From 912b0473a77da06f622f058e7fba33e177379c3f Mon Sep 17 00:00:00 2001 From: lewisfish Date: Tue, 10 Oct 2023 15:18:50 +0000 Subject: [PATCH] =?UTF-8?q?Deploying=20to=20gh-pages=20from=20=20@=20eeb16?= =?UTF-8?q?d4b27926a596a613154b88b15530c2c0155=20=F0=9F=9A=80?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- interface/photon.html | 2 +- module/detector_mod.html | 2 +- module/detectors.html | 2 +- module/geometry.html | 2 +- module/historystack.html | 2 +- module/mat_class.html | 2 +- module/opticalproperties.html | 2 +- module/parse_mod.html | 6 +- module/photonmod.html | 2 +- module/piecewisemod.html | 2 +- module/random.html | 2 +- module/sdf_basemod.html | 2 +- module/sdfhelpers.html | 2 +- module/sdfmodifiers.html | 2 +- module/sdfs.html | 4 +- module/surfaces.html | 2 +- proc/annulus.html | 8 +- proc/aperture.html | 6 +- proc/circular.html | 8 +- proc/display_settings.html | 4 +- proc/dslit.html | 6 +- proc/finalise.html | 12 +- proc/focus.html | 8 +- proc/get_vessels.html | 4 +- proc/handle_annulus_dect.html | 15 +- proc/handle_camera.html | 9 +- proc/handle_circle_dect.html | 9 +- proc/histfinish_sub.html | 2 +- proc/init_historystack.html | 2 +- proc/json_writer.html | 2 +- proc/obj_writer.html | 4 +- proc/parse_detectors.html | 2 +- proc/parse_grid.html | 2 +- proc/parse_output.html | 7 +- proc/parse_params.html | 4 +- proc/parse_source.html | 4 +- proc/parse_spectrum.html | 4 +- proc/pathlength_scatter.html | 22 +- proc/pencil.html | 6 +- proc/ply_writer.html | 2 +- proc/point.html | 2 +- proc/render_sub.html | 4 +- proc/scatter.html | 2 +- proc/setup.html | 16 +- proc/setup_egg.html | 4 +- proc/setup_exp.html | 4 +- proc/setup_logo.html | 4 +- proc/setup_omg_sdf.html | 6 +- proc/setup_scat_test.html | 2 +- proc/setup_scat_test2.html | 2 +- proc/setup_simulation.html | 4 +- proc/setup_sphere.html | 4 +- proc/setup_sphere_scene.html | 6 +- proc/slm.html | 6 +- proc/tauint2.html | 8 +- proc/test_kernel.html | 18 +- proc/uniform.html | 6 +- proc/update_grids.html | 4 +- proc/update_pos.html | 2 +- proc/update_voxels.html | 2 +- proc/wall_dist.html | 2 +- proc/weight_scatter.html | 22 +- proc/write_3d_r4_nrrd.html | 4 +- proc/write_3d_r8_nrrd.html | 2 +- proc/write_data.html | 4 +- proc/write_detected_photons.html | 2 +- sourcefile/historystack.f90.html | 2 +- sourcefile/parse.f90.html | 1132 ++++++++++++++-------------- src/parse.f90 | 22 +- tipuesearch/tipuesearch_content.js | 2 +- 70 files changed, 760 insertions(+), 730 deletions(-) diff --git a/interface/photon.html b/interface/photon.html index 9b8e189a..3e4d94fb 100644 --- a/interface/photon.html +++ b/interface/photon.html @@ -105,7 +105,7 @@

photon
  • 4 statements + title="

    0.1% of total for procedures.

    Including implementation: 53 statements, 1.1% of total for procedures.">4 statements
  • diff --git a/module/detector_mod.html b/module/detector_mod.html index 1fc3bc89..baa6b1be 100644 --- a/module/detector_mod.html +++ b/module/detector_mod.html @@ -232,8 +232,8 @@

    Uses

    diff --git a/module/detectors.html b/module/detectors.html index 9978544f..125b5b2d 100644 --- a/module/detectors.html +++ b/module/detectors.html @@ -213,8 +213,8 @@

    Uses

      • diff --git a/module/geometry.html b/module/geometry.html index 2f9ddce9..3ebbe182 100644 --- a/module/geometry.html +++ b/module/geometry.html @@ -192,8 +192,8 @@

      Uses

      diff --git a/module/historystack.html b/module/historystack.html index e631f40b..73422432 100644 --- a/module/historystack.html +++ b/module/historystack.html @@ -236,8 +236,8 @@

      Uses

      diff --git a/module/mat_class.html b/module/mat_class.html index 95a0a58a..b2b0c197 100644 --- a/module/mat_class.html +++ b/module/mat_class.html @@ -212,8 +212,8 @@

      Uses

      diff --git a/module/opticalproperties.html b/module/opticalproperties.html index b83dc1d1..9834134c 100644 --- a/module/opticalproperties.html +++ b/module/opticalproperties.html @@ -105,7 +105,7 @@

      opticalProperties
    • 129 statements + title=" 2.4% of total for modules and submodules.">129 statements
    • diff --git a/module/parse_mod.html b/module/parse_mod.html index ec317e8c..db78a622 100644 --- a/module/parse_mod.html +++ b/module/parse_mod.html @@ -105,7 +105,7 @@

      parse_mod
    • 563 statements + title="10.9% of total for modules and submodules.">573 statements
    • @@ -201,9 +201,9 @@

      Uses

        • diff --git a/module/photonmod.html b/module/photonmod.html index 656d460b..d7a7371b 100644 --- a/module/photonmod.html +++ b/module/photonmod.html @@ -261,8 +261,8 @@

        Uses

          • diff --git a/module/piecewisemod.html b/module/piecewisemod.html index 62df9111..28ffea39 100644 --- a/module/piecewisemod.html +++ b/module/piecewisemod.html @@ -250,8 +250,8 @@

          Uses

          diff --git a/module/random.html b/module/random.html index d781f4ba..8d0fa507 100644 --- a/module/random.html +++ b/module/random.html @@ -206,8 +206,8 @@

          Uses

          diff --git a/module/sdf_basemod.html b/module/sdf_basemod.html index 634d37d8..b162521c 100644 --- a/module/sdf_basemod.html +++ b/module/sdf_basemod.html @@ -249,9 +249,9 @@

          Uses

            • diff --git a/module/sdfhelpers.html b/module/sdfhelpers.html index 11a84963..5ff6f43d 100644 --- a/module/sdfhelpers.html +++ b/module/sdfhelpers.html @@ -194,8 +194,8 @@

            Uses

            diff --git a/module/sdfmodifiers.html b/module/sdfmodifiers.html index 1599d08a..376c9601 100644 --- a/module/sdfmodifiers.html +++ b/module/sdfmodifiers.html @@ -246,9 +246,9 @@

            Uses

              • diff --git a/module/sdfs.html b/module/sdfs.html index 11c04528..220a199e 100644 --- a/module/sdfs.html +++ b/module/sdfs.html @@ -256,11 +256,11 @@

              Uses

              diff --git a/module/surfaces.html b/module/surfaces.html index c09dc3f6..babf485d 100644 --- a/module/surfaces.html +++ b/module/surfaces.html @@ -192,8 +192,8 @@

              Uses

              diff --git a/proc/annulus.html b/proc/annulus.html index df6fa716..4f243baf 100644 --- a/proc/annulus.html +++ b/proc/annulus.html @@ -174,12 +174,12 @@

              Uses

              diff --git a/proc/aperture.html b/proc/aperture.html index 887a20f6..0d39cf5c 100644 --- a/proc/aperture.html +++ b/proc/aperture.html @@ -174,11 +174,11 @@

              Uses

              diff --git a/proc/circular.html b/proc/circular.html index c7572655..00435bb7 100644 --- a/proc/circular.html +++ b/proc/circular.html @@ -174,13 +174,13 @@

              Uses

                • diff --git a/proc/display_settings.html b/proc/display_settings.html index 74d7b789..2fa0417b 100644 --- a/proc/display_settings.html +++ b/proc/display_settings.html @@ -174,9 +174,9 @@

                Uses

                diff --git a/proc/dslit.html b/proc/dslit.html index 6dba710f..5ee138de 100644 --- a/proc/dslit.html +++ b/proc/dslit.html @@ -174,11 +174,11 @@

                Uses

                diff --git a/proc/finalise.html b/proc/finalise.html index d4d827e8..5ba65ba3 100644 --- a/proc/finalise.html +++ b/proc/finalise.html @@ -174,15 +174,15 @@

                Uses

                diff --git a/proc/focus.html b/proc/focus.html index 94a30978..8080a5be 100644 --- a/proc/focus.html +++ b/proc/focus.html @@ -174,12 +174,12 @@

                Uses

                diff --git a/proc/get_vessels.html b/proc/get_vessels.html index a210ca64..de6cdd26 100644 --- a/proc/get_vessels.html +++ b/proc/get_vessels.html @@ -105,7 +105,7 @@

                get_vessels
              • 76 statements + title=" 1.6% of total for procedures.">76 statements
              • @@ -174,9 +174,9 @@

                Uses

                diff --git a/proc/handle_annulus_dect.html b/proc/handle_annulus_dect.html index 69f90abc..9b86e7d0 100644 --- a/proc/handle_annulus_dect.html +++ b/proc/handle_annulus_dect.html @@ -105,7 +105,7 @@

                handle_annulus_dect
              • 29 statements + title=" 0.7% of total for procedures.">32 statements
              • @@ -174,8 +174,8 @@

                Uses

                @@ -341,15 +341,18 @@

                Source Code

                call get_value(child, "radius1", radius1) call get_value(child, "radius2", radius2, origin=origin) if(radius2 <= radius1)then - print'(a)',context%report("Radii are invalid", origin, "Expected radius2 > radius 1") - stop 1 - end if + call make_error(error, context%report("Radii are invalid", origin, "Expected radius2 > radius 1"), -1) + return + end if call get_value(child, "nbins", nbins, 100) call get_value(child, "maxval", maxval, 100._wp) call get_value(child, "trackHistory", trackHistory, .false.) if(trackHistory)state%trackHistory=.true. #ifdef _OPENMP - if(trackHistory)error stop "Track history currently incompatable with OpenMP!" + if(trackHistory)then + call make_error(error, "Track history currently incompatable with OpenMP!", -1) + return + end if #endif dects(counts) = annulus_dect(pos, dir, layer, radius1, radius2, nbins, maxval, trackHistory) counts = counts + 1 diff --git a/proc/handle_camera.html b/proc/handle_camera.html index 3971e1c5..f4ab7198 100644 --- a/proc/handle_camera.html +++ b/proc/handle_camera.html @@ -105,7 +105,7 @@

                handle_camera
              • 24 statements + title=" 0.6% of total for procedures.">27 statements
              • @@ -174,8 +174,8 @@

                Uses

                @@ -346,7 +346,10 @@

                Source Code

                call get_value(child, "trackHistory", trackHistory, .false.) if(trackHistory)state%trackHistory=.true. #ifdef _OPENMP - if(trackHistory)error stop "Track history currently incompatable with OpenMP!" + if(trackHistory)then + call make_error(error, "Track history currently incompatable with OpenMP!", -1) + return + end if #endif dects(counts) = camera(p1, p2, p3, layer, nbins, maxval, trackHistory) counts = counts + 1 diff --git a/proc/handle_circle_dect.html b/proc/handle_circle_dect.html index 5fe777e4..ef9b15df 100644 --- a/proc/handle_circle_dect.html +++ b/proc/handle_circle_dect.html @@ -105,7 +105,7 @@

                handle_circle_dect
              • 25 statements + title=" 0.6% of total for procedures.">28 statements
              • @@ -174,8 +174,8 @@

                Uses

                @@ -345,7 +345,10 @@

                Source Code

                call get_value(child, "trackHistory", trackHistory, .false.) if(trackHistory)state%trackHistory=.true. #ifdef _OPENMP - if(trackHistory)error stop "Track history currently incompatable with OpenMP!" + if(trackHistory)then + call make_error(error, "Track history currently incompatable with OpenMP!", -1) + return + end if #endif dects(counts) = circle_dect(pos, dir, layer, radius, nbins, maxval, trackHistory) counts = counts + 1 diff --git a/proc/histfinish_sub.html b/proc/histfinish_sub.html index de6452b3..263cdcfa 100644 --- a/proc/histfinish_sub.html +++ b/proc/histfinish_sub.html @@ -174,8 +174,8 @@

                Uses

                diff --git a/proc/init_historystack.html b/proc/init_historystack.html index dd8f7fbe..67de6c96 100644 --- a/proc/init_historystack.html +++ b/proc/init_historystack.html @@ -174,8 +174,8 @@

                Uses

                diff --git a/proc/json_writer.html b/proc/json_writer.html index 84a4a6e0..90bff005 100644 --- a/proc/json_writer.html +++ b/proc/json_writer.html @@ -174,8 +174,8 @@

                Uses

                diff --git a/proc/obj_writer.html b/proc/obj_writer.html index 88aba9c5..20d756b7 100644 --- a/proc/obj_writer.html +++ b/proc/obj_writer.html @@ -174,9 +174,9 @@

                Uses

                diff --git a/proc/parse_detectors.html b/proc/parse_detectors.html index 9fb6cce0..006149b1 100644 --- a/proc/parse_detectors.html +++ b/proc/parse_detectors.html @@ -174,8 +174,8 @@

                Uses

                diff --git a/proc/parse_grid.html b/proc/parse_grid.html index 39cfc87d..0b4d2ca9 100644 --- a/proc/parse_grid.html +++ b/proc/parse_grid.html @@ -174,8 +174,8 @@

                Uses

                diff --git a/proc/parse_output.html b/proc/parse_output.html index c5fc2570..9c5365bd 100644 --- a/proc/parse_output.html +++ b/proc/parse_output.html @@ -105,7 +105,7 @@

                parse_output
              • 31 statements + title=" 0.7% of total for procedures.">32 statements
              • @@ -297,8 +297,9 @@

                Source Code

                if(associated(children))then nlen = len(children) if(nlen < 3)then - error stop "Need a vector of size 3 for render_size." - end if + call make_error(error, "Need a vector of size 3 for render_size.", -1) + return + end if do i = 1, len(children) call get_value(children, i, state%render_size(i)) end do diff --git a/proc/parse_params.html b/proc/parse_params.html index 091dbf2e..30362186 100644 --- a/proc/parse_params.html +++ b/proc/parse_params.html @@ -174,9 +174,9 @@

                Uses

                diff --git a/proc/parse_source.html b/proc/parse_source.html index 29ecac9e..c3be3622 100644 --- a/proc/parse_source.html +++ b/proc/parse_source.html @@ -174,10 +174,10 @@

                Uses

                diff --git a/proc/parse_spectrum.html b/proc/parse_spectrum.html index e96ceeb2..54cb205b 100644 --- a/proc/parse_spectrum.html +++ b/proc/parse_spectrum.html @@ -175,9 +175,9 @@

                Uses

                • diff --git a/proc/pathlength_scatter.html b/proc/pathlength_scatter.html index 2d08759d..a5aa3b52 100644 --- a/proc/pathlength_scatter.html +++ b/proc/pathlength_scatter.html @@ -174,23 +174,23 @@

                Uses

                diff --git a/proc/pencil.html b/proc/pencil.html index 736a0deb..36e07afa 100644 --- a/proc/pencil.html +++ b/proc/pencil.html @@ -174,11 +174,11 @@

                Uses

                diff --git a/proc/ply_writer.html b/proc/ply_writer.html index bcefd5fa..90229fd0 100644 --- a/proc/ply_writer.html +++ b/proc/ply_writer.html @@ -174,8 +174,8 @@

                Uses

                diff --git a/proc/point.html b/proc/point.html index ebfceace..41ce3c70 100644 --- a/proc/point.html +++ b/proc/point.html @@ -175,9 +175,9 @@

                Uses

                • diff --git a/proc/render_sub.html b/proc/render_sub.html index f9c1208a..1f3361bd 100644 --- a/proc/render_sub.html +++ b/proc/render_sub.html @@ -174,10 +174,10 @@

                Uses

                diff --git a/proc/scatter.html b/proc/scatter.html index d46f3849..10b8a7c3 100644 --- a/proc/scatter.html +++ b/proc/scatter.html @@ -175,8 +175,8 @@

                Uses

              diff --git a/proc/setup.html b/proc/setup.html index 41592341..a2cb24a6 100644 --- a/proc/setup.html +++ b/proc/setup.html @@ -174,19 +174,19 @@

              Uses

              diff --git a/proc/setup_logo.html b/proc/setup_logo.html index 82e87ab5..bec0a011 100644 --- a/proc/setup_logo.html +++ b/proc/setup_logo.html @@ -174,10 +174,10 @@

              Uses

              diff --git a/proc/setup_omg_sdf.html b/proc/setup_omg_sdf.html index 6a825c10..69076366 100644 --- a/proc/setup_omg_sdf.html +++ b/proc/setup_omg_sdf.html @@ -174,12 +174,12 @@

              Uses

              diff --git a/proc/setup_scat_test.html b/proc/setup_scat_test.html index c819cd04..adf504e2 100644 --- a/proc/setup_scat_test.html +++ b/proc/setup_scat_test.html @@ -174,9 +174,9 @@

              Uses

              diff --git a/proc/setup_scat_test2.html b/proc/setup_scat_test2.html index 1b134542..fb0e3d4f 100644 --- a/proc/setup_scat_test2.html +++ b/proc/setup_scat_test2.html @@ -174,9 +174,9 @@

              Uses

              diff --git a/proc/setup_simulation.html b/proc/setup_simulation.html index 2d35f16f..bc684dcf 100644 --- a/proc/setup_simulation.html +++ b/proc/setup_simulation.html @@ -174,10 +174,10 @@

              Uses

              diff --git a/proc/setup_sphere.html b/proc/setup_sphere.html index 8ac08fe4..17438aa7 100644 --- a/proc/setup_sphere.html +++ b/proc/setup_sphere.html @@ -174,11 +174,11 @@

              Uses

              diff --git a/proc/setup_sphere_scene.html b/proc/setup_sphere_scene.html index 785cd7b9..fdad115f 100644 --- a/proc/setup_sphere_scene.html +++ b/proc/setup_sphere_scene.html @@ -174,12 +174,12 @@

              Uses

              diff --git a/proc/slm.html b/proc/slm.html index db4ae559..2a9999ef 100644 --- a/proc/slm.html +++ b/proc/slm.html @@ -174,11 +174,11 @@

              Uses

              diff --git a/proc/tauint2.html b/proc/tauint2.html index c3237786..59b2df31 100644 --- a/proc/tauint2.html +++ b/proc/tauint2.html @@ -174,12 +174,12 @@

              Uses

              diff --git a/proc/test_kernel.html b/proc/test_kernel.html index 69567cc9..0b198197 100644 --- a/proc/test_kernel.html +++ b/proc/test_kernel.html @@ -174,21 +174,21 @@

              Uses

              diff --git a/proc/uniform.html b/proc/uniform.html index 6de95704..bf69ebb7 100644 --- a/proc/uniform.html +++ b/proc/uniform.html @@ -174,11 +174,11 @@

              Uses

              diff --git a/proc/update_grids.html b/proc/update_grids.html index dd8dfd67..949a2c30 100644 --- a/proc/update_grids.html +++ b/proc/update_grids.html @@ -174,10 +174,10 @@

              Uses

                • diff --git a/proc/update_pos.html b/proc/update_pos.html index 34b31c44..81946701 100644 --- a/proc/update_pos.html +++ b/proc/update_pos.html @@ -174,9 +174,9 @@

                Uses

                diff --git a/proc/update_voxels.html b/proc/update_voxels.html index 63535513..46fe8fec 100644 --- a/proc/update_voxels.html +++ b/proc/update_voxels.html @@ -174,8 +174,8 @@

                Uses

                diff --git a/proc/wall_dist.html b/proc/wall_dist.html index 3b1abc62..2cdff426 100644 --- a/proc/wall_dist.html +++ b/proc/wall_dist.html @@ -174,8 +174,8 @@

                Uses

                diff --git a/proc/weight_scatter.html b/proc/weight_scatter.html index 27920035..82f5a69b 100644 --- a/proc/weight_scatter.html +++ b/proc/weight_scatter.html @@ -174,23 +174,23 @@

                Uses

                diff --git a/proc/write_3d_r4_nrrd.html b/proc/write_3d_r4_nrrd.html index 4a3af00a..10b4d66e 100644 --- a/proc/write_3d_r4_nrrd.html +++ b/proc/write_3d_r4_nrrd.html @@ -174,10 +174,10 @@

                Uses

                diff --git a/proc/write_3d_r8_nrrd.html b/proc/write_3d_r8_nrrd.html index afc89519..4459eb88 100644 --- a/proc/write_3d_r8_nrrd.html +++ b/proc/write_3d_r8_nrrd.html @@ -174,9 +174,9 @@

                Uses

                diff --git a/proc/write_data.html b/proc/write_data.html index 04264698..99e09a8d 100644 --- a/proc/write_data.html +++ b/proc/write_data.html @@ -174,9 +174,9 @@

                Uses

                diff --git a/proc/write_detected_photons.html b/proc/write_detected_photons.html index f1aee03a..f2904921 100644 --- a/proc/write_detected_photons.html +++ b/proc/write_detected_photons.html @@ -174,9 +174,9 @@

                Uses

                diff --git a/sourcefile/historystack.f90.html b/sourcefile/historystack.f90.html index 76033db4..c006472d 100644 --- a/sourcefile/historystack.f90.html +++ b/sourcefile/historystack.f90.html @@ -105,7 +105,7 @@

                historyStack.f90
              • 235 statements + title=" 4.4% of total for source files.">235 statements
              • diff --git a/sourcefile/parse.f90.html b/sourcefile/parse.f90.html index bb3fd5c3..5bd26460 100644 --- a/sourcefile/parse.f90.html +++ b/sourcefile/parse.f90.html @@ -105,7 +105,7 @@

                parse.f90
              • 563 statements + title="10.8% of total for source files.">573 statements
              • @@ -399,576 +399,586 @@

                Source Code

                call get_value(child, "trackHistory", trackHistory, .false.) if(trackHistory)state%trackHistory=.true. #ifdef _OPENMP - if(trackHistory)error stop "Track history currently incompatable with OpenMP!" -#endif - dects(counts) = camera(p1, p2, p3, layer, nbins, maxval, trackHistory) - counts = counts + 1 - - end subroutine handle_camera - - subroutine handle_circle_dect(child, dects, counts, context, error) - !! Read in Circle_detector settings and initalise variable - use detectors, only : circle_dect - use sim_state_mod, only : state - - type(toml_table), pointer, intent(in) :: child - type(circle_dect), intent(inout) :: dects(:) - integer, intent(inout) :: counts - type(toml_context), intent(in) :: context - type(toml_error), allocatable, intent(out) :: error - - integer :: layer, nbins - real(kind=wp) :: maxval, radius - type(vector) :: pos, dir - logical :: trackHistory - - pos = get_vector(child, "position", context=context, error=error) - dir = get_vector(child, "direction", default=vector(0.0, 0.0, -1.0), context=context, error=error) - dir = dir%magnitude() - call get_value(child, "layer", layer, 1) - call get_value(child, "radius1", radius) - call get_value(child, "nbins", nbins, 100) - call get_value(child, "maxval", maxval, 100._wp) - call get_value(child, "trackHistory", trackHistory, .false.) - if(trackHistory)state%trackHistory=.true. -#ifdef _OPENMP - if(trackHistory)error stop "Track history currently incompatable with OpenMP!" -#endif - dects(counts) = circle_dect(pos, dir, layer, radius, nbins, maxval, trackHistory) - counts = counts + 1 - - end subroutine handle_circle_dect - - subroutine handle_annulus_dect(child, dects, counts, context, error) - !! Read in Annulus_detector settings and initalise variable - use detectors, only : annulus_dect - use sim_state_mod, only : state - - type(toml_table), pointer, intent(in) :: child - type(annulus_dect), intent(inout) :: dects(:) - integer, intent(inout) :: counts - type(toml_context), intent(in) :: context - type(toml_error), allocatable, intent(out) :: error + if(trackHistory)then + call make_error(error, "Track history currently incompatable with OpenMP!", -1) + return + end if +#endif + dects(counts) = camera(p1, p2, p3, layer, nbins, maxval, trackHistory) + counts = counts + 1 + + end subroutine handle_camera + + subroutine handle_circle_dect(child, dects, counts, context, error) + !! Read in Circle_detector settings and initalise variable + use detectors, only : circle_dect + use sim_state_mod, only : state + + type(toml_table), pointer, intent(in) :: child + type(circle_dect), intent(inout) :: dects(:) + integer, intent(inout) :: counts + type(toml_context), intent(in) :: context + type(toml_error), allocatable, intent(out) :: error + + integer :: layer, nbins + real(kind=wp) :: maxval, radius + type(vector) :: pos, dir + logical :: trackHistory + + pos = get_vector(child, "position", context=context, error=error) + dir = get_vector(child, "direction", default=vector(0.0, 0.0, -1.0), context=context, error=error) + dir = dir%magnitude() + call get_value(child, "layer", layer, 1) + call get_value(child, "radius1", radius) + call get_value(child, "nbins", nbins, 100) + call get_value(child, "maxval", maxval, 100._wp) + call get_value(child, "trackHistory", trackHistory, .false.) + if(trackHistory)state%trackHistory=.true. +#ifdef _OPENMP + if(trackHistory)then + call make_error(error, "Track history currently incompatable with OpenMP!", -1) + return + end if +#endif + dects(counts) = circle_dect(pos, dir, layer, radius, nbins, maxval, trackHistory) + counts = counts + 1 + + end subroutine handle_circle_dect + + subroutine handle_annulus_dect(child, dects, counts, context, error) + !! Read in Annulus_detector settings and initalise variable + use detectors, only : annulus_dect + use sim_state_mod, only : state - integer :: layer, nbins, origin - real(kind=wp) :: maxval, radius1, radius2 - type(vector) :: pos, dir - logical :: trackHistory - - pos = get_vector(child, "position", context=context, error=error) - dir = get_vector(child, "direction", default=vector(0.0, 0.0, -1.0), context=context, error=error) - call get_value(child, "layer", layer, 1) - call get_value(child, "radius1", radius1) - call get_value(child, "radius2", radius2, origin=origin) - if(radius2 <= radius1)then - print'(a)',context%report("Radii are invalid", origin, "Expected radius2 > radius 1") - stop 1 - end if - call get_value(child, "nbins", nbins, 100) - call get_value(child, "maxval", maxval, 100._wp) - call get_value(child, "trackHistory", trackHistory, .false.) - if(trackHistory)state%trackHistory=.true. -#ifdef _OPENMP - if(trackHistory)error stop "Track history currently incompatable with OpenMP!" -#endif - dects(counts) = annulus_dect(pos, dir, layer, radius1, radius2, nbins, maxval, trackHistory) - counts = counts + 1 - end subroutine handle_annulus_dect - - subroutine parse_spectrum(table, spectrum, dict, context, error) - !! Parse spectrums to be used - ! TODO seperate out each case to seperate functions. - ! TODO add spectra type to input optical properties - ! handle all possible errors - ! document code and update config.md - use piecewiseMod - use stdlib_io, only: loadtxt - use constants, only : resdir, sp - - use stb_image_mod - use, intrinsic :: iso_c_binding - - type(toml_table), intent(INOUT) :: dict - type(toml_table), pointer :: table - - type(toml_context) :: context - type(spectrum_t), intent(out) :: spectrum - type(toml_error), allocatable, intent(out) :: error - - type(toml_array), pointer :: children - integer :: origin, nlen, i, err, width, height, n_channels,u - integer, allocatable :: image(:,:,:) - type(constant), save, target :: const - type(piecewise1D), save, target :: OneD - type(piecewise2D), save, target :: TwoD - character(len=:), allocatable :: stype, sfile, filetype - real(kind=wp) :: wavelength, cellsize(2) - real(kind=wp), allocatable :: array(:,:) - real(kind=sp), allocatable :: array_sp(:,:) - - call get_value(table, "spectrum_type", stype, "constant", origin=origin) - select case(stype) - case("constant") - call get_value(table, "wavelength", wavelength, 500.0_wp) - const = constant(wavelength) - allocate(spectrum%p, source=const) - spectrum%p => const - case("1D") - allocate(spectrum%p, source=OneD) - call get_value(table, "spectrum_file", sfile) - call loadtxt("res/"//sfile, array_sp) - array = array_sp - deallocate(array_sp) - OneD = piecewise1D(array) - allocate(spectrum%p, source=OneD) - spectrum%p => OneD - case("2D") - allocate(spectrum%p, source=TwoD) + type(toml_table), pointer, intent(in) :: child + type(annulus_dect), intent(inout) :: dects(:) + integer, intent(inout) :: counts + type(toml_context), intent(in) :: context + type(toml_error), allocatable, intent(out) :: error + + integer :: layer, nbins, origin + real(kind=wp) :: maxval, radius1, radius2 + type(vector) :: pos, dir + logical :: trackHistory + + pos = get_vector(child, "position", context=context, error=error) + dir = get_vector(child, "direction", default=vector(0.0, 0.0, -1.0), context=context, error=error) + call get_value(child, "layer", layer, 1) + call get_value(child, "radius1", radius1) + call get_value(child, "radius2", radius2, origin=origin) + if(radius2 <= radius1)then + call make_error(error, context%report("Radii are invalid", origin, "Expected radius2 > radius 1"), -1) + return + end if + call get_value(child, "nbins", nbins, 100) + call get_value(child, "maxval", maxval, 100._wp) + call get_value(child, "trackHistory", trackHistory, .false.) + if(trackHistory)state%trackHistory=.true. +#ifdef _OPENMP + if(trackHistory)then + call make_error(error, "Track history currently incompatable with OpenMP!", -1) + return + end if +#endif + dects(counts) = annulus_dect(pos, dir, layer, radius1, radius2, nbins, maxval, trackHistory) + counts = counts + 1 + end subroutine handle_annulus_dect + + subroutine parse_spectrum(table, spectrum, dict, context, error) + !! Parse spectrums to be used + ! TODO seperate out each case to seperate functions. + ! TODO add spectra type to input optical properties + ! handle all possible errors + ! document code and update config.md + use piecewiseMod + use stdlib_io, only: loadtxt + use constants, only : resdir, sp + + use stb_image_mod + use, intrinsic :: iso_c_binding + + type(toml_table), intent(INOUT) :: dict + type(toml_table), pointer :: table + + type(toml_context) :: context + type(spectrum_t), intent(out) :: spectrum + type(toml_error), allocatable, intent(out) :: error + + type(toml_array), pointer :: children + integer :: origin, nlen, i, err, width, height, n_channels,u + integer, allocatable :: image(:,:,:) + type(constant), save, target :: const + type(piecewise1D), save, target :: OneD + type(piecewise2D), save, target :: TwoD + character(len=:), allocatable :: stype, sfile, filetype + real(kind=wp) :: wavelength, cellsize(2) + real(kind=wp), allocatable :: array(:,:) + real(kind=sp), allocatable :: array_sp(:,:) + + call get_value(table, "spectrum_type", stype, "constant", origin=origin) + select case(stype) + case("constant") + call get_value(table, "wavelength", wavelength, 500.0_wp) + const = constant(wavelength) + allocate(spectrum%p, source=const) + spectrum%p => const + case("1D") + allocate(spectrum%p, source=OneD) call get_value(table, "spectrum_file", sfile) - - call get_value(table, "cell_size", children, requested=.true., origin=origin) - if(associated(children))then - nlen = len(children) - if(nlen /= 2)then - call make_error(error,& - context%report("Need a vector of size 2 for cell_size", origin, "expected vector of size 2"), -1) - return - end if - do i = 1, len(children) - call get_value(children, i, cellsize(i)) - end do - else - call make_error(error,& - context%report("Need a vector of size 2 for cell_size", origin, "expected vector of size 2"), -1) - return - end if - - filetype = sfile(len(sfile)-2:) - select case(filetype) - case("png") - err = stbi_info(trim(resdir)//trim(sfile)//c_null_char, width, height, n_channels) - if(err == 0)then - call make_error(error, "Error reading file: "//trim(sfile)//" "//stbi_failure_reason(), -1) - return - end if - image = stbi_load(trim(resdir)//trim(sfile)//c_null_char, width, height, n_channels, 0) - allocate(array(size(image, 1), size(image, 2))) - array = image(:,:,1) - - deallocate(image) - - case("dat") - call loadtxt(resdir//trim(sfile), array) - case("txt") - call loadtxt(resdir//trim(sfile), array) - case default - print'(2a)', "Unknown spectrum file type:", filetype - end select - TwoD = piecewise2D(cellsize(1), cellsize(2), array) - allocate(spectrum%p, source=TwoD) - spectrum%p => TwoD - case default - call make_error(error,& - context%report("Not a valid spectrum type!", origin, "expected one of either ['constant', '1D', '2D']"),-1) - return - end select - end subroutine parse_spectrum - - subroutine parse_source(table, packet, dict, spectrum, context, error) - !! Parse sources - !! any updates here MUST be reflected in docs/config.md - use sim_state_mod, only : state - use photonmod - use piecewiseMod - use tomlf_error - - !> Input Toml table - type(toml_table), intent(inout) :: table - !> Dictonary used to store metadata - type(toml_table), intent(inout) :: dict - !> Photon packet. Used to store information to save computation - type(photon), intent(out) :: packet - !> Spectrum type. - type(spectrum_t), intent(out) :: spectrum - !> Context handle for error reporting - type(toml_context) :: context - !> Error message - type(toml_error), allocatable, intent(out) :: error - - type(toml_table), pointer :: child - type(toml_array), pointer :: children - - type(vector) :: poss, dirr - real(kind=wp) :: dir(3), pos(3), corners(3, 3), radius, beta, rlo, rhi - integer :: i, nlen, origin - character(len=1) :: axis(3) - character(len=:), allocatable :: direction, annulus_type + call loadtxt("res/"//sfile, array_sp) + array = array_sp + deallocate(array_sp) + OneD = piecewise1D(array) + allocate(spectrum%p, source=OneD) + spectrum%p => OneD + case("2D") + allocate(spectrum%p, source=TwoD) + call get_value(table, "spectrum_file", sfile) + + call get_value(table, "cell_size", children, requested=.true., origin=origin) + if(associated(children))then + nlen = len(children) + if(nlen /= 2)then + call make_error(error,& + context%report("Need a vector of size 2 for cell_size", origin, "expected vector of size 2"), -1) + return + end if + do i = 1, len(children) + call get_value(children, i, cellsize(i)) + end do + else + call make_error(error,& + context%report("Need a vector of size 2 for cell_size", origin, "expected vector of size 2"), -1) + return + end if + + filetype = sfile(len(sfile)-2:) + select case(filetype) + case("png") + err = stbi_info(trim(resdir)//trim(sfile)//c_null_char, width, height, n_channels) + if(err == 0)then + call make_error(error, "Error reading file: "//trim(sfile)//" "//stbi_failure_reason(), -1) + return + end if + image = stbi_load(trim(resdir)//trim(sfile)//c_null_char, width, height, n_channels, 0) + allocate(array(size(image, 1), size(image, 2))) + array = image(:,:,1) + + deallocate(image) + + case("dat") + call loadtxt(resdir//trim(sfile), array) + case("txt") + call loadtxt(resdir//trim(sfile), array) + case default + print'(2a)', "Unknown spectrum file type:", filetype + end select + TwoD = piecewise2D(cellsize(1), cellsize(2), array) + allocate(spectrum%p, source=TwoD) + spectrum%p => TwoD + case default + call make_error(error,& + context%report("Not a valid spectrum type!", origin, "expected one of either ['constant', '1D', '2D']"),-1) + return + end select + end subroutine parse_spectrum + + subroutine parse_source(table, packet, dict, spectrum, context, error) + !! Parse sources + !! any updates here MUST be reflected in docs/config.md + use sim_state_mod, only : state + use photonmod + use piecewiseMod + use tomlf_error + + !> Input Toml table + type(toml_table), intent(inout) :: table + !> Dictonary used to store metadata + type(toml_table), intent(inout) :: dict + !> Photon packet. Used to store information to save computation + type(photon), intent(out) :: packet + !> Spectrum type. + type(spectrum_t), intent(out) :: spectrum + !> Context handle for error reporting + type(toml_context) :: context + !> Error message + type(toml_error), allocatable, intent(out) :: error - axis = ["x", "y", "z"] - pos = 0._wp - dir = 0._wp - corners = reshape((/ -1._wp, -1._wp, 1._wp, & - 2._wp, 0._wp, 0._wp, & - 0._wp, 2._wp, 0._wp /), & - shape(corners), order=[2, 1]) - - call get_value(table, "source", child, requested=.false.) - if(associated(child))then - call get_value(child, "name", state%source, "point") - call get_value(child, "nphotons", state%nphotons, 1000000) - - call get_value(child, "position", children, requested=.false., origin=origin) - if(associated(children))then - nlen = len(children) - if(nlen < 3)then - call make_error(error, & - context%report("Need a vector of size 3 for position", origin, "expected vector of size 3"), -1) - return - end if - do i = 1, len(children) - call get_value(children, i, pos(i)) - end do - else - if(state%source == "point")then + type(toml_table), pointer :: child + type(toml_array), pointer :: children + + type(vector) :: poss, dirr + real(kind=wp) :: dir(3), pos(3), corners(3, 3), radius, beta, rlo, rhi + integer :: i, nlen, origin + character(len=1) :: axis(3) + character(len=:), allocatable :: direction, annulus_type + + axis = ["x", "y", "z"] + pos = 0._wp + dir = 0._wp + corners = reshape((/ -1._wp, -1._wp, 1._wp, & + 2._wp, 0._wp, 0._wp, & + 0._wp, 2._wp, 0._wp /), & + shape(corners), order=[2, 1]) + + call get_value(table, "source", child, requested=.false.) + if(associated(child))then + call get_value(child, "name", state%source, "point") + call get_value(child, "nphotons", state%nphotons, 1000000) + + call get_value(child, "position", children, requested=.false., origin=origin) + if(associated(children))then + nlen = len(children) + if(nlen < 3)then call make_error(error, & - context%report("Point source needs a position!", origin, "Need vector of size 3 for position"), -1) + context%report("Need a vector of size 3 for position", origin, "expected vector of size 3"), -1) return end if - end if - poss = vector(pos(1), pos(2), pos(3)) - - children => null() - - call get_value(child, "direction", children, requested=.false., origin=origin) - if(associated(children))then - if(state%source == "point")then - print'(a)',context%report(& - "Point source needs no direction!!", origin, level=toml_level%warning) - end if - nlen = len(children) - if(nlen < 3)then - call make_error(error, & - context%report("Need a vector of size 3 for direction", origin, "expected vector of size 3"), -1) - return - end if - if(state%source == "circular")then - print'(a)',context%report(& - "Direction not yet fully tested for source type Circular. Results may not be accurate!", origin,& - level=toml_level%warning) - end if - do i = 1, len(children) - call get_value(children, i, dir(i)) - end do - dirr%x = dir(1) - dirr%y = dir(2) - dirr%z = dir(3) - else - call get_value(child, "direction", direction, origin=origin) - if(allocated(direction))then - if(state%source == "point")then - print'(a)',context%report(& - "Point source needs no direction!!", origin, level=toml_level%warning) - end if - - select case(direction) - case("x") - dirr = vector(1._wp, 0._wp, 0._wp) - case("-x") - dirr = vector(-1._wp, 0._wp, 0._wp) - case("y") - dirr = vector(0._wp, 1._wp, 0._wp) - case("-y") - dirr = vector(0._wp, -1._wp, 0._wp) - case("z") - dirr = vector(0._wp, 0._wp, 1._wp) - case("-z") - dirr = vector(0._wp, 0._wp, -1._wp) - case default - call make_error(error, context%report("Direction needs a cardinal direction i.e x, y, or z", origin, & - "Expected cardinal direction"), -1) - return - end select - elseif(state%source /= "point")then - call make_error(error, context%report("Need to specify direction for source type!", origin, & - "No direction specified"), -1) - return - end if - end if - - children => null() - - call get_value(child, "point1", children, requested=.false., origin=origin) - if(associated(children))then - nlen = len(children) - if(nlen < 3)then - call make_error(error, & - context%report("Need a matrix row for points", origin, "expected matrix row of size 3"), -1) - return - end if - do i = 1, len(children) - call get_value(children, i, corners(i, 1)) - call set_value(dict, "pos1%"//axis(i), corners(i,1)) - end do - else - if(state%source == "uniform")then - call make_error(error, & - context%report("Uniform source requires point1 variable", origin, "expected point1 variable"), -1) - return - end if - end if - - call get_value(child, "point2", children, requested=.false., origin=origin) - if(associated(children))then - nlen = len(children) - if(nlen < 3)then - call make_error(error, & - context%report("Need a matrix row for points", origin, "expected matrix row of size 3"), -1) - return - end if - do i = 1, len(children) - call get_value(children, i, corners(i, 2)) - call set_value(dict, "pos2%"//axis(i), corners(i,2)) - end do - else - if(state%source == "uniform")then - call make_error(error, & - context%report("Uniform source requires point2 variable", origin, "expected point2 variable"), -1) - return - end if - end if - - call get_value(child, "point3", children, requested=.false., origin=origin) - if(associated(children))then - nlen = len(children) - if(nlen < 3)then - call make_error(error, & - context%report("Need a matrix row for points", origin, "expected matrix row of size 3"), -1) - return - end if - do i = 1, len(children) - call get_value(children, i, corners(i, 3)) - call set_value(dict, "pos3%"//axis(i), corners(i,3)) - end do - else - if(state%source == "uniform")then - call make_error(error, & - context%report("Uniform source requires point3 variable", origin, "expected point3 variable"), -1) - return - end if - end if - call get_value(child, "radius", radius, 0.5_wp) - call set_value(dict, "radius", radius) - - ! parameters for annulus beam type - call get_value(child, "beta", beta, 5._wp) - call set_value(dict, "beta", beta) - - call get_value(child, "radius_hi", rhi, 0.6_wp) - call set_value(dict, "rhi", rhi) - - call get_value(child, "annulus_type", annulus_type, "gaussian") - call set_value(dict, "annulus_type", annulus_type) - - ! parse spectrum - call parse_spectrum(child, spectrum, dict, context, error) - if(allocated(error))return - else - call make_error(error, context%report("Simulation needs Source table", origin, "Missing source table"), -1) - return - end if - - call set_photon(poss, dirr) - packet = photon(state%source) - packet%pos = poss - packet%nxp = dirr%x - packet%nyp = dirr%y - packet%nzp = dirr%z - - end subroutine parse_source + do i = 1, len(children) + call get_value(children, i, pos(i)) + end do + else + if(state%source == "point")then + call make_error(error, & + context%report("Point source needs a position!", origin, "Need vector of size 3 for position"), -1) + return + end if + end if + poss = vector(pos(1), pos(2), pos(3)) + + children => null() + + call get_value(child, "direction", children, requested=.false., origin=origin) + if(associated(children))then + if(state%source == "point")then + print'(a)',context%report(& + "Point source needs no direction!!", origin, level=toml_level%warning) + end if + nlen = len(children) + if(nlen < 3)then + call make_error(error, & + context%report("Need a vector of size 3 for direction", origin, "expected vector of size 3"), -1) + return + end if + if(state%source == "circular")then + print'(a)',context%report(& + "Direction not yet fully tested for source type Circular. Results may not be accurate!", origin,& + level=toml_level%warning) + end if + do i = 1, len(children) + call get_value(children, i, dir(i)) + end do + dirr%x = dir(1) + dirr%y = dir(2) + dirr%z = dir(3) + else + call get_value(child, "direction", direction, origin=origin) + if(allocated(direction))then + if(state%source == "point")then + print'(a)',context%report(& + "Point source needs no direction!!", origin, level=toml_level%warning) + end if + + select case(direction) + case("x") + dirr = vector(1._wp, 0._wp, 0._wp) + case("-x") + dirr = vector(-1._wp, 0._wp, 0._wp) + case("y") + dirr = vector(0._wp, 1._wp, 0._wp) + case("-y") + dirr = vector(0._wp, -1._wp, 0._wp) + case("z") + dirr = vector(0._wp, 0._wp, 1._wp) + case("-z") + dirr = vector(0._wp, 0._wp, -1._wp) + case default + call make_error(error, context%report("Direction needs a cardinal direction i.e x, y, or z", origin, & + "Expected cardinal direction"), -1) + return + end select + elseif(state%source /= "point")then + call make_error(error, context%report("Need to specify direction for source type!", origin, & + "No direction specified"), -1) + return + end if + end if + + children => null() + + call get_value(child, "point1", children, requested=.false., origin=origin) + if(associated(children))then + nlen = len(children) + if(nlen < 3)then + call make_error(error, & + context%report("Need a matrix row for points", origin, "expected matrix row of size 3"), -1) + return + end if + do i = 1, len(children) + call get_value(children, i, corners(i, 1)) + call set_value(dict, "pos1%"//axis(i), corners(i,1)) + end do + else + if(state%source == "uniform")then + call make_error(error, & + context%report("Uniform source requires point1 variable", origin, "expected point1 variable"), -1) + return + end if + end if + + call get_value(child, "point2", children, requested=.false., origin=origin) + if(associated(children))then + nlen = len(children) + if(nlen < 3)then + call make_error(error, & + context%report("Need a matrix row for points", origin, "expected matrix row of size 3"), -1) + return + end if + do i = 1, len(children) + call get_value(children, i, corners(i, 2)) + call set_value(dict, "pos2%"//axis(i), corners(i,2)) + end do + else + if(state%source == "uniform")then + call make_error(error, & + context%report("Uniform source requires point2 variable", origin, "expected point2 variable"), -1) + return + end if + end if + + call get_value(child, "point3", children, requested=.false., origin=origin) + if(associated(children))then + nlen = len(children) + if(nlen < 3)then + call make_error(error, & + context%report("Need a matrix row for points", origin, "expected matrix row of size 3"), -1) + return + end if + do i = 1, len(children) + call get_value(children, i, corners(i, 3)) + call set_value(dict, "pos3%"//axis(i), corners(i,3)) + end do + else + if(state%source == "uniform")then + call make_error(error, & + context%report("Uniform source requires point3 variable", origin, "expected point3 variable"), -1) + return + end if + end if + call get_value(child, "radius", radius, 0.5_wp) + call set_value(dict, "radius", radius) + + ! parameters for annulus beam type + call get_value(child, "beta", beta, 5._wp) + call set_value(dict, "beta", beta) + + call get_value(child, "radius_hi", rhi, 0.6_wp) + call set_value(dict, "rhi", rhi) + + call get_value(child, "annulus_type", annulus_type, "gaussian") + call set_value(dict, "annulus_type", annulus_type) + + ! parse spectrum + call parse_spectrum(child, spectrum, dict, context, error) + if(allocated(error))return + else + call make_error(error, context%report("Simulation needs Source table", origin, "Missing source table"), -1) + return + end if - subroutine parse_grid(table, dict, error) - !! parse grid input data - use sim_state_mod, only : state - use gridMod, only : init_grid - - !> Input Toml table - type(toml_table), intent(inout) :: table - !> Dictonary used to store metadata - type(toml_table), intent(inout) :: dict - type(toml_error), allocatable, intent(out) :: error - - character(len=:), allocatable :: msg - type(toml_table), pointer :: child - integer :: nxg, nyg, nzg - real(kind=wp) :: xmax, ymax, zmax - character(len=:), allocatable :: units - - call get_value(table, "grid", child) - - if(associated(child))then - call get_value(child, "nxg", nxg, 200) - call get_value(child, "nyg", nyg, 200) - call get_value(child, "nzg", nzg, 200) - call get_value(child, "xmax", xmax, 1.0_wp) - call get_value(child, "ymax", ymax, 1.0_wp) - call get_value(child, "zmax", zmax, 1.0_wp) - call get_value(child, "units", units, "cm") - call set_value(dict, "units", units) - else - msg = "Need grid table in input param file" - call make_error(error, msg) - return - end if - - state%grid = init_grid(nxg, nyg, nzg, xmax, ymax, zmax) - - end subroutine parse_grid - - subroutine parse_geometry(table, dict, error) - !! parse geometry information - use sim_state_mod, only : state - - !> Input Toml table - type(toml_table), intent(INOUT) :: table - !> Dictonary used to store metadata - type(toml_table), intent(INOUT) :: dict - type(toml_error), allocatable, intent(out) :: error - - type(toml_table), pointer :: child - real(kind=wp) :: tau, musb, musc, muab, muac, hgg - integer :: num_spheres - - call get_value(table, "geometry", child) - - if(associated(child))then - call get_value(child, "geom_name", state%experiment, "sphere") - call get_value(child, "tau", tau, 10._wp) - call set_value(dict, "tau", tau) - - call get_value(child, "num_spheres", num_spheres, 10) - call set_value(dict, "num_spheres", num_spheres) - - call get_value(child, "musb", musb, 0.0_wp) - call set_value(dict, "musb", musb) - call get_value(child, "muab", muab, 0.01_wp) - call set_value(dict, "muab", muab) - call get_value(child, "musc", musc, 0.0_wp) - call set_value(dict, "musc", musc) - call get_value(child, "muac", muac, 0.01_wp) - call set_value(dict, "muac", muac) - call get_value(child, "hgg", hgg, 0.7_wp) - call set_value(dict, "hgg", hgg) - else - call make_error(error, "Need geometry table in input param file", -1) - end if - - end subroutine parse_geometry - - subroutine parse_output(table, error) - !! parse output file information - use sim_state_mod, only : state - - !> Input Toml table - type(toml_table), intent(inout) :: table - type(toml_error), allocatable, intent(out) :: error - - type(toml_table), pointer :: child - type(toml_array), pointer :: children - integer :: i, nlen - - call get_value(table, "output", child) - - if(associated(child))then - call get_value(child, "fluence", state%outfile, "fluence.nrrd") - call get_value(child, "absorb", state%outfile_absorb, "absorb.nrrd") - call get_value(child, "render", state%renderfile, "geom_render.nrrd") - call get_value(child, "render_geom", state%render_geom, .false.) - - call get_value(child, "render_size", children, requested=.false.) - if(associated(children))then - nlen = len(children) - if(nlen < 3)then - error stop "Need a vector of size 3 for render_size." - end if - do i = 1, len(children) - call get_value(children, i, state%render_size(i)) - end do - else - state%render_size = [200, 200, 200] - end if - - call get_value(child, "overwrite", state%overwrite, .false.) - else - call make_error(error, "Need output table in input param file", -1) - return - end if - - end subroutine parse_output - - subroutine parse_simulation(table, error) - !! parse simulation information - use sim_state_mod, only : state - - !> Input Toml table - type(toml_table), intent(inout) :: table - type(toml_error), allocatable, intent(out) :: error + call set_photon(poss, dirr) + packet = photon(state%source) + packet%pos = poss + packet%nxp = dirr%x + packet%nyp = dirr%y + packet%nzp = dirr%z + + end subroutine parse_source + + subroutine parse_grid(table, dict, error) + !! parse grid input data + use sim_state_mod, only : state + use gridMod, only : init_grid + + !> Input Toml table + type(toml_table), intent(inout) :: table + !> Dictonary used to store metadata + type(toml_table), intent(inout) :: dict + type(toml_error), allocatable, intent(out) :: error + + character(len=:), allocatable :: msg + type(toml_table), pointer :: child + integer :: nxg, nyg, nzg + real(kind=wp) :: xmax, ymax, zmax + character(len=:), allocatable :: units + + call get_value(table, "grid", child) + + if(associated(child))then + call get_value(child, "nxg", nxg, 200) + call get_value(child, "nyg", nyg, 200) + call get_value(child, "nzg", nzg, 200) + call get_value(child, "xmax", xmax, 1.0_wp) + call get_value(child, "ymax", ymax, 1.0_wp) + call get_value(child, "zmax", zmax, 1.0_wp) + call get_value(child, "units", units, "cm") + call set_value(dict, "units", units) + else + msg = "Need grid table in input param file" + call make_error(error, msg) + return + end if + + state%grid = init_grid(nxg, nyg, nzg, xmax, ymax, zmax) + + end subroutine parse_grid + + subroutine parse_geometry(table, dict, error) + !! parse geometry information + use sim_state_mod, only : state + + !> Input Toml table + type(toml_table), intent(INOUT) :: table + !> Dictonary used to store metadata + type(toml_table), intent(INOUT) :: dict + type(toml_error), allocatable, intent(out) :: error + + type(toml_table), pointer :: child + real(kind=wp) :: tau, musb, musc, muab, muac, hgg + integer :: num_spheres + + call get_value(table, "geometry", child) + + if(associated(child))then + call get_value(child, "geom_name", state%experiment, "sphere") + call get_value(child, "tau", tau, 10._wp) + call set_value(dict, "tau", tau) + + call get_value(child, "num_spheres", num_spheres, 10) + call set_value(dict, "num_spheres", num_spheres) + + call get_value(child, "musb", musb, 0.0_wp) + call set_value(dict, "musb", musb) + call get_value(child, "muab", muab, 0.01_wp) + call set_value(dict, "muab", muab) + call get_value(child, "musc", musc, 0.0_wp) + call set_value(dict, "musc", musc) + call get_value(child, "muac", muac, 0.01_wp) + call set_value(dict, "muac", muac) + call get_value(child, "hgg", hgg, 0.7_wp) + call set_value(dict, "hgg", hgg) + else + call make_error(error, "Need geometry table in input param file", -1) + end if + + end subroutine parse_geometry + + subroutine parse_output(table, error) + !! parse output file information + use sim_state_mod, only : state + + !> Input Toml table + type(toml_table), intent(inout) :: table + type(toml_error), allocatable, intent(out) :: error + + type(toml_table), pointer :: child + type(toml_array), pointer :: children + integer :: i, nlen + + call get_value(table, "output", child) + + if(associated(child))then + call get_value(child, "fluence", state%outfile, "fluence.nrrd") + call get_value(child, "absorb", state%outfile_absorb, "absorb.nrrd") + call get_value(child, "render", state%renderfile, "geom_render.nrrd") + call get_value(child, "render_geom", state%render_geom, .false.) + + call get_value(child, "render_size", children, requested=.false.) + if(associated(children))then + nlen = len(children) + if(nlen < 3)then + call make_error(error, "Need a vector of size 3 for render_size.", -1) + return + end if + do i = 1, len(children) + call get_value(children, i, state%render_size(i)) + end do + else + state%render_size = [200, 200, 200] + end if + + call get_value(child, "overwrite", state%overwrite, .false.) + else + call make_error(error, "Need output table in input param file", -1) + return + end if - type(toml_table), pointer :: child + end subroutine parse_output - call get_value(table, "simulation", child) - - if(associated(child))then - call get_value(child, "iseed", state%iseed, 123456789) - call get_value(child, "tev", state%tev, .false.) - call get_value(child, "absorb", state%absorb, .false.) - else - call make_error(error, "Need simulation table in input param file", -1) - return - end if - - end subroutine parse_simulation - - type(vector) function get_vector(child, key, error, context, default) - !! Vector helper function for parsing toml - - !> Input Toml entry to read - type(toml_table), pointer, intent(in) :: child - !> Key to read - character(*), intent(in) :: key - !> Default value to assign - type(vector), optional, intent(in) :: default - !> Context handle for error reporting - type(toml_context), intent(in) :: context - type(toml_error), allocatable, intent(out) :: error + subroutine parse_simulation(table, error) + !! parse simulation information + use sim_state_mod, only : state + + !> Input Toml table + type(toml_table), intent(inout) :: table + type(toml_error), allocatable, intent(out) :: error + + type(toml_table), pointer :: child + + call get_value(table, "simulation", child) + + if(associated(child))then + call get_value(child, "iseed", state%iseed, 123456789) + call get_value(child, "tev", state%tev, .false.) + call get_value(child, "absorb", state%absorb, .false.) + else + call make_error(error, "Need simulation table in input param file", -1) + return + end if + + end subroutine parse_simulation + + type(vector) function get_vector(child, key, error, context, default) + !! Vector helper function for parsing toml - type(toml_array), pointer :: arr => null() - real(kind=wp) :: tmp(3) - type(vector) :: default_ - integer :: j, origin - - if(present(default))then - default_ = default - else - default_ = vector(0._wp, 0._wp, 0._wp) - end if - - call get_value(child, key, arr, origin=origin) - if (associated(arr))then - if(len(arr) /= 3)then - call make_error(error, & - context%report("Expected vector of size 3", origin, "Wrong vector size"), -1) - return - end if - do j = 1, len(arr) - call get_value(arr, j, tmp(j)) - end do - get_vector = vector(tmp(1), tmp(2), tmp(3)) - else - get_vector = default - end if - - end function get_vector -end module parse_mod + !> Input Toml entry to read + type(toml_table), pointer, intent(in) :: child + !> Key to read + character(*), intent(in) :: key + !> Default value to assign + type(vector), optional, intent(in) :: default + !> Context handle for error reporting + type(toml_context), intent(in) :: context + type(toml_error), allocatable, intent(out) :: error + + type(toml_array), pointer :: arr => null() + real(kind=wp) :: tmp(3) + type(vector) :: default_ + integer :: j, origin + + if(present(default))then + default_ = default + else + default_ = vector(0._wp, 0._wp, 0._wp) + end if + + call get_value(child, key, arr, origin=origin) + if (associated(arr))then + if(len(arr) /= 3)then + call make_error(error, & + context%report("Expected vector of size 3", origin, "Wrong vector size"), -1) + return + end if + do j = 1, len(arr) + call get_value(arr, j, tmp(j)) + end do + get_vector = vector(tmp(1), tmp(2), tmp(3)) + else + get_vector = default + end if + + end function get_vector +end module parse_mod diff --git a/src/parse.f90 b/src/parse.f90 index bd5c85eb..4cf15c16 100644 --- a/src/parse.f90 +++ b/src/parse.f90 @@ -175,7 +175,10 @@ subroutine handle_camera(child, dects, counts, context, error) call get_value(child, "trackHistory", trackHistory, .false.) if(trackHistory)state%trackHistory=.true. #ifdef _OPENMP - if(trackHistory)error stop "Track history currently incompatable with OpenMP!" + if(trackHistory)then + call make_error(error, "Track history currently incompatable with OpenMP!", -1) + return + end if #endif dects(counts) = camera(p1, p2, p3, layer, nbins, maxval, trackHistory) counts = counts + 1 @@ -208,7 +211,10 @@ subroutine handle_circle_dect(child, dects, counts, context, error) call get_value(child, "trackHistory", trackHistory, .false.) if(trackHistory)state%trackHistory=.true. #ifdef _OPENMP - if(trackHistory)error stop "Track history currently incompatable with OpenMP!" + if(trackHistory)then + call make_error(error, "Track history currently incompatable with OpenMP!", -1) + return + end if #endif dects(counts) = circle_dect(pos, dir, layer, radius, nbins, maxval, trackHistory) counts = counts + 1 @@ -237,15 +243,18 @@ subroutine handle_annulus_dect(child, dects, counts, context, error) call get_value(child, "radius1", radius1) call get_value(child, "radius2", radius2, origin=origin) if(radius2 <= radius1)then - print'(a)',context%report("Radii are invalid", origin, "Expected radius2 > radius 1") - stop 1 + call make_error(error, context%report("Radii are invalid", origin, "Expected radius2 > radius 1"), -1) + return end if call get_value(child, "nbins", nbins, 100) call get_value(child, "maxval", maxval, 100._wp) call get_value(child, "trackHistory", trackHistory, .false.) if(trackHistory)state%trackHistory=.true. #ifdef _OPENMP - if(trackHistory)error stop "Track history currently incompatable with OpenMP!" + if(trackHistory)then + call make_error(error, "Track history currently incompatable with OpenMP!", -1) + return + end if #endif dects(counts) = annulus_dect(pos, dir, layer, radius1, radius2, nbins, maxval, trackHistory) counts = counts + 1 @@ -664,7 +673,8 @@ subroutine parse_output(table, error) if(associated(children))then nlen = len(children) if(nlen < 3)then - error stop "Need a vector of size 3 for render_size." + call make_error(error, "Need a vector of size 3 for render_size.", -1) + return end if do i = 1, len(children) call get_value(children, i, state%render_size(i)) diff --git a/tipuesearch/tipuesearch_content.js b/tipuesearch/tipuesearch_content.js index 53814d46..eb8de1b2 100644 --- a/tipuesearch/tipuesearch_content.js +++ b/tipuesearch/tipuesearch_content.js @@ -1 +1 @@ -var tipuesearch = {"pages":[{"title":" signedMCRT ","text":"signedMCRT Brief description Installation Dependencies References License Brief description A Monte Carlo radiation transfer code with signed distance functions representing the geometry, written in modern Fortran.\nThis allows modelling of smooth surfaces with out the need to use triangle or similar meshes. Installation To build signedMCRT, the only current method is using FPM .\nFPM can be easily installed on any platform, and is simple to use to pull all dependencies, and build and compile signedMCRT.\nWe also provide several commands via FPM response file ( found here ), to enable the use of OpenMP, other compliers, and various debug modes. Dependencies Below is the current list of dependencies: test drive Fortran TEV Bindings stdlib stb_image Fortran Utilities Test drive is used to run all tests.\nFortran TEV Bindings is used to interface with TEV, to show live slices of fluences as the simulation is run, which is handy for debugging purposes.\nStdlib is a collection of routines purposed for inclusion within the Fortran standard. Stdlib is used here for it's loadtxt function to load arbitrary plain text data into arrays. More of stdlib may be used in future.\nFortran_stb_Image is used to load images into arrays. Fortran_stb_image are the Fortran bindings for stb_image .\nFinally, Fortran Utilities is my personal collection of useful Fortran utilities such as mathematical functions, or progress bars. References SignedMCRT has so far been used in 2 papers: MESHLESS MONTE CARLO RADIATION TRANSFER METHOD FOR CURVED GEOMETRIES USING SIGNED DISTANCE FUNCTIONS\nL. McMillan, G. D. Bruce, K. Dholakia, J. Biomed. Opt. 27(8), 083003 (2022) / arXiv:2112.08035 (2021) TO FOCUS-MATCH OR NOT TO FOCUS-MATCH INVERSE SPATIALLY OFFSET RAMAN SPECTROSCOPY: A QUESTION OF LIGHT PENETRATION\nG.E. Shillito, L. McMillan, G. D. Bruce, K. Dholakia, Opt. Express 30, 8876 (2022) / arXiv:2112.08877 License The signedMCRT source code and related files and documentation are\ndistributed under a permissive free software license (MIT). Developer Info Lewis McMillan","tags":"home","loc":"index.html"},{"title":"photon – signedMCRT ","text":"type, public :: photon photon class Contents Variables bounces cnts cosp cost emit energy fact id layer nxp nyp nzp phase phi pos sinp sint step tflag wavelength weight xcell ycell zcell Constructor photon Type-Bound Procedures scatter Source Code photon Components Type Visibility Attributes Name Initial integer, public :: bounces Debug data. Number of SDF evals integer, public :: cnts Debug data. Number of SDF evals real(kind=wp), public :: cosp direction cosines real(kind=wp), public :: cost direction cosines procedure( generic_emit ), public, pointer :: emit => null() emission routine real(kind=wp), public :: energy Energy of the packet. TODO real(kind=wp), public :: fact . Used to save computational time integer, public :: id Thread ID of the packet integer, public :: layer ID of the SDF the packet is in real(kind=wp), public :: nxp direction vectors real(kind=wp), public :: nyp direction vectors real(kind=wp), public :: nzp direction vectors real(kind=wp), public :: phase Current phase of the packet real(kind=wp), public :: phi direction cosines type( vector ), public :: pos postion of photon packet in cm. (0,0,0) is the center of the grid. real(kind=wp), public :: sinp direction cosines real(kind=wp), public :: sint direction cosines real(kind=wp), public :: step used if photon packet weights are used logical, public :: tflag photon alive flag real(kind=wp), public :: wavelength Wavelength of the packet real(kind=wp), public :: weight used if photon packet weights are used integer, public :: xcell grid cell position integer, public :: ycell grid cell position integer, public :: zcell grid cell position Constructor public interface photon public function init_source (choice) Bind emission function to photon object Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: choice Name of light source to use Return Value type( photon ) private function init_photon (val) set up all the variables in the photon object Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val value to assing to variables Return Value type( photon ) Type-Bound Procedures procedure, public, :: scatter scattering routine private subroutine scatter (this, hgg, g2, dects) Scattering routine. Implments both isotropic and henyey-greenstein scattering\ntaken from mcxyz Arguments Type Intent Optional Attributes Name class( photon ), intent(inout) :: this real(kind=wp), intent(in) :: hgg g factor real(kind=wp), intent(in) :: g2 g factor squared type( dect_array ), intent(in), optional :: dects (:) array of detectors. Only used if biased scattering is enabled. Source Code type :: photon !> postion of photon packet in cm. (0,0,0) is the center of the grid. type ( vector ) :: pos !> direction vectors real ( kind = wp ) :: nxp , nyp , nzp !> direction cosines real ( kind = wp ) :: sint , cost , sinp , cosp , phi !> Wavelength of the packet real ( kind = wp ) :: wavelength !> Current phase of the packet real ( kind = wp ) :: phase !> \\frac{2\\pi}{\\lambda}. Used to save computational time real ( kind = wp ) :: fact !> Energy of the packet. TODO real ( kind = wp ) :: energy !> grid cell position integer :: xcell , ycell , zcell !> photon alive flag logical :: tflag !> ID of the SDF the packet is in integer :: layer !> Thread ID of the packet integer :: id !> Debug data. Number of SDF evals integer :: cnts , bounces !> used if photon packet weights are used real ( kind = wp ) :: weight , step !, L !> emission routine procedure ( generic_emit ), pointer :: emit => null () contains !> scattering routine procedure :: scatter => scatter end type photon","tags":"","loc":"type/photon.html"},{"title":"mat – signedMCRT ","text":"type, public :: mat Contents Variables vals Constructor mat Type-Bound Procedures mat_add_scal mat_div_scal mat_minus_scal mat_mult_mat mat_mult_scal operator(*) operator(+) operator(-) operator(/) scal_add_mat scal_mult_mat Source Code mat Components Type Visibility Attributes Name Initial real(kind=wp), public :: vals (4,4) Matrix values Constructor public interface mat Intalise Matrix with 1D Array private function mat_init (array) Initalise matrix type from 1D array Arguments Type Intent Optional Attributes Name real(kind=wp) :: array (16) 1D array to initalise from. Return Value type( mat ) Type-Bound Procedures procedure, private, pass(a) :: mat_add_scal private function mat_add_scal (a, b) Matrix + Scalar = Matrix Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to add Return Value type( mat ) procedure, private, pass(a) :: mat_div_scal private function mat_div_scal (a, b) Matrix / scalar Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to divide by Return Value type( mat ) procedure, private, pass(a) :: mat_minus_scal private function mat_minus_scal (a, b) Matrix - Scalar Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( mat ) procedure, private, pass(a) :: mat_mult_mat private function mat_mult_mat (a, b) Matrix * vec4 Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix type( vec4 ), intent(in) :: b Vec4 to multiply by Return Value type( vec4 ) procedure, private, pass(a) :: mat_mult_scal private function mat_mult_scal (a, b) Matrix * Scalar Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( mat ) generic, public, :: operator(*) => mat_mult_scal , scal_mult_mat , mat_mult_mat Overload for Multiplication operator private function mat_mult_scal (a, b) Matrix * Scalar Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( mat ) private function scal_mult_mat (a, b) Matrix * Scalar Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( mat ), intent(in) :: b Input Matrix Return Value type( mat ) private function mat_mult_mat (a, b) Matrix * vec4 Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix type( vec4 ), intent(in) :: b Vec4 to multiply by Return Value type( vec4 ) generic, public, :: operator(+) => mat_add_scal , scal_add_mat Overload for Addition operator private function mat_add_scal (a, b) Matrix + Scalar = Matrix Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to add Return Value type( mat ) private function scal_add_mat (a, b) Scaler + Matrix Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalat to add class( mat ), intent(in) :: b Input Matrix Return Value type( mat ) generic, public, :: operator(-) => mat_minus_scal Overload for Subtraction operator private function mat_minus_scal (a, b) Matrix - Scalar Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( mat ) generic, public, :: operator(/) => mat_div_scal Overload for Division operator private function mat_div_scal (a, b) Matrix / scalar Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to divide by Return Value type( mat ) procedure, private, pass(b) :: scal_add_mat private function scal_add_mat (a, b) Scaler + Matrix Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalat to add class( mat ), intent(in) :: b Input Matrix Return Value type( mat ) procedure, private, pass(b) :: scal_mult_mat private function scal_mult_mat (a, b) Matrix * Scalar Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( mat ), intent(in) :: b Input Matrix Return Value type( mat ) Source Code type :: mat !> Matrix values real ( kind = wp ) :: vals ( 4 , 4 ) contains !> Overload for Division operator generic :: operator ( / ) => mat_div_scal !> Overload for Multiplication operator generic :: operator ( * ) => mat_mult_scal , scal_mult_mat , mat_mult_mat !> Overload for Addition operator generic :: operator ( + ) => mat_add_scal , scal_add_mat !> Overload for Subtraction operator generic :: operator ( - ) => mat_minus_scal procedure , pass ( a ), private :: mat_div_scal procedure , pass ( a ), private :: mat_mult_mat procedure , pass ( a ), private :: mat_mult_scal procedure , pass ( b ), private :: scal_mult_mat procedure , pass ( a ), private :: mat_add_scal procedure , pass ( b ), private :: scal_add_mat procedure , pass ( a ), private :: mat_minus_scal end type mat","tags":"","loc":"type/mat.html"},{"title":"history_stack_t – signedMCRT ","text":"type, public :: history_stack_t Contents Variables data edge_counter filename size type vertex_counter Constructor history_stack_t Type-Bound Procedures empty finish peek pop push write zero Source Code history_stack_t Components Type Visibility Attributes Name Initial type( vec4 ), public, allocatable :: data (:) integer, public :: edge_counter character(len=:), public, allocatable :: filename integer, public :: size character(len=:), public, allocatable :: type integer, public :: vertex_counter Constructor public interface history_stack_t private function init_historyStack (filename, id) Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: filename integer, intent(in) :: id Return Value type( history_stack_t ) Type-Bound Procedures procedure, public, :: empty => histempty_fn private function histempty_fn (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Return Value logical procedure, public, :: finish => histfinish_sub private subroutine histfinish_sub (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this procedure, public, :: peek => histpeek_fn private function histpeek_fn (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Return Value type( vec4 ) procedure, public, :: pop => histpop_fn private function histpop_fn (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Return Value type( vec4 ) procedure, public, :: push => histpush_sub private subroutine histpush_sub (this, val) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this type( vec4 ), intent(in) :: val procedure, public, :: write => histwrite_sub private subroutine histwrite_sub (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this procedure, public, :: zero => histzero_sub private subroutine histzero_sub (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Source Code type :: history_stack_t type ( vec4 ), allocatable :: data (:) integer :: size , vertex_counter , edge_counter character ( len = :), allocatable :: filename , type contains procedure :: pop => histpop_fn procedure :: push => histpush_sub procedure :: peek => histpeek_fn procedure :: empty => histempty_fn procedure :: zero => histzero_sub procedure :: write => histwrite_sub procedure :: finish => histfinish_sub end type history_stack_t","tags":"","loc":"type/history_stack_t.html"},{"title":"vector – signedMCRT ","text":"type, public :: vector Vector class Contents Variables x y z Type-Bound Procedures length magnitude operator(*) operator(**) operator(+) operator(-) operator(.cross.) operator(.dot.) operator(/) operator(==) scal_add_vec scal_minus_vec scal_mult_vec vec_add_scal vec_add_vec vec_cross_vec vec_div_scal_int vec_div_scal_r4 vec_div_scal_r8 vec_dot_mat vec_dot_vec vec_equal_vec vec_minus_scal vec_minus_vec vec_mult_exp_scal_int vec_mult_exp_scal_r4 vec_mult_exp_scal_r8 vec_mult_scal vec_mult_vec Source Code vector Components Type Visibility Attributes Name Initial real(kind=wp), public :: x vector components real(kind=wp), public :: y vector components real(kind=wp), public :: z vector components Type-Bound Procedures procedure, public, :: length Returns the length of the vector public pure elemental function length (this) Returns the length of a vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: this Return Value real(kind=wp) procedure, public, :: magnitude Returns the magnitude of the vector public pure elemental function magnitude (this) Returns the magnitude of a vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: this Return Value type( vector ) generic, public, :: operator(*) => vec_mult_vec , vec_mult_scal , scal_mult_vec Overloads the Multiplication operator for vec3 private pure elemental function vec_mult_vec (a, b) vec3 * vec3 elementwise Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 type( vector ), intent(in) :: b vec3 to multiply by Return Value type( vector ) private pure elemental function vec_mult_scal (a, b) vec3 * scalar elementwise Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( vector ) private pure elemental function scal_mult_vec (a, b) Scalar * vec3 elementwise Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( vector ), intent(in) :: b input vec3 Return Value type( vector ) generic, public, :: operator(**) => vec_mult_exp_scal_int , vec_mult_exp_scal_r4 , vec_mult_exp_scal_r8 Overloads the exponential operator for vec3 private pure elemental function vec_mult_exp_scal_int (a, b) vec3**scalar for integer scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector integer, intent(in) :: b Input scalar Return Value type( vector ) private pure elemental function vec_mult_exp_scal_r4 (a, b) vec3**scalar for 32-bit float scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector real(kind=sp), intent(in) :: b Input scalar Return Value type( vector ) private pure elemental function vec_mult_exp_scal_r8 (a, b) vec3**scalar for 64-bit float scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector real(kind=dp), intent(in) :: b Input scalar Return Value type( vector ) generic, public, :: operator(+) => vec_add_vec , vec_add_scal , scal_add_vec Overloads the Addition operator for vec3 private pure elemental function vec_add_vec (a, b) vec3 + vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b Vec3 to add Return Value type( vector ) private pure elemental function vec_add_scal (a, b) vec3 + scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector real(kind=wp), intent(in) :: b Scalar to add Return Value type( vector ) private pure elemental function scal_add_vec (a, b) vec3 + scalar Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to add class( vector ), intent(in) :: b Input vector Return Value type( vector ) generic, public, :: operator(-) => vec_minus_vec , vec_minus_scal , scal_minus_vec Overloads the Subtraction operator for vec3 private pure elemental function vec_minus_vec (a, b) vec3 - vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b vec3 to subtract Return Value type( vector ) private pure elemental function vec_minus_scal (a, b) vec3 - scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( vector ) private pure elemental function scal_minus_vec (a, b) scalar - vec3 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to subtract from class( vector ), intent(in) :: b Input vector Return Value type( vector ) generic, public, :: operator(.cross.) => vec_cross_vec .cross. operator. Cross product private pure elemental function vec_cross_vec (a, b) result(cross) vec3 x vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b vec3 to cross with Return Value type( vector ) generic, public, :: operator(.dot.) => vec_dot_vec , vec_dot_mat .dot. operator. Dot product private pure elemental function vec_dot_vec (a, b) result(dot) vec3 . vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3 type( vector ), intent(in) :: b vec3 to dot Return Value real(kind=wp) private pure function vec_dot_mat (a, b) result(dot) vec3 . matrix Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3 real(kind=wp), intent(in) :: b (4,4) Matrix to dot with Return Value type( vector ) generic, public, :: operator(/) => vec_div_scal_r4 , vec_div_scal_r8 , vec_div_scal_int Overloads the Division operator for vec3 private pure elemental function vec_div_scal_r4 (a, b) vec3 / scalar elementwise. Scalar is a 32-bit float Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=sp), intent(in) :: b Scalar to divide by Return Value type( vector ) private pure elemental function vec_div_scal_r8 (a, b) vec3 / scalar elementwise. Scalar is a 64-bit float Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=dp), intent(in) :: b Scalar to divide by Return Value type( vector ) private pure elemental function vec_div_scal_int (a, b) vec3 / scalar elementwise. Scalar is an integer Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 integer, intent(in) :: b Scalar to divide by Return Value type( vector ) generic, public, :: operator(==) => vec_equal_vec Overloads the equal operator for vec3 private pure elemental function vec_equal_vec (a, b) vec3 == vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3s class( vector ), intent(in) :: b Input vec3s Return Value logical procedure, private, pass(b) :: scal_add_vec private pure elemental function scal_add_vec (a, b) vec3 + scalar Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to add class( vector ), intent(in) :: b Input vector Return Value type( vector ) procedure, private, pass(b) :: scal_minus_vec private pure elemental function scal_minus_vec (a, b) scalar - vec3 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to subtract from class( vector ), intent(in) :: b Input vector Return Value type( vector ) procedure, private, pass(b) :: scal_mult_vec private pure elemental function scal_mult_vec (a, b) Scalar * vec3 elementwise Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( vector ), intent(in) :: b input vec3 Return Value type( vector ) procedure, private, pass(a) :: vec_add_scal private pure elemental function vec_add_scal (a, b) vec3 + scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector real(kind=wp), intent(in) :: b Scalar to add Return Value type( vector ) procedure, private, pass(a) :: vec_add_vec private pure elemental function vec_add_vec (a, b) vec3 + vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b Vec3 to add Return Value type( vector ) procedure, private, pass(a) :: vec_cross_vec private pure elemental function vec_cross_vec (a, b) result(cross) vec3 x vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b vec3 to cross with Return Value type( vector ) procedure, private, pass(a) :: vec_div_scal_int private pure elemental function vec_div_scal_int (a, b) vec3 / scalar elementwise. Scalar is an integer Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 integer, intent(in) :: b Scalar to divide by Return Value type( vector ) procedure, private, pass(a) :: vec_div_scal_r4 private pure elemental function vec_div_scal_r4 (a, b) vec3 / scalar elementwise. Scalar is a 32-bit float Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=sp), intent(in) :: b Scalar to divide by Return Value type( vector ) procedure, private, pass(a) :: vec_div_scal_r8 private pure elemental function vec_div_scal_r8 (a, b) vec3 / scalar elementwise. Scalar is a 64-bit float Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=dp), intent(in) :: b Scalar to divide by Return Value type( vector ) procedure, private, pass(a) :: vec_dot_mat private pure function vec_dot_mat (a, b) result(dot) vec3 . matrix Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3 real(kind=wp), intent(in) :: b (4,4) Matrix to dot with Return Value type( vector ) procedure, private, pass(a) :: vec_dot_vec private pure elemental function vec_dot_vec (a, b) result(dot) vec3 . vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3 type( vector ), intent(in) :: b vec3 to dot Return Value real(kind=wp) procedure, private, pass(a) :: vec_equal_vec private pure elemental function vec_equal_vec (a, b) vec3 == vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3s class( vector ), intent(in) :: b Input vec3s Return Value logical procedure, private, pass(a) :: vec_minus_scal private pure elemental function vec_minus_scal (a, b) vec3 - scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( vector ) procedure, private, pass(a) :: vec_minus_vec private pure elemental function vec_minus_vec (a, b) vec3 - vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b vec3 to subtract Return Value type( vector ) procedure, private, pass(a) :: vec_mult_exp_scal_int private pure elemental function vec_mult_exp_scal_int (a, b) vec3**scalar for integer scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector integer, intent(in) :: b Input scalar Return Value type( vector ) procedure, private, pass(a) :: vec_mult_exp_scal_r4 private pure elemental function vec_mult_exp_scal_r4 (a, b) vec3**scalar for 32-bit float scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector real(kind=sp), intent(in) :: b Input scalar Return Value type( vector ) procedure, private, pass(a) :: vec_mult_exp_scal_r8 private pure elemental function vec_mult_exp_scal_r8 (a, b) vec3**scalar for 64-bit float scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector real(kind=dp), intent(in) :: b Input scalar Return Value type( vector ) procedure, private, pass(a) :: vec_mult_scal private pure elemental function vec_mult_scal (a, b) vec3 * scalar elementwise Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( vector ) procedure, private, pass(a) :: vec_mult_vec private pure elemental function vec_mult_vec (a, b) vec3 * vec3 elementwise Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 type( vector ), intent(in) :: b vec3 to multiply by Return Value type( vector ) Source Code type :: vector !> vector components real ( kind = wp ) :: x , y , z contains !> Returns the magnitude of the vector procedure :: magnitude => magnitude !> Returns the length of the vector procedure :: length => length !> .dot. operator. Dot product generic :: operator (. dot .) => vec_dot_vec , vec_dot_mat !> .cross. operator. Cross product generic :: operator (. cross .) => vec_cross_vec !> Overloads the Division operator for vec3 generic :: operator ( / ) => vec_div_scal_r4 , vec_div_scal_r8 , vec_div_scal_int !> Overloads the Multiplication operator for vec3 generic :: operator ( * ) => vec_mult_vec , vec_mult_scal , scal_mult_vec !> Overloads the exponential operator for vec3 generic :: operator ( ** ) => vec_mult_exp_scal_int , vec_mult_exp_scal_r4 , vec_mult_exp_scal_r8 !> Overloads the Addition operator for vec3 generic :: operator ( + ) => vec_add_vec , vec_add_scal , scal_add_vec !> Overloads the Subtraction operator for vec3 generic :: operator ( - ) => vec_minus_vec , vec_minus_scal , scal_minus_vec !> Overloads the equal operator for vec3 generic :: operator ( == ) => vec_equal_vec procedure , pass ( a ), private :: vec_dot_vec procedure , pass ( a ), private :: vec_dot_mat procedure , pass ( a ), private :: vec_cross_vec procedure , pass ( a ), private :: vec_div_scal_r4 procedure , pass ( a ), private :: vec_div_scal_r8 procedure , pass ( a ), private :: vec_div_scal_int procedure , pass ( a ), private :: vec_mult_vec procedure , pass ( a ), private :: vec_mult_scal procedure , pass ( b ), private :: scal_mult_vec procedure , pass ( a ), private :: vec_mult_exp_scal_int procedure , pass ( a ), private :: vec_mult_exp_scal_r4 procedure , pass ( a ), private :: vec_mult_exp_scal_r8 procedure , pass ( a ), private :: vec_add_vec procedure , pass ( a ), private :: vec_add_scal procedure , pass ( b ), private :: scal_add_vec procedure , pass ( a ), private :: vec_minus_vec procedure , pass ( a ), private :: vec_minus_scal procedure , pass ( b ), private :: scal_minus_vec procedure , pass ( a ), private :: vec_equal_vec end type vector","tags":"","loc":"type/vector.html"},{"title":"settings_t – signedMCRT ","text":"type, public :: settings_t Contents Variables absorb experiment grid historyFilename iseed nphotons outfile outfile_absorb overwrite render_geom render_size renderfile source tev trackHistory Source Code settings_t Components Type Visibility Attributes Name Initial logical, public :: absorb Boolean to indicate whether to store absoption data. character(len=:), public, allocatable :: experiment Name of experiment/simulation type( cart_grid ), public :: grid Cart_grid type character(len=:), public, allocatable :: historyFilename Name of photon history file integer, public :: iseed initial seed for random number generator integer, public :: nphotons Number of photons to run character(len=:), public, allocatable :: outfile Name of fluence output file character(len=:), public, allocatable :: outfile_absorb Name of absoprtion output file logical, public :: overwrite Boolean to indicate whether to use overwrite datafiles if they have the same name. logical, public :: render_geom Boolean to indicate whether to render SDF to voxels or not. integer, public :: render_size (3) Size of the voxel grid to render SDFs to character(len=:), public, allocatable :: renderfile Name of voxel render file character(len=:), public, allocatable :: source Light source used logical, public :: tev Boolean to indicate whether to use TEV as debug viewer. logical, public :: trackHistory Boolean to indicate whether to store history of photons positions Source Code type :: settings_t !> Number of photons to run integer :: nphotons !> initial seed for random number generator integer :: iseed !> Size of the voxel grid to render SDFs to integer :: render_size ( 3 ) !> Name of experiment/simulation character ( len = :), allocatable :: experiment !> Name of fluence output file character ( len = :), allocatable :: outfile !> Name of voxel render file character ( len = :), allocatable :: renderfile !> Light source used character ( len = :), allocatable :: source !> Name of photon history file character ( len = :), allocatable :: historyFilename !> Name of absoprtion output file character ( len = :), allocatable :: outfile_absorb !> Cart_grid type type ( cart_grid ) :: grid !> Boolean to indicate whether to render SDF to voxels or not. logical :: render_geom !> Boolean to indicate whether to use TEV as debug viewer. logical :: tev !> Boolean to indicate whether to use overwrite datafiles if they have the same name. logical :: overwrite !> Boolean to indicate whether to store history of photons positions logical :: trackHistory !> Boolean to indicate whether to store absoption data. logical :: absorb end type settings_t","tags":"","loc":"type/settings_t.html"},{"title":"seq – signedMCRT ","text":"type, public :: seq Sequence type for quasi-monte carlo Contents Variables base index Type-Bound Procedures next Source Code seq Components Type Visibility Attributes Name Initial integer, public :: base Base from which to calculate radical inverse from. integer, public :: index Current index to get value for. Type-Bound Procedures procedure, public, :: next private function next (this) result(res) Arguments Type Intent Optional Attributes Name class( seq ) :: this Return Value real(kind=wp) Source Code type :: seq !> Current index to get value for. integer :: index !> Base from which to calculate radical inverse from. integer :: base contains procedure :: next end type seq","tags":"","loc":"type/seq.html"},{"title":"vec4 – signedMCRT ","text":"type, public :: vec4 not fully implmented vec4 class Contents Variables p x y z Constructor vec4 Type-Bound Procedures length magnitude operator(*) operator(+) operator(-) operator(.dot.) operator(/) scal_add_vec scal_minus_vec scal_mult_vec vec_add_scal vec_add_vec vec_div_scal_int vec_div_scal_r4 vec_div_scal_r8 vec_dot_vec vec_minus_scal vec_minus_vec vec_mult_scal vec_mult_vec Source Code vec4 Components Type Visibility Attributes Name Initial real(kind=wp), public :: p vec4 components real(kind=wp), public :: x vec4 components real(kind=wp), public :: y vec4 components real(kind=wp), public :: z vec4 components Constructor public interface vec4 Initalise a vec4 from a vec3 and a scalar private function init_vec4_vector_real (vec, val) result(out) Initalise vec4 from a vec3 and Scalar\ne.g vec4 = [vec3%x, vec3%y, vec3%z, scalar] Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: vec Input vec3 real(kind=wp), intent(in) :: val Input Scalar Return Value type( vec4 ) Type-Bound Procedures procedure, public, :: length private pure elemental function length (this) Returns the length of a vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: this Return Value real(kind=wp) procedure, public, :: magnitude => magnitude_fn private pure elemental function magnitude_fn (this) Returns the magnitude of a vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: this Return Value type( vec4 ) generic, public, :: operator(*) => vec_mult_vec , vec_mult_scal , scal_mult_vec Overloaded Mulitiplication operator private pure elemental function vec_mult_vec (a, b) Elementwise vec4 * vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to multiply by Return Value type( vec4 ) private pure elemental function vec_mult_scal (a, b) Elementwise vec4 * Scalar Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( vec4 ) private pure elemental function scal_mult_vec (a, b) Elementwise Scalar * vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) generic, public, :: operator(+) => vec_add_vec , vec_add_scal , scal_add_vec Overloaded Addition operator private pure elemental function vec_add_vec (a, b) Elementwise vec4 + vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to add Return Value type( vec4 ) private pure elemental function vec_add_scal (a, b) Elementwise vec4 + scalar Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to add Return Value type( vec4 ) private pure elemental function scal_add_vec (a, b) Elementwise scalar + vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to add class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) generic, public, :: operator(-) => vec_minus_vec , vec_minus_scal , scal_minus_vec Overloaded Subtraction operator private pure elemental function vec_minus_vec (a, b) Elementwise vec4 - vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to subtract Return Value type( vec4 ) private pure elemental function vec_minus_scal (a, b) Elementwise vec4 - scalar Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( vec4 ) private pure elemental function scal_minus_vec (a, b) Elementwise Scalar - vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to subtract class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) generic, public, :: operator(.dot.) => vec_dot_vec .dot. operator private pure elemental function vec_dot_vec (a, b) result(dot) dot product between two vec4s Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to dot with Return Value real(kind=wp) generic, public, :: operator(/) => vec_div_scal_r4 , vec_div_scal_r8 , vec_div_scal_int Overloaded Division operator private pure elemental function vec_div_scal_r4 (a, b) Elementwise vec4 / Scalar. Scalar is 32-bit float Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=sp), intent(in) :: b Scalar to divide by Return Value type( vec4 ) private pure elemental function vec_div_scal_r8 (a, b) Elementwise vec4 / Scalar. Scalar is 32-bit float Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=dp), intent(in) :: b Scalar to divide by Return Value type( vec4 ) private pure elemental function vec_div_scal_int (a, b) Elementwise vec4 / Scalar. Scalar is an integer Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 integer, intent(in) :: b Scalar to divide by Return Value type( vec4 ) procedure, private, pass(b) :: scal_add_vec private pure elemental function scal_add_vec (a, b) Elementwise scalar + vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to add class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) procedure, private, pass(b) :: scal_minus_vec private pure elemental function scal_minus_vec (a, b) Elementwise Scalar - vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to subtract class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) procedure, private, pass(b) :: scal_mult_vec private pure elemental function scal_mult_vec (a, b) Elementwise Scalar * vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) procedure, private, pass(a) :: vec_add_scal private pure elemental function vec_add_scal (a, b) Elementwise vec4 + scalar Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to add Return Value type( vec4 ) procedure, private, pass(a) :: vec_add_vec private pure elemental function vec_add_vec (a, b) Elementwise vec4 + vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to add Return Value type( vec4 ) procedure, private, pass(a) :: vec_div_scal_int private pure elemental function vec_div_scal_int (a, b) Elementwise vec4 / Scalar. Scalar is an integer Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 integer, intent(in) :: b Scalar to divide by Return Value type( vec4 ) procedure, private, pass(a) :: vec_div_scal_r4 private pure elemental function vec_div_scal_r4 (a, b) Elementwise vec4 / Scalar. Scalar is 32-bit float Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=sp), intent(in) :: b Scalar to divide by Return Value type( vec4 ) procedure, private, pass(a) :: vec_div_scal_r8 private pure elemental function vec_div_scal_r8 (a, b) Elementwise vec4 / Scalar. Scalar is 32-bit float Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=dp), intent(in) :: b Scalar to divide by Return Value type( vec4 ) procedure, private, pass(a) :: vec_dot_vec private pure elemental function vec_dot_vec (a, b) result(dot) dot product between two vec4s Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to dot with Return Value real(kind=wp) procedure, private, pass(a) :: vec_minus_scal private pure elemental function vec_minus_scal (a, b) Elementwise vec4 - scalar Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( vec4 ) procedure, private, pass(a) :: vec_minus_vec private pure elemental function vec_minus_vec (a, b) Elementwise vec4 - vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to subtract Return Value type( vec4 ) procedure, private, pass(a) :: vec_mult_scal private pure elemental function vec_mult_scal (a, b) Elementwise vec4 * Scalar Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( vec4 ) procedure, private, pass(a) :: vec_mult_vec private pure elemental function vec_mult_vec (a, b) Elementwise vec4 * vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to multiply by Return Value type( vec4 ) Source Code type :: vec4 !> vec4 components real ( kind = wp ) :: x , y , z , p contains procedure :: magnitude => magnitude_fn procedure :: length => length !> .dot. operator generic :: operator (. dot .) => vec_dot_vec !> Overloaded Division operator generic :: operator ( / ) => vec_div_scal_r4 , vec_div_scal_r8 , vec_div_scal_int !> Overloaded Mulitiplication operator generic :: operator ( * ) => vec_mult_vec , vec_mult_scal , scal_mult_vec !> Overloaded Addition operator generic :: operator ( + ) => vec_add_vec , vec_add_scal , scal_add_vec !> Overloaded Subtraction operator generic :: operator ( - ) => vec_minus_vec , vec_minus_scal , scal_minus_vec procedure , pass ( a ), private :: vec_dot_vec procedure , pass ( a ), private :: vec_div_scal_r4 procedure , pass ( a ), private :: vec_div_scal_r8 procedure , pass ( a ), private :: vec_div_scal_int procedure , pass ( a ), private :: vec_mult_vec procedure , pass ( a ), private :: vec_mult_scal procedure , pass ( b ), private :: scal_mult_vec procedure , pass ( a ), private :: vec_add_vec procedure , pass ( a ), private :: vec_add_scal procedure , pass ( b ), private :: scal_add_vec procedure , pass ( a ), private :: vec_minus_vec procedure , pass ( a ), private :: vec_minus_scal procedure , pass ( b ), private :: scal_minus_vec end type vec4","tags":"","loc":"type/vec4.html"},{"title":"cart_grid – signedMCRT ","text":"type, public :: cart_grid Contents Variables delta nxg nyg nzg xface xmax yface ymax zface zmax Constructor cart_grid Type-Bound Procedures get_voxel Source Code cart_grid Components Type Visibility Attributes Name Initial real(kind=wp), public :: delta Delta is the round off for near voxel cell walls integer, public :: nxg number of voxels in each cardinal direction for fluence grid integer, public :: nyg number of voxels in each cardinal direction for fluence grid integer, public :: nzg number of voxels in each cardinal direction for fluence grid real(kind=wp), public, allocatable :: xface (:) position of each cell wall in fluence grid real(kind=wp), public :: xmax half size of each dimension in fluence grid. real(kind=wp), public, allocatable :: yface (:) position of each cell wall in fluence grid real(kind=wp), public :: ymax half size of each dimension in fluence grid. real(kind=wp), public, allocatable :: zface (:) position of each cell wall in fluence grid real(kind=wp), public :: zmax half size of each dimension in fluence grid. Constructor public interface cart_grid public function init_grid (nxg, nyg, nzg, xmax, ymax, zmax) setup grid Arguments Type Intent Optional Attributes Name integer, intent(in) :: nxg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nyg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nzg number of voxels in each cardinal direction for fluence grid real(kind=wp), intent(in) :: xmax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: ymax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: zmax half size of each dimension in fluence grid. Return Value type( cart_grid ) Type-Bound Procedures procedure, public, :: get_voxel private function get_voxel (this, pos) result(res) get current voxel the photon packet is in Arguments Type Intent Optional Attributes Name class( cart_grid ) :: this grid class type( vector ), intent(in) :: pos current vector position of photon packet Return Value integer, (3) Source Code type :: cart_grid !> number of voxels in each cardinal direction for fluence grid integer :: nxg , nyg , nzg !> half size of each dimension in fluence grid. real ( kind = wp ) :: xmax , ymax , zmax !> Delta is the round off for near voxel cell walls real ( kind = wp ) :: delta !> position of each cell wall in fluence grid real ( kind = wp ), allocatable :: xface (:), yface (:), zface (:) contains procedure :: get_voxel end type cart_grid","tags":"","loc":"type/cart_grid.html"},{"title":"mono – signedMCRT ","text":"type, public, extends( opticalProp_base ) :: mono Contents Variables albedo g2 hgg kappa mua mus n Constructor mono Type-Bound Procedures update Source Code mono Components Type Visibility Attributes Name Initial real(kind=wp), public :: albedo real(kind=wp), public :: g2 g factor squared real(kind=wp), public :: hgg g factor real(kind=wp), public :: kappa real(kind=wp), public :: mua absoprtion coeff. real(kind=wp), public :: mus scattering coeff. real(kind=wp), public :: n refractive index Constructor public interface mono private function init_mono (mus, mua, hgg, n) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: mus real(kind=wp), intent(in) :: mua real(kind=wp), intent(in) :: hgg real(kind=wp), intent(in) :: n Return Value type( mono ) Type-Bound Procedures procedure, public, :: update => updateMono private subroutine updateMono (this, wavelength) Arguments Type Intent Optional Attributes Name class( mono ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength Source Code type , extends ( opticalProp_base ) :: mono contains procedure :: update => updateMono end type mono","tags":"","loc":"type/mono.html"},{"title":"opticalProp_base – signedMCRT ","text":"type, public, abstract :: opticalProp_base Contents Variables albedo g2 hgg kappa mua mus n Type-Bound Procedures update Source Code opticalProp_base Components Type Visibility Attributes Name Initial real(kind=wp), public :: albedo real(kind=wp), public :: g2 g factor squared real(kind=wp), public :: hgg g factor real(kind=wp), public :: kappa real(kind=wp), public :: mua absoprtion coeff. real(kind=wp), public :: mus scattering coeff. real(kind=wp), public :: n refractive index Type-Bound Procedures procedure( updateInterface ), public, deferred :: update subroutine updateInterface(this, wavelength) Prototype Arguments Type Intent Optional Attributes Name class( opticalProp_base ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength Source Code type , abstract :: opticalProp_base !> scattering coeff. cm^{-1} real ( kind = wp ) :: mus !> absoprtion coeff. cm^{-1} real ( kind = wp ) :: mua !> g factor real ( kind = wp ) :: hgg !> g factor squared real ( kind = wp ) :: g2 !> refractive index real ( kind = wp ) :: n !> \\kappa = \\mu_s + \\mu_a real ( kind = wp ) :: kappa !> a = \\frac{\\mu_s}{\\mu_s + \\mu_a} real ( kind = wp ) :: albedo contains procedure ( updateInterface ), deferred :: update end type opticalProp_base","tags":"","loc":"type/opticalprop_base.html"},{"title":"opticalProp_t – signedMCRT ","text":"type, public, extends( opticalProp_base ) :: opticalProp_t Contents Variables albedo g2 hgg kappa mua mus n value Constructor opticalProp_t Type-Bound Procedures assignment(=) opticalProp_t_assign update Source Code opticalProp_t Components Type Visibility Attributes Name Initial real(kind=wp), public :: albedo real(kind=wp), public :: g2 g factor squared real(kind=wp), public :: hgg g factor real(kind=wp), public :: kappa real(kind=wp), public :: mua absoprtion coeff. real(kind=wp), public :: mus scattering coeff. real(kind=wp), public :: n refractive index class( opticalProp_base ), public, allocatable :: value Constructor public interface opticalProp_t private function opticaProp_new (rhs) result(lhs) Arguments Type Intent Optional Attributes Name class( opticalProp_base ), intent(in) :: rhs Return Value type( opticalProp_t ) Type-Bound Procedures generic, public, :: assignment(=) => opticalProp_t_assign private subroutine opticalProp_t_assign (lhs, rhs) Arguments Type Intent Optional Attributes Name class( opticalProp_t ), intent(inout) :: lhs class( opticalProp_base ), intent(in) :: rhs procedure, private :: opticalProp_t_assign private subroutine opticalProp_t_assign (lhs, rhs) Arguments Type Intent Optional Attributes Name class( opticalProp_t ), intent(inout) :: lhs class( opticalProp_base ), intent(in) :: rhs procedure, public, :: update => update_opticalProp_t private subroutine update_opticalProp_t (this, wavelength) Arguments Type Intent Optional Attributes Name class( opticalProp_t ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength Source Code type , extends ( opticalProp_base ) :: opticalProp_t class ( opticalProp_base ), allocatable :: value contains procedure :: update => update_opticalProp_t procedure , private :: opticalProp_t_assign generic :: assignment ( = ) => opticalProp_t_assign end type opticalProp_t","tags":"","loc":"type/opticalprop_t.html"},{"title":"spectral – signedMCRT ","text":"type, public, extends( opticalProp_base ) :: spectral Contents Variables albedo flux g2 hgg hgg_a kappa mua mua_a mus mus_a n n_a Constructor spectral Type-Bound Procedures update Source Code spectral Components Type Visibility Attributes Name Initial real(kind=wp), public :: albedo type( piecewise1D ), private :: flux real(kind=wp), public :: g2 g factor squared real(kind=wp), public :: hgg g factor type( piecewise1D ), private :: hgg_a real(kind=wp), public :: kappa real(kind=wp), public :: mua absoprtion coeff. type( piecewise1D ), private :: mua_a real(kind=wp), public :: mus scattering coeff. type( piecewise1D ), private :: mus_a real(kind=wp), public :: n refractive index type( piecewise1D ), private :: n_a Constructor public interface spectral private function init_spectral (mus, mua, hgg, n, flux) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), allocatable :: mus (:,:) real(kind=wp), intent(in), allocatable :: mua (:,:) real(kind=wp), intent(in), allocatable :: hgg (:,:) real(kind=wp), intent(in), allocatable :: n (:,:) real(kind=wp), intent(in), allocatable :: flux (:,:) Return Value type( spectral ) Type-Bound Procedures procedure, public, :: update => updateSpectral private subroutine updateSpectral (this, wavelength) Arguments Type Intent Optional Attributes Name class( spectral ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength Source Code type , extends ( opticalProp_base ) :: spectral type ( piecewise1D ), private :: mus_a , mua_a , hgg_a , n_a , flux contains procedure :: update => updateSpectral end type spectral","tags":"","loc":"type/spectral.html"},{"title":"constant – signedMCRT ","text":"type, public, extends( piecewise ) :: constant Constant piecewise type. i.e a piecewise function that does not change value Contents Variables value Type-Bound Procedures sample Source Code constant Components Type Visibility Attributes Name Initial real(kind=wp), public :: value The constant value Type-Bound Procedures procedure, public, :: sample => getValue Sampling routine public subroutine getValue (this, x, y, value) The constant version of sample Arguments Type Intent Optional Attributes Name class( constant ), intent(in) :: this real(kind=wp), intent(out) :: x Output value real(kind=wp), intent(out) :: y Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D real(kind=wp), intent(in), optional :: value Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D Source Code type , extends ( piecewise ) :: constant !> The constant value real ( kind = wp ) :: value contains !> Sampling routine procedure :: sample => getValue end type constant","tags":"","loc":"type/constant.html"},{"title":"piecewise – signedMCRT ","text":"type, public, abstract :: piecewise Abstract spectrum base type. Contents Type-Bound Procedures sample Source Code piecewise Type-Bound Procedures procedure( sampleInterface ), public, deferred :: sample Deferred procdure. Used to generate a sample from spectrum or get constant value etc. subroutine sampleInterface(this, x, y, value) Prototype Arguments Type Intent Optional Attributes Name class( piecewise ), intent(in) :: this real(kind=wp), intent(out) :: x real(kind=wp), intent(out) :: y real(kind=wp), intent(in), optional :: value Source Code type , abstract :: piecewise contains !> Deferred procdure. Used to generate a sample from spectrum or get constant value etc. procedure ( sampleInterface ), deferred :: sample end type piecewise","tags":"","loc":"type/piecewise.html"},{"title":"piecewise1D – signedMCRT ","text":"type, public, extends( piecewise ) :: piecewise1D 1D piecewise type. Used for the spectral type Contents Variables array cdf Constructor piecewise1D Type-Bound Procedures sample Source Code piecewise1D Components Type Visibility Attributes Name Initial real(kind=wp), public, allocatable :: array (:,:) Input array to sample from. Should be size(n, 2). 1st column is x-axis, 2nd column is y-axis real(kind=wp), public, allocatable :: cdf (:) cumulative distribution function (CDF) of array. Constructor public interface piecewise1D public function init_piecewise1D (array) result(res) initalise the piecewise1D type with an array size (n, 2). Calculates the CDF of this array.\nInput array Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:) Return Value type( piecewise1D ) Type-Bound Procedures procedure, public, :: sample => sample1D Overloaded sampling function public subroutine sample1D (this, x, y, value) Randomly sample from 1D array Arguments Type Intent Optional Attributes Name class( piecewise1D ), intent(in) :: this real(kind=wp), intent(out) :: x Return value real(kind=wp), intent(out) :: y Not used, but here so we can have same interface as 2D sample routine. real(kind=wp), intent(in), optional :: value Optional x value. If not present we generate a random one in the range [0., 1.] Source Code type , extends ( piecewise ) :: piecewise1D !> Input array to sample from. Should be size(n, 2). 1st column is x-axis, 2nd column is y-axis real ( kind = wp ), allocatable :: array (:, :) !> cumulative distribution function (CDF) of array. real ( kind = wp ), allocatable :: cdf (:) contains !> Overloaded sampling function procedure :: sample => sample1D end type piecewise1D","tags":"","loc":"type/piecewise1d.html"},{"title":"piecewise2D – signedMCRT ","text":"type, public, extends( piecewise ) :: piecewise2D 2D piecewise type. Used for images Contents Variables cdf cell_height cell_width xoffset yoffset Constructor piecewise2D Type-Bound Procedures sample Source Code piecewise2D Components Type Visibility Attributes Name Initial real(kind=wp), public, allocatable :: cdf (:) cumulative distribution function (CDF) of array. real(kind=wp), public :: cell_height Height of each cell real(kind=wp), public :: cell_width Width of each cell integer, private :: xoffset Offsets integer, private :: yoffset Offsets Constructor public interface piecewise2D public function init_piecewise2D (cell_width, cell_height, image) Initalise the piecewise2D type with a given cell_width, cell_height and input image Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: cell_width Input cell width real(kind=wp), intent(in) :: cell_height Input cell height real(kind=wp), intent(in) :: image (:,:) Input image Return Value type( piecewise2D ) Type-Bound Procedures procedure, public, :: sample => sample2D Overloaded sampling function public subroutine sample2D (this, x, y, value) Arguments Type Intent Optional Attributes Name class( piecewise2D ), intent(in) :: this real(kind=wp), intent(out) :: x real(kind=wp), intent(out) :: y real(kind=wp), intent(in), optional :: value Source Code type , extends ( piecewise ) :: piecewise2D !> Height of each cell real ( kind = wp ) :: cell_height !> Width of each cell real ( kind = wp ) :: cell_width !>cumulative distribution function (CDF) of array. real ( kind = wp ), allocatable :: cdf (:) !> Offsets integer , private :: xoffset , yoffset contains !> Overloaded sampling function procedure :: sample => sample2D end type piecewise2D","tags":"","loc":"type/piecewise2d.html"},{"title":"spectrum_t – signedMCRT ","text":"type, public :: spectrum_t Spectrum_t type. Used as a container type Contents Variables p Source Code spectrum_t Components Type Visibility Attributes Name Initial class( piecewise ), public, pointer :: p => null() Source Code type :: spectrum_t class ( piecewise ), pointer :: p => null () end type spectrum_t","tags":"","loc":"type/spectrum_t.html"},{"title":"annulus_dect – signedMCRT ","text":"type, public, extends( detector1D ) :: annulus_dect Annuluar detector Contents Variables bin_wid data dir layer nbins pos r1 r2 trackHistory Constructor annulus_dect Type-Bound Procedures check_hit record_hit Source Code annulus_dect Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid Bin width real(kind=wp), public, allocatable :: data (:) Bins type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector integer, public :: nbins Number of bins type( vector ), public :: pos position of the detector real(kind=wp), public :: r1 Inner radius real(kind=wp), public :: r2 Outer radius logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Constructor public interface annulus_dect private function init_annulus_dect (pos, dir, layer, r1, r2, nbins, maxval, trackHistory) result(out) Initalise Annular detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: r1 Inner radius real(kind=wp), intent(in) :: r2 Outer radius integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( annulus_dect ) Type-Bound Procedures procedure, public, :: check_hit => check_hit_annulus private function check_hit_annulus (this, hitpoint) Check if a hitpoint is in the annulus Arguments Type Intent Optional Attributes Name class( annulus_dect ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Hitpoint to check Return Value logical procedure, public, :: record_hit => record_hit_1D_sub private subroutine record_hit_1D_sub (this, hitpoint, history) check if a hit is on the detector and record it if so Arguments Type Intent Optional Attributes Name class( detector1D ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Interaction information type( history_stack_t ), intent(inout) :: history Photon packet history Source Code type , extends ( detector1D ) :: annulus_dect !> Inner radius real ( kind = wp ) :: r1 !> Outer radius real ( kind = wp ) :: r2 contains procedure :: check_hit => check_hit_annulus end type annulus_dect","tags":"","loc":"type/annulus_dect.html"},{"title":"camera – signedMCRT ","text":"type, public, extends( detector2D ) :: camera Rectangular or \"camera\" detector Contents Variables bin_wid_x bin_wid_y data dir e1 e2 height layer n nbinsX nbinsY p2 p3 pos trackHistory width Constructor camera Type-Bound Procedures check_hit record_hit Source Code camera Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid_x Bin width in the x dimension real(kind=wp), public :: bin_wid_y Bin width in the y dimension real(kind=wp), public, allocatable :: data (:,:) Bins type( vector ), public :: dir Surface normal of the detector type( vector ), public :: e1 Edge vector of detector type( vector ), public :: e2 Edge vector of detector real(kind=wp), public :: height Height of the detector integer, public :: layer Layer ID of the detector type( vector ), public :: n Normal of the detector integer, public :: nbinsX Number of bins in x dimension (detector space) integer, public :: nbinsY Number of bins in y dimension (detector space) type( vector ), public :: p2 Vector from pos (1st corner) to the 2nd corner of the detector type( vector ), public :: p3 Vector from pos (1st corner) to the 3rd corner of the detector type( vector ), public :: pos position of the detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. real(kind=wp), public :: width Width of the detector Constructor public interface camera private function init_camera (p1, p2, p3, layer, nbins, maxval, trackHistory) result(out) Initalise Camera detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: p1 Position of the 1st corner of the detector type( vector ), intent(in) :: p2 Distance from p1 to the 2nd corner type( vector ), intent(in) :: p3 Distance from p1 to the 3rd corner integer, intent(in) :: layer Layer ID integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( camera ) Type-Bound Procedures procedure, public, :: check_hit => check_hit_camera private function check_hit_camera (this, hitpoint) Check if a hitpoint is in the camera detector ref Arguments Type Intent Optional Attributes Name class( camera ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Hitpoint to check Return Value logical procedure, public, :: record_hit => record_hit_2D_sub private subroutine record_hit_2D_sub (this, hitpoint, history) check if a hit is on the detector and record it if so Arguments Type Intent Optional Attributes Name class( detector2D ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Interaction information type( history_stack_t ), intent(inout) :: history Photon packet history Source Code type , extends ( detector2D ) :: camera !> Normal of the detector type ( vector ) :: n !> Vector from pos (1st corner) to the 2nd corner of the detector type ( vector ) :: p2 !> Vector from pos (1st corner) to the 3rd corner of the detector type ( vector ) :: p3 !> Edge vector of detector type ( vector ) :: e1 !> Edge vector of detector type ( vector ) :: e2 !> Width of the detector real ( kind = wp ) :: width !> Height of the detector real ( kind = wp ) :: height contains procedure :: check_hit => check_hit_camera end type camera","tags":"","loc":"type/camera.html"},{"title":"circle_dect – signedMCRT ","text":"type, public, extends( detector1D ) :: circle_dect Circle detector Contents Variables bin_wid data dir layer nbins pos radius trackHistory Constructor circle_dect Type-Bound Procedures check_hit record_hit Source Code circle_dect Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid Bin width real(kind=wp), public, allocatable :: data (:) Bins type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector integer, public :: nbins Number of bins type( vector ), public :: pos position of the detector real(kind=wp), public :: radius Radius of detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Constructor public interface circle_dect private function init_circle_dect (pos, dir, layer, radius, nbins, maxval, trackHistory) result(out) Initalise Circle detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: radius Radius of the detector integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( circle_dect ) Type-Bound Procedures procedure, public, :: check_hit => check_hit_circle private function check_hit_circle (this, hitpoint) Check if a hitpoint is in the circle Arguments Type Intent Optional Attributes Name class( circle_dect ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Hitpoint to check Return Value logical procedure, public, :: record_hit => record_hit_1D_sub private subroutine record_hit_1D_sub (this, hitpoint, history) check if a hit is on the detector and record it if so Arguments Type Intent Optional Attributes Name class( detector1D ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Interaction information type( history_stack_t ), intent(inout) :: history Photon packet history Source Code type , extends ( detector1D ) :: circle_dect !> Radius of detector real ( kind = wp ) :: radius contains procedure :: check_hit => check_hit_circle end type circle_dect","tags":"","loc":"type/circle_dect.html"},{"title":"dect_array – signedMCRT ","text":"type, public :: dect_array Detector array Contents Variables p Source Code dect_array Components Type Visibility Attributes Name Initial class( detector ), public, pointer :: p => null() Source Code type :: dect_array class ( detector ), pointer :: p => null () end type dect_array","tags":"","loc":"type/dect_array.html"},{"title":"detector – signedMCRT ","text":"type, public, abstract :: detector abstract detector Contents Variables dir layer pos trackHistory Type-Bound Procedures check_hit record_hit Source Code detector Components Type Visibility Attributes Name Initial type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector type( vector ), public :: pos position of the detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Type-Bound Procedures procedure( checkHitInterface ), public, deferred :: check_hit function checkHitInterface(this, hitpoint) Prototype Arguments Type Intent Optional Attributes Name class( detector ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Return Value logical procedure( recordHitInterface ), public, deferred :: record_hit subroutine recordHitInterface(this, hitpoint, history) Prototype Arguments Type Intent Optional Attributes Name class( detector ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint type( history_stack_t ), intent(inout) :: history Source Code type , abstract :: detector !> position of the detector type ( vector ) :: pos !> Surface normal of the detector type ( vector ) :: dir !> Layer ID of the detector integer :: layer !> Boolean, if true store the history of the photon prior to detection. logical :: trackHistory contains procedure ( recordHitInterface ), deferred , public :: record_hit procedure ( checkHitInterface ), deferred , public :: check_hit end type detector","tags":"","loc":"type/detector.html"},{"title":"detector1D – signedMCRT ","text":"type, public, abstract, extends( detector ) :: detector1D 1D detector type. Records linear information Contents Variables bin_wid data dir layer nbins pos trackHistory Type-Bound Procedures check_hit record_hit Source Code detector1D Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid Bin width real(kind=wp), public, allocatable :: data (:) Bins type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector integer, public :: nbins Number of bins type( vector ), public :: pos position of the detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Type-Bound Procedures procedure( checkHitInterface ), public, deferred :: check_hit function checkHitInterface(this, hitpoint) Prototype Arguments Type Intent Optional Attributes Name class( detector ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Return Value logical procedure, public, :: record_hit => record_hit_1D_sub private subroutine record_hit_1D_sub (this, hitpoint, history) check if a hit is on the detector and record it if so Arguments Type Intent Optional Attributes Name class( detector1D ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Interaction information type( history_stack_t ), intent(inout) :: history Photon packet history Source Code type , abstract , extends ( detector ) :: detector1D !> Number of bins integer :: nbins !> Bin width real ( kind = wp ) :: bin_wid !> Bins real ( kind = wp ), allocatable :: data (:) contains procedure :: record_hit => record_hit_1D_sub end type detector1D","tags":"","loc":"type/detector1d.html"},{"title":"detector2D – signedMCRT ","text":"type, public, abstract, extends( detector ) :: detector2D 2D detecctor type. Records spatial information Contents Variables bin_wid_x bin_wid_y data dir layer nbinsX nbinsY pos trackHistory Type-Bound Procedures check_hit record_hit Source Code detector2D Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid_x Bin width in the x dimension real(kind=wp), public :: bin_wid_y Bin width in the y dimension real(kind=wp), public, allocatable :: data (:,:) Bins type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector integer, public :: nbinsX Number of bins in x dimension (detector space) integer, public :: nbinsY Number of bins in y dimension (detector space) type( vector ), public :: pos position of the detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Type-Bound Procedures procedure( checkHitInterface ), public, deferred :: check_hit function checkHitInterface(this, hitpoint) Prototype Arguments Type Intent Optional Attributes Name class( detector ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Return Value logical procedure, public, :: record_hit => record_hit_2D_sub private subroutine record_hit_2D_sub (this, hitpoint, history) check if a hit is on the detector and record it if so Arguments Type Intent Optional Attributes Name class( detector2D ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Interaction information type( history_stack_t ), intent(inout) :: history Photon packet history Source Code type , abstract , extends ( detector ) :: detector2D !> Number of bins in x dimension (detector space) integer :: nbinsX !> Number of bins in y dimension (detector space) integer :: nbinsY !> Bin width in the x dimension real ( kind = wp ) :: bin_wid_x !> Bin width in the y dimension real ( kind = wp ) :: bin_wid_y !> Bins real ( kind = wp ), allocatable :: data (:,:) contains procedure :: record_hit => record_hit_2D_sub end type detector2D","tags":"","loc":"type/detector2d.html"},{"title":"hit_t – signedMCRT ","text":"type, public :: hit_t Hit type, which records possible interaction information Contents Variables dir layer pos value Constructor hit_t Source Code hit_t Components Type Visibility Attributes Name Initial type( vector ), public :: dir Direction the photon came from integer, public :: layer Layer ID of interaction type( vector ), public :: pos Poition of the interaction real(kind=wp), public :: value Value to deposit Constructor public interface hit_t private function hit_init (val) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val Return Value type( hit_t ) Source Code type :: hit_t !> Poition of the interaction type ( vector ) :: pos !> Direction the photon came from type ( vector ) :: dir !> Value to deposit real ( kind = wp ) :: value !> Layer ID of interaction integer :: layer end type hit_t","tags":"","loc":"type/hit_t.html"},{"title":"box – signedMCRT ","text":"type, public, extends( sdf_base ) :: box Box SDF Contents Variables layer lengths optProps transform Constructor box Type-Bound Procedures evaluate Source Code box Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( vector ), public :: lengths Length of each dimension of the box type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface box Interface to box SDF initialising function private function box_init (lengths, optProp, layer, transform) result(out) Initalising function for Box SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: lengths Lengths of each dimension of the box type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( box ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_box private pure elemental function evaluate_box (this, pos) result(res) Evaluation function for Box SDF. Arguments Type Intent Optional Attributes Name class( box ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: box !> Length of each dimension of the box type ( vector ) :: lengths contains procedure :: evaluate => evaluate_box end type box","tags":"","loc":"type/box.html"},{"title":"capsule – signedMCRT ","text":"type, public, extends( sdf_base ) :: capsule Capsule SDF Contents Variables a b layer optProps r transform Constructor capsule Type-Bound Procedures evaluate Source Code capsule Components Type Visibility Attributes Name Initial type( vector ), public :: a type( vector ), public :: b integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: r real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface capsule Interface to capsule SDF initialising function private function capsule_init (a, b, r, optProp, layer, transform) result(out) Initalising function for capsule SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Capsule startpoint type( vector ), intent(in) :: b Capsule endpoint real(kind=wp), intent(in) :: r Capsule radius type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( capsule ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_capsule private pure elemental function evaluate_capsule (this, pos) result(res) Evaluation function for Capsule SDF. Arguments Type Intent Optional Attributes Name class( capsule ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: capsule type ( vector ) :: a , b real ( kind = wp ) :: r contains procedure :: evaluate => evaluate_capsule end type capsule","tags":"","loc":"type/capsule.html"},{"title":"cone – signedMCRT ","text":"type, public, extends( sdf_base ) :: cone Cone SDF Contents Variables a b layer optProps ra rb transform Constructor cone Type-Bound Procedures evaluate Source Code cone Components Type Visibility Attributes Name Initial type( vector ), public :: a type( vector ), public :: b integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: ra real(kind=wp), public :: rb real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface cone Interface to cone SDF initialising function private function cone_init (a, b, ra, rb, optProp, layer, transform) result(out) Initalising function for Capped Cone SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Centre of base of Cone type( vector ), intent(in) :: b Tip of cone real(kind=wp), intent(in) :: ra Radius of Cones base real(kind=wp), intent(in) :: rb Radius of Cones tip. For rb = 0.0 get normal uncapped cone. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cone ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_cone private pure elemental function evaluate_cone (this, pos) result(res) Evaluation function for Cone SDF. Arguments Type Intent Optional Attributes Name class( cone ), intent(in) :: this type( vector ), intent(in) :: pos Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: cone type ( vector ) :: a , b real ( kind = wp ) :: ra , rb contains procedure :: evaluate => evaluate_cone end type cone","tags":"","loc":"type/cone.html"},{"title":"cylinder – signedMCRT ","text":"type, public, extends( sdf_base ) :: cylinder Cylinder SDF Contents Variables a b layer optProps radius transform Constructor cylinder Type-Bound Procedures evaluate Source Code cylinder Components Type Visibility Attributes Name Initial type( vector ), public :: a type( vector ), public :: b integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: radius real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface cylinder Interface to cylinder SDF initialising function private function cylinder_init (a, b, radius, optProp, layer, transform) result(out) Initalising function for Cylinder SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Vector position at centre of the bottom circle type( vector ), intent(in) :: b Vector position at centre of the top circle real(kind=wp), intent(in) :: radius Radius of cylinder type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cylinder ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_cylinder private pure elemental function evaluate_cylinder (this, pos) result(res) Evaluation function for Cylinder SDF. Arguments Type Intent Optional Attributes Name class( cylinder ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: cylinder real ( kind = wp ) :: radius type ( vector ) :: a , b contains procedure :: evaluate => evaluate_cylinder end type cylinder","tags":"","loc":"type/cylinder.html"},{"title":"egg – signedMCRT ","text":"type, public, extends( sdf_base ) :: egg Egg SDF Contents Variables h layer optProps r1 r2 transform Constructor egg Type-Bound Procedures evaluate Source Code egg Components Type Visibility Attributes Name Initial real(kind=wp), public :: h integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: r1 real(kind=wp), public :: r2 real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface egg Interface to egg SDF initialising function private function egg_init (r1, r2, h, optProp, layer, transform) result(out) Initalising function for egg SDF.\nmakes a Moss egg. ref . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: r1 R1 controls \"fatness\" of the egg. Actually controls the base circle radius. real(kind=wp), intent(in) :: r2 R2 contorls the pointiness of the egg. Actually controls radius of top circle. real(kind=wp), intent(in) :: h h controls the height of the egg. Actually controls y position of top circle. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( egg ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_egg private pure elemental function evaluate_egg (this, pos) result(res) Evaluation function for Egg SDF. ref Arguments Type Intent Optional Attributes Name class( egg ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: egg real ( kind = wp ) :: r1 , r2 , h contains procedure :: evaluate => evaluate_egg end type egg","tags":"","loc":"type/egg.html"},{"title":"plane – signedMCRT ","text":"type, public, extends( sdf_base ) :: plane Plane SDF Contents Variables a layer optProps transform Constructor plane Type-Bound Procedures evaluate Source Code plane Components Type Visibility Attributes Name Initial type( vector ), public :: a integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface plane Interface to plane SDF initialising function private function plane_init (a, optProp, layer, transform) result(out) Initalising function for plane SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Plane normal. must be normalised type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( plane ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_plane private pure elemental function evaluate_plane (this, pos) result(res) Evaluation function for Plane SDF. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: plane type ( vector ) :: a contains procedure :: evaluate => evaluate_plane end type plane","tags":"","loc":"type/plane.html"},{"title":"segment – signedMCRT ","text":"type, public, extends( sdf_base ) :: segment Segment SDF (2D) Contents Variables a b layer optProps transform Constructor segment Type-Bound Procedures evaluate Source Code segment Components Type Visibility Attributes Name Initial type( vector ), public :: a type( vector ), public :: b integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface segment Interface to segment SDF initialising function private function segment_init (a, b, optProp, layer, transform) result(out) Initalising function for segment SDF.\nNote this is a 2D function Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a segment start point type( vector ), intent(in) :: b segment end point type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( segment ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_segment private pure elemental function evaluate_segment (this, pos) result(res) Evaluation function for Segment SDF. Arguments Type Intent Optional Attributes Name class( segment ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: segment type ( vector ) :: a , b contains procedure :: evaluate => evaluate_segment end type segment","tags":"","loc":"type/segment.html"},{"title":"sphere – signedMCRT ","text":"type, public, extends( sdf_base ) :: sphere Sphere SDF Contents Variables layer optProps radius transform Constructor sphere Type-Bound Procedures evaluate Source Code sphere Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: radius real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface sphere private function sphere_init (radius, optProp, layer, transform) result(out) Initalising function for Sphere SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: radius radius of the Sphere type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( sphere ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_sphere private pure elemental function evaluate_sphere (this, pos) result(res) Evaluation function for Sphere SDF. Arguments Type Intent Optional Attributes Name class( sphere ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: sphere real ( kind = wp ) :: radius contains procedure :: evaluate => evaluate_sphere end type sphere","tags":"","loc":"type/sphere.html"},{"title":"torus – signedMCRT ","text":"type, public, extends( sdf_base ) :: torus Torus SDF Contents Variables iradius layer optProps oradius transform Constructor torus Type-Bound Procedures evaluate Source Code torus Components Type Visibility Attributes Name Initial real(kind=wp), public :: iradius integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: oradius real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface torus Interface to torus SDF initialising function private function torus_init (oradius, iradius, optProp, layer, transform) result(out) Initalising function for Torus SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: oradius Outer radius of Torus real(kind=wp), intent(in) :: iradius Inner radius of Torus type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( torus ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_torus private pure elemental function evaluate_torus (this, pos) result(res) Evaluation function for Torus SDF. Arguments Type Intent Optional Attributes Name class( torus ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: torus real ( kind = wp ) :: oradius , iradius contains procedure :: evaluate => evaluate_torus end type torus","tags":"","loc":"type/torus.html"},{"title":"triprism – signedMCRT ","text":"type, public, extends( sdf_base ) :: triprism Triprisim SDF Contents Variables h1 h2 layer optProps transform Constructor triprism Type-Bound Procedures evaluate Source Code triprism Components Type Visibility Attributes Name Initial real(kind=wp), public :: h1 real(kind=wp), public :: h2 integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface triprism Interface to triprisim SDF initialising function private function triprism_init (h1, h2, optProp, layer, transform) result(out) Initalising function for triprisim SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: h1 Height of triprisim real(kind=wp), intent(in) :: h2 length of triprisim type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( triprism ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_triprism private pure elemental function evaluate_triprism (this, pos) result(res) Evaluation function for Triprisim SDF. Arguments Type Intent Optional Attributes Name class( triprism ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: triprism real ( kind = wp ) :: h1 , h2 contains procedure :: evaluate => evaluate_triprism end type triprism","tags":"","loc":"type/triprism.html"},{"title":"bend – signedMCRT ","text":"type, public, extends( sdf_base ) :: bend Bend a SDF. Contents Variables k layer optProps prim transform Constructor bend Type-Bound Procedures evaluate Source Code bend Components Type Visibility Attributes Name Initial real(kind=wp), public :: k integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface bend private function bend_init (prim, k) result(out) Initialise the Bend modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: k Amoun to bend by. Return Value type( bend ) Type-Bound Procedures procedure, public, :: evaluate => eval_bend private pure elemental function eval_bend (this, pos) result(res) Evaluation function for Bend modifier. Arguments Type Intent Optional Attributes Name class( bend ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: bend real ( kind = wp ) :: k class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_bend end type bend","tags":"","loc":"type/bend.html"},{"title":"displacement – signedMCRT ","text":"type, public, extends( sdf_base ) :: displacement Displace the surface of a SDF by a function. Contents Variables func layer optProps prim transform Constructor displacement Type-Bound Procedures evaluate Source Code displacement Components Type Visibility Attributes Name Initial procedure( primitive ), public, nopass, pointer :: func integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface displacement private function displacement_init (prim, func) result(out) Initialise the displacement modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify procedure( primitive ) :: func Function to displace the SDF with. Return Value type( displacement ) Type-Bound Procedures procedure, public, :: evaluate => eval_disp private pure elemental function eval_disp (this, pos) result(res) Evaluation function for displacement modifier. Arguments Type Intent Optional Attributes Name class( displacement ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: displacement procedure ( primitive ), nopass , pointer :: func class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_disp end type displacement","tags":"","loc":"type/displacement.html"},{"title":"elongate – signedMCRT ","text":"type, public, extends( sdf_base ) :: elongate Elongate a SDF Contents Variables layer optProps prim size transform Constructor elongate Type-Bound Procedures evaluate Source Code elongate Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim type( vector ), public :: size real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface elongate private function elongate_init (prim, size) result(out) Initialise the elongate modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify type( vector ), intent(in) :: size Distance to elongate by Return Value type( elongate ) Type-Bound Procedures procedure, public, :: evaluate => eval_elongate private pure elemental function eval_elongate (this, pos) result(res) Evaluation function for Elongate modifier. Arguments Type Intent Optional Attributes Name class( elongate ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: elongate type ( vector ) :: size class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_elongate end type elongate","tags":"","loc":"type/elongate.html"},{"title":"extrude – signedMCRT ","text":"type, public, extends( sdf_base ) :: extrude Extrude a 2D SDF into 3D Contents Variables h layer optProps prim transform Constructor extrude Type-Bound Procedures evaluate Source Code extrude Components Type Visibility Attributes Name Initial real(kind=wp), public :: h integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface extrude private function extrude_init (prim, h) result(out) Initialise the extrude modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: h Distance to extrude by. Return Value type( extrude ) Type-Bound Procedures procedure, public, :: evaluate => eval_extrude private pure elemental function eval_extrude (this, pos) result(res) Evaluation function for Extrude modifier. Arguments Type Intent Optional Attributes Name class( extrude ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: extrude real ( kind = wp ) :: h class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_extrude end type extrude","tags":"","loc":"type/extrude.html"},{"title":"onion – signedMCRT ","text":"type, public, extends( sdf_base ) :: onion Carves or gives thickness to SDFs Contents Variables layer optProps prim thickness transform Constructor onion Type-Bound Procedures evaluate Source Code onion Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: thickness real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface onion private function onion_init (prim, thickness) result(out) Initialise the Onion modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: thickness Thickned to onion by. Return Value type( onion ) Type-Bound Procedures procedure, public, :: evaluate => eval_onion private pure elemental function eval_onion (this, pos) result(res) Evaluation function for Onion modifier. Arguments Type Intent Optional Attributes Name class( onion ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: onion real ( kind = wp ) :: thickness class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_onion end type onion","tags":"","loc":"type/onion.html"},{"title":"repeat – signedMCRT ","text":"type, public, extends( sdf_base ) :: repeat Repeat a SDF Contents Variables c la layer lb optProps prim transform Constructor repeat Type-Bound Procedures evaluate Source Code repeat Components Type Visibility Attributes Name Initial real(kind=wp), public :: c type( vector ), public :: la integer, public :: layer Layer ID of SDF type( vector ), public :: lb type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface repeat private function repeat_init (prim, c, la, lb) result(out) Initialise the Repeat modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: c type( vector ), intent(in) :: la type( vector ), intent(in) :: lb Return Value type( repeat ) Type-Bound Procedures procedure, public, :: evaluate => eval_repeat private pure elemental function eval_repeat (this, pos) result(res) Evaluation function for Repeat modifier. Arguments Type Intent Optional Attributes Name class( repeat ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: repeat real ( kind = wp ) :: c type ( vector ) :: la , lb class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_repeat end type repeat","tags":"","loc":"type/repeat.html"},{"title":"revolution – signedMCRT ","text":"type, public, extends( sdf_base ) :: revolution Revoloution modifier. Revolves an SDF around the z axis (need to check this!!) Contents Variables layer o optProps prim transform Constructor revolution Type-Bound Procedures evaluate Source Code revolution Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF real(kind=wp), public :: o type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface revolution private function revolution_init (prim, o) result(out) Initialise the Revolution modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: o Amount to revolve by. Return Value type( revolution ) Type-Bound Procedures procedure, public, :: evaluate => eval_revolution private pure elemental function eval_revolution (this, pos) result(res) Evaluation function for Revolution modifier. Arguments Type Intent Optional Attributes Name class( revolution ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: revolution real ( kind = wp ) :: o class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_revolution end type revolution","tags":"","loc":"type/revolution.html"},{"title":"twist – signedMCRT ","text":"type, public, extends( sdf_base ) :: twist Twist a SDF Contents Variables k layer optProps prim transform Constructor twist Type-Bound Procedures evaluate Source Code twist Components Type Visibility Attributes Name Initial real(kind=wp), public :: k integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface twist private function twist_init (prim, k) result(out) Initialise the twist modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real, intent(in) :: k Twist parameter. Return Value type( twist ) Type-Bound Procedures procedure, public, :: evaluate => eval_twist private pure elemental function eval_twist (this, pos) result(res) Evaluation function for Twist modifier. Arguments Type Intent Optional Attributes Name class( twist ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: twist real ( kind = wp ) :: k class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_twist end type twist","tags":"","loc":"type/twist.html"},{"title":"model – signedMCRT ","text":"type, public, extends( sdf_base ) :: model Model type. Allows the collection of multiple SDF into one model. Used to apply modifiers. Contents Variables array func k layer optProps transform Constructor model Type-Bound Procedures evaluate Source Code model Components Type Visibility Attributes Name Initial type( sdf ), public, allocatable :: array (:) Array of SDFs in the model procedure( op ), public, nopass, pointer :: func SDF modifier function real(kind=wp), public :: k Parameter that may be used in modifer function. integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface model private function model_init (array, func, kopt) result(out) Initalise the model type. Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: array (:) Array of SDFs procedure( op ) :: func Operator to apply to SDF. real(kind=wp), intent(in), optional :: kopt Parameter used in modifier Return Value type( model ) Type-Bound Procedures procedure, public, :: evaluate => eval_model private pure elemental function eval_model (this, pos) result(res) Evaluate the model Arguments Type Intent Optional Attributes Name class( model ), intent(in) :: this type( vector ), intent(in) :: pos Vector position to evaluate at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: model !> Array of SDFs in the model type ( sdf ), allocatable :: array (:) !> SDF modifier function procedure ( op ), nopass , pointer :: func !> Parameter that may be used in modifer function. real ( kind = wp ) :: k contains procedure :: evaluate => eval_model end type model","tags":"","loc":"type/model.html"},{"title":"sdf – signedMCRT ","text":"type, public, extends( sdf_base ) :: sdf Container type that allows the use of arrays of different SDF shapes Contents Variables layer optProps transform value Constructor sdf Type-Bound Procedures assignment(=) evaluate getAlbedo getG2 getKappa getMua getN gethgg sdf_assign Source Code sdf Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. class( sdf_base ), public, allocatable :: value Container for any SDF that inherits from SDF_base Constructor public interface sdf private function sdf_new (rhs) result(lhs) sdf initializer Arguments Type Intent Optional Attributes Name class( sdf_base ), intent(in) :: rhs Return Value type( sdf ) Type-Bound Procedures generic, public, :: assignment(=) => sdf_assign private subroutine sdf_assign (lhs, rhs) sdf initializer Arguments Type Intent Optional Attributes Name class( sdf ), intent(inout) :: lhs class( sdf_base ), intent(in) :: rhs procedure, public, :: evaluate => sdf_evaluate private pure elemental function sdf_evaluate (this, pos) result(res) Evaluate the SDF at a given position. Arguments Type Intent Optional Attributes Name class( sdf ), intent(in) :: this type( vector ), intent(in) :: pos Return Value real(kind=wp) procedure, public, :: getAlbedo private function getAlbedo (this) result(res) Return albedo for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) procedure, public, :: getG2 => getg2 private function getg2 (this) result(res) Return factor for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) procedure, public, :: getKappa private function getKappa (this) result(res) Return for the current SDF Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) procedure, public, :: getMua private function getMua (this) result(res) Return for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) procedure, public, :: getN private function getN (this) result(res) Return refractive index for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) procedure, public, :: gethgg private function gethgg (this) result(res) Return g-factor for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) procedure, private :: sdf_assign private subroutine sdf_assign (lhs, rhs) sdf initializer Arguments Type Intent Optional Attributes Name class( sdf ), intent(inout) :: lhs class( sdf_base ), intent(in) :: rhs Source Code type , extends ( sdf_base ) :: sdf !> Container for any SDF that inherits from SDF_base class ( sdf_base ), allocatable :: value contains procedure :: getKappa procedure :: getAlbedo procedure :: getMua , gethgg , getG2 , getN procedure :: evaluate => sdf_evaluate procedure , private :: sdf_assign generic :: assignment ( = ) => sdf_assign end type sdf","tags":"","loc":"type/sdf.html"},{"title":"sdf_base – signedMCRT ","text":"type, public, abstract :: sdf_base Abstract base type from which all SDF inherit from. Contents Variables layer optProps transform Type-Bound Procedures evaluate Source Code sdf_base Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Type-Bound Procedures procedure( evalInterface ), public, deferred :: evaluate pure elemental function evalInterface(this, pos) result(res) Prototype Evaluation function for SDF. ALL SDF must implment this. Arguments Type Intent Optional Attributes Name class( sdf_base ), intent(in) :: this type( vector ), intent(in) :: pos Return Value real(kind=wp) Source Code type , abstract :: sdf_base !> Optical property of the SDF type ( opticalProp_t ) :: optProps !> Transform to apply to SDF. real ( kind = wp ) :: transform ( 4 , 4 ) !> Layer ID of SDF integer :: layer contains procedure ( evalInterface ), deferred :: evaluate end type sdf_base","tags":"","loc":"type/sdf_base.html"},{"title":"generic_emit – signedMCRT","text":"abstract interface public subroutine generic_emit(this, spectrum, dict, seqs) Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2)","tags":"","loc":"interface/generic_emit.html"},{"title":"updateInterface – signedMCRT","text":"abstract interface public subroutine updateInterface(this, wavelength) Arguments Type Intent Optional Attributes Name class( opticalProp_base ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength","tags":"","loc":"interface/updateinterface.html"},{"title":"sampleInterface – signedMCRT","text":"abstract interface public subroutine sampleInterface(this, x, y, value) Arguments Type Intent Optional Attributes Name class( piecewise ), intent(in) :: this real(kind=wp), intent(out) :: x real(kind=wp), intent(out) :: y real(kind=wp), intent(in), optional :: value","tags":"","loc":"interface/sampleinterface.html"},{"title":"checkHitInterface – signedMCRT","text":"abstract interface public function checkHitInterface(this, hitpoint) Arguments Type Intent Optional Attributes Name class( detector ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Return Value logical","tags":"","loc":"interface/checkhitinterface.html"},{"title":"recordHitInterface – signedMCRT","text":"abstract interface public subroutine recordHitInterface(this, hitpoint, history) Arguments Type Intent Optional Attributes Name class( detector ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint type( history_stack_t ), intent(inout) :: history","tags":"","loc":"interface/recordhitinterface.html"},{"title":"evalInterface – signedMCRT","text":"abstract interface public pure elemental function evalInterface(this, pos) result(res) Arguments Type Intent Optional Attributes Name class( sdf_base ), intent(in) :: this type( vector ), intent(in) :: pos Return Value real(kind=wp) Description Evaluation function for SDF. ALL SDF must implment this.","tags":"","loc":"interface/evalinterface.html"},{"title":"op – signedMCRT","text":"abstract interface public pure function op(d1, d2, k) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 real(kind=wp), intent(in) :: d2 real(kind=wp), intent(in) :: k Return Value real(kind=wp) Description Abstract function used as the base for SDF operators (union, subtraction etc)","tags":"","loc":"interface/op.html"},{"title":"primitive – signedMCRT","text":"abstract interface public pure function primitive(pos) result(res) Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos vector position of photon packet. Return Value real(kind=wp) Description Abstract function used as base for displacement function","tags":"","loc":"interface/primitive.html"},{"title":"get_vessels – signedMCRT","text":"public function get_vessels() result(array) Uses sdfs vector_class opticalProperties setup blood vessel scene Arguments None Return Value type( sdf ), allocatable, (:) Contents Source Code get_vessels Source Code function get_vessels () result ( array ) !! setup blood vessel scene use opticalProperties use sdfs , only : sdf , capsule , box use vector_class , only : vector type ( sdf ), allocatable :: array (:) real ( kind = wp ), allocatable :: nodes (:, :), radii (:) integer , allocatable :: edges (:, :) integer :: io , edge_cnt , tmp1 , tmp2 , u , node_cnt , i real ( kind = wp ) :: x , y , z , radius , res , maxx , maxy , maxz real ( kind = wp ) :: musv , muav , gv , nv real ( kind = wp ) :: musd , muad , gd , nd type ( vector ) :: a , b type ( opticalProp_t ) :: opt ( 2 ) !MCmatlab: an open-source, user-friendly, MATLAB-integrated three-dimensional Monte Carlo light transport solver with heat diffusion and tissue damage muav = 23 1._wp musv = 9 4._wp gv = 0.9_wp nv = 1.37_wp muad = 0.458_wp musd = 35 7._wp gd = 0.9_wp nd = 1.37_wp opt ( 1 ) = mono ( musv , muav , gv , nv ) opt ( 2 ) = mono ( musd , muad , gd , nd ) !get number of edges open ( newunit = u , file = \"res/edges.dat\" , iostat = io ) edge_cnt = 0 do read ( u , * , iostat = io ) tmp1 , tmp2 if ( io /= 0 ) exit edge_cnt = edge_cnt + 1 end do close ( u ) !get number of nodes and radii open ( newunit = u , file = \"res/nodes.dat\" , iostat = io ) node_cnt = 0 do read ( u , * , iostat = io ) x , y , z if ( io /= 0 ) exit node_cnt = node_cnt + 1 end do allocate ( edges ( edge_cnt , 2 ), nodes ( node_cnt , 3 ), radii ( node_cnt )) !read in edges open ( newunit = u , file = \"res/edges.dat\" , iostat = io ) do i = 1 , edge_cnt read ( u , * , iostat = io ) edges ( i , :) if ( io /= 0 ) exit end do close ( u ) !read in nodes open ( newunit = u , file = \"res/nodes.dat\" , iostat = io ) do i = 1 , edge_cnt read ( u , * , iostat = io ) nodes ( i , :) if ( io /= 0 ) exit end do close ( u ) !read in radii open ( newunit = u , file = \"res/radii.dat\" , iostat = io ) do i = 1 , node_cnt read ( u , * , iostat = io ) radii ( i ) if ( io /= 0 ) exit end do close ( u ) res = 0.001_wp !0.01mm maxx = maxval ( abs ( nodes (:, 1 ))) maxy = maxval ( abs ( nodes (:, 2 ))) maxz = maxval ( abs ( nodes (:, 3 ))) nodes (:, 1 ) = ( nodes (:, 1 ) / maxx ) - 0.5_wp nodes (:, 2 ) = ( nodes (:, 2 ) / maxy ) - 0.5_wp nodes (:, 3 ) = ( nodes (:, 3 ) / maxz ) - 0.5_wp nodes (:, 1 ) = nodes (:, 1 ) * maxx * res nodes (:, 2 ) = nodes (:, 2 ) * maxy * res nodes (:, 3 ) = nodes (:, 3 ) * maxz * res allocate ( array ( edge_cnt + 1 )) do i = 1 , edge_cnt a = vector ( nodes ( edges ( i , 1 ), 1 ), nodes ( edges ( i , 1 ), 2 ), nodes ( edges ( i , 1 ), 3 )) b = vector ( nodes ( edges ( i , 2 ), 1 ), nodes ( edges ( i , 2 ), 2 ), nodes ( edges ( i , 2 ), 3 )) radius = radii ( edges ( i , 1 )) * res array ( i ) = capsule ( a , b , radius , opt ( 1 ), 1 ) end do array ( i ) = box ( vector (. 32_wp , . 18_wp , . 26_wp ), opt ( 2 ), 2 ) end function get_vessels","tags":"","loc":"proc/get_vessels.html"},{"title":"setup_egg – signedMCRT","text":"public function setup_egg() result(array) Uses opticalProperties sdfs vector_class sdfModifiers setup an egg, with yolk, albumen and shell Arguments None Return Value type( sdf ), allocatable, (:) Contents Source Code setup_egg Source Code function setup_egg () result ( array ) !! setup an egg, with yolk, albumen and shell use sdfs , only : sdf , sphere , box , egg use sdfModifiers , only : onion , revolution use vector_class use opticalProperties type ( sdf ), allocatable :: array (:) type ( box ) :: bbox type ( revolution ), save :: albumen , rev1 type ( onion ) :: shell type ( sphere ) :: yolk type ( opticalProp_t ) :: opt ( 4 ) type ( egg ), save :: egg_shell , egg_albumen real ( kind = wp ) :: r1 , r2 , h r1 = 3._wp r2 = 3._wp * sqrt ( 2._wp - sqrt ( 2._wp )) h = r2 !width = 42mm !height = 62mm !shell opt ( 1 ) = mono ( 10 0._wp , 1 0._wp , 0.0_wp , 1.37_wp ) egg_shell = egg ( r1 , r2 , h , opt ( 1 ), 2 ) rev1 = revolution ( egg_shell , . 2_wp ) shell = onion ( rev1 , . 2_wp ) !albumen opt ( 2 ) = mono ( 1._wp , 0._wp , 0.0_wp , 1.37_wp ) egg_albumen = egg ( r1 - . 2_wp , r2 , h , opt ( 2 ), 3 ) albumen = revolution ( egg_albumen , . 2_wp ) !yolk opt ( 3 ) = mono ( 1 0._wp , 1._wp , 0.9_wp , 1.37_wp ) yolk = sphere ( 1.5_wp , opt ( 3 ), 1 ) !bounding box opt ( 4 ) = mono ( 0._wp , 0._wp , 0.0_wp , 1._wp ) bbox = box ( vector ( 2 0.001_wp , 2 0.001_wp , 2 0.001_wp ), opt ( 4 ), 4 ) allocate ( array ( 4 )) array ( 1 ) = yolk array ( 2 ) = albumen array ( 3 ) = shell array ( 4 ) = bbox end function setup_egg","tags":"","loc":"proc/setup_egg.html"},{"title":"setup_exp – signedMCRT","text":"public function setup_exp(dict) result(array) Uses sdfHelpers utils vector_class opticalProperties mat_class sdfs Setup experimental geometry from Georgies paper. i.e a glass bottle with contents Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Return Value type( sdf ), allocatable, (:) Contents Source Code setup_exp Source Code function setup_exp ( dict ) result ( array ) !! Setup experimental geometry from Georgies paper. i.e a glass bottle with contents use sdfs , only : sdf , box , cylinder !, subtraction use sdfHelpers , only : rotate_y , translate use utils , only : deg2rad use vector_class , only : vector use mat_class , only : invert use opticalProperties , only : mono , opticalProp_t type ( toml_table ), intent ( inout ) :: dict type ( sdf ), allocatable :: array (:) type ( opticalProp_t ) :: opt ( 3 ) type ( vector ) :: a , b real ( kind = wp ) :: n , optprop ( 5 ) error stop \"add model and subtraction here\" call get_value ( dict , \"musb\" , optprop ( 1 )) call get_value ( dict , \"muab\" , optprop ( 2 )) call get_value ( dict , \"musc\" , optprop ( 3 )) call get_value ( dict , \"muac\" , optprop ( 4 )) call get_value ( dict , \"hgg\" , optprop ( 5 )) n = 1._wp opt ( 1 ) = mono ( optprop ( 1 ), optprop ( 2 ), optprop ( 5 ), 1.5_wp ) opt ( 2 ) = mono ( optprop ( 3 ), optprop ( 4 ), optprop ( 5 ), 1.3_wp ) a = vector ( - 1 0._wp , 0._wp , 0._wp ) b = vector ( 1 0._wp , 0._wp , 0._wp ) !bottle array ( 2 ) = cylinder ( a , b , 1.75_wp , opt ( 1 ), 2 ) ! contents array ( 1 ) = cylinder ( a , b , 1.55_wp , opt ( 2 ), 1 ) ! t = invert(translate(vector(0._wp, 0._wp, -5._wp+1.75_wp))) ! slab = box(vector(10._wp, 10._wp, 10._wp), optprop(3), optprop(4), optprop(5), 1.3_wp, 1, transform=t) opt ( 3 ) = mono ( 0.0_wp , 0.0_wp , 0.0_wp , n ) array ( 3 ) = box ( vector ( 4._wp , 4._wp , 4._wp ), opt ( 3 ), 2 ) end function setup_exp","tags":"","loc":"proc/setup_exp.html"},{"title":"setup_logo – signedMCRT","text":"public function setup_logo() result(array) Uses opticalProperties sdfs vector_class sdfModifiers setup uni crest geometry Arguments None Return Value type( sdf ), allocatable, (:) Contents Source Code setup_logo Source Code function setup_logo () result ( array ) !! setup uni crest geometry use sdfs , only : sdf , box , segment use sdfModifiers , only : extrude use opticalProperties use vector_class type ( sdf ), allocatable :: array (:) type ( segment ), allocatable , save :: seg (:) type ( opticalProp_t ) :: opt ( 2 ) type ( vector ) :: a , b real ( kind = wp ) :: hgg , mus , mua , n integer :: layer logical :: fexists allocate ( array ( 726 ), seg ( 725 )) mus = 1 0._wp mua = . 1_wp hgg = 0.9_wp n = 1.5_wp layer = 1 opt ( 1 ) = mono ( 0.0_wp , 0.0_wp , 0.0_wp , 1.0_wp ) opt ( 2 ) = mono ( mus , mua , hgg , n ) inquire ( file = \"res/svg.f90\" , exist = fexists ) if (. not . fexists ) error stop \"need to generate svg.f90 and place in res/\" error stop \"need to uncomment inlcude line!\" ! include \"../res/svg.f90\" array ( 726 ) = box ( vector ( 1 0._wp , 1 0._wp , 2.001_wp ), opt ( 1 ), 2 ) end function setup_logo","tags":"","loc":"proc/setup_logo.html"},{"title":"setup_omg_sdf – signedMCRT","text":"public function setup_omg_sdf() result(array) Uses sdfHelpers opticalProperties vector_class sdfModifiers mat_class sdfs setup OMG scene Arguments None Return Value type( sdf ), allocatable, (:) Contents Source Code setup_omg_sdf Source Code function setup_omg_sdf () result ( array ) !! setup OMG scene use mat_class , only : invert use opticalProperties use sdfHelpers , only : translate , rotate_y use sdfModifiers , only : SmoothUnion use sdfs , only : sdf , cylinder , torus , box , model use vector_class , only : vector type ( sdf ), allocatable :: array (:) type ( sdf ), allocatable , save :: cnta (:) type ( opticalProp_t ), save :: opt ( 2 ) type ( vector ) :: a , b real ( kind = wp ) :: t ( 4 , 4 ), mus , mua , hgg , n integer :: layer allocate ( array ( 2 ), cnta ( 10 )) mus = 1 0._wp mua = 0.16_wp hgg = 0.0_wp n = 2.65_wp layer = 1 opt ( 1 ) = mono ( mus , mua , hgg , n ) opt ( 2 ) = mono ( 0._wp , 0._wp , 0._wp , 1.0_wp ) ! x ! | ! | ! | ! | ! |_____z !O letter a = vector ( 0._wp , 0._wp , - 0.7_wp ) t = invert ( translate ( a )) cnta ( 1 ) = torus (. 2_wp , 0.05_wp , opt ( 1 ), layer , transform = t ) !M letter a = vector ( - . 25_wp , 0._wp , - . 25_wp ) b = vector ( - . 25_wp , 0._wp , . 25_wp ) t = invert ( rotate_y ( 9 0._wp )) cnta ( 2 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer , transform = t ) a = vector ( - . 25_wp , 0._wp , - . 25_wp ) b = vector (. 25_wp , 0._wp , . 0_wp ) cnta ( 3 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector (. 25_wp , 0._wp , . 0_wp ) b = vector ( - . 25_wp , 0._wp , . 25_wp ) cnta ( 4 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector ( - . 25_wp , 0._wp , . 25_wp ) b = vector (. 25_wp , 0._wp , . 25_wp ) cnta ( 5 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) !G letter a = vector ( - . 25_wp , 0._wp , . 5_wp ) b = vector (. 25_wp , 0._wp , . 5_wp ) cnta ( 6 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector ( - . 25_wp , 0._wp , . 5_wp ) b = vector ( - . 25_wp , 0._wp , . 75_wp ) cnta ( 7 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector (. 25_wp , 0._wp , . 5_wp ) b = vector (. 25_wp , 0._wp , . 75_wp ) cnta ( 8 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector (. 25_wp , 0._wp , . 75_wp ) b = vector ( 0._wp , 0._wp , . 75_wp ) cnta ( 9 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector ( 0._wp , 0._wp , . 625_wp ) b = vector ( 0._wp , 0._wp , . 75_wp ) cnta ( 10 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) array ( 1 ) = model ( cnta , smoothunion , 0.09_wp ) array ( 2 ) = box ( vector ( 2._wp , 2._wp , 2._wp ), opt ( 2 ), 2 ) end function setup_omg_sdf","tags":"","loc":"proc/setup_omg_sdf.html"},{"title":"setup_scat_test – signedMCRT","text":"public function setup_scat_test(dict) result(array) Uses sdfs vector_class opticalProperties set up scattering test scene with user defined tau Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Return Value type( sdf ), allocatable, (:) Contents Source Code setup_scat_test Source Code function setup_scat_test ( dict ) result ( array ) !! set up scattering test scene with user defined tau use opticalProperties use sdfs , only : sdf , sphere , box use vector_class type ( toml_table ), intent ( inout ) :: dict type ( sdf ), allocatable :: array (:) type ( opticalProp_t ) :: opt ( 2 ) real ( kind = wp ) :: mus , mua , hgg , n , tau call get_value ( dict , \"tau\" , tau ) allocate ( array ( 2 )) n = 1._wp hgg = 0.0_wp mua = 0.00_wp mus = tau opt ( 1 ) = mono ( mus , mua , hgg , n ) array ( 1 ) = sphere ( 1._wp , opt ( 1 ), 1 ) opt ( 2 ) = mono ( 0.0_wp , mua , hgg , n ) array ( 2 ) = box ( vector ( 2._wp , 2._wp , 2._wp ), opt ( 2 ), 2 ) end function setup_scat_test","tags":"","loc":"proc/setup_scat_test.html"},{"title":"setup_scat_test2 – signedMCRT","text":"public function setup_scat_test2(dict) result(array) Uses sdfs vector_class opticalProperties set up scattering test scene 2 with user defined tau and hgg Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Return Value type( sdf ), allocatable, (:) Contents Source Code setup_scat_test2 Source Code function setup_scat_test2 ( dict ) result ( array ) !! set up scattering test scene 2 with user defined tau and hgg use opticalProperties use sdfs , only : sdf , box use vector_class type ( toml_table ), intent ( inout ) :: dict type ( sdf ), allocatable :: array (:) type ( opticalProp_t ) :: opt real ( kind = wp ) :: mus , mua , hgg , n , tau allocate ( array ( 1 )) call get_value ( dict , \"tau\" , tau ) call get_value ( dict , \"hgg\" , hgg ) n = 1._wp hgg = hgg mua = 1e-17_wp mus = tau opt = mono ( mus , mua , hgg , n ) array ( 1 ) = box ( vector ( 20 0._wp , 20 0._wp , 20 0._wp ), opt , 2 ) end function setup_scat_test2","tags":"","loc":"proc/setup_scat_test2.html"},{"title":"setup_sphere – signedMCRT","text":"public function setup_sphere() result(array) Uses sdfHelpers opticalProperties vector_class mat_class sdfs setup the sphere test case from tran and jacques paper. Arguments None Return Value type( sdf ), allocatable, (:) Contents Source Code setup_sphere Source Code function setup_sphere () result ( array ) !! setup the sphere test case from tran and jacques paper. use mat_class , only : invert use opticalProperties , only : mono , opticalProp_t use sdfs , only : sdf , box , sphere use sdfHelpers , only : translate use vector_class , only : vector type ( sdf ), allocatable :: array (:) type ( opticalProp_t ) :: opt ( 3 ) real ( kind = wp ) :: mus , mua , n , hgg , t ( 4 , 4 ) type ( vector ) :: a allocate ( array ( 3 )) mus = 0._wp ; mua = 1.e-17_wp ; hgg = 0._wp ; n = 1._wp ; opt ( 1 ) = mono ( mus , mua , hgg , n ) array ( 2 ) = box ( vector ( 2._wp , 2._wp , 2._wp ), opt ( 1 ), 2 ) opt ( 2 ) = mono ( mus , 1000000 0._wp , hgg , n ) array ( 3 ) = box ( vector ( 2.01_wp , 2.01_wp , 2.01_wp ), opt ( 2 ), 3 ) mus = 0._wp ; mua = 1.e-17_wp ; hgg = 0._wp ; n = 1.33_wp ; opt ( 3 ) = mono ( mus , mua , hgg , n ) a = vector (. 0_wp , 0._wp , 0._wp ) t = invert ( translate ( a )) array ( 1 ) = sphere ( 0.5_wp , opt ( 3 ), 1 , transform = t ) end function setup_sphere","tags":"","loc":"proc/setup_sphere.html"},{"title":"setup_sphere_scene – signedMCRT","text":"public function setup_sphere_scene(dict) result(array) Uses sdfHelpers opticalProperties vector_class mat_class sdfs random setup a test scene with user defined spheres Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Return Value type( sdf ), allocatable, (:) Contents Source Code setup_sphere_scene Source Code function setup_sphere_scene ( dict ) result ( array ) !! setup a test scene with user defined spheres use mat_class , only : invert use opticalProperties , only : opticalProp_t , mono use sdfs , only : sdf , sphere , box use sdfHelpers , only : translate use random , only : ranu use vector_class , only : vector type ( toml_table ), intent ( inout ) :: dict type ( sdf ), allocatable :: array (:) integer :: num_spheres , i real ( kind = wp ) :: t ( 4 , 4 ), mus , mua , hgg , n , radius type ( vector ) :: pos type ( opticalProp_t ) :: opt ( 2 ) call get_value ( dict , \"num_spheres\" , num_spheres ) allocate ( array ( num_spheres + 1 )) mus = 1e-17_wp mua = 1e-17_wp hgg = 0.0_wp n = 1.0_wp opt ( 2 ) = mono ( mus , mua , hgg , n ) array ( num_spheres + 1 ) = box ( vector ( 2._wp , 2._wp , 2._wp ), opt ( 2 ), num_spheres + 1 ) mus = 0.0_wp !ranu(1._wp, 50._wp) mua = 0.0_wp !ranu(0.01_wp, 1._wp) hgg = 0.9_wp n = 1.37_wp opt ( 1 ) = mono ( mus , mua , hgg , n ) do i = 1 , num_spheres radius = ranu ( 0.001_wp , 0.25_wp ) pos = vector ( ranu ( - 1._wp + radius , 1._wp - radius ), ranu ( - 1._wp + radius , 1._wp - radius ),& ranu ( - 1._wp + radius , 1._wp - radius )) t = invert ( translate ( pos )) array ( i ) = sphere ( radius , opt ( 1 ), i , transform = t ) end do end function setup_sphere_scene","tags":"","loc":"proc/setup_sphere_scene.html"},{"title":"init_photon – signedMCRT","text":"private function init_photon(val) set up all the variables in the photon object Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val value to assing to variables Return Value type( photon ) Contents Source Code init_photon Source Code type ( photon ) function init_photon ( val ) !! set up all the variables in the photon object !> value to assing to variables real ( kind = wp ), intent ( in ) :: val init_photon % pos = vector ( val , val , val ) init_photon % nxp = val init_photon % nyp = val init_photon % nzp = val init_photon % sint = val init_photon % cost = val init_photon % sinp = val init_photon % cosp = val init_photon % phi = val init_photon % wavelength = val init_photon % energy = val init_photon % fact = val init_photon % zcell = int ( val ) init_photon % ycell = int ( val ) init_photon % zcell = int ( val ) init_photon % tflag = . true . init_photon % layer = int ( val ) init_photon % id = int ( val ) init_photon % cnts = int ( val ) init_photon % bounces = int ( val ) init_photon % weight = val init_photon % step = val end function init_photon","tags":"","loc":"proc/init_photon.html"},{"title":"init_source – signedMCRT","text":"public function init_source(choice) Bind emission function to photon object Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: choice Name of light source to use Return Value type( photon ) Contents Source Code init_source Source Code type ( photon ) function init_source ( choice ) !! Bind emission function to photon object !> Name of light source to use character ( * ), intent ( IN ) :: choice if ( choice == \"uniform\" ) then init_source % emit => uniform elseif ( choice == \"pencil\" ) then init_source % emit => pencil elseif ( choice == \"dslit\" ) then init_source % emit => dslit elseif ( choice == \"aperture\" ) then init_source % emit => aperture elseif ( choice == \"annulus\" ) then init_source % emit => annulus elseif ( choice == \"focus\" ) then init_source % emit => focus elseif ( choice == \"point\" ) then init_source % emit => point elseif ( choice == \"circular\" ) then init_source % emit => circular elseif ( choice == \"slm\" ) then init_source % emit => slm else error stop \"No such source!\" end if end function init_source","tags":"","loc":"proc/init_source.html"},{"title":"annulus – signedMCRT","text":"private subroutine annulus(this, spectrum, dict, seqs) Uses utils constants tomlf random piecewiseMod sim_state_mod annular source Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Contents Source Code annulus Source Code subroutine annulus ( this , spectrum , dict , seqs ) !! annular source use constants , only : TWOPI use utils , only : deg2rad use tomlf , only : toml_table , get_value use random , only : ran2 , rang , seq use sim_state_mod , only : state use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) character ( len = :), allocatable :: beam_type real ( kind = wp ) :: beta , rlo , rhi , radius , tmp , mid , angle , x , y , z , phi , sinp , cosp type ( vector ) :: pos integer :: cell ( 3 ) call get_value ( dict , \"beta\" , beta ) call get_value ( dict , \"radius\" , rlo ) call get_value ( dict , \"radius_hi\" , rhi ) call get_value ( dict , \"annulus_type\" , beam_type ) if ( beam_type == \"tophat\" ) then radius = rlo + ( rhi - rlo ) * sqrt ( ran2 ()) elseif ( beam_type == \"gaussian\" ) then mid = ( rhi - rlo ) / 2. call rang ( radius , tmp , mid , 0.04_wp ) else error stop \"No such beam type!\" end if phi = TWOPI * ran2 () angle = deg2rad ( beta ) cosp = cos ( phi ) sinp = sin ( phi ) x = radius * cosp y = radius * sinp z = state % grid % zmax - 1e-8_wp ! just inside surface of medium. TODO make this user configurable? pos = vector ( x , y , z ) this % pos = pos this % nxp = sin ( angle ) * cosp this % nyp = sin ( angle ) * sinp this % nzp = - cos ( angle ) this % phi = phi this % cosp = cosp this % sinp = sinp this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % tflag = . false . this % bounces = 0 this % cnts = 0 this % weight = 1.0_wp call spectrum % p % sample ( this % wavelength , tmp ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine annulus","tags":"","loc":"proc/annulus.html"},{"title":"aperture – signedMCRT","text":"private subroutine aperture(this, spectrum, dict, seqs) Uses constants tomlf random piecewiseMod sim_state_mod sample from square aperture to produce diff pattern Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Contents Source Code aperture Source Code subroutine aperture ( this , spectrum , dict , seqs ) !! sample from square aperture to produce diff pattern !add user defined apwid and F ! add correct normalisation use random , only : ranu , ran2 , randint , seq use sim_state_mod , only : state use tomlf , only : toml_table , get_value use constants , only : TWOPI use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: x1 , y1 , z1 , x2 , y2 , z2 , b , F , apwid , tmp call spectrum % p % sample ( this % wavelength , tmp ) this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) apwid = 20 0e-6_wp !aperture width b = apwid / 2._wp !slit width ! Fresnel number F = 4.95_wp !sample aperture postiion x1 = ranu ( - b , b ) y1 = ranu ( - b , b ) z1 = ( 1._wp / (((( F / apwid ) ** 2 ) / 2._wp ) * this % wavelength )) - 0.5_wp x2 = ranu ( - 0.5_wp , 0.5_wp ) y2 = ranu ( - 0.5_wp , 0.5_wp ) z2 = 0.5_wp - ( 1.e-5_wp * ( 2._wp * 0.5_wp / 40 0._wp )) this % pos % x = x2 this % pos % y = y2 this % pos % z = z2 this % phase = sqrt (( x2 - x1 ) ** 2 + ( y2 - y1 ) ** 2 + ( z2 - z1 ) ** 2 ) this % nxp = ( x2 - x1 ) / this % phase this % nyp = ( y2 - y1 ) / this % phase this % nzp = - abs (( z2 - z1 )) / this % phase this % tflag = . false . this % cnts = 0 this % bounces = 0 this % weight = 1.0_wp !scattering stuff - not important this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine aperture","tags":"","loc":"proc/aperture.html"},{"title":"circular – signedMCRT","text":"private subroutine circular(this, spectrum, dict, seqs) Uses sdfHelpers vector_class sim_state_mod mat_class tomlf random piecewiseMod constants circular source Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Contents Source Code circular Source Code subroutine circular ( this , spectrum , dict , seqs ) !! circular source use sim_state_mod , only : state use random , only : ran2 , seq use constants , only : twoPI use tomlf , only : toml_table , get_value use sdfHelpers , only : rotationAlign , translate use mat_class , only : invert use vector_class use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) type ( vector ) :: a , b integer :: cell ( 3 ) real ( kind = wp ) :: t ( 4 , 4 ), radius , r , theta , tmp this % nxp = photon_origin % nxp this % nyp = photon_origin % nyp this % nzp = photon_origin % nzp call get_value ( dict , \"radius\" , radius ) ! https://math.stackexchange.com/a/1681815 r = radius * sqrt ( ran2 ()) theta = ran2 () * TWOPI !set inital vector from which the source points a = vector ( 1._wp , 0._wp , 0._wp ) a = a % magnitude () !set vector to rotate to. User defined. b = vector ( this % nxp , this % nyp , this % nzp ) b = b % magnitude () ! method fails if below condition is true. So change a vector to point down x-axis if ( abs ( a ) == abs ( b )) then a = vector ( 0._wp , 0._wp , 1._wp ) a = a % magnitude () this % pos = vector ( r * cos ( theta ), r * sin ( theta ), 0._wp ) else this % pos = vector ( 0._wp , r * cos ( theta ), r * sin ( theta )) end if ! get rotation matrix t = rotationAlign ( a , b ) ! get translation matrix t = matmul ( t , invert ( translate ( photon_origin % pos ))) ! transform point this % pos = this % pos . dot . t this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) call spectrum % p % sample ( this % wavelength , tmp ) this % tflag = . false . this % cnts = 0 this % bounces = 0 this % layer = 1 this % weight = 1.0_wp ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine circular","tags":"","loc":"proc/circular.html"},{"title":"dslit – signedMCRT","text":"private subroutine dslit(this, spectrum, dict, seqs) Uses constants tomlf random piecewiseMod sim_state_mod sample from double slit to produce diff pattern Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Contents Source Code dslit Source Code subroutine dslit ( this , spectrum , dict , seqs ) !!sample from double slit to produce diff pattern ! todo add in user defined slit widths ! add correct normalisation use random , only : ranu , ran2 , randint , seq use sim_state_mod , only : state use tomlf , only : toml_table , get_value use constants , only : TWOPI use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: x1 , y1 , z1 , x2 , y2 , z2 , a , b , tmp call spectrum % p % sample ( this % wavelength , tmp ) this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) a = 6 0._wp * this % wavelength !distance between slits b = 2 0._wp * this % wavelength !2 slit width if ( ran2 () > 0.5_wp ) then ! pick slit and sample x, y position x1 = ranu ( a / 2._wp , a / 2._wp + b ) y1 = ranu ( - b * 0.5_wp , b * 0.5_wp ) else x1 = ranu ( - a / 2._wp , - a / 2._wp - b ) y1 = ranu ( - b * 0.5_wp , b * 0.5_wp ) end if z2 = 5.0_wp - ( 1.e-5_wp * ( 2._wp * ( 5.0_wp / 40 0._wp ))) x2 = ranu ( - 5.0_wp , 5.0_wp ) y2 = ranu ( - 5.0_wp , 5.0_wp ) z1 = ( 1000 0._wp * this % wavelength ) - 5.0_wp !screen location this % pos % x = x2 this % pos % y = y2 this % pos % z = z2 this % phase = sqrt (( x2 - x1 ) ** 2 + ( y2 - y1 ) ** 2 + ( z2 - z1 ) ** 2 ) this % nxp = ( x2 - x1 ) / this % phase this % nyp = ( y2 - y1 ) / this % phase this % nzp = - abs (( z2 - z1 )) / this % phase this % tflag = . false . this % cnts = 0 this % bounces = 0 this % weight = 1.0_wp !Set direction cosine/sine this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine dslit","tags":"","loc":"proc/dslit.html"},{"title":"focus – signedMCRT","text":"private subroutine focus(this, spectrum, dict, seqs) Uses utils vector_class tomlf random piecewiseMod sim_state_mod Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Contents Source Code focus Source Code subroutine focus ( this , spectrum , dict , seqs ) use random , only : ranu , seq use sim_state_mod , only : state use utils , only : deg2rad use vector_class , only : length use tomlf , only : toml_table , get_value use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) type ( vector ) :: targ , dir real ( kind = wp ) :: dist , tmp integer :: cell ( 3 ) targ = vector ( 0._wp , 0._wp , 0._wp ) this % pos % x = ranu ( - state % grid % xmax , state % grid % xmax ) this % pos % y = ranu ( - state % grid % ymax , state % grid % ymax ) this % pos % z = state % grid % zmax - 1e-8_wp dist = length ( this % pos ) dir = ( - 1._wp ) * this % pos / dist dir = dir % magnitude () this % nxp = dir % x this % nyp = dir % y this % nzp = dir % z this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % nxp = this % sint * this % cosp this % nyp = this % sint * this % sinp this % nzp = this % cost this % tflag = . false . this % bounces = 0 this % cnts = 0 this % weight = 1.0_wp call spectrum % p % sample ( this % wavelength , tmp ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine focus","tags":"","loc":"proc/focus.html"},{"title":"pencil – signedMCRT","text":"private subroutine pencil(this, spectrum, dict, seqs) Uses constants tomlf random piecewiseMod sim_state_mod pencil beam source Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Contents Source Code pencil Source Code subroutine pencil ( this , spectrum , dict , seqs ) !! pencil beam source use random , only : ranu , seq use sim_state_mod , only : state use tomlf , only : toml_table , get_value use piecewiseMod use constants , only : TWOPI class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: tmp this % pos = photon_origin % pos this % nxp = photon_origin % nxp this % nyp = photon_origin % nyp this % nzp = photon_origin % nzp this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % tflag = . false . this % bounces = 0 this % cnts = 0 this % weight = 1.0_wp call spectrum % p % sample ( this % wavelength , tmp ) this % energy = 1.0_wp this % fact = TWOPI / this % wavelength ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine pencil","tags":"","loc":"proc/pencil.html"},{"title":"point – signedMCRT","text":"private subroutine point(this, spectrum, dict, seqs) Uses sim_state_mod tomlf random piecewiseMod constants isotropic point source Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Contents Source Code point Source Code subroutine point ( this , spectrum , dict , seqs ) !! isotropic point source use sim_state_mod , only : state use random , only : ran2 , seq use constants , only : twoPI use tomlf , only : toml_table , get_value use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: wavelength , tmp this % pos = photon_origin % pos this % phi = ran2 () * twoPI this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = 2._wp * ran2 () - 1._wp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % nxp = this % sint * this % cosp this % nyp = this % sint * this % sinp this % nzp = this % cost this % tflag = . false . this % cnts = 0 this % bounces = 0 this % layer = 1 this % weight = 1.0_wp ! this%L = 1.0 call spectrum % p % sample ( wavelength , tmp ) this % wavelength = wavelength this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine point","tags":"","loc":"proc/point.html"},{"title":"scatter – signedMCRT","text":"private subroutine scatter(this, hgg, g2, dects) Uses random detectors constants Scattering routine. Implments both isotropic and henyey-greenstein scattering\ntaken from mcxyz Type Bound photon Arguments Type Intent Optional Attributes Name class( photon ), intent(inout) :: this real(kind=wp), intent(in) :: hgg g factor real(kind=wp), intent(in) :: g2 g factor squared type( dect_array ), intent(in), optional :: dects (:) array of detectors. Only used if biased scattering is enabled. Contents Source Code scatter Source Code subroutine scatter ( this , hgg , g2 , dects ) !! Scattering routine. Implments both isotropic and henyey-greenstein scattering !! taken from [mcxyz](https://omlc.org/software/mc/mcxyz/index.html) use constants , only : PI , TWOPI , wp use random , only : ran2 use detectors , only : dect_array class ( photon ), intent ( inout ) :: this !> g factor real ( kind = wp ), intent ( in ) :: hgg !> g factor squared real ( kind = wp ), intent ( in ) :: g2 !> array of detectors. Only used if biased scattering is enabled. type ( dect_array ), optional , intent ( in ) :: dects (:) real ( kind = wp ) :: temp , uxx , uyy , uzz , a , p a = 0.9_wp p = 0.0_wp if ( hgg == 0.0_wp ) then !isotropic scattering this % cost = 2._wp * ran2 () - 1._wp else !henyey-greenstein scattering if ( ran2 () < p . and . present ( dects )) then !bias scattering temp = ran2 () * (( 1._wp / ( 1._wp - a )) - ( 1._wp / sqrt ( a ** 2 + 1._wp ))) + ( 1._wp / sqrt ( a ** 2 + 1._wp )) temp = temp ** ( - 2._wp ) this % cost = ( 1._wp / ( 2._wp * a )) * ( a ** 2 + 1._wp - temp ) this % nxp = dects ( 1 )% p % pos % x - this % pos % x this % nyp = dects ( 1 )% p % pos % y - this % pos % y this % nzp = dects ( 1 )% p % pos % z - this % pos % z else !unbiased temp = ( 1.0_wp - g2 ) / ( 1.0_wp - hgg + 2._wp * hgg * ran2 ()) this % cost = ( 1.0_wp + g2 - temp ** 2 ) / ( 2._wp * hgg ) end if end if this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % phi = TWOPI * ran2 () this % cosp = cos ( this % phi ) if ( this % phi < PI ) then this % sinp = sqrt ( 1._wp - this % cosp ** 2 ) else this % sinp = - sqrt ( 1._wp - this % cosp ** 2 ) end if if ( 1._wp - abs ( this % nzp ) <= 1e-12_wp ) then ! near perpindicular uxx = this % sint * this % cosp uyy = this % sint * this % sinp uzz = sign ( this % cost , this % nzp ) else temp = sqrt ( 1._wp - this % nzp ** 2 ) uxx = this % sint * ( this % nxp * this % nzp * this % cosp - this % nyp * this % sinp ) / temp + this % nxp * this % cost uyy = this % sint * ( this % nyp * this % nzp * this % cosp + this % nxp * this % sinp ) / temp + this % nyp * this % cost uzz = - 1._wp * this % sint * this % cosp * temp + this % nzp * this % cost end if this % nxp = uxx this % nyp = uyy this % nzp = uzz end subroutine scatter","tags":"","loc":"proc/scatter.html"},{"title":"set_photon – signedMCRT","text":"public subroutine set_photon(pos, dir) Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos type( vector ), intent(in) :: dir Contents Source Code set_photon Source Code subroutine set_photon ( pos , dir ) type ( vector ), intent ( in ) :: pos , dir photon_origin % pos = pos photon_origin % nxp = dir % x photon_origin % nyp = dir % y photon_origin % nzp = dir % z end subroutine set_photon","tags":"","loc":"proc/set_photon.html"},{"title":"slm – signedMCRT","text":"private subroutine slm(this, spectrum, dict, seqs) Uses constants tomlf random piecewiseMod sim_state_mod Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Contents Source Code slm Source Code subroutine slm ( this , spectrum , dict , seqs ) use piecewiseMod use tomlf , only : toml_table , get_value use random , only : ran2 , seq use sim_state_mod , only : state use constants , only : TWOPI class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: x , y this % pos = photon_origin % pos call spectrum % p % sample ( x , y ) this % pos % x = ( x - 100 ) / ( state % grid % nxg / ( 2. * state % grid % xmax )) this % pos % y = ( y - 100 ) / ( state % grid % nyg / ( 2. * state % grid % ymax )) this % nxp = photon_origin % nxp this % nyp = photon_origin % nyp this % nzp = photon_origin % nzp this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % tflag = . false . this % cnts = 0 this % bounces = 0 this % layer = 1 this % weight = 1.0_wp this % phase = 0.0_wp this % wavelength = 50 0.e-9_wp this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine slm","tags":"","loc":"proc/slm.html"},{"title":"uniform – signedMCRT","text":"private subroutine uniform(this, spectrum, dict, seqs) Uses constants tomlf random piecewiseMod sim_state_mod uniformly illuminate a surface of the simulation media Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Contents Source Code uniform Source Code subroutine uniform ( this , spectrum , dict , seqs ) !! uniformly illuminate a surface of the simulation media use random , only : ranu , ran2 , randint , seq use sim_state_mod , only : state use tomlf , only : toml_table , get_value use constants , only : TWOPI use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) type ( vector ) :: pos1 , pos2 , pos3 real ( kind = wp ) :: rx , ry , tmp this % nxp = photon_origin % nxp this % nyp = photon_origin % nyp this % nzp = photon_origin % nzp this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) call get_value ( dict , \"pos1%x\" , pos1 % x ) call get_value ( dict , \"pos1%y\" , pos1 % y ) call get_value ( dict , \"pos1%z\" , pos1 % z ) call get_value ( dict , \"pos2%x\" , pos2 % x ) call get_value ( dict , \"pos2%y\" , pos2 % y ) call get_value ( dict , \"pos2%z\" , pos2 % z ) call get_value ( dict , \"pos3%x\" , pos3 % x ) call get_value ( dict , \"pos3%y\" , pos3 % y ) call get_value ( dict , \"pos3%z\" , pos3 % z ) rx = ran2 () !seqs(1)%next() ry = ran2 () !seqs(2)%next() this % pos % x = pos1 % x + rx * pos2 % x + ry * pos3 % x this % pos % y = pos1 % y + rx * pos2 % y + ry * pos3 % y this % pos % z = pos1 % z + rx * pos2 % z + ry * pos3 % z this % tflag = . false . this % cnts = 0 this % bounces = 0 this % weight = 1.0_wp !FOR PHASE call spectrum % p % sample ( this % wavelength , tmp ) this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) this % phase = 0._wp ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine uniform","tags":"","loc":"proc/uniform.html"},{"title":"photon – signedMCRT","text":"public interface photon Contents Module Procedures init_source init_photon Module Procedures public function init_source (choice) Bind emission function to photon object Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: choice Name of light source to use Return Value type( photon ) private function init_photon (val) set up all the variables in the photon object Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val value to assing to variables Return Value type( photon )","tags":"","loc":"interface/photon.html"},{"title":"fresnel – signedMCRT","text":"private function fresnel(I, N, n1, n2) result(tir) Uses ieee_arithmetic calculates the fresnel coefficents Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: I incident vector type( vector ), intent(in) :: N Normal vector real(kind=wp), intent(in) :: n1 reffractive indicies real(kind=wp), intent(in) :: n2 reffractive indicies Return Value real(kind=wp) Contents Source Code fresnel Source Code function fresnel ( I , N , n1 , n2 ) result ( tir ) !! calculates the fresnel coefficents use ieee_arithmetic , only : ieee_is_nan !> reffractive indicies real ( kind = wp ), intent ( IN ) :: n1 , n2 !> incident vector type ( vector ), intent ( IN ) :: I !> Normal vector type ( vector ), intent ( IN ) :: N real ( kind = wp ) :: costt , sintt , sint2 , cost2 , tir , f1 , f2 costt = abs ( I . dot . N ) sintt = sqrt ( 1._wp - costt * costt ) sint2 = n1 / n2 * sintt if ( sint2 > 1._wp ) then tir = 1.0_wp return elseif ( costt == 1._wp ) then tir = 0._wp return else sint2 = ( n1 / n2 ) * sintt cost2 = sqrt ( 1._wp - sint2 * sint2 ) f1 = abs (( n1 * costt - n2 * cost2 ) / ( n1 * costt + n2 * cost2 )) ** 2 f2 = abs (( n1 * cost2 - n2 * costt ) / ( n1 * cost2 + n2 * costt )) ** 2 tir = 0.5_wp * ( f1 + f2 ) if ( ieee_is_nan ( tir ) . or . tir > 1._wp . or . tir < 0._wp ) print * , 'TIR: ' , tir , f1 , f2 , costt , sintt , cost2 , sint2 return end if end function fresnel","tags":"","loc":"proc/fresnel.html"},{"title":"reflect – signedMCRT","text":"private subroutine reflect(I, N) get vector of reflected photon Arguments Type Intent Optional Attributes Name type( vector ), intent(inout) :: I incident vector type( vector ), intent(in) :: N normal vector Contents Source Code reflect Source Code subroutine reflect ( I , N ) !! get vector of reflected photon !> incident vector type ( vector ), intent ( INOUT ) :: I !> normal vector type ( vector ), intent ( IN ) :: N type ( vector ) :: R R = I - 2._wp * ( N . dot . I ) * N I = R end subroutine reflect","tags":"","loc":"proc/reflect.html"},{"title":"reflect_refract – signedMCRT","text":"public subroutine reflect_refract(I, N, n1, n2, rflag, Ri) Uses random wrapper routine for fresnel calculation Arguments Type Intent Optional Attributes Name type( vector ), intent(inout) :: I incident vector type( vector ), intent(inout) :: N normal vector real(kind=wp), intent(in) :: n1 refractive indices real(kind=wp), intent(in) :: n2 refractive indices logical, intent(out) :: rflag reflection flag real(kind=wp), intent(out) :: Ri Contents Source Code reflect_refract Source Code subroutine reflect_refract ( I , N , n1 , n2 , rflag , ri ) !! wrapper routine for fresnel calculation use random , only : ran2 !> incident vector type ( vector ), intent ( INOUT ) :: I !> normal vector type ( vector ), intent ( INOUT ) :: N !> refractive indices real ( kind = wp ), intent ( IN ) :: n1 , n2 real ( kind = wp ), intent ( OUT ) :: Ri !> reflection flag logical , intent ( OUT ) :: rflag rflag = . FALSE . !draw random number, if less than fresnel coefficents, then reflect, else refract Ri = fresnel ( I , N , n1 , n2 ) if ( ran2 () <= Ri ) then call reflect ( I , N ) rflag = . true . else call refract ( I , N , n1 / n2 ) end if end subroutine reflect_refract","tags":"","loc":"proc/reflect_refract.html"},{"title":"refract – signedMCRT","text":"private subroutine refract(I, N, eta) get vector of refracted photon Arguments Type Intent Optional Attributes Name type( vector ), intent(inout) :: I incident vector type( vector ), intent(in) :: N normal vector real(kind=wp), intent(in) :: eta Contents Source Code refract Source Code subroutine refract ( I , N , eta ) !! get vector of refracted photon !> incident vector type ( vector ), intent ( INOUT ) :: I !> normal vector type ( vector ), intent ( IN ) :: N !> \\eta = \\frac{n_1}{n_2} real ( kind = wp ), intent ( IN ) :: eta type ( vector ) :: T , Ntmp real ( kind = wp ) :: c1 , c2 Ntmp = N c1 = ( Ntmp . dot . I ) if ( c1 < 0._wp ) then c1 = - c1 else Ntmp = ( - 1._wp ) * N end if c2 = sqrt ( 1._wp - ( eta ) ** 2 * ( 1._wp - c1 ** 2 )) T = eta * I + ( eta * c1 - c2 ) * Ntmp I = T end subroutine refract","tags":"","loc":"proc/refract.html"},{"title":"alloc_array – signedMCRT","text":"private subroutine alloc_array(nxg, nyg, nzg) Uses iarray subroutine allocates allocatable arrays Arguments Type Intent Optional Attributes Name integer, intent(in) :: nxg grid size integer, intent(in) :: nyg grid size integer, intent(in) :: nzg grid size Contents Source Code alloc_array Source Code subroutine alloc_array ( nxg , nyg , nzg ) !! subroutine allocates allocatable arrays use iarray !> grid size integer , intent ( IN ) :: nxg , nyg , nzg allocate ( phasor ( nxg , nyg , nzg ), phasorGLOBAL ( nxg , nyg , nzg )) allocate ( jmean ( nxg , nyg , nzg ), jmeanGLOBAL ( nxg , nyg , nzg )) allocate ( absorb ( nxg , nyg , nzg ), absorbGLOBAL ( nxg , nyg , nzg )) end subroutine alloc_array","tags":"","loc":"proc/alloc_array.html"},{"title":"create_directory – signedMCRT","text":"private subroutine create_directory(name, flag, appendname, newline) Uses constants create directories if they don't exist Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name logical, intent(in) :: flag character(len=*), intent(in) :: appendname logical, intent(in), optional :: newline Contents Source Code create_directory Source Code subroutine create_directory ( name , flag , appendname , newline ) !! create directories if they don't exist use constants , only : fileplace character ( * ), intent ( in ) :: name , appendname logical , intent ( in ) :: flag logical , optional , intent ( in ) :: newline character ( len = :), allocatable :: mkdirCMD if (. not . flag ) then mkdirCMD = \"mkdir -p \" // trim ( fileplace ) // name call execute_command_line ( mkdirCMD ) ! output correct message for base data dir if ( len ( name ) == 0 ) then mkdirCMD = \"Created \" // appendname // \"data/\" else mkdirCMD = \"Created \" // appendname // name end if if ( newline ) mkdirCMD = mkdirCMD // new_line ( \"a\" ) print * , mkdirCMD end if end subroutine create_directory","tags":"","loc":"proc/create_directory.html"},{"title":"dealloc_array – signedMCRT","text":"public subroutine dealloc_array() Uses iarray deallocate data arrays Arguments None Contents Source Code dealloc_array Source Code subroutine dealloc_array () !! deallocate data arrays use iarray deallocate ( jmean ) deallocate ( jmeanGLOBAL ) deallocate ( absorb ) deallocate ( absorbGLOBAL ) deallocate ( phasor ) deallocate ( phasorGLOBAL ) end subroutine dealloc_array","tags":"","loc":"proc/dealloc_array.html"},{"title":"directory – signedMCRT","text":"public subroutine directory() Uses constants subroutine defines vars to hold paths to various folders Arguments None Contents Source Code directory Source Code subroutine directory () !! subroutine defines vars to hold paths to various folders use constants , only : homedir , fileplace , resdir character ( len = 256 ) :: cwd logical :: dataExists , jmeanExists , depositExists , detectorsExists , phasorExists !get current working directory call get_environment_variable ( 'PWD' , cwd ) ! get 'home' dir from cwd homedir = trim ( cwd ) ! get data dir fileplace = trim ( homedir ) // '/data/' !check if data directory and subdirectories exists. if not create it #ifdef __GFORTRAN__ inquire ( file = trim ( fileplace ) // \"/.\" , exist = dataExists ) inquire ( file = trim ( fileplace ) // \"/jmean/.\" , exist = jmeanExists ) inquire ( file = trim ( fileplace ) // \"/deposit/.\" , exist = depositExists ) inquire ( file = trim ( fileplace ) // \"/detectors/.\" , exist = detectorsExists ) inquire ( file = trim ( fileplace ) // \"/phasor/.\" , exist = phasorExists ) #elif __INTEL_COMPILER inquire ( directory = trim ( fileplace ), exist = dataExists ) inquire ( directory = trim ( fileplace ) // \"/jmean\" , exist = jmeanExists ) inquire ( directory = trim ( fileplace ) // \"/deposit\" , exist = depositExists ) inquire ( directory = trim ( fileplace ) // \"/detectors\" , exist = detectorsExists ) inquire ( directory = trim ( fileplace ) // \"/phasor\" , exist = phasorExists ) #else error stop \"Compiler not supported!\" #endif if (. not . dataExists ) then call create_directory ( \"\" , dataExists , \"\" , . false .) call create_directory ( \"jmean/\" , jmeanExists , \"data/\" , . false .) call create_directory ( \"deposit/\" , depositExists , \"data/\" , . false .) call create_directory ( \"detectors/\" , detectorsExists , \"data/\" , . false .) call create_directory ( \"phasor/\" , phasorExists , \"data/\" , . false .) else call create_directory ( \"jmean/\" , jmeanExists , \"data/\" , . true .) call create_directory ( \"deposit/\" , depositExists , \"data/\" , . true .) call create_directory ( \"detectors/\" , detectorsExists , \"data/\" , . true .) call create_directory ( \"phasor/\" , phasorExists , \"data/\" , . true .) end if ! get res dir resdir = trim ( homedir ) // '/res/' end subroutine directory","tags":"","loc":"proc/directory.html"},{"title":"setup_simulation – signedMCRT","text":"public subroutine setup_simulation(sdfarray, dict) Uses sim_state_mod sdfs vector_class setupGeometry Read in parameters\nSetup up various simulation parameters and routines Arguments Type Intent Optional Attributes Name type( sdf ), intent(out), allocatable :: sdfarray (:) output array of geometry type(toml_table), intent(inout), optional :: dict dictionary used to store metadata Contents Source Code setup_simulation Source Code subroutine setup_simulation ( sdfarray , dict ) !! Read in parameters !! Setup up various simulation parameters and routines use sdfs , only : sdf use setupGeometry use sim_state_mod , only : settings => state use vector_class !> dictionary used to store metadata type ( toml_table ), optional , intent ( INOUT ) :: dict !> output array of geometry type ( sdf ), allocatable , intent ( OUT ) :: sdfarray (:) !allocate and set arrays to 0 call alloc_array ( settings % grid % nxg , settings % grid % nyg , settings % grid % nzg ) call zarray () ! setup geometry using SDFs select case ( settings % experiment ) case ( \"logo\" ) sdfarray = setup_logo () case ( \"omg\" ) sdfarray = setup_omg_sdf () case ( \"scat_test\" ) sdfarray = setup_scat_test ( dict ) case ( \"scat_test2\" ) sdfarray = setup_scat_test2 ( dict ) case ( \"aptran\" ) sdfarray = setup_sphere () case ( \"vessels\" ) sdfarray = get_vessels () case ( \"sphere_scene\" ) sdfarray = setup_sphere_scene ( dict ) case ( \"test_egg\" ) sdfarray = setup_egg () case default error stop \"no such routine\" end select end subroutine setup_simulation","tags":"","loc":"proc/setup_simulation.html"},{"title":"zarray – signedMCRT","text":"private subroutine zarray() Uses iarray zero data arrays Arguments None Contents Source Code zarray Source Code subroutine zarray !! zero data arrays use iarray !sets all arrays to zer phasor = 0._wp phasorGLOBAL = 0._wp jmean = 0._wp jmeanGLOBAL = 0._wp absorb = 0.0_wp absorbGLOBAL = 0.0_wp end subroutine zarray","tags":"","loc":"proc/zarray.html"},{"title":"invert – signedMCRT","text":"public pure function invert(A) result(B) Performs a direct calculation of the inverse of a 4×4 matrix.\nfrom http://fortranwiki.org/fortran/show/Matrix+inversion Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: A (4,4) Input Matric Return Value real(kind=wp), (4,4) Contents Source Code invert Source Code pure function invert ( A ) result ( B ) !! Performs a direct calculation of the inverse of a 4×4 matrix. !! from http://fortranwiki.org/fortran/show/Matrix+inversion !> Input Matric real ( kind = wp ), intent ( in ) :: A ( 4 , 4 ) real ( kind = wp ) :: B ( 4 , 4 ) ! Inverse matrix real ( kind = wp ) :: detinv ! Calculate the inverse determinant of the matrix detinv = & 1._wp / ( A ( 1 , 1 ) * ( A ( 2 , 2 ) * ( A ( 3 , 3 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 3 )) + & A ( 2 , 3 ) * ( A ( 3 , 4 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 2 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 2 )))& - A ( 1 , 2 ) * ( A ( 2 , 1 ) * ( A ( 3 , 3 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 3 )) + & A ( 2 , 3 ) * ( A ( 3 , 4 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 1 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 1 )))& + A ( 1 , 3 ) * ( A ( 2 , 1 ) * ( A ( 3 , 2 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 2 )) + & A ( 2 , 2 ) * ( A ( 3 , 4 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 1 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 1 )))& - A ( 1 , 4 ) * ( A ( 2 , 1 ) * ( A ( 3 , 2 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 2 )) + & A ( 2 , 2 ) * ( A ( 3 , 3 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 3 )) + A ( 2 , 3 ) * ( A ( 3 , 1 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 1 )))) ! Calculate the inverse of the matrix B ( 1 , 1 ) = detinv * ( A ( 2 , 2 ) * ( A ( 3 , 3 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 3 )) + & A ( 2 , 3 ) * ( A ( 3 , 4 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 2 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 2 ))) B ( 2 , 1 ) = detinv * ( A ( 2 , 1 ) * ( A ( 3 , 4 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 4 )) + & A ( 2 , 3 ) * ( A ( 3 , 1 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 1 )) + A ( 2 , 4 ) * ( A ( 3 , 3 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 3 ))) B ( 3 , 1 ) = detinv * ( A ( 2 , 1 ) * ( A ( 3 , 2 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 2 )) + & A ( 2 , 2 ) * ( A ( 3 , 4 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 1 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 1 ))) B ( 4 , 1 ) = detinv * ( A ( 2 , 1 ) * ( A ( 3 , 3 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 3 )) + & A ( 2 , 2 ) * ( A ( 3 , 1 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 1 )) + A ( 2 , 3 ) * ( A ( 3 , 2 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 2 ))) B ( 1 , 2 ) = detinv * ( A ( 1 , 2 ) * ( A ( 3 , 4 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 4 )) + & A ( 1 , 3 ) * ( A ( 3 , 2 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 2 )) + A ( 1 , 4 ) * ( A ( 3 , 3 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 3 ))) B ( 2 , 2 ) = detinv * ( A ( 1 , 1 ) * ( A ( 3 , 3 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 3 )) + & A ( 1 , 3 ) * ( A ( 3 , 4 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 4 )) + A ( 1 , 4 ) * ( A ( 3 , 1 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 1 ))) B ( 3 , 2 ) = detinv * ( A ( 1 , 1 ) * ( A ( 3 , 4 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 4 )) + & A ( 1 , 2 ) * ( A ( 3 , 1 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 1 )) + A ( 1 , 4 ) * ( A ( 3 , 2 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 2 ))) B ( 4 , 2 ) = detinv * ( A ( 1 , 1 ) * ( A ( 3 , 2 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 2 )) + & A ( 1 , 2 ) * ( A ( 3 , 3 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 3 )) + A ( 1 , 3 ) * ( A ( 3 , 1 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 1 ))) B ( 1 , 3 ) = detinv * ( A ( 1 , 2 ) * ( A ( 2 , 3 ) * A ( 4 , 4 ) - A ( 2 , 4 ) * A ( 4 , 3 )) + & A ( 1 , 3 ) * ( A ( 2 , 4 ) * A ( 4 , 2 ) - A ( 2 , 2 ) * A ( 4 , 4 )) + A ( 1 , 4 ) * ( A ( 2 , 2 ) * A ( 4 , 3 ) - A ( 2 , 3 ) * A ( 4 , 2 ))) B ( 2 , 3 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 4 ) * A ( 4 , 3 ) - A ( 2 , 3 ) * A ( 4 , 4 )) + & A ( 1 , 3 ) * ( A ( 2 , 1 ) * A ( 4 , 4 ) - A ( 2 , 4 ) * A ( 4 , 1 )) + A ( 1 , 4 ) * ( A ( 2 , 3 ) * A ( 4 , 1 ) - A ( 2 , 1 ) * A ( 4 , 3 ))) B ( 3 , 3 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 2 ) * A ( 4 , 4 ) - A ( 2 , 4 ) * A ( 4 , 2 )) + & A ( 1 , 2 ) * ( A ( 2 , 4 ) * A ( 4 , 1 ) - A ( 2 , 1 ) * A ( 4 , 4 )) + A ( 1 , 4 ) * ( A ( 2 , 1 ) * A ( 4 , 2 ) - A ( 2 , 2 ) * A ( 4 , 1 ))) B ( 4 , 3 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 3 ) * A ( 4 , 2 ) - A ( 2 , 2 ) * A ( 4 , 3 )) + & A ( 1 , 2 ) * ( A ( 2 , 1 ) * A ( 4 , 3 ) - A ( 2 , 3 ) * A ( 4 , 1 )) + A ( 1 , 3 ) * ( A ( 2 , 2 ) * A ( 4 , 1 ) - A ( 2 , 1 ) * A ( 4 , 2 ))) B ( 1 , 4 ) = detinv * ( A ( 1 , 2 ) * ( A ( 2 , 4 ) * A ( 3 , 3 ) - A ( 2 , 3 ) * A ( 3 , 4 )) + & A ( 1 , 3 ) * ( A ( 2 , 2 ) * A ( 3 , 4 ) - A ( 2 , 4 ) * A ( 3 , 2 )) + A ( 1 , 4 ) * ( A ( 2 , 3 ) * A ( 3 , 2 ) - A ( 2 , 2 ) * A ( 3 , 3 ))) B ( 2 , 4 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 3 ) * A ( 3 , 4 ) - A ( 2 , 4 ) * A ( 3 , 3 )) + & A ( 1 , 3 ) * ( A ( 2 , 4 ) * A ( 3 , 1 ) - A ( 2 , 1 ) * A ( 3 , 4 )) + A ( 1 , 4 ) * ( A ( 2 , 1 ) * A ( 3 , 3 ) - A ( 2 , 3 ) * A ( 3 , 1 ))) B ( 3 , 4 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 4 ) * A ( 3 , 2 ) - A ( 2 , 2 ) * A ( 3 , 4 )) + & A ( 1 , 2 ) * ( A ( 2 , 1 ) * A ( 3 , 4 ) - A ( 2 , 4 ) * A ( 3 , 1 )) + A ( 1 , 4 ) * ( A ( 2 , 2 ) * A ( 3 , 1 ) - A ( 2 , 1 ) * A ( 3 , 2 ))) B ( 4 , 4 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 2 ) * A ( 3 , 3 ) - A ( 2 , 3 ) * A ( 3 , 2 )) + & A ( 1 , 2 ) * ( A ( 2 , 3 ) * A ( 3 , 1 ) - A ( 2 , 1 ) * A ( 3 , 3 )) + A ( 1 , 3 ) * ( A ( 2 , 1 ) * A ( 3 , 2 ) - A ( 2 , 2 ) * A ( 3 , 1 ))) end function invert","tags":"","loc":"proc/invert.html"},{"title":"mat_add_scal – signedMCRT","text":"private function mat_add_scal(a, b) Matrix + Scalar = Matrix Type Bound mat Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to add Return Value type( mat ) Contents Source Code mat_add_scal Source Code type ( mat ) function mat_add_scal ( a , b ) !! Matrix + Scalar = Matrix !> Input Matrix class ( mat ), intent ( IN ) :: a !> Scalar to add real ( kind = wp ), intent ( IN ) :: b mat_add_scal % vals = a % vals + b end function mat_add_scal","tags":"","loc":"proc/mat_add_scal.html"},{"title":"mat_div_scal – signedMCRT","text":"private function mat_div_scal(a, b) Matrix / scalar Type Bound mat Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to divide by Return Value type( mat ) Contents Source Code mat_div_scal Source Code type ( mat ) function mat_div_scal ( a , b ) !! Matrix / scalar !> Input Matrix class ( mat ), intent ( IN ) :: a !> Scalar to divide by real ( kind = wp ), intent ( IN ) :: b mat_div_scal % vals = a % vals / b end function mat_div_scal","tags":"","loc":"proc/mat_div_scal.html"},{"title":"mat_init – signedMCRT","text":"private function mat_init(array) Initalise matrix type from 1D array Arguments Type Intent Optional Attributes Name real(kind=wp) :: array (16) 1D array to initalise from. Return Value type( mat ) Contents Source Code mat_init Source Code type ( mat ) function mat_init ( array ) !! Initalise matrix type from 1D array !> 1D array to initalise from. real ( kind = wp ) :: array ( 16 ) integer :: i , cnt cnt = 1 do i = 1 , 4 mat_init % vals (:, i ) = array ( cnt : cnt + 3 ) cnt = cnt + 4 end do end function mat_init","tags":"","loc":"proc/mat_init.html"},{"title":"mat_minus_scal – signedMCRT","text":"private function mat_minus_scal(a, b) Matrix - Scalar Type Bound mat Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( mat ) Contents Source Code mat_minus_scal Source Code type ( mat ) function mat_minus_scal ( a , b ) !! Matrix - Scalar !> Input Matrix class ( mat ), intent ( IN ) :: a !> Scalar to subtract real ( kind = wp ), intent ( IN ) :: b mat_minus_scal % vals = a % vals - b end function mat_minus_scal","tags":"","loc":"proc/mat_minus_scal.html"},{"title":"mat_mult_mat – signedMCRT","text":"private function mat_mult_mat(a, b) Uses vec4_class Matrix * vec4 Type Bound mat Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix type( vec4 ), intent(in) :: b Vec4 to multiply by Return Value type( vec4 ) Contents Source Code mat_mult_mat Source Code type ( vec4 ) function mat_mult_mat ( a , b ) !! Matrix * vec4 use vec4_class !> Input Matrix class ( mat ), intent ( IN ) :: a !> Vec4 to multiply by type ( vec4 ), intent ( IN ) :: b real ( kind = wp ) :: tmp ( 4 ) tmp = matmul ( a % vals , [ b % x , b % y , b % z , b % p ]) mat_mult_mat = vec4 ( tmp ( 1 ), tmp ( 2 ), tmp ( 3 ), tmp ( 4 )) end function mat_mult_mat","tags":"","loc":"proc/mat_mult_mat.html"},{"title":"mat_mult_scal – signedMCRT","text":"private function mat_mult_scal(a, b) Matrix * Scalar Type Bound mat Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( mat ) Contents Source Code mat_mult_scal Source Code type ( mat ) function mat_mult_scal ( a , b ) !! Matrix * Scalar !> Input Matrix class ( mat ), intent ( IN ) :: a !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: b mat_mult_scal % vals = a % vals * b end function mat_mult_scal","tags":"","loc":"proc/mat_mult_scal.html"},{"title":"scal_add_mat – signedMCRT","text":"private function scal_add_mat(a, b) Scaler + Matrix Type Bound mat Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalat to add class( mat ), intent(in) :: b Input Matrix Return Value type( mat ) Contents Source Code scal_add_mat Source Code type ( mat ) function scal_add_mat ( a , b ) !! Scaler + Matrix !> Input Matrix class ( mat ), intent ( IN ) :: b !> Scalat to add real ( kind = wp ), intent ( IN ) :: a scal_add_mat % vals = b % vals + a end function scal_add_mat","tags":"","loc":"proc/scal_add_mat.html"},{"title":"scal_mult_mat – signedMCRT","text":"private function scal_mult_mat(a, b) Matrix * Scalar Type Bound mat Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( mat ), intent(in) :: b Input Matrix Return Value type( mat ) Contents Source Code scal_mult_mat Source Code type ( mat ) function scal_mult_mat ( a , b ) !! Matrix * Scalar !> Input Matrix class ( mat ), intent ( IN ) :: b !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: a scal_mult_mat % vals = b % vals * a end function scal_mult_mat","tags":"","loc":"proc/scal_mult_mat.html"},{"title":"mat – signedMCRT","text":"public interface mat Intalise Matrix with 1D Array Contents Module Procedures mat_init Module Procedures private function mat_init (array) Initalise matrix type from 1D array Arguments Type Intent Optional Attributes Name real(kind=wp) :: array (16) 1D array to initalise from. Return Value type( mat )","tags":"","loc":"interface/mat.html"},{"title":"histempty_fn – signedMCRT","text":"private function histempty_fn(this) Type Bound history_stack_t Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Return Value logical Contents Source Code histempty_fn Source Code logical function histempty_fn ( this ) class ( history_stack_t ) :: this histempty_fn = ( this % size == 0 . or . . not . allocated ( this % data )) end function histempty_fn","tags":"","loc":"proc/histempty_fn.html"},{"title":"histpeek_fn – signedMCRT","text":"private function histpeek_fn(this) Type Bound history_stack_t Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Return Value type( vec4 ) Contents Source Code histpeek_fn Source Code type ( vec4 ) function histpeek_fn ( this ) class ( history_stack_t ) :: this if ( this % size == 0 . or . . not . allocated ( this % data )) then histpeek_fn = vec4 ( - 9 9._wp , - 9 9._wp , - 9 9._wp , - 9 9._wp ) return end if histpeek_fn = this % data ( this % size ) end function histpeek_fn","tags":"","loc":"proc/histpeek_fn.html"},{"title":"histpop_fn – signedMCRT","text":"private function histpop_fn(this) Type Bound history_stack_t Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Return Value type( vec4 ) Contents Source Code histpop_fn Source Code type ( vec4 ) function histpop_fn ( this ) class ( history_stack_t ) :: this if ( this % size == 0 . or . . not . allocated ( this % data )) then histpop_fn = vec4 ( - 9 9._wp , - 9 9._wp , - 9 9._wp , - 9 9._wp ) return end if histpop_fn = this % data ( this % size ) this % size = this % size - 1 end function histpop_fn","tags":"","loc":"proc/histpop_fn.html"},{"title":"init_historyStack – signedMCRT","text":"private function init_historyStack(filename, id) Uses utils constants Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: filename integer, intent(in) :: id Return Value type( history_stack_t ) Contents Source Code init_historyStack Source Code type ( history_stack_t ) function init_historyStack ( filename , id ) use utils , only : str use constants , only : fileplace character ( * ), intent ( in ) :: filename integer , intent ( in ) :: id character ( len = :), allocatable :: new_filename integer :: idx logical :: res idx = index ( filename , \".\" ) new_filename = filename ( 1 : idx - 1 ) // \"_\" // str ( id , 3 ) // filename ( idx :) init_historyStack % filename = new_filename if ( index ( new_filename , \"obj\" ) /= 0 ) then init_historyStack % type = \"obj\" elseif ( index ( new_filename , \"ply\" ) /= 0 ) then init_historyStack % type = \"ply\" elseif ( index ( new_filename , \"json\" ) /= 0 ) then init_historyStack % type = \"json\" else error stop \"Unsupported filetype for track History!\" end if inquire ( file = trim ( fileplace ) // new_filename , exist = res ) if ( res ) then print * , \"Deleting existing trackHistory files!\" call execute_command_line ( \"rm \" // trim ( fileplace ) // new_filename ) call execute_command_line ( \"rm \" // trim ( fileplace ) // \"scalars000.dat\" ) call execute_command_line ( \"rm \" // trim ( fileplace ) // new_filename // \"2\" ) end if init_historyStack % size = 0 init_historyStack % vertex_counter = 0 init_historyStack % edge_counter = 0 end function init_historyStack","tags":"","loc":"proc/init_historystack.html"},{"title":"histfinish_sub – signedMCRT","text":"private subroutine histfinish_sub(this) Uses utils constants Type Bound history_stack_t Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Contents Source Code histfinish_sub Source Code subroutine histfinish_sub ( this ) use constants , only : fileplace use utils , only : str class ( history_stack_t ) :: this integer :: u select case ( trim ( this % type )) case ( \"obj\" ) call execute_command_line ( \"cat \" // trim ( fileplace ) // this % filename // \"2 >> \" // trim ( fileplace ) // this % filename ) case ( \"ply\" ) ! this is the easiest way to edit the vertex count as we don't know how many photons we will track when writing the header. ! this saves storing all photons data in RAM for duration of simulation. ! taken from: https://stackoverflow.com/a/11145362 call execute_command_line ( \"sed -i '3s#.*#element vertex \" // str ( this % vertex_counter ) // \"#' \" // trim ( fileplace ) // this % filename ) call execute_command_line ( \"sed -i '7s#.*#element edge \" // str ( this % edge_counter ) // \"#' \" // trim ( fileplace ) // this % filename ) call execute_command_line ( \"cat \" // trim ( fileplace ) // this % filename // \"2 >> \" // trim ( fileplace ) // this % filename ) case ( \"json\" ) open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"old\" , position = \"append\" ) write ( u , \"(a)\" ) \"}\" close ( u ) case default error stop \"No such output type \" // this % type end select end subroutine histfinish_sub","tags":"","loc":"proc/histfinish_sub.html"},{"title":"histpush_sub – signedMCRT","text":"private subroutine histpush_sub(this, val) Type Bound history_stack_t Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this type( vec4 ), intent(in) :: val Contents Source Code histpush_sub Source Code subroutine histpush_sub ( this , val ) class ( history_stack_t ) :: this type ( vec4 ), intent ( in ) :: val type ( vec4 ), allocatable :: tmp (:) if (. not . allocated ( this % data ) . or . size ( this % data ) == 0 ) then !allocate space if not yet allocated allocate ( this % data ( block_size )) elseif ( this % size == size ( this % data )) then allocate ( tmp ( size ( this % data ) + block_size )) tmp ( 1 : this % size ) = this % data call move_alloc ( tmp , this % data ) end if this % size = this % size + 1 this % data ( this % size ) = val end subroutine histpush_sub","tags":"","loc":"proc/histpush_sub.html"},{"title":"histwrite_sub – signedMCRT","text":"private subroutine histwrite_sub(this) Type Bound history_stack_t Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Contents Source Code histwrite_sub Source Code subroutine histwrite_sub ( this ) class ( history_stack_t ) :: this select case ( this % type ) case ( \"obj\" ) call obj_writer ( this ) case ( \"ply\" ) call ply_writer ( this ) case ( \"json\" ) call json_writer ( this ) case default error stop \"No such output type \" // this % type end select end subroutine histwrite_sub","tags":"","loc":"proc/histwrite_sub.html"},{"title":"histzero_sub – signedMCRT","text":"private subroutine histzero_sub(this) Type Bound history_stack_t Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Contents Source Code histzero_sub Source Code subroutine histzero_sub ( this ) class ( history_stack_t ) :: this if ( allocated ( this % data )) deallocate ( this % data ) this % size = 0 end subroutine histzero_sub","tags":"","loc":"proc/histzero_sub.html"},{"title":"json_writer – signedMCRT","text":"private subroutine json_writer(this) Uses utils constants Arguments Type Intent Optional Attributes Name type( history_stack_t ), intent(inout) :: this Contents Source Code json_writer Source Code subroutine json_writer ( this ) use constants , only : fileplace use utils , only : str type ( history_stack_t ), intent ( inout ) :: this logical :: res integer :: id , u integer , save :: counter = 0 type ( vec4 ) :: v id = 0 !omp_() if ( id == 0 ) then inquire ( file = trim ( fileplace ) // this % filename , exist = res ) if ( res ) then open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"old\" , position = \"append\" ) write ( u , \"(a)\" ) \",\" // new_line ( \"a\" ) // '\"' // str ( counter ) // '_' // str ( id ) // '\": ' // \"[\" else open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"new\" ) write ( u , \"(a)\" ) \"{\" // new_line ( \"a\" ) // '\"' // str ( counter ) // '_' // str ( id ) // '\": ' // \"[\" end if counter = counter + 1 do while (. not . this % empty ()) v = this % pop () if ( this % size /= 0 ) then write ( u , \"(a,3(es15.8e2,a))\" ) \"[\" , v % x , \",\" , v % y , \",\" , v % z , \"],\" else write ( u , \"(a,3(es15.8e2,a))\" ) \"[\" , v % x , \",\" , v % y , \",\" , v % z , \"]\" end if end do write ( u , \"(a)\" ) \"]\" close ( u ) end if end subroutine json_writer","tags":"","loc":"proc/json_writer.html"},{"title":"obj_writer – signedMCRT","text":"private subroutine obj_writer(this) Uses utils constants omp_lib Arguments Type Intent Optional Attributes Name type( history_stack_t ), intent(inout) :: this Contents Source Code obj_writer Source Code subroutine obj_writer ( this ) use constants , only : fileplace use utils , only : str use omp_lib type ( history_stack_t ), intent ( inout ) :: this type ( vec4 ) :: v integer :: u , io , id , counter , ioi logical :: res id = 0 inquire ( file = trim ( fileplace ) // this % filename , exist = res ) if ( res ) then open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"old\" , position = \"append\" ) open ( newunit = io , file = trim ( fileplace ) // this % filename // \"2\" , status = \"old\" , position = \"append\" ) open ( newunit = ioi , file = trim ( fileplace ) // \"scalars\" // str ( id , 3 ) // \".dat\" , status = \"old\" , position = \"append\" ) else open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"new\" ) open ( newunit = io , file = trim ( fileplace ) // this % filename // \"2\" , status = \"new\" ) open ( newunit = ioi , file = trim ( fileplace ) // \"scalars\" // str ( id , 3 ) // \".dat\" , status = \"new\" ) end if v = this % pop () ! write lines if ( this % size >= 1 ) write ( io , \"(a)\" , advance = \"no\" ) \"l \" do counter = this % vertex_counter + 1 , this % vertex_counter + this % size , 2 write ( io , \"(2(i0,1x))\" , advance = \"no\" ) counter , counter + 1 end do close ( io ) !write vertices do while (. not . this % empty ()) v = this % pop () write ( u , \"(a,1x,3(es15.8e2,1x))\" ) \"v\" , v % x , v % y , v % z write ( ioi , \"(es15.8e2)\" ) v % p this % vertex_counter = this % vertex_counter + 1 end do close ( u ) close ( ioi ) end subroutine obj_writer","tags":"","loc":"proc/obj_writer.html"},{"title":"ply_writer – signedMCRT","text":"private subroutine ply_writer(this) Uses utils constants Arguments Type Intent Optional Attributes Name type( history_stack_t ), intent(inout) :: this Contents Source Code ply_writer Source Code subroutine ply_writer ( this ) use constants , only : fileplace use utils , only : str type ( history_stack_t ), intent ( inout ) :: this integer :: io , counter , i , u logical :: res type ( vec4 ) :: v inquire ( file = trim ( fileplace ) // this % filename , exist = res ) if ( res ) then open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"old\" , position = \"append\" ) else open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"new\" ) write ( u , \"(a)\" ) \"ply\" // new_line ( \"a\" ) // \"format ascii 1.0\" // new_line ( \"a\" ) // \"element vertex \" // str ( this % size ) write ( u , \"(a)\" ) \"property float x\" write ( u , \"(a)\" ) \"property float y\" write ( u , \"(a)\" ) \"property float z\" write ( u , \"(a)\" ) \"element edge\" write ( u , \"(a)\" ) \"property int vertex1\" write ( u , \"(a)\" ) \"property int vertex2\" write ( u , \"(a)\" ) \"end_header\" end if inquire ( file = trim ( fileplace ) // this % filename // \"2\" , exist = res ) if ( res ) then open ( newunit = io , file = trim ( fileplace ) // this % filename // \"2\" , status = \"old\" , position = \"append\" ) else open ( newunit = io , file = trim ( fileplace ) // this % filename // \"2\" , status = \"new\" ) end if counter = this % vertex_counter do i = 1 , this % size - 1 write ( io , \"(2(i0,1x))\" ) counter , counter + 1 counter = counter + 1 this % edge_counter = this % edge_counter + 1 end do close ( io ) do while (. not . this % empty ()) v = this % pop () write ( u , \"(3(es15.8e2,1x))\" ) v % x , v % y , v % z this % vertex_counter = this % vertex_counter + 1 end do close ( u ) end subroutine ply_writer","tags":"","loc":"proc/ply_writer.html"},{"title":"history_stack_t – signedMCRT","text":"public interface history_stack_t Contents Module Procedures init_historyStack Module Procedures private function init_historyStack (filename, id) Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: filename integer, intent(in) :: id Return Value type( history_stack_t )","tags":"","loc":"interface/history_stack_t.html"},{"title":"abs_vec – signedMCRT","text":"private pure elemental function abs_vec(this) Calculate the absoulte of a vector elementwise Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value type( vector ) Contents Source Code abs_vec Source Code type ( vector ) pure elemental function abs_vec ( this ) !! Calculate the absoulte of a vector elementwise !> Input vector type ( vector ), intent ( IN ) :: this abs_vec = vector ( abs ( this % x ), abs ( this % y ), abs ( this % z )) end function abs_vec","tags":"","loc":"proc/abs_vec.html"},{"title":"length – signedMCRT","text":"public pure elemental function length(this) Returns the length of a vec3 Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: this Return Value real(kind=wp) Contents","tags":"","loc":"proc/length.html"},{"title":"magnitude – signedMCRT","text":"public pure elemental function magnitude(this) Returns the magnitude of a vec3 Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: this Return Value type( vector ) Contents Source Code magnitude Source Code type ( vector ) pure elemental function magnitude ( this ) !! Returns the magnitude of a vec3 class ( vector ), intent ( in ) :: this real ( kind = wp ) :: tmp tmp = this % length () magnitude = this / tmp end function magnitude","tags":"","loc":"proc/magnitude.html"},{"title":"max_vec – signedMCRT","text":"private pure elemental function max_vec(this, val) Get the max value elementwise between a vec3 and a scalar Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector real(kind=wp), intent(in) :: val Input max value Return Value type( vector ) Contents Source Code max_vec Source Code type ( vector ) pure elemental function max_vec ( this , val ) !! Get the max value elementwise between a vec3 and a scalar !> Input vector type ( vector ), intent ( IN ) :: this !> Input max value real ( kind = wp ), intent ( IN ) :: val max_vec = vector ( max ( this % x , val ), max ( this % y , val ), max ( this % z , val )) end function max_vec","tags":"","loc":"proc/max_vec.html"},{"title":"maxval_vec – signedMCRT","text":"private pure elemental function maxval_vec(this) Get the max value in a vec3 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value real(kind=wp) Contents","tags":"","loc":"proc/maxval_vec.html"},{"title":"min_vec – signedMCRT","text":"private pure elemental function min_vec(this, val) Get the min value elementwise between a vec3 and a scalar Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector real(kind=wp), intent(in) :: val Input minimum value Return Value type( vector ) Contents Source Code min_vec Source Code type ( vector ) pure elemental function min_vec ( this , val ) !! Get the min value elementwise between a vec3 and a scalar !> Input vector type ( vector ), intent ( IN ) :: this !> Input minimum value real ( kind = wp ), intent ( IN ) :: val min_vec = vector ( min ( this % x , val ), min ( this % y , val ), min ( this % z , val )) end function min_vec","tags":"","loc":"proc/min_vec.html"},{"title":"minval_vec – signedMCRT","text":"private pure elemental function minval_vec(this) Get the min value in a vec3 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value real(kind=wp) Contents","tags":"","loc":"proc/minval_vec.html"},{"title":"nint_vec – signedMCRT","text":"private pure elemental function nint_vec(this) Overload the nint intrinsic for a vec3 elementwise Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value type( vector ) Contents Source Code nint_vec Source Code type ( vector ) pure elemental function nint_vec ( this ) !! Overload the nint intrinsic for a vec3 elementwise !> Input vector type ( vector ), intent ( IN ) :: this nint_vec = vector ( real ( nint ( this % x ), kind = wp ), real ( nint ( this % y ), kind = wp ), real ( nint ( this % z ), kind = wp )) end function nint_vec","tags":"","loc":"proc/nint_vec.html"},{"title":"scal_add_vec – signedMCRT","text":"private pure elemental function scal_add_vec(a, b) vec3 + scalar Type Bound vector Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to add class( vector ), intent(in) :: b Input vector Return Value type( vector ) Contents Source Code scal_add_vec Source Code type ( vector ) pure elemental function scal_add_vec ( a , b ) !! vec3 + scalar !> Input vector class ( vector ), intent ( IN ) :: b !> Scalar to add real ( kind = wp ), intent ( IN ) :: a scal_add_vec = vector ( b % x + a , b % y + a , b % z + a ) end function scal_add_vec","tags":"","loc":"proc/scal_add_vec.html"},{"title":"scal_minus_vec – signedMCRT","text":"private pure elemental function scal_minus_vec(a, b) scalar - vec3 Type Bound vector Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to subtract from class( vector ), intent(in) :: b Input vector Return Value type( vector ) Contents Source Code scal_minus_vec Source Code type ( vector ) pure elemental function scal_minus_vec ( a , b ) !! scalar - vec3 !> Input vector class ( vector ), intent ( IN ) :: b !> Scalar to subtract from real ( kind = wp ), intent ( IN ) :: a scal_minus_vec = vector ( a - b % x , a - b % y , a - b % z ) end function scal_minus_vec","tags":"","loc":"proc/scal_minus_vec.html"},{"title":"scal_mult_vec – signedMCRT","text":"private pure elemental function scal_mult_vec(a, b) Scalar * vec3 elementwise Type Bound vector Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( vector ), intent(in) :: b input vec3 Return Value type( vector ) Contents Source Code scal_mult_vec Source Code type ( vector ) pure elemental function scal_mult_vec ( a , b ) !! Scalar * vec3 elementwise !> input vec3 class ( vector ), intent ( IN ) :: b !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: a scal_mult_vec = vector ( a * b % x , a * b % y , a * b % z ) end function scal_mult_vec","tags":"","loc":"proc/scal_mult_vec.html"},{"title":"vec_add_scal – signedMCRT","text":"private pure elemental function vec_add_scal(a, b) vec3 + scalar Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector real(kind=wp), intent(in) :: b Scalar to add Return Value type( vector ) Contents Source Code vec_add_scal Source Code type ( vector ) pure elemental function vec_add_scal ( a , b ) !! vec3 + scalar !> Input vector class ( vector ), intent ( IN ) :: a !> Scalar to add real ( kind = wp ), intent ( IN ) :: b vec_add_scal = vector ( a % x + b , a % y + b , a % z + b ) end function vec_add_scal","tags":"","loc":"proc/vec_add_scal.html"},{"title":"vec_add_vec – signedMCRT","text":"private pure elemental function vec_add_vec(a, b) vec3 + vec3 Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b Vec3 to add Return Value type( vector ) Contents Source Code vec_add_vec Source Code type ( vector ) pure elemental function vec_add_vec ( a , b ) !! vec3 + vec3 !> Input vector class ( vector ), intent ( IN ) :: a !> Vec3 to add type ( vector ), intent ( IN ) :: b vec_add_vec = vector ( a % x + b % x , a % y + b % y , a % z + b % z ) end function vec_add_vec","tags":"","loc":"proc/vec_add_vec.html"},{"title":"vec_cross_vec – signedMCRT","text":"private pure elemental function vec_cross_vec(a, b) result(cross) vec3 x vec3 Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b vec3 to cross with Return Value type( vector ) Contents Source Code vec_cross_vec Source Code pure elemental function vec_cross_vec ( a , b ) result ( cross ) !! vec3 x vec3 !> Input vector class ( vector ), intent ( in ) :: a !> vec3 to cross with type ( vector ), intent ( in ) :: b type ( vector ) :: cross cross % x = a % y * b % z - a % z * b % y cross % y = - a % x * b % z + a % z * b % x cross % z = a % x * b % y - a % y * b % x end function vec_cross_vec","tags":"","loc":"proc/vec_cross_vec.html"},{"title":"vec_div_scal_int – signedMCRT","text":"private pure elemental function vec_div_scal_int(a, b) vec3 / scalar elementwise. Scalar is an integer Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 integer, intent(in) :: b Scalar to divide by Return Value type( vector ) Contents Source Code vec_div_scal_int Source Code type ( vector ) pure elemental function vec_div_scal_int ( a , b ) !! vec3 / scalar elementwise. Scalar is an integer !> input vec3 class ( vector ), intent ( IN ) :: a !> Scalar to divide by integer , intent ( IN ) :: b vec_div_scal_int = vector ( a % x / real ( b , kind = wp ), a % y / real ( b , kind = wp ), a % z / real ( b , kind = wp )) end function vec_div_scal_int","tags":"","loc":"proc/vec_div_scal_int.html"},{"title":"vec_div_scal_r4 – signedMCRT","text":"private pure elemental function vec_div_scal_r4(a, b) Uses constants vec3 / scalar elementwise. Scalar is a 32-bit float Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=sp), intent(in) :: b Scalar to divide by Return Value type( vector ) Contents Source Code vec_div_scal_r4 Source Code type ( vector ) pure elemental function vec_div_scal_r4 ( a , b ) !! vec3 / scalar elementwise. Scalar is a 32-bit float use constants , only : sp !> input vec3 class ( vector ), intent ( IN ) :: a !> Scalar to divide by real ( kind = sp ), intent ( IN ) :: b vec_div_scal_r4 = vector ( a % x / b , a % y / b , a % z / b ) end function vec_div_scal_r4","tags":"","loc":"proc/vec_div_scal_r4.html"},{"title":"vec_div_scal_r8 – signedMCRT","text":"private pure elemental function vec_div_scal_r8(a, b) Uses constants vec3 / scalar elementwise. Scalar is a 64-bit float Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=dp), intent(in) :: b Scalar to divide by Return Value type( vector ) Contents Source Code vec_div_scal_r8 Source Code type ( vector ) pure elemental function vec_div_scal_r8 ( a , b ) !! vec3 / scalar elementwise. Scalar is a 64-bit float use constants , only : dp !> input vec3 class ( vector ), intent ( IN ) :: a !> Scalar to divide by real ( kind = dp ), intent ( IN ) :: b vec_div_scal_r8 = vector ( a % x / b , a % y / b , a % z / b ) end function vec_div_scal_r8","tags":"","loc":"proc/vec_div_scal_r8.html"},{"title":"vec_dot_mat – signedMCRT","text":"private pure function vec_dot_mat(a, b) result(dot) vec3 . matrix Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3 real(kind=wp), intent(in) :: b (4,4) Matrix to dot with Return Value type( vector ) Contents Source Code vec_dot_mat Source Code pure function vec_dot_mat ( a , b ) result ( dot ) !! vec3 . matrix !> Input vec3 class ( vector ), intent ( IN ) :: a !> Matrix to dot with real ( kind = wp ), intent ( IN ) :: b ( 4 , 4 ) type ( vector ) :: dot dot % x = b ( 1 , 1 ) * a % x + b ( 2 , 1 ) * a % y + b ( 3 , 1 ) * a % z + b ( 4 , 1 ) * 1. dot % y = b ( 1 , 2 ) * a % x + b ( 2 , 2 ) * a % y + b ( 3 , 2 ) * a % z + b ( 4 , 2 ) * 1. dot % z = b ( 1 , 3 ) * a % x + b ( 2 , 3 ) * a % y + b ( 3 , 3 ) * a % z + b ( 4 , 3 ) * 1. end function vec_dot_mat","tags":"","loc":"proc/vec_dot_mat.html"},{"title":"vec_dot_vec – signedMCRT","text":"private pure elemental function vec_dot_vec(a, b) result(dot) vec3 . vec3 Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3 type( vector ), intent(in) :: b vec3 to dot Return Value real(kind=wp) Contents Source Code vec_dot_vec Source Code pure elemental function vec_dot_vec ( a , b ) result ( dot ) !! vec3 . vec3 !> Input vec3 class ( vector ), intent ( IN ) :: a !> vec3 to dot type ( vector ), intent ( IN ) :: b real ( kind = wp ) :: dot dot = ( a % x * b % x ) + ( a % y * b % y ) + ( a % z * b % z ) end function vec_dot_vec","tags":"","loc":"proc/vec_dot_vec.html"},{"title":"vec_equal_vec – signedMCRT","text":"private pure elemental function vec_equal_vec(a, b) vec3 == vec3 Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3s class( vector ), intent(in) :: b Input vec3s Return Value logical Contents Source Code vec_equal_vec Source Code logical pure elemental function vec_equal_vec ( a , b ) !! vec3 == vec3 !> Input vec3s class ( vector ), intent ( in ) :: a , b vec_equal_vec = . false . if ( a % x == b % x ) then if ( a % y == b % y ) then if ( a % z == b % z ) then vec_equal_vec = . true . end if end if end if end function vec_equal_vec","tags":"","loc":"proc/vec_equal_vec.html"},{"title":"vec_minus_scal – signedMCRT","text":"private pure elemental function vec_minus_scal(a, b) vec3 - scalar Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( vector ) Contents Source Code vec_minus_scal Source Code type ( vector ) pure elemental function vec_minus_scal ( a , b ) !! vec3 - scalar !> Input vector class ( vector ), intent ( IN ) :: a !> Scalar to subtract real ( kind = wp ), intent ( IN ) :: b vec_minus_scal = vector ( a % x - b , a % y - b , a % z - b ) end function vec_minus_scal","tags":"","loc":"proc/vec_minus_scal.html"},{"title":"vec_minus_vec – signedMCRT","text":"private pure elemental function vec_minus_vec(a, b) vec3 - vec3 Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b vec3 to subtract Return Value type( vector ) Contents Source Code vec_minus_vec Source Code type ( vector ) pure elemental function vec_minus_vec ( a , b ) !! vec3 - vec3 !> Input vector class ( vector ), intent ( IN ) :: a !> vec3 to subtract type ( vector ), intent ( IN ) :: b vec_minus_vec = vector ( a % x - b % x , a % y - b % y , a % z - b % z ) end function vec_minus_vec","tags":"","loc":"proc/vec_minus_vec.html"},{"title":"vec_mult_exp_scal_int – signedMCRT","text":"private pure elemental function vec_mult_exp_scal_int(a, b) vec3**scalar for integer scalar Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector integer, intent(in) :: b Input scalar Return Value type( vector ) Contents Source Code vec_mult_exp_scal_int Source Code type ( vector ) pure elemental function vec_mult_exp_scal_int ( a , b ) !! vec3**scalar for integer scalar !> Input Vector class ( vector ), intent ( in ) :: a !> Input scalar integer , intent ( in ) :: b vec_mult_exp_scal_int = vector ( a % x ** b , a % y ** b , a % z ** b ) end function vec_mult_exp_scal_int","tags":"","loc":"proc/vec_mult_exp_scal_int.html"},{"title":"vec_mult_exp_scal_r4 – signedMCRT","text":"private pure elemental function vec_mult_exp_scal_r4(a, b) Uses constants vec3**scalar for 32-bit float scalar Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector real(kind=sp), intent(in) :: b Input scalar Return Value type( vector ) Contents Source Code vec_mult_exp_scal_r4 Source Code type ( vector ) pure elemental function vec_mult_exp_scal_r4 ( a , b ) !! vec3**scalar for 32-bit float scalar use constants , only : sp !> Input Vector class ( vector ), intent ( in ) :: a !> Input scalar real ( kind = sp ), intent ( in ) :: b vec_mult_exp_scal_r4 = vector ( a % x ** b , a % y ** b , a % z ** b ) end function vec_mult_exp_scal_r4","tags":"","loc":"proc/vec_mult_exp_scal_r4.html"},{"title":"vec_mult_exp_scal_r8 – signedMCRT","text":"private pure elemental function vec_mult_exp_scal_r8(a, b) Uses constants vec3**scalar for 64-bit float scalar Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector real(kind=dp), intent(in) :: b Input scalar Return Value type( vector ) Contents Source Code vec_mult_exp_scal_r8 Source Code type ( vector ) pure elemental function vec_mult_exp_scal_r8 ( a , b ) !! vec3**scalar for 64-bit float scalar use constants , only : dp !> Input Vector class ( vector ), intent ( in ) :: a !> Input scalar real ( kind = dp ), intent ( in ) :: b vec_mult_exp_scal_r8 = vector ( a % x ** b , a % y ** b , a % z ** b ) end function vec_mult_exp_scal_r8","tags":"","loc":"proc/vec_mult_exp_scal_r8.html"},{"title":"vec_mult_scal – signedMCRT","text":"private pure elemental function vec_mult_scal(a, b) vec3 * scalar elementwise Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( vector ) Contents Source Code vec_mult_scal Source Code type ( vector ) pure elemental function vec_mult_scal ( a , b ) !! vec3 * scalar elementwise !> input vec3 class ( vector ), intent ( IN ) :: a !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: b vec_mult_scal = vector ( a % x * b , a % y * b , a % z * b ) end function vec_mult_scal","tags":"","loc":"proc/vec_mult_scal.html"},{"title":"vec_mult_vec – signedMCRT","text":"private pure elemental function vec_mult_vec(a, b) vec3 * vec3 elementwise Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 type( vector ), intent(in) :: b vec3 to multiply by Return Value type( vector ) Contents Source Code vec_mult_vec Source Code type ( vector ) pure elemental function vec_mult_vec ( a , b ) !! vec3 * vec3 elementwise !> input vec3 class ( vector ), intent ( IN ) :: a !> vec3 to multiply by type ( vector ), intent ( IN ) :: b vec_mult_vec = vector ( a % x * b % x , a % y * b % y , a % z * b % z ) end function vec_mult_vec","tags":"","loc":"proc/vec_mult_vec.html"},{"title":"abs – signedMCRT","text":"public interface abs Overload of the abs intrinsic for a vec3 Contents Module Procedures abs_vec Module Procedures private pure elemental function abs_vec (this) Calculate the absoulte of a vector elementwise Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value type( vector )","tags":"","loc":"interface/abs.html"},{"title":"max – signedMCRT","text":"public interface max Overload of the max intrinsic for a vec3 Contents Module Procedures max_vec maxval_vec Module Procedures private pure elemental function max_vec (this, val) Get the max value elementwise between a vec3 and a scalar Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector real(kind=wp), intent(in) :: val Input max value Return Value type( vector ) private pure elemental function maxval_vec (this) Get the max value in a vec3 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value real(kind=wp)","tags":"","loc":"interface/max.html"},{"title":"min – signedMCRT","text":"public interface min Overload of the min intrinsic for a vec3 Contents Module Procedures min_vec minval_vec Module Procedures private pure elemental function min_vec (this, val) Get the min value elementwise between a vec3 and a scalar Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector real(kind=wp), intent(in) :: val Input minimum value Return Value type( vector ) private pure elemental function minval_vec (this) Get the min value in a vec3 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value real(kind=wp)","tags":"","loc":"interface/min.html"},{"title":"nint – signedMCRT","text":"public interface nint Overload of the nint intrinsic for a vec3 Contents Module Procedures nint_vec Module Procedures private pure elemental function nint_vec (this) Overload the nint intrinsic for a vec3 elementwise Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value type( vector )","tags":"","loc":"interface/nint.html"},{"title":"check_file – signedMCRT","text":"private function check_file(file) result(res) Functional wrapper around inquire to check if file exits Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: file file to be checked Return Value logical Contents Source Code check_file Source Code logical function check_file ( file ) result ( res ) !! Functional wrapper around inquire to check if file exits !> file to be checked character ( len =* ), intent ( IN ) :: file inquire ( file = trim ( file ), exist = res ) end function check_file","tags":"","loc":"proc/check_file.html"},{"title":"get_new_file_name – signedMCRT","text":"private function get_new_file_name(file) result(res) Uses utils If file exits, get numeral to append to filename Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: file file to be checked Return Value character(len=:), allocatable Contents Source Code get_new_file_name Source Code function get_new_file_name ( file ) result ( res ) !! If file exits, get numeral to append to filename use utils , only : str !> file to be checked character ( len =* ), intent ( IN ) :: file character ( len = :), allocatable :: res integer :: pos , i i = 1 do pos = scan ( trim ( file ), \".\" , back = . true .) res = file ( 1 : pos - 1 ) // \" (\" // str ( i ) // \")\" // file ( pos :) if (. not . check_file ( res )) exit i = i + 1 end do end function get_new_file_name","tags":"","loc":"proc/get_new_file_name.html"},{"title":"normalise_fluence – signedMCRT","text":"public subroutine normalise_fluence(grid, array, nphotons) Uses gridMod constants normalise fluence in the Lucy 1999 way Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid grid class real(kind=sp), intent(inout) :: array (:,:,:) array to normalise integer, intent(in) :: nphotons number of photons run Contents Source Code normalise_fluence Source Code subroutine normalise_fluence ( grid , array , nphotons ) !! normalise fluence in the Lucy 1999 way use gridMod use constants , only : sp !> grid class type ( cart_grid ), intent ( in ) :: grid !> array to normalise real ( kind = sp ), intent ( inout ) :: array (:, :, :) !> number of photons run integer , intent ( in ) :: nphotons real ( kind = wp ) :: xmax , ymax , zmax integer :: nxg , nyg , nzg nxg = grid % nxg nyg = grid % nyg nzg = grid % nzg xmax = grid % xmax ymax = grid % ymax zmax = grid % zmax array = array * (( 2._sp * xmax * 2._sp * ymax ) / ( nphotons * ( 2._sp * xmax / nxg ) * ( 2._sp * ymax / nyg ) * ( 2._sp * zmax / nzg ))) end subroutine normalise_fluence","tags":"","loc":"proc/normalise_fluence.html"},{"title":"write_3d_r4_nrrd – signedMCRT","text":"private subroutine write_3d_r4_nrrd(array, filename, overwrite, dict) Uses constants tomlf utils iso_fortran_env write 3D array of float32's to .nrrd fileformat Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to be written to disk character(len=*), intent(in) :: filename filename logical, intent(in) :: overwrite overwrite flag type(toml_table), intent(inout), optional :: dict dictionary of metadata Contents Source Code write_3d_r4_nrrd Source Code subroutine write_3d_r4_nrrd ( array , filename , overwrite , dict ) !! write 3D array of float32's to .nrrd fileformat use tomlf , only : toml_table , toml_dump , toml_error use iso_fortran_env , only : int32 , int64 , real32 , real64 use utils , only : str use constants , only : sp !> filename character ( * ), intent ( IN ) :: filename !> array to be written to disk real ( kind = sp ), intent ( IN ) :: array (:, :, :) !> dictionary of metadata type ( toml_table ), optional , intent ( INOUT ) :: dict !> overwrite flag logical , intent ( IN ) :: overwrite type ( toml_error ), allocatable :: error character ( len = :), allocatable :: file integer :: u if ( check_file ( filename ) . and . . not . overwrite ) then file = get_new_file_name ( filename ) else file = filename end if open ( newunit = u , file = file , form = \"formatted\" ) !to do fix precision call write_hdr ( u , [ size ( array , 1 ), size ( array , 2 ), size ( array , 3 )], \"float\" ) if ( present ( dict )) then call toml_dump ( dict , u , error ) end if write ( u , \"(A)\" ) new_line ( \"C\" ) close ( u ) open ( newunit = u , file = file , access = \"stream\" , form = \"unformatted\" , position = \"append\" ) write ( u ) array close ( u ) end subroutine write_3d_r4_nrrd","tags":"","loc":"proc/write_3d_r4_nrrd.html"},{"title":"write_3d_r4_raw – signedMCRT","text":"private subroutine write_3d_r4_raw(array, filename, overwrite) Uses constants write 3D array of float32's to disk as raw binary data Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to write to disk character(len=*), intent(in) :: filename filename to save array as logical, intent(in) :: overwrite overwrite flag Contents Source Code write_3d_r4_raw Source Code subroutine write_3d_r4_raw ( array , filename , overwrite ) !! write 3D array of float32's to disk as raw binary data use constants , only : sp !> array to write to disk real ( kind = sp ), intent ( IN ) :: array (:, :, :) !> filename to save array as character ( * ), intent ( IN ) :: filename !> overwrite flag logical , intent ( IN ) :: overwrite integer :: u character ( len = :), allocatable :: file if ( check_file ( filename ) . and . . not . overwrite ) then file = get_new_file_name ( filename ) else file = filename end if open ( newunit = u , file = file , access = 'stream' , status = 'REPLACE' , form = 'unformatted' ) write ( u ) array close ( u ) end subroutine write_3d_r4_raw","tags":"","loc":"proc/write_3d_r4_raw.html"},{"title":"write_3d_r8_nrrd – signedMCRT","text":"private subroutine write_3d_r8_nrrd(array, filename, overwrite, dict) Uses tomlf utils iso_fortran_env write 3D array of float64's to .nrrd fileformat Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:,:) array to be written to disk character(len=*), intent(in) :: filename filename logical, intent(in) :: overwrite overwrite flag type(toml_table), intent(inout), optional :: dict dictionary of metadata Contents Source Code write_3d_r8_nrrd Source Code subroutine write_3d_r8_nrrd ( array , filename , overwrite , dict ) !! write 3D array of float64's to .nrrd fileformat use tomlf , only : toml_table , toml_dump , toml_error use iso_fortran_env , only : int32 , int64 , real32 , real64 use utils , only : str !> filename character ( * ), intent ( IN ) :: filename !> array to be written to disk real ( kind = wp ), intent ( IN ) :: array (:, :, :) !> dictionary of metadata type ( toml_table ), optional , intent ( INOUT ) :: dict !> overwrite flag logical , intent ( IN ) :: overwrite type ( toml_error ), allocatable :: error character ( len = :), allocatable :: file integer :: u if ( check_file ( filename ) . and . . not . overwrite ) then file = get_new_file_name ( filename ) else file = filename end if open ( newunit = u , file = file , form = \"formatted\" ) !to do fix precision call write_hdr ( u , [ size ( array , 1 ), size ( array , 2 ), size ( array , 3 )], \"double\" ) if ( present ( dict )) then call toml_dump ( dict , u , error ) end if write ( u , \"(A)\" ) new_line ( \"C\" ) close ( u ) open ( newunit = u , file = file , access = \"stream\" , form = \"unformatted\" , position = \"append\" ) write ( u ) array close ( u ) end subroutine write_3d_r8_nrrd","tags":"","loc":"proc/write_3d_r8_nrrd.html"},{"title":"write_3d_r8_raw – signedMCRT","text":"private subroutine write_3d_r8_raw(array, filename, overwrite) write 3D array of float64s to disk as raw binary data Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:,:) array to write to disk character(len=*), intent(in) :: filename filename to save array as logical, intent(in) :: overwrite overwrite flag Contents Source Code write_3d_r8_raw Source Code subroutine write_3d_r8_raw ( array , filename , overwrite ) !! write 3D array of float64s to disk as raw binary data !> array to write to disk real ( kind = wp ), intent ( IN ) :: array (:, :, :) !> filename to save array as character ( * ), intent ( IN ) :: filename !> overwrite flag logical , intent ( IN ) :: overwrite integer :: u character ( len = :), allocatable :: file if ( check_file ( filename ) . and . . not . overwrite ) then file = get_new_file_name ( filename ) else file = filename end if open ( newunit = u , file = file , access = 'stream' , status = 'REPLACE' , form = 'unformatted' ) write ( u ) array close ( u ) end subroutine write_3d_r8_raw","tags":"","loc":"proc/write_3d_r8_raw.html"},{"title":"write_data – signedMCRT","text":"public subroutine write_data(array, filename, state, dict, overwrite) Uses constants tomlf sim_state_mod routine automatically selects which way to write out results based upon file extension Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to write out character(len=*), intent(in) :: filename filename to save array as type( settings_t ), intent(in) :: state simulation state type(toml_table), intent(inout), optional :: dict dictionary of metadata logical, intent(in), optional :: overwrite overwrite flag Contents Source Code write_data Source Code subroutine write_data ( array , filename , state , dict , overwrite ) !! routine automatically selects which way to write out results based upon file extension use sim_state_mod , only : settings_t use tomlf , only : toml_table , get_value use constants , only : sp !> simulation state type ( settings_t ), intent ( IN ) :: state !> array to write out real ( kind = sp ), intent ( IN ) :: array (:,:,:) !> filename to save array as character ( * ), intent ( IN ) :: filename !> dictionary of metadata type ( toml_table ), optional , intent ( INOUT ) :: dict !> overwrite flag logical , optional , intent ( IN ) :: overwrite Logical :: over_write integer :: pos if ( present ( overwrite )) then over_write = overwrite else over_write = state % overwrite end if pos = index ( filename , \".nrrd\" ) if ( pos > 0 ) then if ( present ( dict )) then call nrrd_write ( array , filename , over_write , dict ) else call nrrd_write ( array , filename , over_write ) end if return end if pos = index ( filename , \".raw\" ) if ( pos > 0 ) then call raw_write ( array , filename , over_write ) return end if pos = index ( filename , \".dat\" ) if ( pos > 0 ) then call raw_write ( array , filename , over_write ) return end if error stop \"File type not supported!\" end subroutine write_data","tags":"","loc":"proc/write_data.html"},{"title":"write_detected_photons – signedMCRT","text":"public subroutine write_detected_photons(dects) Uses constants utils detectors Arguments Type Intent Optional Attributes Name type( dect_array ), intent(in) :: dects (:) Contents Source Code write_detected_photons Source Code subroutine write_detected_photons ( dects ) use detectors use constants , only : fileplace use utils , only : str type ( dect_array ), intent ( in ) :: dects (:) integer :: i , j , u character ( len = :), allocatable :: hdr do i = 1 , size ( dects ) open ( newunit = u , file = trim ( fileplace ) // \"detectors/detector_\" // str ( i ) // \".dat\" ) associate ( x => dects ( i )% p ) select type ( x ) type is ( circle_dect ) ! hdr = \"# pos, layer, nbins, bin_wid, radius\"//new_line(\"a\")//str(x%pos)//\",\"//str(x%layer)//\",\"//str(x%nbins)//\",\"//str(x%bin_wid)//\",\"//str(x%radius) ! write(u, \"(a)\")hdr ! write(u, \"(a)\")\"#data:\" do j = 1 , x % nbins write ( u , * ) real ( j , kind = wp ) * x % bin_wid , x % data ( j ) end do type is ( annulus_dect ) ! hdr = \"#pos, layer, nbins, bin_wid, radius1, radius2\"//new_line(\"a\")//str(x%pos)//\",\"//str(x%layer)//\",\"//str(x%nbins)//\",\"//str(x%bin_wid)//\",\"//str(x%r1)//\",\"//str(x%r2) type is ( camera ) print * , \"Warning not yet implmented!\" end select end associate close ( u ) end do end subroutine write_detected_photons","tags":"","loc":"proc/write_detected_photons.html"},{"title":"write_hdr – signedMCRT","text":"private subroutine write_hdr(u, sizes, type) Uses utils write out header information for .nrrd file format Arguments Type Intent Optional Attributes Name integer, intent(in) :: u file handle integer, intent(in) :: sizes (:) dimensions of data character(len=*), intent(in) :: type data dtype Contents Source Code write_hdr Source Code subroutine write_hdr ( u , sizes , type ) !! write out header information for .nrrd file format use utils , only : str !> data dtype character ( * ), intent ( IN ) :: type !> file handle integer , intent ( IN ) :: u !> dimensions of data integer , intent ( IN ) :: sizes (:) character ( len = 100 ) :: string integer :: i string = \"\" do i = 1 , size ( sizes ) if ( i == 1 ) then string = str ( sizes ( i )) else string = trim ( string ) // \" \" // str ( sizes ( i )) end if end do write ( u , \"(A)\" ) \"NRRD0004\" write ( u , \"(A)\" ) \"type: \" // type write ( u , \"(A)\" ) \"dimension: \" // str ( size ( sizes )) write ( u , \"(A)\" ) \"sizes: \" // trim ( string ) write ( u , \"(A)\" ) \"space dimension: \" // str ( size ( sizes )) write ( u , \"(A)\" ) \"encoding: raw\" write ( u , \"(A)\" ) \"endian: little\" end subroutine write_hdr","tags":"","loc":"proc/write_hdr.html"},{"title":"nrrd_write – signedMCRT","text":"public interface nrrd_write Contents Module Procedures write_3d_r8_nrrd write_3d_r4_nrrd Module Procedures private subroutine write_3d_r8_nrrd (array, filename, overwrite, dict) write 3D array of float64's to .nrrd fileformat Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:,:) array to be written to disk character(len=*), intent(in) :: filename filename logical, intent(in) :: overwrite overwrite flag type(toml_table), intent(inout), optional :: dict dictionary of metadata private subroutine write_3d_r4_nrrd (array, filename, overwrite, dict) write 3D array of float32's to .nrrd fileformat Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to be written to disk character(len=*), intent(in) :: filename filename logical, intent(in) :: overwrite overwrite flag type(toml_table), intent(inout), optional :: dict dictionary of metadata","tags":"","loc":"interface/nrrd_write.html"},{"title":"raw_write – signedMCRT","text":"public interface raw_write Contents Module Procedures write_3d_r8_raw write_3d_r4_raw Module Procedures private subroutine write_3d_r8_raw (array, filename, overwrite) write 3D array of float64s to disk as raw binary data Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:,:) array to write to disk character(len=*), intent(in) :: filename filename to save array as logical, intent(in) :: overwrite overwrite flag private subroutine write_3d_r4_raw (array, filename, overwrite) write 3D array of float32's to disk as raw binary data Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to write to disk character(len=*), intent(in) :: filename filename to save array as logical, intent(in) :: overwrite overwrite flag","tags":"","loc":"interface/raw_write.html"},{"title":"display_settings – signedMCRT","text":"private subroutine display_settings(state, input_file, packet, kernel_type) Uses photonMod utils sim_state_mod Displays the settings used in the current simulation run Arguments Type Intent Optional Attributes Name type( settings_t ), intent(in) :: state Simulation state character(len=*), intent(in) :: input_file Input filenname type( photon ), intent(in) :: packet Photon packet character(len=*), intent(in) :: kernel_type Kernel type to run Contents Source Code display_settings Source Code subroutine display_settings ( state , input_file , packet , kernel_type ) !! Displays the settings used in the current simulation run use sim_state_mod , only : settings_t use photonMod , only : photon use utils , only : str !> Simulation state type ( settings_t ), intent ( IN ) :: state !> Input filenname character ( * ), intent ( IN ) :: input_file !> Kernel type to run character ( * ), intent ( IN ) :: kernel_type !> Photon packet type ( photon ), intent ( IN ) :: packet print * , repeat ( \"#\" , 20 ) // \" Settings \" // repeat ( \"#\" , 20 ) print * , \"# Config file: \" , trim ( input_file ), repeat ( \" \" , 50 - 16 - len ( trim ( input_file ))), \"#\" print * , \"# Using: \" // trim ( kernel_type ) // \"kernel\" // repeat ( \" \" , 50 - 16 - len ( kernel_type )), \"#\" print * , \"# Light source: \" // trim ( state % source ) // repeat ( \" \" , 50 - 17 - len ( trim ( state % source ))), \"#\" if ( state % source == \"point\" ) then print * , \"# Light Source Position: [\" // str ( packet % pos % x , 4 ) // \", \" // str ( packet % pos % y , 4 ) // \", \" // str ( packet % pos % z , 4 ) // & \"]\" // repeat ( \" \" , 6 ) // \"#\" else print * , \"# Light direction: [\" // str ( packet % nxp , 4 ) // \", \" // str ( packet % nyp , 4 ) // \", \" // str ( packet % nzp , 4 ) // & \"]\" // repeat ( \" \" , 12 ) // \"#\" end if print * , \"# Geometry: \" // trim ( state % experiment ) // repeat ( \" \" , 50 - 13 - len ( trim ( state % experiment ))), \"#\" print * , \"# Seed: \" // str ( state % iseed , 9 ) // repeat ( \" \" , 32 ) // \"#\" if ( state % tev ) then print * , \"# Tev enabled!\" // repeat ( \" \" , 35 ) // \"#\" end if if ( state % render_geom ) then print * , \"# Render geometry to file enabled!\" // repeat ( \" \" , 15 ) // \"#\" end if if ( state % overwrite ) then print * , \"# Overwrite Enabled!\" , repeat ( \" \" , 29 ) // \"#\" end if if ( state % absorb ) then print * , \"# Energy absorbed will be written to file.\" // repeat ( \" \" , 7 ) // \"#\" end if print * , repeat ( \"#\" , 50 ) print * , new_line ( \"a\" ) end subroutine display_settings","tags":"","loc":"proc/display_settings.html"},{"title":"finalise – signedMCRT","text":"private subroutine finalise(dict, dects, nscatt, start, history) Uses utils constants detectors iarray setupMod tomlf historyStack sim_state_mod writer_mod Routine writes out simulation data, deallocates arrays and prints total runtime Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Dictionary of metadata type( dect_array ), intent(in) :: dects (:) Detector array real(kind=wp), intent(in) :: nscatt Total number of scattered photon packets real(kind=wp), intent(in) :: start Start time of simulation. Used to calculate total runtime. type( history_stack_t ), intent(in) :: history Photon histyor object Contents Source Code finalise Source Code subroutine finalise ( dict , dects , nscatt , start , history ) !! Routine writes out simulation data, deallocates arrays and prints total runtime use constants , only : wp , fileplace use detectors , only : dect_array use historyStack , only : history_stack_t use iarray , only : phasor , phasorGLOBAL , jmean , jmeanGLOBAL , absorb , absorbGLOBAL use sim_state_mod , only : state use setupMod , only : dealloc_array use writer_mod , only : normalise_fluence , write_data , write_detected_photons use utils , only : get_time , print_time , str use tomlf , only : toml_table , set_value !> Total number of scattered photon packets real ( kind = wp ), intent ( in ) :: nscatt !> Start time of simulation. Used to calculate total runtime. real ( kind = wp ), intent ( in ) :: start !> Detector array type ( dect_array ), intent ( in ) :: dects (:) !> Photon histyor object type ( history_stack_t ), intent ( in ) :: history !> Dictionary of metadata type ( toml_table ), intent ( inout ) :: dict integer :: id , numproc , i real ( kind = wp ) :: nscattGLOBAL , time_taken id = 0 numproc = 1 #ifdef MPI ! collate fluence from all processes call mpi_reduce ( jmean , jmeanGLOBAL , size ( jmean ), MPI_DOUBLE_PRECISION , MPI_SUM , 0 , MPI_COMM_WORLD ) call mpi_reduce ( absorb , absorbGLOBAL , size ( absorb ), MPI_DOUBLE_PRECISION , MPI_SUM , 0 , MPI_COMM_WORLD ) call mpi_reduce ( phasor , phasorGLOBAL , size ( phasor ), MPI_DOUBLE_COMPLEX , MPI_SUM , 0 , MPI_COMM_WORLD ) call mpi_reduce ( nscatt , nscattGLOBAL , 1 , MPI_DOUBLE_PRECISION , MPI_SUM , 0 , MPI_COMM_WORLD ) #else jmeanGLOBAL = jmean absorbGLOBAL = absorb phasorGLOBAL = phasor nscattGLOBAL = nscatt #endif if ( id == 0 ) then #ifdef _OPENMP print * , 'Average # of scatters per photon:' , nscattGLOBAL / ( state % nphotons ) #else print * , 'Average # of scatters per photon:' , nscattGLOBAL / ( state % nphotons * numproc ) ! for testing purposes open ( newunit = i , file = \"nscatt.dat\" ) write ( i , * ) nscattGLOBAL / ( state % nphotons ) close ( i ) #endif !write out files !create dict to store metadata and nrrd hdr info call set_value ( dict , \"grid_data\" , \"fluence map\" ) call set_value ( dict , \"real_size\" , str ( state % grid % xmax , 7 ) // \" \" // str ( state % grid % ymax , 7 ) // \" \" // str ( state % grid % zmax , 7 )) call set_value ( dict , \"nphotons\" , state % nphotons ) call set_value ( dict , \"source\" , state % source ) call set_value ( dict , \"experiment\" , state % experiment ) call normalise_fluence ( state % grid , jmeanGLOBAL , state % nphotons ) call write_data ( jmeanGLOBAL , trim ( fileplace ) // \"jmean/\" // state % outfile , state , dict ) ! if(state%absorb)call write_data(absorbGLOBAL, trim(fileplace)//\"deposit/\"//state%outfile_absorb, state, dict) !INTENSITY ! call write_data(abs(phasorGLOBAL)**2, trim(fileplace)//\"phasor/\"//state%outfile, state, dict) end if !write out detected photons if ( size ( dects ) > 0 ) then call write_detected_photons ( dects ) block logical :: mask ( size ( dects )) do i = 1 , size ( dects ) mask ( i ) = dects ( i )% p % trackHistory end do if ( state % trackHistory ) call history % finish () end block end if time_taken = get_time () - start call print_time ( time_taken , 4 ) #ifdef MPI call MPI_Finalize () #endif call dealloc_array () end subroutine finalise","tags":"","loc":"proc/finalise.html"},{"title":"pathlength_scatter – signedMCRT","text":"public subroutine pathlength_scatter(input_file) Uses detector_mod vec4_class utils photonMod vector_class piecewiseMod sim_state_mod inttau2 detectors iarray sdfs tev_mod tomlf random historyStack constants omp_lib Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: input_file Contents Source Code pathlength_scatter Source Code subroutine pathlength_scatter ( input_file ) !Shared data use iarray use constants , only : wp !subroutines use detector_mod , only : hit_t use detectors , only : dect_array use historyStack , only : history_stack_t use inttau2 , only : tauint2 use photonMod , only : photon use piecewiseMod use random , only : ran2 , init_rng , seq use sdfs , only : sdf use sim_state_mod , only : state use utils , only : pbar use vec4_class , only : vec4 use vector_class , only : vector !external deps use tev_mod , only : tevipc use tomlf , only : toml_table #ifdef _OPENMP use omp_lib #endif character ( len =* ), intent ( in ) :: input_file integer :: numproc , id , j , i type ( history_stack_t ) :: history type ( pbar ) :: bar type ( photon ) :: packet type ( toml_table ) :: dict real ( kind = wp ), allocatable :: distances (:), image (:,:,:) type ( hit_t ) :: hpoint type ( vector ) :: dir type ( dect_array ), allocatable :: dects (:) type ( sdf ), allocatable :: array (:) real ( kind = wp ) :: ran , nscatt , start type ( tevipc ) :: tev type ( seq ) :: seqs ( 2 ) type ( spectrum_t ) :: spectrum call setup ( input_file , tev , dects , array , packet , spectrum , dict , distances , image , nscatt , start ) #ifdef _OPENMP !is state%seed private, i dont think so... !$omp parallel default(none) shared(dict, array, numproc, start, state, bar, jmean, phasor, tev, dects, spectrum)& !$omp& private(ran, id, distances, image, dir, hpoint, history, seqs) reduction(+:nscatt) firstprivate(packet) numproc = omp_get_num_threads () id = omp_get_thread_num () if ( numproc > state % nphotons . and . id == 0 ) print * , \"Warning, simulation may be underministic due to low photon count!\" if ( state % trackHistory ) history = history_stack_t ( state % historyFilename , id ) #elif MPI !nothing #else numproc = 1 id = 0 if ( state % trackHistory ) history = history_stack_t ( state % historyFilename , id ) #endif if ( id == 0 ) print ( \"(a,I3.1,a)\" ), 'Photons now running on' , numproc , ' cores.' ! set seed for rnd generator. id to change seed for each process call init_rng ( spread ( state % iseed + id , 1 , 8 ), fwd = . true .) seqs = [ seq (( id + 1 ) * ( state % nphotons / numproc ), 2 ),& seq (( id + 1 ) * ( state % nphotons / numproc ), 3 )] bar = pbar ( state % nphotons / 10 ) !$OMP BARRIER !$OMP do !loop over photons do j = 1 , state % nphotons if ( mod ( j , 10 ) == 0 ) call bar % progress () ! Release photon from point source call packet % emit ( spectrum , dict , seqs ) packet % step = 0 packet % id = id distances = 0._wp do i = 1 , size ( distances ) distances ( i ) = array ( i )% evaluate ( packet % pos ) if ( distances ( i ) > 0._wp ) distances ( i ) =- 99 9.0_wp end do packet % layer = minloc ( abs ( distances ), dim = 1 ) if ( state % trackHistory ) call history % push ( vec4 ( packet % pos , packet % step )) ! Find scattering location call tauint2 ( state % grid , packet , array ) do while (. not . packet % tflag ) if ( state % trackHistory ) call history % push ( vec4 ( packet % pos , packet % step )) ran = ran2 () if ( ran < array ( packet % layer )% getAlbedo ()) then !interacts with tissue call packet % scatter ( array ( packet % layer )% gethgg (), & array ( packet % layer )% getg2 (), dects ) nscatt = nscatt + 1 packet % step = packet % step + 1 else packet % tflag = . true . exit end if ! !Find next scattering location call tauint2 ( state % grid , packet , array ) end do dir = vector ( packet % nxp , packet % nyp , packet % nzp ) hpoint = hit_t ( packet % pos , dir , sqrt ( packet % pos % x ** 2 + packet % pos % y ** 2 ), packet % layer ) do i = 1 , size ( dects ) call dects ( i )% p % record_hit ( hpoint , history ) end do if ( id == 0 . and . mod ( j , 1000 ) == 0 ) then if ( state % tev ) then !$omp critical image = reshape ( jmean (:, 100 : 100 ,:), [ state % grid % nxg , state % grid % nzg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"I\" ], 0 , 0 , . false ., . false .) image = reshape ( phasor ( 100 : 100 ,:,:), [ state % grid % nyg , state % grid % nzg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"J\" ], 0 , 0 , . false ., . false .) image = reshape ( phasor (:,:, 100 : 100 ), [ state % grid % nxg , state % grid % nyg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"K\" ], 0 , 0 , . false ., . false .) !$omp end critical end if end if end do #ifdef _OPENMP !$OMP end do !$OMP end parallel #endif call finalise ( dict , dects , nscatt , start , history ) end subroutine pathlength_scatter","tags":"","loc":"proc/pathlength_scatter.html"},{"title":"setup – signedMCRT","text":"private subroutine setup(input_file, tev, dects, array, packet, spectrum, dict, distances, image, nscatt, start) Uses utils photonMod parse_mod vector_class sim_state_mod detectors iarray sdfs setupMod tev_mod random tomlf piecewiseMod constants setup simulation by reading in setting file, and setup variables to be used. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: input_file Filename for toml settings to be used type(tevipc), intent(out) :: tev handle for communicating with TEV type( dect_array ), intent(out), allocatable :: dects (:) array of photon detectors type( sdf ), intent(out), allocatable :: array (:) array of SDF objects that create the geometry type( photon ), intent(out) :: packet photon that is to be simulated type( spectrum_t ), intent(out) :: spectrum type(toml_table), intent(out) :: dict toml table of meta-data to be written to output files. real(kind=wp), intent(out), allocatable :: distances (:) real(kind=wp), intent(out), allocatable :: image (:,:,:) real(kind=wp), intent(out) :: nscatt real(kind=wp), intent(out) :: start Contents Source Code setup Source Code subroutine setup ( input_file , tev , dects , array , packet , spectrum , dict , distances , image , nscatt , start ) !! setup simulation by reading in setting file, and setup variables to be used. !shared data use iarray use constants , only : wp !subroutines use detectors , only : dect_array use parse_mod , only : parse_params use photonMod , only : photon use random , only : init_rng use piecewiseMod use sdfs , only : sdf , render use sim_state_mod , only : state use setupMod , only : setup_simulation , directory use utils , only : get_time , print_time , str use vector_class , only : vector ! !external deps use tev_mod , only : tevipc , tev_init use tomlf , only : toml_table , toml_error !> Filename for toml settings to be used character ( * ), intent ( in ) :: input_file !> array of SDF objects that create the geometry type ( sdf ), allocatable , intent ( out ) :: array (:) !> array of photon detectors type ( dect_array ), allocatable , intent ( out ) :: dects (:) !> toml table of meta-data to be written to output files. type ( toml_table ), intent ( out ) :: dict !> handle for communicating with TEV type ( tevipc ), intent ( out ) :: tev !> photon that is to be simulated type ( photon ), intent ( out ) :: packet real ( kind = wp ), allocatable , intent ( out ) :: distances (:), image (:,:,:) real ( kind = wp ), intent ( out ) :: nscatt , start type ( spectrum_t ), intent ( out ) :: spectrum ! mpi/mp variables integer :: id real ( kind = wp ) :: chance , threshold type ( toml_error ), allocatable :: error chance = 1._wp / 1 0._wp threshold = 1e-6_wp call directory () dict = toml_table () call parse_params ( \"res/\" // trim ( input_file ), packet , dects , spectrum , dict , error ) if ( allocated ( error )) then print * , error % message stop 1 end if allocate ( image ( state % grid % nxg , state % grid % nzg , 1 )) call display_settings ( state , input_file , packet , \"Pathlength\" ) if ( state % tev ) then !init TEV link tev = tevipc () call tev % close_image ( state % experiment ) call tev % create_image ( state % experiment , state % grid % nxg , state % grid % nzg , [ \"I\" , \"J\" , \"K\" ], . true .) end if nscatt = 0._wp call init_rng ( spread ( state % iseed + 0 , 1 , 8 ), fwd = . true .) call setup_simulation ( array , dict ) ! render geometry to voxel format for debugging if ( state % render_geom ) then print * , \"Rendering geometry to file\" call render ( array , state ) end if allocate ( distances ( size ( array ))) start = get_time () id = 0 if ( id == 0 ) then print * , '# of photons to run' , state % nphotons end if end subroutine setup","tags":"","loc":"proc/setup.html"},{"title":"test_kernel – signedMCRT","text":"public subroutine test_kernel(input_file, end_early) Uses utils photonMod vector_class piecewiseMod sim_state_mod inttau2 detectors iarray sdfs tev_mod tomlf random historyStack constants omp_lib Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: input_file logical, intent(in) :: end_early Contents Source Code test_kernel Source Code subroutine test_kernel ( input_file , end_early ) !Shared data use iarray use constants , only : wp !subroutines use detectors , only : dect_array use historyStack , only : history_stack_t use inttau2 , only : tauint2 use photonMod , only : photon use piecewiseMod use random , only : ran2 , init_rng use sdfs , only : sdf use sim_state_mod , only : state use utils , only : pbar use vector_class , only : vector !external deps use tev_mod , only : tevipc use tomlf , only : toml_table #ifdef _OPENMP use omp_lib #endif character ( len =* ), intent ( in ) :: input_file integer :: numproc , id , j , i type ( history_stack_t ) :: history ! type(pbar) :: bar type ( photon ) :: packet type ( toml_table ) :: dict real ( kind = wp ), allocatable :: distances (:), image (:,:,:) type ( dect_array ), allocatable :: dects (:) type ( sdf ), allocatable :: array (:) real ( kind = wp ) :: ran , nscatt , start type ( tevipc ) :: tev type ( vector ) :: pos ( 4 ), pos2 ( 4 ) logical , intent ( in ) :: end_early type ( spectrum_t ) :: spectrum pos = vector ( 0.0_wp , 0.0_wp , 0.0_wp ) pos2 = vector ( 0.0_wp , 0.0_wp , 0.0_wp ) call setup ( input_file , tev , dects , array , packet , spectrum , dict , distances , image , nscatt , start ) numproc = 1 id = 0 if ( id == 0 ) print ( \"(a,I3.1,a)\" ), 'Photons now running on' , numproc , ' cores.' ! set seed for rnd generator. id to change seed for each process call init_rng ( spread ( state % iseed + id , 1 , 8 ), fwd = . true .) ! bar = pbar(state%nphotons/ 10) !loop over photons do j = 1 , state % nphotons ! if(mod(j, 10) == 0)call bar%progress() ! Release photon from point source call packet % emit ( spectrum , dict ) packet % step = 0 packet % id = id distances = 0._wp do i = 1 , size ( distances ) distances ( i ) = array ( i )% evaluate ( packet % pos ) if ( distances ( i ) > 0._wp ) distances ( i ) =- 99 9.0_wp end do packet % layer = minloc ( abs ( distances ), dim = 1 ) ! Find scattering location call tauint2 ( state % grid , packet , array ) do while (. not . packet % tflag ) ran = ran2 () if ( ran < array ( packet % layer )% getalbedo ()) then !interacts with tissue call packet % scatter ( array ( packet % layer )% gethgg (), & array ( packet % layer )% getg2 ()) nscatt = nscatt + 1 packet % step = packet % step + 1 if ( packet % step == 1 ) then pos ( 1 ) = pos ( 1 ) + packet % pos pos2 ( 1 ) = pos2 ( 1 ) + packet % pos ** 2 elseif ( packet % step == 2 ) then pos ( 2 ) = pos ( 2 ) + packet % pos pos2 ( 2 ) = pos2 ( 2 ) + packet % pos ** 2 elseif ( packet % step == 3 ) then pos ( 3 ) = pos ( 3 ) + packet % pos pos2 ( 3 ) = pos2 ( 3 ) + packet % pos ** 2 elseif ( packet % step == 4 ) then pos ( 4 ) = pos ( 4 ) + packet % pos pos2 ( 4 ) = pos2 ( 4 ) + packet % pos ** 2 else if ( end_early ) packet % tflag = . true . end if else packet % tflag = . true . exit end if ! !Find next scattering location call tauint2 ( state % grid , packet , array ) end do end do open ( newunit = j , file = \"positions.dat\" ) do i = 1 , 4 write ( j , * ) 1 0. * pos ( i )% x / state % nphotons , 1 0. * pos ( i )% y / state % nphotons , 1 0. * pos ( i )% z / state % nphotons end do do i = 1 , 4 write ( j , * ) 10 0. * pos2 ( i )% x / state % nphotons , 10 0. * pos2 ( i )% y / state % nphotons , 10 0. * pos2 ( i )% z / state % nphotons end do close ( j ) call finalise ( dict , dects , nscatt , start , history ) end subroutine test_kernel","tags":"","loc":"proc/test_kernel.html"},{"title":"weight_scatter – signedMCRT","text":"public subroutine weight_scatter(input_file) Uses detector_mod vec4_class utils photonMod vector_class piecewiseMod sim_state_mod inttau2 detectors iarray sdfs tev_mod tomlf random historyStack constants omp_lib Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: input_file Contents Source Code weight_scatter Source Code subroutine weight_scatter ( input_file ) !Shared data use iarray use constants , only : wp , CHANCE , THRESHOLD !subroutines use detectors , only : dect_array use detector_mod , only : hit_t use historyStack , only : history_stack_t use inttau2 , only : tauint2 , update_voxels use photonMod , only : photon use piecewiseMod use random , only : ran2 , init_rng use sdfs , only : sdf use sim_state_mod , only : state use utils , only : pbar use vec4_class , only : vec4 use vector_class , only : vector !external deps use tev_mod , only : tevipc use tomlf , only : toml_table #ifdef _OPENMP use omp_lib #endif character ( len =* ), intent ( in ) :: input_file integer :: numproc , id , j , i type ( history_stack_t ) :: history type ( pbar ) :: bar type ( photon ) :: packet type ( toml_table ) :: dict real ( kind = wp ), allocatable :: distances (:), image (:,:,:) type ( hit_t ) :: hpoint type ( vector ) :: dir type ( dect_array ), allocatable :: dects (:) type ( sdf ), allocatable :: array (:) real ( kind = wp ) :: nscatt , start , weight_absorb type ( tevipc ) :: tev integer :: celli , cellj , cellk type ( spectrum_t ) :: spectrum call setup ( input_file , tev , dects , array , packet , spectrum , dict , distances , image , nscatt , start ) #ifdef _OPENMP !is state%seed private, i dont think so... !$omp parallel default(none) shared(dict, array, numproc, start, state, bar, jmean, tev, dects, spectrum)& !$omp& private(id, distances, image, dir, hpoint, history, weight_absorb, cellk, cellj, celli) & !$omp& reduction(+:nscatt) firstprivate(packet) numproc = omp_get_num_threads () id = omp_get_thread_num () if ( numproc > state % nphotons . and . id == 0 ) print * , \"Warning, simulation may be underministic due to low photon count!\" if ( state % trackHistory ) history = history_stack_t ( state % historyFilename , id ) #elif MPI !nothing #else numproc = 1 id = 0 if ( state % trackHistory ) history = history_stack_t ( state % historyFilename , id ) #endif if ( id == 0 ) print ( \"(a,I3.1,a)\" ), 'Photons now running on' , numproc , ' cores.' ! set seed for rnd generator. id to change seed for each process call init_rng ( spread ( state % iseed + id , 1 , 8 ), fwd = . true .) bar = pbar ( state % nphotons / 10 ) !$OMP BARRIER !$OMP do !loop over photons do j = 1 , state % nphotons if ( mod ( j , 10 ) == 0 ) call bar % progress () ! Release photon from point source call packet % emit ( spectrum , dict ) packet % step = 0 packet % id = id distances = 0._wp do i = 1 , size ( distances ) distances ( i ) = array ( i )% evaluate ( packet % pos ) if ( distances ( i ) > 0._wp ) distances ( i ) =- 99 9.0_wp end do packet % layer = minloc ( abs ( distances ), dim = 1 ) if ( state % trackHistory ) call history % push ( vec4 ( packet % pos , packet % step )) ! Find scattering location call tauint2 ( state % grid , packet , array ) do while (. not . packet % tflag ) if ( state % trackHistory ) call history % push ( vec4 ( packet % pos , packet % step )) weight_absorb = packet % weight * ( 1._wp - array ( packet % layer )% getAlbedo ()) packet % weight = packet % weight - weight_absorb call update_voxels ( state % grid , & packet % pos + vector ( state % grid % xmax , state % grid % ymax , state % grid % zmax ), celli , cellj , cellk ) if ( celli < 1 ) then packet % tflag = . true . exit end if if ( cellj < 1 ) then packet % tflag = . true . exit end if if ( cellk < 1 ) then packet % tflag = . true . exit end if !$omp atomic jmean ( celli , cellj , cellk ) = jmean ( celli , cellj , cellk ) + weight_absorb call packet % scatter ( array ( packet % layer )% gethgg (), array ( packet % layer )% getg2 (), dects ) if ( packet % weight < THRESHOLD ) then if ( ran2 () < CHANCE ) then packet % weight = packet % weight / CHANCE else packet % tflag = . true . exit end if end if ! !Find next scattering location call tauint2 ( state % grid , packet , array ) end do dir = vector ( packet % nxp , packet % nyp , packet % nzp ) hpoint = hit_t ( packet % pos , dir , packet % weight , packet % layer ) do i = 1 , size ( dects ) call dects ( i )% p % record_hit ( hpoint , history ) end do if ( id == 0 . and . mod ( j , 1000 ) == 0 ) then if ( state % tev ) then !$omp critical image = reshape ( jmean (:, 100 : 100 ,:), [ state % grid % nxg , state % grid % nzg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"I\" ], 0 , 0 , . false ., . false .) image = reshape ( jmean ( 100 : 100 ,:,:), [ state % grid % nyg , state % grid % nzg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"J\" ], 0 , 0 , . false ., . false .) image = reshape ( jmean (:,:, 100 : 100 ), [ state % grid % nxg , state % grid % nyg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"K\" ], 0 , 0 , . false ., . false .) !$omp end critical end if end if end do #ifdef _OPENMP !$OMP end do !$OMP end parallel #endif call finalise ( dict , dects , nscatt , start , history ) end subroutine weight_scatter","tags":"","loc":"proc/weight_scatter.html"},{"title":"intersectCircle – signedMCRT","text":"public function intersectCircle(n, p0, radius, l0, l, t) ref Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: n Normal to the circle type( vector ), intent(in) :: p0 a centre of the circle real(kind=wp), intent(in) :: radius Radius of the circle type( vector ), intent(in) :: l0 origin of the ray type( vector ), intent(in) :: l direction vector of the ray real(kind=wp), intent(inout) :: t Distance from l0 to the intersection point Return Value logical Contents Source Code intersectCircle Source Code logical function intersectCircle ( n , p0 , radius , l0 , l , t ) !![ref](https://www.scratchapixel.com/lessons/3d-basic-rendering/minimal-ray-tracer-rendering-simple-shapes/ray-plane-and-ray-disk-intersection) !> Normal to the circle type ( vector ), intent ( in ) :: n !> a centre of the circle type ( vector ), intent ( in ) :: p0 !> direction vector of the ray type ( vector ), intent ( in ) :: l !> origin of the ray type ( vector ), intent ( in ) :: l0 !> Radius of the circle real ( kind = wp ), intent ( in ) :: radius !> Distance from l0 to the intersection point real ( kind = wp ), intent ( inout ) :: t real ( kind = wp ) :: d2 type ( vector ) :: v , p intersectCircle = . false . t = 0._wp if ( intersectPlane ( n , p0 , l0 , l , t )) then p = l0 + l * t v = p - p0 d2 = v . dot . v if ( sqrt ( d2 ) <= radius ) intersectCircle = . true . end if end function intersectCircle","tags":"","loc":"proc/intersectcircle.html"},{"title":"intersectCone – signedMCRT","text":"public function intersectCone(orig, dir, t, centre, radius, height) calculates where a line, with origin:orig and direction:dir hits a cone, radius:radius and height:height with centre:centre.\ncentre is the point under the apex at the cone's base.\nreturns true if intersection exists\nreturns t, the paramertised parameter of the line equation\nadapted from scratchapixel and pbrt\nneed to check z height after moving ray\nif not this is an infinte cone\ncone lies height ways along z-axis Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: orig origin of the ray type( vector ), intent(in) :: dir Direction vector of the ray real(kind=wp), intent(out) :: t distance from orig to the intersection point type( vector ), intent(in) :: centre Centre of the cone real(kind=wp), intent(in) :: radius Radius of the cones base real(kind=wp), intent(in) :: height Height of the cone Return Value logical Contents Source Code intersectCone Source Code logical function intersectCone ( orig , dir , t , centre , radius , height ) !! calculates where a line, with origin:orig and direction:dir hits a cone, radius:radius and height:height with centre:centre. !! centre is the point under the apex at the cone's base. !! returns true if intersection exists !! returns t, the paramertised parameter of the line equation !! adapted from scratchapixel and pbrt !! need to check z height after moving ray !! if not this is an infinte cone !! cone lies height ways along z-axis !> Direction vector of the ray type ( vector ), intent ( IN ) :: dir !> origin of the ray type ( vector ), intent ( IN ) :: orig !> Centre of the cone type ( vector ), intent ( IN ) :: centre !> distance from orig to the intersection point real ( kind = wp ), intent ( OUT ) :: t !> Radius of the cones base real ( kind = wp ), intent ( IN ) :: radius !> Height of the cone real ( kind = wp ), intent ( IN ) :: height type ( vector ) :: L real ( kind = wp ) :: t0 , t1 , a , b , c , tmp , k intersectCone = . false . k = radius / height k = k ** 2 L = orig - centre a = dir % x ** 2 + dir % y ** 2 - ( k * dir % z ** 2 ) b = 2._wp * (( dir % x * L % x ) + ( dir % y * L % y ) - ( k * dir % z * ( L % z - height ))) c = L % x ** 2 + L % y ** 2 - ( k * ( L % z - height ) ** 2 ) if (. not . solveQuadratic ( a , b , c , t0 , t1 )) return if ( t0 > t1 ) then tmp = t1 t1 = t0 t0 = tmp end if if ( t0 < 0._wp ) then t0 = t1 if ( t0 < 0._wp ) return end if t = t0 intersectCone = . true . return end function intersectCone","tags":"","loc":"proc/intersectcone.html"},{"title":"intersectCylinder – signedMCRT","text":"public function intersectCylinder(orig, dir, t, centre, radius) calculates where a line, with origin:orig and direction:dir hits a cylinder, centre:centre and radius:radius\nThis solves for an infinitely long cylinder centered on the z axis with radius radius\nreturns true if intersection exists\nreturns t, the paramertised parameter of the line equation\nadapted from scratchapixel\nneed to check z height after moving ray\nif not this is an infinite cylinder Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: orig origin of the ray type( vector ), intent(in) :: dir Direction vector of the ray real(kind=wp), intent(out) :: t distance from orig to the intersection point type( vector ), intent(in) :: centre Centre of the cylinder real(kind=wp), intent(in) :: radius radius of the cylinder Return Value logical Contents Source Code intersectCylinder Source Code logical function intersectCylinder ( orig , dir , t , centre , radius ) !! calculates where a line, with origin:orig and direction:dir hits a cylinder, centre:centre and radius:radius !! This solves for an infinitely long cylinder centered on the z axis with radius radius !! returns true if intersection exists !! returns t, the paramertised parameter of the line equation !! adapted from scratchapixel !! need to check z height after moving ray !! if not this is an infinite cylinder !> Direction vector of the ray type ( vector ), intent ( IN ) :: dir !> origin of the ray type ( vector ), intent ( IN ) :: orig !> Centre of the cylinder type ( vector ), intent ( IN ) :: centre !> distance from orig to the intersection point real ( kind = wp ), intent ( OUT ) :: t !> radius of the cylinder real ( kind = wp ), intent ( IN ) :: radius type ( vector ) :: L real ( kind = wp ) :: t0 , t1 , a , b , c , tmp intersectCylinder = . false . L = orig - centre a = dir % x ** 2 + dir % y ** 2 b = 2._wp * ( dir % x * L % x + dir % y * L % y ) c = L % x ** 2 + L % y ** 2 - radius ** 2 if (. not . solveQuadratic ( a , b , c , t0 , t1 )) return if ( t0 > t1 ) then tmp = t1 t1 = t0 t0 = tmp end if if ( t0 < 0._wp ) then t0 = t1 if ( t0 < 0._wp ) return end if t = t0 intersectCylinder = . true . return end function intersectCylinder","tags":"","loc":"proc/intersectcylinder.html"},{"title":"intersectEllipse – signedMCRT","text":"public function intersectEllipse(orig, dir, t, centre, semia, semib) calculates where a line, with origin:orig and direction:dir hits a ellipse, centre:centre and axii:semia, semib\nreturns true if intersection exists\nreturns t, the paramertised parameter of the line equation\nadapted from scratchapixel and pbrt\nneed to check z height after moving ray\nif not this is an infinte ellipse-cylinder\nellipse lies length ways along z-axis\nsemia and semib are the semimajor axis which are the half width and height. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: orig origin of the ray type( vector ), intent(in) :: dir Direction vector of the ray real(kind=wp), intent(out) :: t distance from orig to the intersection point type( vector ), intent(in) :: centre Centre of the ellipse real(kind=wp), intent(in) :: semia Half width of the ellipse real(kind=wp), intent(in) :: semib Half height of the ellipse Return Value logical Contents Source Code intersectEllipse Source Code logical function intersectEllipse ( orig , dir , t , centre , semia , semib ) !! calculates where a line, with origin:orig and direction:dir hits a ellipse, centre:centre and axii:semia, semib !! returns true if intersection exists !! returns t, the paramertised parameter of the line equation !! adapted from scratchapixel and pbrt !! need to check z height after moving ray !! if not this is an infinte ellipse-cylinder !! ellipse lies length ways along z-axis !! semia and semib are the semimajor axis which are the half width and height. !> Direction vector of the ray type ( vector ), intent ( IN ) :: dir !> origin of the ray type ( vector ), intent ( IN ) :: orig !> Centre of the ellipse type ( vector ), intent ( IN ) :: centre !> distance from orig to the intersection point real ( kind = wp ), intent ( OUT ) :: t !> Half width of the ellipse real ( kind = wp ), intent ( IN ) :: semia !> Half height of the ellipse real ( kind = wp ), intent ( IN ) :: semib type ( vector ) :: L real ( kind = wp ) :: t0 , t1 , a , b , c , tmp , semia2div , semib2div intersectEllipse = . false . semia2div = 1._wp / semia ** 2 semib2div = 1._wp / semib ** 2 L = orig - centre a = semia2div * dir % z ** 2 + semib2div * dir % y ** 2 b = 2._wp * ( semia2div * dir % z * L % z + semib2div * dir % y * L % y ) c = semia2div * L % z ** 2 + semib2div * L % y ** 2 - 1._wp if (. not . solveQuadratic ( a , b , c , t0 , t1 )) return if ( t0 > t1 ) then tmp = t1 t1 = t0 t0 = tmp end if if ( t0 < 0._wp ) then t0 = t1 if ( t0 < 0._wp ) return end if t = t0 intersectEllipse = . true . return end function intersectEllipse","tags":"","loc":"proc/intersectellipse.html"},{"title":"intersectPlane – signedMCRT","text":"public function intersectPlane(n, p0, l0, l, t) ref Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: n Normal to the plane type( vector ), intent(in) :: p0 a point on the plane type( vector ), intent(in) :: l0 origin of the ray type( vector ), intent(in) :: l direction vector of the ray real(kind=wp), intent(inout) :: t Distance from l0 to the intersection point Return Value logical Contents Source Code intersectPlane Source Code logical function intersectPlane ( n , p0 , l0 , l , t ) !![ref](https://www.scratchapixel.com/lessons/3d-basic-rendering/minimal-ray-tracer-rendering-simple-shapes/ray-plane-and-ray-disk-intersection) !> Normal to the plane type ( vector ), intent ( in ) :: n !> a point on the plane type ( vector ), intent ( in ) :: p0 !> direction vector of the ray type ( vector ), intent ( in ) :: l !> origin of the ray type ( vector ), intent ( in ) :: l0 !> Distance from l0 to the intersection point real ( kind = wp ), intent ( inout ) :: t real ( kind = wp ) :: denom type ( vector ) :: p0l0 intersectPlane = . false . denom = n . dot . l if ( denom > 1e-6_wp ) then p0l0 = p0 - l0 t = p0l0 . dot . n t = t / denom if ( t >= 0._wp ) intersectPlane = . true . end if end function intersectPlane","tags":"","loc":"proc/intersectplane.html"},{"title":"intersectSphere – signedMCRT","text":"public function intersectSphere(orig, dir, t, centre, radius) calculates where a line, with origin:orig and direction:dir hits a sphere, centre:centre and radius:radius\nreturns true if intersection exists\nreturns t, the paramertised parameter of the line equation\nadapted from scratchapixel Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: orig Origin of the ray type( vector ), intent(in) :: dir Direction vector of the ray real(kind=wp), intent(out) :: t Distance from orig to the intersection point type( vector ), intent(in) :: centre Centre of the sphere real(kind=wp), intent(in) :: radius Radius of the sphere Return Value logical Contents Source Code intersectSphere Source Code logical function intersectSphere ( orig , dir , t , centre , radius ) !! calculates where a line, with origin:orig and direction:dir hits a sphere, centre:centre and radius:radius !! returns true if intersection exists !! returns t, the paramertised parameter of the line equation !! adapted from scratchapixel !> Direction vector of the ray type ( vector ), intent ( IN ) :: dir !> Origin of the ray type ( vector ), intent ( IN ) :: orig !> Centre of the sphere type ( vector ), intent ( IN ) :: centre !> Distance from orig to the intersection point real ( kind = wp ), intent ( OUT ) :: t !> Radius of the sphere real ( kind = wp ), intent ( IN ) :: radius type ( vector ) :: L real ( kind = wp ) :: t0 , t1 , a , b , c , tmp intersectSphere = . false . L = orig - centre a = dir . dot . dir b = 2._wp * ( dir . dot . L ) c = ( l . dot . l ) - radius ** 2 if (. not . solveQuadratic ( a , b , c , t0 , t1 )) return if ( t0 > t1 ) then tmp = t1 t1 = t0 t0 = tmp end if if ( t0 < 0._wp ) then t0 = t1 if ( t0 < 0._wp ) return end if t = t0 intersectSphere = . true . return end function intersectSphere","tags":"","loc":"proc/intersectsphere.html"},{"title":"solveQuadratic – signedMCRT","text":"private function solveQuadratic(a, b, c, x0, x1) solves quadratic equation given coeffs a, b, and c\nreturns true if real solution\nreturns x0 and x1\nadapted from scratchapixel Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a real(kind=wp), intent(in) :: b real(kind=wp), intent(in) :: c real(kind=wp), intent(out) :: x0 real(kind=wp), intent(out) :: x1 Return Value logical Contents Source Code solveQuadratic Source Code logical function solveQuadratic ( a , b , c , x0 , x1 ) !! solves quadratic equation given coeffs a, b, and c !! returns true if real solution !! returns x0 and x1 !! adapted from scratchapixel real ( kind = wp ), intent ( IN ) :: a , b , c real ( kind = wp ), intent ( OUT ) :: x0 , x1 real ( kind = wp ) :: discrim , q solveQuadratic = . false . discrim = b ** 2 - 4._wp * a * c if ( discrim < 0._wp ) then return elseif ( discrim == 0._wp ) then x0 = - 0.5_wp * b / a x1 = x0 else if ( b > 0._wp ) then q = - 0.5_wp * ( b + sqrt ( discrim )) else q = - 0.5_wp * ( b - sqrt ( discrim )) end if x0 = q / a x1 = c / q end if solveQuadratic = . true . return end function solveQuadratic","tags":"","loc":"proc/solvequadratic.html"},{"title":"next – signedMCRT","text":"private function next(this) result(res) Type Bound seq Arguments Type Intent Optional Attributes Name class( seq ) :: this Return Value real(kind=wp) Contents","tags":"","loc":"proc/next.html"},{"title":"ran2 – signedMCRT","text":"public function ran2() result(res) wrapper for call random number Arguments None Return Value real(kind=wp) Contents Source Code ran2 Source Code function ran2 () result ( res ) !! wrapper for call random number real ( kind = wp ) :: res call random_number ( res ) end function ran2","tags":"","loc":"proc/ran2.html"},{"title":"randint – signedMCRT","text":"public function randint(a, b) sample a random integer between [a, b] Arguments Type Intent Optional Attributes Name integer, intent(in) :: a lower bound integer, intent(in) :: b higher bound Return Value integer Contents Source Code randint Source Code integer function randint ( a , b ) !! sample a random integer between [a, b] !> lower bound integer , intent ( IN ) :: a !> higher bound integer , intent ( IN ) :: b randint = a + floor (( b + 1 - a ) * ran2 ()) end function randint","tags":"","loc":"proc/randint.html"},{"title":"ranu – signedMCRT","text":"public function ranu(a, b) result(res) uniformly sample in range[a, b) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a lower bound real(kind=wp), intent(in) :: b upper bound Return Value real(kind=wp) Contents Source Code ranu Source Code function ranu ( a , b ) result ( res ) !! uniformly sample in range[a, b) real ( kind = wp ) :: res !> lower bound real ( kind = wp ), intent ( IN ) :: a !> upper bound real ( kind = wp ), intent ( IN ) :: b res = a + ran2 () * ( b - a ) end function ranu","tags":"","loc":"proc/ranu.html"},{"title":"init_rng – signedMCRT","text":"public subroutine init_rng(input_seed, fwd) initiate RNG state with reproducible state Arguments Type Intent Optional Attributes Name integer, intent(in), optional :: input_seed (:) input seed logical, intent(in), optional :: fwd boolean that if True runs the generator for 100 steps before returning Contents Source Code init_rng Source Code subroutine init_rng ( input_seed , fwd ) !! initiate RNG state with reproducible state !> input seed integer , optional , intent ( IN ) :: input_seed (:) !> boolean that if True runs the generator for 100 steps before returning logical , optional , intent ( IN ) :: fwd integer , allocatable :: seed (:) integer :: n , i logical :: ffwd real ( kind = wp ) :: a call random_seed ( size = n ) allocate ( seed ( n )) if ( present ( input_seed )) then seed = 0 seed = input_seed else seed = 1234567 end if if ( present ( fwd )) then ffwd = fwd else ffwd = . false . end if call random_seed ( put = seed ) !fast forward rng state 100 times to avoid any potential bad seeds if ( ffwd ) then call random_seed ( get = seed ) do i = 1 , 100 a = ran2 () call random_seed ( get = seed ) end do end if end subroutine init_rng","tags":"","loc":"proc/init_rng.html"},{"title":"rang – signedMCRT","text":"public subroutine rang(x, y, avg, sigma) sample a 2D Guassian distribution Arguments Type Intent Optional Attributes Name real(kind=wp), intent(out) :: x first value to return real(kind=wp), intent(out) :: y 2nd value to return real(kind=wp), intent(in) :: avg mean of the gaussian to sample from real(kind=wp), intent(in) :: sigma of the guassian to sample from. Contents Source Code rang Source Code subroutine rang ( x , y , avg , sigma ) !! sample a 2D Guassian distribution !> mean of the gaussian to sample from real ( kind = wp ), intent ( IN ) :: avg !> \\sigma of the guassian to sample from. real ( kind = wp ), intent ( IN ) :: sigma !> first value to return real ( kind = wp ), intent ( OUT ) :: x !> 2nd value to return real ( kind = wp ), intent ( OUT ) :: y real ( kind = wp ) :: s , tmp s = 1._wp do while ( s >= 1._wp ) x = ranu ( - 1._wp , 1._wp ) y = ranu ( - 1._wp , 1._wp ) s = y ** 2 + x ** 2 end do tmp = x * sqrt ( - 2._wp * log ( s ) / s ) x = avg + sigma * tmp tmp = y * sqrt ( - 2._wp * log ( s ) / s ) y = avg + sigma * tmp end subroutine rang","tags":"","loc":"proc/rang.html"},{"title":"get_vector – signedMCRT","text":"private function get_vector(child, key, error, context, default) Vector helper function for parsing toml Arguments Type Intent Optional Attributes Name type(toml_table), intent(in), pointer :: child Input Toml entry to read character(len=*), intent(in) :: key Key to read type(toml_error), intent(out), allocatable :: error type(toml_context), intent(in) :: context Context handle for error reporting type( vector ), intent(in), optional :: default Default value to assign Return Value type( vector ) Contents Source Code get_vector Source Code type ( vector ) function get_vector ( child , key , error , context , default ) !! Vector helper function for parsing toml !> Input Toml entry to read type ( toml_table ), pointer , intent ( in ) :: child !> Key to read character ( * ), intent ( in ) :: key !> Default value to assign type ( vector ), optional , intent ( in ) :: default !> Context handle for error reporting type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_array ), pointer :: arr => null () real ( kind = wp ) :: tmp ( 3 ) type ( vector ) :: default_ integer :: j , origin if ( present ( default )) then default_ = default else default_ = vector ( 0._wp , 0._wp , 0._wp ) end if call get_value ( child , key , arr , origin = origin ) if ( associated ( arr )) then if ( len ( arr ) /= 3 ) then call make_error ( error , & context % report ( \"Expected vector of size 3\" , origin , \"Wrong vector size\" ), - 1 ) return end if do j = 1 , len ( arr ) call get_value ( arr , j , tmp ( j )) end do get_vector = vector ( tmp ( 1 ), tmp ( 2 ), tmp ( 3 )) else get_vector = default end if end function get_vector","tags":"","loc":"proc/get_vector.html"},{"title":"handle_annulus_dect – signedMCRT","text":"private subroutine handle_annulus_dect(child, dects, counts, context, error) Uses sim_state_mod detectors Read in Annulus_detector settings and initalise variable Arguments Type Intent Optional Attributes Name type(toml_table), intent(in), pointer :: child type( annulus_dect ), intent(inout) :: dects (:) integer, intent(inout) :: counts type(toml_context), intent(in) :: context type(toml_error), intent(out), allocatable :: error Contents Source Code handle_annulus_dect Source Code subroutine handle_annulus_dect ( child , dects , counts , context , error ) !! Read in Annulus_detector settings and initalise variable use detectors , only : annulus_dect use sim_state_mod , only : state type ( toml_table ), pointer , intent ( in ) :: child type ( annulus_dect ), intent ( inout ) :: dects (:) integer , intent ( inout ) :: counts type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error integer :: layer , nbins , origin real ( kind = wp ) :: maxval , radius1 , radius2 type ( vector ) :: pos , dir logical :: trackHistory pos = get_vector ( child , \"position\" , context = context , error = error ) dir = get_vector ( child , \"direction\" , default = vector ( 0.0 , 0.0 , - 1.0 ), context = context , error = error ) call get_value ( child , \"layer\" , layer , 1 ) call get_value ( child , \"radius1\" , radius1 ) call get_value ( child , \"radius2\" , radius2 , origin = origin ) if ( radius2 <= radius1 ) then print '(a)' , context % report ( \"Radii are invalid\" , origin , \"Expected radius2 > radius 1\" ) stop 1 end if call get_value ( child , \"nbins\" , nbins , 100 ) call get_value ( child , \"maxval\" , maxval , 10 0._wp ) call get_value ( child , \"trackHistory\" , trackHistory , . false .) if ( trackHistory ) state % trackHistory = . true . #ifdef _OPENMP if ( trackHistory ) error stop \"Track history currently incompatable with OpenMP!\" #endif dects ( counts ) = annulus_dect ( pos , dir , layer , radius1 , radius2 , nbins , maxval , trackHistory ) counts = counts + 1 end subroutine handle_annulus_dect","tags":"","loc":"proc/handle_annulus_dect.html"},{"title":"handle_camera – signedMCRT","text":"private subroutine handle_camera(child, dects, counts, context, error) Uses sim_state_mod detectors Read in Camera settings and initalise variable Arguments Type Intent Optional Attributes Name type(toml_table), intent(in), pointer :: child type( camera ), intent(inout) :: dects (:) integer, intent(inout) :: counts type(toml_context), intent(in) :: context Context handle for error reporting. type(toml_error), intent(out), allocatable :: error Contents Source Code handle_camera Source Code subroutine handle_camera ( child , dects , counts , context , error ) !! Read in Camera settings and initalise variable use detectors , only : camera use sim_state_mod , only : state type ( toml_table ), pointer , intent ( in ) :: child type ( camera ), intent ( inout ) :: dects (:) integer , intent ( inout ) :: counts !> Context handle for error reporting. type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error integer :: layer , nbins real ( kind = wp ) :: maxval type ( vector ) :: p1 , p2 , p3 logical :: trackHistory p1 = get_vector ( child , \"p1\" , default = vector ( - 1.0 , - 1.0 , - 1.0 ), context = context , error = error ) p2 = get_vector ( child , \"p2\" , default = vector ( 2.0 , 0.0 , 0.0 ), context = context , error = error ) p3 = get_vector ( child , \"p3\" , default = vector ( 0.0 , 2.0 , 0.0 ), context = context , error = error ) call get_value ( child , \"layer\" , layer , 1 ) call get_value ( child , \"nbins\" , nbins , 100 ) call get_value ( child , \"maxval\" , maxval , 10 0._wp ) call get_value ( child , \"trackHistory\" , trackHistory , . false .) if ( trackHistory ) state % trackHistory = . true . #ifdef _OPENMP if ( trackHistory ) error stop \"Track history currently incompatable with OpenMP!\" #endif dects ( counts ) = camera ( p1 , p2 , p3 , layer , nbins , maxval , trackHistory ) counts = counts + 1 end subroutine handle_camera","tags":"","loc":"proc/handle_camera.html"},{"title":"handle_circle_dect – signedMCRT","text":"private subroutine handle_circle_dect(child, dects, counts, context, error) Uses sim_state_mod detectors Read in Circle_detector settings and initalise variable Arguments Type Intent Optional Attributes Name type(toml_table), intent(in), pointer :: child type( circle_dect ), intent(inout) :: dects (:) integer, intent(inout) :: counts type(toml_context), intent(in) :: context type(toml_error), intent(out), allocatable :: error Contents Source Code handle_circle_dect Source Code subroutine handle_circle_dect ( child , dects , counts , context , error ) !! Read in Circle_detector settings and initalise variable use detectors , only : circle_dect use sim_state_mod , only : state type ( toml_table ), pointer , intent ( in ) :: child type ( circle_dect ), intent ( inout ) :: dects (:) integer , intent ( inout ) :: counts type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error integer :: layer , nbins real ( kind = wp ) :: maxval , radius type ( vector ) :: pos , dir logical :: trackHistory pos = get_vector ( child , \"position\" , context = context , error = error ) dir = get_vector ( child , \"direction\" , default = vector ( 0.0 , 0.0 , - 1.0 ), context = context , error = error ) dir = dir % magnitude () call get_value ( child , \"layer\" , layer , 1 ) call get_value ( child , \"radius1\" , radius ) call get_value ( child , \"nbins\" , nbins , 100 ) call get_value ( child , \"maxval\" , maxval , 10 0._wp ) call get_value ( child , \"trackHistory\" , trackHistory , . false .) if ( trackHistory ) state % trackHistory = . true . #ifdef _OPENMP if ( trackHistory ) error stop \"Track history currently incompatable with OpenMP!\" #endif dects ( counts ) = circle_dect ( pos , dir , layer , radius , nbins , maxval , trackHistory ) counts = counts + 1 end subroutine handle_circle_dect","tags":"","loc":"proc/handle_circle_dect.html"},{"title":"parse_detectors – signedMCRT","text":"private subroutine parse_detectors(table, dects, context, error) Uses sim_state_mod detectors parse the detectors Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type( dect_array ), allocatable :: dects (:) Detector array to be filled. type(toml_context), intent(in) :: context Context handle for error reporting. type(toml_error), intent(out), allocatable :: error Contents Source Code parse_detectors Source Code subroutine parse_detectors ( table , dects , context , error ) !! parse the detectors use detectors , only : dect_array , circle_dect , annulus_dect , camera use sim_state_mod , only : state !> Input Toml table type ( toml_table ), intent ( inout ) :: table !> Detector array to be filled. type ( dect_array ), allocatable :: dects (:) !> Context handle for error reporting. type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_array ), pointer :: array type ( toml_table ), pointer :: child character ( len = :), allocatable :: dect_type type ( circle_dect ), target , save , allocatable :: dect_c (:) type ( annulus_dect ), target , save , allocatable :: dect_a (:) type ( camera ), target , save , allocatable :: dect_cam (:) integer :: i , c_counter , a_counter , cam_counter , j , k , origin c_counter = 0 a_counter = 0 cam_counter = 0 call get_value ( table , \"detectors\" , array ) allocate ( dects ( len ( array ))) do i = 1 , len ( array ) call get_value ( array , i , child ) call get_value ( child , \"type\" , dect_type , origin = origin ) select case ( dect_type ) case default call make_error ( error , & context % report ( \"Invalid detector type. Valid types are [circle, annulus, camera]\" , & origin , \"expected valid detector type\" ), - 1 ) return case ( \"circle\" ) c_counter = c_counter + 1 case ( \"annulus\" ) a_counter = a_counter + 1 case ( \"camera\" ) cam_counter = cam_counter + 1 end select end do if ( c_counter > 0 ) allocate ( dect_c ( c_counter )) if ( a_counter > 0 ) allocate ( dect_a ( a_counter )) if ( cam_counter > 0 ) allocate ( dect_cam ( cam_counter )) c_counter = 1 a_counter = 1 cam_counter = 1 state % trackHistory = . false . do i = 1 , len ( array ) call get_value ( array , i , child ) call get_value ( child , \"type\" , dect_type ) call get_value ( child , \"historyFileName\" , state % historyFilename , \"photPos.obj\" ) select case ( dect_type ) case ( \"circle\" ) call handle_circle_dect ( child , dect_c , c_counter , context , error ) if ( allocated ( error )) return case ( \"annulus\" ) call handle_annulus_dect ( child , dect_a , a_counter , context , error ) if ( allocated ( error )) return case ( \"camera\" ) call handle_camera ( child , dect_cam , cam_counter , context , error ) if ( allocated ( error )) return end select end do do i = 1 , c_counter - 1 allocate ( dects ( i )% p , source = dect_c ( i )) dects ( i )% p => dect_c ( i ) end do do j = 1 , a_counter - 1 allocate ( dects ( j + i - 1 )% p , source = dect_a ( j )) dects ( j + i - 1 )% p => dect_a ( j ) end do do k = 1 , cam_counter - 1 allocate ( dects ( j + i + k - 2 )% p , source = dect_cam ( k )) dects ( j + i + k - 2 )% p => dect_cam ( k ) end do if (. not . allocated ( state % historyFilename )) state % historyFilename = \"photPos.obj\" end subroutine parse_detectors","tags":"","loc":"proc/parse_detectors.html"},{"title":"parse_geometry – signedMCRT","text":"private subroutine parse_geometry(table, dict, error) Uses sim_state_mod parse geometry information Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type(toml_table), intent(inout) :: dict Dictonary used to store metadata type(toml_error), intent(out), allocatable :: error Contents Source Code parse_geometry Source Code subroutine parse_geometry ( table , dict , error ) !! parse geometry information use sim_state_mod , only : state !> Input Toml table type ( toml_table ), intent ( INOUT ) :: table !> Dictonary used to store metadata type ( toml_table ), intent ( INOUT ) :: dict type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), pointer :: child real ( kind = wp ) :: tau , musb , musc , muab , muac , hgg integer :: num_spheres call get_value ( table , \"geometry\" , child ) if ( associated ( child )) then call get_value ( child , \"geom_name\" , state % experiment , \"sphere\" ) call get_value ( child , \"tau\" , tau , 1 0._wp ) call set_value ( dict , \"tau\" , tau ) call get_value ( child , \"num_spheres\" , num_spheres , 10 ) call set_value ( dict , \"num_spheres\" , num_spheres ) call get_value ( child , \"musb\" , musb , 0.0_wp ) call set_value ( dict , \"musb\" , musb ) call get_value ( child , \"muab\" , muab , 0.01_wp ) call set_value ( dict , \"muab\" , muab ) call get_value ( child , \"musc\" , musc , 0.0_wp ) call set_value ( dict , \"musc\" , musc ) call get_value ( child , \"muac\" , muac , 0.01_wp ) call set_value ( dict , \"muac\" , muac ) call get_value ( child , \"hgg\" , hgg , 0.7_wp ) call set_value ( dict , \"hgg\" , hgg ) else call make_error ( error , \"Need geometry table in input param file\" , - 1 ) end if end subroutine parse_geometry","tags":"","loc":"proc/parse_geometry.html"},{"title":"parse_grid – signedMCRT","text":"private subroutine parse_grid(table, dict, error) Uses gridMod sim_state_mod parse grid input data Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type(toml_table), intent(inout) :: dict Dictonary used to store metadata type(toml_error), intent(out), allocatable :: error Contents Source Code parse_grid Source Code subroutine parse_grid ( table , dict , error ) !! parse grid input data use sim_state_mod , only : state use gridMod , only : init_grid !> Input Toml table type ( toml_table ), intent ( inout ) :: table !> Dictonary used to store metadata type ( toml_table ), intent ( inout ) :: dict type ( toml_error ), allocatable , intent ( out ) :: error character ( len = :), allocatable :: msg type ( toml_table ), pointer :: child integer :: nxg , nyg , nzg real ( kind = wp ) :: xmax , ymax , zmax character ( len = :), allocatable :: units call get_value ( table , \"grid\" , child ) if ( associated ( child )) then call get_value ( child , \"nxg\" , nxg , 200 ) call get_value ( child , \"nyg\" , nyg , 200 ) call get_value ( child , \"nzg\" , nzg , 200 ) call get_value ( child , \"xmax\" , xmax , 1.0_wp ) call get_value ( child , \"ymax\" , ymax , 1.0_wp ) call get_value ( child , \"zmax\" , zmax , 1.0_wp ) call get_value ( child , \"units\" , units , \"cm\" ) call set_value ( dict , \"units\" , units ) else msg = \"Need grid table in input param file\" call make_error ( error , msg ) return end if state % grid = init_grid ( nxg , nyg , nzg , xmax , ymax , zmax ) end subroutine parse_grid","tags":"","loc":"proc/parse_grid.html"},{"title":"parse_output – signedMCRT","text":"private subroutine parse_output(table, error) Uses sim_state_mod parse output file information Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type(toml_error), intent(out), allocatable :: error Contents Source Code parse_output Source Code subroutine parse_output ( table , error ) !! parse output file information use sim_state_mod , only : state !> Input Toml table type ( toml_table ), intent ( inout ) :: table type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), pointer :: child type ( toml_array ), pointer :: children integer :: i , nlen call get_value ( table , \"output\" , child ) if ( associated ( child )) then call get_value ( child , \"fluence\" , state % outfile , \"fluence.nrrd\" ) call get_value ( child , \"absorb\" , state % outfile_absorb , \"absorb.nrrd\" ) call get_value ( child , \"render\" , state % renderfile , \"geom_render.nrrd\" ) call get_value ( child , \"render_geom\" , state % render_geom , . false .) call get_value ( child , \"render_size\" , children , requested = . false .) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then error stop \"Need a vector of size 3 for render_size.\" end if do i = 1 , len ( children ) call get_value ( children , i , state % render_size ( i )) end do else state % render_size = [ 200 , 200 , 200 ] end if call get_value ( child , \"overwrite\" , state % overwrite , . false .) else call make_error ( error , \"Need output table in input param file\" , - 1 ) return end if end subroutine parse_output","tags":"","loc":"proc/parse_output.html"},{"title":"parse_params – signedMCRT","text":"public subroutine parse_params(filename, packet, dects, spectrum, dict, error) Uses photonMod piecewiseMod detectors entry point for parsing toml file Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: filename filename of input toml file type( photon ), intent(out) :: packet some input options set up data in the photon class type( dect_array ), intent(out), allocatable :: dects (:) detector array which is setup during parsing type( spectrum_t ), intent(out) :: spectrum spectrum type which is set up during parsing type(toml_table), intent(inout) :: dict dictionary that stores potential metadata to be saved with simulation output type(toml_error), intent(out), allocatable :: error Last error raised during parsing. Unallocated if no error raised. Need to handle this on return from parse_params. Contents Source Code parse_params Source Code subroutine parse_params ( filename , packet , dects , spectrum , dict , error ) !! entry point for parsing toml file use detectors , only : dect_array use photonmod use piecewiseMod !> filename of input toml file character ( * ), intent ( IN ) :: filename !> dictionary that stores potential metadata to be saved with simulation output type ( toml_table ), intent ( INOUT ) :: dict !> some input options set up data in the photon class type ( photon ), intent ( OUT ) :: packet !> detector array which is setup during parsing type ( dect_array ), allocatable , intent ( out ) :: dects (:) !> spectrum type which is set up during parsing type ( spectrum_t ), intent ( out ) :: spectrum !> Last error raised during parsing. Unallocated if no error raised. Need to handle this on return from parse_params. type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), allocatable :: table type ( toml_context ) :: context call toml_load ( table , trim ( filename ), context = context , error = error ) if ( allocated ( error )) return call parse_source ( table , packet , dict , spectrum , context , error ) if ( allocated ( error )) return call parse_grid ( table , dict , error ) if ( allocated ( error )) return call parse_geometry ( table , dict , error ) if ( allocated ( error )) return call parse_detectors ( table , dects , context , error ) if ( allocated ( error )) return call parse_output ( table , error ) if ( allocated ( error )) return call parse_simulation ( table , error ) if ( allocated ( error )) return end subroutine parse_params","tags":"","loc":"proc/parse_params.html"},{"title":"parse_simulation – signedMCRT","text":"private subroutine parse_simulation(table, error) Uses sim_state_mod parse simulation information Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type(toml_error), intent(out), allocatable :: error Contents Source Code parse_simulation Source Code subroutine parse_simulation ( table , error ) !! parse simulation information use sim_state_mod , only : state !> Input Toml table type ( toml_table ), intent ( inout ) :: table type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), pointer :: child call get_value ( table , \"simulation\" , child ) if ( associated ( child )) then call get_value ( child , \"iseed\" , state % iseed , 123456789 ) call get_value ( child , \"tev\" , state % tev , . false .) call get_value ( child , \"absorb\" , state % absorb , . false .) else call make_error ( error , \"Need simulation table in input param file\" , - 1 ) return end if end subroutine parse_simulation","tags":"","loc":"proc/parse_simulation.html"},{"title":"parse_source – signedMCRT","text":"private subroutine parse_source(table, packet, dict, spectrum, context, error) Uses photonMod piecewiseMod tomlf_error sim_state_mod Parse sources\nany updates here MUST be reflected in docs/config.md Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type( photon ), intent(out) :: packet Photon packet. Used to store information to save computation type(toml_table), intent(inout) :: dict Dictonary used to store metadata type( spectrum_t ), intent(out) :: spectrum Spectrum type. type(toml_context) :: context Context handle for error reporting type(toml_error), intent(out), allocatable :: error Error message Contents Source Code parse_source Source Code subroutine parse_source ( table , packet , dict , spectrum , context , error ) !! Parse sources !! any updates here MUST be reflected in docs/config.md use sim_state_mod , only : state use photonmod use piecewiseMod use tomlf_error !> Input Toml table type ( toml_table ), intent ( inout ) :: table !> Dictonary used to store metadata type ( toml_table ), intent ( inout ) :: dict !> Photon packet. Used to store information to save computation type ( photon ), intent ( out ) :: packet !> Spectrum type. type ( spectrum_t ), intent ( out ) :: spectrum !> Context handle for error reporting type ( toml_context ) :: context !> Error message type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), pointer :: child type ( toml_array ), pointer :: children type ( vector ) :: poss , dirr real ( kind = wp ) :: dir ( 3 ), pos ( 3 ), corners ( 3 , 3 ), radius , beta , rlo , rhi integer :: i , nlen , origin character ( len = 1 ) :: axis ( 3 ) character ( len = :), allocatable :: direction , annulus_type axis = [ \"x\" , \"y\" , \"z\" ] pos = 0._wp dir = 0._wp corners = reshape (( / - 1._wp , - 1._wp , 1._wp , & 2._wp , 0._wp , 0._wp , & 0._wp , 2._wp , 0._wp / ), & shape ( corners ), order = [ 2 , 1 ]) call get_value ( table , \"source\" , child , requested = . false .) if ( associated ( child )) then call get_value ( child , \"name\" , state % source , \"point\" ) call get_value ( child , \"nphotons\" , state % nphotons , 1000000 ) call get_value ( child , \"position\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a vector of size 3 for position\" , origin , \"expected vector of size 3\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , pos ( i )) end do else if ( state % source == \"point\" ) then call make_error ( error , & context % report ( \"Point source needs a position!\" , origin , \"Need vector of size 3 for position\" ), - 1 ) return end if end if poss = vector ( pos ( 1 ), pos ( 2 ), pos ( 3 )) children => null () call get_value ( child , \"direction\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then if ( state % source == \"point\" ) then print '(a)' , context % report (& \"Point source needs no direction!!\" , origin , level = toml_level % warning ) end if nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a vector of size 3 for direction\" , origin , \"expected vector of size 3\" ), - 1 ) return end if if ( state % source == \"circular\" ) then print '(a)' , context % report (& \"Direction not yet fully tested for source type Circular. Results may not be accurate!\" , origin ,& level = toml_level % warning ) end if do i = 1 , len ( children ) call get_value ( children , i , dir ( i )) end do dirr % x = dir ( 1 ) dirr % y = dir ( 2 ) dirr % z = dir ( 3 ) else call get_value ( child , \"direction\" , direction , origin = origin ) if ( allocated ( direction )) then if ( state % source == \"point\" ) then print '(a)' , context % report (& \"Point source needs no direction!!\" , origin , level = toml_level % warning ) end if select case ( direction ) case ( \"x\" ) dirr = vector ( 1._wp , 0._wp , 0._wp ) case ( \"-x\" ) dirr = vector ( - 1._wp , 0._wp , 0._wp ) case ( \"y\" ) dirr = vector ( 0._wp , 1._wp , 0._wp ) case ( \"-y\" ) dirr = vector ( 0._wp , - 1._wp , 0._wp ) case ( \"z\" ) dirr = vector ( 0._wp , 0._wp , 1._wp ) case ( \"-z\" ) dirr = vector ( 0._wp , 0._wp , - 1._wp ) case default call make_error ( error , context % report ( \"Direction needs a cardinal direction i.e x, y, or z\" , origin , & \"Expected cardinal direction\" ), - 1 ) return end select elseif ( state % source /= \"point\" ) then call make_error ( error , context % report ( \"Need to specify direction for source type!\" , origin , & \"No direction specified\" ), - 1 ) return end if end if children => null () call get_value ( child , \"point1\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a matrix row for points\" , origin , \"expected matrix row of size 3\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , corners ( i , 1 )) call set_value ( dict , \"pos1%\" // axis ( i ), corners ( i , 1 )) end do else if ( state % source == \"uniform\" ) then call make_error ( error , & context % report ( \"Uniform source requires point1 variable\" , origin , \"expected point1 variable\" ), - 1 ) return end if end if call get_value ( child , \"point2\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a matrix row for points\" , origin , \"expected matrix row of size 3\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , corners ( i , 2 )) call set_value ( dict , \"pos2%\" // axis ( i ), corners ( i , 2 )) end do else if ( state % source == \"uniform\" ) then call make_error ( error , & context % report ( \"Uniform source requires point2 variable\" , origin , \"expected point2 variable\" ), - 1 ) return end if end if call get_value ( child , \"point3\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a matrix row for points\" , origin , \"expected matrix row of size 3\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , corners ( i , 3 )) call set_value ( dict , \"pos3%\" // axis ( i ), corners ( i , 3 )) end do else if ( state % source == \"uniform\" ) then call make_error ( error , & context % report ( \"Uniform source requires point3 variable\" , origin , \"expected point3 variable\" ), - 1 ) return end if end if call get_value ( child , \"radius\" , radius , 0.5_wp ) call set_value ( dict , \"radius\" , radius ) ! parameters for annulus beam type call get_value ( child , \"beta\" , beta , 5._wp ) call set_value ( dict , \"beta\" , beta ) call get_value ( child , \"radius_hi\" , rhi , 0.6_wp ) call set_value ( dict , \"rhi\" , rhi ) call get_value ( child , \"annulus_type\" , annulus_type , \"gaussian\" ) call set_value ( dict , \"annulus_type\" , annulus_type ) ! parse spectrum call parse_spectrum ( child , spectrum , dict , context , error ) if ( allocated ( error )) return else call make_error ( error , context % report ( \"Simulation needs Source table\" , origin , \"Missing source table\" ), - 1 ) return end if call set_photon ( poss , dirr ) packet = photon ( state % source ) packet % pos = poss packet % nxp = dirr % x packet % nyp = dirr % y packet % nzp = dirr % z end subroutine parse_source","tags":"","loc":"proc/parse_source.html"},{"title":"parse_spectrum – signedMCRT","text":"private subroutine parse_spectrum(table, spectrum, dict, context, error) Uses stdlib_io stb_image_mod iso_c_binding piecewiseMod constants Parse spectrums to be used Arguments Type Intent Optional Attributes Name type(toml_table), pointer :: table type( spectrum_t ), intent(out) :: spectrum type(toml_table), intent(inout) :: dict type(toml_context) :: context type(toml_error), intent(out), allocatable :: error Contents Source Code parse_spectrum Source Code subroutine parse_spectrum ( table , spectrum , dict , context , error ) !! Parse spectrums to be used ! TODO seperate out each case to seperate functions. ! TODO add spectra type to input optical properties ! handle all possible errors ! document code and update config.md use piecewiseMod use stdlib_io , only : loadtxt use constants , only : resdir , sp use stb_image_mod use , intrinsic :: iso_c_binding type ( toml_table ), intent ( INOUT ) :: dict type ( toml_table ), pointer :: table type ( toml_context ) :: context type ( spectrum_t ), intent ( out ) :: spectrum type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_array ), pointer :: children integer :: origin , nlen , i , err , width , height , n_channels , u integer , allocatable :: image (:,:,:) type ( constant ), save , target :: const type ( piecewise1D ), save , target :: OneD type ( piecewise2D ), save , target :: TwoD character ( len = :), allocatable :: stype , sfile , filetype real ( kind = wp ) :: wavelength , cellsize ( 2 ) real ( kind = wp ), allocatable :: array (:,:) real ( kind = sp ), allocatable :: array_sp (:,:) call get_value ( table , \"spectrum_type\" , stype , \"constant\" , origin = origin ) select case ( stype ) case ( \"constant\" ) call get_value ( table , \"wavelength\" , wavelength , 50 0.0_wp ) const = constant ( wavelength ) allocate ( spectrum % p , source = const ) spectrum % p => const case ( \"1D\" ) allocate ( spectrum % p , source = OneD ) call get_value ( table , \"spectrum_file\" , sfile ) call loadtxt ( \"res/\" // sfile , array_sp ) array = array_sp deallocate ( array_sp ) OneD = piecewise1D ( array ) allocate ( spectrum % p , source = OneD ) spectrum % p => OneD case ( \"2D\" ) allocate ( spectrum % p , source = TwoD ) call get_value ( table , \"spectrum_file\" , sfile ) call get_value ( table , \"cell_size\" , children , requested = . true ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen /= 2 ) then call make_error ( error ,& context % report ( \"Need a vector of size 2 for cell_size\" , origin , \"expected vector of size 2\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , cellsize ( i )) end do else call make_error ( error ,& context % report ( \"Need a vector of size 2 for cell_size\" , origin , \"expected vector of size 2\" ), - 1 ) return end if filetype = sfile ( len ( sfile ) - 2 :) select case ( filetype ) case ( \"png\" ) err = stbi_info ( trim ( resdir ) // trim ( sfile ) // c_null_char , width , height , n_channels ) if ( err == 0 ) then call make_error ( error , \"Error reading file: \" // trim ( sfile ) // \" \" // stbi_failure_reason (), - 1 ) return end if image = stbi_load ( trim ( resdir ) // trim ( sfile ) // c_null_char , width , height , n_channels , 0 ) allocate ( array ( size ( image , 1 ), size ( image , 2 ))) array = image (:,:, 1 ) deallocate ( image ) case ( \"dat\" ) call loadtxt ( resdir // trim ( sfile ), array ) case ( \"txt\" ) call loadtxt ( resdir // trim ( sfile ), array ) case default print '(2a)' , \"Unknown spectrum file type:\" , filetype end select TwoD = piecewise2D ( cellsize ( 1 ), cellsize ( 2 ), array ) allocate ( spectrum % p , source = TwoD ) spectrum % p => TwoD case default call make_error ( error ,& context % report ( \"Not a valid spectrum type!\" , origin , \"expected one of either ['constant', '1D', '2D']\" ), - 1 ) return end select end subroutine parse_spectrum","tags":"","loc":"proc/parse_spectrum.html"},{"title":"init_vec4_vector_real – signedMCRT","text":"private function init_vec4_vector_real(vec, val) result(out) Uses vector_class Initalise vec4 from a vec3 and Scalar\ne.g vec4 = [vec3%x, vec3%y, vec3%z, scalar] Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: vec Input vec3 real(kind=wp), intent(in) :: val Input Scalar Return Value type( vec4 ) Contents Source Code init_vec4_vector_real Source Code type ( vec4 ) function init_vec4_vector_real ( vec , val ) result ( out ) !! Initalise vec4 from a vec3 and Scalar !! e.g vec4 = [vec3%x, vec3%y, vec3%z, scalar] use vector_class !> Input vec3 type ( vector ), intent ( in ) :: vec !> Input Scalar real ( kind = wp ), intent ( in ) :: val out % x = vec % x out % y = vec % y out % z = vec % z out % p = val end function init_vec4_vector_real","tags":"","loc":"proc/init_vec4_vector_real.html"},{"title":"length – signedMCRT","text":"private pure elemental function length(this) Returns the length of a vec4 Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: this Return Value real(kind=wp) Contents","tags":"","loc":"proc/length~2.html"},{"title":"magnitude_fn – signedMCRT","text":"private pure elemental function magnitude_fn(this) Returns the magnitude of a vec4 Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: this Return Value type( vec4 ) Contents Source Code magnitude_fn Source Code type ( vec4 ) pure elemental function magnitude_fn ( this ) !! Returns the magnitude of a vec4 class ( vec4 ), intent ( in ) :: this magnitude_fn = this / this % length () end function magnitude_fn","tags":"","loc":"proc/magnitude_fn.html"},{"title":"scal_add_vec – signedMCRT","text":"private pure elemental function scal_add_vec(a, b) Elementwise scalar + vec4 Type Bound vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to add class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) Contents Source Code scal_add_vec Source Code type ( vec4 ) pure elemental function scal_add_vec ( a , b ) !! Elementwise scalar + vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: b !> Scalar to add real ( kind = wp ), intent ( IN ) :: a scal_add_vec = vec4 ( b % x + a , b % y + a , b % z + a , b % p + a ) end function scal_add_vec","tags":"","loc":"proc/scal_add_vec~2.html"},{"title":"scal_minus_vec – signedMCRT","text":"private pure elemental function scal_minus_vec(a, b) Elementwise Scalar - vec4 Type Bound vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to subtract class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) Contents Source Code scal_minus_vec Source Code type ( vec4 ) pure elemental function scal_minus_vec ( a , b ) !! Elementwise Scalar - vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: b !> Scalar to subtract real ( kind = wp ), intent ( IN ) :: a scal_minus_vec = vec4 ( a - b % x , a - b % y , a - b % z , a - b % p ) end function scal_minus_vec","tags":"","loc":"proc/scal_minus_vec~2.html"},{"title":"scal_mult_vec – signedMCRT","text":"private pure elemental function scal_mult_vec(a, b) Elementwise Scalar * vec4 Type Bound vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) Contents Source Code scal_mult_vec Source Code type ( vec4 ) pure elemental function scal_mult_vec ( a , b ) !! Elementwise Scalar * vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: b !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: a scal_mult_vec = vec4 ( a * b % x , a * b % y , a * b % z , a * b % p ) end function scal_mult_vec","tags":"","loc":"proc/scal_mult_vec~2.html"},{"title":"sin_vec – signedMCRT","text":"private pure elemental function sin_vec(p) Sine of a vec4, elementwise Arguments Type Intent Optional Attributes Name type( vec4 ), intent(in) :: p Input vec4 Return Value type( vec4 ) Contents Source Code sin_vec Source Code type ( vec4 ) pure elemental function sin_vec ( p ) !! Sine of a vec4, elementwise !> Input vec4 type ( vec4 ), intent ( IN ) :: p sin_vec = vec4 ( sin ( p % x ), sin ( p % y ), sin ( p % z ), sin ( p % p )) end function sin_vec","tags":"","loc":"proc/sin_vec.html"},{"title":"vec_add_scal – signedMCRT","text":"private pure elemental function vec_add_scal(a, b) Elementwise vec4 + scalar Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to add Return Value type( vec4 ) Contents Source Code vec_add_scal Source Code type ( vec4 ) pure elemental function vec_add_scal ( a , b ) !! Elementwise vec4 + scalar !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to add real ( kind = wp ), intent ( IN ) :: b vec_add_scal = vec4 ( a % x + b , a % y + b , a % z + b , a % p + b ) end function vec_add_scal","tags":"","loc":"proc/vec_add_scal~2.html"},{"title":"vec_add_vec – signedMCRT","text":"private pure elemental function vec_add_vec(a, b) Elementwise vec4 + vec4 Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to add Return Value type( vec4 ) Contents Source Code vec_add_vec Source Code type ( vec4 ) pure elemental function vec_add_vec ( a , b ) !! Elementwise vec4 + vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> vec4 to add type ( vec4 ), intent ( IN ) :: b vec_add_vec = vec4 ( a % x + b % x , a % y + b % y , a % z + b % z , a % p + b % p ) end function vec_add_vec","tags":"","loc":"proc/vec_add_vec~2.html"},{"title":"vec_div_scal_int – signedMCRT","text":"private pure elemental function vec_div_scal_int(a, b) Elementwise vec4 / Scalar. Scalar is an integer Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 integer, intent(in) :: b Scalar to divide by Return Value type( vec4 ) Contents Source Code vec_div_scal_int Source Code type ( vec4 ) pure elemental function vec_div_scal_int ( a , b ) !! Elementwise vec4 / Scalar. Scalar is an integer !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to divide by integer , intent ( IN ) :: b vec_div_scal_int = vec4 ( a % x / real ( b , kind = wp ), a % y / real ( b , kind = wp ), a % z / real ( b , kind = wp ), a % p / real ( b , kind = wp )) end function vec_div_scal_int","tags":"","loc":"proc/vec_div_scal_int~2.html"},{"title":"vec_div_scal_r4 – signedMCRT","text":"private pure elemental function vec_div_scal_r4(a, b) Uses constants Elementwise vec4 / Scalar. Scalar is 32-bit float Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=sp), intent(in) :: b Scalar to divide by Return Value type( vec4 ) Contents Source Code vec_div_scal_r4 Source Code type ( vec4 ) pure elemental function vec_div_scal_r4 ( a , b ) !! Elementwise vec4 / Scalar. Scalar is 32-bit float use constants , only : sp !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to divide by real ( kind = sp ), intent ( IN ) :: b vec_div_scal_r4 = vec4 ( a % x / b , a % y / b , a % z / b , a % p / b ) end function vec_div_scal_r4","tags":"","loc":"proc/vec_div_scal_r4~2.html"},{"title":"vec_div_scal_r8 – signedMCRT","text":"private pure elemental function vec_div_scal_r8(a, b) Uses constants Elementwise vec4 / Scalar. Scalar is 32-bit float Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=dp), intent(in) :: b Scalar to divide by Return Value type( vec4 ) Contents Source Code vec_div_scal_r8 Source Code type ( vec4 ) pure elemental function vec_div_scal_r8 ( a , b ) !! Elementwise vec4 / Scalar. Scalar is 32-bit float use constants , only : dp !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to divide by real ( kind = dp ), intent ( IN ) :: b vec_div_scal_r8 = vec4 ( a % x / b , a % y / b , a % z / b , a % p / b ) end function vec_div_scal_r8","tags":"","loc":"proc/vec_div_scal_r8~2.html"},{"title":"vec_dot_vec – signedMCRT","text":"private pure elemental function vec_dot_vec(a, b) result(dot) dot product between two vec4s Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to dot with Return Value real(kind=wp) Contents Source Code vec_dot_vec Source Code pure elemental function vec_dot_vec ( a , b ) result ( dot ) !! dot product between two vec4s !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> vec4 to dot with type ( vec4 ), intent ( IN ) :: b real ( kind = wp ) :: dot dot = ( a % x * b % x ) + ( a % y * b % y ) + ( a % z * b % z ) + ( a % p * b % p ) end function vec_dot_vec","tags":"","loc":"proc/vec_dot_vec~2.html"},{"title":"vec_minus_scal – signedMCRT","text":"private pure elemental function vec_minus_scal(a, b) Elementwise vec4 - scalar Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( vec4 ) Contents Source Code vec_minus_scal Source Code type ( vec4 ) pure elemental function vec_minus_scal ( a , b ) !! Elementwise vec4 - scalar !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to subtract real ( kind = wp ), intent ( IN ) :: b vec_minus_scal = vec4 ( a % x - b , a % y - b , a % z - b , a % p - b ) end function vec_minus_scal","tags":"","loc":"proc/vec_minus_scal~2.html"},{"title":"vec_minus_vec – signedMCRT","text":"private pure elemental function vec_minus_vec(a, b) Elementwise vec4 - vec4 Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to subtract Return Value type( vec4 ) Contents Source Code vec_minus_vec Source Code type ( vec4 ) pure elemental function vec_minus_vec ( a , b ) !! Elementwise vec4 - vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> vec4 to subtract type ( vec4 ), intent ( IN ) :: b vec_minus_vec = vec4 ( a % x - b % x , a % y - b % y , a % z - b % z , a % p - b % p ) end function vec_minus_vec","tags":"","loc":"proc/vec_minus_vec~2.html"},{"title":"vec_mult_scal – signedMCRT","text":"private pure elemental function vec_mult_scal(a, b) Elementwise vec4 * Scalar Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( vec4 ) Contents Source Code vec_mult_scal Source Code type ( vec4 ) pure elemental function vec_mult_scal ( a , b ) !! Elementwise vec4 * Scalar !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: b vec_mult_scal = vec4 ( a % x * b , a % y * b , a % z * b , a % p * b ) end function vec_mult_scal","tags":"","loc":"proc/vec_mult_scal~2.html"},{"title":"vec_mult_vec – signedMCRT","text":"private pure elemental function vec_mult_vec(a, b) Elementwise vec4 * vec4 Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to multiply by Return Value type( vec4 ) Contents Source Code vec_mult_vec Source Code type ( vec4 ) pure elemental function vec_mult_vec ( a , b ) !! Elementwise vec4 * vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> vec4 to multiply by type ( vec4 ), intent ( IN ) :: b vec_mult_vec = vec4 ( a % x * b % x , a % y * b % y , a % z * b % z , a % p * b % p ) end function vec_mult_vec","tags":"","loc":"proc/vec_mult_vec~2.html"},{"title":"sin – signedMCRT","text":"public interface sin Vec4 overload of the sin intrinsic Contents Module Procedures sin_vec Module Procedures private pure elemental function sin_vec (p) Sine of a vec4, elementwise Arguments Type Intent Optional Attributes Name type( vec4 ), intent(in) :: p Input vec4 Return Value type( vec4 )","tags":"","loc":"interface/sin.html"},{"title":"vec4 – signedMCRT","text":"public interface vec4 Initalise a vec4 from a vec3 and a scalar Contents Module Procedures init_vec4_vector_real Module Procedures private function init_vec4_vector_real (vec, val) result(out) Initalise vec4 from a vec3 and Scalar\ne.g vec4 = [vec3%x, vec3%y, vec3%z, scalar] Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: vec Input vec3 real(kind=wp), intent(in) :: val Input Scalar Return Value type( vec4 )","tags":"","loc":"interface/vec4.html"},{"title":"get_voxel – signedMCRT","text":"private function get_voxel(this, pos) result(res) Uses vector_class get current voxel the photon packet is in Type Bound cart_grid Arguments Type Intent Optional Attributes Name class( cart_grid ) :: this grid class type( vector ), intent(in) :: pos current vector position of photon packet Return Value integer, (3) Contents Source Code get_voxel Source Code function get_voxel ( this , pos ) result ( res ) !! get current voxel the photon packet is in use vector_class !> grid class class ( cart_grid ) :: this !> current vector position of photon packet type ( vector ), intent ( IN ) :: pos integer :: res ( 3 ) res ( 1 ) = int ( this % nxg * ( pos % x + this % xmax ) / ( 2._wp * this % xmax )) + 1 res ( 2 ) = int ( this % nyg * ( pos % y + this % ymax ) / ( 2._wp * this % ymax )) + 1 res ( 3 ) = int ( this % nzg * ( pos % z + this % zmax ) / ( 2._wp * this % zmax )) + 1 end function get_voxel","tags":"","loc":"proc/get_voxel.html"},{"title":"init_grid – signedMCRT","text":"public function init_grid(nxg, nyg, nzg, xmax, ymax, zmax) setup grid Arguments Type Intent Optional Attributes Name integer, intent(in) :: nxg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nyg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nzg number of voxels in each cardinal direction for fluence grid real(kind=wp), intent(in) :: xmax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: ymax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: zmax half size of each dimension in fluence grid. Return Value type( cart_grid ) Contents Source Code init_grid Source Code type ( cart_grid ) function init_grid ( nxg , nyg , nzg , xmax , ymax , zmax ) !! setup grid !> number of voxels in each cardinal direction for fluence grid integer , intent ( IN ) :: nxg , nyg , nzg !> half size of each dimension in fluence grid. real ( kind = wp ), intent ( IN ) :: xmax , ymax , zmax integer :: i init_grid % nxg = nxg init_grid % nyg = nyg init_grid % nzg = nzg init_grid % xmax = xmax init_grid % ymax = ymax init_grid % zmax = zmax allocate ( init_grid % xface ( nxg + 1 ), init_grid % yface ( nyg + 1 ), init_grid % zface ( nzg + 2 )) init_grid % xface = 0._wp init_grid % yface = 0._wp init_grid % zface = 0._wp ! Set small distance for use in optical depth integration routines ! for roundoff effects when crossing cell walls init_grid % delta = 1.e-8_wp * min ((( 2._wp * xmax ) / nxg ), (( 2._wp * ymax ) / nyg ), (( 2._wp * zmax ) / nzg )) do i = 1 , nxg + 1 init_grid % xface ( i ) = ( i - 1 ) * 2._wp * xmax / nxg end do do i = 1 , nyg + 1 init_grid % yface ( i ) = ( i - 1 ) * 2._wp * ymax / nyg end do do i = 1 , nzg + 2 init_grid % zface ( i ) = ( i - 1 ) * 2._wp * zmax / nzg end do end function init_grid","tags":"","loc":"proc/init_grid.html"},{"title":"cart_grid – signedMCRT","text":"public interface cart_grid Contents Module Procedures init_grid Module Procedures public function init_grid (nxg, nyg, nzg, xmax, ymax, zmax) setup grid Arguments Type Intent Optional Attributes Name integer, intent(in) :: nxg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nyg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nzg number of voxels in each cardinal direction for fluence grid real(kind=wp), intent(in) :: xmax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: ymax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: zmax half size of each dimension in fluence grid. Return Value type( cart_grid )","tags":"","loc":"interface/cart_grid.html"},{"title":"find – signedMCRT","text":"private function find(val, a) searches for bracketing indices for a value value in an array a Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val value to find in array real(kind=wp), intent(in) :: a (:) array to find val in Return Value integer Contents Source Code find Source Code integer function find ( val , a ) !! searches for bracketing indices for a value value in an array a !> value to find in array real ( kind = wp ), intent ( in ) :: val !> array to find val in real ( kind = wp ), intent ( in ) :: a (:) integer :: n , lo , mid , hi n = size ( a ) lo = 0 hi = n + 1 if ( val == a ( 1 )) then find = 1 else if ( val == a ( n )) then find = n - 1 else if (( val > a ( n )) . or . ( val < a ( 1 ))) then find = - 1 else do if ( hi - lo <= 1 ) exit mid = ( hi + lo ) / 2 if ( val >= a ( mid )) then lo = mid else hi = mid end if end do find = lo end if end function find","tags":"","loc":"proc/find.html"},{"title":"wall_dist – signedMCRT","text":"private function wall_dist(grid, celli, cellj, cellk, pos, dir, ldir) result(res) Uses gridMod vector_class funtion that returns distant to nearest wall and which wall that is (x, y, or z) Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid integer, intent(inout) :: celli integer, intent(inout) :: cellj integer, intent(inout) :: cellk type( vector ), intent(in) :: pos type( vector ), intent(in) :: dir logical, intent(inout) :: ldir (:) Return Value real(kind=wp) Contents Source Code wall_dist Source Code function wall_dist ( grid , celli , cellj , cellk , pos , dir , ldir ) result ( res ) !! funtion that returns distant to nearest wall and which wall that is (x, y, or z) use vector_class use gridMod type ( cart_grid ), intent ( IN ) :: grid type ( vector ), intent ( IN ) :: pos , dir logical , intent ( INOUT ) :: ldir (:) integer , intent ( INOUT ) :: celli , cellj , cellk real ( kind = wp ) :: res real ( kind = wp ) :: dx , dy , dz dx = - 99 9._wp dy = - 99 9._wp dz = - 99 9._wp if ( dir % x > 0._wp ) then dx = ( grid % xface ( celli + 1 ) - pos % x ) / dir % x elseif ( dir % x < 0._wp ) then dx = ( grid % xface ( celli ) - pos % x ) / dir % x elseif ( dir % x == 0._wp ) then dx = 10000 0._wp end if if ( dir % y > 0._wp ) then dy = ( grid % yface ( cellj + 1 ) - pos % y ) / dir % y elseif ( dir % y < 0._wp ) then dy = ( grid % yface ( cellj ) - pos % y ) / dir % y elseif ( dir % y == 0._wp ) then dy = 10000 0._wp end if if ( dir % z > 0._wp ) then dz = ( grid % zface ( cellk + 1 ) - pos % z ) / dir % z elseif ( dir % z < 0._wp ) then dz = ( grid % zface ( cellk ) - pos % z ) / dir % z elseif ( dir % z == 0._wp ) then dz = 10000 0._wp end if res = min ( dx , dy , dz ) if ( res < 0._wp ) then print * , 'dcell < 0.0 warning! ' , res print * , dx , dy , dz print * , dir print * , celli , cellj , cellk error stop 1 end if ldir = [ res == dx , res == dy , res == dz ] if (. not . ldir ( 1 ) . and . . not . ldir ( 2 ) . and . . not . ldir ( 3 )) print * , 'Error in dir flag' end function wall_dist","tags":"","loc":"proc/wall_dist.html"},{"title":"tauint2 – signedMCRT","text":"public subroutine tauint2(grid, packet, sdfs_array) Uses surfaces photonMod vector_class sdfs random gridMod optical depth integration subroutine\nMoves photons to interaction location\nCalculated is any reflection or refraction happens whilst moving Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid type( photon ), intent(inout) :: packet type( sdf ), intent(in) :: sdfs_array (:) Contents Source Code tauint2 Source Code subroutine tauint2 ( grid , packet , sdfs_array ) !! optical depth integration subroutine !! Moves photons to interaction location !! Calculated is any reflection or refraction happens whilst moving ! use gridMod , only : cart_grid use photonMod , only : photon use random , only : ran2 use sdfs , only : sdf , calcNormal use surfaces , only : reflect_refract use vector_class , only : vector type ( cart_grid ), intent ( in ) :: grid type ( photon ), intent ( inout ) :: packet type ( sdf ), intent ( in ) :: sdfs_array (:) real ( kind = wp ) :: tau , d_sdf , t_sdf , taurun , ds ( size ( sdfs_array )), dstmp ( size ( sdfs_array )) real ( kind = wp ) :: eps , dtot , old ( size ( sdfs_array )), new ( size ( sdfs_array )), n1 , n2 , Ri integer :: i , oldlayer , new_layer type ( vector ) :: pos , dir , oldpos , N logical :: rflag !setup temp variables pos = packet % pos oldpos = pos dir = vector ( packet % nxp , packet % nyp , packet % nzp ) !round off distance eps = 1e-8_wp !get random tau tau = - log ( ran2 ()) taurun = 0. dtot = 0. do !setup sdf distance and current layer ds = 0. do i = 1 , size ( ds ) ds ( i ) = abs ( sdfs_array ( i )% evaluate ( pos )) end do packet % cnts = packet % cnts + size ( ds ) d_sdf = minval ( ds ) if ( d_sdf < eps ) then packet % tflag = . true . exit end if do while ( d_sdf > eps ) t_sdf = d_sdf * sdfs_array ( packet % layer )% getkappa () if ( taurun + t_sdf <= tau ) then !move full distance to sdf surface taurun = taurun + t_sdf oldpos = pos !comment out for phase screen call update_grids ( grid , oldpos , dir , d_sdf , packet , sdfs_array ( packet % layer )% getmua ()) pos = pos + d_sdf * dir dtot = dtot + d_sdf else !run out of tau so move remaining tau and exit d_sdf = ( tau - taurun ) / sdfs_array ( packet % layer )% getkappa () dtot = dtot + d_sdf taurun = tau oldpos = pos pos = pos + d_sdf * dir !comment out for phase screen call update_grids ( grid , oldpos , dir , d_sdf , packet , sdfs_array ( packet % layer )% getmua ()) exit end if ! get distance to nearest sdf ds = 0._wp do i = 1 , size ( ds ) ds ( i ) = sdfs_array ( i )% evaluate ( pos ) end do d_sdf = minval ( abs ( ds ), dim = 1 ) packet % cnts = packet % cnts + size ( ds ) !check if outside all sdfs if ( minval ( ds ) >= 0._wp ) then packet % tflag = . true . exit end if end do !exit early if conditions met if ( taurun >= tau . or . packet % tflag ) then exit end if ds = 0._wp do i = 1 , size ( ds ) ds ( i ) = sdfs_array ( i )% evaluate ( pos ) end do packet % cnts = packet % cnts + size ( ds ) dstmp = ds ds = abs ( ds ) !step a bit into next sdf to get n2 d_sdf = minval ( ds ) + 2._wp * eps oldpos = pos pos = pos + d_sdf * dir ds = 0._wp do i = 1 , size ( ds ) ds ( i ) = sdfs_array ( i )% evaluate ( pos ) end do packet % cnts = packet % cnts + size ( ds ) new = 0._wp old = 0._wp do i = 1 , size ( ds ) if ( dstmp ( i ) < 0. ) then old ( i ) =- 1._wp exit end if end do do i = 1 , size ( ds ) if ( ds ( i ) < 0. ) then new ( i ) =- 1._wp exit end if end do !check for fresnel reflection n1 = sdfs_array ( packet % layer )% getn () new_layer = minloc ( new , dim = 1 ) n2 = sdfs_array ( new_layer )% getn () !carry out refelction/refraction if ( n1 /= n2 ) then !get correct sdf normal if ( ds ( packet % layer ) < 0._wp . and . ds ( new_layer ) < 0._wp ) then oldlayer = minloc ( abs ([ ds ( packet % layer ), ds ( new_layer )]), dim = 1 ) elseif ( dstmp ( packet % layer ) < 0._wp . and . dstmp ( new_layer ) < 0._wp ) then oldlayer = maxloc ([ dstmp ( packet % layer ), dstmp ( new_layer )], dim = 1 ) elseif ( ds ( packet % layer ) > 0._wp . and . ds ( new_layer ) < 0._wp ) then oldlayer = packet % layer elseif ( ds ( packet % layer ) > 0._wp . and . ds ( new_layer ) > 0._wp ) then packet % tflag = . true . exit else error stop \"This should not be reached!\" end if if ( oldlayer == 1 ) then oldlayer = packet % layer else oldlayer = new_layer end if N = calcNormal ( pos , sdfs_array ( oldlayer )) rflag = . false . call reflect_refract ( dir , N , n1 , n2 , rflag , Ri ) packet % weight = packet % weight * Ri tau = - log ( ran2 ()) taurun = 0._wp if (. not . rflag ) then packet % layer = new_layer else !step back inside original sdf pos = oldpos !reflect so incrment bounce counter packet % bounces = packet % bounces + 1 if ( packet % bounces > 1000 ) then packet % tflag = . true . exit end if end if else packet % layer = new_layer end if if ( packet % tflag ) exit end do packet % pos = pos packet % nxp = dir % x packet % nyp = dir % y packet % nzp = dir % z packet % phi = atan2 ( dir % y , dir % x ) packet % sinp = sin ( packet % phi ) packet % cosp = cos ( packet % phi ) packet % cost = dir % z packet % sint = sqrt ( 1._wp - packet % cost ** 2 ) ! packet%step = dtot if ( abs ( packet % pos % x ) > grid % xmax ) then packet % tflag = . true . end if if ( abs ( packet % pos % y ) > grid % ymax ) then packet % tflag = . true . end if if ( abs ( packet % pos % z ) > grid % zmax ) then packet % tflag = . true . end if end subroutine tauint2","tags":"","loc":"proc/tauint2.html"},{"title":"update_grids – signedMCRT","text":"private subroutine update_grids(grid, pos, dir, d_sdf, packet, mua) Uses photonMod vector_class iarray gridMod constants record fluence using path length estimators. Uses voxel grid Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid grid stores voxel grid information (voxel walls and etc) type( vector ), intent(inout) :: pos pos is current position with origin in centre of medium (0,0,0) type( vector ), intent(in) :: dir dir is the current direction (0,0,1) is up real(kind=wp), intent(in) :: d_sdf d_sdf is the distance to travel in voxel grid type( photon ), intent(inout) :: packet packet stores the photon related variables real(kind=wp), intent(in), optional :: mua absoprtion coefficent Contents Source Code update_grids Source Code subroutine update_grids ( grid , pos , dir , d_sdf , packet , mua ) !! record fluence using path length estimators. Uses voxel grid use vector_class use photonMod use gridMod use iarray , only : phasor , jmean , absorb use constants , only : sp !> grid stores voxel grid information (voxel walls and etc) type ( cart_grid ), intent ( IN ) :: grid !> dir is the current direction (0,0,1) is up type ( vector ), intent ( IN ) :: dir !> d_sdf is the distance to travel in voxel grid real ( kind = wp ), intent ( IN ) :: d_sdf !> absoprtion coefficent real ( kind = wp ), optional , intent ( IN ) :: mua !> pos is current position with origin in centre of medium (0,0,0) type ( vector ), intent ( INOUT ) :: pos !> packet stores the photon related variables type ( photon ), intent ( INOUT ) :: packet complex ( kind = sp ) :: phasec type ( vector ) :: old_pos logical :: ldir ( 3 ) integer :: celli , cellj , cellk real ( kind = wp ) :: dcell , delta = 1e-8_wp , d , mua_real if ( present ( mua )) then mua_real = mua else mua_real = 1._wp end if !convert to different coordinate system. Origin is at lower left corner of fluence grid old_pos = vector ( pos % x + grid % xmax , pos % y + grid % ymax , pos % z + grid % zmax ) call update_voxels ( grid , old_pos , celli , cellj , cellk ) packet % xcell = celli packet % ycell = cellj packet % zcell = cellk d = 0._wp !if packet outside grid return if ( celli == - 1 . or . cellj == - 1 . or . cellk == - 1 ) then packet % tflag = . true . pos = vector ( old_pos % x - grid % xmax , old_pos % y - grid % ymax , old_pos % z - grid % zmax ) return end if !move photon through grid updating path length estimators do ldir = ( / . FALSE ., . FALSE ., . FALSE . / ) dcell = wall_dist ( grid , celli , cellj , cellk , old_pos , dir , ldir ) if ( d + dcell > d_sdf ) then dcell = d_sdf - d d = d_sdf ! needs to be atomic so dont write to same array address with more than 1 thread at a time packet % phase = packet % phase + dcell !$omp atomic jmean ( celli , cellj , cellk ) = jmean ( celli , cellj , cellk ) + real ( dcell , kind = sp ) call update_pos ( grid , old_pos , celli , cellj , cellk , dcell , . false ., dir , ldir , delta ) exit else d = d + dcell packet % phase = packet % phase + dcell !$omp atomic jmean ( celli , cellj , cellk ) = jmean ( celli , cellj , cellk ) + real ( dcell , kind = sp ) call update_pos ( grid , old_pos , celli , cellj , cellk , dcell , . true ., dir , ldir , delta ) end if if ( celli == - 1 . or . cellj == - 1 . or . cellk == - 1 ) then packet % tflag = . true . exit end if end do pos = vector ( old_pos % x - grid % xmax , old_pos % y - grid % ymax , old_pos % z - grid % zmax ) packet % xcell = celli packet % ycell = cellj packet % zcell = cellk end subroutine update_grids","tags":"","loc":"proc/update_grids.html"},{"title":"update_pos – signedMCRT","text":"private subroutine update_pos(grid, pos, celli, cellj, cellk, dcell, wall_flag, dir, ldir, delta) Uses gridMod utils vector_class routine that updates positions of photon and calls Fresnel routines if photon leaves current voxel Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid type( vector ), intent(inout) :: pos integer, intent(inout) :: celli integer, intent(inout) :: cellj integer, intent(inout) :: cellk real(kind=wp), intent(in) :: dcell logical, intent(in) :: wall_flag type( vector ), intent(in) :: dir logical, intent(in) :: ldir (:) real(kind=wp), intent(in) :: delta Contents Source Code update_pos Source Code subroutine update_pos ( grid , pos , celli , cellj , cellk , dcell , wall_flag , dir , ldir , delta ) !! routine that updates positions of photon and calls Fresnel routines if photon leaves current voxel use vector_class use gridMod use utils , only : str type ( cart_grid ), intent ( IN ) :: grid type ( vector ), intent ( IN ) :: dir logical , intent ( IN ) :: wall_flag , ldir (:) real ( kind = wp ), intent ( IN ) :: dcell , delta type ( vector ), intent ( INOUT ) :: pos integer , intent ( INOUT ) :: celli , cellj , cellk if ( wall_flag ) then if ( ldir ( 1 )) then if ( dir % x > 0._wp ) then pos % x = grid % xface ( celli + 1 ) + delta elseif ( dir % x < 0._wp ) then pos % x = grid % xface ( celli ) - delta else print * , 'Error in x ldir in update_pos' , ldir , dir end if pos % y = pos % y + dir % y * dcell pos % z = pos % z + dir % z * dcell elseif ( ldir ( 2 )) then if ( dir % y > 0._wp ) then pos % y = grid % yface ( cellj + 1 ) + delta elseif ( dir % y < 0._wp ) then pos % y = grid % yface ( cellj ) - delta else print * , 'Error in y ldir in update_pos' , ldir , dir end if pos % x = pos % x + dir % x * dcell pos % z = pos % z + dir % z * dcell elseif ( ldir ( 3 )) then if ( dir % z > 0._wp ) then pos % z = grid % zface ( cellk + 1 ) + delta elseif ( dir % z < 0._wp ) then pos % z = grid % zface ( cellk ) - delta else print * , 'Error in z ldir in update_pos' , ldir , dir end if pos % x = pos % x + dir % x * dcell pos % y = pos % y + dir % y * dcell else print * , 'Error in update_pos... ' // str ( ldir ) error stop 1 end if else pos % x = pos % x + dir % x * dcell pos % y = pos % y + dir % y * dcell pos % z = pos % z + dir % z * dcell end if if ( wall_flag ) then call update_voxels ( grid , pos , celli , cellj , cellk ) end if end subroutine update_pos","tags":"","loc":"proc/update_pos.html"},{"title":"update_voxels – signedMCRT","text":"public subroutine update_voxels(grid, pos, celli, cellj, cellk) Uses gridMod vector_class updates the current voxel based upon position Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid grid type( vector ), intent(in) :: pos current photon packet position integer, intent(inout) :: celli position of photon packet in grid integer, intent(inout) :: cellj position of photon packet in grid integer, intent(inout) :: cellk position of photon packet in grid Contents Source Code update_voxels Source Code subroutine update_voxels ( grid , pos , celli , cellj , cellk ) !! updates the current voxel based upon position use vector_class use gridmod !> grid type ( cart_grid ), intent ( IN ) :: grid !> current photon packet position type ( vector ), intent ( IN ) :: pos !> position of photon packet in grid integer , intent ( INOUT ) :: celli , cellj , cellk !accurate but slow ! celli = find(pos%x, grid%xface) ! cellj = find(pos%y, grid%yface) ! cellk = find(pos%z, grid%zface) !fast but can be inaccurate in some cases... celli = floor ( grid % nxg * ( pos % x ) / ( 2. * grid % xmax )) + 1 cellj = floor ( grid % nyg * ( pos % y ) / ( 2. * grid % ymax )) + 1 cellk = floor ( grid % nzg * ( pos % z ) / ( 2. * grid % zmax )) + 1 if ( celli > grid % nxg . or . celli < 1 ) celli = - 1 if ( cellj > grid % nyg . or . cellj < 1 ) cellj = - 1 if ( cellk > grid % nzg . or . cellk < 1 ) cellk = - 1 end subroutine update_voxels","tags":"","loc":"proc/update_voxels.html"},{"title":"init_mono – signedMCRT","text":"private function init_mono(mus, mua, hgg, n) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: mus real(kind=wp), intent(in) :: mua real(kind=wp), intent(in) :: hgg real(kind=wp), intent(in) :: n Return Value type( mono ) Contents Source Code init_mono Source Code type ( mono ) function init_mono ( mus , mua , hgg , n ) result ( res ) real ( kind = wp ), intent ( in ) :: mus , mua , hgg , n res % mus = mus res % mua = mua res % kappa = mus + mua if ( res % mua < 1e-9_wp ) then res % albedo = 1. else res % albedo = res % mus / res % kappa end if res % hgg = hgg res % g2 = hgg ** 2 res % n = n end function init_mono","tags":"","loc":"proc/init_mono.html"},{"title":"init_spectral – signedMCRT","text":"private function init_spectral(mus, mua, hgg, n, flux) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), allocatable :: mus (:,:) real(kind=wp), intent(in), allocatable :: mua (:,:) real(kind=wp), intent(in), allocatable :: hgg (:,:) real(kind=wp), intent(in), allocatable :: n (:,:) real(kind=wp), intent(in), allocatable :: flux (:,:) Return Value type( spectral ) Contents Source Code init_spectral Source Code type ( spectral ) function init_spectral ( mus , mua , hgg , n , flux ) result ( res ) real ( kind = wp ), allocatable , intent ( in ) :: mus (:, :), mua (:, :), hgg (:, :), n (:, :), flux (:, :) real ( kind = wp ) :: wave , tmp !setup cdfs res % flux = piecewise1D ( flux ) res % mus_a = piecewise1D ( mus ) res % mua_a = piecewise1D ( mua ) res % hgg_a = piecewise1D ( hgg ) res % n_a = piecewise1D ( n ) !sample wavelength so we can sample from other optical properties at the correct points call res % flux % sample ( wave , tmp ) ! sample optical properties call res % mus_a % sample ( res % mus , wave ) call res % mua_a % sample ( res % mua , wave ) call res % hgg_a % sample ( res % hgg , wave ) res % g2 = res % hgg ** 2 call res % n_a % sample ( res % n , wave ) res % kappa = res % mus + res % mua if ( res % mua < 1e-9_wp ) then res % albedo = 1. else res % albedo = res % mus / res % kappa end if end function init_spectral","tags":"","loc":"proc/init_spectral.html"},{"title":"opticaProp_new – signedMCRT","text":"private function opticaProp_new(rhs) result(lhs) Arguments Type Intent Optional Attributes Name class( opticalProp_base ), intent(in) :: rhs Return Value type( opticalProp_t ) Contents Source Code opticaProp_new Source Code type ( opticalProp_t ) function opticaProp_new ( rhs ) result ( lhs ) class ( opticalProp_base ), intent ( in ) :: rhs allocate ( lhs % value , source = rhs ) end function opticaProp_new","tags":"","loc":"proc/opticaprop_new.html"},{"title":"opticalProp_t_assign – signedMCRT","text":"private subroutine opticalProp_t_assign(lhs, rhs) Type Bound opticalProp_t Arguments Type Intent Optional Attributes Name class( opticalProp_t ), intent(inout) :: lhs class( opticalProp_base ), intent(in) :: rhs Contents Source Code opticalProp_t_assign Source Code subroutine opticalProp_t_assign ( lhs , rhs ) class ( opticalProp_t ), intent ( inout ) :: lhs class ( opticalProp_base ), intent ( in ) :: rhs if ( allocated ( lhs % value )) deallocate ( lhs % value ) ! Prevent nested derived type select type ( rhsT => rhs ) class is ( opticalProp_t ) if ( allocated ( rhsT % value )) allocate ( lhs % value , source = rhsT % value ) class default allocate ( lhs % value , source = rhsT ) end select end subroutine opticalProp_t_assign","tags":"","loc":"proc/opticalprop_t_assign.html"},{"title":"updateMono – signedMCRT","text":"private subroutine updateMono(this, wavelength) Type Bound mono Arguments Type Intent Optional Attributes Name class( mono ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength Contents Source Code updateMono Source Code subroutine updateMono ( this , wavelength ) implicit none class ( Mono ), intent ( inout ) :: this real ( kind = wp ), intent ( out ) :: wavelength ! don't do anything as wavelength will not change wavelength = 0.0_wp end subroutine updateMono","tags":"","loc":"proc/updatemono.html"},{"title":"updateSpectral – signedMCRT","text":"private subroutine updateSpectral(this, wavelength) Type Bound spectral Arguments Type Intent Optional Attributes Name class( spectral ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength Contents Source Code updateSpectral Source Code subroutine updateSpectral ( this , wavelength ) implicit none class ( spectral ), intent ( inout ) :: this real ( kind = wp ), intent ( out ) :: wavelength real ( kind = wp ) :: tmp !get wavelength call this % flux % sample ( wavelength , tmp ) !update mus call this % mus_a % sample ( this % mus , tmp , wavelength ) !update mua call this % mua_a % sample ( this % mua , tmp , wavelength ) !update hgg call this % hgg_a % sample ( this % hgg , tmp , wavelength ) this % g2 = this % hgg ** 2 !update n call this % n_a % sample ( this % n , tmp , wavelength ) !update kappa and albedo this % kappa = this % mus + this % mua this % albedo = this % mus / this % kappa end subroutine updateSpectral","tags":"","loc":"proc/updatespectral.html"},{"title":"update_opticalProp_t – signedMCRT","text":"private subroutine update_opticalProp_t(this, wavelength) Type Bound opticalProp_t Arguments Type Intent Optional Attributes Name class( opticalProp_t ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength Contents Source Code update_opticalProp_t Source Code subroutine update_opticalProp_t ( this , wavelength ) class ( opticalProp_t ), intent ( inout ) :: this real ( kind = wp ), intent ( out ) :: wavelength call this % value % update ( wavelength ) end subroutine update_opticalProp_t","tags":"","loc":"proc/update_opticalprop_t.html"},{"title":"mono – signedMCRT","text":"public interface mono Contents Module Procedures init_mono Module Procedures private function init_mono (mus, mua, hgg, n) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: mus real(kind=wp), intent(in) :: mua real(kind=wp), intent(in) :: hgg real(kind=wp), intent(in) :: n Return Value type( mono )","tags":"","loc":"interface/mono.html"},{"title":"opticalProp_t – signedMCRT","text":"public interface opticalProp_t Contents Module Procedures opticaProp_new Module Procedures private function opticaProp_new (rhs) result(lhs) Arguments Type Intent Optional Attributes Name class( opticalProp_base ), intent(in) :: rhs Return Value type( opticalProp_t )","tags":"","loc":"interface/opticalprop_t.html"},{"title":"spectral – signedMCRT","text":"public interface spectral Contents Module Procedures init_spectral Module Procedures private function init_spectral (mus, mua, hgg, n, flux) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), allocatable :: mus (:,:) real(kind=wp), intent(in), allocatable :: mua (:,:) real(kind=wp), intent(in), allocatable :: hgg (:,:) real(kind=wp), intent(in), allocatable :: n (:,:) real(kind=wp), intent(in), allocatable :: flux (:,:) Return Value type( spectral )","tags":"","loc":"interface/spectral.html"},{"title":"init_piecewise1D – signedMCRT","text":"public function init_piecewise1D(array) result(res) Uses stdlib_quadrature initalise the piecewise1D type with an array size (n, 2). Calculates the CDF of this array.\nInput array Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:) Return Value type( piecewise1D ) Contents Source Code init_piecewise1D Source Code type ( piecewise1D ) function init_piecewise1D ( array ) result ( res ) !! initalise the piecewise1D type with an array size (n, 2). Calculates the CDF of this array. !> Input array use stdlib_quadrature , only : trapz_weights real ( kind = wp ), intent ( in ) :: array (:, :) integer :: i , length real ( kind = wp ) :: weights ( size ( array , 1 )), sumer if ( size ( array , 2 ) /= 2 ) error stop \"Array must be size (n, 2)\" res % array = array length = size ( array , 1 ) allocate ( res % cdf ( length )) res % cdf = 0. ! Generate CDF array from PDF array via Trapezoidal rule weights = trapz_weights ( array (:, 1 )) sumer = 0. do i = 2 , length sumer = sumer + weights ( i ) * array ( i , 2 ) res % cdf ( i ) = sumer end do ! normalise res % cdf = res % cdf / res % cdf ( length ) end function init_piecewise1D","tags":"","loc":"proc/init_piecewise1d.html"},{"title":"init_piecewise2D – signedMCRT","text":"public function init_piecewise2D(cell_width, cell_height, image) Initalise the piecewise2D type with a given cell_width, cell_height and input image Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: cell_width Input cell width real(kind=wp), intent(in) :: cell_height Input cell height real(kind=wp), intent(in) :: image (:,:) Input image Return Value type( piecewise2D ) Contents Source Code init_piecewise2D Source Code type ( piecewise2D ) function init_piecewise2D ( cell_width , cell_height , image ) !! Initalise the piecewise2D type with a given cell_width, cell_height and input image !> Input cell width real ( kind = wp ), intent ( in ) :: cell_width !> Input cell height real ( kind = wp ), intent ( in ) :: cell_height !> Input image real ( kind = wp ), intent ( in ) :: image (:,:) real ( kind = wp ), allocatable :: HC1D (:), imagenew (:,:) integer :: width , height , w2 , h2 integer ( kind = int64 ) :: i integer ( kind = int32 ) :: x , y width = size ( image , 1 ) height = size ( image , 2 ) ! need to pad image for z-order to work... w2 = nextpwr2 ( width ) h2 = nextpwr2 ( height ) allocate ( imagenew ( w2 , h2 )) imagenew = 0. init_piecewise2D % xoffset = ( h2 - height ) / 2 init_piecewise2D % yoffset = ( w2 - width ) / 2 imagenew ( init_piecewise2D % xoffset : init_piecewise2D % xoffset + width - 1 , & init_piecewise2D % yoffset : init_piecewise2D % yoffset + height - 1 ) = image allocate ( init_piecewise2D % cdf ( w2 * h2 )) allocate ( HC1D ( w2 * h2 )) HC1D = 0. do i = 0 , ( h2 * w2 ) - 1 call decode ( i , x , y ) HC1D ( i + 1 ) = imagenew ( x + 1 , y + 1 ) end do init_piecewise2D % cdf ( 1 ) = HC1D ( 1 ) do i = 2 , size ( HC1D ) init_piecewise2D % cdf ( i ) = init_piecewise2D % cdf ( i - 1 ) + HC1D ( i ) end do init_piecewise2D % cell_height = cell_height init_piecewise2D % cell_width = cell_width init_piecewise2D % cdf = init_piecewise2D % cdf / init_piecewise2D % cdf ( size ( init_piecewise2D % cdf )) end function init_piecewise2D","tags":"","loc":"proc/init_piecewise2d.html"},{"title":"nextpwr2 – signedMCRT","text":"public function nextpwr2(v) result(res) Get the next power of 2. i.e given 5 will return 8 (4^2)\nonly works on 32bit ints ref Arguments Type Intent Optional Attributes Name integer, intent(in) :: v Return Value integer Contents Source Code nextpwr2 Source Code integer function nextpwr2 ( v ) result ( res ) !! Get the next power of 2. i.e given 5 will return 8 (4^2) !! only works on 32bit ints !! [ref](https://graphics.stanford.edu/~seander/bithacks.html#RoundUpPowerOf2) integer , intent ( in ) :: v res = v - 1 res = ior ( res , rshift ( res , 1 )) res = ior ( res , rshift ( res , 2 )) res = ior ( res , rshift ( res , 4 )) res = ior ( res , rshift ( res , 8 )) res = ior ( res , rshift ( res , 16 )) res = res + 1 end function nextpwr2","tags":"","loc":"proc/nextpwr2.html"},{"title":"pack_bits – signedMCRT","text":"public function pack_bits(z) result(x) Reverse the split function. I.e go from 0a0b0c0d to abcd\nAdapted from archer2 cpp course Arguments Type Intent Optional Attributes Name integer(kind=int64), intent(in) :: z Input interleaved integer Return Value integer(kind=int64) Contents","tags":"","loc":"proc/pack_bits.html"},{"title":"decode – signedMCRT","text":"public subroutine decode(z, x, y) Compute the 2 indices from a Morton index\nAdapted from archer2 cpp course Arguments Type Intent Optional Attributes Name integer(kind=int64), intent(in) :: z Morton Index integer(kind=int32), intent(out) :: x The computed indices integer(kind=int32), intent(out) :: y The computed indices Contents Source Code decode Source Code subroutine decode ( z , x , y ) !! Compute the 2 indices from a Morton index !! Adapted from archer2 cpp [course](https://github.com/EPCCed/archer2-cpp/tree/main/exercises/morton-order) !> Morton Index integer ( kind = int64 ), intent ( in ) :: z !> The computed indices integer ( kind = int32 ), intent ( out ) :: x , y integer ( kind = int64 ) :: i , j i = z x = pack_bits ( i ) j = rshift ( z , 1 ) y = pack_bits ( j ) end subroutine decode","tags":"","loc":"proc/decode.html"},{"title":"getValue – signedMCRT","text":"public subroutine getValue(this, x, y, value) The constant version of sample Type Bound constant Arguments Type Intent Optional Attributes Name class( constant ), intent(in) :: this real(kind=wp), intent(out) :: x Output value real(kind=wp), intent(out) :: y Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D real(kind=wp), intent(in), optional :: value Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D Contents Source Code getValue Source Code subroutine getValue ( this , x , y , value ) !! The constant version of sample class ( constant ), intent ( in ) :: this !> Output value real ( kind = wp ), intent ( out ) :: x !> Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D real ( kind = wp ), intent ( out ) :: y !> Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D real ( kind = wp ), intent ( in ), optional :: value x = this % value y = - 999 9._wp end subroutine getValue","tags":"","loc":"proc/getvalue.html"},{"title":"sample1D – signedMCRT","text":"public subroutine sample1D(this, x, y, value) Uses random Randomly sample from 1D array Type Bound piecewise1D Arguments Type Intent Optional Attributes Name class( piecewise1D ), intent(in) :: this real(kind=wp), intent(out) :: x Return value real(kind=wp), intent(out) :: y Not used, but here so we can have same interface as 2D sample routine. real(kind=wp), intent(in), optional :: value Optional x value. If not present we generate a random one in the range [0., 1.] Contents Source Code sample1D Source Code subroutine sample1D ( this , x , y , value ) !! Randomly sample from 1D array use random , only : ran2 , ranu class ( piecewise1D ), intent ( in ) :: this !> Return value real ( kind = wp ), intent ( out ) :: x !> Not used, but here so we can have same interface as 2D sample routine. real ( kind = wp ), intent ( out ) :: y !> Optional x value. If not present we generate a random one in the range [0., 1.] real ( kind = wp ), intent ( in ), optional :: value integer ( kind = int64 ) :: idx real ( kind = wp ) :: val if (. not . present ( value )) then !get random x coordinate then get corresponding y val = ran2 () call search_1D ( this % cdf , idx , val ) x = this % array ( idx , 1 ) + & (( val - this % cdf ( idx )) * ( this % array ( idx + 1 , 1 ) - this % array ( idx , 1 ))) / ( this % cdf ( idx + 1 ) - this % cdf ( idx )) else !already have x so get y call search_2D ( this % array , idx , value ) x = this % array ( idx , 2 ) + ( this % array ( idx + 1 , 2 ) - this % array ( idx , 2 )) * & (( value - this % array ( idx , 1 )) / ( this % array ( idx + 1 , 1 ) - this % array ( idx , 1 ))) end if end subroutine sample1D","tags":"","loc":"proc/sample1d.html"},{"title":"sample2D – signedMCRT","text":"public subroutine sample2D(this, x, y, value) Uses random Type Bound piecewise2D Arguments Type Intent Optional Attributes Name class( piecewise2D ), intent(in) :: this real(kind=wp), intent(out) :: x real(kind=wp), intent(out) :: y real(kind=wp), intent(in), optional :: value Contents Source Code sample2D Source Code subroutine sample2D ( this , x , y , value ) ! TODO cite where you got this from... use random , only : ran2 , ranu class ( piecewise2D ), intent ( in ) :: this real ( kind = wp ), intent ( out ) :: x , y real ( kind = wp ), intent ( in ), optional :: value integer ( kind = int32 ) :: xr , yr integer ( kind = int64 ) :: idx real ( kind = wp ) :: val val = ran2 () call search_1D ( this % cdf , idx , val ) call decode ( idx , xr , yr ) x = real ( xr - this % xoffset , kind = wp ) + ranu ( - this % cell_width , this % cell_width ) y = real ( yr - this % yoffset , kind = wp ) + ranu ( - this % cell_height , this % cell_height ) end subroutine sample2D","tags":"","loc":"proc/sample2d.html"},{"title":"search_1D – signedMCRT","text":"public subroutine search_1D(array, nlow, value) search by bisection for 1D array Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:) Array to search integer(kind=int64), intent(out) :: nlow index of found value real(kind=wp), intent(in) :: value value to find in 1D array Contents Source Code search_1D Source Code subroutine search_1D ( array , nlow , value ) !! search by bisection for 1D array !> Array to search real ( kind = wp ), intent ( in ) :: array (:) !> index of found value integer ( kind = int64 ), intent ( out ) :: nlow !> value to find in 1D array real ( kind = wp ), intent ( in ) :: value integer :: nup , middle nup = size ( array ) nlow = 1 middle = int (( nup + nlow ) / 2. ) do while (( nup - nlow ) > 1 ) middle = int (( nup + nlow ) / 2. ) if ( value > array ( middle )) then nlow = middle else nup = middle end if end do end subroutine search_1D","tags":"","loc":"proc/search_1d.html"},{"title":"search_2D – signedMCRT","text":"public subroutine search_2D(array, nlow, value) search by bisection for 1D array Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:) 2D array to search. Only searches 1st column integer(kind=int64), intent(out) :: nlow Index of found index real(kind=wp), intent(in) :: value Value to find in the array. Contents Source Code search_2D Source Code subroutine search_2D ( array , nlow , value ) !! search by bisection for 1D array !> 2D array to search. Only searches 1st column real ( kind = wp ), intent ( in ) :: array (:, :) !> Index of found index integer ( kind = int64 ), intent ( out ) :: nlow !> Value to find in the array. real ( kind = wp ), intent ( in ) :: value integer :: nup , middle nup = size ( array , 1 ) nlow = 1 middle = int (( nup + nlow ) / 2. ) do while (( nup - nlow ) > 1 ) middle = int (( nup + nlow ) / 2. ) if ( value > array ( middle , 1 )) then nlow = middle else nup = middle end if end do end subroutine search_2D","tags":"","loc":"proc/search_2d.html"},{"title":"piecewise1D – signedMCRT","text":"public interface piecewise1D Contents Module Procedures init_piecewise1D Module Procedures public function init_piecewise1D (array) result(res) initalise the piecewise1D type with an array size (n, 2). Calculates the CDF of this array.\nInput array Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:) Return Value type( piecewise1D )","tags":"","loc":"interface/piecewise1d.html"},{"title":"piecewise2D – signedMCRT","text":"public interface piecewise2D Contents Module Procedures init_piecewise2D Module Procedures public function init_piecewise2D (cell_width, cell_height, image) Initalise the piecewise2D type with a given cell_width, cell_height and input image Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: cell_width Input cell width real(kind=wp), intent(in) :: cell_height Input cell height real(kind=wp), intent(in) :: image (:,:) Input image Return Value type( piecewise2D )","tags":"","loc":"interface/piecewise2d.html"},{"title":"check_hit_annulus – signedMCRT","text":"private function check_hit_annulus(this, hitpoint) Check if a hitpoint is in the annulus Type Bound annulus_dect Arguments Type Intent Optional Attributes Name class( annulus_dect ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Hitpoint to check Return Value logical Contents Source Code check_hit_annulus Source Code logical function check_hit_annulus ( this , hitpoint ) !! Check if a hitpoint is in the annulus class ( annulus_dect ), intent ( INOUT ) :: this !> Hitpoint to check type ( hit_t ), intent ( IN ) :: hitpoint real ( kind = wp ) :: newpos check_hit_annulus = . false . if ( this % layer /= hitpoint % layer ) return newpos = sqrt (( hitpoint % pos % x - this % pos % x ) ** 2 + ( hitpoint % pos % y - this % pos % y ) ** 2 + ( hitpoint % pos % z - this % pos % z ) ** 2 ) if ( newpos >= this % r1 . and . newpos <= this % r2 ) then check_hit_annulus = . true . end if end function check_hit_annulus","tags":"","loc":"proc/check_hit_annulus.html"},{"title":"check_hit_camera – signedMCRT","text":"private function check_hit_camera(this, hitpoint) Check if a hitpoint is in the camera detector ref Type Bound camera Arguments Type Intent Optional Attributes Name class( camera ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Hitpoint to check Return Value logical Contents Source Code check_hit_camera Source Code logical function check_hit_camera ( this , hitpoint ) !! Check if a hitpoint is in the camera detector !! [ref](https://www.scratchapixel.com/lessons/3d-basic-rendering/minimal-ray-tracer-rendering-simple-shapes/ray-plane-and-ray-disk-intersection) class ( camera ), intent ( inout ) :: this !> Hitpoint to check type ( hit_t ), intent ( in ) :: hitpoint real ( kind = wp ) :: t , proj1 , proj2 type ( vector ) :: v check_hit_camera = . false . if ( this % layer /= hitpoint % layer ) return t = (( this % pos - hitpoint % pos ) . dot . this % n ) / ( hitpoint % dir . dot . this % n ) if ( t >= 0._wp ) then v = ( hitpoint % pos + t * hitpoint % dir ) - this % pos proj1 = ( v . dot . this % e1 ) / this % width proj2 = ( v . dot . this % e2 ) / this % height if (( proj1 < this % width . and . proj1 > 0._wp ) . and . ( proj2 < this % height . and . proj2 > 0._wp )) then check_hit_camera = . true . end if end if end function check_hit_camera","tags":"","loc":"proc/check_hit_camera.html"},{"title":"check_hit_circle – signedMCRT","text":"private function check_hit_circle(this, hitpoint) Uses geometry Check if a hitpoint is in the circle Type Bound circle_dect Arguments Type Intent Optional Attributes Name class( circle_dect ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Hitpoint to check Return Value logical Contents Source Code check_hit_circle Source Code logical function check_hit_circle ( this , hitpoint ) !! Check if a hitpoint is in the circle use geometry , only : intersectCircle class ( circle_dect ), intent ( INOUT ) :: this !> Hitpoint to check type ( hit_t ), intent ( IN ) :: hitpoint real ( kind = wp ) :: t check_hit_circle = . false . if ( this % layer /= hitpoint % layer ) return check_hit_circle = intersectCircle ( this % dir , this % pos , this % radius , hitpoint % pos , hitpoint % dir , t ) if ( check_hit_circle ) then if ( t > 5e-3_wp ) check_hit_circle = . false . end if end function check_hit_circle","tags":"","loc":"proc/check_hit_circle.html"},{"title":"init_annulus_dect – signedMCRT","text":"private function init_annulus_dect(pos, dir, layer, r1, r2, nbins, maxval, trackHistory) result(out) Initalise Annular detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: r1 Inner radius real(kind=wp), intent(in) :: r2 Outer radius integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( annulus_dect ) Contents Source Code init_annulus_dect Source Code function init_annulus_dect ( pos , dir , layer , r1 , r2 , nbins , maxval , trackHistory ) result ( out ) !! Initalise Annular detector !> Centre of detector type ( vector ), intent ( in ) :: pos !> Normal of the detector type ( vector ), intent ( in ) :: dir !> Layer ID integer , intent ( in ) :: layer !> Inner radius real ( kind = wp ), intent ( IN ) :: r1 !> Outer radius real ( kind = wp ), intent ( IN ) :: r2 !> Number of bins in the detector integer , intent ( in ) :: nbins !> Maximum value to store in bins real ( kind = wp ), intent ( in ) :: maxval !> Boolean on if to store photon's history prior to hitting the detector. logical , intent ( in ) :: trackHistory type ( annulus_dect ) :: out out % pos = pos out % dir = dir out % layer = layer !extra bin for data beyond end of array out % nbins = nbins + 1 out % r1 = r1 out % r2 = r2 allocate ( out % data ( out % nbins )) out % data = 0.0_wp if ( nbins == 0 ) then out % bin_wid = 1._wp else out % bin_wid = maxval / real ( nbins , kind = wp ) end if out % trackHistory = trackHistory end function init_annulus_dect","tags":"","loc":"proc/init_annulus_dect.html"},{"title":"init_camera – signedMCRT","text":"private function init_camera(p1, p2, p3, layer, nbins, maxval, trackHistory) result(out) Initalise Camera detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: p1 Position of the 1st corner of the detector type( vector ), intent(in) :: p2 Distance from p1 to the 2nd corner type( vector ), intent(in) :: p3 Distance from p1 to the 3rd corner integer, intent(in) :: layer Layer ID integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( camera ) Contents Source Code init_camera Source Code function init_camera ( p1 , p2 , p3 , layer , nbins , maxval , trackHistory ) result ( out ) !! Initalise Camera detector !> Position of the 1st corner of the detector type ( vector ), intent ( in ) :: p1 !> Distance from p1 to the 2nd corner type ( vector ), intent ( in ) :: p2 !> Distance from p1 to the 3rd corner type ( vector ), intent ( in ) :: p3 !> Layer ID integer , intent ( in ) :: layer !> Number of bins in the detector integer , intent ( in ) :: nbins !> Maximum value to store in bins real ( kind = wp ), intent ( in ) :: maxval !> Boolean on if to store photon's history prior to hitting the detector. logical , intent ( in ) :: trackHistory type ( camera ) :: out out % pos = p1 out % p2 = p2 out % p3 = p3 out % e1 = p2 - p1 out % e2 = p3 - p1 out % width = length ( out % e1 ) out % height = length ( out % e2 ) out % n = out % e2 . cross . out % e1 out % n = out % n % magnitude () out % layer = layer !extra bin for data beyond end of array out % nbinsX = nbins + 1 out % nbinsY = nbins + 1 allocate ( out % data ( out % nbinsX , out % nbinsY )) out % data = 0.0_wp if ( nbins == 0 ) then out % bin_wid_x = 1._wp out % bin_wid_y = 1._wp else out % bin_wid_x = maxval / real ( out % nbinsX , kind = wp ) out % bin_wid_y = maxval / real ( out % nbinsY , kind = wp ) end if out % trackHistory = trackHistory end function init_camera","tags":"","loc":"proc/init_camera.html"},{"title":"init_circle_dect – signedMCRT","text":"private function init_circle_dect(pos, dir, layer, radius, nbins, maxval, trackHistory) result(out) Initalise Circle detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: radius Radius of the detector integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( circle_dect ) Contents Source Code init_circle_dect Source Code function init_circle_dect ( pos , dir , layer , radius , nbins , maxval , trackHistory ) result ( out ) !! Initalise Circle detector !> Centre of detector type ( vector ), intent ( in ) :: pos !> Normal of the detector type ( vector ), intent ( in ) :: dir !> Layer ID integer , intent ( in ) :: layer !> Number of bins in the detector integer , intent ( in ) :: nbins !> Radius of the detector real ( kind = wp ), intent ( in ) :: radius !> Maximum value to store in bins real ( kind = wp ), intent ( in ) :: maxval !> Boolean on if to store photon's history prior to hitting the detector. logical , intent ( in ) :: trackHistory type ( circle_dect ) :: out out % dir = dir out % pos = pos out % layer = layer !extra bin for data beyond end of array out % nbins = nbins + 1 out % radius = radius allocate ( out % data ( out % nbins )) out % data = 0.0_wp if ( nbins == 0 ) then out % bin_wid = 1._wp else out % bin_wid = maxval / real ( nbins - 1 , kind = wp ) end if out % trackHistory = trackHistory end function init_circle_dect","tags":"","loc":"proc/init_circle_dect.html"},{"title":"annulus_dect – signedMCRT","text":"public interface annulus_dect Contents Module Procedures init_annulus_dect Module Procedures private function init_annulus_dect (pos, dir, layer, r1, r2, nbins, maxval, trackHistory) result(out) Initalise Annular detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: r1 Inner radius real(kind=wp), intent(in) :: r2 Outer radius integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( annulus_dect )","tags":"","loc":"interface/annulus_dect.html"},{"title":"camera – signedMCRT","text":"public interface camera Contents Module Procedures init_camera Module Procedures private function init_camera (p1, p2, p3, layer, nbins, maxval, trackHistory) result(out) Initalise Camera detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: p1 Position of the 1st corner of the detector type( vector ), intent(in) :: p2 Distance from p1 to the 2nd corner type( vector ), intent(in) :: p3 Distance from p1 to the 3rd corner integer, intent(in) :: layer Layer ID integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( camera )","tags":"","loc":"interface/camera.html"},{"title":"circle_dect – signedMCRT","text":"public interface circle_dect Contents Module Procedures init_circle_dect Module Procedures private function init_circle_dect (pos, dir, layer, radius, nbins, maxval, trackHistory) result(out) Initalise Circle detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: radius Radius of the detector integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( circle_dect )","tags":"","loc":"interface/circle_dect.html"},{"title":"hit_init – signedMCRT","text":"private function hit_init(val) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val Return Value type( hit_t ) Contents Source Code hit_init Source Code type ( hit_t ) function hit_init ( val ) real ( kind = wp ), intent ( in ) :: val type ( vector ) :: tmp tmp = vector ( val , val , val ) hit_init = hit_t ( tmp , tmp , val , int ( val )) end function hit_init","tags":"","loc":"proc/hit_init.html"},{"title":"record_hit_1D_sub – signedMCRT","text":"private subroutine record_hit_1D_sub(this, hitpoint, history) Uses historyStack sim_state_mod check if a hit is on the detector and record it if so Type Bound detector1D Arguments Type Intent Optional Attributes Name class( detector1D ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Interaction information type( history_stack_t ), intent(inout) :: history Photon packet history Contents Source Code record_hit_1D_sub Source Code subroutine record_hit_1D_sub ( this , hitpoint , history ) !! check if a hit is on the detector and record it if so use historyStack , only : history_stack_t use sim_state_mod , only : state class ( detector1D ), intent ( inout ) :: this !> Interaction information type ( hit_t ), intent ( in ) :: hitpoint !> Photon packet history type ( history_stack_t ), intent ( inout ) :: history real ( kind = wp ) :: value integer :: idx if ( this % check_hit ( hitpoint )) then value = hitpoint % value idx = min ( nint ( value / this % bin_wid ) + 1 , this % nbins ) !$omp atomic this % data ( idx ) = this % data ( idx ) + 1 if ( this % trackHistory ) then call history % write () end if end if if ( state % trackHistory ) call history % zero () end subroutine record_hit_1D_sub","tags":"","loc":"proc/record_hit_1d_sub.html"},{"title":"record_hit_2D_sub – signedMCRT","text":"private subroutine record_hit_2D_sub(this, hitpoint, history) Uses historyStack sim_state_mod check if a hit is on the detector and record it if so Type Bound detector2D Arguments Type Intent Optional Attributes Name class( detector2D ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Interaction information type( history_stack_t ), intent(inout) :: history Photon packet history Contents Source Code record_hit_2D_sub Source Code subroutine record_hit_2D_sub ( this , hitpoint , history ) !! check if a hit is on the detector and record it if so use historyStack , only : history_stack_t use sim_state_mod , only : state class ( detector2D ), intent ( inout ) :: this !> Interaction information type ( hit_t ), intent ( in ) :: hitpoint !> Photon packet history type ( history_stack_t ), intent ( inout ) :: history real ( kind = wp ), volatile :: x , y integer :: idx , idy if ( this % check_hit ( hitpoint )) then x = hitpoint % pos % z + this % pos % x y = hitpoint % pos % y + this % pos % y idx = min ( int ( x / this % bin_wid_x ) + 1 , this % nbinsX ) idy = min ( int ( y / this % bin_wid_y ) + 1 , this % nbinsY ) if ( idx < 1 ) idx = this % nbinsX if ( idy < 1 ) idy = this % nbinsY !$omp atomic this % data ( idx , idy ) = this % data ( idx , idy ) + 1 if ( this % trackHistory ) then call history % write () end if end if if ( state % trackHistory ) call history % zero () end subroutine record_hit_2D_sub","tags":"","loc":"proc/record_hit_2d_sub.html"},{"title":"hit_t – signedMCRT","text":"public interface hit_t Contents Module Procedures hit_init Module Procedures private function hit_init (val) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val Return Value type( hit_t )","tags":"","loc":"interface/hit_t.html"},{"title":"box_init – signedMCRT","text":"private function box_init(lengths, optProp, layer, transform) result(out) Initalising function for Box SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: lengths Lengths of each dimension of the box type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( box ) Contents Source Code box_init Source Code function box_init ( lengths , optProp , layer , transform ) result ( out ) !! Initalising function for Box SDF. type ( box ) :: out !> Lengths of each dimension of the box type ( vector ), intent ( IN ) :: lengths !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % lengths = . 5_wp * lengths ! as only half lengths out % layer = layer out % transform = t out % optProps = optProp end function box_init","tags":"","loc":"proc/box_init.html"},{"title":"capsule_init – signedMCRT","text":"private function capsule_init(a, b, r, optProp, layer, transform) result(out) Initalising function for capsule SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Capsule startpoint type( vector ), intent(in) :: b Capsule endpoint real(kind=wp), intent(in) :: r Capsule radius type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( capsule ) Contents Source Code capsule_init Source Code function capsule_init ( a , b , r , optProp , layer , transform ) result ( out ) !! Initalising function for capsule SDF. type ( capsule ) :: out !> Capsule startpoint type ( vector ), intent ( IN ) :: a !> Capsule endpoint type ( vector ), intent ( IN ) :: b !> Capsule radius real ( kind = wp ), intent ( IN ) :: r !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % b = b out % r = r out % layer = layer out % transform = t out % optProps = optProp end function capsule_init","tags":"","loc":"proc/capsule_init.html"},{"title":"cone_init – signedMCRT","text":"private function cone_init(a, b, ra, rb, optProp, layer, transform) result(out) Initalising function for Capped Cone SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Centre of base of Cone type( vector ), intent(in) :: b Tip of cone real(kind=wp), intent(in) :: ra Radius of Cones base real(kind=wp), intent(in) :: rb Radius of Cones tip. For rb = 0.0 get normal uncapped cone. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cone ) Contents Source Code cone_init Source Code function cone_init ( a , b , ra , rb , optProp , layer , transform ) result ( out ) !! Initalising function for Capped Cone SDF. type ( cone ) :: out !> Centre of base of Cone type ( vector ), intent ( IN ) :: a !> Tip of cone type ( vector ), intent ( IN ) :: b !> Radius of Cones base real ( kind = wp ), intent ( IN ) :: ra !> Radius of Cones tip. For rb = 0.0 get normal uncapped cone. real ( kind = wp ), intent ( in ) :: rb !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % b = b out % ra = ra out % rb = rb out % layer = layer out % transform = t out % optProps = optProp end function cone_init","tags":"","loc":"proc/cone_init.html"},{"title":"cylinder_init – signedMCRT","text":"private function cylinder_init(a, b, radius, optProp, layer, transform) result(out) Initalising function for Cylinder SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Vector position at centre of the bottom circle type( vector ), intent(in) :: b Vector position at centre of the top circle real(kind=wp), intent(in) :: radius Radius of cylinder type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cylinder ) Contents Source Code cylinder_init Source Code function cylinder_init ( a , b , radius , optProp , layer , transform ) result ( out ) !! Initalising function for Cylinder SDF. type ( cylinder ) :: out !> Radius of cylinder real ( kind = wp ), intent ( in ) :: radius !> Vector position at centre of the bottom circle type ( vector ), intent ( IN ) :: a !> Vector position at centre of the top circle type ( vector ), intent ( IN ) :: b !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % b = b out % radius = radius out % layer = layer out % transform = t out % optProps = optProp end function cylinder_init","tags":"","loc":"proc/cylinder_init.html"},{"title":"egg_init – signedMCRT","text":"private function egg_init(r1, r2, h, optProp, layer, transform) result(out) Initalising function for egg SDF.\nmakes a Moss egg. ref . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: r1 R1 controls \"fatness\" of the egg. Actually controls the base circle radius. real(kind=wp), intent(in) :: r2 R2 contorls the pointiness of the egg. Actually controls radius of top circle. real(kind=wp), intent(in) :: h h controls the height of the egg. Actually controls y position of top circle. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( egg ) Contents Source Code egg_init Source Code function egg_init ( r1 , r2 , h , optProp , layer , transform ) result ( out ) !! Initalising function for egg SDF. !! makes a Moss egg. [ref](https://www.shadertoy.com/view/WsjfRt). type ( egg ) :: out !> R1 controls \"fatness\" of the egg. Actually controls the base circle radius. real ( kind = wp ), intent ( IN ) :: r1 !> R2 contorls the pointiness of the egg. Actually controls radius of top circle. real ( kind = wp ), intent ( in ) :: r2 !> h controls the height of the egg. Actually controls y position of top circle. real ( kind = wp ), intent ( in ) :: h !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % h = h out % r1 = r1 out % r2 = r2 out % layer = layer out % transform = t out % optProps = optProp end function egg_init","tags":"","loc":"proc/egg_init.html"},{"title":"evaluate_box – signedMCRT","text":"private pure elemental function evaluate_box(this, pos) result(res) Evaluation function for Box SDF. Type Bound box Arguments Type Intent Optional Attributes Name class( box ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Contents Source Code evaluate_box Source Code pure elemental function evaluate_box ( this , pos ) result ( res ) !! Evaluation function for Box SDF. class ( box ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: p , q p = pos . dot . this % transform q = abs ( p ) - this % lengths res = length ( max ( q , 0._wp )) + min ( max ( q % x , max ( q % y , q % z )), 0._wp ) end function evaluate_box","tags":"","loc":"proc/evaluate_box.html"},{"title":"evaluate_capsule – signedMCRT","text":"private pure elemental function evaluate_capsule(this, pos) result(res) Uses utils Evaluation function for Capsule SDF. Type Bound capsule Arguments Type Intent Optional Attributes Name class( capsule ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Contents Source Code evaluate_capsule Source Code pure elemental function evaluate_capsule ( this , pos ) result ( res ) !! Evaluation function for Capsule SDF. use utils , only : clamp class ( capsule ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: pa , ba , p real ( kind = wp ) :: h p = pos . dot . this % transform pa = p - this % a ba = this % b - this % a h = clamp (( pa . dot . ba ) / ( ba . dot . ba ), 0._wp , 1._wp ) res = length ( pa - ba * h ) - this % r end function evaluate_capsule","tags":"","loc":"proc/evaluate_capsule.html"},{"title":"evaluate_cone – signedMCRT","text":"private pure elemental function evaluate_cone(this, pos) result(res) Uses utils Evaluation function for Cone SDF. Type Bound cone Arguments Type Intent Optional Attributes Name class( cone ), intent(in) :: this type( vector ), intent(in) :: pos Return Value real(kind=wp) Contents Source Code evaluate_cone Source Code pure elemental function evaluate_cone ( this , pos ) result ( res ) !! Evaluation function for Cone SDF. use utils , only : clamp class ( cone ), intent ( in ) :: this type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: rba , baba , papa , paba , x , cax , cay , k , f , cbx , cby , s type ( vector ) :: p p = pos . dot . this % transform rba = this % rb - this % ra baba = ( this % b - this % a ) . dot . ( this % b - this % a ) papa = ( p - this % a ) . dot . ( p - this % a ) paba = (( p - this % a ) . dot . ( this % b - this % a )) / baba x = sqrt ( papa - baba * paba ** 2 ) if ( paba < 0.5_wp ) then cax = max ( 0._wp , x - this % ra ) else cax = max ( 0._wp , x - this % rb ) end if cay = abs ( paba - 0.5_wp ) - . 5_wp k = rba ** 2 + baba f = clamp (( rba * ( x - this % ra ) + paba * baba ) / k , 0._wp , 1._wp ) cbx = x - this % ra - f * rba cby = paba - f if ( cbx < 0._wp . and . cay < 0._wp ) then s = - 1._wp else s = 1._wp end if res = s * sqrt ( min ( cax ** 2 + baba * cay ** 2 , cbx ** 2 + baba * cby ** 2 )) end function evaluate_cone","tags":"","loc":"proc/evaluate_cone.html"},{"title":"evaluate_cylinder – signedMCRT","text":"private pure elemental function evaluate_cylinder(this, pos) result(res) Evaluation function for Cylinder SDF. Type Bound cylinder Arguments Type Intent Optional Attributes Name class( cylinder ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Contents Source Code evaluate_cylinder Source Code pure elemental function evaluate_cylinder ( this , pos ) result ( res ) !! Evaluation function for Cylinder SDF. class ( cylinder ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: p , ba , pa real ( kind = wp ) :: x , y , x2 , y2 , d , baba , paba p = pos . dot . this % transform ba = this % b - this % a pa = p - this % a baba = ba . dot . ba paba = pa . dot . ba x = length ( pa * baba - ba * paba ) - this % radius * baba y = abs ( paba - baba * . 5_wp ) - baba * . 5_wp x2 = x ** 2 y2 = ( y ** 2 ) * baba if ( max ( x , y ) < 0._wp ) then d = - min ( x2 , y2 ) else if ( x > 0._wp . and . y > 0._wp ) then d = x2 + y2 elseif ( x > 0._wp ) then d = x2 elseif ( y > 0._wp ) then d = y2 else d = 0._wp end if end if res = sign ( sqrt ( abs ( d )) / baba , d ) end function evaluate_cylinder","tags":"","loc":"proc/evaluate_cylinder.html"},{"title":"evaluate_egg – signedMCRT","text":"private pure elemental function evaluate_egg(this, pos) result(res) Evaluation function for Egg SDF. ref Type Bound egg Arguments Type Intent Optional Attributes Name class( egg ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Contents Source Code evaluate_egg Source Code pure elemental function evaluate_egg ( this , pos ) result ( res ) !! Evaluation function for Egg SDF. !! [ref](https://www.shadertoy.com/view/WsjfRt) class ( egg ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: r , l , h_in type ( vector ) :: p_in , p p = pos . dot . this % transform p_in = p p_in % x = abs ( p % x ) r = this % r1 - this % r2 h_in = this % h + r l = ( h_in ** 2 - r ** 2 ) / ( 2._wp * r ) if ( p_in % y <= 0._wp ) then res = length ( p_in ) - this % r1 else if (( p_in % y - h_in ) * l > p_in % x * h_in ) then res = length ( p_in - vector ( 0._wp , h_in , 0._wp )) - (( this % r1 + l ) - length ( vector ( h_in , l , 0._wp ))) else res = length ( p_in + vector ( l , 0._wp , 0._wp )) - ( this % r1 + l ) end if end if end function evaluate_egg","tags":"","loc":"proc/evaluate_egg.html"},{"title":"evaluate_plane – signedMCRT","text":"private pure elemental function evaluate_plane(this, pos) result(res) Evaluation function for Plane SDF. Type Bound plane Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Contents Source Code evaluate_plane Source Code pure elemental function evaluate_plane ( this , pos ) result ( res ) !! Evaluation function for Plane SDF. class ( plane ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: p p = pos . dot . this % transform !a must be normalised res = ( p . dot . this % a ) end function evaluate_plane","tags":"","loc":"proc/evaluate_plane.html"},{"title":"evaluate_segment – signedMCRT","text":"private pure elemental function evaluate_segment(this, pos) result(res) Uses utils Evaluation function for Segment SDF. Type Bound segment Arguments Type Intent Optional Attributes Name class( segment ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Contents Source Code evaluate_segment Source Code pure elemental function evaluate_segment ( this , pos ) result ( res ) !! Evaluation function for Segment SDF. !p = pos !a = pt1 !b = pt2 !draws segment along the axis between 2 points a and b use utils , only : clamp class ( segment ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: pa , ba , p real ( kind = wp ) :: h p = pos . dot . this % transform pa = p - this % a ba = this % b - this % a h = clamp (( pa . dot . ba ) / ( ba . dot . ba ), 0.0_wp , 1.0_wp ) res = length ( pa - ba * h ) - 0.1_wp end function evaluate_segment","tags":"","loc":"proc/evaluate_segment.html"},{"title":"evaluate_sphere – signedMCRT","text":"private pure elemental function evaluate_sphere(this, pos) result(res) Evaluation function for Sphere SDF. Type Bound sphere Arguments Type Intent Optional Attributes Name class( sphere ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Contents Source Code evaluate_sphere Source Code pure elemental function evaluate_sphere ( this , pos ) result ( res ) !! Evaluation function for Sphere SDF. class ( sphere ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: p p = pos . dot . this % transform res = sqrt ( p % x ** 2 + p % y ** 2 + p % z ** 2 ) - this % radius end function evaluate_sphere","tags":"","loc":"proc/evaluate_sphere.html"},{"title":"evaluate_torus – signedMCRT","text":"private pure elemental function evaluate_torus(this, pos) result(res) Evaluation function for Torus SDF. Type Bound torus Arguments Type Intent Optional Attributes Name class( torus ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Contents Source Code evaluate_torus Source Code pure elemental function evaluate_torus ( this , pos ) result ( res ) !! Evaluation function for Torus SDF. class ( torus ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: p , q p = pos . dot . this % transform q = vector ( length ( vector ( p % x , 0._wp , p % z )) - this % oradius , p % y , 0._wp ) res = length ( q ) - this % iradius end function evaluate_torus","tags":"","loc":"proc/evaluate_torus.html"},{"title":"evaluate_triprism – signedMCRT","text":"private pure elemental function evaluate_triprism(this, pos) result(res) Evaluation function for Triprisim SDF. Type Bound triprism Arguments Type Intent Optional Attributes Name class( triprism ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Contents Source Code evaluate_triprism Source Code pure elemental function evaluate_triprism ( this , pos ) result ( res ) !! Evaluation function for Triprisim SDF. class ( triprism ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: q , p p = pos . dot . this % transform q = abs ( p ) res = max ( q % z - this % h2 , max ( q % x * . 866025_wp + p % y * . 5_wp , - p % y ) - this % h1 * . 5_wp ) end function evaluate_triprism","tags":"","loc":"proc/evaluate_triprism.html"},{"title":"plane_init – signedMCRT","text":"private function plane_init(a, optProp, layer, transform) result(out) Initalising function for plane SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Plane normal. must be normalised type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( plane ) Contents Source Code plane_init Source Code function plane_init ( a , optProp , layer , transform ) result ( out ) !! Initalising function for plane SDF. type ( plane ) :: out !> Plane normal. must be normalised type ( vector ), intent ( IN ) :: a !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % layer = layer out % transform = t out % optProps = optProp end function plane_init","tags":"","loc":"proc/plane_init.html"},{"title":"segment_init – signedMCRT","text":"private function segment_init(a, b, optProp, layer, transform) result(out) Initalising function for segment SDF.\nNote this is a 2D function Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a segment start point type( vector ), intent(in) :: b segment end point type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( segment ) Contents Source Code segment_init Source Code function segment_init ( a , b , optProp , layer , transform ) result ( out ) !! Initalising function for segment SDF. !! Note this is a 2D function type ( segment ) :: out !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp !> segment start point type ( vector ), intent ( IN ) :: a !> segment end point type ( vector ), intent ( IN ) :: b !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % b = b out % layer = layer out % transform = t out % optProps = optProp end function segment_init","tags":"","loc":"proc/segment_init.html"},{"title":"sphere_init – signedMCRT","text":"private function sphere_init(radius, optProp, layer, transform) result(out) Initalising function for Sphere SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: radius radius of the Sphere type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( sphere ) Contents Source Code sphere_init Source Code function sphere_init ( radius , optProp , layer , transform ) result ( out ) !! Initalising function for Sphere SDF. type ( sphere ) :: out !> radius of the Sphere real ( kind = wp ), intent ( IN ) :: radius !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % radius = radius out % layer = layer out % transform = t out % optProps = optProp end function sphere_init","tags":"","loc":"proc/sphere_init.html"},{"title":"torus_init – signedMCRT","text":"private function torus_init(oradius, iradius, optProp, layer, transform) result(out) Initalising function for Torus SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: oradius Outer radius of Torus real(kind=wp), intent(in) :: iradius Inner radius of Torus type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( torus ) Contents Source Code torus_init Source Code function torus_init ( oradius , iradius , optProp , layer , transform ) result ( out ) !! Initalising function for Torus SDF. type ( torus ) :: out !> Outer radius of Torus real ( kind = wp ), intent ( IN ) :: oradius !> Inner radius of Torus real ( kind = wp ), intent ( IN ) :: iradius !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % oradius = oradius out % iradius = iradius out % layer = layer out % transform = t out % optProps = optProp end function torus_init","tags":"","loc":"proc/torus_init.html"},{"title":"triprism_init – signedMCRT","text":"private function triprism_init(h1, h2, optProp, layer, transform) result(out) Initalising function for triprisim SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: h1 Height of triprisim real(kind=wp), intent(in) :: h2 length of triprisim type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( triprism ) Contents Source Code triprism_init Source Code function triprism_init ( h1 , h2 , optProp , layer , transform ) result ( out ) !! Initalising function for triprisim SDF. type ( triprism ) :: out !> Height of triprisim real ( kind = wp ), intent ( IN ) :: h1 !> length of triprisim real ( kind = wp ), intent ( IN ) :: h2 !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % h1 = h1 out % h2 = h2 out % layer = layer out % transform = t out % optProps = optProp end function triprism_init","tags":"","loc":"proc/triprism_init.html"},{"title":"box – signedMCRT","text":"public interface box Interface to box SDF initialising function Contents Module Procedures box_init Module Procedures private function box_init (lengths, optProp, layer, transform) result(out) Initalising function for Box SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: lengths Lengths of each dimension of the box type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( box )","tags":"","loc":"interface/box.html"},{"title":"capsule – signedMCRT","text":"public interface capsule Interface to capsule SDF initialising function Contents Module Procedures capsule_init Module Procedures private function capsule_init (a, b, r, optProp, layer, transform) result(out) Initalising function for capsule SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Capsule startpoint type( vector ), intent(in) :: b Capsule endpoint real(kind=wp), intent(in) :: r Capsule radius type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( capsule )","tags":"","loc":"interface/capsule.html"},{"title":"cone – signedMCRT","text":"public interface cone Interface to cone SDF initialising function Contents Module Procedures cone_init Module Procedures private function cone_init (a, b, ra, rb, optProp, layer, transform) result(out) Initalising function for Capped Cone SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Centre of base of Cone type( vector ), intent(in) :: b Tip of cone real(kind=wp), intent(in) :: ra Radius of Cones base real(kind=wp), intent(in) :: rb Radius of Cones tip. For rb = 0.0 get normal uncapped cone. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cone )","tags":"","loc":"interface/cone.html"},{"title":"cylinder – signedMCRT","text":"public interface cylinder Interface to cylinder SDF initialising function Contents Module Procedures cylinder_init Module Procedures private function cylinder_init (a, b, radius, optProp, layer, transform) result(out) Initalising function for Cylinder SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Vector position at centre of the bottom circle type( vector ), intent(in) :: b Vector position at centre of the top circle real(kind=wp), intent(in) :: radius Radius of cylinder type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cylinder )","tags":"","loc":"interface/cylinder.html"},{"title":"egg – signedMCRT","text":"public interface egg Interface to egg SDF initialising function Contents Module Procedures egg_init Module Procedures private function egg_init (r1, r2, h, optProp, layer, transform) result(out) Initalising function for egg SDF.\nmakes a Moss egg. ref . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: r1 R1 controls \"fatness\" of the egg. Actually controls the base circle radius. real(kind=wp), intent(in) :: r2 R2 contorls the pointiness of the egg. Actually controls radius of top circle. real(kind=wp), intent(in) :: h h controls the height of the egg. Actually controls y position of top circle. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( egg )","tags":"","loc":"interface/egg.html"},{"title":"plane – signedMCRT","text":"public interface plane Interface to plane SDF initialising function Contents Module Procedures plane_init Module Procedures private function plane_init (a, optProp, layer, transform) result(out) Initalising function for plane SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Plane normal. must be normalised type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( plane )","tags":"","loc":"interface/plane.html"},{"title":"segment – signedMCRT","text":"public interface segment Interface to segment SDF initialising function Contents Module Procedures segment_init Module Procedures private function segment_init (a, b, optProp, layer, transform) result(out) Initalising function for segment SDF.\nNote this is a 2D function Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a segment start point type( vector ), intent(in) :: b segment end point type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( segment )","tags":"","loc":"interface/segment.html"},{"title":"sphere – signedMCRT","text":"public interface sphere Contents Module Procedures sphere_init Module Procedures private function sphere_init (radius, optProp, layer, transform) result(out) Initalising function for Sphere SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: radius radius of the Sphere type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( sphere )","tags":"","loc":"interface/sphere.html"},{"title":"torus – signedMCRT","text":"public interface torus Interface to torus SDF initialising function Contents Module Procedures torus_init Module Procedures private function torus_init (oradius, iradius, optProp, layer, transform) result(out) Initalising function for Torus SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: oradius Outer radius of Torus real(kind=wp), intent(in) :: iradius Inner radius of Torus type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( torus )","tags":"","loc":"interface/torus.html"},{"title":"triprism – signedMCRT","text":"public interface triprism Interface to triprisim SDF initialising function Contents Module Procedures triprism_init Module Procedures private function triprism_init (h1, h2, optProp, layer, transform) result(out) Initalising function for triprisim SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: h1 Height of triprisim real(kind=wp), intent(in) :: h2 length of triprisim type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( triprism )","tags":"","loc":"interface/triprism.html"},{"title":"identity – signedMCRT","text":"public function identity() result(r) Returns the identity transformation matrix Arguments None Return Value real(kind=wp), (4,4) Contents Source Code identity Source Code function identity () result ( r ) !! Returns the identity transformation matrix real ( kind = wp ) :: r ( 4 , 4 ) r (:, 1 ) = [ 1._wp , 0._wp , 0._wp , 0._wp ] r (:, 2 ) = [ 0._wp , 1._wp , 0._wp , 0._wp ] r (:, 3 ) = [ 0._wp , 0._wp , 1._wp , 0._wp ] r (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function identity","tags":"","loc":"proc/identity.html"},{"title":"rotate_x – signedMCRT","text":"public function rotate_x(angle) result(r) Uses utils rotation in the x-axis function from here Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: angle Angle to rotate by Return Value real(kind=wp), (4,4) Contents Source Code rotate_x Source Code function rotate_x ( angle ) result ( r ) !! rotation in the x-axis function from [here](https://inspirnathan.com/posts/54-shadertoy-tutorial-part-8/) use utils , only : deg2rad !> Angle to rotate by real ( kind = wp ), intent ( IN ) :: angle real ( kind = wp ) :: r ( 4 , 4 ), c , s , a a = deg2rad ( angle ) c = cos ( a ) s = sin ( a ) r (:, 1 ) = [ 1._wp , 0._wp , 0._wp , 0._wp ] r (:, 2 ) = [ 0._wp , c , - s , 0._wp ] r (:, 3 ) = [ 0._wp , s , c , 0._wp ] r (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function rotate_x","tags":"","loc":"proc/rotate_x.html"},{"title":"rotate_y – signedMCRT","text":"public function rotate_y(angle) result(r) Uses utils rotation in the y-axis function from here Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: angle Angle to rotate by Return Value real(kind=wp), (4,4) Contents Source Code rotate_y Source Code function rotate_y ( angle ) result ( r ) !! rotation in the y-axis function from [here](https://inspirnathan.com/posts/54-shadertoy-tutorial-part-8/) use utils , only : deg2rad !> Angle to rotate by real ( kind = wp ), intent ( IN ) :: angle real ( kind = wp ) :: r ( 4 , 4 ), c , s , a a = deg2rad ( angle ) c = cos ( a ) s = sin ( a ) r (:, 1 ) = [ c , 0._wp , s , 0._wp ] r (:, 2 ) = [ 0._wp , 1._wp , 0._wp , 0._wp ] r (:, 3 ) = [ - s , 0._wp , c , 0._wp ] r (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function rotate_y","tags":"","loc":"proc/rotate_y.html"},{"title":"rotate_z – signedMCRT","text":"public function rotate_z(angle) result(r) Uses utils rotation in the z-axis function from here Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: angle Angle to rotate by Return Value real(kind=wp), (4,4) Contents Source Code rotate_z Source Code function rotate_z ( angle ) result ( r ) !! rotation in the z-axis function from [here](https://inspirnathan.com/posts/54-shadertoy-tutorial-part-8/) use utils , only : deg2rad !> Angle to rotate by real ( kind = wp ), intent ( IN ) :: angle real ( kind = wp ) :: r ( 4 , 4 ), c , s , a a = deg2rad ( angle ) c = cos ( a ) s = sin ( a ) r (:, 1 ) = [ c , - s , 0._wp , 0._wp ] r (:, 2 ) = [ s , c , 0._wp , 0._wp ] r (:, 3 ) = [ 0._wp , 0._wp , 1._wp , 0._wp ] r (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function rotate_z","tags":"","loc":"proc/rotate_z.html"},{"title":"rotationAlign – signedMCRT","text":"public function rotationAlign(a, b) result(res) Calculate the rotation matrix to rotate vector a onto b ref1 ref2 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Vector to rotate. Unit vector type( vector ), intent(in) :: b Vector to be rotated onto. Unit vector Return Value real(kind=wp), (4,4) Contents Source Code rotationAlign Source Code function rotationAlign ( a , b ) result ( res ) !! Calculate the rotation matrix to rotate vector a onto b !! [ref1](https://en.wikipedia.org/wiki/Rodrigues%27_rotation_formula) !! [ref2](https://math.stackexchange.com/questions/180418/calculate-rotation-matrix-to-align-vector-a-to-vector-b-in-3d) !> Vector to rotate. Unit vector type ( vector ), intent ( in ) :: a !> Vector to be rotated onto. Unit vector type ( vector ), intent ( in ) :: b type ( vector ) :: v real ( kind = wp ) :: c , k , res ( 4 , 4 ), v_x ( 4 , 4 ), v_x2 ( 4 , 4 ) v = a . cross . b c = a . dot . b k = 1._wp / ( 1._wp + c ) !skew-symmetric matrix v_x (:, 1 ) = [ 0._wp , - 1._wp * v % z , v % y , 0._wp ] v_x (:, 2 ) = [ v % z , 0._wp , - 1._wp * v % x , 0._wp ] v_x (:, 3 ) = [ - 1._wp * v % y , v % x , 0._wp , 0._wp ] v_x (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 0._wp ] v_x2 = matmul ( v_x , v_x ) res = identity () + v_x + v_x2 * k end function rotationAlign","tags":"","loc":"proc/rotationalign.html"},{"title":"rotmat – signedMCRT","text":"public function rotmat(axis, angle) Uses utils Rotate around around an axis by a given angle taken from here Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: axis Axis to rotate around real(kind=wp), intent(in) :: angle Angle to rotate by in degrees Return Value real(kind=wp), (4,4) Contents Source Code rotmat Source Code function rotmat ( axis , angle ) !! Rotate around around an axis by a given angle taken from [here](http://www.neilmendoza.com/glsl-rotation-about-an-arbitrary-axis/) use utils , only : deg2rad !> Axis to rotate around type ( vector ), intent ( in ) :: axis !> Angle to rotate by in degrees real ( kind = wp ), intent ( in ) :: angle type ( vector ) :: axist real ( kind = wp ) :: rotmat ( 4 , 4 ), s , c , oc , a axist = axis % magnitude () a = deg2rad ( angle ) s = sin ( a ) c = cos ( a ) oc = 1._wp - c rotmat (:, 1 ) = [ oc * axist % x * axist % x + c , oc * axist % x * axist % y - axist % z * s ,& oc * axist % z * axist % x + axist % y * s , 0.0_wp ] rotmat (:, 2 ) = [ oc * axist % x * axist % y + axist % z * s , oc * axist % y * axist % y + c ,& oc * axist % y * axist % z - axist % x * s , 0.0_wp ] rotmat (:, 3 ) = [ oc * axist % z * axist % x - axist % y * s , oc * axist % y * axist % z + axist % x * s ,& oc * axist % z * axist % z + c , 0.0_wp ] rotmat (:, 4 ) = [ 0.0_wp , 0.0_wp , 0.0_wp , 1.0_wp ] end function rotmat","tags":"","loc":"proc/rotmat.html"},{"title":"skewSymm – signedMCRT","text":"public function skewSymm(a) result(out) Calculate the Skew Symmetric matrix for a given vector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Vector to calculate the skew symmetric matrix for. Return Value real(kind=wp), (4,4) Contents Source Code skewSymm Source Code function skewSymm ( a ) result ( out ) !! Calculate the Skew Symmetric matrix for a given vector !> Vector to calculate the skew symmetric matrix for. type ( vector ), intent ( in ) :: a real ( kind = wp ) :: out ( 4 , 4 ) out (:, 1 ) = [ 0._wp , - a % z , a % y , 0._wp ] out (:, 2 ) = [ a % z , 0._wp , - a % x , 0._wp ] out (:, 3 ) = [ - a % y , a % x , 0._wp , 0._wp ] out (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 0._wp ] end function skewSymm","tags":"","loc":"proc/skewsymm.html"},{"title":"translate – signedMCRT","text":"public function translate(o) result(out) Returns the Translation matrix for a given vector translation. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: o Vector to translate by. Return Value real(kind=wp), (4,4) Contents Source Code translate Source Code function translate ( o ) result ( out ) !! Returns the Translation matrix for a given vector translation. !> Vector to translate by. type ( vector ), intent ( IN ) :: o real ( kind = wp ) :: out ( 4 , 4 ) out (:, 1 ) = [ 1._wp , 0._wp , 0._wp , o % x ] out (:, 2 ) = [ 0._wp , 1._wp , 0._wp , o % y ] out (:, 3 ) = [ 0._wp , 0._wp , 1._wp , o % z ] out (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function translate","tags":"","loc":"proc/translate.html"},{"title":"SmoothUnion – signedMCRT","text":"public pure function SmoothUnion(d1, d2, k) result(res) Smooth union. Joins two SDFs together smoothly Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 SDF_1 distance real(kind=wp), intent(in) :: d2 SDF_2 distance real(kind=wp), intent(in) :: k smoothing factor. Return Value real(kind=wp) Contents Source Code SmoothUnion Source Code pure function SmoothUnion ( d1 , d2 , k ) result ( res ) !! Smooth union. Joins two SDFs together smoothly !> SDF_1 distance real ( kind = wp ), intent ( IN ) :: d1 !> SDF_2 distance real ( kind = wp ), intent ( IN ) :: d2 !> smoothing factor. real ( kind = wp ), intent ( IN ) :: k real ( kind = wp ) :: res , h h = max ( k - abs ( d1 - d2 ), 0._wp ) / k res = min ( d1 , d2 ) - h * h * h * k * ( 1._wp / 6._wp ) end function SmoothUnion","tags":"","loc":"proc/smoothunion.html"},{"title":"bend_init – signedMCRT","text":"private function bend_init(prim, k) result(out) Initialise the Bend modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: k Amoun to bend by. Return Value type( bend ) Contents Source Code bend_init Source Code type ( bend ) function bend_init ( prim , k ) result ( out ) !! Initialise the Bend modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Amoun to bend by. real ( kind = wp ), intent ( IN ) :: k out % k = k out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function bend_init","tags":"","loc":"proc/bend_init.html"},{"title":"displacement_init – signedMCRT","text":"private function displacement_init(prim, func) result(out) Initialise the displacement modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify procedure( primitive ) :: func Function to displace the SDF with. Return Value type( displacement ) Contents Source Code displacement_init Source Code type ( displacement ) function displacement_init ( prim , func ) result ( out ) !! Initialise the displacement modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Function to displace the SDF with. procedure ( primitive ) :: func out % func => func out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function displacement_init","tags":"","loc":"proc/displacement_init.html"},{"title":"elongate_init – signedMCRT","text":"private function elongate_init(prim, size) result(out) Initialise the elongate modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify type( vector ), intent(in) :: size Distance to elongate by Return Value type( elongate ) Contents Source Code elongate_init Source Code type ( elongate ) function elongate_init ( prim , size ) result ( out ) !! Initialise the elongate modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Distance to elongate by type ( vector ), intent ( IN ) :: size out % size = size out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function elongate_init","tags":"","loc":"proc/elongate_init.html"},{"title":"eval_bend – signedMCRT","text":"private pure elemental function eval_bend(this, pos) result(res) Evaluation function for Bend modifier. Type Bound bend Arguments Type Intent Optional Attributes Name class( bend ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Contents Source Code eval_bend Source Code pure elemental function eval_bend ( this , pos ) result ( res ) !! Evaluation function for Bend modifier. class ( bend ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: c , s , x2 , y2 , z2 c = cos ( this % k * pos % x ) s = sin ( this % k * pos % x ) x2 = c * pos % x - s * pos % y y2 = s * pos % x + c * pos % y z2 = pos % z res = this % prim % evaluate ( vector ( x2 , y2 , z2 )) end function eval_bend","tags":"","loc":"proc/eval_bend.html"},{"title":"eval_disp – signedMCRT","text":"private pure elemental function eval_disp(this, pos) result(res) Evaluation function for displacement modifier. Type Bound displacement Arguments Type Intent Optional Attributes Name class( displacement ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Contents Source Code eval_disp Source Code pure elemental function eval_disp ( this , pos ) result ( res ) !! Evaluation function for displacement modifier. class ( displacement ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: d1 , d2 d1 = this % prim % evaluate ( pos ) d2 = this % func ( pos ) res = d1 + d2 end function eval_disp","tags":"","loc":"proc/eval_disp.html"},{"title":"eval_elongate – signedMCRT","text":"private pure elemental function eval_elongate(this, pos) result(res) Evaluation function for Elongate modifier. Type Bound elongate Arguments Type Intent Optional Attributes Name class( elongate ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Contents Source Code eval_elongate Source Code pure elemental function eval_elongate ( this , pos ) result ( res ) !! Evaluation function for Elongate modifier. class ( elongate ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: w type ( vector ) :: q q = abs ( pos ) - this % size w = min ( max ( q % x , max ( q % y , q % z )), 0._wp ) res = this % prim % evaluate ( max ( q , 0._wp )) + w end function eval_elongate","tags":"","loc":"proc/eval_elongate.html"},{"title":"eval_extrude – signedMCRT","text":"private pure elemental function eval_extrude(this, pos) result(res) Evaluation function for Extrude modifier. Type Bound extrude Arguments Type Intent Optional Attributes Name class( extrude ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Contents Source Code eval_extrude Source Code pure elemental function eval_extrude ( this , pos ) result ( res ) !! Evaluation function for Extrude modifier. class ( extrude ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: w real ( kind = wp ) :: d d = this % prim % evaluate ( pos ) w = vector ( d , abs ( pos % z ) - this % h , 0._wp ) res = min ( max ( w % x , w % y ), 0._wp ) + length ( max ( w , 0._wp )) end function eval_extrude","tags":"","loc":"proc/eval_extrude.html"},{"title":"eval_onion – signedMCRT","text":"private pure elemental function eval_onion(this, pos) result(res) Evaluation function for Onion modifier. Type Bound onion Arguments Type Intent Optional Attributes Name class( onion ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Contents Source Code eval_onion Source Code pure elemental function eval_onion ( this , pos ) result ( res ) !! Evaluation function for Onion modifier. class ( onion ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res res = abs ( this % prim % evaluate ( pos )) - this % thickness end function eval_onion","tags":"","loc":"proc/eval_onion.html"},{"title":"eval_repeat – signedMCRT","text":"private pure elemental function eval_repeat(this, pos) result(res) Evaluation function for Repeat modifier. Type Bound repeat Arguments Type Intent Optional Attributes Name class( repeat ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Contents Source Code eval_repeat Source Code pure elemental function eval_repeat ( this , pos ) result ( res ) !! Evaluation function for Repeat modifier. ! use utils, only : clamp class ( repeat ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: q error stop \"Not implmented as no vector dependacny in utils yet!\" ! q = pos - this%c*clamp(nint(pos/this%c), this%la, this%lb) res = this % prim % evaluate ( q ) end function eval_repeat","tags":"","loc":"proc/eval_repeat.html"},{"title":"eval_revolution – signedMCRT","text":"private pure elemental function eval_revolution(this, pos) result(res) Evaluation function for Revolution modifier. Type Bound revolution Arguments Type Intent Optional Attributes Name class( revolution ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Contents Source Code eval_revolution Source Code pure elemental function eval_revolution ( this , pos ) result ( res ) !! Evaluation function for Revolution modifier. class ( revolution ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: pxz , q pxz = vector ( pos % x , pos % z , 0._wp ) q = vector ( length ( pxz ) - this % o , pos % y , 0._wp ) res = this % prim % evaluate ( q ) end function eval_revolution","tags":"","loc":"proc/eval_revolution.html"},{"title":"eval_twist – signedMCRT","text":"private pure elemental function eval_twist(this, pos) result(res) Evaluation function for Twist modifier. Type Bound twist Arguments Type Intent Optional Attributes Name class( twist ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Contents Source Code eval_twist Source Code pure elemental function eval_twist ( this , pos ) result ( res ) !! Evaluation function for Twist modifier. class ( twist ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: c , s , x2 , y2 , z2 c = cos ( this % k * pos % z ) s = sin ( this % k * pos % z ) x2 = c * pos % x - s * pos % y y2 = s * pos % x + c * pos % y z2 = pos % z res = this % prim % evaluate ( vector ( x2 , y2 , z2 )) end function eval_twist","tags":"","loc":"proc/eval_twist.html"},{"title":"extrude_init – signedMCRT","text":"private function extrude_init(prim, h) result(out) Initialise the extrude modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: h Distance to extrude by. Return Value type( extrude ) Contents Source Code extrude_init Source Code type ( extrude ) function extrude_init ( prim , h ) result ( out ) !! Initialise the extrude modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Distance to extrude by. real ( kind = wp ), intent ( IN ) :: h out % h = h out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function extrude_init","tags":"","loc":"proc/extrude_init.html"},{"title":"intersection – signedMCRT","text":"public pure function intersection(d1, d2, k) result(res) Intersection operator. Returns the intersection of two SDFs. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 SDF_1 distance real(kind=wp), intent(in) :: d2 SDF_2 distance real(kind=wp), intent(in) :: k smoothing factor. Return Value real(kind=wp) Contents Source Code intersection Source Code pure function intersection ( d1 , d2 , k ) result ( res ) !! Intersection operator. Returns the intersection of two SDFs. !> SDF_1 distance real ( kind = wp ), intent ( IN ) :: d1 !> SDF_2 distance real ( kind = wp ), intent ( IN ) :: d2 !> smoothing factor. real ( kind = wp ), intent ( IN ) :: k real ( kind = wp ) :: res res = max ( d1 , d2 ) end function intersection","tags":"","loc":"proc/intersection.html"},{"title":"onion_init – signedMCRT","text":"private function onion_init(prim, thickness) result(out) Initialise the Onion modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: thickness Thickned to onion by. Return Value type( onion ) Contents Source Code onion_init Source Code type ( onion ) function onion_init ( prim , thickness ) result ( out ) !! Initialise the Onion modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Thickned to onion by. real ( kind = wp ), intent ( IN ) :: thickness out % thickness = thickness out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function onion_init","tags":"","loc":"proc/onion_init.html"},{"title":"repeat_init – signedMCRT","text":"private function repeat_init(prim, c, la, lb) result(out) Initialise the Repeat modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: c type( vector ), intent(in) :: la type( vector ), intent(in) :: lb Return Value type( repeat ) Contents Source Code repeat_init Source Code type ( repeat ) function repeat_init ( prim , c , la , lb ) result ( out ) !! Initialise the Repeat modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> type ( vector ), intent ( IN ) :: la !> type ( vector ), intent ( IN ) :: lb !> real ( kind = wp ), intent ( IN ) :: c out % c = c out % la = la out % lb = lb out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function repeat_init","tags":"","loc":"proc/repeat_init.html"},{"title":"revolution_init – signedMCRT","text":"private function revolution_init(prim, o) result(out) Initialise the Revolution modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: o Amount to revolve by. Return Value type( revolution ) Contents Source Code revolution_init Source Code type ( revolution ) function revolution_init ( prim , o ) result ( out ) !! Initialise the Revolution modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Amount to revolve by. real ( kind = wp ), intent ( IN ) :: o out % o = o out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function revolution_init","tags":"","loc":"proc/revolution_init.html"},{"title":"subtraction – signedMCRT","text":"public pure function subtraction(d1, d2, k) result(res) Subtraction operator. Takes one SDF from another.\nTake the first SDF from the 2nd SDF Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 SDF_1 distance real(kind=wp), intent(in) :: d2 SDF_2 distance real(kind=wp), intent(in) :: k unused factor. Return Value real(kind=wp) Contents Source Code subtraction Source Code pure function subtraction ( d1 , d2 , k ) result ( res ) !! Subtraction operator. Takes one SDF from another. !! Take the first SDF from the 2nd SDF !> SDF_1 distance real ( kind = wp ), intent ( IN ) :: d1 !> SDF_2 distance real ( kind = wp ), intent ( IN ) :: d2 !> unused factor. real ( kind = wp ), intent ( IN ) :: k real ( kind = wp ) :: res res = max ( - d1 , d2 ) end function subtraction","tags":"","loc":"proc/subtraction.html"},{"title":"twist_init – signedMCRT","text":"private function twist_init(prim, k) result(out) Initialise the twist modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real, intent(in) :: k Twist parameter. Return Value type( twist ) Contents Source Code twist_init Source Code type ( twist ) function twist_init ( prim , k ) result ( out ) !! Initialise the twist modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Twist parameter. real , intent ( in ) :: k out % k = k out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function twist_init","tags":"","loc":"proc/twist_init.html"},{"title":"union – signedMCRT","text":"public pure function union(d1, d2, k) result(res) Union operation. Joins two SDFs together Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 SDF_1 distance real(kind=wp), intent(in) :: d2 SDF_2 distance real(kind=wp), intent(in) :: k unused factor Return Value real(kind=wp) Contents Source Code union Source Code pure function union ( d1 , d2 , k ) result ( res ) !! Union operation. Joins two SDFs together !> SDF_1 distance real ( kind = wp ), intent ( IN ) :: d1 !> SDF_2 distance real ( kind = wp ), intent ( IN ) :: d2 !> unused factor real ( kind = wp ), intent ( IN ) :: k real ( kind = wp ) :: res res = min ( d1 , d2 ) end function union","tags":"","loc":"proc/union.html"},{"title":"bend – signedMCRT","text":"public interface bend Contents Module Procedures bend_init Module Procedures private function bend_init (prim, k) result(out) Initialise the Bend modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: k Amoun to bend by. Return Value type( bend )","tags":"","loc":"interface/bend.html"},{"title":"displacement – signedMCRT","text":"public interface displacement Contents Module Procedures displacement_init Module Procedures private function displacement_init (prim, func) result(out) Initialise the displacement modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify procedure( primitive ) :: func Function to displace the SDF with. Return Value type( displacement )","tags":"","loc":"interface/displacement.html"},{"title":"elongate – signedMCRT","text":"public interface elongate Contents Module Procedures elongate_init Module Procedures private function elongate_init (prim, size) result(out) Initialise the elongate modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify type( vector ), intent(in) :: size Distance to elongate by Return Value type( elongate )","tags":"","loc":"interface/elongate.html"},{"title":"extrude – signedMCRT","text":"public interface extrude Contents Module Procedures extrude_init Module Procedures private function extrude_init (prim, h) result(out) Initialise the extrude modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: h Distance to extrude by. Return Value type( extrude )","tags":"","loc":"interface/extrude.html"},{"title":"onion – signedMCRT","text":"public interface onion Contents Module Procedures onion_init Module Procedures private function onion_init (prim, thickness) result(out) Initialise the Onion modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: thickness Thickned to onion by. Return Value type( onion )","tags":"","loc":"interface/onion.html"},{"title":"repeat – signedMCRT","text":"public interface repeat Contents Module Procedures repeat_init Module Procedures private function repeat_init (prim, c, la, lb) result(out) Initialise the Repeat modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: c type( vector ), intent(in) :: la type( vector ), intent(in) :: lb Return Value type( repeat )","tags":"","loc":"interface/repeat.html"},{"title":"revolution – signedMCRT","text":"public interface revolution Contents Module Procedures revolution_init Module Procedures private function revolution_init (prim, o) result(out) Initialise the Revolution modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: o Amount to revolve by. Return Value type( revolution )","tags":"","loc":"interface/revolution.html"},{"title":"twist – signedMCRT","text":"public interface twist Contents Module Procedures twist_init Module Procedures private function twist_init (prim, k) result(out) Initialise the twist modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real, intent(in) :: k Twist parameter. Return Value type( twist )","tags":"","loc":"interface/twist.html"},{"title":"calcNormal – signedMCRT","text":"public function calcNormal(p, obj) Calculate the surface normal of a SDF at the point p numerically. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: p Position to evaluate at class( sdf_base ) :: obj SDF to calcuate surface normal of. Return Value type( vector ) Contents Source Code calcNormal Source Code type ( vector ) function calcNormal ( p , obj ) !! Calculate the surface normal of a SDF at the point p numerically. !> Position to evaluate at type ( vector ), intent ( IN ) :: p !> SDF to calcuate surface normal of. class ( sdf_base ) :: obj real ( kind = wp ) :: h type ( vector ) :: xyy , yyx , yxy , xxx h = 1e-6_wp xyy = vector ( 1._wp , - 1._wp , - 1._wp ) yyx = vector ( - 1._wp , - 1._wp , 1._wp ) yxy = vector ( - 1._wp , 1._wp , - 1._wp ) xxx = vector ( 1._wp , 1._wp , 1._wp ) calcNormal = xyy * obj % evaluate ( p + xyy * h ) + & yyx * obj % evaluate ( p + yyx * h ) + & yxy * obj % evaluate ( p + yxy * h ) + & xxx * obj % evaluate ( p + xxx * h ) calcNormal = calcNormal % magnitude () end function calcNormal","tags":"","loc":"proc/calcnormal.html"},{"title":"eval_model – signedMCRT","text":"private pure elemental function eval_model(this, pos) result(res) Evaluate the model Type Bound model Arguments Type Intent Optional Attributes Name class( model ), intent(in) :: this type( vector ), intent(in) :: pos Vector position to evaluate at Return Value real(kind=wp) Contents Source Code eval_model Source Code pure elemental function eval_model ( this , pos ) result ( res ) !! Evaluate the model class ( model ), intent ( in ) :: this !> Vector position to evaluate at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res integer :: i res = this % array ( 1 )% value % evaluate ( pos ) do i = 2 , size ( this % array ) res = this % func ( res , this % array ( i )% value % evaluate ( pos ), this % k ) end do end function eval_model","tags":"","loc":"proc/eval_model.html"},{"title":"getAlbedo – signedMCRT","text":"private function getAlbedo(this) result(res) Return albedo for the current SDF. Type Bound sdf Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) Contents Source Code getAlbedo Source Code function getAlbedo ( this ) result ( res ) !! Return albedo for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % albedo end function getAlbedo","tags":"","loc":"proc/getalbedo.html"},{"title":"getKappa – signedMCRT","text":"private function getKappa(this) result(res) Return for the current SDF Type Bound sdf Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) Contents Source Code getKappa Source Code function getKappa ( this ) result ( res ) !! Return \\kappa for the current SDF class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % kappa end function getKappa","tags":"","loc":"proc/getkappa.html"},{"title":"getMua – signedMCRT","text":"private function getMua(this) result(res) Return for the current SDF. Type Bound sdf Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) Contents Source Code getMua Source Code function getMua ( this ) result ( res ) !! Return \\mu_a for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % mua end function getMua","tags":"","loc":"proc/getmua.html"},{"title":"getN – signedMCRT","text":"private function getN(this) result(res) Return refractive index for the current SDF. Type Bound sdf Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) Contents Source Code getN Source Code function getN ( this ) result ( res ) !! Return refractive index for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % n end function getN","tags":"","loc":"proc/getn.html"},{"title":"getg2 – signedMCRT","text":"private function getg2(this) result(res) Return factor for the current SDF. Type Bound sdf Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) Contents Source Code getg2 Source Code function getg2 ( this ) result ( res ) !! Return g^2 factor for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % g2 end function getg2","tags":"","loc":"proc/getg2.html"},{"title":"gethgg – signedMCRT","text":"private function gethgg(this) result(res) Return g-factor for the current SDF. Type Bound sdf Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) Contents Source Code gethgg Source Code function gethgg ( this ) result ( res ) !! Return g-factor for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % hgg end function gethgg","tags":"","loc":"proc/gethgg.html"},{"title":"model_init – signedMCRT","text":"private function model_init(array, func, kopt) result(out) Initalise the model type. Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: array (:) Array of SDFs procedure( op ) :: func Operator to apply to SDF. real(kind=wp), intent(in), optional :: kopt Parameter used in modifier Return Value type( model ) Contents Source Code model_init Source Code function model_init ( array , func , kopt ) result ( out ) !! Initalise the model type. type ( model ) :: out !> Operator to apply to SDF. procedure ( op ) :: func !> Array of SDFs type ( sdf ), intent ( IN ) :: array (:) !> Parameter used in modifier real ( kind = wp ), optional , intent ( IN ) :: kopt integer :: i out % array = array out % func => func if ( present ( kopt )) then out % k = kopt else out % k = 0._wp end if do i = 2 , size ( array ) if ( array ( 1 )% value % optProps % value % mus /= array ( i )% value % optProps % value % mus ) then print * , \"Error mismatch in model mus in object: \" , i end if if ( array ( 1 )% value % optProps % value % mua /= array ( i )% value % optProps % value % mua ) then print * , \"Error mismatch in model mua in object: \" , i end if if ( array ( 1 )% value % optProps % value % hgg /= array ( i )% value % optProps % value % hgg ) then print * , \"Error mismatch in model hgg in object: \" , i end if if ( array ( 1 )% value % optProps % value % n /= array ( i )% value % optProps % value % n ) then print * , \"Error mismatch in model n in object: \" , i end if if ( array ( 1 )% value % layer /= array ( i )% value % layer ) then print * , \"Error mismatch in model layer in object: \" , i end if end do out % optProps = array ( 1 )% value % optProps out % layer = array ( 1 )% value % layer end function model_init","tags":"","loc":"proc/model_init.html"},{"title":"sdf_evaluate – signedMCRT","text":"private pure elemental function sdf_evaluate(this, pos) result(res) Evaluate the SDF at a given position. Type Bound sdf Arguments Type Intent Optional Attributes Name class( sdf ), intent(in) :: this type( vector ), intent(in) :: pos Return Value real(kind=wp) Contents Source Code sdf_evaluate Source Code pure elemental function sdf_evaluate ( this , pos ) result ( res ) !! Evaluate the SDF at a given position. class ( sdf ), intent ( in ) :: this type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res res = this % value % evaluate ( pos ) end function sdf_evaluate","tags":"","loc":"proc/sdf_evaluate.html"},{"title":"sdf_new – signedMCRT","text":"private function sdf_new(rhs) result(lhs) sdf initializer Arguments Type Intent Optional Attributes Name class( sdf_base ), intent(in) :: rhs Return Value type( sdf ) Contents Source Code sdf_new Source Code type ( sdf ) function sdf_new ( rhs ) result ( lhs ) !! sdf initializer class ( sdf_base ), intent ( in ) :: rhs allocate ( lhs % value , source = rhs ) end function sdf_new","tags":"","loc":"proc/sdf_new.html"},{"title":"render_sub – signedMCRT","text":"private subroutine render_sub(cnt, extent, samples, state) Uses constants utils sim_state_mod writer_mod Render the SDFs onto a voxel grid Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: cnt (:) type( vector ), intent(in) :: extent integer, intent(in) :: samples (3) type( settings_t ), intent(in) :: state Contents Source Code render_sub Source Code subroutine render_sub ( cnt , extent , samples , state ) !! Render the SDFs onto a voxel grid use sim_state_mod , only : settings_t use utils , only : pbar use constants , only : fileplace , sp use writer_mod type ( settings_t ), intent ( IN ) :: state type ( sdf ), intent ( IN ) :: cnt (:) integer , intent ( IN ) :: samples ( 3 ) type ( vector ), intent ( IN ) :: extent type ( vector ) :: pos , wid integer :: i , j , k , u , id real ( kind = wp ) :: x , y , z , ds ( size ( cnt )), ns ( 3 ), minvalue real ( kind = sp ), allocatable :: image (:, :, :) type ( pbar ) :: bar ns = nint ( samples / 2._wp ) allocate ( image ( samples ( 1 ), samples ( 2 ), samples ( 3 ))) wid = vector ( extent % x / ns ( 1 ), extent % y / ns ( 2 ), extent % z / ns ( 3 )) bar = pbar ( samples ( 1 )) !$omp parallel default(none) shared(cnt, ns, wid, image, samples, bar)& !$omp private(i, x, y, z, pos, j, k, u, ds, id, minvalue) !$omp do do i = 1 , samples ( 1 ) x = ( i - ns ( 1 )) * wid % x do j = 1 , samples ( 2 ) y = ( j - ns ( 2 )) * wid % y do k = 1 , samples ( 3 ) z = ( k - ns ( 3 )) * wid % z pos = vector ( x , y , z ) ds = 0._wp do u = 1 , size ( ds ) ds ( u ) = cnt ( u )% evaluate ( pos ) end do image ( i , j , k ) = minval ( ds ) end do end do call bar % progress () end do !$OMP end do !$OMP end parallel call write_data ( image , trim ( fileplace ) // state % renderfile , state , overwrite = . true .) end subroutine render_sub","tags":"","loc":"proc/render_sub.html"},{"title":"render_vec – signedMCRT","text":"private subroutine render_vec(cnt, state) Uses sim_state_mod Render the SDF\nWrapper around the render function to allow ease of use Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: cnt (:) type( settings_t ), intent(in) :: state Contents Source Code render_vec Source Code subroutine render_vec ( cnt , state ) !! Render the SDF !! Wrapper around the render function to allow ease of use use sim_state_mod , only : settings_t type ( settings_t ), intent ( IN ) :: state type ( sdf ), intent ( IN ) :: cnt (:) type ( vector ) :: extent extent = vector ( state % grid % xmax , state % grid % ymax , state % grid % zmax ) call render_sub ( cnt , extent , state % render_size , state ) end subroutine render_vec","tags":"","loc":"proc/render_vec.html"},{"title":"sdf_assign – signedMCRT","text":"private subroutine sdf_assign(lhs, rhs) sdf initializer Type Bound sdf Arguments Type Intent Optional Attributes Name class( sdf ), intent(inout) :: lhs class( sdf_base ), intent(in) :: rhs Contents Source Code sdf_assign Source Code subroutine sdf_assign ( lhs , rhs ) !! sdf initializer class ( sdf ), intent ( inout ) :: lhs class ( sdf_base ), intent ( in ) :: rhs if ( allocated ( lhs % value )) deallocate ( lhs % value ) ! Prevent nested derived type select type ( rhsT => rhs ) class is ( sdf ) if ( allocated ( rhsT % value )) allocate ( lhs % value , source = rhsT % value ) class default allocate ( lhs % value , source = rhsT ) end select end subroutine sdf_assign","tags":"","loc":"proc/sdf_assign.html"},{"title":"model – signedMCRT","text":"public interface model Contents Module Procedures model_init Module Procedures private function model_init (array, func, kopt) result(out) Initalise the model type. Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: array (:) Array of SDFs procedure( op ) :: func Operator to apply to SDF. real(kind=wp), intent(in), optional :: kopt Parameter used in modifier Return Value type( model )","tags":"","loc":"interface/model.html"},{"title":"render – signedMCRT","text":"public interface render Contents Module Procedures render_sub render_vec Module Procedures private subroutine render_sub (cnt, extent, samples, state) Render the SDFs onto a voxel grid Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: cnt (:) type( vector ), intent(in) :: extent integer, intent(in) :: samples (3) type( settings_t ), intent(in) :: state private subroutine render_vec (cnt, state) Render the SDF\nWrapper around the render function to allow ease of use Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: cnt (:) type( settings_t ), intent(in) :: state","tags":"","loc":"interface/render.html"},{"title":"sdf – signedMCRT","text":"public interface sdf Contents Module Procedures sdf_new Module Procedures private function sdf_new (rhs) result(lhs) sdf initializer Arguments Type Intent Optional Attributes Name class( sdf_base ), intent(in) :: rhs Return Value type( sdf )","tags":"","loc":"interface/sdf.html"},{"title":"setupGeometry – signedMCRT","text":"contains all the routines that setup premade experimental geometry Uses tomlf constants Contents Functions get_vessels setup_egg setup_exp setup_logo setup_omg_sdf setup_scat_test setup_scat_test2 setup_sphere setup_sphere_scene Functions public function get_vessels () result(array) setup blood vessel scene Arguments None Return Value type( sdf ), allocatable, (:) public function setup_egg () result(array) setup an egg, with yolk, albumen and shell Arguments None Return Value type( sdf ), allocatable, (:) public function setup_exp (dict) result(array) Setup experimental geometry from Georgies paper. i.e a glass bottle with contents Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Return Value type( sdf ), allocatable, (:) public function setup_logo () result(array) setup uni crest geometry Arguments None Return Value type( sdf ), allocatable, (:) public function setup_omg_sdf () result(array) setup OMG scene Arguments None Return Value type( sdf ), allocatable, (:) public function setup_scat_test (dict) result(array) set up scattering test scene with user defined tau Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Return Value type( sdf ), allocatable, (:) public function setup_scat_test2 (dict) result(array) set up scattering test scene 2 with user defined tau and hgg Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Return Value type( sdf ), allocatable, (:) public function setup_sphere () result(array) setup the sphere test case from tran and jacques paper. Arguments None Return Value type( sdf ), allocatable, (:) public function setup_sphere_scene (dict) result(array) setup a test scene with user defined spheres Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Return Value type( sdf ), allocatable, (:)","tags":"","loc":"module/setupgeometry.html"},{"title":"photonMod – signedMCRT","text":"This source file contains the photon type, all the photon launch routines for different light sources, and the scattering code. Below are the current types of light sources available. Check here for parameters needed for each light source. uniform pencil annulus focus point circular SLM (2D image source) double slit square aperture Uses random vector_class constants Contents Variables photon_origin Interfaces photon Abstract Interfaces generic_emit Derived Types photon Functions init_photon init_source Subroutines annulus aperture circular dslit focus pencil point scatter set_photon slm uniform Variables Type Visibility Attributes Name Initial type( photon ), public :: photon_origin used to save some computation time Interfaces public interface photon public function init_source (choice) Bind emission function to photon object Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: choice Name of light source to use Return Value type( photon ) private function init_photon (val) set up all the variables in the photon object Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val value to assing to variables Return Value type( photon ) Abstract Interfaces abstract interface public subroutine generic_emit(this, spectrum, dict, seqs) Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Derived Types type, public :: photon photon class Components Type Visibility Attributes Name Initial integer, public :: bounces Debug data. Number of SDF evals integer, public :: cnts Debug data. Number of SDF evals real(kind=wp), public :: cosp direction cosines real(kind=wp), public :: cost direction cosines procedure( generic_emit ), public, pointer :: emit => null() emission routine real(kind=wp), public :: energy Energy of the packet. TODO real(kind=wp), public :: fact . Used to save computational time integer, public :: id Thread ID of the packet integer, public :: layer ID of the SDF the packet is in real(kind=wp), public :: nxp direction vectors real(kind=wp), public :: nyp direction vectors real(kind=wp), public :: nzp direction vectors real(kind=wp), public :: phase Current phase of the packet real(kind=wp), public :: phi direction cosines type( vector ), public :: pos postion of photon packet in cm. (0,0,0) is the center of the grid. real(kind=wp), public :: sinp direction cosines real(kind=wp), public :: sint direction cosines real(kind=wp), public :: step used if photon packet weights are used logical, public :: tflag photon alive flag real(kind=wp), public :: wavelength Wavelength of the packet real(kind=wp), public :: weight used if photon packet weights are used integer, public :: xcell grid cell position integer, public :: ycell grid cell position integer, public :: zcell grid cell position Constructor public\n\n \n function init_source (choice) Bind emission function to photon object private\n\n \n function init_photon (val) set up all the variables in the photon object Type-Bound Procedures procedure\n , public\n, :: scatter Subroutine scattering routine Functions private function init_photon (val) set up all the variables in the photon object Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val value to assing to variables Return Value type( photon ) public function init_source (choice) Bind emission function to photon object Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: choice Name of light source to use Return Value type( photon ) Subroutines private subroutine annulus (this, spectrum, dict, seqs) annular source Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) private subroutine aperture (this, spectrum, dict, seqs) sample from square aperture to produce diff pattern Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) private subroutine circular (this, spectrum, dict, seqs) circular source Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) private subroutine dslit (this, spectrum, dict, seqs) sample from double slit to produce diff pattern Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) private subroutine focus (this, spectrum, dict, seqs) Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) private subroutine pencil (this, spectrum, dict, seqs) pencil beam source Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) private subroutine point (this, spectrum, dict, seqs) isotropic point source Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) private subroutine scatter (this, hgg, g2, dects) Scattering routine. Implments both isotropic and henyey-greenstein scattering\ntaken from mcxyz Arguments Type Intent Optional Attributes Name class( photon ), intent(inout) :: this real(kind=wp), intent(in) :: hgg g factor real(kind=wp), intent(in) :: g2 g factor squared type( dect_array ), intent(in), optional :: dects (:) array of detectors. Only used if biased scattering is enabled. public subroutine set_photon (pos, dir) Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos type( vector ), intent(in) :: dir private subroutine slm (this, spectrum, dict, seqs) Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) private subroutine uniform (this, spectrum, dict, seqs) uniformly illuminate a surface of the simulation media Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2)","tags":"","loc":"module/photonmod.html"},{"title":"surfaces – signedMCRT","text":"Contains the routines that handle reflection, and refraction via the Fresnel equations. Uses constants vector_class Contents Functions fresnel Subroutines reflect reflect_refract refract Functions private function fresnel (I, N, n1, n2) result(tir) calculates the fresnel coefficents Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: I incident vector type( vector ), intent(in) :: N Normal vector real(kind=wp), intent(in) :: n1 reffractive indicies real(kind=wp), intent(in) :: n2 reffractive indicies Return Value real(kind=wp) Subroutines private subroutine reflect (I, N) get vector of reflected photon Arguments Type Intent Optional Attributes Name type( vector ), intent(inout) :: I incident vector type( vector ), intent(in) :: N normal vector public subroutine reflect_refract (I, N, n1, n2, rflag, Ri) wrapper routine for fresnel calculation Arguments Type Intent Optional Attributes Name type( vector ), intent(inout) :: I incident vector type( vector ), intent(inout) :: N normal vector real(kind=wp), intent(in) :: n1 refractive indices real(kind=wp), intent(in) :: n2 refractive indices logical, intent(out) :: rflag reflection flag real(kind=wp), intent(out) :: Ri private subroutine refract (I, N, eta) get vector of refracted photon Arguments Type Intent Optional Attributes Name type( vector ), intent(inout) :: I incident vector type( vector ), intent(in) :: N normal vector real(kind=wp), intent(in) :: eta","tags":"","loc":"module/surfaces.html"},{"title":"setupMod – signedMCRT","text":"This file sets up some simulations variables and assigns the geometry for the simulation. Uses tomlf constants Contents Subroutines alloc_array create_directory dealloc_array directory setup_simulation zarray Subroutines private subroutine alloc_array (nxg, nyg, nzg) subroutine allocates allocatable arrays Arguments Type Intent Optional Attributes Name integer, intent(in) :: nxg grid size integer, intent(in) :: nyg grid size integer, intent(in) :: nzg grid size private subroutine create_directory (name, flag, appendname, newline) create directories if they don't exist Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name logical, intent(in) :: flag character(len=*), intent(in) :: appendname logical, intent(in), optional :: newline public subroutine dealloc_array () deallocate data arrays Arguments None public subroutine directory () subroutine defines vars to hold paths to various folders Arguments None public subroutine setup_simulation (sdfarray, dict) Read in parameters\nSetup up various simulation parameters and routines Arguments Type Intent Optional Attributes Name type( sdf ), intent(out), allocatable :: sdfarray (:) output array of geometry type(toml_table), intent(inout), optional :: dict dictionary used to store metadata private subroutine zarray () zero data arrays Arguments None","tags":"","loc":"module/setupmod.html"},{"title":"mat_class – signedMCRT","text":"Matrix class module. Defines a matrix type (4x4 matrix) and associated operations on matrices and other types. not fully implmented matix class\nminimum implmented for neural sdf type Uses vec4_class constants Contents Interfaces mat Derived Types mat Functions invert mat_add_scal mat_div_scal mat_init mat_minus_scal mat_mult_mat mat_mult_scal scal_add_mat scal_mult_mat Interfaces public interface mat Intalise Matrix with 1D Array private function mat_init (array) Initalise matrix type from 1D array Arguments Type Intent Optional Attributes Name real(kind=wp) :: array (16) 1D array to initalise from. Return Value type( mat ) Derived Types type, public :: mat Components Type Visibility Attributes Name Initial real(kind=wp), public :: vals (4,4) Matrix values Constructor Intalise Matrix with 1D Array private\n\n \n function mat_init (array) Initalise matrix type from 1D array Type-Bound Procedures procedure\n , private\n, pass(a) :: mat_add_scal Function procedure\n , private\n, pass(a) :: mat_div_scal Function procedure\n , private\n, pass(a) :: mat_minus_scal Function procedure\n , private\n, pass(a) :: mat_mult_mat Function procedure\n , private\n, pass(a) :: mat_mult_scal Function generic,\n public\n, :: operator(*) => mat_mult_scal , scal_mult_mat , mat_mult_mat Overload for Multiplication operator generic,\n public\n, :: operator(+) => mat_add_scal , scal_add_mat Overload for Addition operator generic,\n public\n, :: operator(-) => mat_minus_scal Overload for Subtraction operator generic,\n public\n, :: operator(/) => mat_div_scal Overload for Division operator procedure\n , private\n, pass(b) :: scal_add_mat Function procedure\n , private\n, pass(b) :: scal_mult_mat Function Functions public pure function invert (A) result(B) Performs a direct calculation of the inverse of a 4×4 matrix.\nfrom http://fortranwiki.org/fortran/show/Matrix+inversion Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: A (4,4) Input Matric Return Value real(kind=wp), (4,4) private function mat_add_scal (a, b) Matrix + Scalar = Matrix Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to add Return Value type( mat ) private function mat_div_scal (a, b) Matrix / scalar Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to divide by Return Value type( mat ) private function mat_init (array) Initalise matrix type from 1D array Arguments Type Intent Optional Attributes Name real(kind=wp) :: array (16) 1D array to initalise from. Return Value type( mat ) private function mat_minus_scal (a, b) Matrix - Scalar Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( mat ) private function mat_mult_mat (a, b) Matrix * vec4 Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix type( vec4 ), intent(in) :: b Vec4 to multiply by Return Value type( vec4 ) private function mat_mult_scal (a, b) Matrix * Scalar Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( mat ) private function scal_add_mat (a, b) Scaler + Matrix Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalat to add class( mat ), intent(in) :: b Input Matrix Return Value type( mat ) private function scal_mult_mat (a, b) Matrix * Scalar Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( mat ), intent(in) :: b Input Matrix Return Value type( mat )","tags":"","loc":"module/mat_class.html"},{"title":"historyStack – signedMCRT","text":"Module contains the history stack type which stores the history of positions of a photon and th I/O routines\nnot fully implmented Uses vec4_class constants Contents Variables block_size Interfaces history_stack_t Derived Types history_stack_t Functions histempty_fn histpeek_fn histpop_fn init_historyStack Subroutines histfinish_sub histpush_sub histwrite_sub histzero_sub json_writer obj_writer ply_writer Variables Type Visibility Attributes Name Initial integer, public, parameter :: block_size = 32 Interfaces public interface history_stack_t private function init_historyStack (filename, id) Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: filename integer, intent(in) :: id Return Value type( history_stack_t ) Derived Types type, public :: history_stack_t Components Type Visibility Attributes Name Initial type( vec4 ), public, allocatable :: data (:) integer, public :: edge_counter character(len=:), public, allocatable :: filename integer, public :: size character(len=:), public, allocatable :: type integer, public :: vertex_counter Constructor private\n\n \n function init_historyStack (filename, id) Type-Bound Procedures procedure\n , public\n, :: empty => histempty_fn Function procedure\n , public\n, :: finish => histfinish_sub Subroutine procedure\n , public\n, :: peek => histpeek_fn Function procedure\n , public\n, :: pop => histpop_fn Function procedure\n , public\n, :: push => histpush_sub Subroutine procedure\n , public\n, :: write => histwrite_sub Subroutine procedure\n , public\n, :: zero => histzero_sub Subroutine Functions private function histempty_fn (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Return Value logical private function histpeek_fn (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Return Value type( vec4 ) private function histpop_fn (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Return Value type( vec4 ) private function init_historyStack (filename, id) Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: filename integer, intent(in) :: id Return Value type( history_stack_t ) Subroutines private subroutine histfinish_sub (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this private subroutine histpush_sub (this, val) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this type( vec4 ), intent(in) :: val private subroutine histwrite_sub (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this private subroutine histzero_sub (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this private subroutine json_writer (this) Arguments Type Intent Optional Attributes Name type( history_stack_t ), intent(inout) :: this private subroutine obj_writer (this) Arguments Type Intent Optional Attributes Name type( history_stack_t ), intent(inout) :: this private subroutine ply_writer (this) Arguments Type Intent Optional Attributes Name type( history_stack_t ), intent(inout) :: this","tags":"","loc":"module/historystack.html"},{"title":"vector_class – signedMCRT","text":"Vector class module. Defines a vector type (x, y, z) and associated operations on vectors and other types. Uses constants Contents Interfaces abs max min nint Derived Types vector Functions abs_vec length magnitude max_vec maxval_vec min_vec minval_vec nint_vec scal_add_vec scal_minus_vec scal_mult_vec vec_add_scal vec_add_vec vec_cross_vec vec_div_scal_int vec_div_scal_r4 vec_div_scal_r8 vec_dot_mat vec_dot_vec vec_equal_vec vec_minus_scal vec_minus_vec vec_mult_exp_scal_int vec_mult_exp_scal_r4 vec_mult_exp_scal_r8 vec_mult_scal vec_mult_vec Interfaces public interface abs Overload of the abs intrinsic for a vec3 private pure elemental function abs_vec (this) Calculate the absoulte of a vector elementwise Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value type( vector ) public interface max Overload of the max intrinsic for a vec3 private pure elemental function max_vec (this, val) Get the max value elementwise between a vec3 and a scalar Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector real(kind=wp), intent(in) :: val Input max value Return Value type( vector ) private pure elemental function maxval_vec (this) Get the max value in a vec3 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value real(kind=wp) public interface min Overload of the min intrinsic for a vec3 private pure elemental function min_vec (this, val) Get the min value elementwise between a vec3 and a scalar Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector real(kind=wp), intent(in) :: val Input minimum value Return Value type( vector ) private pure elemental function minval_vec (this) Get the min value in a vec3 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value real(kind=wp) public interface nint Overload of the nint intrinsic for a vec3 private pure elemental function nint_vec (this) Overload the nint intrinsic for a vec3 elementwise Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value type( vector ) Derived Types type, public :: vector Vector class Components Type Visibility Attributes Name Initial real(kind=wp), public :: x vector components real(kind=wp), public :: y vector components real(kind=wp), public :: z vector components Type-Bound Procedures procedure\n , public\n, :: length Function Returns the length of the vector procedure\n , public\n, :: magnitude Function Returns the magnitude of the vector generic,\n public\n, :: operator(*) => vec_mult_vec , vec_mult_scal , scal_mult_vec Overloads the Multiplication operator for vec3 generic,\n public\n, :: operator(**) => vec_mult_exp_scal_int , vec_mult_exp_scal_r4 , vec_mult_exp_scal_r8 Overloads the exponential operator for vec3 generic,\n public\n, :: operator(+) => vec_add_vec , vec_add_scal , scal_add_vec Overloads the Addition operator for vec3 generic,\n public\n, :: operator(-) => vec_minus_vec , vec_minus_scal , scal_minus_vec Overloads the Subtraction operator for vec3 generic,\n public\n, :: operator(.cross.) => vec_cross_vec .cross. operator. Cross product generic,\n public\n, :: operator(.dot.) => vec_dot_vec , vec_dot_mat .dot. operator. Dot product generic,\n public\n, :: operator(/) => vec_div_scal_r4 , vec_div_scal_r8 , vec_div_scal_int Overloads the Division operator for vec3 generic,\n public\n, :: operator(==) => vec_equal_vec Overloads the equal operator for vec3 procedure\n , private\n, pass(b) :: scal_add_vec Function procedure\n , private\n, pass(b) :: scal_minus_vec Function procedure\n , private\n, pass(b) :: scal_mult_vec Function procedure\n , private\n, pass(a) :: vec_add_scal Function procedure\n , private\n, pass(a) :: vec_add_vec Function procedure\n , private\n, pass(a) :: vec_cross_vec Function procedure\n , private\n, pass(a) :: vec_div_scal_int Function procedure\n , private\n, pass(a) :: vec_div_scal_r4 Function procedure\n , private\n, pass(a) :: vec_div_scal_r8 Function procedure\n , private\n, pass(a) :: vec_dot_mat Function procedure\n , private\n, pass(a) :: vec_dot_vec Function procedure\n , private\n, pass(a) :: vec_equal_vec Function procedure\n , private\n, pass(a) :: vec_minus_scal Function procedure\n , private\n, pass(a) :: vec_minus_vec Function procedure\n , private\n, pass(a) :: vec_mult_exp_scal_int Function procedure\n , private\n, pass(a) :: vec_mult_exp_scal_r4 Function procedure\n , private\n, pass(a) :: vec_mult_exp_scal_r8 Function procedure\n , private\n, pass(a) :: vec_mult_scal Function procedure\n , private\n, pass(a) :: vec_mult_vec Function Functions private pure elemental function abs_vec (this) Calculate the absoulte of a vector elementwise Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value type( vector ) public pure elemental function length (this) Returns the length of a vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: this Return Value real(kind=wp) public pure elemental function magnitude (this) Returns the magnitude of a vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: this Return Value type( vector ) private pure elemental function max_vec (this, val) Get the max value elementwise between a vec3 and a scalar Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector real(kind=wp), intent(in) :: val Input max value Return Value type( vector ) private pure elemental function maxval_vec (this) Get the max value in a vec3 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value real(kind=wp) private pure elemental function min_vec (this, val) Get the min value elementwise between a vec3 and a scalar Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector real(kind=wp), intent(in) :: val Input minimum value Return Value type( vector ) private pure elemental function minval_vec (this) Get the min value in a vec3 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value real(kind=wp) private pure elemental function nint_vec (this) Overload the nint intrinsic for a vec3 elementwise Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value type( vector ) private pure elemental function scal_add_vec (a, b) vec3 + scalar Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to add class( vector ), intent(in) :: b Input vector Return Value type( vector ) private pure elemental function scal_minus_vec (a, b) scalar - vec3 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to subtract from class( vector ), intent(in) :: b Input vector Return Value type( vector ) private pure elemental function scal_mult_vec (a, b) Scalar * vec3 elementwise Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( vector ), intent(in) :: b input vec3 Return Value type( vector ) private pure elemental function vec_add_scal (a, b) vec3 + scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector real(kind=wp), intent(in) :: b Scalar to add Return Value type( vector ) private pure elemental function vec_add_vec (a, b) vec3 + vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b Vec3 to add Return Value type( vector ) private pure elemental function vec_cross_vec (a, b) result(cross) vec3 x vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b vec3 to cross with Return Value type( vector ) private pure elemental function vec_div_scal_int (a, b) vec3 / scalar elementwise. Scalar is an integer Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 integer, intent(in) :: b Scalar to divide by Return Value type( vector ) private pure elemental function vec_div_scal_r4 (a, b) vec3 / scalar elementwise. Scalar is a 32-bit float Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=sp), intent(in) :: b Scalar to divide by Return Value type( vector ) private pure elemental function vec_div_scal_r8 (a, b) vec3 / scalar elementwise. Scalar is a 64-bit float Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=dp), intent(in) :: b Scalar to divide by Return Value type( vector ) private pure function vec_dot_mat (a, b) result(dot) vec3 . matrix Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3 real(kind=wp), intent(in) :: b (4,4) Matrix to dot with Return Value type( vector ) private pure elemental function vec_dot_vec (a, b) result(dot) vec3 . vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3 type( vector ), intent(in) :: b vec3 to dot Return Value real(kind=wp) private pure elemental function vec_equal_vec (a, b) vec3 == vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3s class( vector ), intent(in) :: b Input vec3s Return Value logical private pure elemental function vec_minus_scal (a, b) vec3 - scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( vector ) private pure elemental function vec_minus_vec (a, b) vec3 - vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b vec3 to subtract Return Value type( vector ) private pure elemental function vec_mult_exp_scal_int (a, b) vec3**scalar for integer scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector integer, intent(in) :: b Input scalar Return Value type( vector ) private pure elemental function vec_mult_exp_scal_r4 (a, b) vec3**scalar for 32-bit float scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector real(kind=sp), intent(in) :: b Input scalar Return Value type( vector ) private pure elemental function vec_mult_exp_scal_r8 (a, b) vec3**scalar for 64-bit float scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector real(kind=dp), intent(in) :: b Input scalar Return Value type( vector ) private pure elemental function vec_mult_scal (a, b) vec3 * scalar elementwise Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( vector ) private pure elemental function vec_mult_vec (a, b) vec3 * vec3 elementwise Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 type( vector ), intent(in) :: b vec3 to multiply by Return Value type( vector )","tags":"","loc":"module/vector_class.html"},{"title":"sim_state_mod – signedMCRT","text":"This module defines the setting_t type which holds simulation metadata: Uses gridMod Contents Variables state Derived Types settings_t Variables Type Visibility Attributes Name Initial type( settings_t ), public :: state global var that stores simulation state Derived Types type, public :: settings_t Components Type Visibility Attributes Name Initial logical, public :: absorb Boolean to indicate whether to store absoption data. character(len=:), public, allocatable :: experiment Name of experiment/simulation type( cart_grid ), public :: grid Cart_grid type character(len=:), public, allocatable :: historyFilename Name of photon history file integer, public :: iseed initial seed for random number generator integer, public :: nphotons Number of photons to run character(len=:), public, allocatable :: outfile Name of fluence output file character(len=:), public, allocatable :: outfile_absorb Name of absoprtion output file logical, public :: overwrite Boolean to indicate whether to use overwrite datafiles if they have the same name. logical, public :: render_geom Boolean to indicate whether to render SDF to voxels or not. integer, public :: render_size (3) Size of the voxel grid to render SDFs to character(len=:), public, allocatable :: renderfile Name of voxel render file character(len=:), public, allocatable :: source Light source used logical, public :: tev Boolean to indicate whether to use TEV as debug viewer. logical, public :: trackHistory Boolean to indicate whether to store history of photons positions","tags":"","loc":"module/sim_state_mod.html"},{"title":"writer_mod – signedMCRT","text":"This module defines all functions that write simulation data to the disk or pre-process data before writing.\nnormalise_fluence. Normalises fluence by number of photons run and size of each voxel. !Does not normalise by power! write_fluence. Write out fluence in either raw or nrrd format. Default is nrrd.\nwrite_detected_photons. Write out photons detected by detectors. Changes should only be made here if there is a bug or new data types need to be written to disk (phase information) or new file format is needed. Uses constants Contents Interfaces nrrd_write raw_write Functions check_file get_new_file_name Subroutines normalise_fluence write_3d_r4_nrrd write_3d_r4_raw write_3d_r8_nrrd write_3d_r8_raw write_data write_detected_photons write_hdr Interfaces public interface nrrd_write private subroutine write_3d_r8_nrrd (array, filename, overwrite, dict) write 3D array of float64's to .nrrd fileformat Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:,:) array to be written to disk character(len=*), intent(in) :: filename filename logical, intent(in) :: overwrite overwrite flag type(toml_table), intent(inout), optional :: dict dictionary of metadata private subroutine write_3d_r4_nrrd (array, filename, overwrite, dict) write 3D array of float32's to .nrrd fileformat Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to be written to disk character(len=*), intent(in) :: filename filename logical, intent(in) :: overwrite overwrite flag type(toml_table), intent(inout), optional :: dict dictionary of metadata public interface raw_write private subroutine write_3d_r8_raw (array, filename, overwrite) write 3D array of float64s to disk as raw binary data Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:,:) array to write to disk character(len=*), intent(in) :: filename filename to save array as logical, intent(in) :: overwrite overwrite flag private subroutine write_3d_r4_raw (array, filename, overwrite) write 3D array of float32's to disk as raw binary data Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to write to disk character(len=*), intent(in) :: filename filename to save array as logical, intent(in) :: overwrite overwrite flag Functions private function check_file (file) result(res) Functional wrapper around inquire to check if file exits Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: file file to be checked Return Value logical private function get_new_file_name (file) result(res) If file exits, get numeral to append to filename Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: file file to be checked Return Value character(len=:), allocatable Subroutines public subroutine normalise_fluence (grid, array, nphotons) normalise fluence in the Lucy 1999 way Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid grid class real(kind=sp), intent(inout) :: array (:,:,:) array to normalise integer, intent(in) :: nphotons number of photons run private subroutine write_3d_r4_nrrd (array, filename, overwrite, dict) write 3D array of float32's to .nrrd fileformat Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to be written to disk character(len=*), intent(in) :: filename filename logical, intent(in) :: overwrite overwrite flag type(toml_table), intent(inout), optional :: dict dictionary of metadata private subroutine write_3d_r4_raw (array, filename, overwrite) write 3D array of float32's to disk as raw binary data Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to write to disk character(len=*), intent(in) :: filename filename to save array as logical, intent(in) :: overwrite overwrite flag private subroutine write_3d_r8_nrrd (array, filename, overwrite, dict) write 3D array of float64's to .nrrd fileformat Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:,:) array to be written to disk character(len=*), intent(in) :: filename filename logical, intent(in) :: overwrite overwrite flag type(toml_table), intent(inout), optional :: dict dictionary of metadata private subroutine write_3d_r8_raw (array, filename, overwrite) write 3D array of float64s to disk as raw binary data Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:,:) array to write to disk character(len=*), intent(in) :: filename filename to save array as logical, intent(in) :: overwrite overwrite flag public subroutine write_data (array, filename, state, dict, overwrite) routine automatically selects which way to write out results based upon file extension Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to write out character(len=*), intent(in) :: filename filename to save array as type( settings_t ), intent(in) :: state simulation state type(toml_table), intent(inout), optional :: dict dictionary of metadata logical, intent(in), optional :: overwrite overwrite flag public subroutine write_detected_photons (dects) Arguments Type Intent Optional Attributes Name type( dect_array ), intent(in) :: dects (:) private subroutine write_hdr (u, sizes, type) write out header information for .nrrd file format Arguments Type Intent Optional Attributes Name integer, intent(in) :: u file handle integer, intent(in) :: sizes (:) dimensions of data character(len=*), intent(in) :: type data dtype","tags":"","loc":"module/writer_mod.html"},{"title":"kernels – signedMCRT","text":"Contains the main program and scattering loop. Calls all other routine to setup, run and break down the simulation. Contents Subroutines display_settings finalise pathlength_scatter setup test_kernel weight_scatter Subroutines private subroutine display_settings (state, input_file, packet, kernel_type) Displays the settings used in the current simulation run Arguments Type Intent Optional Attributes Name type( settings_t ), intent(in) :: state Simulation state character(len=*), intent(in) :: input_file Input filenname type( photon ), intent(in) :: packet Photon packet character(len=*), intent(in) :: kernel_type Kernel type to run private subroutine finalise (dict, dects, nscatt, start, history) Routine writes out simulation data, deallocates arrays and prints total runtime Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Dictionary of metadata type( dect_array ), intent(in) :: dects (:) Detector array real(kind=wp), intent(in) :: nscatt Total number of scattered photon packets real(kind=wp), intent(in) :: start Start time of simulation. Used to calculate total runtime. type( history_stack_t ), intent(in) :: history Photon histyor object public subroutine pathlength_scatter (input_file) Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: input_file private subroutine setup (input_file, tev, dects, array, packet, spectrum, dict, distances, image, nscatt, start) setup simulation by reading in setting file, and setup variables to be used. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: input_file Filename for toml settings to be used type(tevipc), intent(out) :: tev handle for communicating with TEV type( dect_array ), intent(out), allocatable :: dects (:) array of photon detectors type( sdf ), intent(out), allocatable :: array (:) array of SDF objects that create the geometry type( photon ), intent(out) :: packet photon that is to be simulated type( spectrum_t ), intent(out) :: spectrum type(toml_table), intent(out) :: dict toml table of meta-data to be written to output files. real(kind=wp), intent(out), allocatable :: distances (:) real(kind=wp), intent(out), allocatable :: image (:,:,:) real(kind=wp), intent(out) :: nscatt real(kind=wp), intent(out) :: start public subroutine test_kernel (input_file, end_early) Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: input_file logical, intent(in) :: end_early public subroutine weight_scatter (input_file) Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: input_file","tags":"","loc":"module/kernels.html"},{"title":"geometry – signedMCRT","text":"Defines a set of functions for intersecting a ray and a surface. Circle Plane Cone Cylinder Ellipse Sphere Uses constants vector_class Contents Functions intersectCircle intersectCone intersectCylinder intersectEllipse intersectPlane intersectSphere solveQuadratic Functions public function intersectCircle (n, p0, radius, l0, l, t) ref Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: n Normal to the circle type( vector ), intent(in) :: p0 a centre of the circle real(kind=wp), intent(in) :: radius Radius of the circle type( vector ), intent(in) :: l0 origin of the ray type( vector ), intent(in) :: l direction vector of the ray real(kind=wp), intent(inout) :: t Distance from l0 to the intersection point Return Value logical public function intersectCone (orig, dir, t, centre, radius, height) calculates where a line, with origin:orig and direction:dir hits a cone, radius:radius and height:height with centre:centre.\ncentre is the point under the apex at the cone's base.\nreturns true if intersection exists\nreturns t, the paramertised parameter of the line equation\nadapted from scratchapixel and pbrt\nneed to check z height after moving ray\nif not this is an infinte cone\ncone lies height ways along z-axis Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: orig origin of the ray type( vector ), intent(in) :: dir Direction vector of the ray real(kind=wp), intent(out) :: t distance from orig to the intersection point type( vector ), intent(in) :: centre Centre of the cone real(kind=wp), intent(in) :: radius Radius of the cones base real(kind=wp), intent(in) :: height Height of the cone Return Value logical public function intersectCylinder (orig, dir, t, centre, radius) calculates where a line, with origin:orig and direction:dir hits a cylinder, centre:centre and radius:radius\nThis solves for an infinitely long cylinder centered on the z axis with radius radius\nreturns true if intersection exists\nreturns t, the paramertised parameter of the line equation\nadapted from scratchapixel\nneed to check z height after moving ray\nif not this is an infinite cylinder Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: orig origin of the ray type( vector ), intent(in) :: dir Direction vector of the ray real(kind=wp), intent(out) :: t distance from orig to the intersection point type( vector ), intent(in) :: centre Centre of the cylinder real(kind=wp), intent(in) :: radius radius of the cylinder Return Value logical public function intersectEllipse (orig, dir, t, centre, semia, semib) calculates where a line, with origin:orig and direction:dir hits a ellipse, centre:centre and axii:semia, semib\nreturns true if intersection exists\nreturns t, the paramertised parameter of the line equation\nadapted from scratchapixel and pbrt\nneed to check z height after moving ray\nif not this is an infinte ellipse-cylinder\nellipse lies length ways along z-axis\nsemia and semib are the semimajor axis which are the half width and height. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: orig origin of the ray type( vector ), intent(in) :: dir Direction vector of the ray real(kind=wp), intent(out) :: t distance from orig to the intersection point type( vector ), intent(in) :: centre Centre of the ellipse real(kind=wp), intent(in) :: semia Half width of the ellipse real(kind=wp), intent(in) :: semib Half height of the ellipse Return Value logical public function intersectPlane (n, p0, l0, l, t) ref Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: n Normal to the plane type( vector ), intent(in) :: p0 a point on the plane type( vector ), intent(in) :: l0 origin of the ray type( vector ), intent(in) :: l direction vector of the ray real(kind=wp), intent(inout) :: t Distance from l0 to the intersection point Return Value logical public function intersectSphere (orig, dir, t, centre, radius) calculates where a line, with origin:orig and direction:dir hits a sphere, centre:centre and radius:radius\nreturns true if intersection exists\nreturns t, the paramertised parameter of the line equation\nadapted from scratchapixel Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: orig Origin of the ray type( vector ), intent(in) :: dir Direction vector of the ray real(kind=wp), intent(out) :: t Distance from orig to the intersection point type( vector ), intent(in) :: centre Centre of the sphere real(kind=wp), intent(in) :: radius Radius of the sphere Return Value logical private function solveQuadratic (a, b, c, x0, x1) solves quadratic equation given coeffs a, b, and c\nreturns true if real solution\nreturns x0 and x1\nadapted from scratchapixel Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a real(kind=wp), intent(in) :: b real(kind=wp), intent(in) :: c real(kind=wp), intent(out) :: x0 real(kind=wp), intent(out) :: x1 Return Value logical","tags":"","loc":"module/geometry.html"},{"title":"random – signedMCRT","text":"module provides an interface to call random_numbers and various other random distributions======= !!This module defines a set of functions that return random numbers in different distributions. !!- ran2. Returns a single float uniformly in the range [0, 1) !!- ranu. Return a single float uniformly in the range [a, b) !!- randint. Returns a single integer uniformly in the range [a, b) !!- rang. Returns a single float from a Gaussian distribution with mean avg and std sigma . !!- init_rng. Seeds the internal random number generator with a reproducible seed. Uses constants vector_class Contents Derived Types seq Functions next ran2 randint ranu Subroutines init_rng rang Derived Types type, public :: seq Sequence type for quasi-monte carlo Components Type Visibility Attributes Name Initial integer, public :: base Base from which to calculate radical inverse from. integer, public :: index Current index to get value for. Type-Bound Procedures procedure\n , public\n, :: next Function Functions private function next (this) result(res) Arguments Type Intent Optional Attributes Name class( seq ) :: this Return Value real(kind=wp) public function ran2 () result(res) wrapper for call random number Arguments None Return Value real(kind=wp) public function randint (a, b) sample a random integer between [a, b] Arguments Type Intent Optional Attributes Name integer, intent(in) :: a lower bound integer, intent(in) :: b higher bound Return Value integer public function ranu (a, b) result(res) uniformly sample in range[a, b) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a lower bound real(kind=wp), intent(in) :: b upper bound Return Value real(kind=wp) Subroutines public subroutine init_rng (input_seed, fwd) initiate RNG state with reproducible state Arguments Type Intent Optional Attributes Name integer, intent(in), optional :: input_seed (:) input seed logical, intent(in), optional :: fwd boolean that if True runs the generator for 100 steps before returning public subroutine rang (x, y, avg, sigma) sample a 2D Guassian distribution Arguments Type Intent Optional Attributes Name real(kind=wp), intent(out) :: x first value to return real(kind=wp), intent(out) :: y 2nd value to return real(kind=wp), intent(in) :: avg mean of the gaussian to sample from real(kind=wp), intent(in) :: sigma of the guassian to sample from.","tags":"","loc":"module/random.html"},{"title":"iarray – signedMCRT","text":"The iarray module contains the variables that record the fluence. These are 3D arrays, with roughly the same dimensions as the cart_grid type.\nJmean is the local fluence. JmeanGLOBAL is the global fluence grid. The global version is the one that is written to disk at the simulations end. Uses constants Contents Variables absorb absorbGLOBAL jmean jmeanGLOBAL phasor phasorGLOBAL Variables Type Visibility Attributes Name Initial real(kind=sp), public, allocatable :: absorb (:,:,:) absorption data array real(kind=sp), public, allocatable :: absorbGLOBAL (:,:,:) absorption data array real(kind=sp), public, allocatable :: jmean (:,:,:) fluence data array real(kind=sp), public, allocatable :: jmeanGLOBAL (:,:,:) fluence data array complex(kind=sp), public, allocatable :: phasor (:,:,:) phase data array complex(kind=sp), public, allocatable :: phasorGLOBAL (:,:,:) phase data array","tags":"","loc":"module/iarray.html"},{"title":"constants – signedMCRT","text":"This module contains mathematical constants and strings that contain the various directories used by the program.\n Math constants:\n - PI\n - 2 PI\n - wp (working precision of the whole program). Default is double precision (64bit floats)\n Directories:\n - homedir. Root directory of this code\n - fileplace. data folder directory\n - resdir. holds the path to the directory that holds the parameter and other associated input files Uses iso_fortran_env Contents Variables CHANCE PI THRESHOLD TWOPI dp fileplace homedir resdir sp wp Variables Type Visibility Attributes Name Initial real(kind=wp), public, parameter :: CHANCE = 0.1_wp Proportion of packet that survive roulette real(kind=wp), public, parameter :: PI = 4._wp*atan(1._wp) real(kind=wp), public, parameter :: THRESHOLD = 0.01_wp Weight threshold for roulette real(kind=wp), public, parameter :: TWOPI = 2._wp*PI integer, public, parameter :: dp = real64 double precision variable. character(len=255), public :: fileplace place where output files are saved character(len=255), public :: homedir root directory character(len=255), public :: resdir directory to input files integer, public, parameter :: sp = real32 single precision variable. integer, public, parameter :: wp = real64 current working precision","tags":"","loc":"module/constants.html"},{"title":"parse_mod – signedMCRT","text":"Module contains all routines related to parsing the input toml config files.\nSee config for details of toml input file. Uses constants tomlf vector_class tomlf_error Contents Functions get_vector Subroutines handle_annulus_dect handle_camera handle_circle_dect parse_detectors parse_geometry parse_grid parse_output parse_params parse_simulation parse_source parse_spectrum Functions private function get_vector (child, key, error, context, default) Vector helper function for parsing toml Arguments Type Intent Optional Attributes Name type(toml_table), intent(in), pointer :: child Input Toml entry to read character(len=*), intent(in) :: key Key to read type(toml_error), intent(out), allocatable :: error type(toml_context), intent(in) :: context Context handle for error reporting type( vector ), intent(in), optional :: default Default value to assign Return Value type( vector ) Subroutines private subroutine handle_annulus_dect (child, dects, counts, context, error) Read in Annulus_detector settings and initalise variable Arguments Type Intent Optional Attributes Name type(toml_table), intent(in), pointer :: child type( annulus_dect ), intent(inout) :: dects (:) integer, intent(inout) :: counts type(toml_context), intent(in) :: context type(toml_error), intent(out), allocatable :: error private subroutine handle_camera (child, dects, counts, context, error) Read in Camera settings and initalise variable Arguments Type Intent Optional Attributes Name type(toml_table), intent(in), pointer :: child type( camera ), intent(inout) :: dects (:) integer, intent(inout) :: counts type(toml_context), intent(in) :: context Context handle for error reporting. type(toml_error), intent(out), allocatable :: error private subroutine handle_circle_dect (child, dects, counts, context, error) Read in Circle_detector settings and initalise variable Arguments Type Intent Optional Attributes Name type(toml_table), intent(in), pointer :: child type( circle_dect ), intent(inout) :: dects (:) integer, intent(inout) :: counts type(toml_context), intent(in) :: context type(toml_error), intent(out), allocatable :: error private subroutine parse_detectors (table, dects, context, error) parse the detectors Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type( dect_array ), allocatable :: dects (:) Detector array to be filled. type(toml_context), intent(in) :: context Context handle for error reporting. type(toml_error), intent(out), allocatable :: error private subroutine parse_geometry (table, dict, error) parse geometry information Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type(toml_table), intent(inout) :: dict Dictonary used to store metadata type(toml_error), intent(out), allocatable :: error private subroutine parse_grid (table, dict, error) parse grid input data Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type(toml_table), intent(inout) :: dict Dictonary used to store metadata type(toml_error), intent(out), allocatable :: error private subroutine parse_output (table, error) parse output file information Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type(toml_error), intent(out), allocatable :: error public subroutine parse_params (filename, packet, dects, spectrum, dict, error) entry point for parsing toml file Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: filename filename of input toml file type( photon ), intent(out) :: packet some input options set up data in the photon class type( dect_array ), intent(out), allocatable :: dects (:) detector array which is setup during parsing type( spectrum_t ), intent(out) :: spectrum spectrum type which is set up during parsing type(toml_table), intent(inout) :: dict dictionary that stores potential metadata to be saved with simulation output type(toml_error), intent(out), allocatable :: error Last error raised during parsing. Unallocated if no error raised. Need to handle this on return from parse_params. private subroutine parse_simulation (table, error) parse simulation information Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type(toml_error), intent(out), allocatable :: error private subroutine parse_source (table, packet, dict, spectrum, context, error) Parse sources\nany updates here MUST be reflected in docs/config.md Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type( photon ), intent(out) :: packet Photon packet. Used to store information to save computation type(toml_table), intent(inout) :: dict Dictonary used to store metadata type( spectrum_t ), intent(out) :: spectrum Spectrum type. type(toml_context) :: context Context handle for error reporting type(toml_error), intent(out), allocatable :: error Error message private subroutine parse_spectrum (table, spectrum, dict, context, error) Parse spectrums to be used Arguments Type Intent Optional Attributes Name type(toml_table), pointer :: table type( spectrum_t ), intent(out) :: spectrum type(toml_table), intent(inout) :: dict type(toml_context) :: context type(toml_error), intent(out), allocatable :: error","tags":"","loc":"module/parse_mod.html"},{"title":"vec4_class – signedMCRT","text":"Vector4 class module. Defines a vector4 type (x, y, z, p) and associated operations on vectors and other types. Uses constants Contents Interfaces sin vec4 Derived Types vec4 Functions init_vec4_vector_real length magnitude_fn scal_add_vec scal_minus_vec scal_mult_vec sin_vec vec_add_scal vec_add_vec vec_div_scal_int vec_div_scal_r4 vec_div_scal_r8 vec_dot_vec vec_minus_scal vec_minus_vec vec_mult_scal vec_mult_vec Interfaces public interface sin Vec4 overload of the sin intrinsic private pure elemental function sin_vec (p) Sine of a vec4, elementwise Arguments Type Intent Optional Attributes Name type( vec4 ), intent(in) :: p Input vec4 Return Value type( vec4 ) public interface vec4 Initalise a vec4 from a vec3 and a scalar private function init_vec4_vector_real (vec, val) result(out) Initalise vec4 from a vec3 and Scalar\ne.g vec4 = [vec3%x, vec3%y, vec3%z, scalar] Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: vec Input vec3 real(kind=wp), intent(in) :: val Input Scalar Return Value type( vec4 ) Derived Types type, public :: vec4 not fully implmented vec4 class Components Type Visibility Attributes Name Initial real(kind=wp), public :: p vec4 components real(kind=wp), public :: x vec4 components real(kind=wp), public :: y vec4 components real(kind=wp), public :: z vec4 components Constructor Initalise a vec4 from a vec3 and a scalar private\n\n \n function init_vec4_vector_real (vec, val) Initalise vec4 from a vec3 and Scalar\ne.g vec4 = [vec3%x, vec3%y, vec3%z, scalar] Type-Bound Procedures procedure\n , public\n, :: length Function procedure\n , public\n, :: magnitude => magnitude_fn Function generic,\n public\n, :: operator(*) => vec_mult_vec , vec_mult_scal , scal_mult_vec Overloaded Mulitiplication operator generic,\n public\n, :: operator(+) => vec_add_vec , vec_add_scal , scal_add_vec Overloaded Addition operator generic,\n public\n, :: operator(-) => vec_minus_vec , vec_minus_scal , scal_minus_vec Overloaded Subtraction operator generic,\n public\n, :: operator(.dot.) => vec_dot_vec .dot. operator generic,\n public\n, :: operator(/) => vec_div_scal_r4 , vec_div_scal_r8 , vec_div_scal_int Overloaded Division operator procedure\n , private\n, pass(b) :: scal_add_vec Function procedure\n , private\n, pass(b) :: scal_minus_vec Function procedure\n , private\n, pass(b) :: scal_mult_vec Function procedure\n , private\n, pass(a) :: vec_add_scal Function procedure\n , private\n, pass(a) :: vec_add_vec Function procedure\n , private\n, pass(a) :: vec_div_scal_int Function procedure\n , private\n, pass(a) :: vec_div_scal_r4 Function procedure\n , private\n, pass(a) :: vec_div_scal_r8 Function procedure\n , private\n, pass(a) :: vec_dot_vec Function procedure\n , private\n, pass(a) :: vec_minus_scal Function procedure\n , private\n, pass(a) :: vec_minus_vec Function procedure\n , private\n, pass(a) :: vec_mult_scal Function procedure\n , private\n, pass(a) :: vec_mult_vec Function Functions private function init_vec4_vector_real (vec, val) result(out) Initalise vec4 from a vec3 and Scalar\ne.g vec4 = [vec3%x, vec3%y, vec3%z, scalar] Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: vec Input vec3 real(kind=wp), intent(in) :: val Input Scalar Return Value type( vec4 ) private pure elemental function length (this) Returns the length of a vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: this Return Value real(kind=wp) private pure elemental function magnitude_fn (this) Returns the magnitude of a vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: this Return Value type( vec4 ) private pure elemental function scal_add_vec (a, b) Elementwise scalar + vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to add class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) private pure elemental function scal_minus_vec (a, b) Elementwise Scalar - vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to subtract class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) private pure elemental function scal_mult_vec (a, b) Elementwise Scalar * vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) private pure elemental function sin_vec (p) Sine of a vec4, elementwise Arguments Type Intent Optional Attributes Name type( vec4 ), intent(in) :: p Input vec4 Return Value type( vec4 ) private pure elemental function vec_add_scal (a, b) Elementwise vec4 + scalar Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to add Return Value type( vec4 ) private pure elemental function vec_add_vec (a, b) Elementwise vec4 + vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to add Return Value type( vec4 ) private pure elemental function vec_div_scal_int (a, b) Elementwise vec4 / Scalar. Scalar is an integer Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 integer, intent(in) :: b Scalar to divide by Return Value type( vec4 ) private pure elemental function vec_div_scal_r4 (a, b) Elementwise vec4 / Scalar. Scalar is 32-bit float Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=sp), intent(in) :: b Scalar to divide by Return Value type( vec4 ) private pure elemental function vec_div_scal_r8 (a, b) Elementwise vec4 / Scalar. Scalar is 32-bit float Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=dp), intent(in) :: b Scalar to divide by Return Value type( vec4 ) private pure elemental function vec_dot_vec (a, b) result(dot) dot product between two vec4s Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to dot with Return Value real(kind=wp) private pure elemental function vec_minus_scal (a, b) Elementwise vec4 - scalar Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( vec4 ) private pure elemental function vec_minus_vec (a, b) Elementwise vec4 - vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to subtract Return Value type( vec4 ) private pure elemental function vec_mult_scal (a, b) Elementwise vec4 * Scalar Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( vec4 ) private pure elemental function vec_mult_vec (a, b) Elementwise vec4 * vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to multiply by Return Value type( vec4 )","tags":"","loc":"module/vec4_class.html"},{"title":"gridMod – signedMCRT","text":"This module defines the cartesian grid type (cart_grid) and associated routines. The cart_grid type contains information related to the grid used to record the fluence. This includes the number of voxels in each cardinal direction (nxg, nyg, nzg), the half size of the grid in each direction (xmax, ymax, zmax), and the locations of the voxels walls in each direction (xface, yface, zface).\nThe type-bound function get_voxel takes a position (vector) and returns the voxel the position falls in. Init_grid initialises a cart_grid instance. Grid class Uses constants Contents Interfaces cart_grid Derived Types cart_grid Functions get_voxel init_grid Interfaces public interface cart_grid public function init_grid (nxg, nyg, nzg, xmax, ymax, zmax) setup grid Arguments Type Intent Optional Attributes Name integer, intent(in) :: nxg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nyg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nzg number of voxels in each cardinal direction for fluence grid real(kind=wp), intent(in) :: xmax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: ymax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: zmax half size of each dimension in fluence grid. Return Value type( cart_grid ) Derived Types type, public :: cart_grid Components Type Visibility Attributes Name Initial real(kind=wp), public :: delta Delta is the round off for near voxel cell walls integer, public :: nxg number of voxels in each cardinal direction for fluence grid integer, public :: nyg number of voxels in each cardinal direction for fluence grid integer, public :: nzg number of voxels in each cardinal direction for fluence grid real(kind=wp), public, allocatable :: xface (:) position of each cell wall in fluence grid real(kind=wp), public :: xmax half size of each dimension in fluence grid. real(kind=wp), public, allocatable :: yface (:) position of each cell wall in fluence grid real(kind=wp), public :: ymax half size of each dimension in fluence grid. real(kind=wp), public, allocatable :: zface (:) position of each cell wall in fluence grid real(kind=wp), public :: zmax half size of each dimension in fluence grid. Constructor public\n\n \n function init_grid (nxg, nyg, nzg, xmax, ymax, zmax) setup grid Type-Bound Procedures procedure\n , public\n, :: get_voxel Function Functions private function get_voxel (this, pos) result(res) get current voxel the photon packet is in Arguments Type Intent Optional Attributes Name class( cart_grid ) :: this grid class type( vector ), intent(in) :: pos current vector position of photon packet Return Value integer, (3) public function init_grid (nxg, nyg, nzg, xmax, ymax, zmax) setup grid Arguments Type Intent Optional Attributes Name integer, intent(in) :: nxg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nyg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nzg number of voxels in each cardinal direction for fluence grid real(kind=wp), intent(in) :: xmax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: ymax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: zmax half size of each dimension in fluence grid. Return Value type( cart_grid )","tags":"","loc":"module/gridmod.html"},{"title":"inttau2 – signedMCRT","text":"inttau2 is the heart of the MCRT simulation. It moves the photons though the simulated media.\ntauint2 is the only public function here and is the main function that moves the photon.\nChanges should only be made here if bugs are discovered or new methods of tracking photons (i.e phase tracking) or moving photons (i.e new geometry method) is needed. Uses constants Contents Functions find wall_dist Subroutines tauint2 update_grids update_pos update_voxels Functions private function find (val, a) searches for bracketing indices for a value value in an array a Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val value to find in array real(kind=wp), intent(in) :: a (:) array to find val in Return Value integer private function wall_dist (grid, celli, cellj, cellk, pos, dir, ldir) result(res) funtion that returns distant to nearest wall and which wall that is (x, y, or z) Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid integer, intent(inout) :: celli integer, intent(inout) :: cellj integer, intent(inout) :: cellk type( vector ), intent(in) :: pos type( vector ), intent(in) :: dir logical, intent(inout) :: ldir (:) Return Value real(kind=wp) Subroutines public subroutine tauint2 (grid, packet, sdfs_array) optical depth integration subroutine\nMoves photons to interaction location\nCalculated is any reflection or refraction happens whilst moving Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid type( photon ), intent(inout) :: packet type( sdf ), intent(in) :: sdfs_array (:) private subroutine update_grids (grid, pos, dir, d_sdf, packet, mua) record fluence using path length estimators. Uses voxel grid Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid grid stores voxel grid information (voxel walls and etc) type( vector ), intent(inout) :: pos pos is current position with origin in centre of medium (0,0,0) type( vector ), intent(in) :: dir dir is the current direction (0,0,1) is up real(kind=wp), intent(in) :: d_sdf d_sdf is the distance to travel in voxel grid type( photon ), intent(inout) :: packet packet stores the photon related variables real(kind=wp), intent(in), optional :: mua absoprtion coefficent private subroutine update_pos (grid, pos, celli, cellj, cellk, dcell, wall_flag, dir, ldir, delta) routine that updates positions of photon and calls Fresnel routines if photon leaves current voxel Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid type( vector ), intent(inout) :: pos integer, intent(inout) :: celli integer, intent(inout) :: cellj integer, intent(inout) :: cellk real(kind=wp), intent(in) :: dcell logical, intent(in) :: wall_flag type( vector ), intent(in) :: dir logical, intent(in) :: ldir (:) real(kind=wp), intent(in) :: delta public subroutine update_voxels (grid, pos, celli, cellj, cellk) updates the current voxel based upon position Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid grid type( vector ), intent(in) :: pos current photon packet position integer, intent(inout) :: celli position of photon packet in grid integer, intent(inout) :: cellj position of photon packet in grid integer, intent(inout) :: cellk position of photon packet in grid","tags":"","loc":"module/inttau2.html"},{"title":"opticalProperties – signedMCRT","text":"module implments the optical property abstract type and the types that inheirt from it\nabstract optical property type Uses piecewiseMod constants Contents Interfaces mono opticalProp_t spectral Abstract Interfaces updateInterface Derived Types mono opticalProp_base opticalProp_t spectral Functions init_mono init_spectral opticaProp_new Subroutines opticalProp_t_assign updateMono updateSpectral update_opticalProp_t Interfaces public interface mono private function init_mono (mus, mua, hgg, n) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: mus real(kind=wp), intent(in) :: mua real(kind=wp), intent(in) :: hgg real(kind=wp), intent(in) :: n Return Value type( mono ) public interface opticalProp_t private function opticaProp_new (rhs) result(lhs) Arguments Type Intent Optional Attributes Name class( opticalProp_base ), intent(in) :: rhs Return Value type( opticalProp_t ) public interface spectral private function init_spectral (mus, mua, hgg, n, flux) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), allocatable :: mus (:,:) real(kind=wp), intent(in), allocatable :: mua (:,:) real(kind=wp), intent(in), allocatable :: hgg (:,:) real(kind=wp), intent(in), allocatable :: n (:,:) real(kind=wp), intent(in), allocatable :: flux (:,:) Return Value type( spectral ) Abstract Interfaces abstract interface public subroutine updateInterface(this, wavelength) Arguments Type Intent Optional Attributes Name class( opticalProp_base ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength Derived Types type, public, extends( opticalProp_base ) :: mono Components Type Visibility Attributes Name Initial real(kind=wp), public :: albedo real(kind=wp), public :: g2 g factor squared real(kind=wp), public :: hgg g factor real(kind=wp), public :: kappa real(kind=wp), public :: mua absoprtion coeff. real(kind=wp), public :: mus scattering coeff. real(kind=wp), public :: n refractive index Constructor private\n\n \n function init_mono (mus, mua, hgg, n) Type-Bound Procedures procedure\n , public\n, :: update => updateMono Subroutine type, public :: opticalProp_base Components Type Visibility Attributes Name Initial real(kind=wp), public :: albedo real(kind=wp), public :: g2 g factor squared real(kind=wp), public :: hgg g factor real(kind=wp), public :: kappa real(kind=wp), public :: mua absoprtion coeff. real(kind=wp), public :: mus scattering coeff. real(kind=wp), public :: n refractive index Type-Bound Procedures procedure\n(updateInterface) , public\n :: update type, public, extends( opticalProp_base ) :: opticalProp_t Components Type Visibility Attributes Name Initial real(kind=wp), public :: albedo real(kind=wp), public :: g2 g factor squared real(kind=wp), public :: hgg g factor real(kind=wp), public :: kappa real(kind=wp), public :: mua absoprtion coeff. real(kind=wp), public :: mus scattering coeff. real(kind=wp), public :: n refractive index class( opticalProp_base ), public, allocatable :: value Constructor private\n\n \n function opticaProp_new (rhs) Type-Bound Procedures generic,\n public\n, :: assignment(=) => opticalProp_t_assign procedure\n , private\n :: opticalProp_t_assign Subroutine procedure\n , public\n, :: update => update_opticalProp_t Subroutine type, public, extends( opticalProp_base ) :: spectral Components Type Visibility Attributes Name Initial real(kind=wp), public :: albedo type( piecewise1D ), private :: flux real(kind=wp), public :: g2 g factor squared real(kind=wp), public :: hgg g factor type( piecewise1D ), private :: hgg_a real(kind=wp), public :: kappa real(kind=wp), public :: mua absoprtion coeff. type( piecewise1D ), private :: mua_a real(kind=wp), public :: mus scattering coeff. type( piecewise1D ), private :: mus_a real(kind=wp), public :: n refractive index type( piecewise1D ), private :: n_a Constructor private\n\n \n function init_spectral (mus, mua, hgg, n, flux) Type-Bound Procedures procedure\n , public\n, :: update => updateSpectral Subroutine Functions private function init_mono (mus, mua, hgg, n) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: mus real(kind=wp), intent(in) :: mua real(kind=wp), intent(in) :: hgg real(kind=wp), intent(in) :: n Return Value type( mono ) private function init_spectral (mus, mua, hgg, n, flux) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), allocatable :: mus (:,:) real(kind=wp), intent(in), allocatable :: mua (:,:) real(kind=wp), intent(in), allocatable :: hgg (:,:) real(kind=wp), intent(in), allocatable :: n (:,:) real(kind=wp), intent(in), allocatable :: flux (:,:) Return Value type( spectral ) private function opticaProp_new (rhs) result(lhs) Arguments Type Intent Optional Attributes Name class( opticalProp_base ), intent(in) :: rhs Return Value type( opticalProp_t ) Subroutines private subroutine opticalProp_t_assign (lhs, rhs) Arguments Type Intent Optional Attributes Name class( opticalProp_t ), intent(inout) :: lhs class( opticalProp_base ), intent(in) :: rhs private subroutine updateMono (this, wavelength) Arguments Type Intent Optional Attributes Name class( mono ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength private subroutine updateSpectral (this, wavelength) Arguments Type Intent Optional Attributes Name class( spectral ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength private subroutine update_opticalProp_t (this, wavelength) Arguments Type Intent Optional Attributes Name class( opticalProp_t ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength","tags":"","loc":"module/opticalproperties.html"},{"title":"piecewiseMod – signedMCRT","text":"This file contains the piecewise abstract type, for sampling from constants, 1D or 2D arrays. Inspired by PBRT piecewise class.\nCurrently, the following public types are defined: Constant. Used in the case where there is only one value. 1D. Used in the case where there is a spectrum 2D. Used in the case where SLM or other image based source types are needed. The piecewise type ensures that there is a method (sample) that can be called on all inherited types, e.g\ncall 2Dimage%p%sample(x, y)\nwill return a position (x,y) from where to release a photon.\nThis class can be used to have multi-spectral or single valued wavelength, or used as a 2D image input source i.e SLMs.\nNOTE: optical properties are not currently adjusted on wavelength change. Uses constants iso_fortran_env Contents Interfaces piecewise1D piecewise2D Abstract Interfaces sampleInterface Derived Types constant piecewise piecewise1D piecewise2D spectrum_t Functions init_piecewise1D init_piecewise2D nextpwr2 pack_bits Subroutines decode getValue sample1D sample2D search_1D search_2D Interfaces public interface piecewise1D public function init_piecewise1D (array) result(res) initalise the piecewise1D type with an array size (n, 2). Calculates the CDF of this array.\nInput array Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:) Return Value type( piecewise1D ) public interface piecewise2D public function init_piecewise2D (cell_width, cell_height, image) Initalise the piecewise2D type with a given cell_width, cell_height and input image Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: cell_width Input cell width real(kind=wp), intent(in) :: cell_height Input cell height real(kind=wp), intent(in) :: image (:,:) Input image Return Value type( piecewise2D ) Abstract Interfaces abstract interface public subroutine sampleInterface(this, x, y, value) Arguments Type Intent Optional Attributes Name class( piecewise ), intent(in) :: this real(kind=wp), intent(out) :: x real(kind=wp), intent(out) :: y real(kind=wp), intent(in), optional :: value Derived Types type, public, extends( piecewise ) :: constant Constant piecewise type. i.e a piecewise function that does not change value Components Type Visibility Attributes Name Initial real(kind=wp), public :: value The constant value Type-Bound Procedures procedure\n , public\n, :: sample => getValue Subroutine Sampling routine type, public :: piecewise Abstract spectrum base type. Type-Bound Procedures procedure\n(sampleInterface) , public\n :: sample Deferred procdure. Used to generate a sample from spectrum or get constant value etc. type, public, extends( piecewise ) :: piecewise1D 1D piecewise type. Used for the spectral type Components Type Visibility Attributes Name Initial real(kind=wp), public, allocatable :: array (:,:) Input array to sample from. Should be size(n, 2). 1st column is x-axis, 2nd column is y-axis real(kind=wp), public, allocatable :: cdf (:) cumulative distribution function (CDF) of array. Constructor public\n\n \n function init_piecewise1D (array) initalise the piecewise1D type with an array size (n, 2). Calculates the CDF of this array.\nInput array Type-Bound Procedures procedure\n , public\n, :: sample => sample1D Subroutine Overloaded sampling function type, public, extends( piecewise ) :: piecewise2D 2D piecewise type. Used for images Components Type Visibility Attributes Name Initial real(kind=wp), public, allocatable :: cdf (:) cumulative distribution function (CDF) of array. real(kind=wp), public :: cell_height Height of each cell real(kind=wp), public :: cell_width Width of each cell integer, private :: xoffset Offsets integer, private :: yoffset Offsets Constructor public\n\n \n function init_piecewise2D (cell_width, cell_height, image) Initalise the piecewise2D type with a given cell_width, cell_height and input image Type-Bound Procedures procedure\n , public\n, :: sample => sample2D Subroutine Overloaded sampling function type, public :: spectrum_t Spectrum_t type. Used as a container type Components Type Visibility Attributes Name Initial class( piecewise ), public, pointer :: p => null() Functions public function init_piecewise1D (array) result(res) initalise the piecewise1D type with an array size (n, 2). Calculates the CDF of this array.\nInput array Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:) Return Value type( piecewise1D ) public function init_piecewise2D (cell_width, cell_height, image) Initalise the piecewise2D type with a given cell_width, cell_height and input image Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: cell_width Input cell width real(kind=wp), intent(in) :: cell_height Input cell height real(kind=wp), intent(in) :: image (:,:) Input image Return Value type( piecewise2D ) public function nextpwr2 (v) result(res) Get the next power of 2. i.e given 5 will return 8 (4^2)\nonly works on 32bit ints ref Arguments Type Intent Optional Attributes Name integer, intent(in) :: v Return Value integer public function pack_bits (z) result(x) Reverse the split function. I.e go from 0a0b0c0d to abcd\nAdapted from archer2 cpp course Arguments Type Intent Optional Attributes Name integer(kind=int64), intent(in) :: z Input interleaved integer Return Value integer(kind=int64) Subroutines public subroutine decode (z, x, y) Compute the 2 indices from a Morton index\nAdapted from archer2 cpp course Arguments Type Intent Optional Attributes Name integer(kind=int64), intent(in) :: z Morton Index integer(kind=int32), intent(out) :: x The computed indices integer(kind=int32), intent(out) :: y The computed indices public subroutine getValue (this, x, y, value) The constant version of sample Arguments Type Intent Optional Attributes Name class( constant ), intent(in) :: this real(kind=wp), intent(out) :: x Output value real(kind=wp), intent(out) :: y Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D real(kind=wp), intent(in), optional :: value Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D public subroutine sample1D (this, x, y, value) Randomly sample from 1D array Arguments Type Intent Optional Attributes Name class( piecewise1D ), intent(in) :: this real(kind=wp), intent(out) :: x Return value real(kind=wp), intent(out) :: y Not used, but here so we can have same interface as 2D sample routine. real(kind=wp), intent(in), optional :: value Optional x value. If not present we generate a random one in the range [0., 1.] public subroutine sample2D (this, x, y, value) Arguments Type Intent Optional Attributes Name class( piecewise2D ), intent(in) :: this real(kind=wp), intent(out) :: x real(kind=wp), intent(out) :: y real(kind=wp), intent(in), optional :: value public subroutine search_1D (array, nlow, value) search by bisection for 1D array Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:) Array to search integer(kind=int64), intent(out) :: nlow index of found value real(kind=wp), intent(in) :: value value to find in 1D array public subroutine search_2D (array, nlow, value) search by bisection for 1D array Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:) 2D array to search. Only searches 1st column integer(kind=int64), intent(out) :: nlow Index of found index real(kind=wp), intent(in) :: value Value to find in the array.","tags":"","loc":"module/piecewisemod.html"},{"title":"detectors – signedMCRT","text":"Module contains each detector type which inherits from the base detector class.\ndetectors detect photon packets colliding with the detectors. Uses detector_mod vector_class constants Contents Interfaces annulus_dect camera circle_dect Derived Types annulus_dect camera circle_dect dect_array Functions check_hit_annulus check_hit_camera check_hit_circle init_annulus_dect init_camera init_circle_dect Interfaces public interface annulus_dect private function init_annulus_dect (pos, dir, layer, r1, r2, nbins, maxval, trackHistory) result(out) Initalise Annular detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: r1 Inner radius real(kind=wp), intent(in) :: r2 Outer radius integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( annulus_dect ) public interface camera private function init_camera (p1, p2, p3, layer, nbins, maxval, trackHistory) result(out) Initalise Camera detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: p1 Position of the 1st corner of the detector type( vector ), intent(in) :: p2 Distance from p1 to the 2nd corner type( vector ), intent(in) :: p3 Distance from p1 to the 3rd corner integer, intent(in) :: layer Layer ID integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( camera ) public interface circle_dect private function init_circle_dect (pos, dir, layer, radius, nbins, maxval, trackHistory) result(out) Initalise Circle detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: radius Radius of the detector integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( circle_dect ) Derived Types type, public, extends( detector1D ) :: annulus_dect Annuluar detector Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid Bin width real(kind=wp), public, allocatable :: data (:) Bins type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector integer, public :: nbins Number of bins type( vector ), public :: pos position of the detector real(kind=wp), public :: r1 Inner radius real(kind=wp), public :: r2 Outer radius logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Constructor private\n\n \n function init_annulus_dect (pos, dir, layer, r1, r2, nbins, maxval, trackHistory) Initalise Annular detector Type-Bound Procedures procedure\n , public\n, :: check_hit => check_hit_annulus Function procedure\n , public\n, :: record_hit => record_hit_1D_sub Subroutine type, public, extends( detector2D ) :: camera Rectangular or \"camera\" detector Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid_x Bin width in the x dimension real(kind=wp), public :: bin_wid_y Bin width in the y dimension real(kind=wp), public, allocatable :: data (:,:) Bins type( vector ), public :: dir Surface normal of the detector type( vector ), public :: e1 Edge vector of detector type( vector ), public :: e2 Edge vector of detector real(kind=wp), public :: height Height of the detector integer, public :: layer Layer ID of the detector type( vector ), public :: n Normal of the detector integer, public :: nbinsX Number of bins in x dimension (detector space) integer, public :: nbinsY Number of bins in y dimension (detector space) type( vector ), public :: p2 Vector from pos (1st corner) to the 2nd corner of the detector type( vector ), public :: p3 Vector from pos (1st corner) to the 3rd corner of the detector type( vector ), public :: pos position of the detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. real(kind=wp), public :: width Width of the detector Constructor private\n\n \n function init_camera (p1, p2, p3, layer, nbins, maxval, trackHistory) Initalise Camera detector Type-Bound Procedures procedure\n , public\n, :: check_hit => check_hit_camera Function procedure\n , public\n, :: record_hit => record_hit_2D_sub Subroutine type, public, extends( detector1D ) :: circle_dect Circle detector Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid Bin width real(kind=wp), public, allocatable :: data (:) Bins type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector integer, public :: nbins Number of bins type( vector ), public :: pos position of the detector real(kind=wp), public :: radius Radius of detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Constructor private\n\n \n function init_circle_dect (pos, dir, layer, radius, nbins, maxval, trackHistory) Initalise Circle detector Type-Bound Procedures procedure\n , public\n, :: check_hit => check_hit_circle Function procedure\n , public\n, :: record_hit => record_hit_1D_sub Subroutine type, public :: dect_array Detector array Components Type Visibility Attributes Name Initial class( detector ), public, pointer :: p => null() Functions private function check_hit_annulus (this, hitpoint) Check if a hitpoint is in the annulus Arguments Type Intent Optional Attributes Name class( annulus_dect ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Hitpoint to check Return Value logical private function check_hit_camera (this, hitpoint) Check if a hitpoint is in the camera detector ref Arguments Type Intent Optional Attributes Name class( camera ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Hitpoint to check Return Value logical private function check_hit_circle (this, hitpoint) Check if a hitpoint is in the circle Arguments Type Intent Optional Attributes Name class( circle_dect ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Hitpoint to check Return Value logical private function init_annulus_dect (pos, dir, layer, r1, r2, nbins, maxval, trackHistory) result(out) Initalise Annular detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: r1 Inner radius real(kind=wp), intent(in) :: r2 Outer radius integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( annulus_dect ) private function init_camera (p1, p2, p3, layer, nbins, maxval, trackHistory) result(out) Initalise Camera detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: p1 Position of the 1st corner of the detector type( vector ), intent(in) :: p2 Distance from p1 to the 2nd corner type( vector ), intent(in) :: p3 Distance from p1 to the 3rd corner integer, intent(in) :: layer Layer ID integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( camera ) private function init_circle_dect (pos, dir, layer, radius, nbins, maxval, trackHistory) result(out) Initalise Circle detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: radius Radius of the detector integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( circle_dect )","tags":"","loc":"module/detectors.html"},{"title":"detector_mod – signedMCRT","text":"Module contains photon detector abstract class and the derived types the inherit from it\nnot fully implmented Uses constants vector_class Contents Interfaces hit_t Abstract Interfaces checkHitInterface recordHitInterface Derived Types detector detector1D detector2D hit_t Functions hit_init Subroutines record_hit_1D_sub record_hit_2D_sub Interfaces public interface hit_t private function hit_init (val) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val Return Value type( hit_t ) Abstract Interfaces abstract interface public function checkHitInterface(this, hitpoint) Arguments Type Intent Optional Attributes Name class( detector ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Return Value logical abstract interface public subroutine recordHitInterface(this, hitpoint, history) Arguments Type Intent Optional Attributes Name class( detector ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint type( history_stack_t ), intent(inout) :: history Derived Types type, public :: detector abstract detector Components Type Visibility Attributes Name Initial type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector type( vector ), public :: pos position of the detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Type-Bound Procedures procedure\n(checkHitInterface) , public\n :: check_hit procedure\n(recordHitInterface) , public\n :: record_hit type, public, extends( detector ) :: detector1D 1D detector type. Records linear information Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid Bin width real(kind=wp), public, allocatable :: data (:) Bins type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector integer, public :: nbins Number of bins type( vector ), public :: pos position of the detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Type-Bound Procedures procedure\n(checkHitInterface) , public\n :: check_hit procedure\n , public\n, :: record_hit => record_hit_1D_sub Subroutine type, public, extends( detector ) :: detector2D 2D detecctor type. Records spatial information Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid_x Bin width in the x dimension real(kind=wp), public :: bin_wid_y Bin width in the y dimension real(kind=wp), public, allocatable :: data (:,:) Bins type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector integer, public :: nbinsX Number of bins in x dimension (detector space) integer, public :: nbinsY Number of bins in y dimension (detector space) type( vector ), public :: pos position of the detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Type-Bound Procedures procedure\n(checkHitInterface) , public\n :: check_hit procedure\n , public\n, :: record_hit => record_hit_2D_sub Subroutine type, public :: hit_t Hit type, which records possible interaction information Components Type Visibility Attributes Name Initial type( vector ), public :: dir Direction the photon came from integer, public :: layer Layer ID of interaction type( vector ), public :: pos Poition of the interaction real(kind=wp), public :: value Value to deposit Constructor private\n\n \n function hit_init (val) Functions private function hit_init (val) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val Return Value type( hit_t ) Subroutines private subroutine record_hit_1D_sub (this, hitpoint, history) check if a hit is on the detector and record it if so Arguments Type Intent Optional Attributes Name class( detector1D ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Interaction information type( history_stack_t ), intent(inout) :: history Photon packet history private subroutine record_hit_2D_sub (this, hitpoint, history) check if a hit is on the detector and record it if so Arguments Type Intent Optional Attributes Name class( detector2D ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Interaction information type( history_stack_t ), intent(inout) :: history Photon packet history","tags":"","loc":"module/detector_mod.html"},{"title":"sdfs – signedMCRT","text":"This module defines the signed distance function (SDF) abstract type and all types that inherit from it.\nThe SDF abstract type defines the optical properties of an SDF (mus, mua, kappa, albedo, hgg, g2,and n), as well as a transform (4x4 matrix), and the layer ID code of the SDF.\nThe SDF abstract type also provides an abstract interface (evaluate) which each inheriting function must implement. This evaluate function is the heart of the SDF implementation.\nEach individual evaluate is the direct implementation of that SDF, e.g. that function defines the mathematical SDF.\nFor more information on SDFs, check out Inigo Quilez's website from which most of the below SDFs and transforms have been taken. cylinder sphere box torus cone triprism (triangular prism) capsule plane segment egg This is the module the user should import to other module not sdf_base! Uses sdfHelpers opticalProperties vector_class constants sdf_baseMod Contents Interfaces box capsule cone cylinder egg plane segment sphere torus triprism Derived Types box capsule cone cylinder egg plane segment sphere torus triprism Functions box_init capsule_init cone_init cylinder_init egg_init evaluate_box evaluate_capsule evaluate_cone evaluate_cylinder evaluate_egg evaluate_plane evaluate_segment evaluate_sphere evaluate_torus evaluate_triprism plane_init segment_init sphere_init torus_init triprism_init Interfaces public interface box Interface to box SDF initialising function private function box_init (lengths, optProp, layer, transform) result(out) Initalising function for Box SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: lengths Lengths of each dimension of the box type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( box ) public interface capsule Interface to capsule SDF initialising function private function capsule_init (a, b, r, optProp, layer, transform) result(out) Initalising function for capsule SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Capsule startpoint type( vector ), intent(in) :: b Capsule endpoint real(kind=wp), intent(in) :: r Capsule radius type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( capsule ) public interface cone Interface to cone SDF initialising function private function cone_init (a, b, ra, rb, optProp, layer, transform) result(out) Initalising function for Capped Cone SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Centre of base of Cone type( vector ), intent(in) :: b Tip of cone real(kind=wp), intent(in) :: ra Radius of Cones base real(kind=wp), intent(in) :: rb Radius of Cones tip. For rb = 0.0 get normal uncapped cone. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cone ) public interface cylinder Interface to cylinder SDF initialising function private function cylinder_init (a, b, radius, optProp, layer, transform) result(out) Initalising function for Cylinder SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Vector position at centre of the bottom circle type( vector ), intent(in) :: b Vector position at centre of the top circle real(kind=wp), intent(in) :: radius Radius of cylinder type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cylinder ) public interface egg Interface to egg SDF initialising function private function egg_init (r1, r2, h, optProp, layer, transform) result(out) Initalising function for egg SDF.\nmakes a Moss egg. ref . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: r1 R1 controls \"fatness\" of the egg. Actually controls the base circle radius. real(kind=wp), intent(in) :: r2 R2 contorls the pointiness of the egg. Actually controls radius of top circle. real(kind=wp), intent(in) :: h h controls the height of the egg. Actually controls y position of top circle. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( egg ) public interface plane Interface to plane SDF initialising function private function plane_init (a, optProp, layer, transform) result(out) Initalising function for plane SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Plane normal. must be normalised type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( plane ) public interface segment Interface to segment SDF initialising function private function segment_init (a, b, optProp, layer, transform) result(out) Initalising function for segment SDF.\nNote this is a 2D function Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a segment start point type( vector ), intent(in) :: b segment end point type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( segment ) public interface sphere private function sphere_init (radius, optProp, layer, transform) result(out) Initalising function for Sphere SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: radius radius of the Sphere type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( sphere ) public interface torus Interface to torus SDF initialising function private function torus_init (oradius, iradius, optProp, layer, transform) result(out) Initalising function for Torus SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: oradius Outer radius of Torus real(kind=wp), intent(in) :: iradius Inner radius of Torus type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( torus ) public interface triprism Interface to triprisim SDF initialising function private function triprism_init (h1, h2, optProp, layer, transform) result(out) Initalising function for triprisim SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: h1 Height of triprisim real(kind=wp), intent(in) :: h2 length of triprisim type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( triprism ) Derived Types type, public, extends( sdf_base ) :: box Box SDF Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( vector ), public :: lengths Length of each dimension of the box type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor Interface to box SDF initialising function private\n\n \n function box_init (lengths, optProp, layer, transform) Initalising function for Box SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_box Function type, public, extends( sdf_base ) :: capsule Capsule SDF Components Type Visibility Attributes Name Initial type( vector ), public :: a type( vector ), public :: b integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: r real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor Interface to capsule SDF initialising function private\n\n \n function capsule_init (a, b, r, optProp, layer, transform) Initalising function for capsule SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_capsule Function type, public, extends( sdf_base ) :: cone Cone SDF Components Type Visibility Attributes Name Initial type( vector ), public :: a type( vector ), public :: b integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: ra real(kind=wp), public :: rb real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor Interface to cone SDF initialising function private\n\n \n function cone_init (a, b, ra, rb, optProp, layer, transform) Initalising function for Capped Cone SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_cone Function type, public, extends( sdf_base ) :: cylinder Cylinder SDF Components Type Visibility Attributes Name Initial type( vector ), public :: a type( vector ), public :: b integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: radius real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor Interface to cylinder SDF initialising function private\n\n \n function cylinder_init (a, b, radius, optProp, layer, transform) Initalising function for Cylinder SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_cylinder Function type, public, extends( sdf_base ) :: egg Egg SDF Components Type Visibility Attributes Name Initial real(kind=wp), public :: h integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: r1 real(kind=wp), public :: r2 real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor Interface to egg SDF initialising function private\n\n \n function egg_init (r1, r2, h, optProp, layer, transform) Initalising function for egg SDF.\nmakes a Moss egg. ref . Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_egg Function type, public, extends( sdf_base ) :: plane Plane SDF Components Type Visibility Attributes Name Initial type( vector ), public :: a integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor Interface to plane SDF initialising function private\n\n \n function plane_init (a, optProp, layer, transform) Initalising function for plane SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_plane Function type, public, extends( sdf_base ) :: segment Segment SDF (2D) Components Type Visibility Attributes Name Initial type( vector ), public :: a type( vector ), public :: b integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor Interface to segment SDF initialising function private\n\n \n function segment_init (a, b, optProp, layer, transform) Initalising function for segment SDF.\nNote this is a 2D function Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_segment Function type, public, extends( sdf_base ) :: sphere Sphere SDF Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: radius real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function sphere_init (radius, optProp, layer, transform) Initalising function for Sphere SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_sphere Function type, public, extends( sdf_base ) :: torus Torus SDF Components Type Visibility Attributes Name Initial real(kind=wp), public :: iradius integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: oradius real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor Interface to torus SDF initialising function private\n\n \n function torus_init (oradius, iradius, optProp, layer, transform) Initalising function for Torus SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_torus Function type, public, extends( sdf_base ) :: triprism Triprisim SDF Components Type Visibility Attributes Name Initial real(kind=wp), public :: h1 real(kind=wp), public :: h2 integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor Interface to triprisim SDF initialising function private\n\n \n function triprism_init (h1, h2, optProp, layer, transform) Initalising function for triprisim SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_triprism Function Functions private function box_init (lengths, optProp, layer, transform) result(out) Initalising function for Box SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: lengths Lengths of each dimension of the box type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( box ) private function capsule_init (a, b, r, optProp, layer, transform) result(out) Initalising function for capsule SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Capsule startpoint type( vector ), intent(in) :: b Capsule endpoint real(kind=wp), intent(in) :: r Capsule radius type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( capsule ) private function cone_init (a, b, ra, rb, optProp, layer, transform) result(out) Initalising function for Capped Cone SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Centre of base of Cone type( vector ), intent(in) :: b Tip of cone real(kind=wp), intent(in) :: ra Radius of Cones base real(kind=wp), intent(in) :: rb Radius of Cones tip. For rb = 0.0 get normal uncapped cone. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cone ) private function cylinder_init (a, b, radius, optProp, layer, transform) result(out) Initalising function for Cylinder SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Vector position at centre of the bottom circle type( vector ), intent(in) :: b Vector position at centre of the top circle real(kind=wp), intent(in) :: radius Radius of cylinder type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cylinder ) private function egg_init (r1, r2, h, optProp, layer, transform) result(out) Initalising function for egg SDF.\nmakes a Moss egg. ref . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: r1 R1 controls \"fatness\" of the egg. Actually controls the base circle radius. real(kind=wp), intent(in) :: r2 R2 contorls the pointiness of the egg. Actually controls radius of top circle. real(kind=wp), intent(in) :: h h controls the height of the egg. Actually controls y position of top circle. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( egg ) private pure elemental function evaluate_box (this, pos) result(res) Evaluation function for Box SDF. Arguments Type Intent Optional Attributes Name class( box ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) private pure elemental function evaluate_capsule (this, pos) result(res) Evaluation function for Capsule SDF. Arguments Type Intent Optional Attributes Name class( capsule ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) private pure elemental function evaluate_cone (this, pos) result(res) Evaluation function for Cone SDF. Arguments Type Intent Optional Attributes Name class( cone ), intent(in) :: this type( vector ), intent(in) :: pos Return Value real(kind=wp) private pure elemental function evaluate_cylinder (this, pos) result(res) Evaluation function for Cylinder SDF. Arguments Type Intent Optional Attributes Name class( cylinder ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) private pure elemental function evaluate_egg (this, pos) result(res) Evaluation function for Egg SDF. ref Arguments Type Intent Optional Attributes Name class( egg ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) private pure elemental function evaluate_plane (this, pos) result(res) Evaluation function for Plane SDF. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) private pure elemental function evaluate_segment (this, pos) result(res) Evaluation function for Segment SDF. Arguments Type Intent Optional Attributes Name class( segment ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) private pure elemental function evaluate_sphere (this, pos) result(res) Evaluation function for Sphere SDF. Arguments Type Intent Optional Attributes Name class( sphere ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) private pure elemental function evaluate_torus (this, pos) result(res) Evaluation function for Torus SDF. Arguments Type Intent Optional Attributes Name class( torus ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) private pure elemental function evaluate_triprism (this, pos) result(res) Evaluation function for Triprisim SDF. Arguments Type Intent Optional Attributes Name class( triprism ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) private function plane_init (a, optProp, layer, transform) result(out) Initalising function for plane SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Plane normal. must be normalised type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( plane ) private function segment_init (a, b, optProp, layer, transform) result(out) Initalising function for segment SDF.\nNote this is a 2D function Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a segment start point type( vector ), intent(in) :: b segment end point type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( segment ) private function sphere_init (radius, optProp, layer, transform) result(out) Initalising function for Sphere SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: radius radius of the Sphere type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( sphere ) private function torus_init (oradius, iradius, optProp, layer, transform) result(out) Initalising function for Torus SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: oradius Outer radius of Torus real(kind=wp), intent(in) :: iradius Inner radius of Torus type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( torus ) private function triprism_init (h1, h2, optProp, layer, transform) result(out) Initalising function for triprisim SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: h1 Height of triprisim real(kind=wp), intent(in) :: h2 length of triprisim type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( triprism )","tags":"","loc":"module/sdfs.html"},{"title":"sdfHelpers – signedMCRT","text":"Collection of helper functions for SDFs: This module defines transforms that can be applied to each SDF: Rotate_{x,y,z} Translate RotationAlign (not tested) RotMat (not tested) Identity SkewSymm Uses constants vector_class Contents Functions identity rotate_x rotate_y rotate_z rotationAlign rotmat skewSymm translate Functions public function identity () result(r) Returns the identity transformation matrix Arguments None Return Value real(kind=wp), (4,4) public function rotate_x (angle) result(r) rotation in the x-axis function from here Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: angle Angle to rotate by Return Value real(kind=wp), (4,4) public function rotate_y (angle) result(r) rotation in the y-axis function from here Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: angle Angle to rotate by Return Value real(kind=wp), (4,4) public function rotate_z (angle) result(r) rotation in the z-axis function from here Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: angle Angle to rotate by Return Value real(kind=wp), (4,4) public function rotationAlign (a, b) result(res) Calculate the rotation matrix to rotate vector a onto b ref1 ref2 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Vector to rotate. Unit vector type( vector ), intent(in) :: b Vector to be rotated onto. Unit vector Return Value real(kind=wp), (4,4) public function rotmat (axis, angle) Rotate around around an axis by a given angle taken from here Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: axis Axis to rotate around real(kind=wp), intent(in) :: angle Angle to rotate by in degrees Return Value real(kind=wp), (4,4) public function skewSymm (a) result(out) Calculate the Skew Symmetric matrix for a given vector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Vector to calculate the skew symmetric matrix for. Return Value real(kind=wp), (4,4) public function translate (o) result(out) Returns the Translation matrix for a given vector translation. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: o Vector to translate by. Return Value real(kind=wp), (4,4)","tags":"","loc":"module/sdfhelpers.html"},{"title":"sdfModifiers – signedMCRT","text":"This module defines transforms that can be applied to each SDF:\n- Union\n- Intersection\n- Subtraction\n- Displacement\n- Bend\n- Twist\n- Elongate\n- Repeat\n- Extrude\n- Revolution\n- Onion Uses sdfHelpers sdf_baseMod vector_class constants Contents Interfaces bend displacement elongate extrude onion repeat revolution twist Derived Types bend displacement elongate extrude onion repeat revolution twist Functions SmoothUnion bend_init displacement_init elongate_init eval_bend eval_disp eval_elongate eval_extrude eval_onion eval_repeat eval_revolution eval_twist extrude_init intersection onion_init repeat_init revolution_init subtraction twist_init union Interfaces public interface bend private function bend_init (prim, k) result(out) Initialise the Bend modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: k Amoun to bend by. Return Value type( bend ) public interface displacement private function displacement_init (prim, func) result(out) Initialise the displacement modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify procedure( primitive ) :: func Function to displace the SDF with. Return Value type( displacement ) public interface elongate private function elongate_init (prim, size) result(out) Initialise the elongate modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify type( vector ), intent(in) :: size Distance to elongate by Return Value type( elongate ) public interface extrude private function extrude_init (prim, h) result(out) Initialise the extrude modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: h Distance to extrude by. Return Value type( extrude ) public interface onion private function onion_init (prim, thickness) result(out) Initialise the Onion modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: thickness Thickned to onion by. Return Value type( onion ) public interface repeat private function repeat_init (prim, c, la, lb) result(out) Initialise the Repeat modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: c type( vector ), intent(in) :: la type( vector ), intent(in) :: lb Return Value type( repeat ) public interface revolution private function revolution_init (prim, o) result(out) Initialise the Revolution modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: o Amount to revolve by. Return Value type( revolution ) public interface twist private function twist_init (prim, k) result(out) Initialise the twist modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real, intent(in) :: k Twist parameter. Return Value type( twist ) Derived Types type, public, extends( sdf_base ) :: bend Bend a SDF. Components Type Visibility Attributes Name Initial real(kind=wp), public :: k integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function bend_init (prim, k) Initialise the Bend modifier for a SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => eval_bend Function type, public, extends( sdf_base ) :: displacement Displace the surface of a SDF by a function. Components Type Visibility Attributes Name Initial procedure( primitive ), public, nopass, pointer :: func integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function displacement_init (prim, func) Initialise the displacement modifier for a SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => eval_disp Function type, public, extends( sdf_base ) :: elongate Elongate a SDF Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim type( vector ), public :: size real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function elongate_init (prim, size) Initialise the elongate modifier for a SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => eval_elongate Function type, public, extends( sdf_base ) :: extrude Extrude a 2D SDF into 3D Components Type Visibility Attributes Name Initial real(kind=wp), public :: h integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function extrude_init (prim, h) Initialise the extrude modifier for a SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => eval_extrude Function type, public, extends( sdf_base ) :: onion Carves or gives thickness to SDFs Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: thickness real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function onion_init (prim, thickness) Initialise the Onion modifier for a SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => eval_onion Function type, public, extends( sdf_base ) :: repeat Repeat a SDF Components Type Visibility Attributes Name Initial real(kind=wp), public :: c type( vector ), public :: la integer, public :: layer Layer ID of SDF type( vector ), public :: lb type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function repeat_init (prim, c, la, lb) Initialise the Repeat modifier for a SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => eval_repeat Function type, public, extends( sdf_base ) :: revolution Revoloution modifier. Revolves an SDF around the z axis (need to check this!!) Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF real(kind=wp), public :: o type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function revolution_init (prim, o) Initialise the Revolution modifier for a SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => eval_revolution Function type, public, extends( sdf_base ) :: twist Twist a SDF Components Type Visibility Attributes Name Initial real(kind=wp), public :: k integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function twist_init (prim, k) Initialise the twist modifier for a SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => eval_twist Function Functions public pure function SmoothUnion (d1, d2, k) result(res) Smooth union. Joins two SDFs together smoothly Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 SDF_1 distance real(kind=wp), intent(in) :: d2 SDF_2 distance real(kind=wp), intent(in) :: k smoothing factor. Return Value real(kind=wp) private function bend_init (prim, k) result(out) Initialise the Bend modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: k Amoun to bend by. Return Value type( bend ) private function displacement_init (prim, func) result(out) Initialise the displacement modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify procedure( primitive ) :: func Function to displace the SDF with. Return Value type( displacement ) private function elongate_init (prim, size) result(out) Initialise the elongate modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify type( vector ), intent(in) :: size Distance to elongate by Return Value type( elongate ) private pure elemental function eval_bend (this, pos) result(res) Evaluation function for Bend modifier. Arguments Type Intent Optional Attributes Name class( bend ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) private pure elemental function eval_disp (this, pos) result(res) Evaluation function for displacement modifier. Arguments Type Intent Optional Attributes Name class( displacement ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) private pure elemental function eval_elongate (this, pos) result(res) Evaluation function for Elongate modifier. Arguments Type Intent Optional Attributes Name class( elongate ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) private pure elemental function eval_extrude (this, pos) result(res) Evaluation function for Extrude modifier. Arguments Type Intent Optional Attributes Name class( extrude ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) private pure elemental function eval_onion (this, pos) result(res) Evaluation function for Onion modifier. Arguments Type Intent Optional Attributes Name class( onion ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) private pure elemental function eval_repeat (this, pos) result(res) Evaluation function for Repeat modifier. Arguments Type Intent Optional Attributes Name class( repeat ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) private pure elemental function eval_revolution (this, pos) result(res) Evaluation function for Revolution modifier. Arguments Type Intent Optional Attributes Name class( revolution ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) private pure elemental function eval_twist (this, pos) result(res) Evaluation function for Twist modifier. Arguments Type Intent Optional Attributes Name class( twist ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) private function extrude_init (prim, h) result(out) Initialise the extrude modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: h Distance to extrude by. Return Value type( extrude ) public pure function intersection (d1, d2, k) result(res) Intersection operator. Returns the intersection of two SDFs. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 SDF_1 distance real(kind=wp), intent(in) :: d2 SDF_2 distance real(kind=wp), intent(in) :: k smoothing factor. Return Value real(kind=wp) private function onion_init (prim, thickness) result(out) Initialise the Onion modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: thickness Thickned to onion by. Return Value type( onion ) private function repeat_init (prim, c, la, lb) result(out) Initialise the Repeat modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: c type( vector ), intent(in) :: la type( vector ), intent(in) :: lb Return Value type( repeat ) private function revolution_init (prim, o) result(out) Initialise the Revolution modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: o Amount to revolve by. Return Value type( revolution ) public pure function subtraction (d1, d2, k) result(res) Subtraction operator. Takes one SDF from another.\nTake the first SDF from the 2nd SDF Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 SDF_1 distance real(kind=wp), intent(in) :: d2 SDF_2 distance real(kind=wp), intent(in) :: k unused factor. Return Value real(kind=wp) private function twist_init (prim, k) result(out) Initialise the twist modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real, intent(in) :: k Twist parameter. Return Value type( twist ) public pure function union (d1, d2, k) result(res) Union operation. Joins two SDFs together Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 SDF_1 distance real(kind=wp), intent(in) :: d2 SDF_2 distance real(kind=wp), intent(in) :: k unused factor Return Value real(kind=wp)","tags":"","loc":"module/sdfmodifiers.html"},{"title":"sdf_baseMod – signedMCRT","text":"This module defines the signed distance function (SDF) abstract type, sdf_base type, and model type.\nThe SDF abstract type contains the optical properties of an SDF (mus, mua, kappa, albedo, hgg, g2,and n), as well as a transform (4x4 matrix), \nand the layer ID code of the SDF. The SDF abstract type also provides an abstract interface (evaluate) which each inheriting function must implement.\nThis evaluate function is the heart of the SDF implementation. Each individual evaluate is the direct implementation of that SDF, e.g. that function defines the mathematical SDF. \nFor more information on SDFs, check out Inigo Quilez's website from which most of the below SDFs and transforms have been taken.\nAPI based upon here Uses opticalProperties sdfHelpers vector_class constants Contents Interfaces model render sdf Abstract Interfaces evalInterface op primitive Derived Types model sdf sdf_base Functions calcNormal eval_model getAlbedo getKappa getMua getN getg2 gethgg model_init sdf_evaluate sdf_new Subroutines render_sub render_vec sdf_assign Interfaces public interface model private function model_init (array, func, kopt) result(out) Initalise the model type. Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: array (:) Array of SDFs procedure( op ) :: func Operator to apply to SDF. real(kind=wp), intent(in), optional :: kopt Parameter used in modifier Return Value type( model ) public interface render private subroutine render_sub (cnt, extent, samples, state) Render the SDFs onto a voxel grid Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: cnt (:) type( vector ), intent(in) :: extent integer, intent(in) :: samples (3) type( settings_t ), intent(in) :: state private subroutine render_vec (cnt, state) Render the SDF\nWrapper around the render function to allow ease of use Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: cnt (:) type( settings_t ), intent(in) :: state public interface sdf private function sdf_new (rhs) result(lhs) sdf initializer Arguments Type Intent Optional Attributes Name class( sdf_base ), intent(in) :: rhs Return Value type( sdf ) Abstract Interfaces abstract interface public pure elemental function evalInterface(this, pos) result(res) Evaluation function for SDF. ALL SDF must implment this. Arguments Type Intent Optional Attributes Name class( sdf_base ), intent(in) :: this type( vector ), intent(in) :: pos Return Value real(kind=wp) abstract interface public pure function op(d1, d2, k) result(res) Abstract function used as the base for SDF operators (union, subtraction etc) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 real(kind=wp), intent(in) :: d2 real(kind=wp), intent(in) :: k Return Value real(kind=wp) abstract interface public pure function primitive(pos) result(res) Abstract function used as base for displacement function Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos vector position of photon packet. Return Value real(kind=wp) Derived Types type, public, extends( sdf_base ) :: model Model type. Allows the collection of multiple SDF into one model. Used to apply modifiers. Components Type Visibility Attributes Name Initial type( sdf ), public, allocatable :: array (:) Array of SDFs in the model procedure( op ), public, nopass, pointer :: func SDF modifier function real(kind=wp), public :: k Parameter that may be used in modifer function. integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function model_init (array, func, kopt) Initalise the model type. Type-Bound Procedures procedure\n , public\n, :: evaluate => eval_model Function type, public, extends( sdf_base ) :: sdf Container type that allows the use of arrays of different SDF shapes Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. class( sdf_base ), public, allocatable :: value Container for any SDF that inherits from SDF_base Constructor private\n\n \n function sdf_new (rhs) sdf initializer Type-Bound Procedures generic,\n public\n, :: assignment(=) => sdf_assign procedure\n , public\n, :: evaluate => sdf_evaluate Function procedure\n , public\n, :: getAlbedo Function procedure\n , public\n, :: getG2 => getg2 Function procedure\n , public\n, :: getKappa Function procedure\n , public\n, :: getMua Function procedure\n , public\n, :: getN Function procedure\n , public\n, :: gethgg Function procedure\n , private\n :: sdf_assign Subroutine type, public :: sdf_base Abstract base type from which all SDF inherit from. Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Type-Bound Procedures procedure\n(evalInterface) , public\n :: evaluate Functions public function calcNormal (p, obj) Calculate the surface normal of a SDF at the point p numerically. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: p Position to evaluate at class( sdf_base ) :: obj SDF to calcuate surface normal of. Return Value type( vector ) private pure elemental function eval_model (this, pos) result(res) Evaluate the model Arguments Type Intent Optional Attributes Name class( model ), intent(in) :: this type( vector ), intent(in) :: pos Vector position to evaluate at Return Value real(kind=wp) private function getAlbedo (this) result(res) Return albedo for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) private function getKappa (this) result(res) Return for the current SDF Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) private function getMua (this) result(res) Return for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) private function getN (this) result(res) Return refractive index for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) private function getg2 (this) result(res) Return factor for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) private function gethgg (this) result(res) Return g-factor for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) private function model_init (array, func, kopt) result(out) Initalise the model type. Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: array (:) Array of SDFs procedure( op ) :: func Operator to apply to SDF. real(kind=wp), intent(in), optional :: kopt Parameter used in modifier Return Value type( model ) private pure elemental function sdf_evaluate (this, pos) result(res) Evaluate the SDF at a given position. Arguments Type Intent Optional Attributes Name class( sdf ), intent(in) :: this type( vector ), intent(in) :: pos Return Value real(kind=wp) private function sdf_new (rhs) result(lhs) sdf initializer Arguments Type Intent Optional Attributes Name class( sdf_base ), intent(in) :: rhs Return Value type( sdf ) Subroutines private subroutine render_sub (cnt, extent, samples, state) Render the SDFs onto a voxel grid Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: cnt (:) type( vector ), intent(in) :: extent integer, intent(in) :: samples (3) type( settings_t ), intent(in) :: state private subroutine render_vec (cnt, state) Render the SDF\nWrapper around the render function to allow ease of use Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: cnt (:) type( settings_t ), intent(in) :: state private subroutine sdf_assign (lhs, rhs) sdf initializer Arguments Type Intent Optional Attributes Name class( sdf ), intent(inout) :: lhs class( sdf_base ), intent(in) :: rhs","tags":"","loc":"module/sdf_basemod.html"},{"title":"mcpolar – signedMCRT","text":"Uses kernels Entry point for program Contents Variables args i num_args Variables Type Attributes Name Initial character(len=64), allocatable :: args (:) integer :: i integer :: num_args","tags":"","loc":"program/mcpolar.html"},{"title":"setupGeometry.f90 – signedMCRT","text":"Contents Modules setupGeometry Source Code setupGeometry.f90 Source Code module setupGeometry !! contains all the routines that setup premade experimental geometry use constants , only : wp use tomlf , only : toml_table , get_value implicit none contains function setup_egg () result ( array ) !! setup an egg, with yolk, albumen and shell use sdfs , only : sdf , sphere , box , egg use sdfModifiers , only : onion , revolution use vector_class use opticalProperties type ( sdf ), allocatable :: array (:) type ( box ) :: bbox type ( revolution ), save :: albumen , rev1 type ( onion ) :: shell type ( sphere ) :: yolk type ( opticalProp_t ) :: opt ( 4 ) type ( egg ), save :: egg_shell , egg_albumen real ( kind = wp ) :: r1 , r2 , h r1 = 3._wp r2 = 3._wp * sqrt ( 2._wp - sqrt ( 2._wp )) h = r2 !width = 42mm !height = 62mm !shell opt ( 1 ) = mono ( 10 0._wp , 1 0._wp , 0.0_wp , 1.37_wp ) egg_shell = egg ( r1 , r2 , h , opt ( 1 ), 2 ) rev1 = revolution ( egg_shell , . 2_wp ) shell = onion ( rev1 , . 2_wp ) !albumen opt ( 2 ) = mono ( 1._wp , 0._wp , 0.0_wp , 1.37_wp ) egg_albumen = egg ( r1 - . 2_wp , r2 , h , opt ( 2 ), 3 ) albumen = revolution ( egg_albumen , . 2_wp ) !yolk opt ( 3 ) = mono ( 1 0._wp , 1._wp , 0.9_wp , 1.37_wp ) yolk = sphere ( 1.5_wp , opt ( 3 ), 1 ) !bounding box opt ( 4 ) = mono ( 0._wp , 0._wp , 0.0_wp , 1._wp ) bbox = box ( vector ( 2 0.001_wp , 2 0.001_wp , 2 0.001_wp ), opt ( 4 ), 4 ) allocate ( array ( 4 )) array ( 1 ) = yolk array ( 2 ) = albumen array ( 3 ) = shell array ( 4 ) = bbox end function setup_egg function setup_sphere_scene ( dict ) result ( array ) !! setup a test scene with user defined spheres use mat_class , only : invert use opticalProperties , only : opticalProp_t , mono use sdfs , only : sdf , sphere , box use sdfHelpers , only : translate use random , only : ranu use vector_class , only : vector type ( toml_table ), intent ( inout ) :: dict type ( sdf ), allocatable :: array (:) integer :: num_spheres , i real ( kind = wp ) :: t ( 4 , 4 ), mus , mua , hgg , n , radius type ( vector ) :: pos type ( opticalProp_t ) :: opt ( 2 ) call get_value ( dict , \"num_spheres\" , num_spheres ) allocate ( array ( num_spheres + 1 )) mus = 1e-17_wp mua = 1e-17_wp hgg = 0.0_wp n = 1.0_wp opt ( 2 ) = mono ( mus , mua , hgg , n ) array ( num_spheres + 1 ) = box ( vector ( 2._wp , 2._wp , 2._wp ), opt ( 2 ), num_spheres + 1 ) mus = 0.0_wp !ranu(1._wp, 50._wp) mua = 0.0_wp !ranu(0.01_wp, 1._wp) hgg = 0.9_wp n = 1.37_wp opt ( 1 ) = mono ( mus , mua , hgg , n ) do i = 1 , num_spheres radius = ranu ( 0.001_wp , 0.25_wp ) pos = vector ( ranu ( - 1._wp + radius , 1._wp - radius ), ranu ( - 1._wp + radius , 1._wp - radius ),& ranu ( - 1._wp + radius , 1._wp - radius )) t = invert ( translate ( pos )) array ( i ) = sphere ( radius , opt ( 1 ), i , transform = t ) end do end function setup_sphere_scene function setup_logo () result ( array ) !! setup uni crest geometry use sdfs , only : sdf , box , segment use sdfModifiers , only : extrude use opticalProperties use vector_class type ( sdf ), allocatable :: array (:) type ( segment ), allocatable , save :: seg (:) type ( opticalProp_t ) :: opt ( 2 ) type ( vector ) :: a , b real ( kind = wp ) :: hgg , mus , mua , n integer :: layer logical :: fexists allocate ( array ( 726 ), seg ( 725 )) mus = 1 0._wp mua = . 1_wp hgg = 0.9_wp n = 1.5_wp layer = 1 opt ( 1 ) = mono ( 0.0_wp , 0.0_wp , 0.0_wp , 1.0_wp ) opt ( 2 ) = mono ( mus , mua , hgg , n ) inquire ( file = \"res/svg.f90\" , exist = fexists ) if (. not . fexists ) error stop \"need to generate svg.f90 and place in res/\" error stop \"need to uncomment inlcude line!\" ! include \"../res/svg.f90\" array ( 726 ) = box ( vector ( 1 0._wp , 1 0._wp , 2.001_wp ), opt ( 1 ), 2 ) end function setup_logo function setup_sphere () result ( array ) !! setup the sphere test case from tran and jacques paper. use mat_class , only : invert use opticalProperties , only : mono , opticalProp_t use sdfs , only : sdf , box , sphere use sdfHelpers , only : translate use vector_class , only : vector type ( sdf ), allocatable :: array (:) type ( opticalProp_t ) :: opt ( 3 ) real ( kind = wp ) :: mus , mua , n , hgg , t ( 4 , 4 ) type ( vector ) :: a allocate ( array ( 3 )) mus = 0._wp ; mua = 1.e-17_wp ; hgg = 0._wp ; n = 1._wp ; opt ( 1 ) = mono ( mus , mua , hgg , n ) array ( 2 ) = box ( vector ( 2._wp , 2._wp , 2._wp ), opt ( 1 ), 2 ) opt ( 2 ) = mono ( mus , 1000000 0._wp , hgg , n ) array ( 3 ) = box ( vector ( 2.01_wp , 2.01_wp , 2.01_wp ), opt ( 2 ), 3 ) mus = 0._wp ; mua = 1.e-17_wp ; hgg = 0._wp ; n = 1.33_wp ; opt ( 3 ) = mono ( mus , mua , hgg , n ) a = vector (. 0_wp , 0._wp , 0._wp ) t = invert ( translate ( a )) array ( 1 ) = sphere ( 0.5_wp , opt ( 3 ), 1 , transform = t ) end function setup_sphere function setup_exp ( dict ) result ( array ) !! Setup experimental geometry from Georgies paper. i.e a glass bottle with contents use sdfs , only : sdf , box , cylinder !, subtraction use sdfHelpers , only : rotate_y , translate use utils , only : deg2rad use vector_class , only : vector use mat_class , only : invert use opticalProperties , only : mono , opticalProp_t type ( toml_table ), intent ( inout ) :: dict type ( sdf ), allocatable :: array (:) type ( opticalProp_t ) :: opt ( 3 ) type ( vector ) :: a , b real ( kind = wp ) :: n , optprop ( 5 ) error stop \"add model and subtraction here\" call get_value ( dict , \"musb\" , optprop ( 1 )) call get_value ( dict , \"muab\" , optprop ( 2 )) call get_value ( dict , \"musc\" , optprop ( 3 )) call get_value ( dict , \"muac\" , optprop ( 4 )) call get_value ( dict , \"hgg\" , optprop ( 5 )) n = 1._wp opt ( 1 ) = mono ( optprop ( 1 ), optprop ( 2 ), optprop ( 5 ), 1.5_wp ) opt ( 2 ) = mono ( optprop ( 3 ), optprop ( 4 ), optprop ( 5 ), 1.3_wp ) a = vector ( - 1 0._wp , 0._wp , 0._wp ) b = vector ( 1 0._wp , 0._wp , 0._wp ) !bottle array ( 2 ) = cylinder ( a , b , 1.75_wp , opt ( 1 ), 2 ) ! contents array ( 1 ) = cylinder ( a , b , 1.55_wp , opt ( 2 ), 1 ) ! t = invert(translate(vector(0._wp, 0._wp, -5._wp+1.75_wp))) ! slab = box(vector(10._wp, 10._wp, 10._wp), optprop(3), optprop(4), optprop(5), 1.3_wp, 1, transform=t) opt ( 3 ) = mono ( 0.0_wp , 0.0_wp , 0.0_wp , n ) array ( 3 ) = box ( vector ( 4._wp , 4._wp , 4._wp ), opt ( 3 ), 2 ) end function setup_exp function setup_scat_test ( dict ) result ( array ) !! set up scattering test scene with user defined tau use opticalProperties use sdfs , only : sdf , sphere , box use vector_class type ( toml_table ), intent ( inout ) :: dict type ( sdf ), allocatable :: array (:) type ( opticalProp_t ) :: opt ( 2 ) real ( kind = wp ) :: mus , mua , hgg , n , tau call get_value ( dict , \"tau\" , tau ) allocate ( array ( 2 )) n = 1._wp hgg = 0.0_wp mua = 0.00_wp mus = tau opt ( 1 ) = mono ( mus , mua , hgg , n ) array ( 1 ) = sphere ( 1._wp , opt ( 1 ), 1 ) opt ( 2 ) = mono ( 0.0_wp , mua , hgg , n ) array ( 2 ) = box ( vector ( 2._wp , 2._wp , 2._wp ), opt ( 2 ), 2 ) end function setup_scat_test function setup_scat_test2 ( dict ) result ( array ) !! set up scattering test scene 2 with user defined tau and hgg use opticalProperties use sdfs , only : sdf , box use vector_class type ( toml_table ), intent ( inout ) :: dict type ( sdf ), allocatable :: array (:) type ( opticalProp_t ) :: opt real ( kind = wp ) :: mus , mua , hgg , n , tau allocate ( array ( 1 )) call get_value ( dict , \"tau\" , tau ) call get_value ( dict , \"hgg\" , hgg ) n = 1._wp hgg = hgg mua = 1e-17_wp mus = tau opt = mono ( mus , mua , hgg , n ) array ( 1 ) = box ( vector ( 20 0._wp , 20 0._wp , 20 0._wp ), opt , 2 ) end function setup_scat_test2 function setup_omg_sdf () result ( array ) !! setup OMG scene use mat_class , only : invert use opticalProperties use sdfHelpers , only : translate , rotate_y use sdfModifiers , only : SmoothUnion use sdfs , only : sdf , cylinder , torus , box , model use vector_class , only : vector type ( sdf ), allocatable :: array (:) type ( sdf ), allocatable , save :: cnta (:) type ( opticalProp_t ), save :: opt ( 2 ) type ( vector ) :: a , b real ( kind = wp ) :: t ( 4 , 4 ), mus , mua , hgg , n integer :: layer allocate ( array ( 2 ), cnta ( 10 )) mus = 1 0._wp mua = 0.16_wp hgg = 0.0_wp n = 2.65_wp layer = 1 opt ( 1 ) = mono ( mus , mua , hgg , n ) opt ( 2 ) = mono ( 0._wp , 0._wp , 0._wp , 1.0_wp ) ! x ! | ! | ! | ! | ! |_____z !O letter a = vector ( 0._wp , 0._wp , - 0.7_wp ) t = invert ( translate ( a )) cnta ( 1 ) = torus (. 2_wp , 0.05_wp , opt ( 1 ), layer , transform = t ) !M letter a = vector ( - . 25_wp , 0._wp , - . 25_wp ) b = vector ( - . 25_wp , 0._wp , . 25_wp ) t = invert ( rotate_y ( 9 0._wp )) cnta ( 2 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer , transform = t ) a = vector ( - . 25_wp , 0._wp , - . 25_wp ) b = vector (. 25_wp , 0._wp , . 0_wp ) cnta ( 3 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector (. 25_wp , 0._wp , . 0_wp ) b = vector ( - . 25_wp , 0._wp , . 25_wp ) cnta ( 4 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector ( - . 25_wp , 0._wp , . 25_wp ) b = vector (. 25_wp , 0._wp , . 25_wp ) cnta ( 5 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) !G letter a = vector ( - . 25_wp , 0._wp , . 5_wp ) b = vector (. 25_wp , 0._wp , . 5_wp ) cnta ( 6 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector ( - . 25_wp , 0._wp , . 5_wp ) b = vector ( - . 25_wp , 0._wp , . 75_wp ) cnta ( 7 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector (. 25_wp , 0._wp , . 5_wp ) b = vector (. 25_wp , 0._wp , . 75_wp ) cnta ( 8 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector (. 25_wp , 0._wp , . 75_wp ) b = vector ( 0._wp , 0._wp , . 75_wp ) cnta ( 9 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector ( 0._wp , 0._wp , . 625_wp ) b = vector ( 0._wp , 0._wp , . 75_wp ) cnta ( 10 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) array ( 1 ) = model ( cnta , smoothunion , 0.09_wp ) array ( 2 ) = box ( vector ( 2._wp , 2._wp , 2._wp ), opt ( 2 ), 2 ) end function setup_omg_sdf function get_vessels () result ( array ) !! setup blood vessel scene use opticalProperties use sdfs , only : sdf , capsule , box use vector_class , only : vector type ( sdf ), allocatable :: array (:) real ( kind = wp ), allocatable :: nodes (:, :), radii (:) integer , allocatable :: edges (:, :) integer :: io , edge_cnt , tmp1 , tmp2 , u , node_cnt , i real ( kind = wp ) :: x , y , z , radius , res , maxx , maxy , maxz real ( kind = wp ) :: musv , muav , gv , nv real ( kind = wp ) :: musd , muad , gd , nd type ( vector ) :: a , b type ( opticalProp_t ) :: opt ( 2 ) !MCmatlab: an open-source, user-friendly, MATLAB-integrated three-dimensional Monte Carlo light transport solver with heat diffusion and tissue damage muav = 23 1._wp musv = 9 4._wp gv = 0.9_wp nv = 1.37_wp muad = 0.458_wp musd = 35 7._wp gd = 0.9_wp nd = 1.37_wp opt ( 1 ) = mono ( musv , muav , gv , nv ) opt ( 2 ) = mono ( musd , muad , gd , nd ) !get number of edges open ( newunit = u , file = \"res/edges.dat\" , iostat = io ) edge_cnt = 0 do read ( u , * , iostat = io ) tmp1 , tmp2 if ( io /= 0 ) exit edge_cnt = edge_cnt + 1 end do close ( u ) !get number of nodes and radii open ( newunit = u , file = \"res/nodes.dat\" , iostat = io ) node_cnt = 0 do read ( u , * , iostat = io ) x , y , z if ( io /= 0 ) exit node_cnt = node_cnt + 1 end do allocate ( edges ( edge_cnt , 2 ), nodes ( node_cnt , 3 ), radii ( node_cnt )) !read in edges open ( newunit = u , file = \"res/edges.dat\" , iostat = io ) do i = 1 , edge_cnt read ( u , * , iostat = io ) edges ( i , :) if ( io /= 0 ) exit end do close ( u ) !read in nodes open ( newunit = u , file = \"res/nodes.dat\" , iostat = io ) do i = 1 , edge_cnt read ( u , * , iostat = io ) nodes ( i , :) if ( io /= 0 ) exit end do close ( u ) !read in radii open ( newunit = u , file = \"res/radii.dat\" , iostat = io ) do i = 1 , node_cnt read ( u , * , iostat = io ) radii ( i ) if ( io /= 0 ) exit end do close ( u ) res = 0.001_wp !0.01mm maxx = maxval ( abs ( nodes (:, 1 ))) maxy = maxval ( abs ( nodes (:, 2 ))) maxz = maxval ( abs ( nodes (:, 3 ))) nodes (:, 1 ) = ( nodes (:, 1 ) / maxx ) - 0.5_wp nodes (:, 2 ) = ( nodes (:, 2 ) / maxy ) - 0.5_wp nodes (:, 3 ) = ( nodes (:, 3 ) / maxz ) - 0.5_wp nodes (:, 1 ) = nodes (:, 1 ) * maxx * res nodes (:, 2 ) = nodes (:, 2 ) * maxy * res nodes (:, 3 ) = nodes (:, 3 ) * maxz * res allocate ( array ( edge_cnt + 1 )) do i = 1 , edge_cnt a = vector ( nodes ( edges ( i , 1 ), 1 ), nodes ( edges ( i , 1 ), 2 ), nodes ( edges ( i , 1 ), 3 )) b = vector ( nodes ( edges ( i , 2 ), 1 ), nodes ( edges ( i , 2 ), 2 ), nodes ( edges ( i , 2 ), 3 )) radius = radii ( edges ( i , 1 )) * res array ( i ) = capsule ( a , b , radius , opt ( 1 ), 1 ) end do array ( i ) = box ( vector (. 32_wp , . 18_wp , . 26_wp ), opt ( 2 ), 2 ) end function get_vessels end module setupGeometry","tags":"","loc":"sourcefile/setupgeometry.f90.html"},{"title":"photon.f90 – signedMCRT","text":"Contents Modules photonMod Source Code photon.f90 Source Code module photonMod !! This source file contains the photon type, all the photon launch routines for different light sources, and the scattering code. !! Below are the current types of light sources available. Check [here](config.md) for parameters needed for each light source. !! !! - uniform !! - pencil !! - annulus !! - focus !! - point !! - circular !! - SLM (2D image source) !! - double slit !! - square aperture use constants , only : wp use vector_class use random , only : seq implicit none !> photon class type :: photon !> postion of photon packet in cm. (0,0,0) is the center of the grid. type ( vector ) :: pos !> direction vectors real ( kind = wp ) :: nxp , nyp , nzp !> direction cosines real ( kind = wp ) :: sint , cost , sinp , cosp , phi !> Wavelength of the packet real ( kind = wp ) :: wavelength !> Current phase of the packet real ( kind = wp ) :: phase !> \\frac{2\\pi}{\\lambda}. Used to save computational time real ( kind = wp ) :: fact !> Energy of the packet. TODO real ( kind = wp ) :: energy !> grid cell position integer :: xcell , ycell , zcell !> photon alive flag logical :: tflag !> ID of the SDF the packet is in integer :: layer !> Thread ID of the packet integer :: id !> Debug data. Number of SDF evals integer :: cnts , bounces !> used if photon packet weights are used real ( kind = wp ) :: weight , step !, L !> emission routine procedure ( generic_emit ), pointer :: emit => null () contains !> scattering routine procedure :: scatter => scatter end type photon interface photon !> assign the emission function to the photon object module procedure init_source !> intialise the photon class module procedure init_photon end interface photon abstract interface subroutine generic_emit ( this , spectrum , dict , seqs ) use tomlf , only : toml_table , get_value use random , only : seq use piecewiseMod import :: photon class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) end subroutine generic_emit end interface !> used to save some computation time type ( photon ) :: photon_origin private public :: photon , init_source , set_photon contains subroutine set_photon ( pos , dir ) type ( vector ), intent ( in ) :: pos , dir photon_origin % pos = pos photon_origin % nxp = dir % x photon_origin % nyp = dir % y photon_origin % nzp = dir % z end subroutine set_photon type ( photon ) function init_photon ( val ) !! set up all the variables in the photon object !> value to assing to variables real ( kind = wp ), intent ( in ) :: val init_photon % pos = vector ( val , val , val ) init_photon % nxp = val init_photon % nyp = val init_photon % nzp = val init_photon % sint = val init_photon % cost = val init_photon % sinp = val init_photon % cosp = val init_photon % phi = val init_photon % wavelength = val init_photon % energy = val init_photon % fact = val init_photon % zcell = int ( val ) init_photon % ycell = int ( val ) init_photon % zcell = int ( val ) init_photon % tflag = . true . init_photon % layer = int ( val ) init_photon % id = int ( val ) init_photon % cnts = int ( val ) init_photon % bounces = int ( val ) init_photon % weight = val init_photon % step = val end function init_photon type ( photon ) function init_source ( choice ) !! Bind emission function to photon object !> Name of light source to use character ( * ), intent ( IN ) :: choice if ( choice == \"uniform\" ) then init_source % emit => uniform elseif ( choice == \"pencil\" ) then init_source % emit => pencil elseif ( choice == \"dslit\" ) then init_source % emit => dslit elseif ( choice == \"aperture\" ) then init_source % emit => aperture elseif ( choice == \"annulus\" ) then init_source % emit => annulus elseif ( choice == \"focus\" ) then init_source % emit => focus elseif ( choice == \"point\" ) then init_source % emit => point elseif ( choice == \"circular\" ) then init_source % emit => circular elseif ( choice == \"slm\" ) then init_source % emit => slm else error stop \"No such source!\" end if end function init_source subroutine slm ( this , spectrum , dict , seqs ) use piecewiseMod use tomlf , only : toml_table , get_value use random , only : ran2 , seq use sim_state_mod , only : state use constants , only : TWOPI class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: x , y this % pos = photon_origin % pos call spectrum % p % sample ( x , y ) this % pos % x = ( x - 100 ) / ( state % grid % nxg / ( 2. * state % grid % xmax )) this % pos % y = ( y - 100 ) / ( state % grid % nyg / ( 2. * state % grid % ymax )) this % nxp = photon_origin % nxp this % nyp = photon_origin % nyp this % nzp = photon_origin % nzp this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % tflag = . false . this % cnts = 0 this % bounces = 0 this % layer = 1 this % weight = 1.0_wp this % phase = 0.0_wp this % wavelength = 50 0.e-9_wp this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine slm subroutine circular ( this , spectrum , dict , seqs ) !! circular source use sim_state_mod , only : state use random , only : ran2 , seq use constants , only : twoPI use tomlf , only : toml_table , get_value use sdfHelpers , only : rotationAlign , translate use mat_class , only : invert use vector_class use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) type ( vector ) :: a , b integer :: cell ( 3 ) real ( kind = wp ) :: t ( 4 , 4 ), radius , r , theta , tmp this % nxp = photon_origin % nxp this % nyp = photon_origin % nyp this % nzp = photon_origin % nzp call get_value ( dict , \"radius\" , radius ) ! https://math.stackexchange.com/a/1681815 r = radius * sqrt ( ran2 ()) theta = ran2 () * TWOPI !set inital vector from which the source points a = vector ( 1._wp , 0._wp , 0._wp ) a = a % magnitude () !set vector to rotate to. User defined. b = vector ( this % nxp , this % nyp , this % nzp ) b = b % magnitude () ! method fails if below condition is true. So change a vector to point down x-axis if ( abs ( a ) == abs ( b )) then a = vector ( 0._wp , 0._wp , 1._wp ) a = a % magnitude () this % pos = vector ( r * cos ( theta ), r * sin ( theta ), 0._wp ) else this % pos = vector ( 0._wp , r * cos ( theta ), r * sin ( theta )) end if ! get rotation matrix t = rotationAlign ( a , b ) ! get translation matrix t = matmul ( t , invert ( translate ( photon_origin % pos ))) ! transform point this % pos = this % pos . dot . t this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) call spectrum % p % sample ( this % wavelength , tmp ) this % tflag = . false . this % cnts = 0 this % bounces = 0 this % layer = 1 this % weight = 1.0_wp ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine circular subroutine point ( this , spectrum , dict , seqs ) !! isotropic point source use sim_state_mod , only : state use random , only : ran2 , seq use constants , only : twoPI use tomlf , only : toml_table , get_value use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: wavelength , tmp this % pos = photon_origin % pos this % phi = ran2 () * twoPI this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = 2._wp * ran2 () - 1._wp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % nxp = this % sint * this % cosp this % nyp = this % sint * this % sinp this % nzp = this % cost this % tflag = . false . this % cnts = 0 this % bounces = 0 this % layer = 1 this % weight = 1.0_wp ! this%L = 1.0 call spectrum % p % sample ( wavelength , tmp ) this % wavelength = wavelength this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine point subroutine focus ( this , spectrum , dict , seqs ) use random , only : ranu , seq use sim_state_mod , only : state use utils , only : deg2rad use vector_class , only : length use tomlf , only : toml_table , get_value use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) type ( vector ) :: targ , dir real ( kind = wp ) :: dist , tmp integer :: cell ( 3 ) targ = vector ( 0._wp , 0._wp , 0._wp ) this % pos % x = ranu ( - state % grid % xmax , state % grid % xmax ) this % pos % y = ranu ( - state % grid % ymax , state % grid % ymax ) this % pos % z = state % grid % zmax - 1e-8_wp dist = length ( this % pos ) dir = ( - 1._wp ) * this % pos / dist dir = dir % magnitude () this % nxp = dir % x this % nyp = dir % y this % nzp = dir % z this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % nxp = this % sint * this % cosp this % nyp = this % sint * this % sinp this % nzp = this % cost this % tflag = . false . this % bounces = 0 this % cnts = 0 this % weight = 1.0_wp call spectrum % p % sample ( this % wavelength , tmp ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine focus subroutine uniform ( this , spectrum , dict , seqs ) !! uniformly illuminate a surface of the simulation media use random , only : ranu , ran2 , randint , seq use sim_state_mod , only : state use tomlf , only : toml_table , get_value use constants , only : TWOPI use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) type ( vector ) :: pos1 , pos2 , pos3 real ( kind = wp ) :: rx , ry , tmp this % nxp = photon_origin % nxp this % nyp = photon_origin % nyp this % nzp = photon_origin % nzp this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) call get_value ( dict , \"pos1%x\" , pos1 % x ) call get_value ( dict , \"pos1%y\" , pos1 % y ) call get_value ( dict , \"pos1%z\" , pos1 % z ) call get_value ( dict , \"pos2%x\" , pos2 % x ) call get_value ( dict , \"pos2%y\" , pos2 % y ) call get_value ( dict , \"pos2%z\" , pos2 % z ) call get_value ( dict , \"pos3%x\" , pos3 % x ) call get_value ( dict , \"pos3%y\" , pos3 % y ) call get_value ( dict , \"pos3%z\" , pos3 % z ) rx = ran2 () !seqs(1)%next() ry = ran2 () !seqs(2)%next() this % pos % x = pos1 % x + rx * pos2 % x + ry * pos3 % x this % pos % y = pos1 % y + rx * pos2 % y + ry * pos3 % y this % pos % z = pos1 % z + rx * pos2 % z + ry * pos3 % z this % tflag = . false . this % cnts = 0 this % bounces = 0 this % weight = 1.0_wp !FOR PHASE call spectrum % p % sample ( this % wavelength , tmp ) this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) this % phase = 0._wp ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine uniform subroutine pencil ( this , spectrum , dict , seqs ) !! pencil beam source use random , only : ranu , seq use sim_state_mod , only : state use tomlf , only : toml_table , get_value use piecewiseMod use constants , only : TWOPI class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: tmp this % pos = photon_origin % pos this % nxp = photon_origin % nxp this % nyp = photon_origin % nyp this % nzp = photon_origin % nzp this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % tflag = . false . this % bounces = 0 this % cnts = 0 this % weight = 1.0_wp call spectrum % p % sample ( this % wavelength , tmp ) this % energy = 1.0_wp this % fact = TWOPI / this % wavelength ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine pencil subroutine dslit ( this , spectrum , dict , seqs ) !!sample from double slit to produce diff pattern ! todo add in user defined slit widths ! add correct normalisation use random , only : ranu , ran2 , randint , seq use sim_state_mod , only : state use tomlf , only : toml_table , get_value use constants , only : TWOPI use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: x1 , y1 , z1 , x2 , y2 , z2 , a , b , tmp call spectrum % p % sample ( this % wavelength , tmp ) this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) a = 6 0._wp * this % wavelength !distance between slits b = 2 0._wp * this % wavelength !2 slit width if ( ran2 () > 0.5_wp ) then ! pick slit and sample x, y position x1 = ranu ( a / 2._wp , a / 2._wp + b ) y1 = ranu ( - b * 0.5_wp , b * 0.5_wp ) else x1 = ranu ( - a / 2._wp , - a / 2._wp - b ) y1 = ranu ( - b * 0.5_wp , b * 0.5_wp ) end if z2 = 5.0_wp - ( 1.e-5_wp * ( 2._wp * ( 5.0_wp / 40 0._wp ))) x2 = ranu ( - 5.0_wp , 5.0_wp ) y2 = ranu ( - 5.0_wp , 5.0_wp ) z1 = ( 1000 0._wp * this % wavelength ) - 5.0_wp !screen location this % pos % x = x2 this % pos % y = y2 this % pos % z = z2 this % phase = sqrt (( x2 - x1 ) ** 2 + ( y2 - y1 ) ** 2 + ( z2 - z1 ) ** 2 ) this % nxp = ( x2 - x1 ) / this % phase this % nyp = ( y2 - y1 ) / this % phase this % nzp = - abs (( z2 - z1 )) / this % phase this % tflag = . false . this % cnts = 0 this % bounces = 0 this % weight = 1.0_wp !Set direction cosine/sine this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine dslit subroutine aperture ( this , spectrum , dict , seqs ) !! sample from square aperture to produce diff pattern !add user defined apwid and F ! add correct normalisation use random , only : ranu , ran2 , randint , seq use sim_state_mod , only : state use tomlf , only : toml_table , get_value use constants , only : TWOPI use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: x1 , y1 , z1 , x2 , y2 , z2 , b , F , apwid , tmp call spectrum % p % sample ( this % wavelength , tmp ) this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) apwid = 20 0e-6_wp !aperture width b = apwid / 2._wp !slit width ! Fresnel number F = 4.95_wp !sample aperture postiion x1 = ranu ( - b , b ) y1 = ranu ( - b , b ) z1 = ( 1._wp / (((( F / apwid ) ** 2 ) / 2._wp ) * this % wavelength )) - 0.5_wp x2 = ranu ( - 0.5_wp , 0.5_wp ) y2 = ranu ( - 0.5_wp , 0.5_wp ) z2 = 0.5_wp - ( 1.e-5_wp * ( 2._wp * 0.5_wp / 40 0._wp )) this % pos % x = x2 this % pos % y = y2 this % pos % z = z2 this % phase = sqrt (( x2 - x1 ) ** 2 + ( y2 - y1 ) ** 2 + ( z2 - z1 ) ** 2 ) this % nxp = ( x2 - x1 ) / this % phase this % nyp = ( y2 - y1 ) / this % phase this % nzp = - abs (( z2 - z1 )) / this % phase this % tflag = . false . this % cnts = 0 this % bounces = 0 this % weight = 1.0_wp !scattering stuff - not important this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine aperture subroutine annulus ( this , spectrum , dict , seqs ) !! annular source use constants , only : TWOPI use utils , only : deg2rad use tomlf , only : toml_table , get_value use random , only : ran2 , rang , seq use sim_state_mod , only : state use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) character ( len = :), allocatable :: beam_type real ( kind = wp ) :: beta , rlo , rhi , radius , tmp , mid , angle , x , y , z , phi , sinp , cosp type ( vector ) :: pos integer :: cell ( 3 ) call get_value ( dict , \"beta\" , beta ) call get_value ( dict , \"radius\" , rlo ) call get_value ( dict , \"radius_hi\" , rhi ) call get_value ( dict , \"annulus_type\" , beam_type ) if ( beam_type == \"tophat\" ) then radius = rlo + ( rhi - rlo ) * sqrt ( ran2 ()) elseif ( beam_type == \"gaussian\" ) then mid = ( rhi - rlo ) / 2. call rang ( radius , tmp , mid , 0.04_wp ) else error stop \"No such beam type!\" end if phi = TWOPI * ran2 () angle = deg2rad ( beta ) cosp = cos ( phi ) sinp = sin ( phi ) x = radius * cosp y = radius * sinp z = state % grid % zmax - 1e-8_wp ! just inside surface of medium. TODO make this user configurable? pos = vector ( x , y , z ) this % pos = pos this % nxp = sin ( angle ) * cosp this % nyp = sin ( angle ) * sinp this % nzp = - cos ( angle ) this % phi = phi this % cosp = cosp this % sinp = sinp this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % tflag = . false . this % bounces = 0 this % cnts = 0 this % weight = 1.0_wp call spectrum % p % sample ( this % wavelength , tmp ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine annulus subroutine scatter ( this , hgg , g2 , dects ) !! Scattering routine. Implments both isotropic and henyey-greenstein scattering !! taken from [mcxyz](https://omlc.org/software/mc/mcxyz/index.html) use constants , only : PI , TWOPI , wp use random , only : ran2 use detectors , only : dect_array class ( photon ), intent ( inout ) :: this !> g factor real ( kind = wp ), intent ( in ) :: hgg !> g factor squared real ( kind = wp ), intent ( in ) :: g2 !> array of detectors. Only used if biased scattering is enabled. type ( dect_array ), optional , intent ( in ) :: dects (:) real ( kind = wp ) :: temp , uxx , uyy , uzz , a , p a = 0.9_wp p = 0.0_wp if ( hgg == 0.0_wp ) then !isotropic scattering this % cost = 2._wp * ran2 () - 1._wp else !henyey-greenstein scattering if ( ran2 () < p . and . present ( dects )) then !bias scattering temp = ran2 () * (( 1._wp / ( 1._wp - a )) - ( 1._wp / sqrt ( a ** 2 + 1._wp ))) + ( 1._wp / sqrt ( a ** 2 + 1._wp )) temp = temp ** ( - 2._wp ) this % cost = ( 1._wp / ( 2._wp * a )) * ( a ** 2 + 1._wp - temp ) this % nxp = dects ( 1 )% p % pos % x - this % pos % x this % nyp = dects ( 1 )% p % pos % y - this % pos % y this % nzp = dects ( 1 )% p % pos % z - this % pos % z else !unbiased temp = ( 1.0_wp - g2 ) / ( 1.0_wp - hgg + 2._wp * hgg * ran2 ()) this % cost = ( 1.0_wp + g2 - temp ** 2 ) / ( 2._wp * hgg ) end if end if this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % phi = TWOPI * ran2 () this % cosp = cos ( this % phi ) if ( this % phi < PI ) then this % sinp = sqrt ( 1._wp - this % cosp ** 2 ) else this % sinp = - sqrt ( 1._wp - this % cosp ** 2 ) end if if ( 1._wp - abs ( this % nzp ) <= 1e-12_wp ) then ! near perpindicular uxx = this % sint * this % cosp uyy = this % sint * this % sinp uzz = sign ( this % cost , this % nzp ) else temp = sqrt ( 1._wp - this % nzp ** 2 ) uxx = this % sint * ( this % nxp * this % nzp * this % cosp - this % nyp * this % sinp ) / temp + this % nxp * this % cost uyy = this % sint * ( this % nyp * this % nzp * this % cosp + this % nxp * this % sinp ) / temp + this % nyp * this % cost uzz = - 1._wp * this % sint * this % cosp * temp + this % nzp * this % cost end if this % nxp = uxx this % nyp = uyy this % nzp = uzz end subroutine scatter end module photonMod","tags":"","loc":"sourcefile/photon.f90.html"},{"title":"surfaces.f90 – signedMCRT","text":"Contents Modules surfaces Source Code surfaces.f90 Source Code module surfaces !! Contains the routines that handle reflection, and refraction via the Fresnel equations. use vector_class , only : vector use constants , only : wp implicit none private public :: reflect_refract contains subroutine reflect_refract ( I , N , n1 , n2 , rflag , ri ) !! wrapper routine for fresnel calculation use random , only : ran2 !> incident vector type ( vector ), intent ( INOUT ) :: I !> normal vector type ( vector ), intent ( INOUT ) :: N !> refractive indices real ( kind = wp ), intent ( IN ) :: n1 , n2 real ( kind = wp ), intent ( OUT ) :: Ri !> reflection flag logical , intent ( OUT ) :: rflag rflag = . FALSE . !draw random number, if less than fresnel coefficents, then reflect, else refract Ri = fresnel ( I , N , n1 , n2 ) if ( ran2 () <= Ri ) then call reflect ( I , N ) rflag = . true . else call refract ( I , N , n1 / n2 ) end if end subroutine reflect_refract subroutine reflect ( I , N ) !! get vector of reflected photon !> incident vector type ( vector ), intent ( INOUT ) :: I !> normal vector type ( vector ), intent ( IN ) :: N type ( vector ) :: R R = I - 2._wp * ( N . dot . I ) * N I = R end subroutine reflect subroutine refract ( I , N , eta ) !! get vector of refracted photon !> incident vector type ( vector ), intent ( INOUT ) :: I !> normal vector type ( vector ), intent ( IN ) :: N !> \\eta = \\frac{n_1}{n_2} real ( kind = wp ), intent ( IN ) :: eta type ( vector ) :: T , Ntmp real ( kind = wp ) :: c1 , c2 Ntmp = N c1 = ( Ntmp . dot . I ) if ( c1 < 0._wp ) then c1 = - c1 else Ntmp = ( - 1._wp ) * N end if c2 = sqrt ( 1._wp - ( eta ) ** 2 * ( 1._wp - c1 ** 2 )) T = eta * I + ( eta * c1 - c2 ) * Ntmp I = T end subroutine refract function fresnel ( I , N , n1 , n2 ) result ( tir ) !! calculates the fresnel coefficents use ieee_arithmetic , only : ieee_is_nan !> reffractive indicies real ( kind = wp ), intent ( IN ) :: n1 , n2 !> incident vector type ( vector ), intent ( IN ) :: I !> Normal vector type ( vector ), intent ( IN ) :: N real ( kind = wp ) :: costt , sintt , sint2 , cost2 , tir , f1 , f2 costt = abs ( I . dot . N ) sintt = sqrt ( 1._wp - costt * costt ) sint2 = n1 / n2 * sintt if ( sint2 > 1._wp ) then tir = 1.0_wp return elseif ( costt == 1._wp ) then tir = 0._wp return else sint2 = ( n1 / n2 ) * sintt cost2 = sqrt ( 1._wp - sint2 * sint2 ) f1 = abs (( n1 * costt - n2 * cost2 ) / ( n1 * costt + n2 * cost2 )) ** 2 f2 = abs (( n1 * cost2 - n2 * costt ) / ( n1 * cost2 + n2 * costt )) ** 2 tir = 0.5_wp * ( f1 + f2 ) if ( ieee_is_nan ( tir ) . or . tir > 1._wp . or . tir < 0._wp ) print * , 'TIR: ' , tir , f1 , f2 , costt , sintt , cost2 , sint2 return end if end function fresnel end module surfaces","tags":"","loc":"sourcefile/surfaces.f90.html"},{"title":"setup.f90 – signedMCRT","text":"Contents Modules setupMod Source Code setup.f90 Source Code module setupMod !! This file sets up some simulations variables and assigns the geometry for the simulation. use constants , only : wp use tomlf implicit none private public :: setup_simulation , dealloc_array , directory contains subroutine setup_simulation ( sdfarray , dict ) !! Read in parameters !! Setup up various simulation parameters and routines use sdfs , only : sdf use setupGeometry use sim_state_mod , only : settings => state use vector_class !> dictionary used to store metadata type ( toml_table ), optional , intent ( INOUT ) :: dict !> output array of geometry type ( sdf ), allocatable , intent ( OUT ) :: sdfarray (:) !allocate and set arrays to 0 call alloc_array ( settings % grid % nxg , settings % grid % nyg , settings % grid % nzg ) call zarray () ! setup geometry using SDFs select case ( settings % experiment ) case ( \"logo\" ) sdfarray = setup_logo () case ( \"omg\" ) sdfarray = setup_omg_sdf () case ( \"scat_test\" ) sdfarray = setup_scat_test ( dict ) case ( \"scat_test2\" ) sdfarray = setup_scat_test2 ( dict ) case ( \"aptran\" ) sdfarray = setup_sphere () case ( \"vessels\" ) sdfarray = get_vessels () case ( \"sphere_scene\" ) sdfarray = setup_sphere_scene ( dict ) case ( \"test_egg\" ) sdfarray = setup_egg () case default error stop \"no such routine\" end select end subroutine setup_simulation subroutine directory () !! subroutine defines vars to hold paths to various folders use constants , only : homedir , fileplace , resdir character ( len = 256 ) :: cwd logical :: dataExists , jmeanExists , depositExists , detectorsExists , phasorExists !get current working directory call get_environment_variable ( 'PWD' , cwd ) ! get 'home' dir from cwd homedir = trim ( cwd ) ! get data dir fileplace = trim ( homedir ) // '/data/' !check if data directory and subdirectories exists. if not create it #ifdef __GFORTRAN__ inquire ( file = trim ( fileplace ) // \"/.\" , exist = dataExists ) inquire ( file = trim ( fileplace ) // \"/jmean/.\" , exist = jmeanExists ) inquire ( file = trim ( fileplace ) // \"/deposit/.\" , exist = depositExists ) inquire ( file = trim ( fileplace ) // \"/detectors/.\" , exist = detectorsExists ) inquire ( file = trim ( fileplace ) // \"/phasor/.\" , exist = phasorExists ) #elif __INTEL_COMPILER inquire ( directory = trim ( fileplace ), exist = dataExists ) inquire ( directory = trim ( fileplace ) // \"/jmean\" , exist = jmeanExists ) inquire ( directory = trim ( fileplace ) // \"/deposit\" , exist = depositExists ) inquire ( directory = trim ( fileplace ) // \"/detectors\" , exist = detectorsExists ) inquire ( directory = trim ( fileplace ) // \"/phasor\" , exist = phasorExists ) #else error stop \"Compiler not supported!\" #endif if (. not . dataExists ) then call create_directory ( \"\" , dataExists , \"\" , . false .) call create_directory ( \"jmean/\" , jmeanExists , \"data/\" , . false .) call create_directory ( \"deposit/\" , depositExists , \"data/\" , . false .) call create_directory ( \"detectors/\" , detectorsExists , \"data/\" , . false .) call create_directory ( \"phasor/\" , phasorExists , \"data/\" , . false .) else call create_directory ( \"jmean/\" , jmeanExists , \"data/\" , . true .) call create_directory ( \"deposit/\" , depositExists , \"data/\" , . true .) call create_directory ( \"detectors/\" , detectorsExists , \"data/\" , . true .) call create_directory ( \"phasor/\" , phasorExists , \"data/\" , . true .) end if ! get res dir resdir = trim ( homedir ) // '/res/' end subroutine directory subroutine create_directory ( name , flag , appendname , newline ) !! create directories if they don't exist use constants , only : fileplace character ( * ), intent ( in ) :: name , appendname logical , intent ( in ) :: flag logical , optional , intent ( in ) :: newline character ( len = :), allocatable :: mkdirCMD if (. not . flag ) then mkdirCMD = \"mkdir -p \" // trim ( fileplace ) // name call execute_command_line ( mkdirCMD ) ! output correct message for base data dir if ( len ( name ) == 0 ) then mkdirCMD = \"Created \" // appendname // \"data/\" else mkdirCMD = \"Created \" // appendname // name end if if ( newline ) mkdirCMD = mkdirCMD // new_line ( \"a\" ) print * , mkdirCMD end if end subroutine create_directory subroutine zarray !! zero data arrays use iarray !sets all arrays to zer phasor = 0._wp phasorGLOBAL = 0._wp jmean = 0._wp jmeanGLOBAL = 0._wp absorb = 0.0_wp absorbGLOBAL = 0.0_wp end subroutine zarray subroutine alloc_array ( nxg , nyg , nzg ) !! subroutine allocates allocatable arrays use iarray !> grid size integer , intent ( IN ) :: nxg , nyg , nzg allocate ( phasor ( nxg , nyg , nzg ), phasorGLOBAL ( nxg , nyg , nzg )) allocate ( jmean ( nxg , nyg , nzg ), jmeanGLOBAL ( nxg , nyg , nzg )) allocate ( absorb ( nxg , nyg , nzg ), absorbGLOBAL ( nxg , nyg , nzg )) end subroutine alloc_array subroutine dealloc_array () !! deallocate data arrays use iarray deallocate ( jmean ) deallocate ( jmeanGLOBAL ) deallocate ( absorb ) deallocate ( absorbGLOBAL ) deallocate ( phasor ) deallocate ( phasorGLOBAL ) end subroutine dealloc_array end module setupMod","tags":"","loc":"sourcefile/setup.f90.html"},{"title":"mat_class.f90 – signedMCRT","text":"Contents Modules mat_class Source Code mat_class.f90 Source Code module mat_class !! Matrix class module. Defines a matrix type (4x4 matrix) and associated operations on matrices and other types. use constants , only : wp use vec4_class !! not fully implmented matix class !! minimum implmented for neural sdf type type :: mat !> Matrix values real ( kind = wp ) :: vals ( 4 , 4 ) contains !> Overload for Division operator generic :: operator ( / ) => mat_div_scal !> Overload for Multiplication operator generic :: operator ( * ) => mat_mult_scal , scal_mult_mat , mat_mult_mat !> Overload for Addition operator generic :: operator ( + ) => mat_add_scal , scal_add_mat !> Overload for Subtraction operator generic :: operator ( - ) => mat_minus_scal procedure , pass ( a ), private :: mat_div_scal procedure , pass ( a ), private :: mat_mult_mat procedure , pass ( a ), private :: mat_mult_scal procedure , pass ( b ), private :: scal_mult_mat procedure , pass ( a ), private :: mat_add_scal procedure , pass ( b ), private :: scal_add_mat procedure , pass ( a ), private :: mat_minus_scal end type mat interface mat !! Intalise Matrix with 1D Array module procedure mat_init end interface mat private public :: mat , invert contains type ( mat ) function mat_init ( array ) !! Initalise matrix type from 1D array !> 1D array to initalise from. real ( kind = wp ) :: array ( 16 ) integer :: i , cnt cnt = 1 do i = 1 , 4 mat_init % vals (:, i ) = array ( cnt : cnt + 3 ) cnt = cnt + 4 end do end function mat_init type ( mat ) function mat_add_scal ( a , b ) !! Matrix + Scalar = Matrix !> Input Matrix class ( mat ), intent ( IN ) :: a !> Scalar to add real ( kind = wp ), intent ( IN ) :: b mat_add_scal % vals = a % vals + b end function mat_add_scal type ( mat ) function scal_add_mat ( a , b ) !! Scaler + Matrix !> Input Matrix class ( mat ), intent ( IN ) :: b !> Scalat to add real ( kind = wp ), intent ( IN ) :: a scal_add_mat % vals = b % vals + a end function scal_add_mat type ( mat ) function mat_minus_scal ( a , b ) !! Matrix - Scalar !> Input Matrix class ( mat ), intent ( IN ) :: a !> Scalar to subtract real ( kind = wp ), intent ( IN ) :: b mat_minus_scal % vals = a % vals - b end function mat_minus_scal type ( mat ) function mat_div_scal ( a , b ) !! Matrix / scalar !> Input Matrix class ( mat ), intent ( IN ) :: a !> Scalar to divide by real ( kind = wp ), intent ( IN ) :: b mat_div_scal % vals = a % vals / b end function mat_div_scal type ( mat ) function mat_mult_scal ( a , b ) !! Matrix * Scalar !> Input Matrix class ( mat ), intent ( IN ) :: a !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: b mat_mult_scal % vals = a % vals * b end function mat_mult_scal type ( mat ) function scal_mult_mat ( a , b ) !! Matrix * Scalar !> Input Matrix class ( mat ), intent ( IN ) :: b !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: a scal_mult_mat % vals = b % vals * a end function scal_mult_mat type ( vec4 ) function mat_mult_mat ( a , b ) !! Matrix * vec4 use vec4_class !> Input Matrix class ( mat ), intent ( IN ) :: a !> Vec4 to multiply by type ( vec4 ), intent ( IN ) :: b real ( kind = wp ) :: tmp ( 4 ) tmp = matmul ( a % vals , [ b % x , b % y , b % z , b % p ]) mat_mult_mat = vec4 ( tmp ( 1 ), tmp ( 2 ), tmp ( 3 ), tmp ( 4 )) end function mat_mult_mat pure function invert ( A ) result ( B ) !! Performs a direct calculation of the inverse of a 4×4 matrix. !! from http://fortranwiki.org/fortran/show/Matrix+inversion !> Input Matric real ( kind = wp ), intent ( in ) :: A ( 4 , 4 ) real ( kind = wp ) :: B ( 4 , 4 ) ! Inverse matrix real ( kind = wp ) :: detinv ! Calculate the inverse determinant of the matrix detinv = & 1._wp / ( A ( 1 , 1 ) * ( A ( 2 , 2 ) * ( A ( 3 , 3 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 3 )) + & A ( 2 , 3 ) * ( A ( 3 , 4 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 2 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 2 )))& - A ( 1 , 2 ) * ( A ( 2 , 1 ) * ( A ( 3 , 3 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 3 )) + & A ( 2 , 3 ) * ( A ( 3 , 4 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 1 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 1 )))& + A ( 1 , 3 ) * ( A ( 2 , 1 ) * ( A ( 3 , 2 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 2 )) + & A ( 2 , 2 ) * ( A ( 3 , 4 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 1 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 1 )))& - A ( 1 , 4 ) * ( A ( 2 , 1 ) * ( A ( 3 , 2 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 2 )) + & A ( 2 , 2 ) * ( A ( 3 , 3 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 3 )) + A ( 2 , 3 ) * ( A ( 3 , 1 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 1 )))) ! Calculate the inverse of the matrix B ( 1 , 1 ) = detinv * ( A ( 2 , 2 ) * ( A ( 3 , 3 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 3 )) + & A ( 2 , 3 ) * ( A ( 3 , 4 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 2 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 2 ))) B ( 2 , 1 ) = detinv * ( A ( 2 , 1 ) * ( A ( 3 , 4 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 4 )) + & A ( 2 , 3 ) * ( A ( 3 , 1 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 1 )) + A ( 2 , 4 ) * ( A ( 3 , 3 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 3 ))) B ( 3 , 1 ) = detinv * ( A ( 2 , 1 ) * ( A ( 3 , 2 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 2 )) + & A ( 2 , 2 ) * ( A ( 3 , 4 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 1 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 1 ))) B ( 4 , 1 ) = detinv * ( A ( 2 , 1 ) * ( A ( 3 , 3 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 3 )) + & A ( 2 , 2 ) * ( A ( 3 , 1 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 1 )) + A ( 2 , 3 ) * ( A ( 3 , 2 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 2 ))) B ( 1 , 2 ) = detinv * ( A ( 1 , 2 ) * ( A ( 3 , 4 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 4 )) + & A ( 1 , 3 ) * ( A ( 3 , 2 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 2 )) + A ( 1 , 4 ) * ( A ( 3 , 3 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 3 ))) B ( 2 , 2 ) = detinv * ( A ( 1 , 1 ) * ( A ( 3 , 3 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 3 )) + & A ( 1 , 3 ) * ( A ( 3 , 4 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 4 )) + A ( 1 , 4 ) * ( A ( 3 , 1 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 1 ))) B ( 3 , 2 ) = detinv * ( A ( 1 , 1 ) * ( A ( 3 , 4 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 4 )) + & A ( 1 , 2 ) * ( A ( 3 , 1 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 1 )) + A ( 1 , 4 ) * ( A ( 3 , 2 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 2 ))) B ( 4 , 2 ) = detinv * ( A ( 1 , 1 ) * ( A ( 3 , 2 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 2 )) + & A ( 1 , 2 ) * ( A ( 3 , 3 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 3 )) + A ( 1 , 3 ) * ( A ( 3 , 1 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 1 ))) B ( 1 , 3 ) = detinv * ( A ( 1 , 2 ) * ( A ( 2 , 3 ) * A ( 4 , 4 ) - A ( 2 , 4 ) * A ( 4 , 3 )) + & A ( 1 , 3 ) * ( A ( 2 , 4 ) * A ( 4 , 2 ) - A ( 2 , 2 ) * A ( 4 , 4 )) + A ( 1 , 4 ) * ( A ( 2 , 2 ) * A ( 4 , 3 ) - A ( 2 , 3 ) * A ( 4 , 2 ))) B ( 2 , 3 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 4 ) * A ( 4 , 3 ) - A ( 2 , 3 ) * A ( 4 , 4 )) + & A ( 1 , 3 ) * ( A ( 2 , 1 ) * A ( 4 , 4 ) - A ( 2 , 4 ) * A ( 4 , 1 )) + A ( 1 , 4 ) * ( A ( 2 , 3 ) * A ( 4 , 1 ) - A ( 2 , 1 ) * A ( 4 , 3 ))) B ( 3 , 3 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 2 ) * A ( 4 , 4 ) - A ( 2 , 4 ) * A ( 4 , 2 )) + & A ( 1 , 2 ) * ( A ( 2 , 4 ) * A ( 4 , 1 ) - A ( 2 , 1 ) * A ( 4 , 4 )) + A ( 1 , 4 ) * ( A ( 2 , 1 ) * A ( 4 , 2 ) - A ( 2 , 2 ) * A ( 4 , 1 ))) B ( 4 , 3 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 3 ) * A ( 4 , 2 ) - A ( 2 , 2 ) * A ( 4 , 3 )) + & A ( 1 , 2 ) * ( A ( 2 , 1 ) * A ( 4 , 3 ) - A ( 2 , 3 ) * A ( 4 , 1 )) + A ( 1 , 3 ) * ( A ( 2 , 2 ) * A ( 4 , 1 ) - A ( 2 , 1 ) * A ( 4 , 2 ))) B ( 1 , 4 ) = detinv * ( A ( 1 , 2 ) * ( A ( 2 , 4 ) * A ( 3 , 3 ) - A ( 2 , 3 ) * A ( 3 , 4 )) + & A ( 1 , 3 ) * ( A ( 2 , 2 ) * A ( 3 , 4 ) - A ( 2 , 4 ) * A ( 3 , 2 )) + A ( 1 , 4 ) * ( A ( 2 , 3 ) * A ( 3 , 2 ) - A ( 2 , 2 ) * A ( 3 , 3 ))) B ( 2 , 4 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 3 ) * A ( 3 , 4 ) - A ( 2 , 4 ) * A ( 3 , 3 )) + & A ( 1 , 3 ) * ( A ( 2 , 4 ) * A ( 3 , 1 ) - A ( 2 , 1 ) * A ( 3 , 4 )) + A ( 1 , 4 ) * ( A ( 2 , 1 ) * A ( 3 , 3 ) - A ( 2 , 3 ) * A ( 3 , 1 ))) B ( 3 , 4 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 4 ) * A ( 3 , 2 ) - A ( 2 , 2 ) * A ( 3 , 4 )) + & A ( 1 , 2 ) * ( A ( 2 , 1 ) * A ( 3 , 4 ) - A ( 2 , 4 ) * A ( 3 , 1 )) + A ( 1 , 4 ) * ( A ( 2 , 2 ) * A ( 3 , 1 ) - A ( 2 , 1 ) * A ( 3 , 2 ))) B ( 4 , 4 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 2 ) * A ( 3 , 3 ) - A ( 2 , 3 ) * A ( 3 , 2 )) + & A ( 1 , 2 ) * ( A ( 2 , 3 ) * A ( 3 , 1 ) - A ( 2 , 1 ) * A ( 3 , 3 )) + A ( 1 , 3 ) * ( A ( 2 , 1 ) * A ( 3 , 2 ) - A ( 2 , 2 ) * A ( 3 , 1 ))) end function invert end module mat_class ! Program p ! use mat_class ! use vec4_class ! implicit none ! real(kind=wp) :: array(16) ! type(mat) :: m ! type(vec4) :: v4 ! v4 = vec4(1., 1., 1., 1.) ! array = [1., 1., 1., 1., 2., 2., 2., 2., 3., 3., 3., 3., 4., 4., 4., 4.] ! m = mat(array) ! write(*,\"(4f9.5)\")m%vals ! m = m + 1. ! print*,\" \" ! write(*,\"(4f9.5)\")m%vals ! m = 1. + m ! print*,\" \" ! write(*,\"(4f9.5)\")m%vals ! m = m - 2. ! print*,\" \" ! write(*,\"(4f9.5)\")m%vals ! m = m / 2. ! print*,\" \" ! write(*,\"(4f9.5)\")m%vals ! m = m * 2. ! print*,\" \" ! write(*,\"(4f9.5)\")m%vals ! ! m = 2. * m ! ! print*,\" \" ! ! write(*,\"(4f9.5)\")m%vals ! v4 = m * v4 ! print*,\" \" ! write(*,\"(4f9.5)\")v4 ! end program p","tags":"","loc":"sourcefile/mat_class.f90.html"},{"title":"historyStack.f90 – signedMCRT","text":"Contents Modules historyStack Source Code historyStack.f90 Source Code module historyStack !! Module contains the history stack type which stores the history of positions of a photon and th I/O routines !! not fully implmented use constants , only : wp use vec4_class , only : vec4 implicit none type :: history_stack_t type ( vec4 ), allocatable :: data (:) integer :: size , vertex_counter , edge_counter character ( len = :), allocatable :: filename , type contains procedure :: pop => histpop_fn procedure :: push => histpush_sub procedure :: peek => histpeek_fn procedure :: empty => histempty_fn procedure :: zero => histzero_sub procedure :: write => histwrite_sub procedure :: finish => histfinish_sub end type history_stack_t interface history_stack_t module procedure init_historyStack end interface integer , parameter :: block_size = 32 private public :: history_stack_t contains type ( history_stack_t ) function init_historyStack ( filename , id ) use utils , only : str use constants , only : fileplace character ( * ), intent ( in ) :: filename integer , intent ( in ) :: id character ( len = :), allocatable :: new_filename integer :: idx logical :: res idx = index ( filename , \".\" ) new_filename = filename ( 1 : idx - 1 ) // \"_\" // str ( id , 3 ) // filename ( idx :) init_historyStack % filename = new_filename if ( index ( new_filename , \"obj\" ) /= 0 ) then init_historyStack % type = \"obj\" elseif ( index ( new_filename , \"ply\" ) /= 0 ) then init_historyStack % type = \"ply\" elseif ( index ( new_filename , \"json\" ) /= 0 ) then init_historyStack % type = \"json\" else error stop \"Unsupported filetype for track History!\" end if inquire ( file = trim ( fileplace ) // new_filename , exist = res ) if ( res ) then print * , \"Deleting existing trackHistory files!\" call execute_command_line ( \"rm \" // trim ( fileplace ) // new_filename ) call execute_command_line ( \"rm \" // trim ( fileplace ) // \"scalars000.dat\" ) call execute_command_line ( \"rm \" // trim ( fileplace ) // new_filename // \"2\" ) end if init_historyStack % size = 0 init_historyStack % vertex_counter = 0 init_historyStack % edge_counter = 0 end function init_historyStack type ( vec4 ) function histpop_fn ( this ) class ( history_stack_t ) :: this if ( this % size == 0 . or . . not . allocated ( this % data )) then histpop_fn = vec4 ( - 9 9._wp , - 9 9._wp , - 9 9._wp , - 9 9._wp ) return end if histpop_fn = this % data ( this % size ) this % size = this % size - 1 end function histpop_fn subroutine histpush_sub ( this , val ) class ( history_stack_t ) :: this type ( vec4 ), intent ( in ) :: val type ( vec4 ), allocatable :: tmp (:) if (. not . allocated ( this % data ) . or . size ( this % data ) == 0 ) then !allocate space if not yet allocated allocate ( this % data ( block_size )) elseif ( this % size == size ( this % data )) then allocate ( tmp ( size ( this % data ) + block_size )) tmp ( 1 : this % size ) = this % data call move_alloc ( tmp , this % data ) end if this % size = this % size + 1 this % data ( this % size ) = val end subroutine histpush_sub type ( vec4 ) function histpeek_fn ( this ) class ( history_stack_t ) :: this if ( this % size == 0 . or . . not . allocated ( this % data )) then histpeek_fn = vec4 ( - 9 9._wp , - 9 9._wp , - 9 9._wp , - 9 9._wp ) return end if histpeek_fn = this % data ( this % size ) end function histpeek_fn logical function histempty_fn ( this ) class ( history_stack_t ) :: this histempty_fn = ( this % size == 0 . or . . not . allocated ( this % data )) end function histempty_fn subroutine histzero_sub ( this ) class ( history_stack_t ) :: this if ( allocated ( this % data )) deallocate ( this % data ) this % size = 0 end subroutine histzero_sub subroutine histwrite_sub ( this ) class ( history_stack_t ) :: this select case ( this % type ) case ( \"obj\" ) call obj_writer ( this ) case ( \"ply\" ) call ply_writer ( this ) case ( \"json\" ) call json_writer ( this ) case default error stop \"No such output type \" // this % type end select end subroutine histwrite_sub subroutine histfinish_sub ( this ) use constants , only : fileplace use utils , only : str class ( history_stack_t ) :: this integer :: u select case ( trim ( this % type )) case ( \"obj\" ) call execute_command_line ( \"cat \" // trim ( fileplace ) // this % filename // \"2 >> \" // trim ( fileplace ) // this % filename ) case ( \"ply\" ) ! this is the easiest way to edit the vertex count as we don't know how many photons we will track when writing the header. ! this saves storing all photons data in RAM for duration of simulation. ! taken from: https://stackoverflow.com/a/11145362 call execute_command_line ( \"sed -i '3s#.*#element vertex \" // str ( this % vertex_counter ) // \"#' \" // trim ( fileplace ) // this % filename ) call execute_command_line ( \"sed -i '7s#.*#element edge \" // str ( this % edge_counter ) // \"#' \" // trim ( fileplace ) // this % filename ) call execute_command_line ( \"cat \" // trim ( fileplace ) // this % filename // \"2 >> \" // trim ( fileplace ) // this % filename ) case ( \"json\" ) open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"old\" , position = \"append\" ) write ( u , \"(a)\" ) \"}\" close ( u ) case default error stop \"No such output type \" // this % type end select end subroutine histfinish_sub subroutine obj_writer ( this ) use constants , only : fileplace use utils , only : str use omp_lib type ( history_stack_t ), intent ( inout ) :: this type ( vec4 ) :: v integer :: u , io , id , counter , ioi logical :: res id = 0 inquire ( file = trim ( fileplace ) // this % filename , exist = res ) if ( res ) then open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"old\" , position = \"append\" ) open ( newunit = io , file = trim ( fileplace ) // this % filename // \"2\" , status = \"old\" , position = \"append\" ) open ( newunit = ioi , file = trim ( fileplace ) // \"scalars\" // str ( id , 3 ) // \".dat\" , status = \"old\" , position = \"append\" ) else open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"new\" ) open ( newunit = io , file = trim ( fileplace ) // this % filename // \"2\" , status = \"new\" ) open ( newunit = ioi , file = trim ( fileplace ) // \"scalars\" // str ( id , 3 ) // \".dat\" , status = \"new\" ) end if v = this % pop () ! write lines if ( this % size >= 1 ) write ( io , \"(a)\" , advance = \"no\" ) \"l \" do counter = this % vertex_counter + 1 , this % vertex_counter + this % size , 2 write ( io , \"(2(i0,1x))\" , advance = \"no\" ) counter , counter + 1 end do close ( io ) !write vertices do while (. not . this % empty ()) v = this % pop () write ( u , \"(a,1x,3(es15.8e2,1x))\" ) \"v\" , v % x , v % y , v % z write ( ioi , \"(es15.8e2)\" ) v % p this % vertex_counter = this % vertex_counter + 1 end do close ( u ) close ( ioi ) end subroutine obj_writer subroutine ply_writer ( this ) use constants , only : fileplace use utils , only : str type ( history_stack_t ), intent ( inout ) :: this integer :: io , counter , i , u logical :: res type ( vec4 ) :: v inquire ( file = trim ( fileplace ) // this % filename , exist = res ) if ( res ) then open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"old\" , position = \"append\" ) else open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"new\" ) write ( u , \"(a)\" ) \"ply\" // new_line ( \"a\" ) // \"format ascii 1.0\" // new_line ( \"a\" ) // \"element vertex \" // str ( this % size ) write ( u , \"(a)\" ) \"property float x\" write ( u , \"(a)\" ) \"property float y\" write ( u , \"(a)\" ) \"property float z\" write ( u , \"(a)\" ) \"element edge\" write ( u , \"(a)\" ) \"property int vertex1\" write ( u , \"(a)\" ) \"property int vertex2\" write ( u , \"(a)\" ) \"end_header\" end if inquire ( file = trim ( fileplace ) // this % filename // \"2\" , exist = res ) if ( res ) then open ( newunit = io , file = trim ( fileplace ) // this % filename // \"2\" , status = \"old\" , position = \"append\" ) else open ( newunit = io , file = trim ( fileplace ) // this % filename // \"2\" , status = \"new\" ) end if counter = this % vertex_counter do i = 1 , this % size - 1 write ( io , \"(2(i0,1x))\" ) counter , counter + 1 counter = counter + 1 this % edge_counter = this % edge_counter + 1 end do close ( io ) do while (. not . this % empty ()) v = this % pop () write ( u , \"(3(es15.8e2,1x))\" ) v % x , v % y , v % z this % vertex_counter = this % vertex_counter + 1 end do close ( u ) end subroutine ply_writer subroutine json_writer ( this ) use constants , only : fileplace use utils , only : str type ( history_stack_t ), intent ( inout ) :: this logical :: res integer :: id , u integer , save :: counter = 0 type ( vec4 ) :: v id = 0 !omp_() if ( id == 0 ) then inquire ( file = trim ( fileplace ) // this % filename , exist = res ) if ( res ) then open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"old\" , position = \"append\" ) write ( u , \"(a)\" ) \",\" // new_line ( \"a\" ) // '\"' // str ( counter ) // '_' // str ( id ) // '\": ' // \"[\" else open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"new\" ) write ( u , \"(a)\" ) \"{\" // new_line ( \"a\" ) // '\"' // str ( counter ) // '_' // str ( id ) // '\": ' // \"[\" end if counter = counter + 1 do while (. not . this % empty ()) v = this % pop () if ( this % size /= 0 ) then write ( u , \"(a,3(es15.8e2,a))\" ) \"[\" , v % x , \",\" , v % y , \",\" , v % z , \"],\" else write ( u , \"(a,3(es15.8e2,a))\" ) \"[\" , v % x , \",\" , v % y , \",\" , v % z , \"]\" end if end do write ( u , \"(a)\" ) \"]\" close ( u ) end if end subroutine json_writer end module historyStack","tags":"","loc":"sourcefile/historystack.f90.html"},{"title":"vector_class.f90 – signedMCRT","text":"Contents Modules vector_class Source Code vector_class.f90 Source Code module vector_class !! Vector class module. Defines a vector type (x, y, z) and associated operations on vectors and other types. use constants , only : wp implicit none !> Vector class type :: vector !> vector components real ( kind = wp ) :: x , y , z contains !> Returns the magnitude of the vector procedure :: magnitude => magnitude !> Returns the length of the vector procedure :: length => length !> .dot. operator. Dot product generic :: operator (. dot .) => vec_dot_vec , vec_dot_mat !> .cross. operator. Cross product generic :: operator (. cross .) => vec_cross_vec !> Overloads the Division operator for vec3 generic :: operator ( / ) => vec_div_scal_r4 , vec_div_scal_r8 , vec_div_scal_int !> Overloads the Multiplication operator for vec3 generic :: operator ( * ) => vec_mult_vec , vec_mult_scal , scal_mult_vec !> Overloads the exponential operator for vec3 generic :: operator ( ** ) => vec_mult_exp_scal_int , vec_mult_exp_scal_r4 , vec_mult_exp_scal_r8 !> Overloads the Addition operator for vec3 generic :: operator ( + ) => vec_add_vec , vec_add_scal , scal_add_vec !> Overloads the Subtraction operator for vec3 generic :: operator ( - ) => vec_minus_vec , vec_minus_scal , scal_minus_vec !> Overloads the equal operator for vec3 generic :: operator ( == ) => vec_equal_vec procedure , pass ( a ), private :: vec_dot_vec procedure , pass ( a ), private :: vec_dot_mat procedure , pass ( a ), private :: vec_cross_vec procedure , pass ( a ), private :: vec_div_scal_r4 procedure , pass ( a ), private :: vec_div_scal_r8 procedure , pass ( a ), private :: vec_div_scal_int procedure , pass ( a ), private :: vec_mult_vec procedure , pass ( a ), private :: vec_mult_scal procedure , pass ( b ), private :: scal_mult_vec procedure , pass ( a ), private :: vec_mult_exp_scal_int procedure , pass ( a ), private :: vec_mult_exp_scal_r4 procedure , pass ( a ), private :: vec_mult_exp_scal_r8 procedure , pass ( a ), private :: vec_add_vec procedure , pass ( a ), private :: vec_add_scal procedure , pass ( b ), private :: scal_add_vec procedure , pass ( a ), private :: vec_minus_vec procedure , pass ( a ), private :: vec_minus_scal procedure , pass ( b ), private :: scal_minus_vec procedure , pass ( a ), private :: vec_equal_vec end type vector private public :: magnitude , vector , abs , length , max , nint , min interface nint !! Overload of the nint intrinsic for a vec3 module procedure nint_vec end interface nint interface abs !! Overload of the abs intrinsic for a vec3 module procedure abs_vec end interface abs interface max !! Overload of the max intrinsic for a vec3 module procedure max_vec module procedure maxval_vec end interface max interface min !! Overload of the min intrinsic for a vec3 module procedure min_vec module procedure minval_vec end interface min contains type ( vector ) pure elemental function vec_mult_exp_scal_int ( a , b ) !! vec3**scalar for integer scalar !> Input Vector class ( vector ), intent ( in ) :: a !> Input scalar integer , intent ( in ) :: b vec_mult_exp_scal_int = vector ( a % x ** b , a % y ** b , a % z ** b ) end function vec_mult_exp_scal_int type ( vector ) pure elemental function vec_mult_exp_scal_r4 ( a , b ) !! vec3**scalar for 32-bit float scalar use constants , only : sp !> Input Vector class ( vector ), intent ( in ) :: a !> Input scalar real ( kind = sp ), intent ( in ) :: b vec_mult_exp_scal_r4 = vector ( a % x ** b , a % y ** b , a % z ** b ) end function vec_mult_exp_scal_r4 type ( vector ) pure elemental function vec_mult_exp_scal_r8 ( a , b ) !! vec3**scalar for 64-bit float scalar use constants , only : dp !> Input Vector class ( vector ), intent ( in ) :: a !> Input scalar real ( kind = dp ), intent ( in ) :: b vec_mult_exp_scal_r8 = vector ( a % x ** b , a % y ** b , a % z ** b ) end function vec_mult_exp_scal_r8 logical pure elemental function vec_equal_vec ( a , b ) !! vec3 == vec3 !> Input vec3s class ( vector ), intent ( in ) :: a , b vec_equal_vec = . false . if ( a % x == b % x ) then if ( a % y == b % y ) then if ( a % z == b % z ) then vec_equal_vec = . true . end if end if end if end function vec_equal_vec type ( vector ) pure elemental function nint_vec ( this ) !! Overload the nint intrinsic for a vec3 elementwise !> Input vector type ( vector ), intent ( IN ) :: this nint_vec = vector ( real ( nint ( this % x ), kind = wp ), real ( nint ( this % y ), kind = wp ), real ( nint ( this % z ), kind = wp )) end function nint_vec type ( vector ) pure elemental function abs_vec ( this ) !! Calculate the absoulte of a vector elementwise !> Input vector type ( vector ), intent ( IN ) :: this abs_vec = vector ( abs ( this % x ), abs ( this % y ), abs ( this % z )) end function abs_vec type ( vector ) pure elemental function max_vec ( this , val ) !! Get the max value elementwise between a vec3 and a scalar !> Input vector type ( vector ), intent ( IN ) :: this !> Input max value real ( kind = wp ), intent ( IN ) :: val max_vec = vector ( max ( this % x , val ), max ( this % y , val ), max ( this % z , val )) end function max_vec type ( vector ) pure elemental function min_vec ( this , val ) !! Get the min value elementwise between a vec3 and a scalar !> Input vector type ( vector ), intent ( IN ) :: this !> Input minimum value real ( kind = wp ), intent ( IN ) :: val min_vec = vector ( min ( this % x , val ), min ( this % y , val ), min ( this % z , val )) end function min_vec real ( kind = wp ) pure elemental function maxval_vec ( this ) !! Get the max value in a vec3 !> Input vector type ( vector ), intent ( IN ) :: this maxval_vec = max ( this % x , this % y , this % z ) end function maxval_vec real ( kind = wp ) pure elemental function minval_vec ( this ) !! Get the min value in a vec3 !> Input vector type ( vector ), intent ( IN ) :: this minval_vec = min ( this % x , this % y , this % z ) end function minval_vec type ( vector ) pure elemental function vec_minus_vec ( a , b ) !! vec3 - vec3 !> Input vector class ( vector ), intent ( IN ) :: a !> vec3 to subtract type ( vector ), intent ( IN ) :: b vec_minus_vec = vector ( a % x - b % x , a % y - b % y , a % z - b % z ) end function vec_minus_vec type ( vector ) pure elemental function vec_add_scal ( a , b ) !! vec3 + scalar !> Input vector class ( vector ), intent ( IN ) :: a !> Scalar to add real ( kind = wp ), intent ( IN ) :: b vec_add_scal = vector ( a % x + b , a % y + b , a % z + b ) end function vec_add_scal type ( vector ) pure elemental function scal_add_vec ( a , b ) !! vec3 + scalar !> Input vector class ( vector ), intent ( IN ) :: b !> Scalar to add real ( kind = wp ), intent ( IN ) :: a scal_add_vec = vector ( b % x + a , b % y + a , b % z + a ) end function scal_add_vec type ( vector ) pure elemental function vec_minus_scal ( a , b ) !! vec3 - scalar !> Input vector class ( vector ), intent ( IN ) :: a !> Scalar to subtract real ( kind = wp ), intent ( IN ) :: b vec_minus_scal = vector ( a % x - b , a % y - b , a % z - b ) end function vec_minus_scal type ( vector ) pure elemental function scal_minus_vec ( a , b ) !! scalar - vec3 !> Input vector class ( vector ), intent ( IN ) :: b !> Scalar to subtract from real ( kind = wp ), intent ( IN ) :: a scal_minus_vec = vector ( a - b % x , a - b % y , a - b % z ) end function scal_minus_vec type ( vector ) pure elemental function vec_add_vec ( a , b ) !! vec3 + vec3 !> Input vector class ( vector ), intent ( IN ) :: a !> Vec3 to add type ( vector ), intent ( IN ) :: b vec_add_vec = vector ( a % x + b % x , a % y + b % y , a % z + b % z ) end function vec_add_vec pure elemental function vec_dot_vec ( a , b ) result ( dot ) !! vec3 . vec3 !> Input vec3 class ( vector ), intent ( IN ) :: a !> vec3 to dot type ( vector ), intent ( IN ) :: b real ( kind = wp ) :: dot dot = ( a % x * b % x ) + ( a % y * b % y ) + ( a % z * b % z ) end function vec_dot_vec pure function vec_dot_mat ( a , b ) result ( dot ) !! vec3 . matrix !> Input vec3 class ( vector ), intent ( IN ) :: a !> Matrix to dot with real ( kind = wp ), intent ( IN ) :: b ( 4 , 4 ) type ( vector ) :: dot dot % x = b ( 1 , 1 ) * a % x + b ( 2 , 1 ) * a % y + b ( 3 , 1 ) * a % z + b ( 4 , 1 ) * 1. dot % y = b ( 1 , 2 ) * a % x + b ( 2 , 2 ) * a % y + b ( 3 , 2 ) * a % z + b ( 4 , 2 ) * 1. dot % z = b ( 1 , 3 ) * a % x + b ( 2 , 3 ) * a % y + b ( 3 , 3 ) * a % z + b ( 4 , 3 ) * 1. end function vec_dot_mat pure elemental function vec_cross_vec ( a , b ) result ( cross ) !! vec3 x vec3 !> Input vector class ( vector ), intent ( in ) :: a !> vec3 to cross with type ( vector ), intent ( in ) :: b type ( vector ) :: cross cross % x = a % y * b % z - a % z * b % y cross % y = - a % x * b % z + a % z * b % x cross % z = a % x * b % y - a % y * b % x end function vec_cross_vec type ( vector ) pure elemental function vec_mult_vec ( a , b ) !! vec3 * vec3 elementwise !> input vec3 class ( vector ), intent ( IN ) :: a !> vec3 to multiply by type ( vector ), intent ( IN ) :: b vec_mult_vec = vector ( a % x * b % x , a % y * b % y , a % z * b % z ) end function vec_mult_vec type ( vector ) pure elemental function vec_mult_scal ( a , b ) !! vec3 * scalar elementwise !> input vec3 class ( vector ), intent ( IN ) :: a !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: b vec_mult_scal = vector ( a % x * b , a % y * b , a % z * b ) end function vec_mult_scal type ( vector ) pure elemental function scal_mult_vec ( a , b ) !! Scalar * vec3 elementwise !> input vec3 class ( vector ), intent ( IN ) :: b !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: a scal_mult_vec = vector ( a * b % x , a * b % y , a * b % z ) end function scal_mult_vec type ( vector ) pure elemental function vec_div_scal_r4 ( a , b ) !! vec3 / scalar elementwise. Scalar is a 32-bit float use constants , only : sp !> input vec3 class ( vector ), intent ( IN ) :: a !> Scalar to divide by real ( kind = sp ), intent ( IN ) :: b vec_div_scal_r4 = vector ( a % x / b , a % y / b , a % z / b ) end function vec_div_scal_r4 type ( vector ) pure elemental function vec_div_scal_r8 ( a , b ) !! vec3 / scalar elementwise. Scalar is a 64-bit float use constants , only : dp !> input vec3 class ( vector ), intent ( IN ) :: a !> Scalar to divide by real ( kind = dp ), intent ( IN ) :: b vec_div_scal_r8 = vector ( a % x / b , a % y / b , a % z / b ) end function vec_div_scal_r8 type ( vector ) pure elemental function vec_div_scal_int ( a , b ) !! vec3 / scalar elementwise. Scalar is an integer !> input vec3 class ( vector ), intent ( IN ) :: a !> Scalar to divide by integer , intent ( IN ) :: b vec_div_scal_int = vector ( a % x / real ( b , kind = wp ), a % y / real ( b , kind = wp ), a % z / real ( b , kind = wp )) end function vec_div_scal_int type ( vector ) pure elemental function magnitude ( this ) !! Returns the magnitude of a vec3 class ( vector ), intent ( in ) :: this real ( kind = wp ) :: tmp tmp = this % length () magnitude = this / tmp end function magnitude real ( kind = wp ) pure elemental function length ( this ) !! Returns the length of a vec3 class ( vector ), intent ( in ) :: this length = sqrt ( this % x ** 2 + this % y ** 2 + this % z ** 2 ) end function length end Module vector_class","tags":"","loc":"sourcefile/vector_class.f90.html"},{"title":"sim_state.f90 – signedMCRT","text":"Contents Modules sim_state_mod Source Code sim_state.f90 Source Code module sim_state_mod !! This module defines the setting_t type which holds simulation metadata: use gridMod , only : cart_grid implicit none type :: settings_t !> Number of photons to run integer :: nphotons !> initial seed for random number generator integer :: iseed !> Size of the voxel grid to render SDFs to integer :: render_size ( 3 ) !> Name of experiment/simulation character ( len = :), allocatable :: experiment !> Name of fluence output file character ( len = :), allocatable :: outfile !> Name of voxel render file character ( len = :), allocatable :: renderfile !> Light source used character ( len = :), allocatable :: source !> Name of photon history file character ( len = :), allocatable :: historyFilename !> Name of absoprtion output file character ( len = :), allocatable :: outfile_absorb !> Cart_grid type type ( cart_grid ) :: grid !> Boolean to indicate whether to render SDF to voxels or not. logical :: render_geom !> Boolean to indicate whether to use TEV as debug viewer. logical :: tev !> Boolean to indicate whether to use overwrite datafiles if they have the same name. logical :: overwrite !> Boolean to indicate whether to store history of photons positions logical :: trackHistory !> Boolean to indicate whether to store absoption data. logical :: absorb end type settings_t !> global var that stores simulation state type ( settings_t ) :: state private public :: settings_t , state end module sim_state_mod","tags":"","loc":"sourcefile/sim_state.f90.html"},{"title":"writer.f90 – signedMCRT","text":"Contents Modules writer_mod Source Code writer.f90 Source Code module writer_mod !! This module defines all functions that write simulation data to the disk or pre-process data before writing. !! normalise_fluence. Normalises fluence by number of photons run and size of each voxel. **!Does not normalise by power!** !! write_fluence. Write out fluence in either raw or nrrd format. Default is nrrd. !! write_detected_photons. Write out photons detected by detectors. !! Changes should only be made here if there is a bug or new data types need to be written to disk (phase information) or new file format is needed. use constants , only : wp implicit none interface nrrd_write module procedure write_3d_r8_nrrd , write_3d_r4_nrrd end interface nrrd_write interface raw_write module procedure write_3d_r8_raw , write_3d_r4_raw end interface raw_write private public :: normalise_fluence , write_data , write_detected_photons contains subroutine normalise_fluence ( grid , array , nphotons ) !! normalise fluence in the Lucy 1999 way use gridMod use constants , only : sp !> grid class type ( cart_grid ), intent ( in ) :: grid !> array to normalise real ( kind = sp ), intent ( inout ) :: array (:, :, :) !> number of photons run integer , intent ( in ) :: nphotons real ( kind = wp ) :: xmax , ymax , zmax integer :: nxg , nyg , nzg nxg = grid % nxg nyg = grid % nyg nzg = grid % nzg xmax = grid % xmax ymax = grid % ymax zmax = grid % zmax array = array * (( 2._sp * xmax * 2._sp * ymax ) / ( nphotons * ( 2._sp * xmax / nxg ) * ( 2._sp * ymax / nyg ) * ( 2._sp * zmax / nzg ))) end subroutine normalise_fluence subroutine write_detected_photons ( dects ) use detectors use constants , only : fileplace use utils , only : str type ( dect_array ), intent ( in ) :: dects (:) integer :: i , j , u character ( len = :), allocatable :: hdr do i = 1 , size ( dects ) open ( newunit = u , file = trim ( fileplace ) // \"detectors/detector_\" // str ( i ) // \".dat\" ) associate ( x => dects ( i )% p ) select type ( x ) type is ( circle_dect ) ! hdr = \"# pos, layer, nbins, bin_wid, radius\"//new_line(\"a\")//str(x%pos)//\",\"//str(x%layer)//\",\"//str(x%nbins)//\",\"//str(x%bin_wid)//\",\"//str(x%radius) ! write(u, \"(a)\")hdr ! write(u, \"(a)\")\"#data:\" do j = 1 , x % nbins write ( u , * ) real ( j , kind = wp ) * x % bin_wid , x % data ( j ) end do type is ( annulus_dect ) ! hdr = \"#pos, layer, nbins, bin_wid, radius1, radius2\"//new_line(\"a\")//str(x%pos)//\",\"//str(x%layer)//\",\"//str(x%nbins)//\",\"//str(x%bin_wid)//\",\"//str(x%r1)//\",\"//str(x%r2) type is ( camera ) print * , \"Warning not yet implmented!\" end select end associate close ( u ) end do end subroutine write_detected_photons subroutine write_data ( array , filename , state , dict , overwrite ) !! routine automatically selects which way to write out results based upon file extension use sim_state_mod , only : settings_t use tomlf , only : toml_table , get_value use constants , only : sp !> simulation state type ( settings_t ), intent ( IN ) :: state !> array to write out real ( kind = sp ), intent ( IN ) :: array (:,:,:) !> filename to save array as character ( * ), intent ( IN ) :: filename !> dictionary of metadata type ( toml_table ), optional , intent ( INOUT ) :: dict !> overwrite flag logical , optional , intent ( IN ) :: overwrite Logical :: over_write integer :: pos if ( present ( overwrite )) then over_write = overwrite else over_write = state % overwrite end if pos = index ( filename , \".nrrd\" ) if ( pos > 0 ) then if ( present ( dict )) then call nrrd_write ( array , filename , over_write , dict ) else call nrrd_write ( array , filename , over_write ) end if return end if pos = index ( filename , \".raw\" ) if ( pos > 0 ) then call raw_write ( array , filename , over_write ) return end if pos = index ( filename , \".dat\" ) if ( pos > 0 ) then call raw_write ( array , filename , over_write ) return end if error stop \"File type not supported!\" end subroutine write_data subroutine write_3d_r8_raw ( array , filename , overwrite ) !! write 3D array of float64s to disk as raw binary data !> array to write to disk real ( kind = wp ), intent ( IN ) :: array (:, :, :) !> filename to save array as character ( * ), intent ( IN ) :: filename !> overwrite flag logical , intent ( IN ) :: overwrite integer :: u character ( len = :), allocatable :: file if ( check_file ( filename ) . and . . not . overwrite ) then file = get_new_file_name ( filename ) else file = filename end if open ( newunit = u , file = file , access = 'stream' , status = 'REPLACE' , form = 'unformatted' ) write ( u ) array close ( u ) end subroutine write_3d_r8_raw subroutine write_3d_r4_raw ( array , filename , overwrite ) !! write 3D array of float32's to disk as raw binary data use constants , only : sp !> array to write to disk real ( kind = sp ), intent ( IN ) :: array (:, :, :) !> filename to save array as character ( * ), intent ( IN ) :: filename !> overwrite flag logical , intent ( IN ) :: overwrite integer :: u character ( len = :), allocatable :: file if ( check_file ( filename ) . and . . not . overwrite ) then file = get_new_file_name ( filename ) else file = filename end if open ( newunit = u , file = file , access = 'stream' , status = 'REPLACE' , form = 'unformatted' ) write ( u ) array close ( u ) end subroutine write_3d_r4_raw function get_new_file_name ( file ) result ( res ) !! If file exits, get numeral to append to filename use utils , only : str !> file to be checked character ( len =* ), intent ( IN ) :: file character ( len = :), allocatable :: res integer :: pos , i i = 1 do pos = scan ( trim ( file ), \".\" , back = . true .) res = file ( 1 : pos - 1 ) // \" (\" // str ( i ) // \")\" // file ( pos :) if (. not . check_file ( res )) exit i = i + 1 end do end function get_new_file_name logical function check_file ( file ) result ( res ) !! Functional wrapper around inquire to check if file exits !> file to be checked character ( len =* ), intent ( IN ) :: file inquire ( file = trim ( file ), exist = res ) end function check_file subroutine write_hdr ( u , sizes , type ) !! write out header information for .nrrd file format use utils , only : str !> data dtype character ( * ), intent ( IN ) :: type !> file handle integer , intent ( IN ) :: u !> dimensions of data integer , intent ( IN ) :: sizes (:) character ( len = 100 ) :: string integer :: i string = \"\" do i = 1 , size ( sizes ) if ( i == 1 ) then string = str ( sizes ( i )) else string = trim ( string ) // \" \" // str ( sizes ( i )) end if end do write ( u , \"(A)\" ) \"NRRD0004\" write ( u , \"(A)\" ) \"type: \" // type write ( u , \"(A)\" ) \"dimension: \" // str ( size ( sizes )) write ( u , \"(A)\" ) \"sizes: \" // trim ( string ) write ( u , \"(A)\" ) \"space dimension: \" // str ( size ( sizes )) write ( u , \"(A)\" ) \"encoding: raw\" write ( u , \"(A)\" ) \"endian: little\" end subroutine write_hdr subroutine write_3d_r8_nrrd ( array , filename , overwrite , dict ) !! write 3D array of float64's to .nrrd fileformat use tomlf , only : toml_table , toml_dump , toml_error use iso_fortran_env , only : int32 , int64 , real32 , real64 use utils , only : str !> filename character ( * ), intent ( IN ) :: filename !> array to be written to disk real ( kind = wp ), intent ( IN ) :: array (:, :, :) !> dictionary of metadata type ( toml_table ), optional , intent ( INOUT ) :: dict !> overwrite flag logical , intent ( IN ) :: overwrite type ( toml_error ), allocatable :: error character ( len = :), allocatable :: file integer :: u if ( check_file ( filename ) . and . . not . overwrite ) then file = get_new_file_name ( filename ) else file = filename end if open ( newunit = u , file = file , form = \"formatted\" ) !to do fix precision call write_hdr ( u , [ size ( array , 1 ), size ( array , 2 ), size ( array , 3 )], \"double\" ) if ( present ( dict )) then call toml_dump ( dict , u , error ) end if write ( u , \"(A)\" ) new_line ( \"C\" ) close ( u ) open ( newunit = u , file = file , access = \"stream\" , form = \"unformatted\" , position = \"append\" ) write ( u ) array close ( u ) end subroutine write_3d_r8_nrrd subroutine write_3d_r4_nrrd ( array , filename , overwrite , dict ) !! write 3D array of float32's to .nrrd fileformat use tomlf , only : toml_table , toml_dump , toml_error use iso_fortran_env , only : int32 , int64 , real32 , real64 use utils , only : str use constants , only : sp !> filename character ( * ), intent ( IN ) :: filename !> array to be written to disk real ( kind = sp ), intent ( IN ) :: array (:, :, :) !> dictionary of metadata type ( toml_table ), optional , intent ( INOUT ) :: dict !> overwrite flag logical , intent ( IN ) :: overwrite type ( toml_error ), allocatable :: error character ( len = :), allocatable :: file integer :: u if ( check_file ( filename ) . and . . not . overwrite ) then file = get_new_file_name ( filename ) else file = filename end if open ( newunit = u , file = file , form = \"formatted\" ) !to do fix precision call write_hdr ( u , [ size ( array , 1 ), size ( array , 2 ), size ( array , 3 )], \"float\" ) if ( present ( dict )) then call toml_dump ( dict , u , error ) end if write ( u , \"(A)\" ) new_line ( \"C\" ) close ( u ) open ( newunit = u , file = file , access = \"stream\" , form = \"unformatted\" , position = \"append\" ) write ( u ) array close ( u ) end subroutine write_3d_r4_nrrd end module writer_mod","tags":"","loc":"sourcefile/writer.f90.html"},{"title":"kernelsMod.f90 – signedMCRT","text":"Contents Modules kernels Source Code kernelsMod.f90 Source Code module kernels !! Contains the main program and scattering loop. Calls all other routine to setup, run and break down the simulation. implicit none private public :: weight_scatter , pathlength_scatter , test_kernel contains !############################################################################### ! KERNELS subroutine weight_scatter ( input_file ) !Shared data use iarray use constants , only : wp , CHANCE , THRESHOLD !subroutines use detectors , only : dect_array use detector_mod , only : hit_t use historyStack , only : history_stack_t use inttau2 , only : tauint2 , update_voxels use photonMod , only : photon use piecewiseMod use random , only : ran2 , init_rng use sdfs , only : sdf use sim_state_mod , only : state use utils , only : pbar use vec4_class , only : vec4 use vector_class , only : vector !external deps use tev_mod , only : tevipc use tomlf , only : toml_table #ifdef _OPENMP use omp_lib #endif character ( len =* ), intent ( in ) :: input_file integer :: numproc , id , j , i type ( history_stack_t ) :: history type ( pbar ) :: bar type ( photon ) :: packet type ( toml_table ) :: dict real ( kind = wp ), allocatable :: distances (:), image (:,:,:) type ( hit_t ) :: hpoint type ( vector ) :: dir type ( dect_array ), allocatable :: dects (:) type ( sdf ), allocatable :: array (:) real ( kind = wp ) :: nscatt , start , weight_absorb type ( tevipc ) :: tev integer :: celli , cellj , cellk type ( spectrum_t ) :: spectrum call setup ( input_file , tev , dects , array , packet , spectrum , dict , distances , image , nscatt , start ) #ifdef _OPENMP !is state%seed private, i dont think so... !$omp parallel default(none) shared(dict, array, numproc, start, state, bar, jmean, tev, dects, spectrum)& !$omp& private(id, distances, image, dir, hpoint, history, weight_absorb, cellk, cellj, celli) & !$omp& reduction(+:nscatt) firstprivate(packet) numproc = omp_get_num_threads () id = omp_get_thread_num () if ( numproc > state % nphotons . and . id == 0 ) print * , \"Warning, simulation may be underministic due to low photon count!\" if ( state % trackHistory ) history = history_stack_t ( state % historyFilename , id ) #elif MPI !nothing #else numproc = 1 id = 0 if ( state % trackHistory ) history = history_stack_t ( state % historyFilename , id ) #endif if ( id == 0 ) print ( \"(a,I3.1,a)\" ), 'Photons now running on' , numproc , ' cores.' ! set seed for rnd generator. id to change seed for each process call init_rng ( spread ( state % iseed + id , 1 , 8 ), fwd = . true .) bar = pbar ( state % nphotons / 10 ) !$OMP BARRIER !$OMP do !loop over photons do j = 1 , state % nphotons if ( mod ( j , 10 ) == 0 ) call bar % progress () ! Release photon from point source call packet % emit ( spectrum , dict ) packet % step = 0 packet % id = id distances = 0._wp do i = 1 , size ( distances ) distances ( i ) = array ( i )% evaluate ( packet % pos ) if ( distances ( i ) > 0._wp ) distances ( i ) =- 99 9.0_wp end do packet % layer = minloc ( abs ( distances ), dim = 1 ) if ( state % trackHistory ) call history % push ( vec4 ( packet % pos , packet % step )) ! Find scattering location call tauint2 ( state % grid , packet , array ) do while (. not . packet % tflag ) if ( state % trackHistory ) call history % push ( vec4 ( packet % pos , packet % step )) weight_absorb = packet % weight * ( 1._wp - array ( packet % layer )% getAlbedo ()) packet % weight = packet % weight - weight_absorb call update_voxels ( state % grid , & packet % pos + vector ( state % grid % xmax , state % grid % ymax , state % grid % zmax ), celli , cellj , cellk ) if ( celli < 1 ) then packet % tflag = . true . exit end if if ( cellj < 1 ) then packet % tflag = . true . exit end if if ( cellk < 1 ) then packet % tflag = . true . exit end if !$omp atomic jmean ( celli , cellj , cellk ) = jmean ( celli , cellj , cellk ) + weight_absorb call packet % scatter ( array ( packet % layer )% gethgg (), array ( packet % layer )% getg2 (), dects ) if ( packet % weight < THRESHOLD ) then if ( ran2 () < CHANCE ) then packet % weight = packet % weight / CHANCE else packet % tflag = . true . exit end if end if ! !Find next scattering location call tauint2 ( state % grid , packet , array ) end do dir = vector ( packet % nxp , packet % nyp , packet % nzp ) hpoint = hit_t ( packet % pos , dir , packet % weight , packet % layer ) do i = 1 , size ( dects ) call dects ( i )% p % record_hit ( hpoint , history ) end do if ( id == 0 . and . mod ( j , 1000 ) == 0 ) then if ( state % tev ) then !$omp critical image = reshape ( jmean (:, 100 : 100 ,:), [ state % grid % nxg , state % grid % nzg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"I\" ], 0 , 0 , . false ., . false .) image = reshape ( jmean ( 100 : 100 ,:,:), [ state % grid % nyg , state % grid % nzg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"J\" ], 0 , 0 , . false ., . false .) image = reshape ( jmean (:,:, 100 : 100 ), [ state % grid % nxg , state % grid % nyg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"K\" ], 0 , 0 , . false ., . false .) !$omp end critical end if end if end do #ifdef _OPENMP !$OMP end do !$OMP end parallel #endif call finalise ( dict , dects , nscatt , start , history ) end subroutine weight_scatter subroutine pathlength_scatter ( input_file ) !Shared data use iarray use constants , only : wp !subroutines use detector_mod , only : hit_t use detectors , only : dect_array use historyStack , only : history_stack_t use inttau2 , only : tauint2 use photonMod , only : photon use piecewiseMod use random , only : ran2 , init_rng , seq use sdfs , only : sdf use sim_state_mod , only : state use utils , only : pbar use vec4_class , only : vec4 use vector_class , only : vector !external deps use tev_mod , only : tevipc use tomlf , only : toml_table #ifdef _OPENMP use omp_lib #endif character ( len =* ), intent ( in ) :: input_file integer :: numproc , id , j , i type ( history_stack_t ) :: history type ( pbar ) :: bar type ( photon ) :: packet type ( toml_table ) :: dict real ( kind = wp ), allocatable :: distances (:), image (:,:,:) type ( hit_t ) :: hpoint type ( vector ) :: dir type ( dect_array ), allocatable :: dects (:) type ( sdf ), allocatable :: array (:) real ( kind = wp ) :: ran , nscatt , start type ( tevipc ) :: tev type ( seq ) :: seqs ( 2 ) type ( spectrum_t ) :: spectrum call setup ( input_file , tev , dects , array , packet , spectrum , dict , distances , image , nscatt , start ) #ifdef _OPENMP !is state%seed private, i dont think so... !$omp parallel default(none) shared(dict, array, numproc, start, state, bar, jmean, phasor, tev, dects, spectrum)& !$omp& private(ran, id, distances, image, dir, hpoint, history, seqs) reduction(+:nscatt) firstprivate(packet) numproc = omp_get_num_threads () id = omp_get_thread_num () if ( numproc > state % nphotons . and . id == 0 ) print * , \"Warning, simulation may be underministic due to low photon count!\" if ( state % trackHistory ) history = history_stack_t ( state % historyFilename , id ) #elif MPI !nothing #else numproc = 1 id = 0 if ( state % trackHistory ) history = history_stack_t ( state % historyFilename , id ) #endif if ( id == 0 ) print ( \"(a,I3.1,a)\" ), 'Photons now running on' , numproc , ' cores.' ! set seed for rnd generator. id to change seed for each process call init_rng ( spread ( state % iseed + id , 1 , 8 ), fwd = . true .) seqs = [ seq (( id + 1 ) * ( state % nphotons / numproc ), 2 ),& seq (( id + 1 ) * ( state % nphotons / numproc ), 3 )] bar = pbar ( state % nphotons / 10 ) !$OMP BARRIER !$OMP do !loop over photons do j = 1 , state % nphotons if ( mod ( j , 10 ) == 0 ) call bar % progress () ! Release photon from point source call packet % emit ( spectrum , dict , seqs ) packet % step = 0 packet % id = id distances = 0._wp do i = 1 , size ( distances ) distances ( i ) = array ( i )% evaluate ( packet % pos ) if ( distances ( i ) > 0._wp ) distances ( i ) =- 99 9.0_wp end do packet % layer = minloc ( abs ( distances ), dim = 1 ) if ( state % trackHistory ) call history % push ( vec4 ( packet % pos , packet % step )) ! Find scattering location call tauint2 ( state % grid , packet , array ) do while (. not . packet % tflag ) if ( state % trackHistory ) call history % push ( vec4 ( packet % pos , packet % step )) ran = ran2 () if ( ran < array ( packet % layer )% getAlbedo ()) then !interacts with tissue call packet % scatter ( array ( packet % layer )% gethgg (), & array ( packet % layer )% getg2 (), dects ) nscatt = nscatt + 1 packet % step = packet % step + 1 else packet % tflag = . true . exit end if ! !Find next scattering location call tauint2 ( state % grid , packet , array ) end do dir = vector ( packet % nxp , packet % nyp , packet % nzp ) hpoint = hit_t ( packet % pos , dir , sqrt ( packet % pos % x ** 2 + packet % pos % y ** 2 ), packet % layer ) do i = 1 , size ( dects ) call dects ( i )% p % record_hit ( hpoint , history ) end do if ( id == 0 . and . mod ( j , 1000 ) == 0 ) then if ( state % tev ) then !$omp critical image = reshape ( jmean (:, 100 : 100 ,:), [ state % grid % nxg , state % grid % nzg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"I\" ], 0 , 0 , . false ., . false .) image = reshape ( phasor ( 100 : 100 ,:,:), [ state % grid % nyg , state % grid % nzg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"J\" ], 0 , 0 , . false ., . false .) image = reshape ( phasor (:,:, 100 : 100 ), [ state % grid % nxg , state % grid % nyg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"K\" ], 0 , 0 , . false ., . false .) !$omp end critical end if end if end do #ifdef _OPENMP !$OMP end do !$OMP end parallel #endif call finalise ( dict , dects , nscatt , start , history ) end subroutine pathlength_scatter subroutine test_kernel ( input_file , end_early ) !Shared data use iarray use constants , only : wp !subroutines use detectors , only : dect_array use historyStack , only : history_stack_t use inttau2 , only : tauint2 use photonMod , only : photon use piecewiseMod use random , only : ran2 , init_rng use sdfs , only : sdf use sim_state_mod , only : state use utils , only : pbar use vector_class , only : vector !external deps use tev_mod , only : tevipc use tomlf , only : toml_table #ifdef _OPENMP use omp_lib #endif character ( len =* ), intent ( in ) :: input_file integer :: numproc , id , j , i type ( history_stack_t ) :: history ! type(pbar) :: bar type ( photon ) :: packet type ( toml_table ) :: dict real ( kind = wp ), allocatable :: distances (:), image (:,:,:) type ( dect_array ), allocatable :: dects (:) type ( sdf ), allocatable :: array (:) real ( kind = wp ) :: ran , nscatt , start type ( tevipc ) :: tev type ( vector ) :: pos ( 4 ), pos2 ( 4 ) logical , intent ( in ) :: end_early type ( spectrum_t ) :: spectrum pos = vector ( 0.0_wp , 0.0_wp , 0.0_wp ) pos2 = vector ( 0.0_wp , 0.0_wp , 0.0_wp ) call setup ( input_file , tev , dects , array , packet , spectrum , dict , distances , image , nscatt , start ) numproc = 1 id = 0 if ( id == 0 ) print ( \"(a,I3.1,a)\" ), 'Photons now running on' , numproc , ' cores.' ! set seed for rnd generator. id to change seed for each process call init_rng ( spread ( state % iseed + id , 1 , 8 ), fwd = . true .) ! bar = pbar(state%nphotons/ 10) !loop over photons do j = 1 , state % nphotons ! if(mod(j, 10) == 0)call bar%progress() ! Release photon from point source call packet % emit ( spectrum , dict ) packet % step = 0 packet % id = id distances = 0._wp do i = 1 , size ( distances ) distances ( i ) = array ( i )% evaluate ( packet % pos ) if ( distances ( i ) > 0._wp ) distances ( i ) =- 99 9.0_wp end do packet % layer = minloc ( abs ( distances ), dim = 1 ) ! Find scattering location call tauint2 ( state % grid , packet , array ) do while (. not . packet % tflag ) ran = ran2 () if ( ran < array ( packet % layer )% getalbedo ()) then !interacts with tissue call packet % scatter ( array ( packet % layer )% gethgg (), & array ( packet % layer )% getg2 ()) nscatt = nscatt + 1 packet % step = packet % step + 1 if ( packet % step == 1 ) then pos ( 1 ) = pos ( 1 ) + packet % pos pos2 ( 1 ) = pos2 ( 1 ) + packet % pos ** 2 elseif ( packet % step == 2 ) then pos ( 2 ) = pos ( 2 ) + packet % pos pos2 ( 2 ) = pos2 ( 2 ) + packet % pos ** 2 elseif ( packet % step == 3 ) then pos ( 3 ) = pos ( 3 ) + packet % pos pos2 ( 3 ) = pos2 ( 3 ) + packet % pos ** 2 elseif ( packet % step == 4 ) then pos ( 4 ) = pos ( 4 ) + packet % pos pos2 ( 4 ) = pos2 ( 4 ) + packet % pos ** 2 else if ( end_early ) packet % tflag = . true . end if else packet % tflag = . true . exit end if ! !Find next scattering location call tauint2 ( state % grid , packet , array ) end do end do open ( newunit = j , file = \"positions.dat\" ) do i = 1 , 4 write ( j , * ) 1 0. * pos ( i )% x / state % nphotons , 1 0. * pos ( i )% y / state % nphotons , 1 0. * pos ( i )% z / state % nphotons end do do i = 1 , 4 write ( j , * ) 10 0. * pos2 ( i )% x / state % nphotons , 10 0. * pos2 ( i )% y / state % nphotons , 10 0. * pos2 ( i )% z / state % nphotons end do close ( j ) call finalise ( dict , dects , nscatt , start , history ) end subroutine test_kernel !#################################################################################################### ! Setup and break down helper routines subroutine setup ( input_file , tev , dects , array , packet , spectrum , dict , distances , image , nscatt , start ) !! setup simulation by reading in setting file, and setup variables to be used. !shared data use iarray use constants , only : wp !subroutines use detectors , only : dect_array use parse_mod , only : parse_params use photonMod , only : photon use random , only : init_rng use piecewiseMod use sdfs , only : sdf , render use sim_state_mod , only : state use setupMod , only : setup_simulation , directory use utils , only : get_time , print_time , str use vector_class , only : vector ! !external deps use tev_mod , only : tevipc , tev_init use tomlf , only : toml_table , toml_error !> Filename for toml settings to be used character ( * ), intent ( in ) :: input_file !> array of SDF objects that create the geometry type ( sdf ), allocatable , intent ( out ) :: array (:) !> array of photon detectors type ( dect_array ), allocatable , intent ( out ) :: dects (:) !> toml table of meta-data to be written to output files. type ( toml_table ), intent ( out ) :: dict !> handle for communicating with TEV type ( tevipc ), intent ( out ) :: tev !> photon that is to be simulated type ( photon ), intent ( out ) :: packet real ( kind = wp ), allocatable , intent ( out ) :: distances (:), image (:,:,:) real ( kind = wp ), intent ( out ) :: nscatt , start type ( spectrum_t ), intent ( out ) :: spectrum ! mpi/mp variables integer :: id real ( kind = wp ) :: chance , threshold type ( toml_error ), allocatable :: error chance = 1._wp / 1 0._wp threshold = 1e-6_wp call directory () dict = toml_table () call parse_params ( \"res/\" // trim ( input_file ), packet , dects , spectrum , dict , error ) if ( allocated ( error )) then print * , error % message stop 1 end if allocate ( image ( state % grid % nxg , state % grid % nzg , 1 )) call display_settings ( state , input_file , packet , \"Pathlength\" ) if ( state % tev ) then !init TEV link tev = tevipc () call tev % close_image ( state % experiment ) call tev % create_image ( state % experiment , state % grid % nxg , state % grid % nzg , [ \"I\" , \"J\" , \"K\" ], . true .) end if nscatt = 0._wp call init_rng ( spread ( state % iseed + 0 , 1 , 8 ), fwd = . true .) call setup_simulation ( array , dict ) ! render geometry to voxel format for debugging if ( state % render_geom ) then print * , \"Rendering geometry to file\" call render ( array , state ) end if allocate ( distances ( size ( array ))) start = get_time () id = 0 if ( id == 0 ) then print * , '# of photons to run' , state % nphotons end if end subroutine setup subroutine finalise ( dict , dects , nscatt , start , history ) !! Routine writes out simulation data, deallocates arrays and prints total runtime use constants , only : wp , fileplace use detectors , only : dect_array use historyStack , only : history_stack_t use iarray , only : phasor , phasorGLOBAL , jmean , jmeanGLOBAL , absorb , absorbGLOBAL use sim_state_mod , only : state use setupMod , only : dealloc_array use writer_mod , only : normalise_fluence , write_data , write_detected_photons use utils , only : get_time , print_time , str use tomlf , only : toml_table , set_value !> Total number of scattered photon packets real ( kind = wp ), intent ( in ) :: nscatt !> Start time of simulation. Used to calculate total runtime. real ( kind = wp ), intent ( in ) :: start !> Detector array type ( dect_array ), intent ( in ) :: dects (:) !> Photon histyor object type ( history_stack_t ), intent ( in ) :: history !> Dictionary of metadata type ( toml_table ), intent ( inout ) :: dict integer :: id , numproc , i real ( kind = wp ) :: nscattGLOBAL , time_taken id = 0 numproc = 1 #ifdef MPI ! collate fluence from all processes call mpi_reduce ( jmean , jmeanGLOBAL , size ( jmean ), MPI_DOUBLE_PRECISION , MPI_SUM , 0 , MPI_COMM_WORLD ) call mpi_reduce ( absorb , absorbGLOBAL , size ( absorb ), MPI_DOUBLE_PRECISION , MPI_SUM , 0 , MPI_COMM_WORLD ) call mpi_reduce ( phasor , phasorGLOBAL , size ( phasor ), MPI_DOUBLE_COMPLEX , MPI_SUM , 0 , MPI_COMM_WORLD ) call mpi_reduce ( nscatt , nscattGLOBAL , 1 , MPI_DOUBLE_PRECISION , MPI_SUM , 0 , MPI_COMM_WORLD ) #else jmeanGLOBAL = jmean absorbGLOBAL = absorb phasorGLOBAL = phasor nscattGLOBAL = nscatt #endif if ( id == 0 ) then #ifdef _OPENMP print * , 'Average # of scatters per photon:' , nscattGLOBAL / ( state % nphotons ) #else print * , 'Average # of scatters per photon:' , nscattGLOBAL / ( state % nphotons * numproc ) ! for testing purposes open ( newunit = i , file = \"nscatt.dat\" ) write ( i , * ) nscattGLOBAL / ( state % nphotons ) close ( i ) #endif !write out files !create dict to store metadata and nrrd hdr info call set_value ( dict , \"grid_data\" , \"fluence map\" ) call set_value ( dict , \"real_size\" , str ( state % grid % xmax , 7 ) // \" \" // str ( state % grid % ymax , 7 ) // \" \" // str ( state % grid % zmax , 7 )) call set_value ( dict , \"nphotons\" , state % nphotons ) call set_value ( dict , \"source\" , state % source ) call set_value ( dict , \"experiment\" , state % experiment ) call normalise_fluence ( state % grid , jmeanGLOBAL , state % nphotons ) call write_data ( jmeanGLOBAL , trim ( fileplace ) // \"jmean/\" // state % outfile , state , dict ) ! if(state%absorb)call write_data(absorbGLOBAL, trim(fileplace)//\"deposit/\"//state%outfile_absorb, state, dict) !INTENSITY ! call write_data(abs(phasorGLOBAL)**2, trim(fileplace)//\"phasor/\"//state%outfile, state, dict) end if !write out detected photons if ( size ( dects ) > 0 ) then call write_detected_photons ( dects ) block logical :: mask ( size ( dects )) do i = 1 , size ( dects ) mask ( i ) = dects ( i )% p % trackHistory end do if ( state % trackHistory ) call history % finish () end block end if time_taken = get_time () - start call print_time ( time_taken , 4 ) #ifdef MPI call MPI_Finalize () #endif call dealloc_array () end subroutine finalise subroutine display_settings ( state , input_file , packet , kernel_type ) !! Displays the settings used in the current simulation run use sim_state_mod , only : settings_t use photonMod , only : photon use utils , only : str !> Simulation state type ( settings_t ), intent ( IN ) :: state !> Input filenname character ( * ), intent ( IN ) :: input_file !> Kernel type to run character ( * ), intent ( IN ) :: kernel_type !> Photon packet type ( photon ), intent ( IN ) :: packet print * , repeat ( \"#\" , 20 ) // \" Settings \" // repeat ( \"#\" , 20 ) print * , \"# Config file: \" , trim ( input_file ), repeat ( \" \" , 50 - 16 - len ( trim ( input_file ))), \"#\" print * , \"# Using: \" // trim ( kernel_type ) // \"kernel\" // repeat ( \" \" , 50 - 16 - len ( kernel_type )), \"#\" print * , \"# Light source: \" // trim ( state % source ) // repeat ( \" \" , 50 - 17 - len ( trim ( state % source ))), \"#\" if ( state % source == \"point\" ) then print * , \"# Light Source Position: [\" // str ( packet % pos % x , 4 ) // \", \" // str ( packet % pos % y , 4 ) // \", \" // str ( packet % pos % z , 4 ) // & \"]\" // repeat ( \" \" , 6 ) // \"#\" else print * , \"# Light direction: [\" // str ( packet % nxp , 4 ) // \", \" // str ( packet % nyp , 4 ) // \", \" // str ( packet % nzp , 4 ) // & \"]\" // repeat ( \" \" , 12 ) // \"#\" end if print * , \"# Geometry: \" // trim ( state % experiment ) // repeat ( \" \" , 50 - 13 - len ( trim ( state % experiment ))), \"#\" print * , \"# Seed: \" // str ( state % iseed , 9 ) // repeat ( \" \" , 32 ) // \"#\" if ( state % tev ) then print * , \"# Tev enabled!\" // repeat ( \" \" , 35 ) // \"#\" end if if ( state % render_geom ) then print * , \"# Render geometry to file enabled!\" // repeat ( \" \" , 15 ) // \"#\" end if if ( state % overwrite ) then print * , \"# Overwrite Enabled!\" , repeat ( \" \" , 29 ) // \"#\" end if if ( state % absorb ) then print * , \"# Energy absorbed will be written to file.\" // repeat ( \" \" , 7 ) // \"#\" end if print * , repeat ( \"#\" , 50 ) print * , new_line ( \"a\" ) end subroutine display_settings end module kernels","tags":"","loc":"sourcefile/kernelsmod.f90.html"},{"title":"geometryMod.f90 – signedMCRT","text":"Contents Modules geometry Source Code geometryMod.f90 Source Code module geometry !! Defines a set of functions for intersecting a ray and a surface. !! !! - Circle !! - Plane !! - Cone !! - Cylinder !! - Ellipse !! - Sphere use vector_class , only : vector use constants , only : wp implicit none private public :: intersectCircle , intersectPlane , intersectCone , intersectCylinder , intersectEllipse , intersectSphere contains logical function intersectSphere ( orig , dir , t , centre , radius ) !! calculates where a line, with origin:orig and direction:dir hits a sphere, centre:centre and radius:radius !! returns true if intersection exists !! returns t, the paramertised parameter of the line equation !! adapted from scratchapixel !> Direction vector of the ray type ( vector ), intent ( IN ) :: dir !> Origin of the ray type ( vector ), intent ( IN ) :: orig !> Centre of the sphere type ( vector ), intent ( IN ) :: centre !> Distance from orig to the intersection point real ( kind = wp ), intent ( OUT ) :: t !> Radius of the sphere real ( kind = wp ), intent ( IN ) :: radius type ( vector ) :: L real ( kind = wp ) :: t0 , t1 , a , b , c , tmp intersectSphere = . false . L = orig - centre a = dir . dot . dir b = 2._wp * ( dir . dot . L ) c = ( l . dot . l ) - radius ** 2 if (. not . solveQuadratic ( a , b , c , t0 , t1 )) return if ( t0 > t1 ) then tmp = t1 t1 = t0 t0 = tmp end if if ( t0 < 0._wp ) then t0 = t1 if ( t0 < 0._wp ) return end if t = t0 intersectSphere = . true . return end function intersectSphere logical function intersectCylinder ( orig , dir , t , centre , radius ) !! calculates where a line, with origin:orig and direction:dir hits a cylinder, centre:centre and radius:radius !! This solves for an infinitely long cylinder centered on the z axis with radius radius !! returns true if intersection exists !! returns t, the paramertised parameter of the line equation !! adapted from scratchapixel !! need to check z height after moving ray !! if not this is an infinite cylinder !> Direction vector of the ray type ( vector ), intent ( IN ) :: dir !> origin of the ray type ( vector ), intent ( IN ) :: orig !> Centre of the cylinder type ( vector ), intent ( IN ) :: centre !> distance from orig to the intersection point real ( kind = wp ), intent ( OUT ) :: t !> radius of the cylinder real ( kind = wp ), intent ( IN ) :: radius type ( vector ) :: L real ( kind = wp ) :: t0 , t1 , a , b , c , tmp intersectCylinder = . false . L = orig - centre a = dir % x ** 2 + dir % y ** 2 b = 2._wp * ( dir % x * L % x + dir % y * L % y ) c = L % x ** 2 + L % y ** 2 - radius ** 2 if (. not . solveQuadratic ( a , b , c , t0 , t1 )) return if ( t0 > t1 ) then tmp = t1 t1 = t0 t0 = tmp end if if ( t0 < 0._wp ) then t0 = t1 if ( t0 < 0._wp ) return end if t = t0 intersectCylinder = . true . return end function intersectCylinder logical function intersectEllipse ( orig , dir , t , centre , semia , semib ) !! calculates where a line, with origin:orig and direction:dir hits a ellipse, centre:centre and axii:semia, semib !! returns true if intersection exists !! returns t, the paramertised parameter of the line equation !! adapted from scratchapixel and pbrt !! need to check z height after moving ray !! if not this is an infinte ellipse-cylinder !! ellipse lies length ways along z-axis !! semia and semib are the semimajor axis which are the half width and height. !> Direction vector of the ray type ( vector ), intent ( IN ) :: dir !> origin of the ray type ( vector ), intent ( IN ) :: orig !> Centre of the ellipse type ( vector ), intent ( IN ) :: centre !> distance from orig to the intersection point real ( kind = wp ), intent ( OUT ) :: t !> Half width of the ellipse real ( kind = wp ), intent ( IN ) :: semia !> Half height of the ellipse real ( kind = wp ), intent ( IN ) :: semib type ( vector ) :: L real ( kind = wp ) :: t0 , t1 , a , b , c , tmp , semia2div , semib2div intersectEllipse = . false . semia2div = 1._wp / semia ** 2 semib2div = 1._wp / semib ** 2 L = orig - centre a = semia2div * dir % z ** 2 + semib2div * dir % y ** 2 b = 2._wp * ( semia2div * dir % z * L % z + semib2div * dir % y * L % y ) c = semia2div * L % z ** 2 + semib2div * L % y ** 2 - 1._wp if (. not . solveQuadratic ( a , b , c , t0 , t1 )) return if ( t0 > t1 ) then tmp = t1 t1 = t0 t0 = tmp end if if ( t0 < 0._wp ) then t0 = t1 if ( t0 < 0._wp ) return end if t = t0 intersectEllipse = . true . return end function intersectEllipse logical function intersectCone ( orig , dir , t , centre , radius , height ) !! calculates where a line, with origin:orig and direction:dir hits a cone, radius:radius and height:height with centre:centre. !! centre is the point under the apex at the cone's base. !! returns true if intersection exists !! returns t, the paramertised parameter of the line equation !! adapted from scratchapixel and pbrt !! need to check z height after moving ray !! if not this is an infinte cone !! cone lies height ways along z-axis !> Direction vector of the ray type ( vector ), intent ( IN ) :: dir !> origin of the ray type ( vector ), intent ( IN ) :: orig !> Centre of the cone type ( vector ), intent ( IN ) :: centre !> distance from orig to the intersection point real ( kind = wp ), intent ( OUT ) :: t !> Radius of the cones base real ( kind = wp ), intent ( IN ) :: radius !> Height of the cone real ( kind = wp ), intent ( IN ) :: height type ( vector ) :: L real ( kind = wp ) :: t0 , t1 , a , b , c , tmp , k intersectCone = . false . k = radius / height k = k ** 2 L = orig - centre a = dir % x ** 2 + dir % y ** 2 - ( k * dir % z ** 2 ) b = 2._wp * (( dir % x * L % x ) + ( dir % y * L % y ) - ( k * dir % z * ( L % z - height ))) c = L % x ** 2 + L % y ** 2 - ( k * ( L % z - height ) ** 2 ) if (. not . solveQuadratic ( a , b , c , t0 , t1 )) return if ( t0 > t1 ) then tmp = t1 t1 = t0 t0 = tmp end if if ( t0 < 0._wp ) then t0 = t1 if ( t0 < 0._wp ) return end if t = t0 intersectCone = . true . return end function intersectCone logical function intersectPlane ( n , p0 , l0 , l , t ) !![ref](https://www.scratchapixel.com/lessons/3d-basic-rendering/minimal-ray-tracer-rendering-simple-shapes/ray-plane-and-ray-disk-intersection) !> Normal to the plane type ( vector ), intent ( in ) :: n !> a point on the plane type ( vector ), intent ( in ) :: p0 !> direction vector of the ray type ( vector ), intent ( in ) :: l !> origin of the ray type ( vector ), intent ( in ) :: l0 !> Distance from l0 to the intersection point real ( kind = wp ), intent ( inout ) :: t real ( kind = wp ) :: denom type ( vector ) :: p0l0 intersectPlane = . false . denom = n . dot . l if ( denom > 1e-6_wp ) then p0l0 = p0 - l0 t = p0l0 . dot . n t = t / denom if ( t >= 0._wp ) intersectPlane = . true . end if end function intersectPlane logical function intersectCircle ( n , p0 , radius , l0 , l , t ) !![ref](https://www.scratchapixel.com/lessons/3d-basic-rendering/minimal-ray-tracer-rendering-simple-shapes/ray-plane-and-ray-disk-intersection) !> Normal to the circle type ( vector ), intent ( in ) :: n !> a centre of the circle type ( vector ), intent ( in ) :: p0 !> direction vector of the ray type ( vector ), intent ( in ) :: l !> origin of the ray type ( vector ), intent ( in ) :: l0 !> Radius of the circle real ( kind = wp ), intent ( in ) :: radius !> Distance from l0 to the intersection point real ( kind = wp ), intent ( inout ) :: t real ( kind = wp ) :: d2 type ( vector ) :: v , p intersectCircle = . false . t = 0._wp if ( intersectPlane ( n , p0 , l0 , l , t )) then p = l0 + l * t v = p - p0 d2 = v . dot . v if ( sqrt ( d2 ) <= radius ) intersectCircle = . true . end if end function intersectCircle logical function solveQuadratic ( a , b , c , x0 , x1 ) !! solves quadratic equation given coeffs a, b, and c !! returns true if real solution !! returns x0 and x1 !! adapted from scratchapixel real ( kind = wp ), intent ( IN ) :: a , b , c real ( kind = wp ), intent ( OUT ) :: x0 , x1 real ( kind = wp ) :: discrim , q solveQuadratic = . false . discrim = b ** 2 - 4._wp * a * c if ( discrim < 0._wp ) then return elseif ( discrim == 0._wp ) then x0 = - 0.5_wp * b / a x1 = x0 else if ( b > 0._wp ) then q = - 0.5_wp * ( b + sqrt ( discrim )) else q = - 0.5_wp * ( b - sqrt ( discrim )) end if x0 = q / a x1 = c / q end if solveQuadratic = . true . return end function solveQuadratic end module geometry","tags":"","loc":"sourcefile/geometrymod.f90.html"},{"title":"random_mod.f90 – signedMCRT","text":"Contents Modules random Source Code random_mod.f90 Source Code module random !! module provides an interface to call random_numbers and various other random distributions======= !!This module defines a set of functions that return random numbers in different distributions. !!- ran2. Returns a single float uniformly in the range [0, 1) !!- ranu. Return a single float uniformly in the range [a, b) !!- randint. Returns a single integer uniformly in the range [a, b) !!- rang. Returns a single float from a Gaussian distribution with mean *avg* and std *sigma*. !!- init_rng. Seeds the internal random number generator with a reproducible seed. use vector_class use constants , only : wp implicit none !> Sequence type for quasi-monte carlo type :: seq !> Current index to get value for. integer :: index !> Base from which to calculate radical inverse from. integer :: base contains procedure :: next end type seq private public :: ran2 , ranu , rang , randint , init_rng , seq contains real ( kind = wp ) function next ( this ) result ( res ) class ( seq ) :: this real ( kind = wp ) :: fraction integer :: i fraction = 1. res = 0. i = this % index do while ( i > 0 ) fraction = fraction / this % base res = res + ( fraction * mod ( i , this % base )) i = floor ( i / real ( this % base , kind = wp )) end do this % index = this % index + 1 end function next subroutine init_rng ( input_seed , fwd ) !! initiate RNG state with reproducible state !> input seed integer , optional , intent ( IN ) :: input_seed (:) !> boolean that if True runs the generator for 100 steps before returning logical , optional , intent ( IN ) :: fwd integer , allocatable :: seed (:) integer :: n , i logical :: ffwd real ( kind = wp ) :: a call random_seed ( size = n ) allocate ( seed ( n )) if ( present ( input_seed )) then seed = 0 seed = input_seed else seed = 1234567 end if if ( present ( fwd )) then ffwd = fwd else ffwd = . false . end if call random_seed ( put = seed ) !fast forward rng state 100 times to avoid any potential bad seeds if ( ffwd ) then call random_seed ( get = seed ) do i = 1 , 100 a = ran2 () call random_seed ( get = seed ) end do end if end subroutine init_rng function ran2 () result ( res ) !! wrapper for call random number real ( kind = wp ) :: res call random_number ( res ) end function ran2 function ranu ( a , b ) result ( res ) !! uniformly sample in range[a, b) real ( kind = wp ) :: res !> lower bound real ( kind = wp ), intent ( IN ) :: a !> upper bound real ( kind = wp ), intent ( IN ) :: b res = a + ran2 () * ( b - a ) end function ranu subroutine rang ( x , y , avg , sigma ) !! sample a 2D Guassian distribution !> mean of the gaussian to sample from real ( kind = wp ), intent ( IN ) :: avg !> \\sigma of the guassian to sample from. real ( kind = wp ), intent ( IN ) :: sigma !> first value to return real ( kind = wp ), intent ( OUT ) :: x !> 2nd value to return real ( kind = wp ), intent ( OUT ) :: y real ( kind = wp ) :: s , tmp s = 1._wp do while ( s >= 1._wp ) x = ranu ( - 1._wp , 1._wp ) y = ranu ( - 1._wp , 1._wp ) s = y ** 2 + x ** 2 end do tmp = x * sqrt ( - 2._wp * log ( s ) / s ) x = avg + sigma * tmp tmp = y * sqrt ( - 2._wp * log ( s ) / s ) y = avg + sigma * tmp end subroutine rang integer function randint ( a , b ) !! sample a random integer between [a, b] !> lower bound integer , intent ( IN ) :: a !> higher bound integer , intent ( IN ) :: b randint = a + floor (( b + 1 - a ) * ran2 ()) end function randint end module random ! Program test ! use random, only : randint ! implicit none ! integer :: i ! do i = 1, 100 ! print*,randint(0, 5) ! end do ! end program test","tags":"","loc":"sourcefile/random_mod.f90.html"},{"title":"iarray.f90 – signedMCRT","text":"Contents Modules iarray Source Code iarray.f90 Source Code module iarray !! The iarray module contains the variables that record the fluence. These are 3D arrays, with roughly the same dimensions as the cart_grid type. !! Jmean is the *local* fluence. JmeanGLOBAL is the *global* fluence grid. The global version is the one that is written to disk at the simulations end. use constants , only : sp implicit none !> phase data array complex ( kind = sp ), allocatable :: phasor (:,:,:), phasorGLOBAL (:,:,:) !> fluence data array real ( kind = sp ), allocatable :: jmean (:,:,:), jmeanGLOBAL (:,:,:) !> absorption data array real ( kind = sp ), allocatable :: absorb (:,:,:), absorbGLOBAL (:,:,:) end module iarray","tags":"","loc":"sourcefile/iarray.f90.html"},{"title":"constants.f90 – signedMCRT","text":"Contents Modules constants Source Code constants.f90 Source Code module constants !! This module contains mathematical constants and strings that contain the various directories used by the program. !! Math constants: !! - PI !! - 2 PI !! - wp (working precision of the whole program). Default is double precision (64bit floats) !! Directories: !! - homedir. Root directory of this code !! - fileplace. data folder directory !! - resdir. holds the path to the directory that holds the parameter and other associated input files use iso_fortran_env , only : real64 , real32 implicit none !> current working precision integer , parameter :: wp = real64 !can change this to other precision, not tested for lower or higher precisions. !> single precision variable. integer , parameter :: sp = real32 !> double precision variable. integer , parameter :: dp = real64 !> \\pi real ( kind = wp ), parameter :: PI = 4._wp * atan ( 1._wp ) !> 2 \\pi real ( kind = wp ), parameter :: TWOPI = 2._wp * PI !> Weight threshold for roulette real ( kind = wp ), parameter :: THRESHOLD = 0.01_wp !> Proportion of packet that survive roulette real ( kind = wp ), parameter :: CHANCE = 0.1_wp !> root directory character ( len = 255 ) :: homedir !> place where output files are saved character ( len = 255 ) :: fileplace !> directory to input files character ( len = 255 ) :: resdir end module constants","tags":"","loc":"sourcefile/constants.f90.html"},{"title":"parse.f90 – signedMCRT","text":"Contents Modules parse_mod Source Code parse.f90 Source Code module parse_mod !! Module contains all routines related to parsing the input toml config files. !! See [config](../|page|/config.html) for details of toml input file. use tomlf use tomlf_error , only : make_error use constants , only : wp use vector_class implicit none private public :: parse_params contains subroutine parse_params ( filename , packet , dects , spectrum , dict , error ) !! entry point for parsing toml file use detectors , only : dect_array use photonmod use piecewiseMod !> filename of input toml file character ( * ), intent ( IN ) :: filename !> dictionary that stores potential metadata to be saved with simulation output type ( toml_table ), intent ( INOUT ) :: dict !> some input options set up data in the photon class type ( photon ), intent ( OUT ) :: packet !> detector array which is setup during parsing type ( dect_array ), allocatable , intent ( out ) :: dects (:) !> spectrum type which is set up during parsing type ( spectrum_t ), intent ( out ) :: spectrum !> Last error raised during parsing. Unallocated if no error raised. Need to handle this on return from parse_params. type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), allocatable :: table type ( toml_context ) :: context call toml_load ( table , trim ( filename ), context = context , error = error ) if ( allocated ( error )) return call parse_source ( table , packet , dict , spectrum , context , error ) if ( allocated ( error )) return call parse_grid ( table , dict , error ) if ( allocated ( error )) return call parse_geometry ( table , dict , error ) if ( allocated ( error )) return call parse_detectors ( table , dects , context , error ) if ( allocated ( error )) return call parse_output ( table , error ) if ( allocated ( error )) return call parse_simulation ( table , error ) if ( allocated ( error )) return end subroutine parse_params subroutine parse_detectors ( table , dects , context , error ) !! parse the detectors use detectors , only : dect_array , circle_dect , annulus_dect , camera use sim_state_mod , only : state !> Input Toml table type ( toml_table ), intent ( inout ) :: table !> Detector array to be filled. type ( dect_array ), allocatable :: dects (:) !> Context handle for error reporting. type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_array ), pointer :: array type ( toml_table ), pointer :: child character ( len = :), allocatable :: dect_type type ( circle_dect ), target , save , allocatable :: dect_c (:) type ( annulus_dect ), target , save , allocatable :: dect_a (:) type ( camera ), target , save , allocatable :: dect_cam (:) integer :: i , c_counter , a_counter , cam_counter , j , k , origin c_counter = 0 a_counter = 0 cam_counter = 0 call get_value ( table , \"detectors\" , array ) allocate ( dects ( len ( array ))) do i = 1 , len ( array ) call get_value ( array , i , child ) call get_value ( child , \"type\" , dect_type , origin = origin ) select case ( dect_type ) case default call make_error ( error , & context % report ( \"Invalid detector type. Valid types are [circle, annulus, camera]\" , & origin , \"expected valid detector type\" ), - 1 ) return case ( \"circle\" ) c_counter = c_counter + 1 case ( \"annulus\" ) a_counter = a_counter + 1 case ( \"camera\" ) cam_counter = cam_counter + 1 end select end do if ( c_counter > 0 ) allocate ( dect_c ( c_counter )) if ( a_counter > 0 ) allocate ( dect_a ( a_counter )) if ( cam_counter > 0 ) allocate ( dect_cam ( cam_counter )) c_counter = 1 a_counter = 1 cam_counter = 1 state % trackHistory = . false . do i = 1 , len ( array ) call get_value ( array , i , child ) call get_value ( child , \"type\" , dect_type ) call get_value ( child , \"historyFileName\" , state % historyFilename , \"photPos.obj\" ) select case ( dect_type ) case ( \"circle\" ) call handle_circle_dect ( child , dect_c , c_counter , context , error ) if ( allocated ( error )) return case ( \"annulus\" ) call handle_annulus_dect ( child , dect_a , a_counter , context , error ) if ( allocated ( error )) return case ( \"camera\" ) call handle_camera ( child , dect_cam , cam_counter , context , error ) if ( allocated ( error )) return end select end do do i = 1 , c_counter - 1 allocate ( dects ( i )% p , source = dect_c ( i )) dects ( i )% p => dect_c ( i ) end do do j = 1 , a_counter - 1 allocate ( dects ( j + i - 1 )% p , source = dect_a ( j )) dects ( j + i - 1 )% p => dect_a ( j ) end do do k = 1 , cam_counter - 1 allocate ( dects ( j + i + k - 2 )% p , source = dect_cam ( k )) dects ( j + i + k - 2 )% p => dect_cam ( k ) end do if (. not . allocated ( state % historyFilename )) state % historyFilename = \"photPos.obj\" end subroutine parse_detectors subroutine handle_camera ( child , dects , counts , context , error ) !! Read in Camera settings and initalise variable use detectors , only : camera use sim_state_mod , only : state type ( toml_table ), pointer , intent ( in ) :: child type ( camera ), intent ( inout ) :: dects (:) integer , intent ( inout ) :: counts !> Context handle for error reporting. type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error integer :: layer , nbins real ( kind = wp ) :: maxval type ( vector ) :: p1 , p2 , p3 logical :: trackHistory p1 = get_vector ( child , \"p1\" , default = vector ( - 1.0 , - 1.0 , - 1.0 ), context = context , error = error ) p2 = get_vector ( child , \"p2\" , default = vector ( 2.0 , 0.0 , 0.0 ), context = context , error = error ) p3 = get_vector ( child , \"p3\" , default = vector ( 0.0 , 2.0 , 0.0 ), context = context , error = error ) call get_value ( child , \"layer\" , layer , 1 ) call get_value ( child , \"nbins\" , nbins , 100 ) call get_value ( child , \"maxval\" , maxval , 10 0._wp ) call get_value ( child , \"trackHistory\" , trackHistory , . false .) if ( trackHistory ) state % trackHistory = . true . #ifdef _OPENMP if ( trackHistory ) error stop \"Track history currently incompatable with OpenMP!\" #endif dects ( counts ) = camera ( p1 , p2 , p3 , layer , nbins , maxval , trackHistory ) counts = counts + 1 end subroutine handle_camera subroutine handle_circle_dect ( child , dects , counts , context , error ) !! Read in Circle_detector settings and initalise variable use detectors , only : circle_dect use sim_state_mod , only : state type ( toml_table ), pointer , intent ( in ) :: child type ( circle_dect ), intent ( inout ) :: dects (:) integer , intent ( inout ) :: counts type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error integer :: layer , nbins real ( kind = wp ) :: maxval , radius type ( vector ) :: pos , dir logical :: trackHistory pos = get_vector ( child , \"position\" , context = context , error = error ) dir = get_vector ( child , \"direction\" , default = vector ( 0.0 , 0.0 , - 1.0 ), context = context , error = error ) dir = dir % magnitude () call get_value ( child , \"layer\" , layer , 1 ) call get_value ( child , \"radius1\" , radius ) call get_value ( child , \"nbins\" , nbins , 100 ) call get_value ( child , \"maxval\" , maxval , 10 0._wp ) call get_value ( child , \"trackHistory\" , trackHistory , . false .) if ( trackHistory ) state % trackHistory = . true . #ifdef _OPENMP if ( trackHistory ) error stop \"Track history currently incompatable with OpenMP!\" #endif dects ( counts ) = circle_dect ( pos , dir , layer , radius , nbins , maxval , trackHistory ) counts = counts + 1 end subroutine handle_circle_dect subroutine handle_annulus_dect ( child , dects , counts , context , error ) !! Read in Annulus_detector settings and initalise variable use detectors , only : annulus_dect use sim_state_mod , only : state type ( toml_table ), pointer , intent ( in ) :: child type ( annulus_dect ), intent ( inout ) :: dects (:) integer , intent ( inout ) :: counts type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error integer :: layer , nbins , origin real ( kind = wp ) :: maxval , radius1 , radius2 type ( vector ) :: pos , dir logical :: trackHistory pos = get_vector ( child , \"position\" , context = context , error = error ) dir = get_vector ( child , \"direction\" , default = vector ( 0.0 , 0.0 , - 1.0 ), context = context , error = error ) call get_value ( child , \"layer\" , layer , 1 ) call get_value ( child , \"radius1\" , radius1 ) call get_value ( child , \"radius2\" , radius2 , origin = origin ) if ( radius2 <= radius1 ) then print '(a)' , context % report ( \"Radii are invalid\" , origin , \"Expected radius2 > radius 1\" ) stop 1 end if call get_value ( child , \"nbins\" , nbins , 100 ) call get_value ( child , \"maxval\" , maxval , 10 0._wp ) call get_value ( child , \"trackHistory\" , trackHistory , . false .) if ( trackHistory ) state % trackHistory = . true . #ifdef _OPENMP if ( trackHistory ) error stop \"Track history currently incompatable with OpenMP!\" #endif dects ( counts ) = annulus_dect ( pos , dir , layer , radius1 , radius2 , nbins , maxval , trackHistory ) counts = counts + 1 end subroutine handle_annulus_dect subroutine parse_spectrum ( table , spectrum , dict , context , error ) !! Parse spectrums to be used ! TODO seperate out each case to seperate functions. ! TODO add spectra type to input optical properties ! handle all possible errors ! document code and update config.md use piecewiseMod use stdlib_io , only : loadtxt use constants , only : resdir , sp use stb_image_mod use , intrinsic :: iso_c_binding type ( toml_table ), intent ( INOUT ) :: dict type ( toml_table ), pointer :: table type ( toml_context ) :: context type ( spectrum_t ), intent ( out ) :: spectrum type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_array ), pointer :: children integer :: origin , nlen , i , err , width , height , n_channels , u integer , allocatable :: image (:,:,:) type ( constant ), save , target :: const type ( piecewise1D ), save , target :: OneD type ( piecewise2D ), save , target :: TwoD character ( len = :), allocatable :: stype , sfile , filetype real ( kind = wp ) :: wavelength , cellsize ( 2 ) real ( kind = wp ), allocatable :: array (:,:) real ( kind = sp ), allocatable :: array_sp (:,:) call get_value ( table , \"spectrum_type\" , stype , \"constant\" , origin = origin ) select case ( stype ) case ( \"constant\" ) call get_value ( table , \"wavelength\" , wavelength , 50 0.0_wp ) const = constant ( wavelength ) allocate ( spectrum % p , source = const ) spectrum % p => const case ( \"1D\" ) allocate ( spectrum % p , source = OneD ) call get_value ( table , \"spectrum_file\" , sfile ) call loadtxt ( \"res/\" // sfile , array_sp ) array = array_sp deallocate ( array_sp ) OneD = piecewise1D ( array ) allocate ( spectrum % p , source = OneD ) spectrum % p => OneD case ( \"2D\" ) allocate ( spectrum % p , source = TwoD ) call get_value ( table , \"spectrum_file\" , sfile ) call get_value ( table , \"cell_size\" , children , requested = . true ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen /= 2 ) then call make_error ( error ,& context % report ( \"Need a vector of size 2 for cell_size\" , origin , \"expected vector of size 2\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , cellsize ( i )) end do else call make_error ( error ,& context % report ( \"Need a vector of size 2 for cell_size\" , origin , \"expected vector of size 2\" ), - 1 ) return end if filetype = sfile ( len ( sfile ) - 2 :) select case ( filetype ) case ( \"png\" ) err = stbi_info ( trim ( resdir ) // trim ( sfile ) // c_null_char , width , height , n_channels ) if ( err == 0 ) then call make_error ( error , \"Error reading file: \" // trim ( sfile ) // \" \" // stbi_failure_reason (), - 1 ) return end if image = stbi_load ( trim ( resdir ) // trim ( sfile ) // c_null_char , width , height , n_channels , 0 ) allocate ( array ( size ( image , 1 ), size ( image , 2 ))) array = image (:,:, 1 ) deallocate ( image ) case ( \"dat\" ) call loadtxt ( resdir // trim ( sfile ), array ) case ( \"txt\" ) call loadtxt ( resdir // trim ( sfile ), array ) case default print '(2a)' , \"Unknown spectrum file type:\" , filetype end select TwoD = piecewise2D ( cellsize ( 1 ), cellsize ( 2 ), array ) allocate ( spectrum % p , source = TwoD ) spectrum % p => TwoD case default call make_error ( error ,& context % report ( \"Not a valid spectrum type!\" , origin , \"expected one of either ['constant', '1D', '2D']\" ), - 1 ) return end select end subroutine parse_spectrum subroutine parse_source ( table , packet , dict , spectrum , context , error ) !! Parse sources !! any updates here MUST be reflected in docs/config.md use sim_state_mod , only : state use photonmod use piecewiseMod use tomlf_error !> Input Toml table type ( toml_table ), intent ( inout ) :: table !> Dictonary used to store metadata type ( toml_table ), intent ( inout ) :: dict !> Photon packet. Used to store information to save computation type ( photon ), intent ( out ) :: packet !> Spectrum type. type ( spectrum_t ), intent ( out ) :: spectrum !> Context handle for error reporting type ( toml_context ) :: context !> Error message type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), pointer :: child type ( toml_array ), pointer :: children type ( vector ) :: poss , dirr real ( kind = wp ) :: dir ( 3 ), pos ( 3 ), corners ( 3 , 3 ), radius , beta , rlo , rhi integer :: i , nlen , origin character ( len = 1 ) :: axis ( 3 ) character ( len = :), allocatable :: direction , annulus_type axis = [ \"x\" , \"y\" , \"z\" ] pos = 0._wp dir = 0._wp corners = reshape (( / - 1._wp , - 1._wp , 1._wp , & 2._wp , 0._wp , 0._wp , & 0._wp , 2._wp , 0._wp / ), & shape ( corners ), order = [ 2 , 1 ]) call get_value ( table , \"source\" , child , requested = . false .) if ( associated ( child )) then call get_value ( child , \"name\" , state % source , \"point\" ) call get_value ( child , \"nphotons\" , state % nphotons , 1000000 ) call get_value ( child , \"position\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a vector of size 3 for position\" , origin , \"expected vector of size 3\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , pos ( i )) end do else if ( state % source == \"point\" ) then call make_error ( error , & context % report ( \"Point source needs a position!\" , origin , \"Need vector of size 3 for position\" ), - 1 ) return end if end if poss = vector ( pos ( 1 ), pos ( 2 ), pos ( 3 )) children => null () call get_value ( child , \"direction\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then if ( state % source == \"point\" ) then print '(a)' , context % report (& \"Point source needs no direction!!\" , origin , level = toml_level % warning ) end if nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a vector of size 3 for direction\" , origin , \"expected vector of size 3\" ), - 1 ) return end if if ( state % source == \"circular\" ) then print '(a)' , context % report (& \"Direction not yet fully tested for source type Circular. Results may not be accurate!\" , origin ,& level = toml_level % warning ) end if do i = 1 , len ( children ) call get_value ( children , i , dir ( i )) end do dirr % x = dir ( 1 ) dirr % y = dir ( 2 ) dirr % z = dir ( 3 ) else call get_value ( child , \"direction\" , direction , origin = origin ) if ( allocated ( direction )) then if ( state % source == \"point\" ) then print '(a)' , context % report (& \"Point source needs no direction!!\" , origin , level = toml_level % warning ) end if select case ( direction ) case ( \"x\" ) dirr = vector ( 1._wp , 0._wp , 0._wp ) case ( \"-x\" ) dirr = vector ( - 1._wp , 0._wp , 0._wp ) case ( \"y\" ) dirr = vector ( 0._wp , 1._wp , 0._wp ) case ( \"-y\" ) dirr = vector ( 0._wp , - 1._wp , 0._wp ) case ( \"z\" ) dirr = vector ( 0._wp , 0._wp , 1._wp ) case ( \"-z\" ) dirr = vector ( 0._wp , 0._wp , - 1._wp ) case default call make_error ( error , context % report ( \"Direction needs a cardinal direction i.e x, y, or z\" , origin , & \"Expected cardinal direction\" ), - 1 ) return end select elseif ( state % source /= \"point\" ) then call make_error ( error , context % report ( \"Need to specify direction for source type!\" , origin , & \"No direction specified\" ), - 1 ) return end if end if children => null () call get_value ( child , \"point1\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a matrix row for points\" , origin , \"expected matrix row of size 3\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , corners ( i , 1 )) call set_value ( dict , \"pos1%\" // axis ( i ), corners ( i , 1 )) end do else if ( state % source == \"uniform\" ) then call make_error ( error , & context % report ( \"Uniform source requires point1 variable\" , origin , \"expected point1 variable\" ), - 1 ) return end if end if call get_value ( child , \"point2\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a matrix row for points\" , origin , \"expected matrix row of size 3\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , corners ( i , 2 )) call set_value ( dict , \"pos2%\" // axis ( i ), corners ( i , 2 )) end do else if ( state % source == \"uniform\" ) then call make_error ( error , & context % report ( \"Uniform source requires point2 variable\" , origin , \"expected point2 variable\" ), - 1 ) return end if end if call get_value ( child , \"point3\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a matrix row for points\" , origin , \"expected matrix row of size 3\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , corners ( i , 3 )) call set_value ( dict , \"pos3%\" // axis ( i ), corners ( i , 3 )) end do else if ( state % source == \"uniform\" ) then call make_error ( error , & context % report ( \"Uniform source requires point3 variable\" , origin , \"expected point3 variable\" ), - 1 ) return end if end if call get_value ( child , \"radius\" , radius , 0.5_wp ) call set_value ( dict , \"radius\" , radius ) ! parameters for annulus beam type call get_value ( child , \"beta\" , beta , 5._wp ) call set_value ( dict , \"beta\" , beta ) call get_value ( child , \"radius_hi\" , rhi , 0.6_wp ) call set_value ( dict , \"rhi\" , rhi ) call get_value ( child , \"annulus_type\" , annulus_type , \"gaussian\" ) call set_value ( dict , \"annulus_type\" , annulus_type ) ! parse spectrum call parse_spectrum ( child , spectrum , dict , context , error ) if ( allocated ( error )) return else call make_error ( error , context % report ( \"Simulation needs Source table\" , origin , \"Missing source table\" ), - 1 ) return end if call set_photon ( poss , dirr ) packet = photon ( state % source ) packet % pos = poss packet % nxp = dirr % x packet % nyp = dirr % y packet % nzp = dirr % z end subroutine parse_source subroutine parse_grid ( table , dict , error ) !! parse grid input data use sim_state_mod , only : state use gridMod , only : init_grid !> Input Toml table type ( toml_table ), intent ( inout ) :: table !> Dictonary used to store metadata type ( toml_table ), intent ( inout ) :: dict type ( toml_error ), allocatable , intent ( out ) :: error character ( len = :), allocatable :: msg type ( toml_table ), pointer :: child integer :: nxg , nyg , nzg real ( kind = wp ) :: xmax , ymax , zmax character ( len = :), allocatable :: units call get_value ( table , \"grid\" , child ) if ( associated ( child )) then call get_value ( child , \"nxg\" , nxg , 200 ) call get_value ( child , \"nyg\" , nyg , 200 ) call get_value ( child , \"nzg\" , nzg , 200 ) call get_value ( child , \"xmax\" , xmax , 1.0_wp ) call get_value ( child , \"ymax\" , ymax , 1.0_wp ) call get_value ( child , \"zmax\" , zmax , 1.0_wp ) call get_value ( child , \"units\" , units , \"cm\" ) call set_value ( dict , \"units\" , units ) else msg = \"Need grid table in input param file\" call make_error ( error , msg ) return end if state % grid = init_grid ( nxg , nyg , nzg , xmax , ymax , zmax ) end subroutine parse_grid subroutine parse_geometry ( table , dict , error ) !! parse geometry information use sim_state_mod , only : state !> Input Toml table type ( toml_table ), intent ( INOUT ) :: table !> Dictonary used to store metadata type ( toml_table ), intent ( INOUT ) :: dict type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), pointer :: child real ( kind = wp ) :: tau , musb , musc , muab , muac , hgg integer :: num_spheres call get_value ( table , \"geometry\" , child ) if ( associated ( child )) then call get_value ( child , \"geom_name\" , state % experiment , \"sphere\" ) call get_value ( child , \"tau\" , tau , 1 0._wp ) call set_value ( dict , \"tau\" , tau ) call get_value ( child , \"num_spheres\" , num_spheres , 10 ) call set_value ( dict , \"num_spheres\" , num_spheres ) call get_value ( child , \"musb\" , musb , 0.0_wp ) call set_value ( dict , \"musb\" , musb ) call get_value ( child , \"muab\" , muab , 0.01_wp ) call set_value ( dict , \"muab\" , muab ) call get_value ( child , \"musc\" , musc , 0.0_wp ) call set_value ( dict , \"musc\" , musc ) call get_value ( child , \"muac\" , muac , 0.01_wp ) call set_value ( dict , \"muac\" , muac ) call get_value ( child , \"hgg\" , hgg , 0.7_wp ) call set_value ( dict , \"hgg\" , hgg ) else call make_error ( error , \"Need geometry table in input param file\" , - 1 ) end if end subroutine parse_geometry subroutine parse_output ( table , error ) !! parse output file information use sim_state_mod , only : state !> Input Toml table type ( toml_table ), intent ( inout ) :: table type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), pointer :: child type ( toml_array ), pointer :: children integer :: i , nlen call get_value ( table , \"output\" , child ) if ( associated ( child )) then call get_value ( child , \"fluence\" , state % outfile , \"fluence.nrrd\" ) call get_value ( child , \"absorb\" , state % outfile_absorb , \"absorb.nrrd\" ) call get_value ( child , \"render\" , state % renderfile , \"geom_render.nrrd\" ) call get_value ( child , \"render_geom\" , state % render_geom , . false .) call get_value ( child , \"render_size\" , children , requested = . false .) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then error stop \"Need a vector of size 3 for render_size.\" end if do i = 1 , len ( children ) call get_value ( children , i , state % render_size ( i )) end do else state % render_size = [ 200 , 200 , 200 ] end if call get_value ( child , \"overwrite\" , state % overwrite , . false .) else call make_error ( error , \"Need output table in input param file\" , - 1 ) return end if end subroutine parse_output subroutine parse_simulation ( table , error ) !! parse simulation information use sim_state_mod , only : state !> Input Toml table type ( toml_table ), intent ( inout ) :: table type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), pointer :: child call get_value ( table , \"simulation\" , child ) if ( associated ( child )) then call get_value ( child , \"iseed\" , state % iseed , 123456789 ) call get_value ( child , \"tev\" , state % tev , . false .) call get_value ( child , \"absorb\" , state % absorb , . false .) else call make_error ( error , \"Need simulation table in input param file\" , - 1 ) return end if end subroutine parse_simulation type ( vector ) function get_vector ( child , key , error , context , default ) !! Vector helper function for parsing toml !> Input Toml entry to read type ( toml_table ), pointer , intent ( in ) :: child !> Key to read character ( * ), intent ( in ) :: key !> Default value to assign type ( vector ), optional , intent ( in ) :: default !> Context handle for error reporting type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_array ), pointer :: arr => null () real ( kind = wp ) :: tmp ( 3 ) type ( vector ) :: default_ integer :: j , origin if ( present ( default )) then default_ = default else default_ = vector ( 0._wp , 0._wp , 0._wp ) end if call get_value ( child , key , arr , origin = origin ) if ( associated ( arr )) then if ( len ( arr ) /= 3 ) then call make_error ( error , & context % report ( \"Expected vector of size 3\" , origin , \"Wrong vector size\" ), - 1 ) return end if do j = 1 , len ( arr ) call get_value ( arr , j , tmp ( j )) end do get_vector = vector ( tmp ( 1 ), tmp ( 2 ), tmp ( 3 )) else get_vector = default end if end function get_vector end module parse_mod","tags":"","loc":"sourcefile/parse.f90.html"},{"title":"vec4_class.f90 – signedMCRT","text":"Contents Modules vec4_class Source Code vec4_class.f90 Source Code Module vec4_class !! Vector4 class module. Defines a vector4 type (x, y, z, p) and associated operations on vectors and other types. use constants , only : wp implicit none !> not fully implmented vec4 class type :: vec4 !> vec4 components real ( kind = wp ) :: x , y , z , p contains procedure :: magnitude => magnitude_fn procedure :: length => length !> .dot. operator generic :: operator (. dot .) => vec_dot_vec !> Overloaded Division operator generic :: operator ( / ) => vec_div_scal_r4 , vec_div_scal_r8 , vec_div_scal_int !> Overloaded Mulitiplication operator generic :: operator ( * ) => vec_mult_vec , vec_mult_scal , scal_mult_vec !> Overloaded Addition operator generic :: operator ( + ) => vec_add_vec , vec_add_scal , scal_add_vec !> Overloaded Subtraction operator generic :: operator ( - ) => vec_minus_vec , vec_minus_scal , scal_minus_vec procedure , pass ( a ), private :: vec_dot_vec procedure , pass ( a ), private :: vec_div_scal_r4 procedure , pass ( a ), private :: vec_div_scal_r8 procedure , pass ( a ), private :: vec_div_scal_int procedure , pass ( a ), private :: vec_mult_vec procedure , pass ( a ), private :: vec_mult_scal procedure , pass ( b ), private :: scal_mult_vec procedure , pass ( a ), private :: vec_add_vec procedure , pass ( a ), private :: vec_add_scal procedure , pass ( b ), private :: scal_add_vec procedure , pass ( a ), private :: vec_minus_vec procedure , pass ( a ), private :: vec_minus_scal procedure , pass ( b ), private :: scal_minus_vec end type vec4 interface sin !! Vec4 overload of the sin intrinsic module procedure sin_vec end interface sin interface vec4 !! Initalise a vec4 from a vec3 and a scalar module procedure init_vec4_vector_real end interface vec4 private public :: vec4 , sin contains type ( vec4 ) function init_vec4_vector_real ( vec , val ) result ( out ) !! Initalise vec4 from a vec3 and Scalar !! e.g vec4 = [vec3%x, vec3%y, vec3%z, scalar] use vector_class !> Input vec3 type ( vector ), intent ( in ) :: vec !> Input Scalar real ( kind = wp ), intent ( in ) :: val out % x = vec % x out % y = vec % y out % z = vec % z out % p = val end function init_vec4_vector_real type ( vec4 ) pure elemental function sin_vec ( p ) !! Sine of a vec4, elementwise !> Input vec4 type ( vec4 ), intent ( IN ) :: p sin_vec = vec4 ( sin ( p % x ), sin ( p % y ), sin ( p % z ), sin ( p % p )) end function sin_vec type ( vec4 ) pure elemental function vec_minus_vec ( a , b ) !! Elementwise vec4 - vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> vec4 to subtract type ( vec4 ), intent ( IN ) :: b vec_minus_vec = vec4 ( a % x - b % x , a % y - b % y , a % z - b % z , a % p - b % p ) end function vec_minus_vec type ( vec4 ) pure elemental function vec_add_scal ( a , b ) !! Elementwise vec4 + scalar !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to add real ( kind = wp ), intent ( IN ) :: b vec_add_scal = vec4 ( a % x + b , a % y + b , a % z + b , a % p + b ) end function vec_add_scal type ( vec4 ) pure elemental function scal_add_vec ( a , b ) !! Elementwise scalar + vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: b !> Scalar to add real ( kind = wp ), intent ( IN ) :: a scal_add_vec = vec4 ( b % x + a , b % y + a , b % z + a , b % p + a ) end function scal_add_vec type ( vec4 ) pure elemental function vec_minus_scal ( a , b ) !! Elementwise vec4 - scalar !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to subtract real ( kind = wp ), intent ( IN ) :: b vec_minus_scal = vec4 ( a % x - b , a % y - b , a % z - b , a % p - b ) end function vec_minus_scal type ( vec4 ) pure elemental function scal_minus_vec ( a , b ) !! Elementwise Scalar - vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: b !> Scalar to subtract real ( kind = wp ), intent ( IN ) :: a scal_minus_vec = vec4 ( a - b % x , a - b % y , a - b % z , a - b % p ) end function scal_minus_vec type ( vec4 ) pure elemental function vec_add_vec ( a , b ) !! Elementwise vec4 + vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> vec4 to add type ( vec4 ), intent ( IN ) :: b vec_add_vec = vec4 ( a % x + b % x , a % y + b % y , a % z + b % z , a % p + b % p ) end function vec_add_vec pure elemental function vec_dot_vec ( a , b ) result ( dot ) !! dot product between two vec4s !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> vec4 to dot with type ( vec4 ), intent ( IN ) :: b real ( kind = wp ) :: dot dot = ( a % x * b % x ) + ( a % y * b % y ) + ( a % z * b % z ) + ( a % p * b % p ) end function vec_dot_vec type ( vec4 ) pure elemental function vec_mult_vec ( a , b ) !! Elementwise vec4 * vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> vec4 to multiply by type ( vec4 ), intent ( IN ) :: b vec_mult_vec = vec4 ( a % x * b % x , a % y * b % y , a % z * b % z , a % p * b % p ) end function vec_mult_vec type ( vec4 ) pure elemental function vec_mult_scal ( a , b ) !! Elementwise vec4 * Scalar !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: b vec_mult_scal = vec4 ( a % x * b , a % y * b , a % z * b , a % p * b ) end function vec_mult_scal type ( vec4 ) pure elemental function scal_mult_vec ( a , b ) !! Elementwise Scalar * vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: b !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: a scal_mult_vec = vec4 ( a * b % x , a * b % y , a * b % z , a * b % p ) end function scal_mult_vec type ( vec4 ) pure elemental function vec_div_scal_r4 ( a , b ) !! Elementwise vec4 / Scalar. Scalar is 32-bit float use constants , only : sp !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to divide by real ( kind = sp ), intent ( IN ) :: b vec_div_scal_r4 = vec4 ( a % x / b , a % y / b , a % z / b , a % p / b ) end function vec_div_scal_r4 type ( vec4 ) pure elemental function vec_div_scal_r8 ( a , b ) !! Elementwise vec4 / Scalar. Scalar is 32-bit float use constants , only : dp !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to divide by real ( kind = dp ), intent ( IN ) :: b vec_div_scal_r8 = vec4 ( a % x / b , a % y / b , a % z / b , a % p / b ) end function vec_div_scal_r8 type ( vec4 ) pure elemental function vec_div_scal_int ( a , b ) !! Elementwise vec4 / Scalar. Scalar is an integer !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to divide by integer , intent ( IN ) :: b vec_div_scal_int = vec4 ( a % x / real ( b , kind = wp ), a % y / real ( b , kind = wp ), a % z / real ( b , kind = wp ), a % p / real ( b , kind = wp )) end function vec_div_scal_int type ( vec4 ) pure elemental function magnitude_fn ( this ) !! Returns the magnitude of a vec4 class ( vec4 ), intent ( in ) :: this magnitude_fn = this / this % length () end function magnitude_fn real ( kind = wp ) pure elemental function length ( this ) !! Returns the length of a vec4 class ( vec4 ), intent ( in ) :: this length = sqrt ( this % x ** 2 + this % y ** 2 + this % z ** 2 + this % p ** 2 ) end function length end Module vec4_class","tags":"","loc":"sourcefile/vec4_class.f90.html"},{"title":"grid.f90 – signedMCRT","text":"Contents Modules gridMod Source Code grid.f90 Source Code module gridMod !! This module defines the cartesian grid type (cart_grid) and associated routines. !! The cart_grid type contains information related to the grid used to record the fluence. This includes the number of voxels in each cardinal direction (nxg, nyg, nzg), the **half** size of the grid in each direction (xmax, ymax, zmax), and the locations of the voxels walls in each direction (xface, yface, zface). !! The type-bound function get_voxel takes a position (vector) and returns the voxel the position falls in. !! !! Init_grid initialises a cart_grid instance. use constants , only : wp implicit none !! Grid class type :: cart_grid !> number of voxels in each cardinal direction for fluence grid integer :: nxg , nyg , nzg !> half size of each dimension in fluence grid. real ( kind = wp ) :: xmax , ymax , zmax !> Delta is the round off for near voxel cell walls real ( kind = wp ) :: delta !> position of each cell wall in fluence grid real ( kind = wp ), allocatable :: xface (:), yface (:), zface (:) contains procedure :: get_voxel end type cart_grid interface cart_grid module procedure init_grid end interface cart_grid public :: cart_grid , init_grid private contains function get_voxel ( this , pos ) result ( res ) !! get current voxel the photon packet is in use vector_class !> grid class class ( cart_grid ) :: this !> current vector position of photon packet type ( vector ), intent ( IN ) :: pos integer :: res ( 3 ) res ( 1 ) = int ( this % nxg * ( pos % x + this % xmax ) / ( 2._wp * this % xmax )) + 1 res ( 2 ) = int ( this % nyg * ( pos % y + this % ymax ) / ( 2._wp * this % ymax )) + 1 res ( 3 ) = int ( this % nzg * ( pos % z + this % zmax ) / ( 2._wp * this % zmax )) + 1 end function get_voxel type ( cart_grid ) function init_grid ( nxg , nyg , nzg , xmax , ymax , zmax ) !! setup grid !> number of voxels in each cardinal direction for fluence grid integer , intent ( IN ) :: nxg , nyg , nzg !> half size of each dimension in fluence grid. real ( kind = wp ), intent ( IN ) :: xmax , ymax , zmax integer :: i init_grid % nxg = nxg init_grid % nyg = nyg init_grid % nzg = nzg init_grid % xmax = xmax init_grid % ymax = ymax init_grid % zmax = zmax allocate ( init_grid % xface ( nxg + 1 ), init_grid % yface ( nyg + 1 ), init_grid % zface ( nzg + 2 )) init_grid % xface = 0._wp init_grid % yface = 0._wp init_grid % zface = 0._wp ! Set small distance for use in optical depth integration routines ! for roundoff effects when crossing cell walls init_grid % delta = 1.e-8_wp * min ((( 2._wp * xmax ) / nxg ), (( 2._wp * ymax ) / nyg ), (( 2._wp * zmax ) / nzg )) do i = 1 , nxg + 1 init_grid % xface ( i ) = ( i - 1 ) * 2._wp * xmax / nxg end do do i = 1 , nyg + 1 init_grid % yface ( i ) = ( i - 1 ) * 2._wp * ymax / nyg end do do i = 1 , nzg + 2 init_grid % zface ( i ) = ( i - 1 ) * 2._wp * zmax / nzg end do end function init_grid end module gridMod","tags":"","loc":"sourcefile/grid.f90.html"},{"title":"inttau2.f90 – signedMCRT","text":"Contents Modules inttau2 Source Code inttau2.f90 Source Code module inttau2 !! inttau2 is the heart of the MCRT simulation. It moves the photons though the simulated media. !! tauint2 is the only public function here and is the main function that moves the photon. !! Changes should only be made here if bugs are discovered or new methods of tracking photons (i.e phase tracking) or moving photons (i.e new geometry method) is needed. use constants , only : wp implicit none private public :: tauint2 , update_voxels contains subroutine tauint2 ( grid , packet , sdfs_array ) !! optical depth integration subroutine !! Moves photons to interaction location !! Calculated is any reflection or refraction happens whilst moving ! use gridMod , only : cart_grid use photonMod , only : photon use random , only : ran2 use sdfs , only : sdf , calcNormal use surfaces , only : reflect_refract use vector_class , only : vector type ( cart_grid ), intent ( in ) :: grid type ( photon ), intent ( inout ) :: packet type ( sdf ), intent ( in ) :: sdfs_array (:) real ( kind = wp ) :: tau , d_sdf , t_sdf , taurun , ds ( size ( sdfs_array )), dstmp ( size ( sdfs_array )) real ( kind = wp ) :: eps , dtot , old ( size ( sdfs_array )), new ( size ( sdfs_array )), n1 , n2 , Ri integer :: i , oldlayer , new_layer type ( vector ) :: pos , dir , oldpos , N logical :: rflag !setup temp variables pos = packet % pos oldpos = pos dir = vector ( packet % nxp , packet % nyp , packet % nzp ) !round off distance eps = 1e-8_wp !get random tau tau = - log ( ran2 ()) taurun = 0. dtot = 0. do !setup sdf distance and current layer ds = 0. do i = 1 , size ( ds ) ds ( i ) = abs ( sdfs_array ( i )% evaluate ( pos )) end do packet % cnts = packet % cnts + size ( ds ) d_sdf = minval ( ds ) if ( d_sdf < eps ) then packet % tflag = . true . exit end if do while ( d_sdf > eps ) t_sdf = d_sdf * sdfs_array ( packet % layer )% getkappa () if ( taurun + t_sdf <= tau ) then !move full distance to sdf surface taurun = taurun + t_sdf oldpos = pos !comment out for phase screen call update_grids ( grid , oldpos , dir , d_sdf , packet , sdfs_array ( packet % layer )% getmua ()) pos = pos + d_sdf * dir dtot = dtot + d_sdf else !run out of tau so move remaining tau and exit d_sdf = ( tau - taurun ) / sdfs_array ( packet % layer )% getkappa () dtot = dtot + d_sdf taurun = tau oldpos = pos pos = pos + d_sdf * dir !comment out for phase screen call update_grids ( grid , oldpos , dir , d_sdf , packet , sdfs_array ( packet % layer )% getmua ()) exit end if ! get distance to nearest sdf ds = 0._wp do i = 1 , size ( ds ) ds ( i ) = sdfs_array ( i )% evaluate ( pos ) end do d_sdf = minval ( abs ( ds ), dim = 1 ) packet % cnts = packet % cnts + size ( ds ) !check if outside all sdfs if ( minval ( ds ) >= 0._wp ) then packet % tflag = . true . exit end if end do !exit early if conditions met if ( taurun >= tau . or . packet % tflag ) then exit end if ds = 0._wp do i = 1 , size ( ds ) ds ( i ) = sdfs_array ( i )% evaluate ( pos ) end do packet % cnts = packet % cnts + size ( ds ) dstmp = ds ds = abs ( ds ) !step a bit into next sdf to get n2 d_sdf = minval ( ds ) + 2._wp * eps oldpos = pos pos = pos + d_sdf * dir ds = 0._wp do i = 1 , size ( ds ) ds ( i ) = sdfs_array ( i )% evaluate ( pos ) end do packet % cnts = packet % cnts + size ( ds ) new = 0._wp old = 0._wp do i = 1 , size ( ds ) if ( dstmp ( i ) < 0. ) then old ( i ) =- 1._wp exit end if end do do i = 1 , size ( ds ) if ( ds ( i ) < 0. ) then new ( i ) =- 1._wp exit end if end do !check for fresnel reflection n1 = sdfs_array ( packet % layer )% getn () new_layer = minloc ( new , dim = 1 ) n2 = sdfs_array ( new_layer )% getn () !carry out refelction/refraction if ( n1 /= n2 ) then !get correct sdf normal if ( ds ( packet % layer ) < 0._wp . and . ds ( new_layer ) < 0._wp ) then oldlayer = minloc ( abs ([ ds ( packet % layer ), ds ( new_layer )]), dim = 1 ) elseif ( dstmp ( packet % layer ) < 0._wp . and . dstmp ( new_layer ) < 0._wp ) then oldlayer = maxloc ([ dstmp ( packet % layer ), dstmp ( new_layer )], dim = 1 ) elseif ( ds ( packet % layer ) > 0._wp . and . ds ( new_layer ) < 0._wp ) then oldlayer = packet % layer elseif ( ds ( packet % layer ) > 0._wp . and . ds ( new_layer ) > 0._wp ) then packet % tflag = . true . exit else error stop \"This should not be reached!\" end if if ( oldlayer == 1 ) then oldlayer = packet % layer else oldlayer = new_layer end if N = calcNormal ( pos , sdfs_array ( oldlayer )) rflag = . false . call reflect_refract ( dir , N , n1 , n2 , rflag , Ri ) packet % weight = packet % weight * Ri tau = - log ( ran2 ()) taurun = 0._wp if (. not . rflag ) then packet % layer = new_layer else !step back inside original sdf pos = oldpos !reflect so incrment bounce counter packet % bounces = packet % bounces + 1 if ( packet % bounces > 1000 ) then packet % tflag = . true . exit end if end if else packet % layer = new_layer end if if ( packet % tflag ) exit end do packet % pos = pos packet % nxp = dir % x packet % nyp = dir % y packet % nzp = dir % z packet % phi = atan2 ( dir % y , dir % x ) packet % sinp = sin ( packet % phi ) packet % cosp = cos ( packet % phi ) packet % cost = dir % z packet % sint = sqrt ( 1._wp - packet % cost ** 2 ) ! packet%step = dtot if ( abs ( packet % pos % x ) > grid % xmax ) then packet % tflag = . true . end if if ( abs ( packet % pos % y ) > grid % ymax ) then packet % tflag = . true . end if if ( abs ( packet % pos % z ) > grid % zmax ) then packet % tflag = . true . end if end subroutine tauint2 subroutine update_grids ( grid , pos , dir , d_sdf , packet , mua ) !! record fluence using path length estimators. Uses voxel grid use vector_class use photonMod use gridMod use iarray , only : phasor , jmean , absorb use constants , only : sp !> grid stores voxel grid information (voxel walls and etc) type ( cart_grid ), intent ( IN ) :: grid !> dir is the current direction (0,0,1) is up type ( vector ), intent ( IN ) :: dir !> d_sdf is the distance to travel in voxel grid real ( kind = wp ), intent ( IN ) :: d_sdf !> absoprtion coefficent real ( kind = wp ), optional , intent ( IN ) :: mua !> pos is current position with origin in centre of medium (0,0,0) type ( vector ), intent ( INOUT ) :: pos !> packet stores the photon related variables type ( photon ), intent ( INOUT ) :: packet complex ( kind = sp ) :: phasec type ( vector ) :: old_pos logical :: ldir ( 3 ) integer :: celli , cellj , cellk real ( kind = wp ) :: dcell , delta = 1e-8_wp , d , mua_real if ( present ( mua )) then mua_real = mua else mua_real = 1._wp end if !convert to different coordinate system. Origin is at lower left corner of fluence grid old_pos = vector ( pos % x + grid % xmax , pos % y + grid % ymax , pos % z + grid % zmax ) call update_voxels ( grid , old_pos , celli , cellj , cellk ) packet % xcell = celli packet % ycell = cellj packet % zcell = cellk d = 0._wp !if packet outside grid return if ( celli == - 1 . or . cellj == - 1 . or . cellk == - 1 ) then packet % tflag = . true . pos = vector ( old_pos % x - grid % xmax , old_pos % y - grid % ymax , old_pos % z - grid % zmax ) return end if !move photon through grid updating path length estimators do ldir = ( / . FALSE ., . FALSE ., . FALSE . / ) dcell = wall_dist ( grid , celli , cellj , cellk , old_pos , dir , ldir ) if ( d + dcell > d_sdf ) then dcell = d_sdf - d d = d_sdf ! needs to be atomic so dont write to same array address with more than 1 thread at a time packet % phase = packet % phase + dcell !$omp atomic jmean ( celli , cellj , cellk ) = jmean ( celli , cellj , cellk ) + real ( dcell , kind = sp ) call update_pos ( grid , old_pos , celli , cellj , cellk , dcell , . false ., dir , ldir , delta ) exit else d = d + dcell packet % phase = packet % phase + dcell !$omp atomic jmean ( celli , cellj , cellk ) = jmean ( celli , cellj , cellk ) + real ( dcell , kind = sp ) call update_pos ( grid , old_pos , celli , cellj , cellk , dcell , . true ., dir , ldir , delta ) end if if ( celli == - 1 . or . cellj == - 1 . or . cellk == - 1 ) then packet % tflag = . true . exit end if end do pos = vector ( old_pos % x - grid % xmax , old_pos % y - grid % ymax , old_pos % z - grid % zmax ) packet % xcell = celli packet % ycell = cellj packet % zcell = cellk end subroutine update_grids function wall_dist ( grid , celli , cellj , cellk , pos , dir , ldir ) result ( res ) !! funtion that returns distant to nearest wall and which wall that is (x, y, or z) use vector_class use gridMod type ( cart_grid ), intent ( IN ) :: grid type ( vector ), intent ( IN ) :: pos , dir logical , intent ( INOUT ) :: ldir (:) integer , intent ( INOUT ) :: celli , cellj , cellk real ( kind = wp ) :: res real ( kind = wp ) :: dx , dy , dz dx = - 99 9._wp dy = - 99 9._wp dz = - 99 9._wp if ( dir % x > 0._wp ) then dx = ( grid % xface ( celli + 1 ) - pos % x ) / dir % x elseif ( dir % x < 0._wp ) then dx = ( grid % xface ( celli ) - pos % x ) / dir % x elseif ( dir % x == 0._wp ) then dx = 10000 0._wp end if if ( dir % y > 0._wp ) then dy = ( grid % yface ( cellj + 1 ) - pos % y ) / dir % y elseif ( dir % y < 0._wp ) then dy = ( grid % yface ( cellj ) - pos % y ) / dir % y elseif ( dir % y == 0._wp ) then dy = 10000 0._wp end if if ( dir % z > 0._wp ) then dz = ( grid % zface ( cellk + 1 ) - pos % z ) / dir % z elseif ( dir % z < 0._wp ) then dz = ( grid % zface ( cellk ) - pos % z ) / dir % z elseif ( dir % z == 0._wp ) then dz = 10000 0._wp end if res = min ( dx , dy , dz ) if ( res < 0._wp ) then print * , 'dcell < 0.0 warning! ' , res print * , dx , dy , dz print * , dir print * , celli , cellj , cellk error stop 1 end if ldir = [ res == dx , res == dy , res == dz ] if (. not . ldir ( 1 ) . and . . not . ldir ( 2 ) . and . . not . ldir ( 3 )) print * , 'Error in dir flag' end function wall_dist subroutine update_pos ( grid , pos , celli , cellj , cellk , dcell , wall_flag , dir , ldir , delta ) !! routine that updates positions of photon and calls Fresnel routines if photon leaves current voxel use vector_class use gridMod use utils , only : str type ( cart_grid ), intent ( IN ) :: grid type ( vector ), intent ( IN ) :: dir logical , intent ( IN ) :: wall_flag , ldir (:) real ( kind = wp ), intent ( IN ) :: dcell , delta type ( vector ), intent ( INOUT ) :: pos integer , intent ( INOUT ) :: celli , cellj , cellk if ( wall_flag ) then if ( ldir ( 1 )) then if ( dir % x > 0._wp ) then pos % x = grid % xface ( celli + 1 ) + delta elseif ( dir % x < 0._wp ) then pos % x = grid % xface ( celli ) - delta else print * , 'Error in x ldir in update_pos' , ldir , dir end if pos % y = pos % y + dir % y * dcell pos % z = pos % z + dir % z * dcell elseif ( ldir ( 2 )) then if ( dir % y > 0._wp ) then pos % y = grid % yface ( cellj + 1 ) + delta elseif ( dir % y < 0._wp ) then pos % y = grid % yface ( cellj ) - delta else print * , 'Error in y ldir in update_pos' , ldir , dir end if pos % x = pos % x + dir % x * dcell pos % z = pos % z + dir % z * dcell elseif ( ldir ( 3 )) then if ( dir % z > 0._wp ) then pos % z = grid % zface ( cellk + 1 ) + delta elseif ( dir % z < 0._wp ) then pos % z = grid % zface ( cellk ) - delta else print * , 'Error in z ldir in update_pos' , ldir , dir end if pos % x = pos % x + dir % x * dcell pos % y = pos % y + dir % y * dcell else print * , 'Error in update_pos... ' // str ( ldir ) error stop 1 end if else pos % x = pos % x + dir % x * dcell pos % y = pos % y + dir % y * dcell pos % z = pos % z + dir % z * dcell end if if ( wall_flag ) then call update_voxels ( grid , pos , celli , cellj , cellk ) end if end subroutine update_pos subroutine update_voxels ( grid , pos , celli , cellj , cellk ) !! updates the current voxel based upon position use vector_class use gridmod !> grid type ( cart_grid ), intent ( IN ) :: grid !> current photon packet position type ( vector ), intent ( IN ) :: pos !> position of photon packet in grid integer , intent ( INOUT ) :: celli , cellj , cellk !accurate but slow ! celli = find(pos%x, grid%xface) ! cellj = find(pos%y, grid%yface) ! cellk = find(pos%z, grid%zface) !fast but can be inaccurate in some cases... celli = floor ( grid % nxg * ( pos % x ) / ( 2. * grid % xmax )) + 1 cellj = floor ( grid % nyg * ( pos % y ) / ( 2. * grid % ymax )) + 1 cellk = floor ( grid % nzg * ( pos % z ) / ( 2. * grid % zmax )) + 1 if ( celli > grid % nxg . or . celli < 1 ) celli = - 1 if ( cellj > grid % nyg . or . cellj < 1 ) cellj = - 1 if ( cellk > grid % nzg . or . cellk < 1 ) cellk = - 1 end subroutine update_voxels integer function find ( val , a ) !! searches for bracketing indices for a value value in an array a !> value to find in array real ( kind = wp ), intent ( in ) :: val !> array to find val in real ( kind = wp ), intent ( in ) :: a (:) integer :: n , lo , mid , hi n = size ( a ) lo = 0 hi = n + 1 if ( val == a ( 1 )) then find = 1 else if ( val == a ( n )) then find = n - 1 else if (( val > a ( n )) . or . ( val < a ( 1 ))) then find = - 1 else do if ( hi - lo <= 1 ) exit mid = ( hi + lo ) / 2 if ( val >= a ( mid )) then lo = mid else hi = mid end if end do find = lo end if end function find end module inttau2","tags":"","loc":"sourcefile/inttau2.f90.html"},{"title":"opticalProperties.f90 – signedMCRT","text":"Contents Modules opticalProperties Source Code opticalProperties.f90 Source Code module opticalProperties !! module implments the optical property abstract type and the types that inheirt from it use constants , only : wp use piecewiseMod implicit none !! abstract optical property type type , abstract :: opticalProp_base !> scattering coeff. cm^{-1} real ( kind = wp ) :: mus !> absoprtion coeff. cm^{-1} real ( kind = wp ) :: mua !> g factor real ( kind = wp ) :: hgg !> g factor squared real ( kind = wp ) :: g2 !> refractive index real ( kind = wp ) :: n !> \\kappa = \\mu_s + \\mu_a real ( kind = wp ) :: kappa !> a = \\frac{\\mu_s}{\\mu_s + \\mu_a} real ( kind = wp ) :: albedo contains procedure ( updateInterface ), deferred :: update end type opticalProp_base abstract interface subroutine updateInterface ( this , wavelength ) use constants , only : wp use piecewiseMod import opticalProp_base implicit none class ( opticalProp_base ), intent ( inout ) :: this real ( kind = wp ), intent ( out ) :: wavelength end subroutine updateInterface end interface type , extends ( opticalProp_base ) :: opticalProp_t class ( opticalProp_base ), allocatable :: value contains procedure :: update => update_opticalProp_t procedure , private :: opticalProp_t_assign generic :: assignment ( = ) => opticalProp_t_assign end type opticalProp_t type , extends ( opticalProp_base ) :: mono contains procedure :: update => updateMono end type mono type , extends ( opticalProp_base ) :: spectral type ( piecewise1D ), private :: mus_a , mua_a , hgg_a , n_a , flux contains procedure :: update => updateSpectral end type spectral interface opticalProp_t module procedure opticaProp_new end interface interface spectral module procedure init_spectral end interface spectral interface mono module procedure init_mono end interface mono private public :: spectral , mono , opticalProp_base , opticalProp_t contains subroutine opticalProp_t_assign ( lhs , rhs ) class ( opticalProp_t ), intent ( inout ) :: lhs class ( opticalProp_base ), intent ( in ) :: rhs if ( allocated ( lhs % value )) deallocate ( lhs % value ) ! Prevent nested derived type select type ( rhsT => rhs ) class is ( opticalProp_t ) if ( allocated ( rhsT % value )) allocate ( lhs % value , source = rhsT % value ) class default allocate ( lhs % value , source = rhsT ) end select end subroutine opticalProp_t_assign ! optical_property initializer type ( opticalProp_t ) function opticaProp_new ( rhs ) result ( lhs ) class ( opticalProp_base ), intent ( in ) :: rhs allocate ( lhs % value , source = rhs ) end function opticaProp_new subroutine update_opticalProp_t ( this , wavelength ) class ( opticalProp_t ), intent ( inout ) :: this real ( kind = wp ), intent ( out ) :: wavelength call this % value % update ( wavelength ) end subroutine update_opticalProp_t type ( mono ) function init_mono ( mus , mua , hgg , n ) result ( res ) real ( kind = wp ), intent ( in ) :: mus , mua , hgg , n res % mus = mus res % mua = mua res % kappa = mus + mua if ( res % mua < 1e-9_wp ) then res % albedo = 1. else res % albedo = res % mus / res % kappa end if res % hgg = hgg res % g2 = hgg ** 2 res % n = n end function init_mono type ( spectral ) function init_spectral ( mus , mua , hgg , n , flux ) result ( res ) real ( kind = wp ), allocatable , intent ( in ) :: mus (:, :), mua (:, :), hgg (:, :), n (:, :), flux (:, :) real ( kind = wp ) :: wave , tmp !setup cdfs res % flux = piecewise1D ( flux ) res % mus_a = piecewise1D ( mus ) res % mua_a = piecewise1D ( mua ) res % hgg_a = piecewise1D ( hgg ) res % n_a = piecewise1D ( n ) !sample wavelength so we can sample from other optical properties at the correct points call res % flux % sample ( wave , tmp ) ! sample optical properties call res % mus_a % sample ( res % mus , wave ) call res % mua_a % sample ( res % mua , wave ) call res % hgg_a % sample ( res % hgg , wave ) res % g2 = res % hgg ** 2 call res % n_a % sample ( res % n , wave ) res % kappa = res % mus + res % mua if ( res % mua < 1e-9_wp ) then res % albedo = 1. else res % albedo = res % mus / res % kappa end if end function init_spectral subroutine updateMono ( this , wavelength ) implicit none class ( Mono ), intent ( inout ) :: this real ( kind = wp ), intent ( out ) :: wavelength ! don't do anything as wavelength will not change wavelength = 0.0_wp end subroutine updateMono subroutine updateSpectral ( this , wavelength ) implicit none class ( spectral ), intent ( inout ) :: this real ( kind = wp ), intent ( out ) :: wavelength real ( kind = wp ) :: tmp !get wavelength call this % flux % sample ( wavelength , tmp ) !update mus call this % mus_a % sample ( this % mus , tmp , wavelength ) !update mua call this % mua_a % sample ( this % mua , tmp , wavelength ) !update hgg call this % hgg_a % sample ( this % hgg , tmp , wavelength ) this % g2 = this % hgg ** 2 !update n call this % n_a % sample ( this % n , tmp , wavelength ) !update kappa and albedo this % kappa = this % mus + this % mua this % albedo = this % mus / this % kappa end subroutine updateSpectral end module opticalProperties","tags":"","loc":"sourcefile/opticalproperties.f90.html"},{"title":"piecewise.f90 – signedMCRT","text":"Contents Modules piecewiseMod Source Code piecewise.f90 Source Code module piecewiseMod !! This file contains the piecewise abstract type, for sampling from constants, 1D or 2D arrays. Inspired by [PBRT](https://www.pbr-book.org/) piecewise class. !! Currently, the following public types are defined: !! - Constant. Used in the case where there is only one value. !! - 1D. Used in the case where there is a spectrum !! - 2D. Used in the case where SLM or other image based source types are needed. !! The piecewise type ensures that there is a method (sample) that can be called on all inherited types, e.g !! call 2Dimage%p%sample(x, y) !! will return a position (x,y) from where to release a photon. !! This class can be used to have multi-spectral or single valued wavelength, or used as a 2D image input source i.e SLMs. !! NOTE: optical properties are not currently adjusted on wavelength change. use iso_fortran_env , only : int32 , int64 use constants , only : wp implicit none !> Abstract spectrum base type. type , abstract :: piecewise contains !> Deferred procdure. Used to generate a sample from spectrum or get constant value etc. procedure ( sampleInterface ), deferred :: sample end type piecewise abstract interface subroutine sampleInterface ( this , x , y , value ) use constants , only : wp import piecewise implicit none class ( piecewise ), intent ( in ) :: this real ( kind = wp ), intent ( out ) :: x , y real ( kind = wp ), intent ( in ), optional :: value end subroutine sampleInterface end interface !> Spectrum_t type. Used as a container type type :: spectrum_t class ( piecewise ), pointer :: p => null () end type spectrum_t !> Constant piecewise type. i.e a piecewise function that does not change value type , extends ( piecewise ) :: constant !> The constant value real ( kind = wp ) :: value contains !> Sampling routine procedure :: sample => getValue end type constant !> 1D piecewise type. Used for the spectral type type , extends ( piecewise ) :: piecewise1D !> Input array to sample from. Should be size(n, 2). 1st column is x-axis, 2nd column is y-axis real ( kind = wp ), allocatable :: array (:, :) !> cumulative distribution function (CDF) of array. real ( kind = wp ), allocatable :: cdf (:) contains !> Overloaded sampling function procedure :: sample => sample1D end type piecewise1D !> 2D piecewise type. Used for images type , extends ( piecewise ) :: piecewise2D !> Height of each cell real ( kind = wp ) :: cell_height !> Width of each cell real ( kind = wp ) :: cell_width !>cumulative distribution function (CDF) of array. real ( kind = wp ), allocatable :: cdf (:) !> Offsets integer , private :: xoffset , yoffset contains !> Overloaded sampling function procedure :: sample => sample2D end type piecewise2D interface piecewise1D !> Initalise piecewise1D module procedure init_piecewise1D end interface piecewise1D interface piecewise2D !> Initalise piecewise2D module procedure init_piecewise2D end interface piecewise2D ! private public :: spectrum_t , piecewise , piecewise1D , piecewise2D , constant contains subroutine getValue ( this , x , y , value ) !! The constant version of sample class ( constant ), intent ( in ) :: this !> Output value real ( kind = wp ), intent ( out ) :: x !> Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D real ( kind = wp ), intent ( out ) :: y !> Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D real ( kind = wp ), intent ( in ), optional :: value x = this % value y = - 999 9._wp end subroutine getValue subroutine sample1D ( this , x , y , value ) !! Randomly sample from 1D array use random , only : ran2 , ranu class ( piecewise1D ), intent ( in ) :: this !> Return value real ( kind = wp ), intent ( out ) :: x !> Not used, but here so we can have same interface as 2D sample routine. real ( kind = wp ), intent ( out ) :: y !> Optional x value. If not present we generate a random one in the range [0., 1.] real ( kind = wp ), intent ( in ), optional :: value integer ( kind = int64 ) :: idx real ( kind = wp ) :: val if (. not . present ( value )) then !get random x coordinate then get corresponding y val = ran2 () call search_1D ( this % cdf , idx , val ) x = this % array ( idx , 1 ) + & (( val - this % cdf ( idx )) * ( this % array ( idx + 1 , 1 ) - this % array ( idx , 1 ))) / ( this % cdf ( idx + 1 ) - this % cdf ( idx )) else !already have x so get y call search_2D ( this % array , idx , value ) x = this % array ( idx , 2 ) + ( this % array ( idx + 1 , 2 ) - this % array ( idx , 2 )) * & (( value - this % array ( idx , 1 )) / ( this % array ( idx + 1 , 1 ) - this % array ( idx , 1 ))) end if end subroutine sample1D type ( piecewise1D ) function init_piecewise1D ( array ) result ( res ) !! initalise the piecewise1D type with an array size (n, 2). Calculates the CDF of this array. !> Input array use stdlib_quadrature , only : trapz_weights real ( kind = wp ), intent ( in ) :: array (:, :) integer :: i , length real ( kind = wp ) :: weights ( size ( array , 1 )), sumer if ( size ( array , 2 ) /= 2 ) error stop \"Array must be size (n, 2)\" res % array = array length = size ( array , 1 ) allocate ( res % cdf ( length )) res % cdf = 0. ! Generate CDF array from PDF array via Trapezoidal rule weights = trapz_weights ( array (:, 1 )) sumer = 0. do i = 2 , length sumer = sumer + weights ( i ) * array ( i , 2 ) res % cdf ( i ) = sumer end do ! normalise res % cdf = res % cdf / res % cdf ( length ) end function init_piecewise1D subroutine sample2D ( this , x , y , value ) ! TODO cite where you got this from... use random , only : ran2 , ranu class ( piecewise2D ), intent ( in ) :: this real ( kind = wp ), intent ( out ) :: x , y real ( kind = wp ), intent ( in ), optional :: value integer ( kind = int32 ) :: xr , yr integer ( kind = int64 ) :: idx real ( kind = wp ) :: val val = ran2 () call search_1D ( this % cdf , idx , val ) call decode ( idx , xr , yr ) x = real ( xr - this % xoffset , kind = wp ) + ranu ( - this % cell_width , this % cell_width ) y = real ( yr - this % yoffset , kind = wp ) + ranu ( - this % cell_height , this % cell_height ) end subroutine sample2D type ( piecewise2D ) function init_piecewise2D ( cell_width , cell_height , image ) !! Initalise the piecewise2D type with a given cell_width, cell_height and input image !> Input cell width real ( kind = wp ), intent ( in ) :: cell_width !> Input cell height real ( kind = wp ), intent ( in ) :: cell_height !> Input image real ( kind = wp ), intent ( in ) :: image (:,:) real ( kind = wp ), allocatable :: HC1D (:), imagenew (:,:) integer :: width , height , w2 , h2 integer ( kind = int64 ) :: i integer ( kind = int32 ) :: x , y width = size ( image , 1 ) height = size ( image , 2 ) ! need to pad image for z-order to work... w2 = nextpwr2 ( width ) h2 = nextpwr2 ( height ) allocate ( imagenew ( w2 , h2 )) imagenew = 0. init_piecewise2D % xoffset = ( h2 - height ) / 2 init_piecewise2D % yoffset = ( w2 - width ) / 2 imagenew ( init_piecewise2D % xoffset : init_piecewise2D % xoffset + width - 1 , & init_piecewise2D % yoffset : init_piecewise2D % yoffset + height - 1 ) = image allocate ( init_piecewise2D % cdf ( w2 * h2 )) allocate ( HC1D ( w2 * h2 )) HC1D = 0. do i = 0 , ( h2 * w2 ) - 1 call decode ( i , x , y ) HC1D ( i + 1 ) = imagenew ( x + 1 , y + 1 ) end do init_piecewise2D % cdf ( 1 ) = HC1D ( 1 ) do i = 2 , size ( HC1D ) init_piecewise2D % cdf ( i ) = init_piecewise2D % cdf ( i - 1 ) + HC1D ( i ) end do init_piecewise2D % cell_height = cell_height init_piecewise2D % cell_width = cell_width init_piecewise2D % cdf = init_piecewise2D % cdf / init_piecewise2D % cdf ( size ( init_piecewise2D % cdf )) end function init_piecewise2D integer function nextpwr2 ( v ) result ( res ) !! Get the next power of 2. i.e given 5 will return 8 (4^2) !! only works on 32bit ints !! [ref](https://graphics.stanford.edu/~seander/bithacks.html#RoundUpPowerOf2) integer , intent ( in ) :: v res = v - 1 res = ior ( res , rshift ( res , 1 )) res = ior ( res , rshift ( res , 2 )) res = ior ( res , rshift ( res , 4 )) res = ior ( res , rshift ( res , 8 )) res = ior ( res , rshift ( res , 16 )) res = res + 1 end function nextpwr2 subroutine search_1D ( array , nlow , value ) !! search by bisection for 1D array !> Array to search real ( kind = wp ), intent ( in ) :: array (:) !> index of found value integer ( kind = int64 ), intent ( out ) :: nlow !> value to find in 1D array real ( kind = wp ), intent ( in ) :: value integer :: nup , middle nup = size ( array ) nlow = 1 middle = int (( nup + nlow ) / 2. ) do while (( nup - nlow ) > 1 ) middle = int (( nup + nlow ) / 2. ) if ( value > array ( middle )) then nlow = middle else nup = middle end if end do end subroutine search_1D subroutine search_2D ( array , nlow , value ) !! search by bisection for 1D array !> 2D array to search. Only searches 1st column real ( kind = wp ), intent ( in ) :: array (:, :) !> Index of found index integer ( kind = int64 ), intent ( out ) :: nlow !> Value to find in the array. real ( kind = wp ), intent ( in ) :: value integer :: nup , middle nup = size ( array , 1 ) nlow = 1 middle = int (( nup + nlow ) / 2. ) do while (( nup - nlow ) > 1 ) middle = int (( nup + nlow ) / 2. ) if ( value > array ( middle , 1 )) then nlow = middle else nup = middle end if end do end subroutine search_2D integer ( kind = int64 ) function pack_bits ( z ) result ( x ) !! Reverse the split function. I.e go from 0a0b0c0d to abcd !! Adapted from archer2 cpp [course](https://github.com/EPCCed/archer2-cpp/tree/main/exercises/morton-order) !> Input interleaved integer integer ( kind = int64 ), intent ( in ) :: z x = z x = iand ( x , 6148914691236517205_int64 ) x = ior ( rshift ( x , 1 ), x ) x = iand ( x , 3689348814741910323_int64 ) x = ior ( rshift ( x , 2 ), x ) x = iand ( x , 1085102592571150095_int64 ) x = ior ( rshift ( x , 4 ), x ) x = iand ( x , 71777214294589695_int64 ) x = ior ( rshift ( x , 8 ), x ) x = iand ( x , 281470681808895_int64 ) x = ior ( rshift ( x , 16 ), x ) end function pack_bits subroutine decode ( z , x , y ) !! Compute the 2 indices from a Morton index !! Adapted from archer2 cpp [course](https://github.com/EPCCed/archer2-cpp/tree/main/exercises/morton-order) !> Morton Index integer ( kind = int64 ), intent ( in ) :: z !> The computed indices integer ( kind = int32 ), intent ( out ) :: x , y integer ( kind = int64 ) :: i , j i = z x = pack_bits ( i ) j = rshift ( z , 1 ) y = pack_bits ( j ) end subroutine decode end module piecewiseMod","tags":"","loc":"sourcefile/piecewise.f90.html"},{"title":"detectors.f90 – signedMCRT","text":"Contents Modules detectors Source Code detectors.f90 Source Code module detectors !! Module contains each detector type which inherits from the base detector class. !! detectors detect photon packets colliding with the detectors. use constants , only : wp use detector_mod , only : detector , detector1D , detector2D , hit_t use vector_class , only : vector , length implicit none !> Circle detector type , extends ( detector1D ) :: circle_dect !> Radius of detector real ( kind = wp ) :: radius contains procedure :: check_hit => check_hit_circle end type circle_dect interface circle_dect !> Initialise circular detector module procedure init_circle_dect end interface circle_dect !> Annuluar detector type , extends ( detector1D ) :: annulus_dect !> Inner radius real ( kind = wp ) :: r1 !> Outer radius real ( kind = wp ) :: r2 contains procedure :: check_hit => check_hit_annulus end type annulus_dect interface annulus_dect !> Initialise annuluar detector module procedure init_annulus_dect end interface annulus_dect !> Rectangular or \"camera\" detector type , extends ( detector2D ) :: camera !> Normal of the detector type ( vector ) :: n !> Vector from pos (1st corner) to the 2nd corner of the detector type ( vector ) :: p2 !> Vector from pos (1st corner) to the 3rd corner of the detector type ( vector ) :: p3 !> Edge vector of detector type ( vector ) :: e1 !> Edge vector of detector type ( vector ) :: e2 !> Width of the detector real ( kind = wp ) :: width !> Height of the detector real ( kind = wp ) :: height contains procedure :: check_hit => check_hit_camera end type camera interface camera module procedure init_camera end interface camera !> Detector array type :: dect_array class ( detector ), pointer :: p => null () end type dect_array private public :: camera , annulus_dect , circle_dect , dect_array contains function init_circle_dect ( pos , dir , layer , radius , nbins , maxval , trackHistory ) result ( out ) !! Initalise Circle detector !> Centre of detector type ( vector ), intent ( in ) :: pos !> Normal of the detector type ( vector ), intent ( in ) :: dir !> Layer ID integer , intent ( in ) :: layer !> Number of bins in the detector integer , intent ( in ) :: nbins !> Radius of the detector real ( kind = wp ), intent ( in ) :: radius !> Maximum value to store in bins real ( kind = wp ), intent ( in ) :: maxval !> Boolean on if to store photon's history prior to hitting the detector. logical , intent ( in ) :: trackHistory type ( circle_dect ) :: out out % dir = dir out % pos = pos out % layer = layer !extra bin for data beyond end of array out % nbins = nbins + 1 out % radius = radius allocate ( out % data ( out % nbins )) out % data = 0.0_wp if ( nbins == 0 ) then out % bin_wid = 1._wp else out % bin_wid = maxval / real ( nbins - 1 , kind = wp ) end if out % trackHistory = trackHistory end function init_circle_dect logical function check_hit_circle ( this , hitpoint ) !! Check if a hitpoint is in the circle use geometry , only : intersectCircle class ( circle_dect ), intent ( INOUT ) :: this !> Hitpoint to check type ( hit_t ), intent ( IN ) :: hitpoint real ( kind = wp ) :: t check_hit_circle = . false . if ( this % layer /= hitpoint % layer ) return check_hit_circle = intersectCircle ( this % dir , this % pos , this % radius , hitpoint % pos , hitpoint % dir , t ) if ( check_hit_circle ) then if ( t > 5e-3_wp ) check_hit_circle = . false . end if end function check_hit_circle function init_annulus_dect ( pos , dir , layer , r1 , r2 , nbins , maxval , trackHistory ) result ( out ) !! Initalise Annular detector !> Centre of detector type ( vector ), intent ( in ) :: pos !> Normal of the detector type ( vector ), intent ( in ) :: dir !> Layer ID integer , intent ( in ) :: layer !> Inner radius real ( kind = wp ), intent ( IN ) :: r1 !> Outer radius real ( kind = wp ), intent ( IN ) :: r2 !> Number of bins in the detector integer , intent ( in ) :: nbins !> Maximum value to store in bins real ( kind = wp ), intent ( in ) :: maxval !> Boolean on if to store photon's history prior to hitting the detector. logical , intent ( in ) :: trackHistory type ( annulus_dect ) :: out out % pos = pos out % dir = dir out % layer = layer !extra bin for data beyond end of array out % nbins = nbins + 1 out % r1 = r1 out % r2 = r2 allocate ( out % data ( out % nbins )) out % data = 0.0_wp if ( nbins == 0 ) then out % bin_wid = 1._wp else out % bin_wid = maxval / real ( nbins , kind = wp ) end if out % trackHistory = trackHistory end function init_annulus_dect logical function check_hit_annulus ( this , hitpoint ) !! Check if a hitpoint is in the annulus class ( annulus_dect ), intent ( INOUT ) :: this !> Hitpoint to check type ( hit_t ), intent ( IN ) :: hitpoint real ( kind = wp ) :: newpos check_hit_annulus = . false . if ( this % layer /= hitpoint % layer ) return newpos = sqrt (( hitpoint % pos % x - this % pos % x ) ** 2 + ( hitpoint % pos % y - this % pos % y ) ** 2 + ( hitpoint % pos % z - this % pos % z ) ** 2 ) if ( newpos >= this % r1 . and . newpos <= this % r2 ) then check_hit_annulus = . true . end if end function check_hit_annulus function init_camera ( p1 , p2 , p3 , layer , nbins , maxval , trackHistory ) result ( out ) !! Initalise Camera detector !> Position of the 1st corner of the detector type ( vector ), intent ( in ) :: p1 !> Distance from p1 to the 2nd corner type ( vector ), intent ( in ) :: p2 !> Distance from p1 to the 3rd corner type ( vector ), intent ( in ) :: p3 !> Layer ID integer , intent ( in ) :: layer !> Number of bins in the detector integer , intent ( in ) :: nbins !> Maximum value to store in bins real ( kind = wp ), intent ( in ) :: maxval !> Boolean on if to store photon's history prior to hitting the detector. logical , intent ( in ) :: trackHistory type ( camera ) :: out out % pos = p1 out % p2 = p2 out % p3 = p3 out % e1 = p2 - p1 out % e2 = p3 - p1 out % width = length ( out % e1 ) out % height = length ( out % e2 ) out % n = out % e2 . cross . out % e1 out % n = out % n % magnitude () out % layer = layer !extra bin for data beyond end of array out % nbinsX = nbins + 1 out % nbinsY = nbins + 1 allocate ( out % data ( out % nbinsX , out % nbinsY )) out % data = 0.0_wp if ( nbins == 0 ) then out % bin_wid_x = 1._wp out % bin_wid_y = 1._wp else out % bin_wid_x = maxval / real ( out % nbinsX , kind = wp ) out % bin_wid_y = maxval / real ( out % nbinsY , kind = wp ) end if out % trackHistory = trackHistory end function init_camera logical function check_hit_camera ( this , hitpoint ) !! Check if a hitpoint is in the camera detector !! [ref](https://www.scratchapixel.com/lessons/3d-basic-rendering/minimal-ray-tracer-rendering-simple-shapes/ray-plane-and-ray-disk-intersection) class ( camera ), intent ( inout ) :: this !> Hitpoint to check type ( hit_t ), intent ( in ) :: hitpoint real ( kind = wp ) :: t , proj1 , proj2 type ( vector ) :: v check_hit_camera = . false . if ( this % layer /= hitpoint % layer ) return t = (( this % pos - hitpoint % pos ) . dot . this % n ) / ( hitpoint % dir . dot . this % n ) if ( t >= 0._wp ) then v = ( hitpoint % pos + t * hitpoint % dir ) - this % pos proj1 = ( v . dot . this % e1 ) / this % width proj2 = ( v . dot . this % e2 ) / this % height if (( proj1 < this % width . and . proj1 > 0._wp ) . and . ( proj2 < this % height . and . proj2 > 0._wp )) then check_hit_camera = . true . end if end if end function check_hit_camera end module detectors","tags":"","loc":"sourcefile/detectors.f90.html"},{"title":"detector_base.f90 – signedMCRT","text":"Contents Modules detector_mod Source Code detector_base.f90 Source Code module detector_mod !! Module contains photon detector abstract class and the derived types the inherit from it !! not fully implmented use vector_class use constants , only : wp implicit none !> Hit type, which records possible interaction information type :: hit_t !> Poition of the interaction type ( vector ) :: pos !> Direction the photon came from type ( vector ) :: dir !> Value to deposit real ( kind = wp ) :: value !> Layer ID of interaction integer :: layer end type hit_t !only needed if using a stack to init with a single null value interface hit_t module procedure hit_init end interface hit_t !> abstract detector type , abstract :: detector !> position of the detector type ( vector ) :: pos !> Surface normal of the detector type ( vector ) :: dir !> Layer ID of the detector integer :: layer !> Boolean, if true store the history of the photon prior to detection. logical :: trackHistory contains procedure ( recordHitInterface ), deferred , public :: record_hit procedure ( checkHitInterface ), deferred , public :: check_hit end type detector abstract interface logical function checkHitInterface ( this , hitpoint ) use vector_class use constants , only : wp import detector , hit_t class ( detector ), intent ( inout ) :: this type ( hit_t ), intent ( in ) :: hitpoint end function checkHitInterface subroutine recordHitInterface ( this , hitpoint , history ) use constants , only : wp use historyStack , only : history_stack_t use vector_class import detector , hit_t class ( detector ), intent ( inout ) :: this type ( hit_t ), intent ( in ) :: hitpoint type ( history_stack_t ), intent ( inout ) :: history end subroutine recordHitInterface end interface !> 1D detector type. Records linear information type , abstract , extends ( detector ) :: detector1D !> Number of bins integer :: nbins !> Bin width real ( kind = wp ) :: bin_wid !> Bins real ( kind = wp ), allocatable :: data (:) contains procedure :: record_hit => record_hit_1D_sub end type detector1D !> 2D detecctor type. Records spatial information type , abstract , extends ( detector ) :: detector2D !> Number of bins in x dimension (detector space) integer :: nbinsX !> Number of bins in y dimension (detector space) integer :: nbinsY !> Bin width in the x dimension real ( kind = wp ) :: bin_wid_x !> Bin width in the y dimension real ( kind = wp ) :: bin_wid_y !> Bins real ( kind = wp ), allocatable :: data (:,:) contains procedure :: record_hit => record_hit_2D_sub end type detector2D private public :: detector , detector1D , detector2D , hit_t contains type ( hit_t ) function hit_init ( val ) real ( kind = wp ), intent ( in ) :: val type ( vector ) :: tmp tmp = vector ( val , val , val ) hit_init = hit_t ( tmp , tmp , val , int ( val )) end function hit_init subroutine record_hit_1D_sub ( this , hitpoint , history ) !! check if a hit is on the detector and record it if so use historyStack , only : history_stack_t use sim_state_mod , only : state class ( detector1D ), intent ( inout ) :: this !> Interaction information type ( hit_t ), intent ( in ) :: hitpoint !> Photon packet history type ( history_stack_t ), intent ( inout ) :: history real ( kind = wp ) :: value integer :: idx if ( this % check_hit ( hitpoint )) then value = hitpoint % value idx = min ( nint ( value / this % bin_wid ) + 1 , this % nbins ) !$omp atomic this % data ( idx ) = this % data ( idx ) + 1 if ( this % trackHistory ) then call history % write () end if end if if ( state % trackHistory ) call history % zero () end subroutine record_hit_1D_sub subroutine record_hit_2D_sub ( this , hitpoint , history ) !! check if a hit is on the detector and record it if so use historyStack , only : history_stack_t use sim_state_mod , only : state class ( detector2D ), intent ( inout ) :: this !> Interaction information type ( hit_t ), intent ( in ) :: hitpoint !> Photon packet history type ( history_stack_t ), intent ( inout ) :: history real ( kind = wp ), volatile :: x , y integer :: idx , idy if ( this % check_hit ( hitpoint )) then x = hitpoint % pos % z + this % pos % x y = hitpoint % pos % y + this % pos % y idx = min ( int ( x / this % bin_wid_x ) + 1 , this % nbinsX ) idy = min ( int ( y / this % bin_wid_y ) + 1 , this % nbinsY ) if ( idx < 1 ) idx = this % nbinsX if ( idy < 1 ) idy = this % nbinsY !$omp atomic this % data ( idx , idy ) = this % data ( idx , idy ) + 1 if ( this % trackHistory ) then call history % write () end if end if if ( state % trackHistory ) call history % zero () end subroutine record_hit_2D_sub end module detector_mod ! program test ! use detector_mod ! use vector_class ! use constants, only : wp ! implicit none ! type(hit_t) :: hit ! type(vector) :: pos, dir ! integer :: layer ! type(circle_dect) :: dect_c ! type(annulus_dect) :: dect_a ! dect_c = circle_dect(vector(0._wp, 0._wp, 0._wp), 1, .5_wp, 100, 100._wp) ! dect_a = annulus_dect(vector(0._wp, 0._wp, 0._wp), 1, .25_wp, .5_wp, 100, 100._wp) ! layer = 1 ! pos = vector(0._wp, .5_wp, 0._wp) ! dir = vector(0._wp, 0._wp, 1._wp) ! hit = hit_t(pos, dir, 99._wp, layer) ! call dect_c%record_hit(hit) ! print*,sum(dect_c%data) ! pos = vector(0._wp, .25_wp, 0._wp) ! dir = vector(0._wp, 0._wp, 1._wp) ! hit = hit_t(pos, dir, 99._wp, layer) ! call dect_a%record_hit(hit) ! print*,sum(dect_a%data) ! end program test","tags":"","loc":"sourcefile/detector_base.f90.html"},{"title":"sdfs.f90 – signedMCRT","text":"Contents Modules sdfs Source Code sdfs.f90 Source Code module sdfs !! This module defines the signed distance function (SDF) abstract type and all types that inherit from it. !! The SDF abstract type defines the optical properties of an SDF (mus, mua, kappa, albedo, hgg, g2,and n), as well as a transform (4x4 matrix), and the layer ID code of the SDF. !! The SDF abstract type also provides an abstract interface (evaluate) which each inheriting function must implement. This evaluate function is the heart of the SDF implementation. !! Each individual evaluate is the direct implementation of that SDF, e.g. that function defines the mathematical SDF. !! For more information on SDFs, check out Inigo Quilez's [website](https://iquilezles.org/articles/) from which most of the below SDFs and transforms have been taken. !! - cylinder !! - sphere !! - box !! - torus !! - cone !! - triprism (triangular prism) !! - capsule !! - plane !! - segment !! - egg !! **This is the module the user should import to other module not sdf_base!** use constants , only : wp use opticalProperties , only : opticalProp_t use sdf_baseMod , only : sdf , sdf_base , model , calcNormal , render use sdfHelpers , only : identity use vector_class implicit none !> Box SDF type , extends ( sdf_base ) :: box !> Length of each dimension of the box type ( vector ) :: lengths contains procedure :: evaluate => evaluate_box end type box !> Sphere SDF type , extends ( sdf_base ) :: sphere real ( kind = wp ) :: radius contains procedure :: evaluate => evaluate_sphere end type sphere !> Cylinder SDF type , extends ( sdf_base ) :: cylinder real ( kind = wp ) :: radius type ( vector ) :: a , b contains procedure :: evaluate => evaluate_cylinder end type cylinder !> Torus SDF type , extends ( sdf_base ) :: torus real ( kind = wp ) :: oradius , iradius contains procedure :: evaluate => evaluate_torus end type torus !> Triprisim SDF type , extends ( sdf_base ) :: triprism real ( kind = wp ) :: h1 , h2 contains procedure :: evaluate => evaluate_triprism end type triprism !> Cone SDF type , extends ( sdf_base ) :: cone type ( vector ) :: a , b real ( kind = wp ) :: ra , rb contains procedure :: evaluate => evaluate_cone end type cone !> Capsule SDF type , extends ( sdf_base ) :: capsule type ( vector ) :: a , b real ( kind = wp ) :: r contains procedure :: evaluate => evaluate_capsule end type capsule !> Plane SDF type , extends ( sdf_base ) :: plane type ( vector ) :: a contains procedure :: evaluate => evaluate_plane end type plane !> Segment SDF (2D) type , extends ( sdf_base ) :: segment type ( vector ) :: a , b contains procedure :: evaluate => evaluate_segment end type segment !> Egg SDF type , extends ( sdf_base ) :: egg real ( kind = wp ) :: r1 , r2 , h contains procedure :: evaluate => evaluate_egg end type egg interface sphere module procedure sphere_init end interface sphere interface box !! Interface to box SDF initialising function module procedure box_init end interface box interface torus !! Interface to torus SDF initialising function module procedure torus_init end interface torus interface cylinder !! Interface to cylinder SDF initialising function module procedure cylinder_init end interface cylinder interface triprism !! Interface to triprisim SDF initialising function module procedure triprism_init end interface triprism interface egg !! Interface to egg SDF initialising function module procedure egg_init end interface egg interface segment !! Interface to segment SDF initialising function module procedure segment_init end interface segment interface cone !! Interface to cone SDF initialising function module procedure cone_init end interface cone interface capsule !! Interface to capsule SDF initialising function module procedure capsule_init end interface capsule interface plane !! Interface to plane SDF initialising function module procedure plane_init end interface plane private public :: plane , capsule , cone , segment , egg , triprism , cylinder , torus , box , sphere , sdf , model , calcNormal , render contains function segment_init ( a , b , optProp , layer , transform ) result ( out ) !! Initalising function for segment SDF. !! Note this is a 2D function type ( segment ) :: out !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp !> segment start point type ( vector ), intent ( IN ) :: a !> segment end point type ( vector ), intent ( IN ) :: b !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % b = b out % layer = layer out % transform = t out % optProps = optProp end function segment_init function egg_init ( r1 , r2 , h , optProp , layer , transform ) result ( out ) !! Initalising function for egg SDF. !! makes a Moss egg. [ref](https://www.shadertoy.com/view/WsjfRt). type ( egg ) :: out !> R1 controls \"fatness\" of the egg. Actually controls the base circle radius. real ( kind = wp ), intent ( IN ) :: r1 !> R2 contorls the pointiness of the egg. Actually controls radius of top circle. real ( kind = wp ), intent ( in ) :: r2 !> h controls the height of the egg. Actually controls y position of top circle. real ( kind = wp ), intent ( in ) :: h !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % h = h out % r1 = r1 out % r2 = r2 out % layer = layer out % transform = t out % optProps = optProp end function egg_init function plane_init ( a , optProp , layer , transform ) result ( out ) !! Initalising function for plane SDF. type ( plane ) :: out !> Plane normal. must be normalised type ( vector ), intent ( IN ) :: a !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % layer = layer out % transform = t out % optProps = optProp end function plane_init function capsule_init ( a , b , r , optProp , layer , transform ) result ( out ) !! Initalising function for capsule SDF. type ( capsule ) :: out !> Capsule startpoint type ( vector ), intent ( IN ) :: a !> Capsule endpoint type ( vector ), intent ( IN ) :: b !> Capsule radius real ( kind = wp ), intent ( IN ) :: r !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % b = b out % r = r out % layer = layer out % transform = t out % optProps = optProp end function capsule_init function triprism_init ( h1 , h2 , optProp , layer , transform ) result ( out ) !! Initalising function for triprisim SDF. type ( triprism ) :: out !> Height of triprisim real ( kind = wp ), intent ( IN ) :: h1 !> length of triprisim real ( kind = wp ), intent ( IN ) :: h2 !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % h1 = h1 out % h2 = h2 out % layer = layer out % transform = t out % optProps = optProp end function triprism_init function cone_init ( a , b , ra , rb , optProp , layer , transform ) result ( out ) !! Initalising function for Capped Cone SDF. type ( cone ) :: out !> Centre of base of Cone type ( vector ), intent ( IN ) :: a !> Tip of cone type ( vector ), intent ( IN ) :: b !> Radius of Cones base real ( kind = wp ), intent ( IN ) :: ra !> Radius of Cones tip. For rb = 0.0 get normal uncapped cone. real ( kind = wp ), intent ( in ) :: rb !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % b = b out % ra = ra out % rb = rb out % layer = layer out % transform = t out % optProps = optProp end function cone_init function cylinder_init ( a , b , radius , optProp , layer , transform ) result ( out ) !! Initalising function for Cylinder SDF. type ( cylinder ) :: out !> Radius of cylinder real ( kind = wp ), intent ( in ) :: radius !> Vector position at centre of the bottom circle type ( vector ), intent ( IN ) :: a !> Vector position at centre of the top circle type ( vector ), intent ( IN ) :: b !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % b = b out % radius = radius out % layer = layer out % transform = t out % optProps = optProp end function cylinder_init function torus_init ( oradius , iradius , optProp , layer , transform ) result ( out ) !! Initalising function for Torus SDF. type ( torus ) :: out !> Outer radius of Torus real ( kind = wp ), intent ( IN ) :: oradius !> Inner radius of Torus real ( kind = wp ), intent ( IN ) :: iradius !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % oradius = oradius out % iradius = iradius out % layer = layer out % transform = t out % optProps = optProp end function torus_init function box_init ( lengths , optProp , layer , transform ) result ( out ) !! Initalising function for Box SDF. type ( box ) :: out !> Lengths of each dimension of the box type ( vector ), intent ( IN ) :: lengths !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % lengths = . 5_wp * lengths ! as only half lengths out % layer = layer out % transform = t out % optProps = optProp end function box_init function sphere_init ( radius , optProp , layer , transform ) result ( out ) !! Initalising function for Sphere SDF. type ( sphere ) :: out !> radius of the Sphere real ( kind = wp ), intent ( IN ) :: radius !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % radius = radius out % layer = layer out % transform = t out % optProps = optProp end function sphere_init pure elemental function evaluate_sphere ( this , pos ) result ( res ) !! Evaluation function for Sphere SDF. class ( sphere ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: p p = pos . dot . this % transform res = sqrt ( p % x ** 2 + p % y ** 2 + p % z ** 2 ) - this % radius end function evaluate_sphere pure elemental function evaluate_box ( this , pos ) result ( res ) !! Evaluation function for Box SDF. class ( box ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: p , q p = pos . dot . this % transform q = abs ( p ) - this % lengths res = length ( max ( q , 0._wp )) + min ( max ( q % x , max ( q % y , q % z )), 0._wp ) end function evaluate_box pure elemental function evaluate_torus ( this , pos ) result ( res ) !! Evaluation function for Torus SDF. class ( torus ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: p , q p = pos . dot . this % transform q = vector ( length ( vector ( p % x , 0._wp , p % z )) - this % oradius , p % y , 0._wp ) res = length ( q ) - this % iradius end function evaluate_torus pure elemental function evaluate_cylinder ( this , pos ) result ( res ) !! Evaluation function for Cylinder SDF. class ( cylinder ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: p , ba , pa real ( kind = wp ) :: x , y , x2 , y2 , d , baba , paba p = pos . dot . this % transform ba = this % b - this % a pa = p - this % a baba = ba . dot . ba paba = pa . dot . ba x = length ( pa * baba - ba * paba ) - this % radius * baba y = abs ( paba - baba * . 5_wp ) - baba * . 5_wp x2 = x ** 2 y2 = ( y ** 2 ) * baba if ( max ( x , y ) < 0._wp ) then d = - min ( x2 , y2 ) else if ( x > 0._wp . and . y > 0._wp ) then d = x2 + y2 elseif ( x > 0._wp ) then d = x2 elseif ( y > 0._wp ) then d = y2 else d = 0._wp end if end if res = sign ( sqrt ( abs ( d )) / baba , d ) end function evaluate_cylinder pure elemental function evaluate_triprism ( this , pos ) result ( res ) !! Evaluation function for Triprisim SDF. class ( triprism ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: q , p p = pos . dot . this % transform q = abs ( p ) res = max ( q % z - this % h2 , max ( q % x * . 866025_wp + p % y * . 5_wp , - p % y ) - this % h1 * . 5_wp ) end function evaluate_triprism pure elemental function evaluate_segment ( this , pos ) result ( res ) !! Evaluation function for Segment SDF. !p = pos !a = pt1 !b = pt2 !draws segment along the axis between 2 points a and b use utils , only : clamp class ( segment ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: pa , ba , p real ( kind = wp ) :: h p = pos . dot . this % transform pa = p - this % a ba = this % b - this % a h = clamp (( pa . dot . ba ) / ( ba . dot . ba ), 0.0_wp , 1.0_wp ) res = length ( pa - ba * h ) - 0.1_wp end function evaluate_segment pure elemental function evaluate_capsule ( this , pos ) result ( res ) !! Evaluation function for Capsule SDF. use utils , only : clamp class ( capsule ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: pa , ba , p real ( kind = wp ) :: h p = pos . dot . this % transform pa = p - this % a ba = this % b - this % a h = clamp (( pa . dot . ba ) / ( ba . dot . ba ), 0._wp , 1._wp ) res = length ( pa - ba * h ) - this % r end function evaluate_capsule pure elemental function evaluate_cone ( this , pos ) result ( res ) !! Evaluation function for Cone SDF. use utils , only : clamp class ( cone ), intent ( in ) :: this type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: rba , baba , papa , paba , x , cax , cay , k , f , cbx , cby , s type ( vector ) :: p p = pos . dot . this % transform rba = this % rb - this % ra baba = ( this % b - this % a ) . dot . ( this % b - this % a ) papa = ( p - this % a ) . dot . ( p - this % a ) paba = (( p - this % a ) . dot . ( this % b - this % a )) / baba x = sqrt ( papa - baba * paba ** 2 ) if ( paba < 0.5_wp ) then cax = max ( 0._wp , x - this % ra ) else cax = max ( 0._wp , x - this % rb ) end if cay = abs ( paba - 0.5_wp ) - . 5_wp k = rba ** 2 + baba f = clamp (( rba * ( x - this % ra ) + paba * baba ) / k , 0._wp , 1._wp ) cbx = x - this % ra - f * rba cby = paba - f if ( cbx < 0._wp . and . cay < 0._wp ) then s = - 1._wp else s = 1._wp end if res = s * sqrt ( min ( cax ** 2 + baba * cay ** 2 , cbx ** 2 + baba * cby ** 2 )) end function evaluate_cone pure elemental function evaluate_egg ( this , pos ) result ( res ) !! Evaluation function for Egg SDF. !! [ref](https://www.shadertoy.com/view/WsjfRt) class ( egg ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: r , l , h_in type ( vector ) :: p_in , p p = pos . dot . this % transform p_in = p p_in % x = abs ( p % x ) r = this % r1 - this % r2 h_in = this % h + r l = ( h_in ** 2 - r ** 2 ) / ( 2._wp * r ) if ( p_in % y <= 0._wp ) then res = length ( p_in ) - this % r1 else if (( p_in % y - h_in ) * l > p_in % x * h_in ) then res = length ( p_in - vector ( 0._wp , h_in , 0._wp )) - (( this % r1 + l ) - length ( vector ( h_in , l , 0._wp ))) else res = length ( p_in + vector ( l , 0._wp , 0._wp )) - ( this % r1 + l ) end if end if end function evaluate_egg pure elemental function evaluate_plane ( this , pos ) result ( res ) !! Evaluation function for Plane SDF. class ( plane ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: p p = pos . dot . this % transform !a must be normalised res = ( p . dot . this % a ) end function evaluate_plane end module sdfs","tags":"","loc":"sourcefile/sdfs.f90.html"},{"title":"sdfHelpers.f90 – signedMCRT","text":"Contents Modules sdfHelpers Source Code sdfHelpers.f90 Source Code module sdfHelpers !! Collection of helper functions for SDFs: !! This module defines transforms that can be applied to each SDF: !! - Rotate_{x,y,z} !! - Translate !! - RotationAlign (not tested) !! - RotMat (not tested) !! - Identity !! - SkewSymm use vector_class use constants , only : wp implicit none private public :: rotate_x , rotate_y , rotate_z , rotmat , rotationAlign , identity , skewSymm , translate contains function rotate_x ( angle ) result ( r ) !! rotation in the x-axis function from [here](https://inspirnathan.com/posts/54-shadertoy-tutorial-part-8/) use utils , only : deg2rad !> Angle to rotate by real ( kind = wp ), intent ( IN ) :: angle real ( kind = wp ) :: r ( 4 , 4 ), c , s , a a = deg2rad ( angle ) c = cos ( a ) s = sin ( a ) r (:, 1 ) = [ 1._wp , 0._wp , 0._wp , 0._wp ] r (:, 2 ) = [ 0._wp , c , - s , 0._wp ] r (:, 3 ) = [ 0._wp , s , c , 0._wp ] r (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function rotate_x function rotate_y ( angle ) result ( r ) !! rotation in the y-axis function from [here](https://inspirnathan.com/posts/54-shadertoy-tutorial-part-8/) use utils , only : deg2rad !> Angle to rotate by real ( kind = wp ), intent ( IN ) :: angle real ( kind = wp ) :: r ( 4 , 4 ), c , s , a a = deg2rad ( angle ) c = cos ( a ) s = sin ( a ) r (:, 1 ) = [ c , 0._wp , s , 0._wp ] r (:, 2 ) = [ 0._wp , 1._wp , 0._wp , 0._wp ] r (:, 3 ) = [ - s , 0._wp , c , 0._wp ] r (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function rotate_y function rotate_z ( angle ) result ( r ) !! rotation in the z-axis function from [here](https://inspirnathan.com/posts/54-shadertoy-tutorial-part-8/) use utils , only : deg2rad !> Angle to rotate by real ( kind = wp ), intent ( IN ) :: angle real ( kind = wp ) :: r ( 4 , 4 ), c , s , a a = deg2rad ( angle ) c = cos ( a ) s = sin ( a ) r (:, 1 ) = [ c , - s , 0._wp , 0._wp ] r (:, 2 ) = [ s , c , 0._wp , 0._wp ] r (:, 3 ) = [ 0._wp , 0._wp , 1._wp , 0._wp ] r (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function rotate_z function rotmat ( axis , angle ) !! Rotate around around an axis by a given angle taken from [here](http://www.neilmendoza.com/glsl-rotation-about-an-arbitrary-axis/) use utils , only : deg2rad !> Axis to rotate around type ( vector ), intent ( in ) :: axis !> Angle to rotate by in degrees real ( kind = wp ), intent ( in ) :: angle type ( vector ) :: axist real ( kind = wp ) :: rotmat ( 4 , 4 ), s , c , oc , a axist = axis % magnitude () a = deg2rad ( angle ) s = sin ( a ) c = cos ( a ) oc = 1._wp - c rotmat (:, 1 ) = [ oc * axist % x * axist % x + c , oc * axist % x * axist % y - axist % z * s ,& oc * axist % z * axist % x + axist % y * s , 0.0_wp ] rotmat (:, 2 ) = [ oc * axist % x * axist % y + axist % z * s , oc * axist % y * axist % y + c ,& oc * axist % y * axist % z - axist % x * s , 0.0_wp ] rotmat (:, 3 ) = [ oc * axist % z * axist % x - axist % y * s , oc * axist % y * axist % z + axist % x * s ,& oc * axist % z * axist % z + c , 0.0_wp ] rotmat (:, 4 ) = [ 0.0_wp , 0.0_wp , 0.0_wp , 1.0_wp ] end function rotmat function rotationAlign ( a , b ) result ( res ) !! Calculate the rotation matrix to rotate vector a onto b !! [ref1](https://en.wikipedia.org/wiki/Rodrigues%27_rotation_formula) !! [ref2](https://math.stackexchange.com/questions/180418/calculate-rotation-matrix-to-align-vector-a-to-vector-b-in-3d) !> Vector to rotate. Unit vector type ( vector ), intent ( in ) :: a !> Vector to be rotated onto. Unit vector type ( vector ), intent ( in ) :: b type ( vector ) :: v real ( kind = wp ) :: c , k , res ( 4 , 4 ), v_x ( 4 , 4 ), v_x2 ( 4 , 4 ) v = a . cross . b c = a . dot . b k = 1._wp / ( 1._wp + c ) !skew-symmetric matrix v_x (:, 1 ) = [ 0._wp , - 1._wp * v % z , v % y , 0._wp ] v_x (:, 2 ) = [ v % z , 0._wp , - 1._wp * v % x , 0._wp ] v_x (:, 3 ) = [ - 1._wp * v % y , v % x , 0._wp , 0._wp ] v_x (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 0._wp ] v_x2 = matmul ( v_x , v_x ) res = identity () + v_x + v_x2 * k end function rotationAlign function identity () result ( r ) !! Returns the identity transformation matrix real ( kind = wp ) :: r ( 4 , 4 ) r (:, 1 ) = [ 1._wp , 0._wp , 0._wp , 0._wp ] r (:, 2 ) = [ 0._wp , 1._wp , 0._wp , 0._wp ] r (:, 3 ) = [ 0._wp , 0._wp , 1._wp , 0._wp ] r (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function identity function skewSymm ( a ) result ( out ) !! Calculate the Skew Symmetric matrix for a given vector !> Vector to calculate the skew symmetric matrix for. type ( vector ), intent ( in ) :: a real ( kind = wp ) :: out ( 4 , 4 ) out (:, 1 ) = [ 0._wp , - a % z , a % y , 0._wp ] out (:, 2 ) = [ a % z , 0._wp , - a % x , 0._wp ] out (:, 3 ) = [ - a % y , a % x , 0._wp , 0._wp ] out (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 0._wp ] end function skewSymm function translate ( o ) result ( out ) !! Returns the Translation matrix for a given vector translation. !> Vector to translate by. type ( vector ), intent ( IN ) :: o real ( kind = wp ) :: out ( 4 , 4 ) out (:, 1 ) = [ 1._wp , 0._wp , 0._wp , o % x ] out (:, 2 ) = [ 0._wp , 1._wp , 0._wp , o % y ] out (:, 3 ) = [ 0._wp , 0._wp , 1._wp , o % z ] out (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function translate end module sdfHelpers","tags":"","loc":"sourcefile/sdfhelpers.f90.html"},{"title":"sdfModifiers.f90 – signedMCRT","text":"Contents Modules sdfModifiers Source Code sdfModifiers.f90 Source Code module sdfModifiers !! This module defines transforms that can be applied to each SDF: !! - Union !! - Intersection !! - Subtraction !! - Displacement !! - Bend !! - Twist !! - Elongate !! - Repeat !! - Extrude !! - Revolution !! - Onion use constants , only : wp use sdf_baseMod , only : sdf_base , primitive use sdfHelpers , only : identity use vector_class implicit none !> Revoloution modifier. Revolves an SDF around the z axis (need to check this!!) type , extends ( sdf_base ) :: revolution real ( kind = wp ) :: o class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_revolution end type revolution !> Extrude a 2D SDF into 3D type , extends ( sdf_base ) :: extrude real ( kind = wp ) :: h class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_extrude end type extrude !> Carves or gives thickness to SDFs type , extends ( sdf_base ) :: onion real ( kind = wp ) :: thickness class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_onion end type onion !> Twist a SDF type , extends ( sdf_base ) :: twist real ( kind = wp ) :: k class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_twist end type twist !> Displace the surface of a SDF by a function. type , extends ( sdf_base ) :: displacement procedure ( primitive ), nopass , pointer :: func class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_disp end type displacement !> Bend a SDF. type , extends ( sdf_base ) :: bend real ( kind = wp ) :: k class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_bend end type bend !> Elongate a SDF type , extends ( sdf_base ) :: elongate type ( vector ) :: size class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_elongate end type elongate !> Repeat a SDF type , extends ( sdf_base ) :: repeat real ( kind = wp ) :: c type ( vector ) :: la , lb class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_repeat end type repeat interface revolution module procedure revolution_init end interface revolution interface extrude module procedure extrude_init end interface extrude interface onion module procedure onion_init end interface onion interface twist module procedure twist_init end interface twist interface displacement module procedure displacement_init end interface displacement interface bend module procedure bend_init end interface bend interface elongate module procedure elongate_init end interface elongate interface repeat module procedure repeat_init end interface repeat private public :: onion , extrude , twist , displacement , bend , elongate , repeat , revolution public :: union , SmoothUnion , intersection , subtraction contains type ( twist ) function twist_init ( prim , k ) result ( out ) !! Initialise the twist modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Twist parameter. real , intent ( in ) :: k out % k = k out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function twist_init type ( extrude ) function extrude_init ( prim , h ) result ( out ) !! Initialise the extrude modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Distance to extrude by. real ( kind = wp ), intent ( IN ) :: h out % h = h out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function extrude_init type ( elongate ) function elongate_init ( prim , size ) result ( out ) !! Initialise the elongate modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Distance to elongate by type ( vector ), intent ( IN ) :: size out % size = size out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function elongate_init type ( displacement ) function displacement_init ( prim , func ) result ( out ) !! Initialise the displacement modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Function to displace the SDF with. procedure ( primitive ) :: func out % func => func out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function displacement_init type ( bend ) function bend_init ( prim , k ) result ( out ) !! Initialise the Bend modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Amoun to bend by. real ( kind = wp ), intent ( IN ) :: k out % k = k out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function bend_init type ( repeat ) function repeat_init ( prim , c , la , lb ) result ( out ) !! Initialise the Repeat modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> type ( vector ), intent ( IN ) :: la !> type ( vector ), intent ( IN ) :: lb !> real ( kind = wp ), intent ( IN ) :: c out % c = c out % la = la out % lb = lb out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function repeat_init type ( revolution ) function revolution_init ( prim , o ) result ( out ) !! Initialise the Revolution modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Amount to revolve by. real ( kind = wp ), intent ( IN ) :: o out % o = o out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function revolution_init type ( onion ) function onion_init ( prim , thickness ) result ( out ) !! Initialise the Onion modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Thickned to onion by. real ( kind = wp ), intent ( IN ) :: thickness out % thickness = thickness out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function onion_init pure elemental function eval_extrude ( this , pos ) result ( res ) !! Evaluation function for Extrude modifier. class ( extrude ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: w real ( kind = wp ) :: d d = this % prim % evaluate ( pos ) w = vector ( d , abs ( pos % z ) - this % h , 0._wp ) res = min ( max ( w % x , w % y ), 0._wp ) + length ( max ( w , 0._wp )) end function eval_extrude pure elemental function eval_revolution ( this , pos ) result ( res ) !! Evaluation function for Revolution modifier. class ( revolution ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: pxz , q pxz = vector ( pos % x , pos % z , 0._wp ) q = vector ( length ( pxz ) - this % o , pos % y , 0._wp ) res = this % prim % evaluate ( q ) end function eval_revolution pure elemental function eval_onion ( this , pos ) result ( res ) !! Evaluation function for Onion modifier. class ( onion ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res res = abs ( this % prim % evaluate ( pos )) - this % thickness end function eval_onion pure elemental function eval_elongate ( this , pos ) result ( res ) !! Evaluation function for Elongate modifier. class ( elongate ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: w type ( vector ) :: q q = abs ( pos ) - this % size w = min ( max ( q % x , max ( q % y , q % z )), 0._wp ) res = this % prim % evaluate ( max ( q , 0._wp )) + w end function eval_elongate pure elemental function eval_twist ( this , pos ) result ( res ) !! Evaluation function for Twist modifier. class ( twist ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: c , s , x2 , y2 , z2 c = cos ( this % k * pos % z ) s = sin ( this % k * pos % z ) x2 = c * pos % x - s * pos % y y2 = s * pos % x + c * pos % y z2 = pos % z res = this % prim % evaluate ( vector ( x2 , y2 , z2 )) end function eval_twist pure elemental function eval_bend ( this , pos ) result ( res ) !! Evaluation function for Bend modifier. class ( bend ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: c , s , x2 , y2 , z2 c = cos ( this % k * pos % x ) s = sin ( this % k * pos % x ) x2 = c * pos % x - s * pos % y y2 = s * pos % x + c * pos % y z2 = pos % z res = this % prim % evaluate ( vector ( x2 , y2 , z2 )) end function eval_bend pure elemental function eval_disp ( this , pos ) result ( res ) !! Evaluation function for displacement modifier. class ( displacement ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: d1 , d2 d1 = this % prim % evaluate ( pos ) d2 = this % func ( pos ) res = d1 + d2 end function eval_disp pure elemental function eval_repeat ( this , pos ) result ( res ) !! Evaluation function for Repeat modifier. ! use utils, only : clamp class ( repeat ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: q error stop \"Not implmented as no vector dependacny in utils yet!\" ! q = pos - this%c*clamp(nint(pos/this%c), this%la, this%lb) res = this % prim % evaluate ( q ) end function eval_repeat pure function union ( d1 , d2 , k ) result ( res ) !! Union operation. Joins two SDFs together !> SDF_1 distance real ( kind = wp ), intent ( IN ) :: d1 !> SDF_2 distance real ( kind = wp ), intent ( IN ) :: d2 !> unused factor real ( kind = wp ), intent ( IN ) :: k real ( kind = wp ) :: res res = min ( d1 , d2 ) end function union pure function SmoothUnion ( d1 , d2 , k ) result ( res ) !! Smooth union. Joins two SDFs together smoothly !> SDF_1 distance real ( kind = wp ), intent ( IN ) :: d1 !> SDF_2 distance real ( kind = wp ), intent ( IN ) :: d2 !> smoothing factor. real ( kind = wp ), intent ( IN ) :: k real ( kind = wp ) :: res , h h = max ( k - abs ( d1 - d2 ), 0._wp ) / k res = min ( d1 , d2 ) - h * h * h * k * ( 1._wp / 6._wp ) end function SmoothUnion pure function subtraction ( d1 , d2 , k ) result ( res ) !! Subtraction operator. Takes one SDF from another. !! Take the first SDF from the 2nd SDF !> SDF_1 distance real ( kind = wp ), intent ( IN ) :: d1 !> SDF_2 distance real ( kind = wp ), intent ( IN ) :: d2 !> unused factor. real ( kind = wp ), intent ( IN ) :: k real ( kind = wp ) :: res res = max ( - d1 , d2 ) end function subtraction pure function intersection ( d1 , d2 , k ) result ( res ) !! Intersection operator. Returns the intersection of two SDFs. !> SDF_1 distance real ( kind = wp ), intent ( IN ) :: d1 !> SDF_2 distance real ( kind = wp ), intent ( IN ) :: d2 !> smoothing factor. real ( kind = wp ), intent ( IN ) :: k real ( kind = wp ) :: res res = max ( d1 , d2 ) end function intersection end module sdfModifiers","tags":"","loc":"sourcefile/sdfmodifiers.f90.html"},{"title":"sdf_base.f90 – signedMCRT","text":"Contents Modules sdf_baseMod Source Code sdf_base.f90 Source Code module sdf_baseMod !! This module defines the signed distance function (SDF) abstract type, sdf_base type, and model type. !! The SDF abstract type contains the optical properties of an SDF (mus, mua, kappa, albedo, hgg, g2,and n), as well as a transform (4x4 matrix), !! and the layer ID code of the SDF. The SDF abstract type also provides an abstract interface (evaluate) which each inheriting function must implement. !! This evaluate function is the heart of the SDF implementation. Each individual evaluate is the direct implementation of that SDF, e.g. that function defines the mathematical SDF. !! For more information on SDFs, check out Inigo Quilez's [website](https://iquilezles.org/articles/) from which most of the below SDFs and transforms have been taken. !! API based upon [here](https://fortran-lang.discourse.group/t/attempting-type-erasure-in-fortran/4402/2) use constants , only : wp use opticalProperties , only : opticalProp_t use sdfHelpers , only : identity use vector_class implicit none !> Abstract base type from which all SDF inherit from. type , abstract :: sdf_base !> Optical property of the SDF type ( opticalProp_t ) :: optProps !> Transform to apply to SDF. real ( kind = wp ) :: transform ( 4 , 4 ) !> Layer ID of SDF integer :: layer contains procedure ( evalInterface ), deferred :: evaluate end type sdf_base !> Container type that allows the use of arrays of different SDF shapes type , extends ( sdf_base ) :: sdf !> Container for any SDF that inherits from SDF_base class ( sdf_base ), allocatable :: value contains procedure :: getKappa procedure :: getAlbedo procedure :: getMua , gethgg , getG2 , getN procedure :: evaluate => sdf_evaluate procedure , private :: sdf_assign generic :: assignment ( = ) => sdf_assign end type sdf !> Model type. Allows the collection of multiple SDF into one model. Used to apply modifiers. type , extends ( sdf_base ) :: model !> Array of SDFs in the model type ( sdf ), allocatable :: array (:) !> SDF modifier function procedure ( op ), nopass , pointer :: func !> Parameter that may be used in modifer function. real ( kind = wp ) :: k contains procedure :: evaluate => eval_model end type model !#################################################################### abstract interface pure elemental function evalInterface ( this , pos ) result ( res ) !! Evaluation function for SDF. ALL SDF must implment this. use vector_class use constants , only : wp import sdf_base class ( sdf_base ), intent ( in ) :: this type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res end function pure function primitive ( pos ) result ( res ) !! Abstract function used as base for displacement function use vector_class , only : vector use constants , only : wp implicit none !> vector position of photon packet. type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res end function primitive pure function op ( d1 , d2 , k ) result ( res ) !! Abstract function used as the base for SDF operators (union, subtraction etc) use constants , only : wp implicit none real ( kind = wp ), intent ( IN ) :: d1 , d2 , k real ( kind = wp ) :: res end function op end interface interface sdf module procedure sdf_new end interface interface model module procedure model_init end interface interface render module procedure render_sub , render_vec end interface private public :: model , sdf , sdf_base , primitive , op , calcNormal , render contains function model_init ( array , func , kopt ) result ( out ) !! Initalise the model type. type ( model ) :: out !> Operator to apply to SDF. procedure ( op ) :: func !> Array of SDFs type ( sdf ), intent ( IN ) :: array (:) !> Parameter used in modifier real ( kind = wp ), optional , intent ( IN ) :: kopt integer :: i out % array = array out % func => func if ( present ( kopt )) then out % k = kopt else out % k = 0._wp end if do i = 2 , size ( array ) if ( array ( 1 )% value % optProps % value % mus /= array ( i )% value % optProps % value % mus ) then print * , \"Error mismatch in model mus in object: \" , i end if if ( array ( 1 )% value % optProps % value % mua /= array ( i )% value % optProps % value % mua ) then print * , \"Error mismatch in model mua in object: \" , i end if if ( array ( 1 )% value % optProps % value % hgg /= array ( i )% value % optProps % value % hgg ) then print * , \"Error mismatch in model hgg in object: \" , i end if if ( array ( 1 )% value % optProps % value % n /= array ( i )% value % optProps % value % n ) then print * , \"Error mismatch in model n in object: \" , i end if if ( array ( 1 )% value % layer /= array ( i )% value % layer ) then print * , \"Error mismatch in model layer in object: \" , i end if end do out % optProps = array ( 1 )% value % optProps out % layer = array ( 1 )% value % layer end function model_init pure elemental function eval_model ( this , pos ) result ( res ) !! Evaluate the model class ( model ), intent ( in ) :: this !> Vector position to evaluate at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res integer :: i res = this % array ( 1 )% value % evaluate ( pos ) do i = 2 , size ( this % array ) res = this % func ( res , this % array ( i )% value % evaluate ( pos ), this % k ) end do end function eval_model !############################################################# ! Helpers !############################################################# type ( vector ) function calcNormal ( p , obj ) !! Calculate the surface normal of a SDF at the point p numerically. !> Position to evaluate at type ( vector ), intent ( IN ) :: p !> SDF to calcuate surface normal of. class ( sdf_base ) :: obj real ( kind = wp ) :: h type ( vector ) :: xyy , yyx , yxy , xxx h = 1e-6_wp xyy = vector ( 1._wp , - 1._wp , - 1._wp ) yyx = vector ( - 1._wp , - 1._wp , 1._wp ) yxy = vector ( - 1._wp , 1._wp , - 1._wp ) xxx = vector ( 1._wp , 1._wp , 1._wp ) calcNormal = xyy * obj % evaluate ( p + xyy * h ) + & yyx * obj % evaluate ( p + yyx * h ) + & yxy * obj % evaluate ( p + yxy * h ) + & xxx * obj % evaluate ( p + xxx * h ) calcNormal = calcNormal % magnitude () end function calcNormal function getKappa ( this ) result ( res ) !! Return \\kappa for the current SDF class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % kappa end function getKappa function getMua ( this ) result ( res ) !! Return \\mu_a for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % mua end function getMua function gethgg ( this ) result ( res ) !! Return g-factor for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % hgg end function gethgg function getg2 ( this ) result ( res ) !! Return g^2 factor for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % g2 end function getg2 function getN ( this ) result ( res ) !! Return refractive index for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % n end function getN function getAlbedo ( this ) result ( res ) !! Return albedo for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % albedo end function getAlbedo !######################################################################### ! SDF bound procedures !######################################################################### pure elemental function sdf_evaluate ( this , pos ) result ( res ) !! Evaluate the SDF at a given position. class ( sdf ), intent ( in ) :: this type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res res = this % value % evaluate ( pos ) end function sdf_evaluate subroutine sdf_assign ( lhs , rhs ) !! sdf initializer class ( sdf ), intent ( inout ) :: lhs class ( sdf_base ), intent ( in ) :: rhs if ( allocated ( lhs % value )) deallocate ( lhs % value ) ! Prevent nested derived type select type ( rhsT => rhs ) class is ( sdf ) if ( allocated ( rhsT % value )) allocate ( lhs % value , source = rhsT % value ) class default allocate ( lhs % value , source = rhsT ) end select end subroutine sdf_assign type ( sdf ) function sdf_new ( rhs ) result ( lhs ) !! sdf initializer class ( sdf_base ), intent ( in ) :: rhs allocate ( lhs % value , source = rhs ) end function sdf_new subroutine render_vec ( cnt , state ) !! Render the SDF !! Wrapper around the render function to allow ease of use use sim_state_mod , only : settings_t type ( settings_t ), intent ( IN ) :: state type ( sdf ), intent ( IN ) :: cnt (:) type ( vector ) :: extent extent = vector ( state % grid % xmax , state % grid % ymax , state % grid % zmax ) call render_sub ( cnt , extent , state % render_size , state ) end subroutine render_vec subroutine render_sub ( cnt , extent , samples , state ) !! Render the SDFs onto a voxel grid use sim_state_mod , only : settings_t use utils , only : pbar use constants , only : fileplace , sp use writer_mod type ( settings_t ), intent ( IN ) :: state type ( sdf ), intent ( IN ) :: cnt (:) integer , intent ( IN ) :: samples ( 3 ) type ( vector ), intent ( IN ) :: extent type ( vector ) :: pos , wid integer :: i , j , k , u , id real ( kind = wp ) :: x , y , z , ds ( size ( cnt )), ns ( 3 ), minvalue real ( kind = sp ), allocatable :: image (:, :, :) type ( pbar ) :: bar ns = nint ( samples / 2._wp ) allocate ( image ( samples ( 1 ), samples ( 2 ), samples ( 3 ))) wid = vector ( extent % x / ns ( 1 ), extent % y / ns ( 2 ), extent % z / ns ( 3 )) bar = pbar ( samples ( 1 )) !$omp parallel default(none) shared(cnt, ns, wid, image, samples, bar)& !$omp private(i, x, y, z, pos, j, k, u, ds, id, minvalue) !$omp do do i = 1 , samples ( 1 ) x = ( i - ns ( 1 )) * wid % x do j = 1 , samples ( 2 ) y = ( j - ns ( 2 )) * wid % y do k = 1 , samples ( 3 ) z = ( k - ns ( 3 )) * wid % z pos = vector ( x , y , z ) ds = 0._wp do u = 1 , size ( ds ) ds ( u ) = cnt ( u )% evaluate ( pos ) end do image ( i , j , k ) = minval ( ds ) end do end do call bar % progress () end do !$OMP end do !$OMP end parallel call write_data ( image , trim ( fileplace ) // state % renderfile , state , overwrite = . true .) end subroutine render_sub end module sdf_baseMod","tags":"","loc":"sourcefile/sdf_base.f90.html"},{"title":"main.f90 – signedMCRT","text":"Contents Programs mcpolar Source Code main.f90 Source Code program mcpolar !! Entry point for program use kernels , only : weight_scatter , pathlength_scatter integer :: num_args , i character ( len = 64 ), allocatable :: args (:) num_args = command_argument_count () if ( num_args == 0 ) then allocate ( args ( 1 )) args ( 1 ) = \"scat_test.toml\" else allocate ( args ( num_args )) do i = 1 , num_args call get_command_argument ( i , args ( i )) end do end if ! call weight_scatter(trim(args(1))) call pathlength_scatter ( trim ( args ( 1 ))) end program","tags":"","loc":"sourcefile/main.f90.html"},{"title":"main – signedMCRT","text":"Documentation This document is the incomplete documentation of signedMCRT . Build system To build signedMCRT, the only current method is using FPM .\nFPM can be easily installed on any platform, and is simple to use to pull all dependencies, and build and compile signedMCRT.\nWe also provide several commands via FPM response file ( found here ), to enable the use of OpenMP, other compliers, and various debug modes. Running the code The code is run using FPM. To run on a single core with no debug flags enabled: fpm run To run on all available threads on current computer with no debug flags: fpm @runmp To run the code on one thread with all debug flags enabled: fpm @debug To run the code on all threads with all debug flags enabled: fpm @debugmp Please see ( here ) for other possible options. Dependencies Below is the current list of dependencies: test drive Fortran TEV Bindings stdlib stb_image Fortran Utilities Test drive is used to run all tests.\nFortran TEV Bindings is used to interface with TEV, to show live slices of fluences as the simulation is run, which is handy for debugging purposes.\nStdlib is a collection of routines purposed for inclusion within the Fortran standard. Stdlib is used here for it's loadtxt function to load arbitrary plain text data into arrays. More of stdlib may be used in future.\nFortran_stb_Image is used to load images into arrays. Fortran_stb_image are the Fortran bindings for stb_image .\nFinally, Fortran Utilities is my personal collection of useful Fortran utilities such as mathematical functions, or progress bars. Config file signedMCRT uses TOML as it's configuration file format.\nDocumentation of the input file format can be found in here Plotting Results To view the output of simulations you can use this .\nAlternatively to customise the plot you can adjust the following script . Monte Carlo Radiation Transfer (MCRT) method Please see my thesis for an overview of the MCRT method. Citation SignedMCRT has so far been used in 2 papers: MESHLESS MONTE CARLO RADIATION TRANSFER METHOD FOR CURVED GEOMETRIES USING SIGNED DISTANCE FUNCTIONS\nL. McMillan, G. D. Bruce, K. Dholakia, J. Biomed. Opt. 27(8), 083003 (2022) / arXiv:2112.08035 (2021) TO FOCUS-MATCH OR NOT TO FOCUS-MATCH INVERSE SPATIALLY OFFSET RAMAN SPECTROSCOPY: A QUESTION OF LIGHT PENETRATION\nG.E. Shillito, L. McMillan, G. D. Bruce, K. Dholakia, Opt. Express 30, 8876 (2022) / arXiv:2112.08877 TODO's The current TODO list of planned features and current bugs can be found here .","tags":"","loc":"page/index.html"},{"title":"todos – signedMCRT","text":"TODOs List of ToDo's for SignedMCRT. Additional Features Finished Features Make CI run tests Add Code Coverage reports Remove spurious implicit nones Make sure all optical properties are the same for a model instance (SDF) [x] Add \"Scattering\" kernels path length counter method Weight method [x] Add documentation on piecewise Constant 1D 2D [x] Finish new SDF API add all SDFs add adjustment functions (twist, union etc) propagate to subs.f90 Minor Features Add more saved state to photon_origin to save compute time [ ] Finish Circular, focus, and annulus source types Circular Focus Annulus. Partially done via control of Beta parameter. [ ] Add Direction component to rest of Detectors Circle Camera Annulus [ ] Add photon trajectory history tracking Add to each detector separately Fix openMP troubles Fix speed issues Major Features Make code work on Windows Automate benchmarking so we can catch performance regressions Add voxel geometry Add mesh geometry Improve performance of SDF intersection [ ] Make code serializable so that we can checkpoint simulations Save input toml file photons run [ ] Save output data Detectors Fluence Absorb NScatt Add optics to Camera type [x] Add phase tracking (https://github.com/lewisfish/signedMCRT/pull/2). Add phase screen detector to camera Add refractive index accounting Compress output data (https://github.com/aras-p/float_compr_tester/blob/main/src/compression_helpers.cpp) Add more error handling for spectrums in parse.f90 [ ] Add optical property type, to allow for multi-spectral input. [x] base optical property type function defined Tabulated propagate to SDFs propagate to subs.f90 Document optical properties Change API to match that of SDFs, i.e easier to use Add MPI + openMP mode (e.g. run openMP on N nodes with minimal communication) Testing Vec3 class Matrix class Vec4 Class [ ] SDF Class Helpers Modifiers Base Shapes [x] Detector Class Circle Camera Annulus Surfaces Grid Optical Properties [ ] Photon class Uniform Point Pencil Circular Annulus Scattering Isotropic Henyey-Greenstein Importance sampling biased scattering Photon movement code History Stack Class I/O Random Numbers [x] Fresnel reflections Simple reflect Simple refract Complex reflect Complex refract [ ] End to End tests Scattering Test Others [ ] test phase double slit square aperture gaussian beam bessel beam Bugs [ ] Fix CI so that build on Macos run, and builds using Intel run. Macos Intel [ ] Can't operate trackHistory in parallel Make each thread write to tmp file and finish method collate results Added default array option to get_vector in parse.f90","tags":"","loc":"page/TODO.html"},{"title":"config – signedMCRT","text":"Config file settings The configuration file format used is Tom's Obvious Minimal Language ( TOML ).\nThe below sections describe the tables (dictionaries) that are able to be defined for SignedMCRT. Source This table defines the parameters for the light source used in the simulation it can have the following: Parameter Type Options Default Notes name string point, circular, uniform, pencil, annulus, focus point - nphotons integer - 1000000 - position float array size 3 - [0.0, 0.0, 0.0] Default value only set for point source type direction float array size 3 or string - -z String type applies to all source types bar: Uniform and circular point1 float array size 3 - [-1.0, -1.0, -1.0] Used by uniform source only to set location and size of source point2 float array size 3 - [2.0, 0.0, 0.0] See Above point3 float array size 3 - [0.0, 2.0, 0.0] See Above Radius float - 0.5 Used by circular source and annular source (as lower radius) rhi float - 0.6 Annular source upper radius Beta float - 5.0 Annular source convergence angle (Bessel beam beta parameter) annulus_type string gaussian, tophat gaussian Type of annular beam spectrum_type string constant, 1D, 2D constant Type of spectrum used spectrum_file string - - filename of 1D or 2D spectrum/image cell_size float array size 2 - - size of pixel in 2D spectrum in simulation units. wavelength float - 500 nm Wavelength for constant spectrum Note point1, point2, and point3 define a rectangle. Point1 is the origin,point2 and point3 are the vectors that describe the sides. Grid Parameter Type Default Notes nxg integer 200 Number of voxel in x direction nyg integer 200 Number of voxel in y direction nyg integer 200 Number of voxel in z direction xmax float 1.0 Half size of simulated medium in x direction ymax float 1.0 Half size of simulated medium in y direction zmax float 1.0 Half size of simulated medium in z direction units string cm Units of simulation (currently need to manually adjust optical properties to account) Geometry Parameter Type Default Notes geom_name string sphere Name of experiment for metadata tau float 10.0 Tau value for MCRT scattering test experiment num_spheres integer 10 Number of random spheres for sphere scene musb float 0.0 Optical properties for experimental geometry for whiskey Raman sensing paper muab float 0.01 See above musc float 0.0 See Above muac float 0.01 See Above hgg float 0.7 See Above Detectors Parameter Type Options Default Notes type string annulus, circle, camera - - position float array size 3 - NO DEFAULT! Central position of detector direction float array size 3 - [0.0, 0.0, -1.0] - radius1 float - - Radius of circular detector. Inner radius of annular detector radius2 float - - Outer radius of annulus detector. Must be larger than radius1 p1 float array size 3 - [-1.0, -1.0, -1.0] Used by camera detector only to set location and size of source p2 float array size 3 - [2.0, 0.0, 0.0] See above p3 float array size 3 - [0.0, 2.0, 0.0] See above layer integer - 1 layer to match SDF layer label nbins integer - 100 Number of bins in detector maxval float - 100.0 Maximum value to bin historyFileName string - \"photPos.obj\" Name of output file of detected photons histories trackHistory boolean - false If true record detected photons histories. !!!Does not work with openMP!!! Output Parameter Type Default Notes fluence string fluence.nrrd Filename for fluence output absorb string absorb.nrrd Filename for energy absorbed output render string geom_render.nrrd Filename for render geometry output render_geom boolean false Render geometry out. For debugging purposes render_size integer array size 3 [200, 200, 200] Size in voxels of render overwrite boolean false Overwrite files if they have the same name Simulation Parameter Type Default Notes iseed integer 123456789 seed for simulation. Each thread get its own copy + threadID tev boolean false Enables TEV image viewer to display simulation as it runs. Must have opened TEV prior to launching simulation. absorb boolean false Enables writing to file of absorbed energy.","tags":"","loc":"page/config.html"}]} \ No newline at end of file +var tipuesearch = {"pages":[{"title":" signedMCRT ","text":"signedMCRT Brief description Installation Dependencies References License Brief description A Monte Carlo radiation transfer code with signed distance functions representing the geometry, written in modern Fortran.\nThis allows modelling of smooth surfaces with out the need to use triangle or similar meshes. Installation To build signedMCRT, the only current method is using FPM .\nFPM can be easily installed on any platform, and is simple to use to pull all dependencies, and build and compile signedMCRT.\nWe also provide several commands via FPM response file ( found here ), to enable the use of OpenMP, other compliers, and various debug modes. Dependencies Below is the current list of dependencies: test drive Fortran TEV Bindings stdlib stb_image Fortran Utilities Test drive is used to run all tests.\nFortran TEV Bindings is used to interface with TEV, to show live slices of fluences as the simulation is run, which is handy for debugging purposes.\nStdlib is a collection of routines purposed for inclusion within the Fortran standard. Stdlib is used here for it's loadtxt function to load arbitrary plain text data into arrays. More of stdlib may be used in future.\nFortran_stb_Image is used to load images into arrays. Fortran_stb_image are the Fortran bindings for stb_image .\nFinally, Fortran Utilities is my personal collection of useful Fortran utilities such as mathematical functions, or progress bars. References SignedMCRT has so far been used in 2 papers: MESHLESS MONTE CARLO RADIATION TRANSFER METHOD FOR CURVED GEOMETRIES USING SIGNED DISTANCE FUNCTIONS\nL. McMillan, G. D. Bruce, K. Dholakia, J. Biomed. Opt. 27(8), 083003 (2022) / arXiv:2112.08035 (2021) TO FOCUS-MATCH OR NOT TO FOCUS-MATCH INVERSE SPATIALLY OFFSET RAMAN SPECTROSCOPY: A QUESTION OF LIGHT PENETRATION\nG.E. Shillito, L. McMillan, G. D. Bruce, K. Dholakia, Opt. Express 30, 8876 (2022) / arXiv:2112.08877 License The signedMCRT source code and related files and documentation are\ndistributed under a permissive free software license (MIT). Developer Info Lewis McMillan","tags":"home","loc":"index.html"},{"title":"photon – signedMCRT ","text":"type, public :: photon photon class Contents Variables bounces cnts cosp cost emit energy fact id layer nxp nyp nzp phase phi pos sinp sint step tflag wavelength weight xcell ycell zcell Constructor photon Type-Bound Procedures scatter Source Code photon Components Type Visibility Attributes Name Initial integer, public :: bounces Debug data. Number of SDF evals integer, public :: cnts Debug data. Number of SDF evals real(kind=wp), public :: cosp direction cosines real(kind=wp), public :: cost direction cosines procedure( generic_emit ), public, pointer :: emit => null() emission routine real(kind=wp), public :: energy Energy of the packet. TODO real(kind=wp), public :: fact . Used to save computational time integer, public :: id Thread ID of the packet integer, public :: layer ID of the SDF the packet is in real(kind=wp), public :: nxp direction vectors real(kind=wp), public :: nyp direction vectors real(kind=wp), public :: nzp direction vectors real(kind=wp), public :: phase Current phase of the packet real(kind=wp), public :: phi direction cosines type( vector ), public :: pos postion of photon packet in cm. (0,0,0) is the center of the grid. real(kind=wp), public :: sinp direction cosines real(kind=wp), public :: sint direction cosines real(kind=wp), public :: step used if photon packet weights are used logical, public :: tflag photon alive flag real(kind=wp), public :: wavelength Wavelength of the packet real(kind=wp), public :: weight used if photon packet weights are used integer, public :: xcell grid cell position integer, public :: ycell grid cell position integer, public :: zcell grid cell position Constructor public interface photon public function init_source (choice) Bind emission function to photon object Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: choice Name of light source to use Return Value type( photon ) private function init_photon (val) set up all the variables in the photon object Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val value to assing to variables Return Value type( photon ) Type-Bound Procedures procedure, public, :: scatter scattering routine private subroutine scatter (this, hgg, g2, dects) Scattering routine. Implments both isotropic and henyey-greenstein scattering\ntaken from mcxyz Arguments Type Intent Optional Attributes Name class( photon ), intent(inout) :: this real(kind=wp), intent(in) :: hgg g factor real(kind=wp), intent(in) :: g2 g factor squared type( dect_array ), intent(in), optional :: dects (:) array of detectors. Only used if biased scattering is enabled. Source Code type :: photon !> postion of photon packet in cm. (0,0,0) is the center of the grid. type ( vector ) :: pos !> direction vectors real ( kind = wp ) :: nxp , nyp , nzp !> direction cosines real ( kind = wp ) :: sint , cost , sinp , cosp , phi !> Wavelength of the packet real ( kind = wp ) :: wavelength !> Current phase of the packet real ( kind = wp ) :: phase !> \\frac{2\\pi}{\\lambda}. Used to save computational time real ( kind = wp ) :: fact !> Energy of the packet. TODO real ( kind = wp ) :: energy !> grid cell position integer :: xcell , ycell , zcell !> photon alive flag logical :: tflag !> ID of the SDF the packet is in integer :: layer !> Thread ID of the packet integer :: id !> Debug data. Number of SDF evals integer :: cnts , bounces !> used if photon packet weights are used real ( kind = wp ) :: weight , step !, L !> emission routine procedure ( generic_emit ), pointer :: emit => null () contains !> scattering routine procedure :: scatter => scatter end type photon","tags":"","loc":"type/photon.html"},{"title":"mat – signedMCRT ","text":"type, public :: mat Contents Variables vals Constructor mat Type-Bound Procedures mat_add_scal mat_div_scal mat_minus_scal mat_mult_mat mat_mult_scal operator(*) operator(+) operator(-) operator(/) scal_add_mat scal_mult_mat Source Code mat Components Type Visibility Attributes Name Initial real(kind=wp), public :: vals (4,4) Matrix values Constructor public interface mat Intalise Matrix with 1D Array private function mat_init (array) Initalise matrix type from 1D array Arguments Type Intent Optional Attributes Name real(kind=wp) :: array (16) 1D array to initalise from. Return Value type( mat ) Type-Bound Procedures procedure, private, pass(a) :: mat_add_scal private function mat_add_scal (a, b) Matrix + Scalar = Matrix Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to add Return Value type( mat ) procedure, private, pass(a) :: mat_div_scal private function mat_div_scal (a, b) Matrix / scalar Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to divide by Return Value type( mat ) procedure, private, pass(a) :: mat_minus_scal private function mat_minus_scal (a, b) Matrix - Scalar Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( mat ) procedure, private, pass(a) :: mat_mult_mat private function mat_mult_mat (a, b) Matrix * vec4 Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix type( vec4 ), intent(in) :: b Vec4 to multiply by Return Value type( vec4 ) procedure, private, pass(a) :: mat_mult_scal private function mat_mult_scal (a, b) Matrix * Scalar Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( mat ) generic, public, :: operator(*) => mat_mult_scal , scal_mult_mat , mat_mult_mat Overload for Multiplication operator private function mat_mult_scal (a, b) Matrix * Scalar Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( mat ) private function scal_mult_mat (a, b) Matrix * Scalar Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( mat ), intent(in) :: b Input Matrix Return Value type( mat ) private function mat_mult_mat (a, b) Matrix * vec4 Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix type( vec4 ), intent(in) :: b Vec4 to multiply by Return Value type( vec4 ) generic, public, :: operator(+) => mat_add_scal , scal_add_mat Overload for Addition operator private function mat_add_scal (a, b) Matrix + Scalar = Matrix Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to add Return Value type( mat ) private function scal_add_mat (a, b) Scaler + Matrix Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalat to add class( mat ), intent(in) :: b Input Matrix Return Value type( mat ) generic, public, :: operator(-) => mat_minus_scal Overload for Subtraction operator private function mat_minus_scal (a, b) Matrix - Scalar Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( mat ) generic, public, :: operator(/) => mat_div_scal Overload for Division operator private function mat_div_scal (a, b) Matrix / scalar Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to divide by Return Value type( mat ) procedure, private, pass(b) :: scal_add_mat private function scal_add_mat (a, b) Scaler + Matrix Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalat to add class( mat ), intent(in) :: b Input Matrix Return Value type( mat ) procedure, private, pass(b) :: scal_mult_mat private function scal_mult_mat (a, b) Matrix * Scalar Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( mat ), intent(in) :: b Input Matrix Return Value type( mat ) Source Code type :: mat !> Matrix values real ( kind = wp ) :: vals ( 4 , 4 ) contains !> Overload for Division operator generic :: operator ( / ) => mat_div_scal !> Overload for Multiplication operator generic :: operator ( * ) => mat_mult_scal , scal_mult_mat , mat_mult_mat !> Overload for Addition operator generic :: operator ( + ) => mat_add_scal , scal_add_mat !> Overload for Subtraction operator generic :: operator ( - ) => mat_minus_scal procedure , pass ( a ), private :: mat_div_scal procedure , pass ( a ), private :: mat_mult_mat procedure , pass ( a ), private :: mat_mult_scal procedure , pass ( b ), private :: scal_mult_mat procedure , pass ( a ), private :: mat_add_scal procedure , pass ( b ), private :: scal_add_mat procedure , pass ( a ), private :: mat_minus_scal end type mat","tags":"","loc":"type/mat.html"},{"title":"history_stack_t – signedMCRT ","text":"type, public :: history_stack_t Contents Variables data edge_counter filename size type vertex_counter Constructor history_stack_t Type-Bound Procedures empty finish peek pop push write zero Source Code history_stack_t Components Type Visibility Attributes Name Initial type( vec4 ), public, allocatable :: data (:) integer, public :: edge_counter character(len=:), public, allocatable :: filename integer, public :: size character(len=:), public, allocatable :: type integer, public :: vertex_counter Constructor public interface history_stack_t private function init_historyStack (filename, id) Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: filename integer, intent(in) :: id Return Value type( history_stack_t ) Type-Bound Procedures procedure, public, :: empty => histempty_fn private function histempty_fn (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Return Value logical procedure, public, :: finish => histfinish_sub private subroutine histfinish_sub (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this procedure, public, :: peek => histpeek_fn private function histpeek_fn (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Return Value type( vec4 ) procedure, public, :: pop => histpop_fn private function histpop_fn (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Return Value type( vec4 ) procedure, public, :: push => histpush_sub private subroutine histpush_sub (this, val) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this type( vec4 ), intent(in) :: val procedure, public, :: write => histwrite_sub private subroutine histwrite_sub (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this procedure, public, :: zero => histzero_sub private subroutine histzero_sub (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Source Code type :: history_stack_t type ( vec4 ), allocatable :: data (:) integer :: size , vertex_counter , edge_counter character ( len = :), allocatable :: filename , type contains procedure :: pop => histpop_fn procedure :: push => histpush_sub procedure :: peek => histpeek_fn procedure :: empty => histempty_fn procedure :: zero => histzero_sub procedure :: write => histwrite_sub procedure :: finish => histfinish_sub end type history_stack_t","tags":"","loc":"type/history_stack_t.html"},{"title":"vector – signedMCRT ","text":"type, public :: vector Vector class Contents Variables x y z Type-Bound Procedures length magnitude operator(*) operator(**) operator(+) operator(-) operator(.cross.) operator(.dot.) operator(/) operator(==) scal_add_vec scal_minus_vec scal_mult_vec vec_add_scal vec_add_vec vec_cross_vec vec_div_scal_int vec_div_scal_r4 vec_div_scal_r8 vec_dot_mat vec_dot_vec vec_equal_vec vec_minus_scal vec_minus_vec vec_mult_exp_scal_int vec_mult_exp_scal_r4 vec_mult_exp_scal_r8 vec_mult_scal vec_mult_vec Source Code vector Components Type Visibility Attributes Name Initial real(kind=wp), public :: x vector components real(kind=wp), public :: y vector components real(kind=wp), public :: z vector components Type-Bound Procedures procedure, public, :: length Returns the length of the vector public pure elemental function length (this) Returns the length of a vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: this Return Value real(kind=wp) procedure, public, :: magnitude Returns the magnitude of the vector public pure elemental function magnitude (this) Returns the magnitude of a vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: this Return Value type( vector ) generic, public, :: operator(*) => vec_mult_vec , vec_mult_scal , scal_mult_vec Overloads the Multiplication operator for vec3 private pure elemental function vec_mult_vec (a, b) vec3 * vec3 elementwise Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 type( vector ), intent(in) :: b vec3 to multiply by Return Value type( vector ) private pure elemental function vec_mult_scal (a, b) vec3 * scalar elementwise Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( vector ) private pure elemental function scal_mult_vec (a, b) Scalar * vec3 elementwise Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( vector ), intent(in) :: b input vec3 Return Value type( vector ) generic, public, :: operator(**) => vec_mult_exp_scal_int , vec_mult_exp_scal_r4 , vec_mult_exp_scal_r8 Overloads the exponential operator for vec3 private pure elemental function vec_mult_exp_scal_int (a, b) vec3**scalar for integer scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector integer, intent(in) :: b Input scalar Return Value type( vector ) private pure elemental function vec_mult_exp_scal_r4 (a, b) vec3**scalar for 32-bit float scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector real(kind=sp), intent(in) :: b Input scalar Return Value type( vector ) private pure elemental function vec_mult_exp_scal_r8 (a, b) vec3**scalar for 64-bit float scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector real(kind=dp), intent(in) :: b Input scalar Return Value type( vector ) generic, public, :: operator(+) => vec_add_vec , vec_add_scal , scal_add_vec Overloads the Addition operator for vec3 private pure elemental function vec_add_vec (a, b) vec3 + vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b Vec3 to add Return Value type( vector ) private pure elemental function vec_add_scal (a, b) vec3 + scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector real(kind=wp), intent(in) :: b Scalar to add Return Value type( vector ) private pure elemental function scal_add_vec (a, b) vec3 + scalar Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to add class( vector ), intent(in) :: b Input vector Return Value type( vector ) generic, public, :: operator(-) => vec_minus_vec , vec_minus_scal , scal_minus_vec Overloads the Subtraction operator for vec3 private pure elemental function vec_minus_vec (a, b) vec3 - vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b vec3 to subtract Return Value type( vector ) private pure elemental function vec_minus_scal (a, b) vec3 - scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( vector ) private pure elemental function scal_minus_vec (a, b) scalar - vec3 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to subtract from class( vector ), intent(in) :: b Input vector Return Value type( vector ) generic, public, :: operator(.cross.) => vec_cross_vec .cross. operator. Cross product private pure elemental function vec_cross_vec (a, b) result(cross) vec3 x vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b vec3 to cross with Return Value type( vector ) generic, public, :: operator(.dot.) => vec_dot_vec , vec_dot_mat .dot. operator. Dot product private pure elemental function vec_dot_vec (a, b) result(dot) vec3 . vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3 type( vector ), intent(in) :: b vec3 to dot Return Value real(kind=wp) private pure function vec_dot_mat (a, b) result(dot) vec3 . matrix Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3 real(kind=wp), intent(in) :: b (4,4) Matrix to dot with Return Value type( vector ) generic, public, :: operator(/) => vec_div_scal_r4 , vec_div_scal_r8 , vec_div_scal_int Overloads the Division operator for vec3 private pure elemental function vec_div_scal_r4 (a, b) vec3 / scalar elementwise. Scalar is a 32-bit float Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=sp), intent(in) :: b Scalar to divide by Return Value type( vector ) private pure elemental function vec_div_scal_r8 (a, b) vec3 / scalar elementwise. Scalar is a 64-bit float Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=dp), intent(in) :: b Scalar to divide by Return Value type( vector ) private pure elemental function vec_div_scal_int (a, b) vec3 / scalar elementwise. Scalar is an integer Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 integer, intent(in) :: b Scalar to divide by Return Value type( vector ) generic, public, :: operator(==) => vec_equal_vec Overloads the equal operator for vec3 private pure elemental function vec_equal_vec (a, b) vec3 == vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3s class( vector ), intent(in) :: b Input vec3s Return Value logical procedure, private, pass(b) :: scal_add_vec private pure elemental function scal_add_vec (a, b) vec3 + scalar Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to add class( vector ), intent(in) :: b Input vector Return Value type( vector ) procedure, private, pass(b) :: scal_minus_vec private pure elemental function scal_minus_vec (a, b) scalar - vec3 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to subtract from class( vector ), intent(in) :: b Input vector Return Value type( vector ) procedure, private, pass(b) :: scal_mult_vec private pure elemental function scal_mult_vec (a, b) Scalar * vec3 elementwise Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( vector ), intent(in) :: b input vec3 Return Value type( vector ) procedure, private, pass(a) :: vec_add_scal private pure elemental function vec_add_scal (a, b) vec3 + scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector real(kind=wp), intent(in) :: b Scalar to add Return Value type( vector ) procedure, private, pass(a) :: vec_add_vec private pure elemental function vec_add_vec (a, b) vec3 + vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b Vec3 to add Return Value type( vector ) procedure, private, pass(a) :: vec_cross_vec private pure elemental function vec_cross_vec (a, b) result(cross) vec3 x vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b vec3 to cross with Return Value type( vector ) procedure, private, pass(a) :: vec_div_scal_int private pure elemental function vec_div_scal_int (a, b) vec3 / scalar elementwise. Scalar is an integer Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 integer, intent(in) :: b Scalar to divide by Return Value type( vector ) procedure, private, pass(a) :: vec_div_scal_r4 private pure elemental function vec_div_scal_r4 (a, b) vec3 / scalar elementwise. Scalar is a 32-bit float Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=sp), intent(in) :: b Scalar to divide by Return Value type( vector ) procedure, private, pass(a) :: vec_div_scal_r8 private pure elemental function vec_div_scal_r8 (a, b) vec3 / scalar elementwise. Scalar is a 64-bit float Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=dp), intent(in) :: b Scalar to divide by Return Value type( vector ) procedure, private, pass(a) :: vec_dot_mat private pure function vec_dot_mat (a, b) result(dot) vec3 . matrix Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3 real(kind=wp), intent(in) :: b (4,4) Matrix to dot with Return Value type( vector ) procedure, private, pass(a) :: vec_dot_vec private pure elemental function vec_dot_vec (a, b) result(dot) vec3 . vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3 type( vector ), intent(in) :: b vec3 to dot Return Value real(kind=wp) procedure, private, pass(a) :: vec_equal_vec private pure elemental function vec_equal_vec (a, b) vec3 == vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3s class( vector ), intent(in) :: b Input vec3s Return Value logical procedure, private, pass(a) :: vec_minus_scal private pure elemental function vec_minus_scal (a, b) vec3 - scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( vector ) procedure, private, pass(a) :: vec_minus_vec private pure elemental function vec_minus_vec (a, b) vec3 - vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b vec3 to subtract Return Value type( vector ) procedure, private, pass(a) :: vec_mult_exp_scal_int private pure elemental function vec_mult_exp_scal_int (a, b) vec3**scalar for integer scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector integer, intent(in) :: b Input scalar Return Value type( vector ) procedure, private, pass(a) :: vec_mult_exp_scal_r4 private pure elemental function vec_mult_exp_scal_r4 (a, b) vec3**scalar for 32-bit float scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector real(kind=sp), intent(in) :: b Input scalar Return Value type( vector ) procedure, private, pass(a) :: vec_mult_exp_scal_r8 private pure elemental function vec_mult_exp_scal_r8 (a, b) vec3**scalar for 64-bit float scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector real(kind=dp), intent(in) :: b Input scalar Return Value type( vector ) procedure, private, pass(a) :: vec_mult_scal private pure elemental function vec_mult_scal (a, b) vec3 * scalar elementwise Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( vector ) procedure, private, pass(a) :: vec_mult_vec private pure elemental function vec_mult_vec (a, b) vec3 * vec3 elementwise Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 type( vector ), intent(in) :: b vec3 to multiply by Return Value type( vector ) Source Code type :: vector !> vector components real ( kind = wp ) :: x , y , z contains !> Returns the magnitude of the vector procedure :: magnitude => magnitude !> Returns the length of the vector procedure :: length => length !> .dot. operator. Dot product generic :: operator (. dot .) => vec_dot_vec , vec_dot_mat !> .cross. operator. Cross product generic :: operator (. cross .) => vec_cross_vec !> Overloads the Division operator for vec3 generic :: operator ( / ) => vec_div_scal_r4 , vec_div_scal_r8 , vec_div_scal_int !> Overloads the Multiplication operator for vec3 generic :: operator ( * ) => vec_mult_vec , vec_mult_scal , scal_mult_vec !> Overloads the exponential operator for vec3 generic :: operator ( ** ) => vec_mult_exp_scal_int , vec_mult_exp_scal_r4 , vec_mult_exp_scal_r8 !> Overloads the Addition operator for vec3 generic :: operator ( + ) => vec_add_vec , vec_add_scal , scal_add_vec !> Overloads the Subtraction operator for vec3 generic :: operator ( - ) => vec_minus_vec , vec_minus_scal , scal_minus_vec !> Overloads the equal operator for vec3 generic :: operator ( == ) => vec_equal_vec procedure , pass ( a ), private :: vec_dot_vec procedure , pass ( a ), private :: vec_dot_mat procedure , pass ( a ), private :: vec_cross_vec procedure , pass ( a ), private :: vec_div_scal_r4 procedure , pass ( a ), private :: vec_div_scal_r8 procedure , pass ( a ), private :: vec_div_scal_int procedure , pass ( a ), private :: vec_mult_vec procedure , pass ( a ), private :: vec_mult_scal procedure , pass ( b ), private :: scal_mult_vec procedure , pass ( a ), private :: vec_mult_exp_scal_int procedure , pass ( a ), private :: vec_mult_exp_scal_r4 procedure , pass ( a ), private :: vec_mult_exp_scal_r8 procedure , pass ( a ), private :: vec_add_vec procedure , pass ( a ), private :: vec_add_scal procedure , pass ( b ), private :: scal_add_vec procedure , pass ( a ), private :: vec_minus_vec procedure , pass ( a ), private :: vec_minus_scal procedure , pass ( b ), private :: scal_minus_vec procedure , pass ( a ), private :: vec_equal_vec end type vector","tags":"","loc":"type/vector.html"},{"title":"settings_t – signedMCRT ","text":"type, public :: settings_t Contents Variables absorb experiment grid historyFilename iseed nphotons outfile outfile_absorb overwrite render_geom render_size renderfile source tev trackHistory Source Code settings_t Components Type Visibility Attributes Name Initial logical, public :: absorb Boolean to indicate whether to store absoption data. character(len=:), public, allocatable :: experiment Name of experiment/simulation type( cart_grid ), public :: grid Cart_grid type character(len=:), public, allocatable :: historyFilename Name of photon history file integer, public :: iseed initial seed for random number generator integer, public :: nphotons Number of photons to run character(len=:), public, allocatable :: outfile Name of fluence output file character(len=:), public, allocatable :: outfile_absorb Name of absoprtion output file logical, public :: overwrite Boolean to indicate whether to use overwrite datafiles if they have the same name. logical, public :: render_geom Boolean to indicate whether to render SDF to voxels or not. integer, public :: render_size (3) Size of the voxel grid to render SDFs to character(len=:), public, allocatable :: renderfile Name of voxel render file character(len=:), public, allocatable :: source Light source used logical, public :: tev Boolean to indicate whether to use TEV as debug viewer. logical, public :: trackHistory Boolean to indicate whether to store history of photons positions Source Code type :: settings_t !> Number of photons to run integer :: nphotons !> initial seed for random number generator integer :: iseed !> Size of the voxel grid to render SDFs to integer :: render_size ( 3 ) !> Name of experiment/simulation character ( len = :), allocatable :: experiment !> Name of fluence output file character ( len = :), allocatable :: outfile !> Name of voxel render file character ( len = :), allocatable :: renderfile !> Light source used character ( len = :), allocatable :: source !> Name of photon history file character ( len = :), allocatable :: historyFilename !> Name of absoprtion output file character ( len = :), allocatable :: outfile_absorb !> Cart_grid type type ( cart_grid ) :: grid !> Boolean to indicate whether to render SDF to voxels or not. logical :: render_geom !> Boolean to indicate whether to use TEV as debug viewer. logical :: tev !> Boolean to indicate whether to use overwrite datafiles if they have the same name. logical :: overwrite !> Boolean to indicate whether to store history of photons positions logical :: trackHistory !> Boolean to indicate whether to store absoption data. logical :: absorb end type settings_t","tags":"","loc":"type/settings_t.html"},{"title":"seq – signedMCRT ","text":"type, public :: seq Sequence type for quasi-monte carlo Contents Variables base index Type-Bound Procedures next Source Code seq Components Type Visibility Attributes Name Initial integer, public :: base Base from which to calculate radical inverse from. integer, public :: index Current index to get value for. Type-Bound Procedures procedure, public, :: next private function next (this) result(res) Arguments Type Intent Optional Attributes Name class( seq ) :: this Return Value real(kind=wp) Source Code type :: seq !> Current index to get value for. integer :: index !> Base from which to calculate radical inverse from. integer :: base contains procedure :: next end type seq","tags":"","loc":"type/seq.html"},{"title":"vec4 – signedMCRT ","text":"type, public :: vec4 not fully implmented vec4 class Contents Variables p x y z Constructor vec4 Type-Bound Procedures length magnitude operator(*) operator(+) operator(-) operator(.dot.) operator(/) scal_add_vec scal_minus_vec scal_mult_vec vec_add_scal vec_add_vec vec_div_scal_int vec_div_scal_r4 vec_div_scal_r8 vec_dot_vec vec_minus_scal vec_minus_vec vec_mult_scal vec_mult_vec Source Code vec4 Components Type Visibility Attributes Name Initial real(kind=wp), public :: p vec4 components real(kind=wp), public :: x vec4 components real(kind=wp), public :: y vec4 components real(kind=wp), public :: z vec4 components Constructor public interface vec4 Initalise a vec4 from a vec3 and a scalar private function init_vec4_vector_real (vec, val) result(out) Initalise vec4 from a vec3 and Scalar\ne.g vec4 = [vec3%x, vec3%y, vec3%z, scalar] Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: vec Input vec3 real(kind=wp), intent(in) :: val Input Scalar Return Value type( vec4 ) Type-Bound Procedures procedure, public, :: length private pure elemental function length (this) Returns the length of a vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: this Return Value real(kind=wp) procedure, public, :: magnitude => magnitude_fn private pure elemental function magnitude_fn (this) Returns the magnitude of a vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: this Return Value type( vec4 ) generic, public, :: operator(*) => vec_mult_vec , vec_mult_scal , scal_mult_vec Overloaded Mulitiplication operator private pure elemental function vec_mult_vec (a, b) Elementwise vec4 * vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to multiply by Return Value type( vec4 ) private pure elemental function vec_mult_scal (a, b) Elementwise vec4 * Scalar Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( vec4 ) private pure elemental function scal_mult_vec (a, b) Elementwise Scalar * vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) generic, public, :: operator(+) => vec_add_vec , vec_add_scal , scal_add_vec Overloaded Addition operator private pure elemental function vec_add_vec (a, b) Elementwise vec4 + vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to add Return Value type( vec4 ) private pure elemental function vec_add_scal (a, b) Elementwise vec4 + scalar Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to add Return Value type( vec4 ) private pure elemental function scal_add_vec (a, b) Elementwise scalar + vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to add class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) generic, public, :: operator(-) => vec_minus_vec , vec_minus_scal , scal_minus_vec Overloaded Subtraction operator private pure elemental function vec_minus_vec (a, b) Elementwise vec4 - vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to subtract Return Value type( vec4 ) private pure elemental function vec_minus_scal (a, b) Elementwise vec4 - scalar Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( vec4 ) private pure elemental function scal_minus_vec (a, b) Elementwise Scalar - vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to subtract class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) generic, public, :: operator(.dot.) => vec_dot_vec .dot. operator private pure elemental function vec_dot_vec (a, b) result(dot) dot product between two vec4s Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to dot with Return Value real(kind=wp) generic, public, :: operator(/) => vec_div_scal_r4 , vec_div_scal_r8 , vec_div_scal_int Overloaded Division operator private pure elemental function vec_div_scal_r4 (a, b) Elementwise vec4 / Scalar. Scalar is 32-bit float Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=sp), intent(in) :: b Scalar to divide by Return Value type( vec4 ) private pure elemental function vec_div_scal_r8 (a, b) Elementwise vec4 / Scalar. Scalar is 32-bit float Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=dp), intent(in) :: b Scalar to divide by Return Value type( vec4 ) private pure elemental function vec_div_scal_int (a, b) Elementwise vec4 / Scalar. Scalar is an integer Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 integer, intent(in) :: b Scalar to divide by Return Value type( vec4 ) procedure, private, pass(b) :: scal_add_vec private pure elemental function scal_add_vec (a, b) Elementwise scalar + vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to add class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) procedure, private, pass(b) :: scal_minus_vec private pure elemental function scal_minus_vec (a, b) Elementwise Scalar - vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to subtract class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) procedure, private, pass(b) :: scal_mult_vec private pure elemental function scal_mult_vec (a, b) Elementwise Scalar * vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) procedure, private, pass(a) :: vec_add_scal private pure elemental function vec_add_scal (a, b) Elementwise vec4 + scalar Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to add Return Value type( vec4 ) procedure, private, pass(a) :: vec_add_vec private pure elemental function vec_add_vec (a, b) Elementwise vec4 + vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to add Return Value type( vec4 ) procedure, private, pass(a) :: vec_div_scal_int private pure elemental function vec_div_scal_int (a, b) Elementwise vec4 / Scalar. Scalar is an integer Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 integer, intent(in) :: b Scalar to divide by Return Value type( vec4 ) procedure, private, pass(a) :: vec_div_scal_r4 private pure elemental function vec_div_scal_r4 (a, b) Elementwise vec4 / Scalar. Scalar is 32-bit float Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=sp), intent(in) :: b Scalar to divide by Return Value type( vec4 ) procedure, private, pass(a) :: vec_div_scal_r8 private pure elemental function vec_div_scal_r8 (a, b) Elementwise vec4 / Scalar. Scalar is 32-bit float Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=dp), intent(in) :: b Scalar to divide by Return Value type( vec4 ) procedure, private, pass(a) :: vec_dot_vec private pure elemental function vec_dot_vec (a, b) result(dot) dot product between two vec4s Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to dot with Return Value real(kind=wp) procedure, private, pass(a) :: vec_minus_scal private pure elemental function vec_minus_scal (a, b) Elementwise vec4 - scalar Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( vec4 ) procedure, private, pass(a) :: vec_minus_vec private pure elemental function vec_minus_vec (a, b) Elementwise vec4 - vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to subtract Return Value type( vec4 ) procedure, private, pass(a) :: vec_mult_scal private pure elemental function vec_mult_scal (a, b) Elementwise vec4 * Scalar Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( vec4 ) procedure, private, pass(a) :: vec_mult_vec private pure elemental function vec_mult_vec (a, b) Elementwise vec4 * vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to multiply by Return Value type( vec4 ) Source Code type :: vec4 !> vec4 components real ( kind = wp ) :: x , y , z , p contains procedure :: magnitude => magnitude_fn procedure :: length => length !> .dot. operator generic :: operator (. dot .) => vec_dot_vec !> Overloaded Division operator generic :: operator ( / ) => vec_div_scal_r4 , vec_div_scal_r8 , vec_div_scal_int !> Overloaded Mulitiplication operator generic :: operator ( * ) => vec_mult_vec , vec_mult_scal , scal_mult_vec !> Overloaded Addition operator generic :: operator ( + ) => vec_add_vec , vec_add_scal , scal_add_vec !> Overloaded Subtraction operator generic :: operator ( - ) => vec_minus_vec , vec_minus_scal , scal_minus_vec procedure , pass ( a ), private :: vec_dot_vec procedure , pass ( a ), private :: vec_div_scal_r4 procedure , pass ( a ), private :: vec_div_scal_r8 procedure , pass ( a ), private :: vec_div_scal_int procedure , pass ( a ), private :: vec_mult_vec procedure , pass ( a ), private :: vec_mult_scal procedure , pass ( b ), private :: scal_mult_vec procedure , pass ( a ), private :: vec_add_vec procedure , pass ( a ), private :: vec_add_scal procedure , pass ( b ), private :: scal_add_vec procedure , pass ( a ), private :: vec_minus_vec procedure , pass ( a ), private :: vec_minus_scal procedure , pass ( b ), private :: scal_minus_vec end type vec4","tags":"","loc":"type/vec4.html"},{"title":"cart_grid – signedMCRT ","text":"type, public :: cart_grid Contents Variables delta nxg nyg nzg xface xmax yface ymax zface zmax Constructor cart_grid Type-Bound Procedures get_voxel Source Code cart_grid Components Type Visibility Attributes Name Initial real(kind=wp), public :: delta Delta is the round off for near voxel cell walls integer, public :: nxg number of voxels in each cardinal direction for fluence grid integer, public :: nyg number of voxels in each cardinal direction for fluence grid integer, public :: nzg number of voxels in each cardinal direction for fluence grid real(kind=wp), public, allocatable :: xface (:) position of each cell wall in fluence grid real(kind=wp), public :: xmax half size of each dimension in fluence grid. real(kind=wp), public, allocatable :: yface (:) position of each cell wall in fluence grid real(kind=wp), public :: ymax half size of each dimension in fluence grid. real(kind=wp), public, allocatable :: zface (:) position of each cell wall in fluence grid real(kind=wp), public :: zmax half size of each dimension in fluence grid. Constructor public interface cart_grid public function init_grid (nxg, nyg, nzg, xmax, ymax, zmax) setup grid Arguments Type Intent Optional Attributes Name integer, intent(in) :: nxg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nyg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nzg number of voxels in each cardinal direction for fluence grid real(kind=wp), intent(in) :: xmax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: ymax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: zmax half size of each dimension in fluence grid. Return Value type( cart_grid ) Type-Bound Procedures procedure, public, :: get_voxel private function get_voxel (this, pos) result(res) get current voxel the photon packet is in Arguments Type Intent Optional Attributes Name class( cart_grid ) :: this grid class type( vector ), intent(in) :: pos current vector position of photon packet Return Value integer, (3) Source Code type :: cart_grid !> number of voxels in each cardinal direction for fluence grid integer :: nxg , nyg , nzg !> half size of each dimension in fluence grid. real ( kind = wp ) :: xmax , ymax , zmax !> Delta is the round off for near voxel cell walls real ( kind = wp ) :: delta !> position of each cell wall in fluence grid real ( kind = wp ), allocatable :: xface (:), yface (:), zface (:) contains procedure :: get_voxel end type cart_grid","tags":"","loc":"type/cart_grid.html"},{"title":"mono – signedMCRT ","text":"type, public, extends( opticalProp_base ) :: mono Contents Variables albedo g2 hgg kappa mua mus n Constructor mono Type-Bound Procedures update Source Code mono Components Type Visibility Attributes Name Initial real(kind=wp), public :: albedo real(kind=wp), public :: g2 g factor squared real(kind=wp), public :: hgg g factor real(kind=wp), public :: kappa real(kind=wp), public :: mua absoprtion coeff. real(kind=wp), public :: mus scattering coeff. real(kind=wp), public :: n refractive index Constructor public interface mono private function init_mono (mus, mua, hgg, n) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: mus real(kind=wp), intent(in) :: mua real(kind=wp), intent(in) :: hgg real(kind=wp), intent(in) :: n Return Value type( mono ) Type-Bound Procedures procedure, public, :: update => updateMono private subroutine updateMono (this, wavelength) Arguments Type Intent Optional Attributes Name class( mono ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength Source Code type , extends ( opticalProp_base ) :: mono contains procedure :: update => updateMono end type mono","tags":"","loc":"type/mono.html"},{"title":"opticalProp_base – signedMCRT ","text":"type, public, abstract :: opticalProp_base Contents Variables albedo g2 hgg kappa mua mus n Type-Bound Procedures update Source Code opticalProp_base Components Type Visibility Attributes Name Initial real(kind=wp), public :: albedo real(kind=wp), public :: g2 g factor squared real(kind=wp), public :: hgg g factor real(kind=wp), public :: kappa real(kind=wp), public :: mua absoprtion coeff. real(kind=wp), public :: mus scattering coeff. real(kind=wp), public :: n refractive index Type-Bound Procedures procedure( updateInterface ), public, deferred :: update subroutine updateInterface(this, wavelength) Prototype Arguments Type Intent Optional Attributes Name class( opticalProp_base ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength Source Code type , abstract :: opticalProp_base !> scattering coeff. cm^{-1} real ( kind = wp ) :: mus !> absoprtion coeff. cm^{-1} real ( kind = wp ) :: mua !> g factor real ( kind = wp ) :: hgg !> g factor squared real ( kind = wp ) :: g2 !> refractive index real ( kind = wp ) :: n !> \\kappa = \\mu_s + \\mu_a real ( kind = wp ) :: kappa !> a = \\frac{\\mu_s}{\\mu_s + \\mu_a} real ( kind = wp ) :: albedo contains procedure ( updateInterface ), deferred :: update end type opticalProp_base","tags":"","loc":"type/opticalprop_base.html"},{"title":"opticalProp_t – signedMCRT ","text":"type, public, extends( opticalProp_base ) :: opticalProp_t Contents Variables albedo g2 hgg kappa mua mus n value Constructor opticalProp_t Type-Bound Procedures assignment(=) opticalProp_t_assign update Source Code opticalProp_t Components Type Visibility Attributes Name Initial real(kind=wp), public :: albedo real(kind=wp), public :: g2 g factor squared real(kind=wp), public :: hgg g factor real(kind=wp), public :: kappa real(kind=wp), public :: mua absoprtion coeff. real(kind=wp), public :: mus scattering coeff. real(kind=wp), public :: n refractive index class( opticalProp_base ), public, allocatable :: value Constructor public interface opticalProp_t private function opticaProp_new (rhs) result(lhs) Arguments Type Intent Optional Attributes Name class( opticalProp_base ), intent(in) :: rhs Return Value type( opticalProp_t ) Type-Bound Procedures generic, public, :: assignment(=) => opticalProp_t_assign private subroutine opticalProp_t_assign (lhs, rhs) Arguments Type Intent Optional Attributes Name class( opticalProp_t ), intent(inout) :: lhs class( opticalProp_base ), intent(in) :: rhs procedure, private :: opticalProp_t_assign private subroutine opticalProp_t_assign (lhs, rhs) Arguments Type Intent Optional Attributes Name class( opticalProp_t ), intent(inout) :: lhs class( opticalProp_base ), intent(in) :: rhs procedure, public, :: update => update_opticalProp_t private subroutine update_opticalProp_t (this, wavelength) Arguments Type Intent Optional Attributes Name class( opticalProp_t ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength Source Code type , extends ( opticalProp_base ) :: opticalProp_t class ( opticalProp_base ), allocatable :: value contains procedure :: update => update_opticalProp_t procedure , private :: opticalProp_t_assign generic :: assignment ( = ) => opticalProp_t_assign end type opticalProp_t","tags":"","loc":"type/opticalprop_t.html"},{"title":"spectral – signedMCRT ","text":"type, public, extends( opticalProp_base ) :: spectral Contents Variables albedo flux g2 hgg hgg_a kappa mua mua_a mus mus_a n n_a Constructor spectral Type-Bound Procedures update Source Code spectral Components Type Visibility Attributes Name Initial real(kind=wp), public :: albedo type( piecewise1D ), private :: flux real(kind=wp), public :: g2 g factor squared real(kind=wp), public :: hgg g factor type( piecewise1D ), private :: hgg_a real(kind=wp), public :: kappa real(kind=wp), public :: mua absoprtion coeff. type( piecewise1D ), private :: mua_a real(kind=wp), public :: mus scattering coeff. type( piecewise1D ), private :: mus_a real(kind=wp), public :: n refractive index type( piecewise1D ), private :: n_a Constructor public interface spectral private function init_spectral (mus, mua, hgg, n, flux) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), allocatable :: mus (:,:) real(kind=wp), intent(in), allocatable :: mua (:,:) real(kind=wp), intent(in), allocatable :: hgg (:,:) real(kind=wp), intent(in), allocatable :: n (:,:) real(kind=wp), intent(in), allocatable :: flux (:,:) Return Value type( spectral ) Type-Bound Procedures procedure, public, :: update => updateSpectral private subroutine updateSpectral (this, wavelength) Arguments Type Intent Optional Attributes Name class( spectral ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength Source Code type , extends ( opticalProp_base ) :: spectral type ( piecewise1D ), private :: mus_a , mua_a , hgg_a , n_a , flux contains procedure :: update => updateSpectral end type spectral","tags":"","loc":"type/spectral.html"},{"title":"constant – signedMCRT ","text":"type, public, extends( piecewise ) :: constant Constant piecewise type. i.e a piecewise function that does not change value Contents Variables value Type-Bound Procedures sample Source Code constant Components Type Visibility Attributes Name Initial real(kind=wp), public :: value The constant value Type-Bound Procedures procedure, public, :: sample => getValue Sampling routine public subroutine getValue (this, x, y, value) The constant version of sample Arguments Type Intent Optional Attributes Name class( constant ), intent(in) :: this real(kind=wp), intent(out) :: x Output value real(kind=wp), intent(out) :: y Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D real(kind=wp), intent(in), optional :: value Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D Source Code type , extends ( piecewise ) :: constant !> The constant value real ( kind = wp ) :: value contains !> Sampling routine procedure :: sample => getValue end type constant","tags":"","loc":"type/constant.html"},{"title":"piecewise – signedMCRT ","text":"type, public, abstract :: piecewise Abstract spectrum base type. Contents Type-Bound Procedures sample Source Code piecewise Type-Bound Procedures procedure( sampleInterface ), public, deferred :: sample Deferred procdure. Used to generate a sample from spectrum or get constant value etc. subroutine sampleInterface(this, x, y, value) Prototype Arguments Type Intent Optional Attributes Name class( piecewise ), intent(in) :: this real(kind=wp), intent(out) :: x real(kind=wp), intent(out) :: y real(kind=wp), intent(in), optional :: value Source Code type , abstract :: piecewise contains !> Deferred procdure. Used to generate a sample from spectrum or get constant value etc. procedure ( sampleInterface ), deferred :: sample end type piecewise","tags":"","loc":"type/piecewise.html"},{"title":"piecewise1D – signedMCRT ","text":"type, public, extends( piecewise ) :: piecewise1D 1D piecewise type. Used for the spectral type Contents Variables array cdf Constructor piecewise1D Type-Bound Procedures sample Source Code piecewise1D Components Type Visibility Attributes Name Initial real(kind=wp), public, allocatable :: array (:,:) Input array to sample from. Should be size(n, 2). 1st column is x-axis, 2nd column is y-axis real(kind=wp), public, allocatable :: cdf (:) cumulative distribution function (CDF) of array. Constructor public interface piecewise1D public function init_piecewise1D (array) result(res) initalise the piecewise1D type with an array size (n, 2). Calculates the CDF of this array.\nInput array Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:) Return Value type( piecewise1D ) Type-Bound Procedures procedure, public, :: sample => sample1D Overloaded sampling function public subroutine sample1D (this, x, y, value) Randomly sample from 1D array Arguments Type Intent Optional Attributes Name class( piecewise1D ), intent(in) :: this real(kind=wp), intent(out) :: x Return value real(kind=wp), intent(out) :: y Not used, but here so we can have same interface as 2D sample routine. real(kind=wp), intent(in), optional :: value Optional x value. If not present we generate a random one in the range [0., 1.] Source Code type , extends ( piecewise ) :: piecewise1D !> Input array to sample from. Should be size(n, 2). 1st column is x-axis, 2nd column is y-axis real ( kind = wp ), allocatable :: array (:, :) !> cumulative distribution function (CDF) of array. real ( kind = wp ), allocatable :: cdf (:) contains !> Overloaded sampling function procedure :: sample => sample1D end type piecewise1D","tags":"","loc":"type/piecewise1d.html"},{"title":"piecewise2D – signedMCRT ","text":"type, public, extends( piecewise ) :: piecewise2D 2D piecewise type. Used for images Contents Variables cdf cell_height cell_width xoffset yoffset Constructor piecewise2D Type-Bound Procedures sample Source Code piecewise2D Components Type Visibility Attributes Name Initial real(kind=wp), public, allocatable :: cdf (:) cumulative distribution function (CDF) of array. real(kind=wp), public :: cell_height Height of each cell real(kind=wp), public :: cell_width Width of each cell integer, private :: xoffset Offsets integer, private :: yoffset Offsets Constructor public interface piecewise2D public function init_piecewise2D (cell_width, cell_height, image) Initalise the piecewise2D type with a given cell_width, cell_height and input image Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: cell_width Input cell width real(kind=wp), intent(in) :: cell_height Input cell height real(kind=wp), intent(in) :: image (:,:) Input image Return Value type( piecewise2D ) Type-Bound Procedures procedure, public, :: sample => sample2D Overloaded sampling function public subroutine sample2D (this, x, y, value) Arguments Type Intent Optional Attributes Name class( piecewise2D ), intent(in) :: this real(kind=wp), intent(out) :: x real(kind=wp), intent(out) :: y real(kind=wp), intent(in), optional :: value Source Code type , extends ( piecewise ) :: piecewise2D !> Height of each cell real ( kind = wp ) :: cell_height !> Width of each cell real ( kind = wp ) :: cell_width !>cumulative distribution function (CDF) of array. real ( kind = wp ), allocatable :: cdf (:) !> Offsets integer , private :: xoffset , yoffset contains !> Overloaded sampling function procedure :: sample => sample2D end type piecewise2D","tags":"","loc":"type/piecewise2d.html"},{"title":"spectrum_t – signedMCRT ","text":"type, public :: spectrum_t Spectrum_t type. Used as a container type Contents Variables p Source Code spectrum_t Components Type Visibility Attributes Name Initial class( piecewise ), public, pointer :: p => null() Source Code type :: spectrum_t class ( piecewise ), pointer :: p => null () end type spectrum_t","tags":"","loc":"type/spectrum_t.html"},{"title":"annulus_dect – signedMCRT ","text":"type, public, extends( detector1D ) :: annulus_dect Annuluar detector Contents Variables bin_wid data dir layer nbins pos r1 r2 trackHistory Constructor annulus_dect Type-Bound Procedures check_hit record_hit Source Code annulus_dect Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid Bin width real(kind=wp), public, allocatable :: data (:) Bins type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector integer, public :: nbins Number of bins type( vector ), public :: pos position of the detector real(kind=wp), public :: r1 Inner radius real(kind=wp), public :: r2 Outer radius logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Constructor public interface annulus_dect private function init_annulus_dect (pos, dir, layer, r1, r2, nbins, maxval, trackHistory) result(out) Initalise Annular detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: r1 Inner radius real(kind=wp), intent(in) :: r2 Outer radius integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( annulus_dect ) Type-Bound Procedures procedure, public, :: check_hit => check_hit_annulus private function check_hit_annulus (this, hitpoint) Check if a hitpoint is in the annulus Arguments Type Intent Optional Attributes Name class( annulus_dect ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Hitpoint to check Return Value logical procedure, public, :: record_hit => record_hit_1D_sub private subroutine record_hit_1D_sub (this, hitpoint, history) check if a hit is on the detector and record it if so Arguments Type Intent Optional Attributes Name class( detector1D ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Interaction information type( history_stack_t ), intent(inout) :: history Photon packet history Source Code type , extends ( detector1D ) :: annulus_dect !> Inner radius real ( kind = wp ) :: r1 !> Outer radius real ( kind = wp ) :: r2 contains procedure :: check_hit => check_hit_annulus end type annulus_dect","tags":"","loc":"type/annulus_dect.html"},{"title":"camera – signedMCRT ","text":"type, public, extends( detector2D ) :: camera Rectangular or \"camera\" detector Contents Variables bin_wid_x bin_wid_y data dir e1 e2 height layer n nbinsX nbinsY p2 p3 pos trackHistory width Constructor camera Type-Bound Procedures check_hit record_hit Source Code camera Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid_x Bin width in the x dimension real(kind=wp), public :: bin_wid_y Bin width in the y dimension real(kind=wp), public, allocatable :: data (:,:) Bins type( vector ), public :: dir Surface normal of the detector type( vector ), public :: e1 Edge vector of detector type( vector ), public :: e2 Edge vector of detector real(kind=wp), public :: height Height of the detector integer, public :: layer Layer ID of the detector type( vector ), public :: n Normal of the detector integer, public :: nbinsX Number of bins in x dimension (detector space) integer, public :: nbinsY Number of bins in y dimension (detector space) type( vector ), public :: p2 Vector from pos (1st corner) to the 2nd corner of the detector type( vector ), public :: p3 Vector from pos (1st corner) to the 3rd corner of the detector type( vector ), public :: pos position of the detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. real(kind=wp), public :: width Width of the detector Constructor public interface camera private function init_camera (p1, p2, p3, layer, nbins, maxval, trackHistory) result(out) Initalise Camera detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: p1 Position of the 1st corner of the detector type( vector ), intent(in) :: p2 Distance from p1 to the 2nd corner type( vector ), intent(in) :: p3 Distance from p1 to the 3rd corner integer, intent(in) :: layer Layer ID integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( camera ) Type-Bound Procedures procedure, public, :: check_hit => check_hit_camera private function check_hit_camera (this, hitpoint) Check if a hitpoint is in the camera detector ref Arguments Type Intent Optional Attributes Name class( camera ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Hitpoint to check Return Value logical procedure, public, :: record_hit => record_hit_2D_sub private subroutine record_hit_2D_sub (this, hitpoint, history) check if a hit is on the detector and record it if so Arguments Type Intent Optional Attributes Name class( detector2D ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Interaction information type( history_stack_t ), intent(inout) :: history Photon packet history Source Code type , extends ( detector2D ) :: camera !> Normal of the detector type ( vector ) :: n !> Vector from pos (1st corner) to the 2nd corner of the detector type ( vector ) :: p2 !> Vector from pos (1st corner) to the 3rd corner of the detector type ( vector ) :: p3 !> Edge vector of detector type ( vector ) :: e1 !> Edge vector of detector type ( vector ) :: e2 !> Width of the detector real ( kind = wp ) :: width !> Height of the detector real ( kind = wp ) :: height contains procedure :: check_hit => check_hit_camera end type camera","tags":"","loc":"type/camera.html"},{"title":"circle_dect – signedMCRT ","text":"type, public, extends( detector1D ) :: circle_dect Circle detector Contents Variables bin_wid data dir layer nbins pos radius trackHistory Constructor circle_dect Type-Bound Procedures check_hit record_hit Source Code circle_dect Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid Bin width real(kind=wp), public, allocatable :: data (:) Bins type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector integer, public :: nbins Number of bins type( vector ), public :: pos position of the detector real(kind=wp), public :: radius Radius of detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Constructor public interface circle_dect private function init_circle_dect (pos, dir, layer, radius, nbins, maxval, trackHistory) result(out) Initalise Circle detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: radius Radius of the detector integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( circle_dect ) Type-Bound Procedures procedure, public, :: check_hit => check_hit_circle private function check_hit_circle (this, hitpoint) Check if a hitpoint is in the circle Arguments Type Intent Optional Attributes Name class( circle_dect ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Hitpoint to check Return Value logical procedure, public, :: record_hit => record_hit_1D_sub private subroutine record_hit_1D_sub (this, hitpoint, history) check if a hit is on the detector and record it if so Arguments Type Intent Optional Attributes Name class( detector1D ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Interaction information type( history_stack_t ), intent(inout) :: history Photon packet history Source Code type , extends ( detector1D ) :: circle_dect !> Radius of detector real ( kind = wp ) :: radius contains procedure :: check_hit => check_hit_circle end type circle_dect","tags":"","loc":"type/circle_dect.html"},{"title":"dect_array – signedMCRT ","text":"type, public :: dect_array Detector array Contents Variables p Source Code dect_array Components Type Visibility Attributes Name Initial class( detector ), public, pointer :: p => null() Source Code type :: dect_array class ( detector ), pointer :: p => null () end type dect_array","tags":"","loc":"type/dect_array.html"},{"title":"detector – signedMCRT ","text":"type, public, abstract :: detector abstract detector Contents Variables dir layer pos trackHistory Type-Bound Procedures check_hit record_hit Source Code detector Components Type Visibility Attributes Name Initial type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector type( vector ), public :: pos position of the detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Type-Bound Procedures procedure( checkHitInterface ), public, deferred :: check_hit function checkHitInterface(this, hitpoint) Prototype Arguments Type Intent Optional Attributes Name class( detector ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Return Value logical procedure( recordHitInterface ), public, deferred :: record_hit subroutine recordHitInterface(this, hitpoint, history) Prototype Arguments Type Intent Optional Attributes Name class( detector ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint type( history_stack_t ), intent(inout) :: history Source Code type , abstract :: detector !> position of the detector type ( vector ) :: pos !> Surface normal of the detector type ( vector ) :: dir !> Layer ID of the detector integer :: layer !> Boolean, if true store the history of the photon prior to detection. logical :: trackHistory contains procedure ( recordHitInterface ), deferred , public :: record_hit procedure ( checkHitInterface ), deferred , public :: check_hit end type detector","tags":"","loc":"type/detector.html"},{"title":"detector1D – signedMCRT ","text":"type, public, abstract, extends( detector ) :: detector1D 1D detector type. Records linear information Contents Variables bin_wid data dir layer nbins pos trackHistory Type-Bound Procedures check_hit record_hit Source Code detector1D Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid Bin width real(kind=wp), public, allocatable :: data (:) Bins type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector integer, public :: nbins Number of bins type( vector ), public :: pos position of the detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Type-Bound Procedures procedure( checkHitInterface ), public, deferred :: check_hit function checkHitInterface(this, hitpoint) Prototype Arguments Type Intent Optional Attributes Name class( detector ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Return Value logical procedure, public, :: record_hit => record_hit_1D_sub private subroutine record_hit_1D_sub (this, hitpoint, history) check if a hit is on the detector and record it if so Arguments Type Intent Optional Attributes Name class( detector1D ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Interaction information type( history_stack_t ), intent(inout) :: history Photon packet history Source Code type , abstract , extends ( detector ) :: detector1D !> Number of bins integer :: nbins !> Bin width real ( kind = wp ) :: bin_wid !> Bins real ( kind = wp ), allocatable :: data (:) contains procedure :: record_hit => record_hit_1D_sub end type detector1D","tags":"","loc":"type/detector1d.html"},{"title":"detector2D – signedMCRT ","text":"type, public, abstract, extends( detector ) :: detector2D 2D detecctor type. Records spatial information Contents Variables bin_wid_x bin_wid_y data dir layer nbinsX nbinsY pos trackHistory Type-Bound Procedures check_hit record_hit Source Code detector2D Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid_x Bin width in the x dimension real(kind=wp), public :: bin_wid_y Bin width in the y dimension real(kind=wp), public, allocatable :: data (:,:) Bins type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector integer, public :: nbinsX Number of bins in x dimension (detector space) integer, public :: nbinsY Number of bins in y dimension (detector space) type( vector ), public :: pos position of the detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Type-Bound Procedures procedure( checkHitInterface ), public, deferred :: check_hit function checkHitInterface(this, hitpoint) Prototype Arguments Type Intent Optional Attributes Name class( detector ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Return Value logical procedure, public, :: record_hit => record_hit_2D_sub private subroutine record_hit_2D_sub (this, hitpoint, history) check if a hit is on the detector and record it if so Arguments Type Intent Optional Attributes Name class( detector2D ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Interaction information type( history_stack_t ), intent(inout) :: history Photon packet history Source Code type , abstract , extends ( detector ) :: detector2D !> Number of bins in x dimension (detector space) integer :: nbinsX !> Number of bins in y dimension (detector space) integer :: nbinsY !> Bin width in the x dimension real ( kind = wp ) :: bin_wid_x !> Bin width in the y dimension real ( kind = wp ) :: bin_wid_y !> Bins real ( kind = wp ), allocatable :: data (:,:) contains procedure :: record_hit => record_hit_2D_sub end type detector2D","tags":"","loc":"type/detector2d.html"},{"title":"hit_t – signedMCRT ","text":"type, public :: hit_t Hit type, which records possible interaction information Contents Variables dir layer pos value Constructor hit_t Source Code hit_t Components Type Visibility Attributes Name Initial type( vector ), public :: dir Direction the photon came from integer, public :: layer Layer ID of interaction type( vector ), public :: pos Poition of the interaction real(kind=wp), public :: value Value to deposit Constructor public interface hit_t private function hit_init (val) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val Return Value type( hit_t ) Source Code type :: hit_t !> Poition of the interaction type ( vector ) :: pos !> Direction the photon came from type ( vector ) :: dir !> Value to deposit real ( kind = wp ) :: value !> Layer ID of interaction integer :: layer end type hit_t","tags":"","loc":"type/hit_t.html"},{"title":"box – signedMCRT ","text":"type, public, extends( sdf_base ) :: box Box SDF Contents Variables layer lengths optProps transform Constructor box Type-Bound Procedures evaluate Source Code box Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( vector ), public :: lengths Length of each dimension of the box type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface box Interface to box SDF initialising function private function box_init (lengths, optProp, layer, transform) result(out) Initalising function for Box SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: lengths Lengths of each dimension of the box type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( box ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_box private pure elemental function evaluate_box (this, pos) result(res) Evaluation function for Box SDF. Arguments Type Intent Optional Attributes Name class( box ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: box !> Length of each dimension of the box type ( vector ) :: lengths contains procedure :: evaluate => evaluate_box end type box","tags":"","loc":"type/box.html"},{"title":"capsule – signedMCRT ","text":"type, public, extends( sdf_base ) :: capsule Capsule SDF Contents Variables a b layer optProps r transform Constructor capsule Type-Bound Procedures evaluate Source Code capsule Components Type Visibility Attributes Name Initial type( vector ), public :: a type( vector ), public :: b integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: r real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface capsule Interface to capsule SDF initialising function private function capsule_init (a, b, r, optProp, layer, transform) result(out) Initalising function for capsule SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Capsule startpoint type( vector ), intent(in) :: b Capsule endpoint real(kind=wp), intent(in) :: r Capsule radius type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( capsule ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_capsule private pure elemental function evaluate_capsule (this, pos) result(res) Evaluation function for Capsule SDF. Arguments Type Intent Optional Attributes Name class( capsule ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: capsule type ( vector ) :: a , b real ( kind = wp ) :: r contains procedure :: evaluate => evaluate_capsule end type capsule","tags":"","loc":"type/capsule.html"},{"title":"cone – signedMCRT ","text":"type, public, extends( sdf_base ) :: cone Cone SDF Contents Variables a b layer optProps ra rb transform Constructor cone Type-Bound Procedures evaluate Source Code cone Components Type Visibility Attributes Name Initial type( vector ), public :: a type( vector ), public :: b integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: ra real(kind=wp), public :: rb real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface cone Interface to cone SDF initialising function private function cone_init (a, b, ra, rb, optProp, layer, transform) result(out) Initalising function for Capped Cone SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Centre of base of Cone type( vector ), intent(in) :: b Tip of cone real(kind=wp), intent(in) :: ra Radius of Cones base real(kind=wp), intent(in) :: rb Radius of Cones tip. For rb = 0.0 get normal uncapped cone. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cone ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_cone private pure elemental function evaluate_cone (this, pos) result(res) Evaluation function for Cone SDF. Arguments Type Intent Optional Attributes Name class( cone ), intent(in) :: this type( vector ), intent(in) :: pos Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: cone type ( vector ) :: a , b real ( kind = wp ) :: ra , rb contains procedure :: evaluate => evaluate_cone end type cone","tags":"","loc":"type/cone.html"},{"title":"cylinder – signedMCRT ","text":"type, public, extends( sdf_base ) :: cylinder Cylinder SDF Contents Variables a b layer optProps radius transform Constructor cylinder Type-Bound Procedures evaluate Source Code cylinder Components Type Visibility Attributes Name Initial type( vector ), public :: a type( vector ), public :: b integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: radius real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface cylinder Interface to cylinder SDF initialising function private function cylinder_init (a, b, radius, optProp, layer, transform) result(out) Initalising function for Cylinder SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Vector position at centre of the bottom circle type( vector ), intent(in) :: b Vector position at centre of the top circle real(kind=wp), intent(in) :: radius Radius of cylinder type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cylinder ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_cylinder private pure elemental function evaluate_cylinder (this, pos) result(res) Evaluation function for Cylinder SDF. Arguments Type Intent Optional Attributes Name class( cylinder ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: cylinder real ( kind = wp ) :: radius type ( vector ) :: a , b contains procedure :: evaluate => evaluate_cylinder end type cylinder","tags":"","loc":"type/cylinder.html"},{"title":"egg – signedMCRT ","text":"type, public, extends( sdf_base ) :: egg Egg SDF Contents Variables h layer optProps r1 r2 transform Constructor egg Type-Bound Procedures evaluate Source Code egg Components Type Visibility Attributes Name Initial real(kind=wp), public :: h integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: r1 real(kind=wp), public :: r2 real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface egg Interface to egg SDF initialising function private function egg_init (r1, r2, h, optProp, layer, transform) result(out) Initalising function for egg SDF.\nmakes a Moss egg. ref . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: r1 R1 controls \"fatness\" of the egg. Actually controls the base circle radius. real(kind=wp), intent(in) :: r2 R2 contorls the pointiness of the egg. Actually controls radius of top circle. real(kind=wp), intent(in) :: h h controls the height of the egg. Actually controls y position of top circle. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( egg ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_egg private pure elemental function evaluate_egg (this, pos) result(res) Evaluation function for Egg SDF. ref Arguments Type Intent Optional Attributes Name class( egg ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: egg real ( kind = wp ) :: r1 , r2 , h contains procedure :: evaluate => evaluate_egg end type egg","tags":"","loc":"type/egg.html"},{"title":"plane – signedMCRT ","text":"type, public, extends( sdf_base ) :: plane Plane SDF Contents Variables a layer optProps transform Constructor plane Type-Bound Procedures evaluate Source Code plane Components Type Visibility Attributes Name Initial type( vector ), public :: a integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface plane Interface to plane SDF initialising function private function plane_init (a, optProp, layer, transform) result(out) Initalising function for plane SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Plane normal. must be normalised type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( plane ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_plane private pure elemental function evaluate_plane (this, pos) result(res) Evaluation function for Plane SDF. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: plane type ( vector ) :: a contains procedure :: evaluate => evaluate_plane end type plane","tags":"","loc":"type/plane.html"},{"title":"segment – signedMCRT ","text":"type, public, extends( sdf_base ) :: segment Segment SDF (2D) Contents Variables a b layer optProps transform Constructor segment Type-Bound Procedures evaluate Source Code segment Components Type Visibility Attributes Name Initial type( vector ), public :: a type( vector ), public :: b integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface segment Interface to segment SDF initialising function private function segment_init (a, b, optProp, layer, transform) result(out) Initalising function for segment SDF.\nNote this is a 2D function Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a segment start point type( vector ), intent(in) :: b segment end point type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( segment ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_segment private pure elemental function evaluate_segment (this, pos) result(res) Evaluation function for Segment SDF. Arguments Type Intent Optional Attributes Name class( segment ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: segment type ( vector ) :: a , b contains procedure :: evaluate => evaluate_segment end type segment","tags":"","loc":"type/segment.html"},{"title":"sphere – signedMCRT ","text":"type, public, extends( sdf_base ) :: sphere Sphere SDF Contents Variables layer optProps radius transform Constructor sphere Type-Bound Procedures evaluate Source Code sphere Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: radius real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface sphere private function sphere_init (radius, optProp, layer, transform) result(out) Initalising function for Sphere SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: radius radius of the Sphere type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( sphere ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_sphere private pure elemental function evaluate_sphere (this, pos) result(res) Evaluation function for Sphere SDF. Arguments Type Intent Optional Attributes Name class( sphere ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: sphere real ( kind = wp ) :: radius contains procedure :: evaluate => evaluate_sphere end type sphere","tags":"","loc":"type/sphere.html"},{"title":"torus – signedMCRT ","text":"type, public, extends( sdf_base ) :: torus Torus SDF Contents Variables iradius layer optProps oradius transform Constructor torus Type-Bound Procedures evaluate Source Code torus Components Type Visibility Attributes Name Initial real(kind=wp), public :: iradius integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: oradius real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface torus Interface to torus SDF initialising function private function torus_init (oradius, iradius, optProp, layer, transform) result(out) Initalising function for Torus SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: oradius Outer radius of Torus real(kind=wp), intent(in) :: iradius Inner radius of Torus type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( torus ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_torus private pure elemental function evaluate_torus (this, pos) result(res) Evaluation function for Torus SDF. Arguments Type Intent Optional Attributes Name class( torus ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: torus real ( kind = wp ) :: oradius , iradius contains procedure :: evaluate => evaluate_torus end type torus","tags":"","loc":"type/torus.html"},{"title":"triprism – signedMCRT ","text":"type, public, extends( sdf_base ) :: triprism Triprisim SDF Contents Variables h1 h2 layer optProps transform Constructor triprism Type-Bound Procedures evaluate Source Code triprism Components Type Visibility Attributes Name Initial real(kind=wp), public :: h1 real(kind=wp), public :: h2 integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface triprism Interface to triprisim SDF initialising function private function triprism_init (h1, h2, optProp, layer, transform) result(out) Initalising function for triprisim SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: h1 Height of triprisim real(kind=wp), intent(in) :: h2 length of triprisim type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( triprism ) Type-Bound Procedures procedure, public, :: evaluate => evaluate_triprism private pure elemental function evaluate_triprism (this, pos) result(res) Evaluation function for Triprisim SDF. Arguments Type Intent Optional Attributes Name class( triprism ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: triprism real ( kind = wp ) :: h1 , h2 contains procedure :: evaluate => evaluate_triprism end type triprism","tags":"","loc":"type/triprism.html"},{"title":"bend – signedMCRT ","text":"type, public, extends( sdf_base ) :: bend Bend a SDF. Contents Variables k layer optProps prim transform Constructor bend Type-Bound Procedures evaluate Source Code bend Components Type Visibility Attributes Name Initial real(kind=wp), public :: k integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface bend private function bend_init (prim, k) result(out) Initialise the Bend modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: k Amoun to bend by. Return Value type( bend ) Type-Bound Procedures procedure, public, :: evaluate => eval_bend private pure elemental function eval_bend (this, pos) result(res) Evaluation function for Bend modifier. Arguments Type Intent Optional Attributes Name class( bend ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: bend real ( kind = wp ) :: k class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_bend end type bend","tags":"","loc":"type/bend.html"},{"title":"displacement – signedMCRT ","text":"type, public, extends( sdf_base ) :: displacement Displace the surface of a SDF by a function. Contents Variables func layer optProps prim transform Constructor displacement Type-Bound Procedures evaluate Source Code displacement Components Type Visibility Attributes Name Initial procedure( primitive ), public, nopass, pointer :: func integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface displacement private function displacement_init (prim, func) result(out) Initialise the displacement modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify procedure( primitive ) :: func Function to displace the SDF with. Return Value type( displacement ) Type-Bound Procedures procedure, public, :: evaluate => eval_disp private pure elemental function eval_disp (this, pos) result(res) Evaluation function for displacement modifier. Arguments Type Intent Optional Attributes Name class( displacement ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: displacement procedure ( primitive ), nopass , pointer :: func class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_disp end type displacement","tags":"","loc":"type/displacement.html"},{"title":"elongate – signedMCRT ","text":"type, public, extends( sdf_base ) :: elongate Elongate a SDF Contents Variables layer optProps prim size transform Constructor elongate Type-Bound Procedures evaluate Source Code elongate Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim type( vector ), public :: size real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface elongate private function elongate_init (prim, size) result(out) Initialise the elongate modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify type( vector ), intent(in) :: size Distance to elongate by Return Value type( elongate ) Type-Bound Procedures procedure, public, :: evaluate => eval_elongate private pure elemental function eval_elongate (this, pos) result(res) Evaluation function for Elongate modifier. Arguments Type Intent Optional Attributes Name class( elongate ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: elongate type ( vector ) :: size class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_elongate end type elongate","tags":"","loc":"type/elongate.html"},{"title":"extrude – signedMCRT ","text":"type, public, extends( sdf_base ) :: extrude Extrude a 2D SDF into 3D Contents Variables h layer optProps prim transform Constructor extrude Type-Bound Procedures evaluate Source Code extrude Components Type Visibility Attributes Name Initial real(kind=wp), public :: h integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface extrude private function extrude_init (prim, h) result(out) Initialise the extrude modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: h Distance to extrude by. Return Value type( extrude ) Type-Bound Procedures procedure, public, :: evaluate => eval_extrude private pure elemental function eval_extrude (this, pos) result(res) Evaluation function for Extrude modifier. Arguments Type Intent Optional Attributes Name class( extrude ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: extrude real ( kind = wp ) :: h class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_extrude end type extrude","tags":"","loc":"type/extrude.html"},{"title":"onion – signedMCRT ","text":"type, public, extends( sdf_base ) :: onion Carves or gives thickness to SDFs Contents Variables layer optProps prim thickness transform Constructor onion Type-Bound Procedures evaluate Source Code onion Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: thickness real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface onion private function onion_init (prim, thickness) result(out) Initialise the Onion modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: thickness Thickned to onion by. Return Value type( onion ) Type-Bound Procedures procedure, public, :: evaluate => eval_onion private pure elemental function eval_onion (this, pos) result(res) Evaluation function for Onion modifier. Arguments Type Intent Optional Attributes Name class( onion ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: onion real ( kind = wp ) :: thickness class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_onion end type onion","tags":"","loc":"type/onion.html"},{"title":"repeat – signedMCRT ","text":"type, public, extends( sdf_base ) :: repeat Repeat a SDF Contents Variables c la layer lb optProps prim transform Constructor repeat Type-Bound Procedures evaluate Source Code repeat Components Type Visibility Attributes Name Initial real(kind=wp), public :: c type( vector ), public :: la integer, public :: layer Layer ID of SDF type( vector ), public :: lb type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface repeat private function repeat_init (prim, c, la, lb) result(out) Initialise the Repeat modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: c type( vector ), intent(in) :: la type( vector ), intent(in) :: lb Return Value type( repeat ) Type-Bound Procedures procedure, public, :: evaluate => eval_repeat private pure elemental function eval_repeat (this, pos) result(res) Evaluation function for Repeat modifier. Arguments Type Intent Optional Attributes Name class( repeat ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: repeat real ( kind = wp ) :: c type ( vector ) :: la , lb class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_repeat end type repeat","tags":"","loc":"type/repeat.html"},{"title":"revolution – signedMCRT ","text":"type, public, extends( sdf_base ) :: revolution Revoloution modifier. Revolves an SDF around the z axis (need to check this!!) Contents Variables layer o optProps prim transform Constructor revolution Type-Bound Procedures evaluate Source Code revolution Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF real(kind=wp), public :: o type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface revolution private function revolution_init (prim, o) result(out) Initialise the Revolution modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: o Amount to revolve by. Return Value type( revolution ) Type-Bound Procedures procedure, public, :: evaluate => eval_revolution private pure elemental function eval_revolution (this, pos) result(res) Evaluation function for Revolution modifier. Arguments Type Intent Optional Attributes Name class( revolution ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: revolution real ( kind = wp ) :: o class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_revolution end type revolution","tags":"","loc":"type/revolution.html"},{"title":"twist – signedMCRT ","text":"type, public, extends( sdf_base ) :: twist Twist a SDF Contents Variables k layer optProps prim transform Constructor twist Type-Bound Procedures evaluate Source Code twist Components Type Visibility Attributes Name Initial real(kind=wp), public :: k integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface twist private function twist_init (prim, k) result(out) Initialise the twist modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real, intent(in) :: k Twist parameter. Return Value type( twist ) Type-Bound Procedures procedure, public, :: evaluate => eval_twist private pure elemental function eval_twist (this, pos) result(res) Evaluation function for Twist modifier. Arguments Type Intent Optional Attributes Name class( twist ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: twist real ( kind = wp ) :: k class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_twist end type twist","tags":"","loc":"type/twist.html"},{"title":"model – signedMCRT ","text":"type, public, extends( sdf_base ) :: model Model type. Allows the collection of multiple SDF into one model. Used to apply modifiers. Contents Variables array func k layer optProps transform Constructor model Type-Bound Procedures evaluate Source Code model Components Type Visibility Attributes Name Initial type( sdf ), public, allocatable :: array (:) Array of SDFs in the model procedure( op ), public, nopass, pointer :: func SDF modifier function real(kind=wp), public :: k Parameter that may be used in modifer function. integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor public interface model private function model_init (array, func, kopt) result(out) Initalise the model type. Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: array (:) Array of SDFs procedure( op ) :: func Operator to apply to SDF. real(kind=wp), intent(in), optional :: kopt Parameter used in modifier Return Value type( model ) Type-Bound Procedures procedure, public, :: evaluate => eval_model private pure elemental function eval_model (this, pos) result(res) Evaluate the model Arguments Type Intent Optional Attributes Name class( model ), intent(in) :: this type( vector ), intent(in) :: pos Vector position to evaluate at Return Value real(kind=wp) Source Code type , extends ( sdf_base ) :: model !> Array of SDFs in the model type ( sdf ), allocatable :: array (:) !> SDF modifier function procedure ( op ), nopass , pointer :: func !> Parameter that may be used in modifer function. real ( kind = wp ) :: k contains procedure :: evaluate => eval_model end type model","tags":"","loc":"type/model.html"},{"title":"sdf – signedMCRT ","text":"type, public, extends( sdf_base ) :: sdf Container type that allows the use of arrays of different SDF shapes Contents Variables layer optProps transform value Constructor sdf Type-Bound Procedures assignment(=) evaluate getAlbedo getG2 getKappa getMua getN gethgg sdf_assign Source Code sdf Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. class( sdf_base ), public, allocatable :: value Container for any SDF that inherits from SDF_base Constructor public interface sdf private function sdf_new (rhs) result(lhs) sdf initializer Arguments Type Intent Optional Attributes Name class( sdf_base ), intent(in) :: rhs Return Value type( sdf ) Type-Bound Procedures generic, public, :: assignment(=) => sdf_assign private subroutine sdf_assign (lhs, rhs) sdf initializer Arguments Type Intent Optional Attributes Name class( sdf ), intent(inout) :: lhs class( sdf_base ), intent(in) :: rhs procedure, public, :: evaluate => sdf_evaluate private pure elemental function sdf_evaluate (this, pos) result(res) Evaluate the SDF at a given position. Arguments Type Intent Optional Attributes Name class( sdf ), intent(in) :: this type( vector ), intent(in) :: pos Return Value real(kind=wp) procedure, public, :: getAlbedo private function getAlbedo (this) result(res) Return albedo for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) procedure, public, :: getG2 => getg2 private function getg2 (this) result(res) Return factor for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) procedure, public, :: getKappa private function getKappa (this) result(res) Return for the current SDF Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) procedure, public, :: getMua private function getMua (this) result(res) Return for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) procedure, public, :: getN private function getN (this) result(res) Return refractive index for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) procedure, public, :: gethgg private function gethgg (this) result(res) Return g-factor for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) procedure, private :: sdf_assign private subroutine sdf_assign (lhs, rhs) sdf initializer Arguments Type Intent Optional Attributes Name class( sdf ), intent(inout) :: lhs class( sdf_base ), intent(in) :: rhs Source Code type , extends ( sdf_base ) :: sdf !> Container for any SDF that inherits from SDF_base class ( sdf_base ), allocatable :: value contains procedure :: getKappa procedure :: getAlbedo procedure :: getMua , gethgg , getG2 , getN procedure :: evaluate => sdf_evaluate procedure , private :: sdf_assign generic :: assignment ( = ) => sdf_assign end type sdf","tags":"","loc":"type/sdf.html"},{"title":"sdf_base – signedMCRT ","text":"type, public, abstract :: sdf_base Abstract base type from which all SDF inherit from. Contents Variables layer optProps transform Type-Bound Procedures evaluate Source Code sdf_base Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Type-Bound Procedures procedure( evalInterface ), public, deferred :: evaluate pure elemental function evalInterface(this, pos) result(res) Prototype Evaluation function for SDF. ALL SDF must implment this. Arguments Type Intent Optional Attributes Name class( sdf_base ), intent(in) :: this type( vector ), intent(in) :: pos Return Value real(kind=wp) Source Code type , abstract :: sdf_base !> Optical property of the SDF type ( opticalProp_t ) :: optProps !> Transform to apply to SDF. real ( kind = wp ) :: transform ( 4 , 4 ) !> Layer ID of SDF integer :: layer contains procedure ( evalInterface ), deferred :: evaluate end type sdf_base","tags":"","loc":"type/sdf_base.html"},{"title":"generic_emit – signedMCRT","text":"abstract interface public subroutine generic_emit(this, spectrum, dict, seqs) Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2)","tags":"","loc":"interface/generic_emit.html"},{"title":"updateInterface – signedMCRT","text":"abstract interface public subroutine updateInterface(this, wavelength) Arguments Type Intent Optional Attributes Name class( opticalProp_base ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength","tags":"","loc":"interface/updateinterface.html"},{"title":"sampleInterface – signedMCRT","text":"abstract interface public subroutine sampleInterface(this, x, y, value) Arguments Type Intent Optional Attributes Name class( piecewise ), intent(in) :: this real(kind=wp), intent(out) :: x real(kind=wp), intent(out) :: y real(kind=wp), intent(in), optional :: value","tags":"","loc":"interface/sampleinterface.html"},{"title":"checkHitInterface – signedMCRT","text":"abstract interface public function checkHitInterface(this, hitpoint) Arguments Type Intent Optional Attributes Name class( detector ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Return Value logical","tags":"","loc":"interface/checkhitinterface.html"},{"title":"recordHitInterface – signedMCRT","text":"abstract interface public subroutine recordHitInterface(this, hitpoint, history) Arguments Type Intent Optional Attributes Name class( detector ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint type( history_stack_t ), intent(inout) :: history","tags":"","loc":"interface/recordhitinterface.html"},{"title":"evalInterface – signedMCRT","text":"abstract interface public pure elemental function evalInterface(this, pos) result(res) Arguments Type Intent Optional Attributes Name class( sdf_base ), intent(in) :: this type( vector ), intent(in) :: pos Return Value real(kind=wp) Description Evaluation function for SDF. ALL SDF must implment this.","tags":"","loc":"interface/evalinterface.html"},{"title":"op – signedMCRT","text":"abstract interface public pure function op(d1, d2, k) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 real(kind=wp), intent(in) :: d2 real(kind=wp), intent(in) :: k Return Value real(kind=wp) Description Abstract function used as the base for SDF operators (union, subtraction etc)","tags":"","loc":"interface/op.html"},{"title":"primitive – signedMCRT","text":"abstract interface public pure function primitive(pos) result(res) Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos vector position of photon packet. Return Value real(kind=wp) Description Abstract function used as base for displacement function","tags":"","loc":"interface/primitive.html"},{"title":"get_vessels – signedMCRT","text":"public function get_vessels() result(array) Uses vector_class opticalProperties sdfs setup blood vessel scene Arguments None Return Value type( sdf ), allocatable, (:) Contents Source Code get_vessels Source Code function get_vessels () result ( array ) !! setup blood vessel scene use opticalProperties use sdfs , only : sdf , capsule , box use vector_class , only : vector type ( sdf ), allocatable :: array (:) real ( kind = wp ), allocatable :: nodes (:, :), radii (:) integer , allocatable :: edges (:, :) integer :: io , edge_cnt , tmp1 , tmp2 , u , node_cnt , i real ( kind = wp ) :: x , y , z , radius , res , maxx , maxy , maxz real ( kind = wp ) :: musv , muav , gv , nv real ( kind = wp ) :: musd , muad , gd , nd type ( vector ) :: a , b type ( opticalProp_t ) :: opt ( 2 ) !MCmatlab: an open-source, user-friendly, MATLAB-integrated three-dimensional Monte Carlo light transport solver with heat diffusion and tissue damage muav = 23 1._wp musv = 9 4._wp gv = 0.9_wp nv = 1.37_wp muad = 0.458_wp musd = 35 7._wp gd = 0.9_wp nd = 1.37_wp opt ( 1 ) = mono ( musv , muav , gv , nv ) opt ( 2 ) = mono ( musd , muad , gd , nd ) !get number of edges open ( newunit = u , file = \"res/edges.dat\" , iostat = io ) edge_cnt = 0 do read ( u , * , iostat = io ) tmp1 , tmp2 if ( io /= 0 ) exit edge_cnt = edge_cnt + 1 end do close ( u ) !get number of nodes and radii open ( newunit = u , file = \"res/nodes.dat\" , iostat = io ) node_cnt = 0 do read ( u , * , iostat = io ) x , y , z if ( io /= 0 ) exit node_cnt = node_cnt + 1 end do allocate ( edges ( edge_cnt , 2 ), nodes ( node_cnt , 3 ), radii ( node_cnt )) !read in edges open ( newunit = u , file = \"res/edges.dat\" , iostat = io ) do i = 1 , edge_cnt read ( u , * , iostat = io ) edges ( i , :) if ( io /= 0 ) exit end do close ( u ) !read in nodes open ( newunit = u , file = \"res/nodes.dat\" , iostat = io ) do i = 1 , edge_cnt read ( u , * , iostat = io ) nodes ( i , :) if ( io /= 0 ) exit end do close ( u ) !read in radii open ( newunit = u , file = \"res/radii.dat\" , iostat = io ) do i = 1 , node_cnt read ( u , * , iostat = io ) radii ( i ) if ( io /= 0 ) exit end do close ( u ) res = 0.001_wp !0.01mm maxx = maxval ( abs ( nodes (:, 1 ))) maxy = maxval ( abs ( nodes (:, 2 ))) maxz = maxval ( abs ( nodes (:, 3 ))) nodes (:, 1 ) = ( nodes (:, 1 ) / maxx ) - 0.5_wp nodes (:, 2 ) = ( nodes (:, 2 ) / maxy ) - 0.5_wp nodes (:, 3 ) = ( nodes (:, 3 ) / maxz ) - 0.5_wp nodes (:, 1 ) = nodes (:, 1 ) * maxx * res nodes (:, 2 ) = nodes (:, 2 ) * maxy * res nodes (:, 3 ) = nodes (:, 3 ) * maxz * res allocate ( array ( edge_cnt + 1 )) do i = 1 , edge_cnt a = vector ( nodes ( edges ( i , 1 ), 1 ), nodes ( edges ( i , 1 ), 2 ), nodes ( edges ( i , 1 ), 3 )) b = vector ( nodes ( edges ( i , 2 ), 1 ), nodes ( edges ( i , 2 ), 2 ), nodes ( edges ( i , 2 ), 3 )) radius = radii ( edges ( i , 1 )) * res array ( i ) = capsule ( a , b , radius , opt ( 1 ), 1 ) end do array ( i ) = box ( vector (. 32_wp , . 18_wp , . 26_wp ), opt ( 2 ), 2 ) end function get_vessels","tags":"","loc":"proc/get_vessels.html"},{"title":"setup_egg – signedMCRT","text":"public function setup_egg() result(array) Uses vector_class sdfModifiers opticalProperties sdfs setup an egg, with yolk, albumen and shell Arguments None Return Value type( sdf ), allocatable, (:) Contents Source Code setup_egg Source Code function setup_egg () result ( array ) !! setup an egg, with yolk, albumen and shell use sdfs , only : sdf , sphere , box , egg use sdfModifiers , only : onion , revolution use vector_class use opticalProperties type ( sdf ), allocatable :: array (:) type ( box ) :: bbox type ( revolution ), save :: albumen , rev1 type ( onion ) :: shell type ( sphere ) :: yolk type ( opticalProp_t ) :: opt ( 4 ) type ( egg ), save :: egg_shell , egg_albumen real ( kind = wp ) :: r1 , r2 , h r1 = 3._wp r2 = 3._wp * sqrt ( 2._wp - sqrt ( 2._wp )) h = r2 !width = 42mm !height = 62mm !shell opt ( 1 ) = mono ( 10 0._wp , 1 0._wp , 0.0_wp , 1.37_wp ) egg_shell = egg ( r1 , r2 , h , opt ( 1 ), 2 ) rev1 = revolution ( egg_shell , . 2_wp ) shell = onion ( rev1 , . 2_wp ) !albumen opt ( 2 ) = mono ( 1._wp , 0._wp , 0.0_wp , 1.37_wp ) egg_albumen = egg ( r1 - . 2_wp , r2 , h , opt ( 2 ), 3 ) albumen = revolution ( egg_albumen , . 2_wp ) !yolk opt ( 3 ) = mono ( 1 0._wp , 1._wp , 0.9_wp , 1.37_wp ) yolk = sphere ( 1.5_wp , opt ( 3 ), 1 ) !bounding box opt ( 4 ) = mono ( 0._wp , 0._wp , 0.0_wp , 1._wp ) bbox = box ( vector ( 2 0.001_wp , 2 0.001_wp , 2 0.001_wp ), opt ( 4 ), 4 ) allocate ( array ( 4 )) array ( 1 ) = yolk array ( 2 ) = albumen array ( 3 ) = shell array ( 4 ) = bbox end function setup_egg","tags":"","loc":"proc/setup_egg.html"},{"title":"setup_exp – signedMCRT","text":"public function setup_exp(dict) result(array) Uses sdfHelpers opticalProperties mat_class sdfs vector_class utils Setup experimental geometry from Georgies paper. i.e a glass bottle with contents Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Return Value type( sdf ), allocatable, (:) Contents Source Code setup_exp Source Code function setup_exp ( dict ) result ( array ) !! Setup experimental geometry from Georgies paper. i.e a glass bottle with contents use sdfs , only : sdf , box , cylinder !, subtraction use sdfHelpers , only : rotate_y , translate use utils , only : deg2rad use vector_class , only : vector use mat_class , only : invert use opticalProperties , only : mono , opticalProp_t type ( toml_table ), intent ( inout ) :: dict type ( sdf ), allocatable :: array (:) type ( opticalProp_t ) :: opt ( 3 ) type ( vector ) :: a , b real ( kind = wp ) :: n , optprop ( 5 ) error stop \"add model and subtraction here\" call get_value ( dict , \"musb\" , optprop ( 1 )) call get_value ( dict , \"muab\" , optprop ( 2 )) call get_value ( dict , \"musc\" , optprop ( 3 )) call get_value ( dict , \"muac\" , optprop ( 4 )) call get_value ( dict , \"hgg\" , optprop ( 5 )) n = 1._wp opt ( 1 ) = mono ( optprop ( 1 ), optprop ( 2 ), optprop ( 5 ), 1.5_wp ) opt ( 2 ) = mono ( optprop ( 3 ), optprop ( 4 ), optprop ( 5 ), 1.3_wp ) a = vector ( - 1 0._wp , 0._wp , 0._wp ) b = vector ( 1 0._wp , 0._wp , 0._wp ) !bottle array ( 2 ) = cylinder ( a , b , 1.75_wp , opt ( 1 ), 2 ) ! contents array ( 1 ) = cylinder ( a , b , 1.55_wp , opt ( 2 ), 1 ) ! t = invert(translate(vector(0._wp, 0._wp, -5._wp+1.75_wp))) ! slab = box(vector(10._wp, 10._wp, 10._wp), optprop(3), optprop(4), optprop(5), 1.3_wp, 1, transform=t) opt ( 3 ) = mono ( 0.0_wp , 0.0_wp , 0.0_wp , n ) array ( 3 ) = box ( vector ( 4._wp , 4._wp , 4._wp ), opt ( 3 ), 2 ) end function setup_exp","tags":"","loc":"proc/setup_exp.html"},{"title":"setup_logo – signedMCRT","text":"public function setup_logo() result(array) Uses vector_class opticalProperties sdfModifiers sdfs setup uni crest geometry Arguments None Return Value type( sdf ), allocatable, (:) Contents Source Code setup_logo Source Code function setup_logo () result ( array ) !! setup uni crest geometry use sdfs , only : sdf , box , segment use sdfModifiers , only : extrude use opticalProperties use vector_class type ( sdf ), allocatable :: array (:) type ( segment ), allocatable , save :: seg (:) type ( opticalProp_t ) :: opt ( 2 ) type ( vector ) :: a , b real ( kind = wp ) :: hgg , mus , mua , n integer :: layer logical :: fexists allocate ( array ( 726 ), seg ( 725 )) mus = 1 0._wp mua = . 1_wp hgg = 0.9_wp n = 1.5_wp layer = 1 opt ( 1 ) = mono ( 0.0_wp , 0.0_wp , 0.0_wp , 1.0_wp ) opt ( 2 ) = mono ( mus , mua , hgg , n ) inquire ( file = \"res/svg.f90\" , exist = fexists ) if (. not . fexists ) error stop \"need to generate svg.f90 and place in res/\" error stop \"need to uncomment inlcude line!\" ! include \"../res/svg.f90\" array ( 726 ) = box ( vector ( 1 0._wp , 1 0._wp , 2.001_wp ), opt ( 1 ), 2 ) end function setup_logo","tags":"","loc":"proc/setup_logo.html"},{"title":"setup_omg_sdf – signedMCRT","text":"public function setup_omg_sdf() result(array) Uses opticalProperties sdfHelpers mat_class sdfs vector_class sdfModifiers setup OMG scene Arguments None Return Value type( sdf ), allocatable, (:) Contents Source Code setup_omg_sdf Source Code function setup_omg_sdf () result ( array ) !! setup OMG scene use mat_class , only : invert use opticalProperties use sdfHelpers , only : translate , rotate_y use sdfModifiers , only : SmoothUnion use sdfs , only : sdf , cylinder , torus , box , model use vector_class , only : vector type ( sdf ), allocatable :: array (:) type ( sdf ), allocatable , save :: cnta (:) type ( opticalProp_t ), save :: opt ( 2 ) type ( vector ) :: a , b real ( kind = wp ) :: t ( 4 , 4 ), mus , mua , hgg , n integer :: layer allocate ( array ( 2 ), cnta ( 10 )) mus = 1 0._wp mua = 0.16_wp hgg = 0.0_wp n = 2.65_wp layer = 1 opt ( 1 ) = mono ( mus , mua , hgg , n ) opt ( 2 ) = mono ( 0._wp , 0._wp , 0._wp , 1.0_wp ) ! x ! | ! | ! | ! | ! |_____z !O letter a = vector ( 0._wp , 0._wp , - 0.7_wp ) t = invert ( translate ( a )) cnta ( 1 ) = torus (. 2_wp , 0.05_wp , opt ( 1 ), layer , transform = t ) !M letter a = vector ( - . 25_wp , 0._wp , - . 25_wp ) b = vector ( - . 25_wp , 0._wp , . 25_wp ) t = invert ( rotate_y ( 9 0._wp )) cnta ( 2 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer , transform = t ) a = vector ( - . 25_wp , 0._wp , - . 25_wp ) b = vector (. 25_wp , 0._wp , . 0_wp ) cnta ( 3 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector (. 25_wp , 0._wp , . 0_wp ) b = vector ( - . 25_wp , 0._wp , . 25_wp ) cnta ( 4 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector ( - . 25_wp , 0._wp , . 25_wp ) b = vector (. 25_wp , 0._wp , . 25_wp ) cnta ( 5 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) !G letter a = vector ( - . 25_wp , 0._wp , . 5_wp ) b = vector (. 25_wp , 0._wp , . 5_wp ) cnta ( 6 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector ( - . 25_wp , 0._wp , . 5_wp ) b = vector ( - . 25_wp , 0._wp , . 75_wp ) cnta ( 7 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector (. 25_wp , 0._wp , . 5_wp ) b = vector (. 25_wp , 0._wp , . 75_wp ) cnta ( 8 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector (. 25_wp , 0._wp , . 75_wp ) b = vector ( 0._wp , 0._wp , . 75_wp ) cnta ( 9 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector ( 0._wp , 0._wp , . 625_wp ) b = vector ( 0._wp , 0._wp , . 75_wp ) cnta ( 10 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) array ( 1 ) = model ( cnta , smoothunion , 0.09_wp ) array ( 2 ) = box ( vector ( 2._wp , 2._wp , 2._wp ), opt ( 2 ), 2 ) end function setup_omg_sdf","tags":"","loc":"proc/setup_omg_sdf.html"},{"title":"setup_scat_test – signedMCRT","text":"public function setup_scat_test(dict) result(array) Uses vector_class opticalProperties sdfs set up scattering test scene with user defined tau Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Return Value type( sdf ), allocatable, (:) Contents Source Code setup_scat_test Source Code function setup_scat_test ( dict ) result ( array ) !! set up scattering test scene with user defined tau use opticalProperties use sdfs , only : sdf , sphere , box use vector_class type ( toml_table ), intent ( inout ) :: dict type ( sdf ), allocatable :: array (:) type ( opticalProp_t ) :: opt ( 2 ) real ( kind = wp ) :: mus , mua , hgg , n , tau call get_value ( dict , \"tau\" , tau ) allocate ( array ( 2 )) n = 1._wp hgg = 0.0_wp mua = 0.00_wp mus = tau opt ( 1 ) = mono ( mus , mua , hgg , n ) array ( 1 ) = sphere ( 1._wp , opt ( 1 ), 1 ) opt ( 2 ) = mono ( 0.0_wp , mua , hgg , n ) array ( 2 ) = box ( vector ( 2._wp , 2._wp , 2._wp ), opt ( 2 ), 2 ) end function setup_scat_test","tags":"","loc":"proc/setup_scat_test.html"},{"title":"setup_scat_test2 – signedMCRT","text":"public function setup_scat_test2(dict) result(array) Uses vector_class opticalProperties sdfs set up scattering test scene 2 with user defined tau and hgg Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Return Value type( sdf ), allocatable, (:) Contents Source Code setup_scat_test2 Source Code function setup_scat_test2 ( dict ) result ( array ) !! set up scattering test scene 2 with user defined tau and hgg use opticalProperties use sdfs , only : sdf , box use vector_class type ( toml_table ), intent ( inout ) :: dict type ( sdf ), allocatable :: array (:) type ( opticalProp_t ) :: opt real ( kind = wp ) :: mus , mua , hgg , n , tau allocate ( array ( 1 )) call get_value ( dict , \"tau\" , tau ) call get_value ( dict , \"hgg\" , hgg ) n = 1._wp hgg = hgg mua = 1e-17_wp mus = tau opt = mono ( mus , mua , hgg , n ) array ( 1 ) = box ( vector ( 20 0._wp , 20 0._wp , 20 0._wp ), opt , 2 ) end function setup_scat_test2","tags":"","loc":"proc/setup_scat_test2.html"},{"title":"setup_sphere – signedMCRT","text":"public function setup_sphere() result(array) Uses opticalProperties sdfHelpers mat_class sdfs vector_class setup the sphere test case from tran and jacques paper. Arguments None Return Value type( sdf ), allocatable, (:) Contents Source Code setup_sphere Source Code function setup_sphere () result ( array ) !! setup the sphere test case from tran and jacques paper. use mat_class , only : invert use opticalProperties , only : mono , opticalProp_t use sdfs , only : sdf , box , sphere use sdfHelpers , only : translate use vector_class , only : vector type ( sdf ), allocatable :: array (:) type ( opticalProp_t ) :: opt ( 3 ) real ( kind = wp ) :: mus , mua , n , hgg , t ( 4 , 4 ) type ( vector ) :: a allocate ( array ( 3 )) mus = 0._wp ; mua = 1.e-17_wp ; hgg = 0._wp ; n = 1._wp ; opt ( 1 ) = mono ( mus , mua , hgg , n ) array ( 2 ) = box ( vector ( 2._wp , 2._wp , 2._wp ), opt ( 1 ), 2 ) opt ( 2 ) = mono ( mus , 1000000 0._wp , hgg , n ) array ( 3 ) = box ( vector ( 2.01_wp , 2.01_wp , 2.01_wp ), opt ( 2 ), 3 ) mus = 0._wp ; mua = 1.e-17_wp ; hgg = 0._wp ; n = 1.33_wp ; opt ( 3 ) = mono ( mus , mua , hgg , n ) a = vector (. 0_wp , 0._wp , 0._wp ) t = invert ( translate ( a )) array ( 1 ) = sphere ( 0.5_wp , opt ( 3 ), 1 , transform = t ) end function setup_sphere","tags":"","loc":"proc/setup_sphere.html"},{"title":"setup_sphere_scene – signedMCRT","text":"public function setup_sphere_scene(dict) result(array) Uses opticalProperties sdfHelpers random mat_class sdfs vector_class setup a test scene with user defined spheres Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Return Value type( sdf ), allocatable, (:) Contents Source Code setup_sphere_scene Source Code function setup_sphere_scene ( dict ) result ( array ) !! setup a test scene with user defined spheres use mat_class , only : invert use opticalProperties , only : opticalProp_t , mono use sdfs , only : sdf , sphere , box use sdfHelpers , only : translate use random , only : ranu use vector_class , only : vector type ( toml_table ), intent ( inout ) :: dict type ( sdf ), allocatable :: array (:) integer :: num_spheres , i real ( kind = wp ) :: t ( 4 , 4 ), mus , mua , hgg , n , radius type ( vector ) :: pos type ( opticalProp_t ) :: opt ( 2 ) call get_value ( dict , \"num_spheres\" , num_spheres ) allocate ( array ( num_spheres + 1 )) mus = 1e-17_wp mua = 1e-17_wp hgg = 0.0_wp n = 1.0_wp opt ( 2 ) = mono ( mus , mua , hgg , n ) array ( num_spheres + 1 ) = box ( vector ( 2._wp , 2._wp , 2._wp ), opt ( 2 ), num_spheres + 1 ) mus = 0.0_wp !ranu(1._wp, 50._wp) mua = 0.0_wp !ranu(0.01_wp, 1._wp) hgg = 0.9_wp n = 1.37_wp opt ( 1 ) = mono ( mus , mua , hgg , n ) do i = 1 , num_spheres radius = ranu ( 0.001_wp , 0.25_wp ) pos = vector ( ranu ( - 1._wp + radius , 1._wp - radius ), ranu ( - 1._wp + radius , 1._wp - radius ),& ranu ( - 1._wp + radius , 1._wp - radius )) t = invert ( translate ( pos )) array ( i ) = sphere ( radius , opt ( 1 ), i , transform = t ) end do end function setup_sphere_scene","tags":"","loc":"proc/setup_sphere_scene.html"},{"title":"init_photon – signedMCRT","text":"private function init_photon(val) set up all the variables in the photon object Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val value to assing to variables Return Value type( photon ) Contents Source Code init_photon Source Code type ( photon ) function init_photon ( val ) !! set up all the variables in the photon object !> value to assing to variables real ( kind = wp ), intent ( in ) :: val init_photon % pos = vector ( val , val , val ) init_photon % nxp = val init_photon % nyp = val init_photon % nzp = val init_photon % sint = val init_photon % cost = val init_photon % sinp = val init_photon % cosp = val init_photon % phi = val init_photon % wavelength = val init_photon % energy = val init_photon % fact = val init_photon % zcell = int ( val ) init_photon % ycell = int ( val ) init_photon % zcell = int ( val ) init_photon % tflag = . true . init_photon % layer = int ( val ) init_photon % id = int ( val ) init_photon % cnts = int ( val ) init_photon % bounces = int ( val ) init_photon % weight = val init_photon % step = val end function init_photon","tags":"","loc":"proc/init_photon.html"},{"title":"init_source – signedMCRT","text":"public function init_source(choice) Bind emission function to photon object Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: choice Name of light source to use Return Value type( photon ) Contents Source Code init_source Source Code type ( photon ) function init_source ( choice ) !! Bind emission function to photon object !> Name of light source to use character ( * ), intent ( IN ) :: choice if ( choice == \"uniform\" ) then init_source % emit => uniform elseif ( choice == \"pencil\" ) then init_source % emit => pencil elseif ( choice == \"dslit\" ) then init_source % emit => dslit elseif ( choice == \"aperture\" ) then init_source % emit => aperture elseif ( choice == \"annulus\" ) then init_source % emit => annulus elseif ( choice == \"focus\" ) then init_source % emit => focus elseif ( choice == \"point\" ) then init_source % emit => point elseif ( choice == \"circular\" ) then init_source % emit => circular elseif ( choice == \"slm\" ) then init_source % emit => slm else error stop \"No such source!\" end if end function init_source","tags":"","loc":"proc/init_source.html"},{"title":"annulus – signedMCRT","text":"private subroutine annulus(this, spectrum, dict, seqs) Uses random sim_state_mod piecewiseMod tomlf utils constants annular source Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Contents Source Code annulus Source Code subroutine annulus ( this , spectrum , dict , seqs ) !! annular source use constants , only : TWOPI use utils , only : deg2rad use tomlf , only : toml_table , get_value use random , only : ran2 , rang , seq use sim_state_mod , only : state use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) character ( len = :), allocatable :: beam_type real ( kind = wp ) :: beta , rlo , rhi , radius , tmp , mid , angle , x , y , z , phi , sinp , cosp type ( vector ) :: pos integer :: cell ( 3 ) call get_value ( dict , \"beta\" , beta ) call get_value ( dict , \"radius\" , rlo ) call get_value ( dict , \"radius_hi\" , rhi ) call get_value ( dict , \"annulus_type\" , beam_type ) if ( beam_type == \"tophat\" ) then radius = rlo + ( rhi - rlo ) * sqrt ( ran2 ()) elseif ( beam_type == \"gaussian\" ) then mid = ( rhi - rlo ) / 2. call rang ( radius , tmp , mid , 0.04_wp ) else error stop \"No such beam type!\" end if phi = TWOPI * ran2 () angle = deg2rad ( beta ) cosp = cos ( phi ) sinp = sin ( phi ) x = radius * cosp y = radius * sinp z = state % grid % zmax - 1e-8_wp ! just inside surface of medium. TODO make this user configurable? pos = vector ( x , y , z ) this % pos = pos this % nxp = sin ( angle ) * cosp this % nyp = sin ( angle ) * sinp this % nzp = - cos ( angle ) this % phi = phi this % cosp = cosp this % sinp = sinp this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % tflag = . false . this % bounces = 0 this % cnts = 0 this % weight = 1.0_wp call spectrum % p % sample ( this % wavelength , tmp ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine annulus","tags":"","loc":"proc/annulus.html"},{"title":"aperture – signedMCRT","text":"private subroutine aperture(this, spectrum, dict, seqs) Uses random sim_state_mod piecewiseMod tomlf constants sample from square aperture to produce diff pattern Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Contents Source Code aperture Source Code subroutine aperture ( this , spectrum , dict , seqs ) !! sample from square aperture to produce diff pattern !add user defined apwid and F ! add correct normalisation use random , only : ranu , ran2 , randint , seq use sim_state_mod , only : state use tomlf , only : toml_table , get_value use constants , only : TWOPI use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: x1 , y1 , z1 , x2 , y2 , z2 , b , F , apwid , tmp call spectrum % p % sample ( this % wavelength , tmp ) this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) apwid = 20 0e-6_wp !aperture width b = apwid / 2._wp !slit width ! Fresnel number F = 4.95_wp !sample aperture postiion x1 = ranu ( - b , b ) y1 = ranu ( - b , b ) z1 = ( 1._wp / (((( F / apwid ) ** 2 ) / 2._wp ) * this % wavelength )) - 0.5_wp x2 = ranu ( - 0.5_wp , 0.5_wp ) y2 = ranu ( - 0.5_wp , 0.5_wp ) z2 = 0.5_wp - ( 1.e-5_wp * ( 2._wp * 0.5_wp / 40 0._wp )) this % pos % x = x2 this % pos % y = y2 this % pos % z = z2 this % phase = sqrt (( x2 - x1 ) ** 2 + ( y2 - y1 ) ** 2 + ( z2 - z1 ) ** 2 ) this % nxp = ( x2 - x1 ) / this % phase this % nyp = ( y2 - y1 ) / this % phase this % nzp = - abs (( z2 - z1 )) / this % phase this % tflag = . false . this % cnts = 0 this % bounces = 0 this % weight = 1.0_wp !scattering stuff - not important this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine aperture","tags":"","loc":"proc/aperture.html"},{"title":"circular – signedMCRT","text":"private subroutine circular(this, spectrum, dict, seqs) Uses sim_state_mod random sdfHelpers piecewiseMod mat_class tomlf vector_class constants circular source Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Contents Source Code circular Source Code subroutine circular ( this , spectrum , dict , seqs ) !! circular source use sim_state_mod , only : state use random , only : ran2 , seq use constants , only : twoPI use tomlf , only : toml_table , get_value use sdfHelpers , only : rotationAlign , translate use mat_class , only : invert use vector_class use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) type ( vector ) :: a , b integer :: cell ( 3 ) real ( kind = wp ) :: t ( 4 , 4 ), radius , r , theta , tmp this % nxp = photon_origin % nxp this % nyp = photon_origin % nyp this % nzp = photon_origin % nzp call get_value ( dict , \"radius\" , radius ) ! https://math.stackexchange.com/a/1681815 r = radius * sqrt ( ran2 ()) theta = ran2 () * TWOPI !set inital vector from which the source points a = vector ( 1._wp , 0._wp , 0._wp ) a = a % magnitude () !set vector to rotate to. User defined. b = vector ( this % nxp , this % nyp , this % nzp ) b = b % magnitude () ! method fails if below condition is true. So change a vector to point down x-axis if ( abs ( a ) == abs ( b )) then a = vector ( 0._wp , 0._wp , 1._wp ) a = a % magnitude () this % pos = vector ( r * cos ( theta ), r * sin ( theta ), 0._wp ) else this % pos = vector ( 0._wp , r * cos ( theta ), r * sin ( theta )) end if ! get rotation matrix t = rotationAlign ( a , b ) ! get translation matrix t = matmul ( t , invert ( translate ( photon_origin % pos ))) ! transform point this % pos = this % pos . dot . t this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) call spectrum % p % sample ( this % wavelength , tmp ) this % tflag = . false . this % cnts = 0 this % bounces = 0 this % layer = 1 this % weight = 1.0_wp ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine circular","tags":"","loc":"proc/circular.html"},{"title":"dslit – signedMCRT","text":"private subroutine dslit(this, spectrum, dict, seqs) Uses random sim_state_mod piecewiseMod tomlf constants sample from double slit to produce diff pattern Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Contents Source Code dslit Source Code subroutine dslit ( this , spectrum , dict , seqs ) !!sample from double slit to produce diff pattern ! todo add in user defined slit widths ! add correct normalisation use random , only : ranu , ran2 , randint , seq use sim_state_mod , only : state use tomlf , only : toml_table , get_value use constants , only : TWOPI use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: x1 , y1 , z1 , x2 , y2 , z2 , a , b , tmp call spectrum % p % sample ( this % wavelength , tmp ) this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) a = 6 0._wp * this % wavelength !distance between slits b = 2 0._wp * this % wavelength !2 slit width if ( ran2 () > 0.5_wp ) then ! pick slit and sample x, y position x1 = ranu ( a / 2._wp , a / 2._wp + b ) y1 = ranu ( - b * 0.5_wp , b * 0.5_wp ) else x1 = ranu ( - a / 2._wp , - a / 2._wp - b ) y1 = ranu ( - b * 0.5_wp , b * 0.5_wp ) end if z2 = 5.0_wp - ( 1.e-5_wp * ( 2._wp * ( 5.0_wp / 40 0._wp ))) x2 = ranu ( - 5.0_wp , 5.0_wp ) y2 = ranu ( - 5.0_wp , 5.0_wp ) z1 = ( 1000 0._wp * this % wavelength ) - 5.0_wp !screen location this % pos % x = x2 this % pos % y = y2 this % pos % z = z2 this % phase = sqrt (( x2 - x1 ) ** 2 + ( y2 - y1 ) ** 2 + ( z2 - z1 ) ** 2 ) this % nxp = ( x2 - x1 ) / this % phase this % nyp = ( y2 - y1 ) / this % phase this % nzp = - abs (( z2 - z1 )) / this % phase this % tflag = . false . this % cnts = 0 this % bounces = 0 this % weight = 1.0_wp !Set direction cosine/sine this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine dslit","tags":"","loc":"proc/dslit.html"},{"title":"focus – signedMCRT","text":"private subroutine focus(this, spectrum, dict, seqs) Uses random sim_state_mod piecewiseMod tomlf vector_class utils Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Contents Source Code focus Source Code subroutine focus ( this , spectrum , dict , seqs ) use random , only : ranu , seq use sim_state_mod , only : state use utils , only : deg2rad use vector_class , only : length use tomlf , only : toml_table , get_value use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) type ( vector ) :: targ , dir real ( kind = wp ) :: dist , tmp integer :: cell ( 3 ) targ = vector ( 0._wp , 0._wp , 0._wp ) this % pos % x = ranu ( - state % grid % xmax , state % grid % xmax ) this % pos % y = ranu ( - state % grid % ymax , state % grid % ymax ) this % pos % z = state % grid % zmax - 1e-8_wp dist = length ( this % pos ) dir = ( - 1._wp ) * this % pos / dist dir = dir % magnitude () this % nxp = dir % x this % nyp = dir % y this % nzp = dir % z this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % nxp = this % sint * this % cosp this % nyp = this % sint * this % sinp this % nzp = this % cost this % tflag = . false . this % bounces = 0 this % cnts = 0 this % weight = 1.0_wp call spectrum % p % sample ( this % wavelength , tmp ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine focus","tags":"","loc":"proc/focus.html"},{"title":"pencil – signedMCRT","text":"private subroutine pencil(this, spectrum, dict, seqs) Uses random sim_state_mod piecewiseMod tomlf constants pencil beam source Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Contents Source Code pencil Source Code subroutine pencil ( this , spectrum , dict , seqs ) !! pencil beam source use random , only : ranu , seq use sim_state_mod , only : state use tomlf , only : toml_table , get_value use piecewiseMod use constants , only : TWOPI class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: tmp this % pos = photon_origin % pos this % nxp = photon_origin % nxp this % nyp = photon_origin % nyp this % nzp = photon_origin % nzp this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % tflag = . false . this % bounces = 0 this % cnts = 0 this % weight = 1.0_wp call spectrum % p % sample ( this % wavelength , tmp ) this % energy = 1.0_wp this % fact = TWOPI / this % wavelength ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine pencil","tags":"","loc":"proc/pencil.html"},{"title":"point – signedMCRT","text":"private subroutine point(this, spectrum, dict, seqs) Uses sim_state_mod random piecewiseMod tomlf constants isotropic point source Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Contents Source Code point Source Code subroutine point ( this , spectrum , dict , seqs ) !! isotropic point source use sim_state_mod , only : state use random , only : ran2 , seq use constants , only : twoPI use tomlf , only : toml_table , get_value use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: wavelength , tmp this % pos = photon_origin % pos this % phi = ran2 () * twoPI this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = 2._wp * ran2 () - 1._wp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % nxp = this % sint * this % cosp this % nyp = this % sint * this % sinp this % nzp = this % cost this % tflag = . false . this % cnts = 0 this % bounces = 0 this % layer = 1 this % weight = 1.0_wp ! this%L = 1.0 call spectrum % p % sample ( wavelength , tmp ) this % wavelength = wavelength this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine point","tags":"","loc":"proc/point.html"},{"title":"scatter – signedMCRT","text":"private subroutine scatter(this, hgg, g2, dects) Uses random constants detectors Scattering routine. Implments both isotropic and henyey-greenstein scattering\ntaken from mcxyz Type Bound photon Arguments Type Intent Optional Attributes Name class( photon ), intent(inout) :: this real(kind=wp), intent(in) :: hgg g factor real(kind=wp), intent(in) :: g2 g factor squared type( dect_array ), intent(in), optional :: dects (:) array of detectors. Only used if biased scattering is enabled. Contents Source Code scatter Source Code subroutine scatter ( this , hgg , g2 , dects ) !! Scattering routine. Implments both isotropic and henyey-greenstein scattering !! taken from [mcxyz](https://omlc.org/software/mc/mcxyz/index.html) use constants , only : PI , TWOPI , wp use random , only : ran2 use detectors , only : dect_array class ( photon ), intent ( inout ) :: this !> g factor real ( kind = wp ), intent ( in ) :: hgg !> g factor squared real ( kind = wp ), intent ( in ) :: g2 !> array of detectors. Only used if biased scattering is enabled. type ( dect_array ), optional , intent ( in ) :: dects (:) real ( kind = wp ) :: temp , uxx , uyy , uzz , a , p a = 0.9_wp p = 0.0_wp if ( hgg == 0.0_wp ) then !isotropic scattering this % cost = 2._wp * ran2 () - 1._wp else !henyey-greenstein scattering if ( ran2 () < p . and . present ( dects )) then !bias scattering temp = ran2 () * (( 1._wp / ( 1._wp - a )) - ( 1._wp / sqrt ( a ** 2 + 1._wp ))) + ( 1._wp / sqrt ( a ** 2 + 1._wp )) temp = temp ** ( - 2._wp ) this % cost = ( 1._wp / ( 2._wp * a )) * ( a ** 2 + 1._wp - temp ) this % nxp = dects ( 1 )% p % pos % x - this % pos % x this % nyp = dects ( 1 )% p % pos % y - this % pos % y this % nzp = dects ( 1 )% p % pos % z - this % pos % z else !unbiased temp = ( 1.0_wp - g2 ) / ( 1.0_wp - hgg + 2._wp * hgg * ran2 ()) this % cost = ( 1.0_wp + g2 - temp ** 2 ) / ( 2._wp * hgg ) end if end if this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % phi = TWOPI * ran2 () this % cosp = cos ( this % phi ) if ( this % phi < PI ) then this % sinp = sqrt ( 1._wp - this % cosp ** 2 ) else this % sinp = - sqrt ( 1._wp - this % cosp ** 2 ) end if if ( 1._wp - abs ( this % nzp ) <= 1e-12_wp ) then ! near perpindicular uxx = this % sint * this % cosp uyy = this % sint * this % sinp uzz = sign ( this % cost , this % nzp ) else temp = sqrt ( 1._wp - this % nzp ** 2 ) uxx = this % sint * ( this % nxp * this % nzp * this % cosp - this % nyp * this % sinp ) / temp + this % nxp * this % cost uyy = this % sint * ( this % nyp * this % nzp * this % cosp + this % nxp * this % sinp ) / temp + this % nyp * this % cost uzz = - 1._wp * this % sint * this % cosp * temp + this % nzp * this % cost end if this % nxp = uxx this % nyp = uyy this % nzp = uzz end subroutine scatter","tags":"","loc":"proc/scatter.html"},{"title":"set_photon – signedMCRT","text":"public subroutine set_photon(pos, dir) Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos type( vector ), intent(in) :: dir Contents Source Code set_photon Source Code subroutine set_photon ( pos , dir ) type ( vector ), intent ( in ) :: pos , dir photon_origin % pos = pos photon_origin % nxp = dir % x photon_origin % nyp = dir % y photon_origin % nzp = dir % z end subroutine set_photon","tags":"","loc":"proc/set_photon.html"},{"title":"slm – signedMCRT","text":"private subroutine slm(this, spectrum, dict, seqs) Uses piecewiseMod random sim_state_mod tomlf constants Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Contents Source Code slm Source Code subroutine slm ( this , spectrum , dict , seqs ) use piecewiseMod use tomlf , only : toml_table , get_value use random , only : ran2 , seq use sim_state_mod , only : state use constants , only : TWOPI class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: x , y this % pos = photon_origin % pos call spectrum % p % sample ( x , y ) this % pos % x = ( x - 100 ) / ( state % grid % nxg / ( 2. * state % grid % xmax )) this % pos % y = ( y - 100 ) / ( state % grid % nyg / ( 2. * state % grid % ymax )) this % nxp = photon_origin % nxp this % nyp = photon_origin % nyp this % nzp = photon_origin % nzp this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % tflag = . false . this % cnts = 0 this % bounces = 0 this % layer = 1 this % weight = 1.0_wp this % phase = 0.0_wp this % wavelength = 50 0.e-9_wp this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine slm","tags":"","loc":"proc/slm.html"},{"title":"uniform – signedMCRT","text":"private subroutine uniform(this, spectrum, dict, seqs) Uses random sim_state_mod piecewiseMod tomlf constants uniformly illuminate a surface of the simulation media Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Contents Source Code uniform Source Code subroutine uniform ( this , spectrum , dict , seqs ) !! uniformly illuminate a surface of the simulation media use random , only : ranu , ran2 , randint , seq use sim_state_mod , only : state use tomlf , only : toml_table , get_value use constants , only : TWOPI use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) type ( vector ) :: pos1 , pos2 , pos3 real ( kind = wp ) :: rx , ry , tmp this % nxp = photon_origin % nxp this % nyp = photon_origin % nyp this % nzp = photon_origin % nzp this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) call get_value ( dict , \"pos1%x\" , pos1 % x ) call get_value ( dict , \"pos1%y\" , pos1 % y ) call get_value ( dict , \"pos1%z\" , pos1 % z ) call get_value ( dict , \"pos2%x\" , pos2 % x ) call get_value ( dict , \"pos2%y\" , pos2 % y ) call get_value ( dict , \"pos2%z\" , pos2 % z ) call get_value ( dict , \"pos3%x\" , pos3 % x ) call get_value ( dict , \"pos3%y\" , pos3 % y ) call get_value ( dict , \"pos3%z\" , pos3 % z ) rx = ran2 () !seqs(1)%next() ry = ran2 () !seqs(2)%next() this % pos % x = pos1 % x + rx * pos2 % x + ry * pos3 % x this % pos % y = pos1 % y + rx * pos2 % y + ry * pos3 % y this % pos % z = pos1 % z + rx * pos2 % z + ry * pos3 % z this % tflag = . false . this % cnts = 0 this % bounces = 0 this % weight = 1.0_wp !FOR PHASE call spectrum % p % sample ( this % wavelength , tmp ) this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) this % phase = 0._wp ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine uniform","tags":"","loc":"proc/uniform.html"},{"title":"photon – signedMCRT","text":"public interface photon Contents Module Procedures init_source init_photon Module Procedures public function init_source (choice) Bind emission function to photon object Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: choice Name of light source to use Return Value type( photon ) private function init_photon (val) set up all the variables in the photon object Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val value to assing to variables Return Value type( photon )","tags":"","loc":"interface/photon.html"},{"title":"fresnel – signedMCRT","text":"private function fresnel(I, N, n1, n2) result(tir) Uses ieee_arithmetic calculates the fresnel coefficents Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: I incident vector type( vector ), intent(in) :: N Normal vector real(kind=wp), intent(in) :: n1 reffractive indicies real(kind=wp), intent(in) :: n2 reffractive indicies Return Value real(kind=wp) Contents Source Code fresnel Source Code function fresnel ( I , N , n1 , n2 ) result ( tir ) !! calculates the fresnel coefficents use ieee_arithmetic , only : ieee_is_nan !> reffractive indicies real ( kind = wp ), intent ( IN ) :: n1 , n2 !> incident vector type ( vector ), intent ( IN ) :: I !> Normal vector type ( vector ), intent ( IN ) :: N real ( kind = wp ) :: costt , sintt , sint2 , cost2 , tir , f1 , f2 costt = abs ( I . dot . N ) sintt = sqrt ( 1._wp - costt * costt ) sint2 = n1 / n2 * sintt if ( sint2 > 1._wp ) then tir = 1.0_wp return elseif ( costt == 1._wp ) then tir = 0._wp return else sint2 = ( n1 / n2 ) * sintt cost2 = sqrt ( 1._wp - sint2 * sint2 ) f1 = abs (( n1 * costt - n2 * cost2 ) / ( n1 * costt + n2 * cost2 )) ** 2 f2 = abs (( n1 * cost2 - n2 * costt ) / ( n1 * cost2 + n2 * costt )) ** 2 tir = 0.5_wp * ( f1 + f2 ) if ( ieee_is_nan ( tir ) . or . tir > 1._wp . or . tir < 0._wp ) print * , 'TIR: ' , tir , f1 , f2 , costt , sintt , cost2 , sint2 return end if end function fresnel","tags":"","loc":"proc/fresnel.html"},{"title":"reflect – signedMCRT","text":"private subroutine reflect(I, N) get vector of reflected photon Arguments Type Intent Optional Attributes Name type( vector ), intent(inout) :: I incident vector type( vector ), intent(in) :: N normal vector Contents Source Code reflect Source Code subroutine reflect ( I , N ) !! get vector of reflected photon !> incident vector type ( vector ), intent ( INOUT ) :: I !> normal vector type ( vector ), intent ( IN ) :: N type ( vector ) :: R R = I - 2._wp * ( N . dot . I ) * N I = R end subroutine reflect","tags":"","loc":"proc/reflect.html"},{"title":"reflect_refract – signedMCRT","text":"public subroutine reflect_refract(I, N, n1, n2, rflag, Ri) Uses random wrapper routine for fresnel calculation Arguments Type Intent Optional Attributes Name type( vector ), intent(inout) :: I incident vector type( vector ), intent(inout) :: N normal vector real(kind=wp), intent(in) :: n1 refractive indices real(kind=wp), intent(in) :: n2 refractive indices logical, intent(out) :: rflag reflection flag real(kind=wp), intent(out) :: Ri Contents Source Code reflect_refract Source Code subroutine reflect_refract ( I , N , n1 , n2 , rflag , ri ) !! wrapper routine for fresnel calculation use random , only : ran2 !> incident vector type ( vector ), intent ( INOUT ) :: I !> normal vector type ( vector ), intent ( INOUT ) :: N !> refractive indices real ( kind = wp ), intent ( IN ) :: n1 , n2 real ( kind = wp ), intent ( OUT ) :: Ri !> reflection flag logical , intent ( OUT ) :: rflag rflag = . FALSE . !draw random number, if less than fresnel coefficents, then reflect, else refract Ri = fresnel ( I , N , n1 , n2 ) if ( ran2 () <= Ri ) then call reflect ( I , N ) rflag = . true . else call refract ( I , N , n1 / n2 ) end if end subroutine reflect_refract","tags":"","loc":"proc/reflect_refract.html"},{"title":"refract – signedMCRT","text":"private subroutine refract(I, N, eta) get vector of refracted photon Arguments Type Intent Optional Attributes Name type( vector ), intent(inout) :: I incident vector type( vector ), intent(in) :: N normal vector real(kind=wp), intent(in) :: eta Contents Source Code refract Source Code subroutine refract ( I , N , eta ) !! get vector of refracted photon !> incident vector type ( vector ), intent ( INOUT ) :: I !> normal vector type ( vector ), intent ( IN ) :: N !> \\eta = \\frac{n_1}{n_2} real ( kind = wp ), intent ( IN ) :: eta type ( vector ) :: T , Ntmp real ( kind = wp ) :: c1 , c2 Ntmp = N c1 = ( Ntmp . dot . I ) if ( c1 < 0._wp ) then c1 = - c1 else Ntmp = ( - 1._wp ) * N end if c2 = sqrt ( 1._wp - ( eta ) ** 2 * ( 1._wp - c1 ** 2 )) T = eta * I + ( eta * c1 - c2 ) * Ntmp I = T end subroutine refract","tags":"","loc":"proc/refract.html"},{"title":"alloc_array – signedMCRT","text":"private subroutine alloc_array(nxg, nyg, nzg) Uses iarray subroutine allocates allocatable arrays Arguments Type Intent Optional Attributes Name integer, intent(in) :: nxg grid size integer, intent(in) :: nyg grid size integer, intent(in) :: nzg grid size Contents Source Code alloc_array Source Code subroutine alloc_array ( nxg , nyg , nzg ) !! subroutine allocates allocatable arrays use iarray !> grid size integer , intent ( IN ) :: nxg , nyg , nzg allocate ( phasor ( nxg , nyg , nzg ), phasorGLOBAL ( nxg , nyg , nzg )) allocate ( jmean ( nxg , nyg , nzg ), jmeanGLOBAL ( nxg , nyg , nzg )) allocate ( absorb ( nxg , nyg , nzg ), absorbGLOBAL ( nxg , nyg , nzg )) end subroutine alloc_array","tags":"","loc":"proc/alloc_array.html"},{"title":"create_directory – signedMCRT","text":"private subroutine create_directory(name, flag, appendname, newline) Uses constants create directories if they don't exist Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name logical, intent(in) :: flag character(len=*), intent(in) :: appendname logical, intent(in), optional :: newline Contents Source Code create_directory Source Code subroutine create_directory ( name , flag , appendname , newline ) !! create directories if they don't exist use constants , only : fileplace character ( * ), intent ( in ) :: name , appendname logical , intent ( in ) :: flag logical , optional , intent ( in ) :: newline character ( len = :), allocatable :: mkdirCMD if (. not . flag ) then mkdirCMD = \"mkdir -p \" // trim ( fileplace ) // name call execute_command_line ( mkdirCMD ) ! output correct message for base data dir if ( len ( name ) == 0 ) then mkdirCMD = \"Created \" // appendname // \"data/\" else mkdirCMD = \"Created \" // appendname // name end if if ( newline ) mkdirCMD = mkdirCMD // new_line ( \"a\" ) print * , mkdirCMD end if end subroutine create_directory","tags":"","loc":"proc/create_directory.html"},{"title":"dealloc_array – signedMCRT","text":"public subroutine dealloc_array() Uses iarray deallocate data arrays Arguments None Contents Source Code dealloc_array Source Code subroutine dealloc_array () !! deallocate data arrays use iarray deallocate ( jmean ) deallocate ( jmeanGLOBAL ) deallocate ( absorb ) deallocate ( absorbGLOBAL ) deallocate ( phasor ) deallocate ( phasorGLOBAL ) end subroutine dealloc_array","tags":"","loc":"proc/dealloc_array.html"},{"title":"directory – signedMCRT","text":"public subroutine directory() Uses constants subroutine defines vars to hold paths to various folders Arguments None Contents Source Code directory Source Code subroutine directory () !! subroutine defines vars to hold paths to various folders use constants , only : homedir , fileplace , resdir character ( len = 256 ) :: cwd logical :: dataExists , jmeanExists , depositExists , detectorsExists , phasorExists !get current working directory call get_environment_variable ( 'PWD' , cwd ) ! get 'home' dir from cwd homedir = trim ( cwd ) ! get data dir fileplace = trim ( homedir ) // '/data/' !check if data directory and subdirectories exists. if not create it #ifdef __GFORTRAN__ inquire ( file = trim ( fileplace ) // \"/.\" , exist = dataExists ) inquire ( file = trim ( fileplace ) // \"/jmean/.\" , exist = jmeanExists ) inquire ( file = trim ( fileplace ) // \"/deposit/.\" , exist = depositExists ) inquire ( file = trim ( fileplace ) // \"/detectors/.\" , exist = detectorsExists ) inquire ( file = trim ( fileplace ) // \"/phasor/.\" , exist = phasorExists ) #elif __INTEL_COMPILER inquire ( directory = trim ( fileplace ), exist = dataExists ) inquire ( directory = trim ( fileplace ) // \"/jmean\" , exist = jmeanExists ) inquire ( directory = trim ( fileplace ) // \"/deposit\" , exist = depositExists ) inquire ( directory = trim ( fileplace ) // \"/detectors\" , exist = detectorsExists ) inquire ( directory = trim ( fileplace ) // \"/phasor\" , exist = phasorExists ) #else error stop \"Compiler not supported!\" #endif if (. not . dataExists ) then call create_directory ( \"\" , dataExists , \"\" , . false .) call create_directory ( \"jmean/\" , jmeanExists , \"data/\" , . false .) call create_directory ( \"deposit/\" , depositExists , \"data/\" , . false .) call create_directory ( \"detectors/\" , detectorsExists , \"data/\" , . false .) call create_directory ( \"phasor/\" , phasorExists , \"data/\" , . false .) else call create_directory ( \"jmean/\" , jmeanExists , \"data/\" , . true .) call create_directory ( \"deposit/\" , depositExists , \"data/\" , . true .) call create_directory ( \"detectors/\" , detectorsExists , \"data/\" , . true .) call create_directory ( \"phasor/\" , phasorExists , \"data/\" , . true .) end if ! get res dir resdir = trim ( homedir ) // '/res/' end subroutine directory","tags":"","loc":"proc/directory.html"},{"title":"setup_simulation – signedMCRT","text":"public subroutine setup_simulation(sdfarray, dict) Uses vector_class setupGeometry sim_state_mod sdfs Read in parameters\nSetup up various simulation parameters and routines Arguments Type Intent Optional Attributes Name type( sdf ), intent(out), allocatable :: sdfarray (:) output array of geometry type(toml_table), intent(inout), optional :: dict dictionary used to store metadata Contents Source Code setup_simulation Source Code subroutine setup_simulation ( sdfarray , dict ) !! Read in parameters !! Setup up various simulation parameters and routines use sdfs , only : sdf use setupGeometry use sim_state_mod , only : settings => state use vector_class !> dictionary used to store metadata type ( toml_table ), optional , intent ( INOUT ) :: dict !> output array of geometry type ( sdf ), allocatable , intent ( OUT ) :: sdfarray (:) !allocate and set arrays to 0 call alloc_array ( settings % grid % nxg , settings % grid % nyg , settings % grid % nzg ) call zarray () ! setup geometry using SDFs select case ( settings % experiment ) case ( \"logo\" ) sdfarray = setup_logo () case ( \"omg\" ) sdfarray = setup_omg_sdf () case ( \"scat_test\" ) sdfarray = setup_scat_test ( dict ) case ( \"scat_test2\" ) sdfarray = setup_scat_test2 ( dict ) case ( \"aptran\" ) sdfarray = setup_sphere () case ( \"vessels\" ) sdfarray = get_vessels () case ( \"sphere_scene\" ) sdfarray = setup_sphere_scene ( dict ) case ( \"test_egg\" ) sdfarray = setup_egg () case default error stop \"no such routine\" end select end subroutine setup_simulation","tags":"","loc":"proc/setup_simulation.html"},{"title":"zarray – signedMCRT","text":"private subroutine zarray() Uses iarray zero data arrays Arguments None Contents Source Code zarray Source Code subroutine zarray !! zero data arrays use iarray !sets all arrays to zer phasor = 0._wp phasorGLOBAL = 0._wp jmean = 0._wp jmeanGLOBAL = 0._wp absorb = 0.0_wp absorbGLOBAL = 0.0_wp end subroutine zarray","tags":"","loc":"proc/zarray.html"},{"title":"invert – signedMCRT","text":"public pure function invert(A) result(B) Performs a direct calculation of the inverse of a 4×4 matrix.\nfrom http://fortranwiki.org/fortran/show/Matrix+inversion Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: A (4,4) Input Matric Return Value real(kind=wp), (4,4) Contents Source Code invert Source Code pure function invert ( A ) result ( B ) !! Performs a direct calculation of the inverse of a 4×4 matrix. !! from http://fortranwiki.org/fortran/show/Matrix+inversion !> Input Matric real ( kind = wp ), intent ( in ) :: A ( 4 , 4 ) real ( kind = wp ) :: B ( 4 , 4 ) ! Inverse matrix real ( kind = wp ) :: detinv ! Calculate the inverse determinant of the matrix detinv = & 1._wp / ( A ( 1 , 1 ) * ( A ( 2 , 2 ) * ( A ( 3 , 3 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 3 )) + & A ( 2 , 3 ) * ( A ( 3 , 4 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 2 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 2 )))& - A ( 1 , 2 ) * ( A ( 2 , 1 ) * ( A ( 3 , 3 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 3 )) + & A ( 2 , 3 ) * ( A ( 3 , 4 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 1 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 1 )))& + A ( 1 , 3 ) * ( A ( 2 , 1 ) * ( A ( 3 , 2 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 2 )) + & A ( 2 , 2 ) * ( A ( 3 , 4 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 1 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 1 )))& - A ( 1 , 4 ) * ( A ( 2 , 1 ) * ( A ( 3 , 2 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 2 )) + & A ( 2 , 2 ) * ( A ( 3 , 3 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 3 )) + A ( 2 , 3 ) * ( A ( 3 , 1 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 1 )))) ! Calculate the inverse of the matrix B ( 1 , 1 ) = detinv * ( A ( 2 , 2 ) * ( A ( 3 , 3 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 3 )) + & A ( 2 , 3 ) * ( A ( 3 , 4 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 2 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 2 ))) B ( 2 , 1 ) = detinv * ( A ( 2 , 1 ) * ( A ( 3 , 4 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 4 )) + & A ( 2 , 3 ) * ( A ( 3 , 1 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 1 )) + A ( 2 , 4 ) * ( A ( 3 , 3 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 3 ))) B ( 3 , 1 ) = detinv * ( A ( 2 , 1 ) * ( A ( 3 , 2 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 2 )) + & A ( 2 , 2 ) * ( A ( 3 , 4 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 1 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 1 ))) B ( 4 , 1 ) = detinv * ( A ( 2 , 1 ) * ( A ( 3 , 3 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 3 )) + & A ( 2 , 2 ) * ( A ( 3 , 1 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 1 )) + A ( 2 , 3 ) * ( A ( 3 , 2 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 2 ))) B ( 1 , 2 ) = detinv * ( A ( 1 , 2 ) * ( A ( 3 , 4 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 4 )) + & A ( 1 , 3 ) * ( A ( 3 , 2 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 2 )) + A ( 1 , 4 ) * ( A ( 3 , 3 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 3 ))) B ( 2 , 2 ) = detinv * ( A ( 1 , 1 ) * ( A ( 3 , 3 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 3 )) + & A ( 1 , 3 ) * ( A ( 3 , 4 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 4 )) + A ( 1 , 4 ) * ( A ( 3 , 1 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 1 ))) B ( 3 , 2 ) = detinv * ( A ( 1 , 1 ) * ( A ( 3 , 4 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 4 )) + & A ( 1 , 2 ) * ( A ( 3 , 1 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 1 )) + A ( 1 , 4 ) * ( A ( 3 , 2 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 2 ))) B ( 4 , 2 ) = detinv * ( A ( 1 , 1 ) * ( A ( 3 , 2 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 2 )) + & A ( 1 , 2 ) * ( A ( 3 , 3 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 3 )) + A ( 1 , 3 ) * ( A ( 3 , 1 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 1 ))) B ( 1 , 3 ) = detinv * ( A ( 1 , 2 ) * ( A ( 2 , 3 ) * A ( 4 , 4 ) - A ( 2 , 4 ) * A ( 4 , 3 )) + & A ( 1 , 3 ) * ( A ( 2 , 4 ) * A ( 4 , 2 ) - A ( 2 , 2 ) * A ( 4 , 4 )) + A ( 1 , 4 ) * ( A ( 2 , 2 ) * A ( 4 , 3 ) - A ( 2 , 3 ) * A ( 4 , 2 ))) B ( 2 , 3 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 4 ) * A ( 4 , 3 ) - A ( 2 , 3 ) * A ( 4 , 4 )) + & A ( 1 , 3 ) * ( A ( 2 , 1 ) * A ( 4 , 4 ) - A ( 2 , 4 ) * A ( 4 , 1 )) + A ( 1 , 4 ) * ( A ( 2 , 3 ) * A ( 4 , 1 ) - A ( 2 , 1 ) * A ( 4 , 3 ))) B ( 3 , 3 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 2 ) * A ( 4 , 4 ) - A ( 2 , 4 ) * A ( 4 , 2 )) + & A ( 1 , 2 ) * ( A ( 2 , 4 ) * A ( 4 , 1 ) - A ( 2 , 1 ) * A ( 4 , 4 )) + A ( 1 , 4 ) * ( A ( 2 , 1 ) * A ( 4 , 2 ) - A ( 2 , 2 ) * A ( 4 , 1 ))) B ( 4 , 3 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 3 ) * A ( 4 , 2 ) - A ( 2 , 2 ) * A ( 4 , 3 )) + & A ( 1 , 2 ) * ( A ( 2 , 1 ) * A ( 4 , 3 ) - A ( 2 , 3 ) * A ( 4 , 1 )) + A ( 1 , 3 ) * ( A ( 2 , 2 ) * A ( 4 , 1 ) - A ( 2 , 1 ) * A ( 4 , 2 ))) B ( 1 , 4 ) = detinv * ( A ( 1 , 2 ) * ( A ( 2 , 4 ) * A ( 3 , 3 ) - A ( 2 , 3 ) * A ( 3 , 4 )) + & A ( 1 , 3 ) * ( A ( 2 , 2 ) * A ( 3 , 4 ) - A ( 2 , 4 ) * A ( 3 , 2 )) + A ( 1 , 4 ) * ( A ( 2 , 3 ) * A ( 3 , 2 ) - A ( 2 , 2 ) * A ( 3 , 3 ))) B ( 2 , 4 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 3 ) * A ( 3 , 4 ) - A ( 2 , 4 ) * A ( 3 , 3 )) + & A ( 1 , 3 ) * ( A ( 2 , 4 ) * A ( 3 , 1 ) - A ( 2 , 1 ) * A ( 3 , 4 )) + A ( 1 , 4 ) * ( A ( 2 , 1 ) * A ( 3 , 3 ) - A ( 2 , 3 ) * A ( 3 , 1 ))) B ( 3 , 4 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 4 ) * A ( 3 , 2 ) - A ( 2 , 2 ) * A ( 3 , 4 )) + & A ( 1 , 2 ) * ( A ( 2 , 1 ) * A ( 3 , 4 ) - A ( 2 , 4 ) * A ( 3 , 1 )) + A ( 1 , 4 ) * ( A ( 2 , 2 ) * A ( 3 , 1 ) - A ( 2 , 1 ) * A ( 3 , 2 ))) B ( 4 , 4 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 2 ) * A ( 3 , 3 ) - A ( 2 , 3 ) * A ( 3 , 2 )) + & A ( 1 , 2 ) * ( A ( 2 , 3 ) * A ( 3 , 1 ) - A ( 2 , 1 ) * A ( 3 , 3 )) + A ( 1 , 3 ) * ( A ( 2 , 1 ) * A ( 3 , 2 ) - A ( 2 , 2 ) * A ( 3 , 1 ))) end function invert","tags":"","loc":"proc/invert.html"},{"title":"mat_add_scal – signedMCRT","text":"private function mat_add_scal(a, b) Matrix + Scalar = Matrix Type Bound mat Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to add Return Value type( mat ) Contents Source Code mat_add_scal Source Code type ( mat ) function mat_add_scal ( a , b ) !! Matrix + Scalar = Matrix !> Input Matrix class ( mat ), intent ( IN ) :: a !> Scalar to add real ( kind = wp ), intent ( IN ) :: b mat_add_scal % vals = a % vals + b end function mat_add_scal","tags":"","loc":"proc/mat_add_scal.html"},{"title":"mat_div_scal – signedMCRT","text":"private function mat_div_scal(a, b) Matrix / scalar Type Bound mat Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to divide by Return Value type( mat ) Contents Source Code mat_div_scal Source Code type ( mat ) function mat_div_scal ( a , b ) !! Matrix / scalar !> Input Matrix class ( mat ), intent ( IN ) :: a !> Scalar to divide by real ( kind = wp ), intent ( IN ) :: b mat_div_scal % vals = a % vals / b end function mat_div_scal","tags":"","loc":"proc/mat_div_scal.html"},{"title":"mat_init – signedMCRT","text":"private function mat_init(array) Initalise matrix type from 1D array Arguments Type Intent Optional Attributes Name real(kind=wp) :: array (16) 1D array to initalise from. Return Value type( mat ) Contents Source Code mat_init Source Code type ( mat ) function mat_init ( array ) !! Initalise matrix type from 1D array !> 1D array to initalise from. real ( kind = wp ) :: array ( 16 ) integer :: i , cnt cnt = 1 do i = 1 , 4 mat_init % vals (:, i ) = array ( cnt : cnt + 3 ) cnt = cnt + 4 end do end function mat_init","tags":"","loc":"proc/mat_init.html"},{"title":"mat_minus_scal – signedMCRT","text":"private function mat_minus_scal(a, b) Matrix - Scalar Type Bound mat Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( mat ) Contents Source Code mat_minus_scal Source Code type ( mat ) function mat_minus_scal ( a , b ) !! Matrix - Scalar !> Input Matrix class ( mat ), intent ( IN ) :: a !> Scalar to subtract real ( kind = wp ), intent ( IN ) :: b mat_minus_scal % vals = a % vals - b end function mat_minus_scal","tags":"","loc":"proc/mat_minus_scal.html"},{"title":"mat_mult_mat – signedMCRT","text":"private function mat_mult_mat(a, b) Uses vec4_class Matrix * vec4 Type Bound mat Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix type( vec4 ), intent(in) :: b Vec4 to multiply by Return Value type( vec4 ) Contents Source Code mat_mult_mat Source Code type ( vec4 ) function mat_mult_mat ( a , b ) !! Matrix * vec4 use vec4_class !> Input Matrix class ( mat ), intent ( IN ) :: a !> Vec4 to multiply by type ( vec4 ), intent ( IN ) :: b real ( kind = wp ) :: tmp ( 4 ) tmp = matmul ( a % vals , [ b % x , b % y , b % z , b % p ]) mat_mult_mat = vec4 ( tmp ( 1 ), tmp ( 2 ), tmp ( 3 ), tmp ( 4 )) end function mat_mult_mat","tags":"","loc":"proc/mat_mult_mat.html"},{"title":"mat_mult_scal – signedMCRT","text":"private function mat_mult_scal(a, b) Matrix * Scalar Type Bound mat Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( mat ) Contents Source Code mat_mult_scal Source Code type ( mat ) function mat_mult_scal ( a , b ) !! Matrix * Scalar !> Input Matrix class ( mat ), intent ( IN ) :: a !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: b mat_mult_scal % vals = a % vals * b end function mat_mult_scal","tags":"","loc":"proc/mat_mult_scal.html"},{"title":"scal_add_mat – signedMCRT","text":"private function scal_add_mat(a, b) Scaler + Matrix Type Bound mat Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalat to add class( mat ), intent(in) :: b Input Matrix Return Value type( mat ) Contents Source Code scal_add_mat Source Code type ( mat ) function scal_add_mat ( a , b ) !! Scaler + Matrix !> Input Matrix class ( mat ), intent ( IN ) :: b !> Scalat to add real ( kind = wp ), intent ( IN ) :: a scal_add_mat % vals = b % vals + a end function scal_add_mat","tags":"","loc":"proc/scal_add_mat.html"},{"title":"scal_mult_mat – signedMCRT","text":"private function scal_mult_mat(a, b) Matrix * Scalar Type Bound mat Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( mat ), intent(in) :: b Input Matrix Return Value type( mat ) Contents Source Code scal_mult_mat Source Code type ( mat ) function scal_mult_mat ( a , b ) !! Matrix * Scalar !> Input Matrix class ( mat ), intent ( IN ) :: b !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: a scal_mult_mat % vals = b % vals * a end function scal_mult_mat","tags":"","loc":"proc/scal_mult_mat.html"},{"title":"mat – signedMCRT","text":"public interface mat Intalise Matrix with 1D Array Contents Module Procedures mat_init Module Procedures private function mat_init (array) Initalise matrix type from 1D array Arguments Type Intent Optional Attributes Name real(kind=wp) :: array (16) 1D array to initalise from. Return Value type( mat )","tags":"","loc":"interface/mat.html"},{"title":"histempty_fn – signedMCRT","text":"private function histempty_fn(this) Type Bound history_stack_t Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Return Value logical Contents Source Code histempty_fn Source Code logical function histempty_fn ( this ) class ( history_stack_t ) :: this histempty_fn = ( this % size == 0 . or . . not . allocated ( this % data )) end function histempty_fn","tags":"","loc":"proc/histempty_fn.html"},{"title":"histpeek_fn – signedMCRT","text":"private function histpeek_fn(this) Type Bound history_stack_t Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Return Value type( vec4 ) Contents Source Code histpeek_fn Source Code type ( vec4 ) function histpeek_fn ( this ) class ( history_stack_t ) :: this if ( this % size == 0 . or . . not . allocated ( this % data )) then histpeek_fn = vec4 ( - 9 9._wp , - 9 9._wp , - 9 9._wp , - 9 9._wp ) return end if histpeek_fn = this % data ( this % size ) end function histpeek_fn","tags":"","loc":"proc/histpeek_fn.html"},{"title":"histpop_fn – signedMCRT","text":"private function histpop_fn(this) Type Bound history_stack_t Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Return Value type( vec4 ) Contents Source Code histpop_fn Source Code type ( vec4 ) function histpop_fn ( this ) class ( history_stack_t ) :: this if ( this % size == 0 . or . . not . allocated ( this % data )) then histpop_fn = vec4 ( - 9 9._wp , - 9 9._wp , - 9 9._wp , - 9 9._wp ) return end if histpop_fn = this % data ( this % size ) this % size = this % size - 1 end function histpop_fn","tags":"","loc":"proc/histpop_fn.html"},{"title":"init_historyStack – signedMCRT","text":"private function init_historyStack(filename, id) Uses constants utils Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: filename integer, intent(in) :: id Return Value type( history_stack_t ) Contents Source Code init_historyStack Source Code type ( history_stack_t ) function init_historyStack ( filename , id ) use utils , only : str use constants , only : fileplace character ( * ), intent ( in ) :: filename integer , intent ( in ) :: id character ( len = :), allocatable :: new_filename integer :: idx logical :: res idx = index ( filename , \".\" ) new_filename = filename ( 1 : idx - 1 ) // \"_\" // str ( id , 3 ) // filename ( idx :) init_historyStack % filename = new_filename if ( index ( new_filename , \"obj\" ) /= 0 ) then init_historyStack % type = \"obj\" elseif ( index ( new_filename , \"ply\" ) /= 0 ) then init_historyStack % type = \"ply\" elseif ( index ( new_filename , \"json\" ) /= 0 ) then init_historyStack % type = \"json\" else error stop \"Unsupported filetype for track History!\" end if inquire ( file = trim ( fileplace ) // new_filename , exist = res ) if ( res ) then print * , \"Deleting existing trackHistory files!\" call execute_command_line ( \"rm \" // trim ( fileplace ) // new_filename ) call execute_command_line ( \"rm \" // trim ( fileplace ) // \"scalars000.dat\" ) call execute_command_line ( \"rm \" // trim ( fileplace ) // new_filename // \"2\" ) end if init_historyStack % size = 0 init_historyStack % vertex_counter = 0 init_historyStack % edge_counter = 0 end function init_historyStack","tags":"","loc":"proc/init_historystack.html"},{"title":"histfinish_sub – signedMCRT","text":"private subroutine histfinish_sub(this) Uses constants utils Type Bound history_stack_t Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Contents Source Code histfinish_sub Source Code subroutine histfinish_sub ( this ) use constants , only : fileplace use utils , only : str class ( history_stack_t ) :: this integer :: u select case ( trim ( this % type )) case ( \"obj\" ) call execute_command_line ( \"cat \" // trim ( fileplace ) // this % filename // \"2 >> \" // trim ( fileplace ) // this % filename ) case ( \"ply\" ) ! this is the easiest way to edit the vertex count as we don't know how many photons we will track when writing the header. ! this saves storing all photons data in RAM for duration of simulation. ! taken from: https://stackoverflow.com/a/11145362 call execute_command_line ( \"sed -i '3s#.*#element vertex \" // str ( this % vertex_counter ) // \"#' \" // trim ( fileplace ) // this % filename ) call execute_command_line ( \"sed -i '7s#.*#element edge \" // str ( this % edge_counter ) // \"#' \" // trim ( fileplace ) // this % filename ) call execute_command_line ( \"cat \" // trim ( fileplace ) // this % filename // \"2 >> \" // trim ( fileplace ) // this % filename ) case ( \"json\" ) open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"old\" , position = \"append\" ) write ( u , \"(a)\" ) \"}\" close ( u ) case default error stop \"No such output type \" // this % type end select end subroutine histfinish_sub","tags":"","loc":"proc/histfinish_sub.html"},{"title":"histpush_sub – signedMCRT","text":"private subroutine histpush_sub(this, val) Type Bound history_stack_t Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this type( vec4 ), intent(in) :: val Contents Source Code histpush_sub Source Code subroutine histpush_sub ( this , val ) class ( history_stack_t ) :: this type ( vec4 ), intent ( in ) :: val type ( vec4 ), allocatable :: tmp (:) if (. not . allocated ( this % data ) . or . size ( this % data ) == 0 ) then !allocate space if not yet allocated allocate ( this % data ( block_size )) elseif ( this % size == size ( this % data )) then allocate ( tmp ( size ( this % data ) + block_size )) tmp ( 1 : this % size ) = this % data call move_alloc ( tmp , this % data ) end if this % size = this % size + 1 this % data ( this % size ) = val end subroutine histpush_sub","tags":"","loc":"proc/histpush_sub.html"},{"title":"histwrite_sub – signedMCRT","text":"private subroutine histwrite_sub(this) Type Bound history_stack_t Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Contents Source Code histwrite_sub Source Code subroutine histwrite_sub ( this ) class ( history_stack_t ) :: this select case ( this % type ) case ( \"obj\" ) call obj_writer ( this ) case ( \"ply\" ) call ply_writer ( this ) case ( \"json\" ) call json_writer ( this ) case default error stop \"No such output type \" // this % type end select end subroutine histwrite_sub","tags":"","loc":"proc/histwrite_sub.html"},{"title":"histzero_sub – signedMCRT","text":"private subroutine histzero_sub(this) Type Bound history_stack_t Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Contents Source Code histzero_sub Source Code subroutine histzero_sub ( this ) class ( history_stack_t ) :: this if ( allocated ( this % data )) deallocate ( this % data ) this % size = 0 end subroutine histzero_sub","tags":"","loc":"proc/histzero_sub.html"},{"title":"json_writer – signedMCRT","text":"private subroutine json_writer(this) Uses constants utils Arguments Type Intent Optional Attributes Name type( history_stack_t ), intent(inout) :: this Contents Source Code json_writer Source Code subroutine json_writer ( this ) use constants , only : fileplace use utils , only : str type ( history_stack_t ), intent ( inout ) :: this logical :: res integer :: id , u integer , save :: counter = 0 type ( vec4 ) :: v id = 0 !omp_() if ( id == 0 ) then inquire ( file = trim ( fileplace ) // this % filename , exist = res ) if ( res ) then open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"old\" , position = \"append\" ) write ( u , \"(a)\" ) \",\" // new_line ( \"a\" ) // '\"' // str ( counter ) // '_' // str ( id ) // '\": ' // \"[\" else open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"new\" ) write ( u , \"(a)\" ) \"{\" // new_line ( \"a\" ) // '\"' // str ( counter ) // '_' // str ( id ) // '\": ' // \"[\" end if counter = counter + 1 do while (. not . this % empty ()) v = this % pop () if ( this % size /= 0 ) then write ( u , \"(a,3(es15.8e2,a))\" ) \"[\" , v % x , \",\" , v % y , \",\" , v % z , \"],\" else write ( u , \"(a,3(es15.8e2,a))\" ) \"[\" , v % x , \",\" , v % y , \",\" , v % z , \"]\" end if end do write ( u , \"(a)\" ) \"]\" close ( u ) end if end subroutine json_writer","tags":"","loc":"proc/json_writer.html"},{"title":"obj_writer – signedMCRT","text":"private subroutine obj_writer(this) Uses omp_lib constants utils Arguments Type Intent Optional Attributes Name type( history_stack_t ), intent(inout) :: this Contents Source Code obj_writer Source Code subroutine obj_writer ( this ) use constants , only : fileplace use utils , only : str use omp_lib type ( history_stack_t ), intent ( inout ) :: this type ( vec4 ) :: v integer :: u , io , id , counter , ioi logical :: res id = 0 inquire ( file = trim ( fileplace ) // this % filename , exist = res ) if ( res ) then open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"old\" , position = \"append\" ) open ( newunit = io , file = trim ( fileplace ) // this % filename // \"2\" , status = \"old\" , position = \"append\" ) open ( newunit = ioi , file = trim ( fileplace ) // \"scalars\" // str ( id , 3 ) // \".dat\" , status = \"old\" , position = \"append\" ) else open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"new\" ) open ( newunit = io , file = trim ( fileplace ) // this % filename // \"2\" , status = \"new\" ) open ( newunit = ioi , file = trim ( fileplace ) // \"scalars\" // str ( id , 3 ) // \".dat\" , status = \"new\" ) end if v = this % pop () ! write lines if ( this % size >= 1 ) write ( io , \"(a)\" , advance = \"no\" ) \"l \" do counter = this % vertex_counter + 1 , this % vertex_counter + this % size , 2 write ( io , \"(2(i0,1x))\" , advance = \"no\" ) counter , counter + 1 end do close ( io ) !write vertices do while (. not . this % empty ()) v = this % pop () write ( u , \"(a,1x,3(es15.8e2,1x))\" ) \"v\" , v % x , v % y , v % z write ( ioi , \"(es15.8e2)\" ) v % p this % vertex_counter = this % vertex_counter + 1 end do close ( u ) close ( ioi ) end subroutine obj_writer","tags":"","loc":"proc/obj_writer.html"},{"title":"ply_writer – signedMCRT","text":"private subroutine ply_writer(this) Uses constants utils Arguments Type Intent Optional Attributes Name type( history_stack_t ), intent(inout) :: this Contents Source Code ply_writer Source Code subroutine ply_writer ( this ) use constants , only : fileplace use utils , only : str type ( history_stack_t ), intent ( inout ) :: this integer :: io , counter , i , u logical :: res type ( vec4 ) :: v inquire ( file = trim ( fileplace ) // this % filename , exist = res ) if ( res ) then open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"old\" , position = \"append\" ) else open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"new\" ) write ( u , \"(a)\" ) \"ply\" // new_line ( \"a\" ) // \"format ascii 1.0\" // new_line ( \"a\" ) // \"element vertex \" // str ( this % size ) write ( u , \"(a)\" ) \"property float x\" write ( u , \"(a)\" ) \"property float y\" write ( u , \"(a)\" ) \"property float z\" write ( u , \"(a)\" ) \"element edge\" write ( u , \"(a)\" ) \"property int vertex1\" write ( u , \"(a)\" ) \"property int vertex2\" write ( u , \"(a)\" ) \"end_header\" end if inquire ( file = trim ( fileplace ) // this % filename // \"2\" , exist = res ) if ( res ) then open ( newunit = io , file = trim ( fileplace ) // this % filename // \"2\" , status = \"old\" , position = \"append\" ) else open ( newunit = io , file = trim ( fileplace ) // this % filename // \"2\" , status = \"new\" ) end if counter = this % vertex_counter do i = 1 , this % size - 1 write ( io , \"(2(i0,1x))\" ) counter , counter + 1 counter = counter + 1 this % edge_counter = this % edge_counter + 1 end do close ( io ) do while (. not . this % empty ()) v = this % pop () write ( u , \"(3(es15.8e2,1x))\" ) v % x , v % y , v % z this % vertex_counter = this % vertex_counter + 1 end do close ( u ) end subroutine ply_writer","tags":"","loc":"proc/ply_writer.html"},{"title":"history_stack_t – signedMCRT","text":"public interface history_stack_t Contents Module Procedures init_historyStack Module Procedures private function init_historyStack (filename, id) Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: filename integer, intent(in) :: id Return Value type( history_stack_t )","tags":"","loc":"interface/history_stack_t.html"},{"title":"abs_vec – signedMCRT","text":"private pure elemental function abs_vec(this) Calculate the absoulte of a vector elementwise Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value type( vector ) Contents Source Code abs_vec Source Code type ( vector ) pure elemental function abs_vec ( this ) !! Calculate the absoulte of a vector elementwise !> Input vector type ( vector ), intent ( IN ) :: this abs_vec = vector ( abs ( this % x ), abs ( this % y ), abs ( this % z )) end function abs_vec","tags":"","loc":"proc/abs_vec.html"},{"title":"length – signedMCRT","text":"public pure elemental function length(this) Returns the length of a vec3 Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: this Return Value real(kind=wp) Contents","tags":"","loc":"proc/length.html"},{"title":"magnitude – signedMCRT","text":"public pure elemental function magnitude(this) Returns the magnitude of a vec3 Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: this Return Value type( vector ) Contents Source Code magnitude Source Code type ( vector ) pure elemental function magnitude ( this ) !! Returns the magnitude of a vec3 class ( vector ), intent ( in ) :: this real ( kind = wp ) :: tmp tmp = this % length () magnitude = this / tmp end function magnitude","tags":"","loc":"proc/magnitude.html"},{"title":"max_vec – signedMCRT","text":"private pure elemental function max_vec(this, val) Get the max value elementwise between a vec3 and a scalar Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector real(kind=wp), intent(in) :: val Input max value Return Value type( vector ) Contents Source Code max_vec Source Code type ( vector ) pure elemental function max_vec ( this , val ) !! Get the max value elementwise between a vec3 and a scalar !> Input vector type ( vector ), intent ( IN ) :: this !> Input max value real ( kind = wp ), intent ( IN ) :: val max_vec = vector ( max ( this % x , val ), max ( this % y , val ), max ( this % z , val )) end function max_vec","tags":"","loc":"proc/max_vec.html"},{"title":"maxval_vec – signedMCRT","text":"private pure elemental function maxval_vec(this) Get the max value in a vec3 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value real(kind=wp) Contents","tags":"","loc":"proc/maxval_vec.html"},{"title":"min_vec – signedMCRT","text":"private pure elemental function min_vec(this, val) Get the min value elementwise between a vec3 and a scalar Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector real(kind=wp), intent(in) :: val Input minimum value Return Value type( vector ) Contents Source Code min_vec Source Code type ( vector ) pure elemental function min_vec ( this , val ) !! Get the min value elementwise between a vec3 and a scalar !> Input vector type ( vector ), intent ( IN ) :: this !> Input minimum value real ( kind = wp ), intent ( IN ) :: val min_vec = vector ( min ( this % x , val ), min ( this % y , val ), min ( this % z , val )) end function min_vec","tags":"","loc":"proc/min_vec.html"},{"title":"minval_vec – signedMCRT","text":"private pure elemental function minval_vec(this) Get the min value in a vec3 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value real(kind=wp) Contents","tags":"","loc":"proc/minval_vec.html"},{"title":"nint_vec – signedMCRT","text":"private pure elemental function nint_vec(this) Overload the nint intrinsic for a vec3 elementwise Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value type( vector ) Contents Source Code nint_vec Source Code type ( vector ) pure elemental function nint_vec ( this ) !! Overload the nint intrinsic for a vec3 elementwise !> Input vector type ( vector ), intent ( IN ) :: this nint_vec = vector ( real ( nint ( this % x ), kind = wp ), real ( nint ( this % y ), kind = wp ), real ( nint ( this % z ), kind = wp )) end function nint_vec","tags":"","loc":"proc/nint_vec.html"},{"title":"scal_add_vec – signedMCRT","text":"private pure elemental function scal_add_vec(a, b) vec3 + scalar Type Bound vector Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to add class( vector ), intent(in) :: b Input vector Return Value type( vector ) Contents Source Code scal_add_vec Source Code type ( vector ) pure elemental function scal_add_vec ( a , b ) !! vec3 + scalar !> Input vector class ( vector ), intent ( IN ) :: b !> Scalar to add real ( kind = wp ), intent ( IN ) :: a scal_add_vec = vector ( b % x + a , b % y + a , b % z + a ) end function scal_add_vec","tags":"","loc":"proc/scal_add_vec.html"},{"title":"scal_minus_vec – signedMCRT","text":"private pure elemental function scal_minus_vec(a, b) scalar - vec3 Type Bound vector Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to subtract from class( vector ), intent(in) :: b Input vector Return Value type( vector ) Contents Source Code scal_minus_vec Source Code type ( vector ) pure elemental function scal_minus_vec ( a , b ) !! scalar - vec3 !> Input vector class ( vector ), intent ( IN ) :: b !> Scalar to subtract from real ( kind = wp ), intent ( IN ) :: a scal_minus_vec = vector ( a - b % x , a - b % y , a - b % z ) end function scal_minus_vec","tags":"","loc":"proc/scal_minus_vec.html"},{"title":"scal_mult_vec – signedMCRT","text":"private pure elemental function scal_mult_vec(a, b) Scalar * vec3 elementwise Type Bound vector Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( vector ), intent(in) :: b input vec3 Return Value type( vector ) Contents Source Code scal_mult_vec Source Code type ( vector ) pure elemental function scal_mult_vec ( a , b ) !! Scalar * vec3 elementwise !> input vec3 class ( vector ), intent ( IN ) :: b !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: a scal_mult_vec = vector ( a * b % x , a * b % y , a * b % z ) end function scal_mult_vec","tags":"","loc":"proc/scal_mult_vec.html"},{"title":"vec_add_scal – signedMCRT","text":"private pure elemental function vec_add_scal(a, b) vec3 + scalar Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector real(kind=wp), intent(in) :: b Scalar to add Return Value type( vector ) Contents Source Code vec_add_scal Source Code type ( vector ) pure elemental function vec_add_scal ( a , b ) !! vec3 + scalar !> Input vector class ( vector ), intent ( IN ) :: a !> Scalar to add real ( kind = wp ), intent ( IN ) :: b vec_add_scal = vector ( a % x + b , a % y + b , a % z + b ) end function vec_add_scal","tags":"","loc":"proc/vec_add_scal.html"},{"title":"vec_add_vec – signedMCRT","text":"private pure elemental function vec_add_vec(a, b) vec3 + vec3 Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b Vec3 to add Return Value type( vector ) Contents Source Code vec_add_vec Source Code type ( vector ) pure elemental function vec_add_vec ( a , b ) !! vec3 + vec3 !> Input vector class ( vector ), intent ( IN ) :: a !> Vec3 to add type ( vector ), intent ( IN ) :: b vec_add_vec = vector ( a % x + b % x , a % y + b % y , a % z + b % z ) end function vec_add_vec","tags":"","loc":"proc/vec_add_vec.html"},{"title":"vec_cross_vec – signedMCRT","text":"private pure elemental function vec_cross_vec(a, b) result(cross) vec3 x vec3 Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b vec3 to cross with Return Value type( vector ) Contents Source Code vec_cross_vec Source Code pure elemental function vec_cross_vec ( a , b ) result ( cross ) !! vec3 x vec3 !> Input vector class ( vector ), intent ( in ) :: a !> vec3 to cross with type ( vector ), intent ( in ) :: b type ( vector ) :: cross cross % x = a % y * b % z - a % z * b % y cross % y = - a % x * b % z + a % z * b % x cross % z = a % x * b % y - a % y * b % x end function vec_cross_vec","tags":"","loc":"proc/vec_cross_vec.html"},{"title":"vec_div_scal_int – signedMCRT","text":"private pure elemental function vec_div_scal_int(a, b) vec3 / scalar elementwise. Scalar is an integer Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 integer, intent(in) :: b Scalar to divide by Return Value type( vector ) Contents Source Code vec_div_scal_int Source Code type ( vector ) pure elemental function vec_div_scal_int ( a , b ) !! vec3 / scalar elementwise. Scalar is an integer !> input vec3 class ( vector ), intent ( IN ) :: a !> Scalar to divide by integer , intent ( IN ) :: b vec_div_scal_int = vector ( a % x / real ( b , kind = wp ), a % y / real ( b , kind = wp ), a % z / real ( b , kind = wp )) end function vec_div_scal_int","tags":"","loc":"proc/vec_div_scal_int.html"},{"title":"vec_div_scal_r4 – signedMCRT","text":"private pure elemental function vec_div_scal_r4(a, b) Uses constants vec3 / scalar elementwise. Scalar is a 32-bit float Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=sp), intent(in) :: b Scalar to divide by Return Value type( vector ) Contents Source Code vec_div_scal_r4 Source Code type ( vector ) pure elemental function vec_div_scal_r4 ( a , b ) !! vec3 / scalar elementwise. Scalar is a 32-bit float use constants , only : sp !> input vec3 class ( vector ), intent ( IN ) :: a !> Scalar to divide by real ( kind = sp ), intent ( IN ) :: b vec_div_scal_r4 = vector ( a % x / b , a % y / b , a % z / b ) end function vec_div_scal_r4","tags":"","loc":"proc/vec_div_scal_r4.html"},{"title":"vec_div_scal_r8 – signedMCRT","text":"private pure elemental function vec_div_scal_r8(a, b) Uses constants vec3 / scalar elementwise. Scalar is a 64-bit float Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=dp), intent(in) :: b Scalar to divide by Return Value type( vector ) Contents Source Code vec_div_scal_r8 Source Code type ( vector ) pure elemental function vec_div_scal_r8 ( a , b ) !! vec3 / scalar elementwise. Scalar is a 64-bit float use constants , only : dp !> input vec3 class ( vector ), intent ( IN ) :: a !> Scalar to divide by real ( kind = dp ), intent ( IN ) :: b vec_div_scal_r8 = vector ( a % x / b , a % y / b , a % z / b ) end function vec_div_scal_r8","tags":"","loc":"proc/vec_div_scal_r8.html"},{"title":"vec_dot_mat – signedMCRT","text":"private pure function vec_dot_mat(a, b) result(dot) vec3 . matrix Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3 real(kind=wp), intent(in) :: b (4,4) Matrix to dot with Return Value type( vector ) Contents Source Code vec_dot_mat Source Code pure function vec_dot_mat ( a , b ) result ( dot ) !! vec3 . matrix !> Input vec3 class ( vector ), intent ( IN ) :: a !> Matrix to dot with real ( kind = wp ), intent ( IN ) :: b ( 4 , 4 ) type ( vector ) :: dot dot % x = b ( 1 , 1 ) * a % x + b ( 2 , 1 ) * a % y + b ( 3 , 1 ) * a % z + b ( 4 , 1 ) * 1. dot % y = b ( 1 , 2 ) * a % x + b ( 2 , 2 ) * a % y + b ( 3 , 2 ) * a % z + b ( 4 , 2 ) * 1. dot % z = b ( 1 , 3 ) * a % x + b ( 2 , 3 ) * a % y + b ( 3 , 3 ) * a % z + b ( 4 , 3 ) * 1. end function vec_dot_mat","tags":"","loc":"proc/vec_dot_mat.html"},{"title":"vec_dot_vec – signedMCRT","text":"private pure elemental function vec_dot_vec(a, b) result(dot) vec3 . vec3 Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3 type( vector ), intent(in) :: b vec3 to dot Return Value real(kind=wp) Contents Source Code vec_dot_vec Source Code pure elemental function vec_dot_vec ( a , b ) result ( dot ) !! vec3 . vec3 !> Input vec3 class ( vector ), intent ( IN ) :: a !> vec3 to dot type ( vector ), intent ( IN ) :: b real ( kind = wp ) :: dot dot = ( a % x * b % x ) + ( a % y * b % y ) + ( a % z * b % z ) end function vec_dot_vec","tags":"","loc":"proc/vec_dot_vec.html"},{"title":"vec_equal_vec – signedMCRT","text":"private pure elemental function vec_equal_vec(a, b) vec3 == vec3 Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3s class( vector ), intent(in) :: b Input vec3s Return Value logical Contents Source Code vec_equal_vec Source Code logical pure elemental function vec_equal_vec ( a , b ) !! vec3 == vec3 !> Input vec3s class ( vector ), intent ( in ) :: a , b vec_equal_vec = . false . if ( a % x == b % x ) then if ( a % y == b % y ) then if ( a % z == b % z ) then vec_equal_vec = . true . end if end if end if end function vec_equal_vec","tags":"","loc":"proc/vec_equal_vec.html"},{"title":"vec_minus_scal – signedMCRT","text":"private pure elemental function vec_minus_scal(a, b) vec3 - scalar Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( vector ) Contents Source Code vec_minus_scal Source Code type ( vector ) pure elemental function vec_minus_scal ( a , b ) !! vec3 - scalar !> Input vector class ( vector ), intent ( IN ) :: a !> Scalar to subtract real ( kind = wp ), intent ( IN ) :: b vec_minus_scal = vector ( a % x - b , a % y - b , a % z - b ) end function vec_minus_scal","tags":"","loc":"proc/vec_minus_scal.html"},{"title":"vec_minus_vec – signedMCRT","text":"private pure elemental function vec_minus_vec(a, b) vec3 - vec3 Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b vec3 to subtract Return Value type( vector ) Contents Source Code vec_minus_vec Source Code type ( vector ) pure elemental function vec_minus_vec ( a , b ) !! vec3 - vec3 !> Input vector class ( vector ), intent ( IN ) :: a !> vec3 to subtract type ( vector ), intent ( IN ) :: b vec_minus_vec = vector ( a % x - b % x , a % y - b % y , a % z - b % z ) end function vec_minus_vec","tags":"","loc":"proc/vec_minus_vec.html"},{"title":"vec_mult_exp_scal_int – signedMCRT","text":"private pure elemental function vec_mult_exp_scal_int(a, b) vec3**scalar for integer scalar Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector integer, intent(in) :: b Input scalar Return Value type( vector ) Contents Source Code vec_mult_exp_scal_int Source Code type ( vector ) pure elemental function vec_mult_exp_scal_int ( a , b ) !! vec3**scalar for integer scalar !> Input Vector class ( vector ), intent ( in ) :: a !> Input scalar integer , intent ( in ) :: b vec_mult_exp_scal_int = vector ( a % x ** b , a % y ** b , a % z ** b ) end function vec_mult_exp_scal_int","tags":"","loc":"proc/vec_mult_exp_scal_int.html"},{"title":"vec_mult_exp_scal_r4 – signedMCRT","text":"private pure elemental function vec_mult_exp_scal_r4(a, b) Uses constants vec3**scalar for 32-bit float scalar Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector real(kind=sp), intent(in) :: b Input scalar Return Value type( vector ) Contents Source Code vec_mult_exp_scal_r4 Source Code type ( vector ) pure elemental function vec_mult_exp_scal_r4 ( a , b ) !! vec3**scalar for 32-bit float scalar use constants , only : sp !> Input Vector class ( vector ), intent ( in ) :: a !> Input scalar real ( kind = sp ), intent ( in ) :: b vec_mult_exp_scal_r4 = vector ( a % x ** b , a % y ** b , a % z ** b ) end function vec_mult_exp_scal_r4","tags":"","loc":"proc/vec_mult_exp_scal_r4.html"},{"title":"vec_mult_exp_scal_r8 – signedMCRT","text":"private pure elemental function vec_mult_exp_scal_r8(a, b) Uses constants vec3**scalar for 64-bit float scalar Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector real(kind=dp), intent(in) :: b Input scalar Return Value type( vector ) Contents Source Code vec_mult_exp_scal_r8 Source Code type ( vector ) pure elemental function vec_mult_exp_scal_r8 ( a , b ) !! vec3**scalar for 64-bit float scalar use constants , only : dp !> Input Vector class ( vector ), intent ( in ) :: a !> Input scalar real ( kind = dp ), intent ( in ) :: b vec_mult_exp_scal_r8 = vector ( a % x ** b , a % y ** b , a % z ** b ) end function vec_mult_exp_scal_r8","tags":"","loc":"proc/vec_mult_exp_scal_r8.html"},{"title":"vec_mult_scal – signedMCRT","text":"private pure elemental function vec_mult_scal(a, b) vec3 * scalar elementwise Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( vector ) Contents Source Code vec_mult_scal Source Code type ( vector ) pure elemental function vec_mult_scal ( a , b ) !! vec3 * scalar elementwise !> input vec3 class ( vector ), intent ( IN ) :: a !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: b vec_mult_scal = vector ( a % x * b , a % y * b , a % z * b ) end function vec_mult_scal","tags":"","loc":"proc/vec_mult_scal.html"},{"title":"vec_mult_vec – signedMCRT","text":"private pure elemental function vec_mult_vec(a, b) vec3 * vec3 elementwise Type Bound vector Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 type( vector ), intent(in) :: b vec3 to multiply by Return Value type( vector ) Contents Source Code vec_mult_vec Source Code type ( vector ) pure elemental function vec_mult_vec ( a , b ) !! vec3 * vec3 elementwise !> input vec3 class ( vector ), intent ( IN ) :: a !> vec3 to multiply by type ( vector ), intent ( IN ) :: b vec_mult_vec = vector ( a % x * b % x , a % y * b % y , a % z * b % z ) end function vec_mult_vec","tags":"","loc":"proc/vec_mult_vec.html"},{"title":"abs – signedMCRT","text":"public interface abs Overload of the abs intrinsic for a vec3 Contents Module Procedures abs_vec Module Procedures private pure elemental function abs_vec (this) Calculate the absoulte of a vector elementwise Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value type( vector )","tags":"","loc":"interface/abs.html"},{"title":"max – signedMCRT","text":"public interface max Overload of the max intrinsic for a vec3 Contents Module Procedures max_vec maxval_vec Module Procedures private pure elemental function max_vec (this, val) Get the max value elementwise between a vec3 and a scalar Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector real(kind=wp), intent(in) :: val Input max value Return Value type( vector ) private pure elemental function maxval_vec (this) Get the max value in a vec3 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value real(kind=wp)","tags":"","loc":"interface/max.html"},{"title":"min – signedMCRT","text":"public interface min Overload of the min intrinsic for a vec3 Contents Module Procedures min_vec minval_vec Module Procedures private pure elemental function min_vec (this, val) Get the min value elementwise between a vec3 and a scalar Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector real(kind=wp), intent(in) :: val Input minimum value Return Value type( vector ) private pure elemental function minval_vec (this) Get the min value in a vec3 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value real(kind=wp)","tags":"","loc":"interface/min.html"},{"title":"nint – signedMCRT","text":"public interface nint Overload of the nint intrinsic for a vec3 Contents Module Procedures nint_vec Module Procedures private pure elemental function nint_vec (this) Overload the nint intrinsic for a vec3 elementwise Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value type( vector )","tags":"","loc":"interface/nint.html"},{"title":"check_file – signedMCRT","text":"private function check_file(file) result(res) Functional wrapper around inquire to check if file exits Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: file file to be checked Return Value logical Contents Source Code check_file Source Code logical function check_file ( file ) result ( res ) !! Functional wrapper around inquire to check if file exits !> file to be checked character ( len =* ), intent ( IN ) :: file inquire ( file = trim ( file ), exist = res ) end function check_file","tags":"","loc":"proc/check_file.html"},{"title":"get_new_file_name – signedMCRT","text":"private function get_new_file_name(file) result(res) Uses utils If file exits, get numeral to append to filename Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: file file to be checked Return Value character(len=:), allocatable Contents Source Code get_new_file_name Source Code function get_new_file_name ( file ) result ( res ) !! If file exits, get numeral to append to filename use utils , only : str !> file to be checked character ( len =* ), intent ( IN ) :: file character ( len = :), allocatable :: res integer :: pos , i i = 1 do pos = scan ( trim ( file ), \".\" , back = . true .) res = file ( 1 : pos - 1 ) // \" (\" // str ( i ) // \")\" // file ( pos :) if (. not . check_file ( res )) exit i = i + 1 end do end function get_new_file_name","tags":"","loc":"proc/get_new_file_name.html"},{"title":"normalise_fluence – signedMCRT","text":"public subroutine normalise_fluence(grid, array, nphotons) Uses gridMod constants normalise fluence in the Lucy 1999 way Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid grid class real(kind=sp), intent(inout) :: array (:,:,:) array to normalise integer, intent(in) :: nphotons number of photons run Contents Source Code normalise_fluence Source Code subroutine normalise_fluence ( grid , array , nphotons ) !! normalise fluence in the Lucy 1999 way use gridMod use constants , only : sp !> grid class type ( cart_grid ), intent ( in ) :: grid !> array to normalise real ( kind = sp ), intent ( inout ) :: array (:, :, :) !> number of photons run integer , intent ( in ) :: nphotons real ( kind = wp ) :: xmax , ymax , zmax integer :: nxg , nyg , nzg nxg = grid % nxg nyg = grid % nyg nzg = grid % nzg xmax = grid % xmax ymax = grid % ymax zmax = grid % zmax array = array * (( 2._sp * xmax * 2._sp * ymax ) / ( nphotons * ( 2._sp * xmax / nxg ) * ( 2._sp * ymax / nyg ) * ( 2._sp * zmax / nzg ))) end subroutine normalise_fluence","tags":"","loc":"proc/normalise_fluence.html"},{"title":"write_3d_r4_nrrd – signedMCRT","text":"private subroutine write_3d_r4_nrrd(array, filename, overwrite, dict) Uses iso_fortran_env tomlf constants utils write 3D array of float32's to .nrrd fileformat Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to be written to disk character(len=*), intent(in) :: filename filename logical, intent(in) :: overwrite overwrite flag type(toml_table), intent(inout), optional :: dict dictionary of metadata Contents Source Code write_3d_r4_nrrd Source Code subroutine write_3d_r4_nrrd ( array , filename , overwrite , dict ) !! write 3D array of float32's to .nrrd fileformat use tomlf , only : toml_table , toml_dump , toml_error use iso_fortran_env , only : int32 , int64 , real32 , real64 use utils , only : str use constants , only : sp !> filename character ( * ), intent ( IN ) :: filename !> array to be written to disk real ( kind = sp ), intent ( IN ) :: array (:, :, :) !> dictionary of metadata type ( toml_table ), optional , intent ( INOUT ) :: dict !> overwrite flag logical , intent ( IN ) :: overwrite type ( toml_error ), allocatable :: error character ( len = :), allocatable :: file integer :: u if ( check_file ( filename ) . and . . not . overwrite ) then file = get_new_file_name ( filename ) else file = filename end if open ( newunit = u , file = file , form = \"formatted\" ) !to do fix precision call write_hdr ( u , [ size ( array , 1 ), size ( array , 2 ), size ( array , 3 )], \"float\" ) if ( present ( dict )) then call toml_dump ( dict , u , error ) end if write ( u , \"(A)\" ) new_line ( \"C\" ) close ( u ) open ( newunit = u , file = file , access = \"stream\" , form = \"unformatted\" , position = \"append\" ) write ( u ) array close ( u ) end subroutine write_3d_r4_nrrd","tags":"","loc":"proc/write_3d_r4_nrrd.html"},{"title":"write_3d_r4_raw – signedMCRT","text":"private subroutine write_3d_r4_raw(array, filename, overwrite) Uses constants write 3D array of float32's to disk as raw binary data Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to write to disk character(len=*), intent(in) :: filename filename to save array as logical, intent(in) :: overwrite overwrite flag Contents Source Code write_3d_r4_raw Source Code subroutine write_3d_r4_raw ( array , filename , overwrite ) !! write 3D array of float32's to disk as raw binary data use constants , only : sp !> array to write to disk real ( kind = sp ), intent ( IN ) :: array (:, :, :) !> filename to save array as character ( * ), intent ( IN ) :: filename !> overwrite flag logical , intent ( IN ) :: overwrite integer :: u character ( len = :), allocatable :: file if ( check_file ( filename ) . and . . not . overwrite ) then file = get_new_file_name ( filename ) else file = filename end if open ( newunit = u , file = file , access = 'stream' , status = 'REPLACE' , form = 'unformatted' ) write ( u ) array close ( u ) end subroutine write_3d_r4_raw","tags":"","loc":"proc/write_3d_r4_raw.html"},{"title":"write_3d_r8_nrrd – signedMCRT","text":"private subroutine write_3d_r8_nrrd(array, filename, overwrite, dict) Uses iso_fortran_env tomlf utils write 3D array of float64's to .nrrd fileformat Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:,:) array to be written to disk character(len=*), intent(in) :: filename filename logical, intent(in) :: overwrite overwrite flag type(toml_table), intent(inout), optional :: dict dictionary of metadata Contents Source Code write_3d_r8_nrrd Source Code subroutine write_3d_r8_nrrd ( array , filename , overwrite , dict ) !! write 3D array of float64's to .nrrd fileformat use tomlf , only : toml_table , toml_dump , toml_error use iso_fortran_env , only : int32 , int64 , real32 , real64 use utils , only : str !> filename character ( * ), intent ( IN ) :: filename !> array to be written to disk real ( kind = wp ), intent ( IN ) :: array (:, :, :) !> dictionary of metadata type ( toml_table ), optional , intent ( INOUT ) :: dict !> overwrite flag logical , intent ( IN ) :: overwrite type ( toml_error ), allocatable :: error character ( len = :), allocatable :: file integer :: u if ( check_file ( filename ) . and . . not . overwrite ) then file = get_new_file_name ( filename ) else file = filename end if open ( newunit = u , file = file , form = \"formatted\" ) !to do fix precision call write_hdr ( u , [ size ( array , 1 ), size ( array , 2 ), size ( array , 3 )], \"double\" ) if ( present ( dict )) then call toml_dump ( dict , u , error ) end if write ( u , \"(A)\" ) new_line ( \"C\" ) close ( u ) open ( newunit = u , file = file , access = \"stream\" , form = \"unformatted\" , position = \"append\" ) write ( u ) array close ( u ) end subroutine write_3d_r8_nrrd","tags":"","loc":"proc/write_3d_r8_nrrd.html"},{"title":"write_3d_r8_raw – signedMCRT","text":"private subroutine write_3d_r8_raw(array, filename, overwrite) write 3D array of float64s to disk as raw binary data Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:,:) array to write to disk character(len=*), intent(in) :: filename filename to save array as logical, intent(in) :: overwrite overwrite flag Contents Source Code write_3d_r8_raw Source Code subroutine write_3d_r8_raw ( array , filename , overwrite ) !! write 3D array of float64s to disk as raw binary data !> array to write to disk real ( kind = wp ), intent ( IN ) :: array (:, :, :) !> filename to save array as character ( * ), intent ( IN ) :: filename !> overwrite flag logical , intent ( IN ) :: overwrite integer :: u character ( len = :), allocatable :: file if ( check_file ( filename ) . and . . not . overwrite ) then file = get_new_file_name ( filename ) else file = filename end if open ( newunit = u , file = file , access = 'stream' , status = 'REPLACE' , form = 'unformatted' ) write ( u ) array close ( u ) end subroutine write_3d_r8_raw","tags":"","loc":"proc/write_3d_r8_raw.html"},{"title":"write_data – signedMCRT","text":"public subroutine write_data(array, filename, state, dict, overwrite) Uses sim_state_mod tomlf constants routine automatically selects which way to write out results based upon file extension Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to write out character(len=*), intent(in) :: filename filename to save array as type( settings_t ), intent(in) :: state simulation state type(toml_table), intent(inout), optional :: dict dictionary of metadata logical, intent(in), optional :: overwrite overwrite flag Contents Source Code write_data Source Code subroutine write_data ( array , filename , state , dict , overwrite ) !! routine automatically selects which way to write out results based upon file extension use sim_state_mod , only : settings_t use tomlf , only : toml_table , get_value use constants , only : sp !> simulation state type ( settings_t ), intent ( IN ) :: state !> array to write out real ( kind = sp ), intent ( IN ) :: array (:,:,:) !> filename to save array as character ( * ), intent ( IN ) :: filename !> dictionary of metadata type ( toml_table ), optional , intent ( INOUT ) :: dict !> overwrite flag logical , optional , intent ( IN ) :: overwrite Logical :: over_write integer :: pos if ( present ( overwrite )) then over_write = overwrite else over_write = state % overwrite end if pos = index ( filename , \".nrrd\" ) if ( pos > 0 ) then if ( present ( dict )) then call nrrd_write ( array , filename , over_write , dict ) else call nrrd_write ( array , filename , over_write ) end if return end if pos = index ( filename , \".raw\" ) if ( pos > 0 ) then call raw_write ( array , filename , over_write ) return end if pos = index ( filename , \".dat\" ) if ( pos > 0 ) then call raw_write ( array , filename , over_write ) return end if error stop \"File type not supported!\" end subroutine write_data","tags":"","loc":"proc/write_data.html"},{"title":"write_detected_photons – signedMCRT","text":"public subroutine write_detected_photons(dects) Uses detectors constants utils Arguments Type Intent Optional Attributes Name type( dect_array ), intent(in) :: dects (:) Contents Source Code write_detected_photons Source Code subroutine write_detected_photons ( dects ) use detectors use constants , only : fileplace use utils , only : str type ( dect_array ), intent ( in ) :: dects (:) integer :: i , j , u character ( len = :), allocatable :: hdr do i = 1 , size ( dects ) open ( newunit = u , file = trim ( fileplace ) // \"detectors/detector_\" // str ( i ) // \".dat\" ) associate ( x => dects ( i )% p ) select type ( x ) type is ( circle_dect ) ! hdr = \"# pos, layer, nbins, bin_wid, radius\"//new_line(\"a\")//str(x%pos)//\",\"//str(x%layer)//\",\"//str(x%nbins)//\",\"//str(x%bin_wid)//\",\"//str(x%radius) ! write(u, \"(a)\")hdr ! write(u, \"(a)\")\"#data:\" do j = 1 , x % nbins write ( u , * ) real ( j , kind = wp ) * x % bin_wid , x % data ( j ) end do type is ( annulus_dect ) ! hdr = \"#pos, layer, nbins, bin_wid, radius1, radius2\"//new_line(\"a\")//str(x%pos)//\",\"//str(x%layer)//\",\"//str(x%nbins)//\",\"//str(x%bin_wid)//\",\"//str(x%r1)//\",\"//str(x%r2) type is ( camera ) print * , \"Warning not yet implmented!\" end select end associate close ( u ) end do end subroutine write_detected_photons","tags":"","loc":"proc/write_detected_photons.html"},{"title":"write_hdr – signedMCRT","text":"private subroutine write_hdr(u, sizes, type) Uses utils write out header information for .nrrd file format Arguments Type Intent Optional Attributes Name integer, intent(in) :: u file handle integer, intent(in) :: sizes (:) dimensions of data character(len=*), intent(in) :: type data dtype Contents Source Code write_hdr Source Code subroutine write_hdr ( u , sizes , type ) !! write out header information for .nrrd file format use utils , only : str !> data dtype character ( * ), intent ( IN ) :: type !> file handle integer , intent ( IN ) :: u !> dimensions of data integer , intent ( IN ) :: sizes (:) character ( len = 100 ) :: string integer :: i string = \"\" do i = 1 , size ( sizes ) if ( i == 1 ) then string = str ( sizes ( i )) else string = trim ( string ) // \" \" // str ( sizes ( i )) end if end do write ( u , \"(A)\" ) \"NRRD0004\" write ( u , \"(A)\" ) \"type: \" // type write ( u , \"(A)\" ) \"dimension: \" // str ( size ( sizes )) write ( u , \"(A)\" ) \"sizes: \" // trim ( string ) write ( u , \"(A)\" ) \"space dimension: \" // str ( size ( sizes )) write ( u , \"(A)\" ) \"encoding: raw\" write ( u , \"(A)\" ) \"endian: little\" end subroutine write_hdr","tags":"","loc":"proc/write_hdr.html"},{"title":"nrrd_write – signedMCRT","text":"public interface nrrd_write Contents Module Procedures write_3d_r8_nrrd write_3d_r4_nrrd Module Procedures private subroutine write_3d_r8_nrrd (array, filename, overwrite, dict) write 3D array of float64's to .nrrd fileformat Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:,:) array to be written to disk character(len=*), intent(in) :: filename filename logical, intent(in) :: overwrite overwrite flag type(toml_table), intent(inout), optional :: dict dictionary of metadata private subroutine write_3d_r4_nrrd (array, filename, overwrite, dict) write 3D array of float32's to .nrrd fileformat Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to be written to disk character(len=*), intent(in) :: filename filename logical, intent(in) :: overwrite overwrite flag type(toml_table), intent(inout), optional :: dict dictionary of metadata","tags":"","loc":"interface/nrrd_write.html"},{"title":"raw_write – signedMCRT","text":"public interface raw_write Contents Module Procedures write_3d_r8_raw write_3d_r4_raw Module Procedures private subroutine write_3d_r8_raw (array, filename, overwrite) write 3D array of float64s to disk as raw binary data Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:,:) array to write to disk character(len=*), intent(in) :: filename filename to save array as logical, intent(in) :: overwrite overwrite flag private subroutine write_3d_r4_raw (array, filename, overwrite) write 3D array of float32's to disk as raw binary data Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to write to disk character(len=*), intent(in) :: filename filename to save array as logical, intent(in) :: overwrite overwrite flag","tags":"","loc":"interface/raw_write.html"},{"title":"display_settings – signedMCRT","text":"private subroutine display_settings(state, input_file, packet, kernel_type) Uses sim_state_mod utils photonMod Displays the settings used in the current simulation run Arguments Type Intent Optional Attributes Name type( settings_t ), intent(in) :: state Simulation state character(len=*), intent(in) :: input_file Input filenname type( photon ), intent(in) :: packet Photon packet character(len=*), intent(in) :: kernel_type Kernel type to run Contents Source Code display_settings Source Code subroutine display_settings ( state , input_file , packet , kernel_type ) !! Displays the settings used in the current simulation run use sim_state_mod , only : settings_t use photonMod , only : photon use utils , only : str !> Simulation state type ( settings_t ), intent ( IN ) :: state !> Input filenname character ( * ), intent ( IN ) :: input_file !> Kernel type to run character ( * ), intent ( IN ) :: kernel_type !> Photon packet type ( photon ), intent ( IN ) :: packet print * , repeat ( \"#\" , 20 ) // \" Settings \" // repeat ( \"#\" , 20 ) print * , \"# Config file: \" , trim ( input_file ), repeat ( \" \" , 50 - 16 - len ( trim ( input_file ))), \"#\" print * , \"# Using: \" // trim ( kernel_type ) // \"kernel\" // repeat ( \" \" , 50 - 16 - len ( kernel_type )), \"#\" print * , \"# Light source: \" // trim ( state % source ) // repeat ( \" \" , 50 - 17 - len ( trim ( state % source ))), \"#\" if ( state % source == \"point\" ) then print * , \"# Light Source Position: [\" // str ( packet % pos % x , 4 ) // \", \" // str ( packet % pos % y , 4 ) // \", \" // str ( packet % pos % z , 4 ) // & \"]\" // repeat ( \" \" , 6 ) // \"#\" else print * , \"# Light direction: [\" // str ( packet % nxp , 4 ) // \", \" // str ( packet % nyp , 4 ) // \", \" // str ( packet % nzp , 4 ) // & \"]\" // repeat ( \" \" , 12 ) // \"#\" end if print * , \"# Geometry: \" // trim ( state % experiment ) // repeat ( \" \" , 50 - 13 - len ( trim ( state % experiment ))), \"#\" print * , \"# Seed: \" // str ( state % iseed , 9 ) // repeat ( \" \" , 32 ) // \"#\" if ( state % tev ) then print * , \"# Tev enabled!\" // repeat ( \" \" , 35 ) // \"#\" end if if ( state % render_geom ) then print * , \"# Render geometry to file enabled!\" // repeat ( \" \" , 15 ) // \"#\" end if if ( state % overwrite ) then print * , \"# Overwrite Enabled!\" , repeat ( \" \" , 29 ) // \"#\" end if if ( state % absorb ) then print * , \"# Energy absorbed will be written to file.\" // repeat ( \" \" , 7 ) // \"#\" end if print * , repeat ( \"#\" , 50 ) print * , new_line ( \"a\" ) end subroutine display_settings","tags":"","loc":"proc/display_settings.html"},{"title":"finalise – signedMCRT","text":"private subroutine finalise(dict, dects, nscatt, start, history) Uses sim_state_mod writer_mod detectors tomlf historyStack setupMod iarray utils constants Routine writes out simulation data, deallocates arrays and prints total runtime Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Dictionary of metadata type( dect_array ), intent(in) :: dects (:) Detector array real(kind=wp), intent(in) :: nscatt Total number of scattered photon packets real(kind=wp), intent(in) :: start Start time of simulation. Used to calculate total runtime. type( history_stack_t ), intent(in) :: history Photon histyor object Contents Source Code finalise Source Code subroutine finalise ( dict , dects , nscatt , start , history ) !! Routine writes out simulation data, deallocates arrays and prints total runtime use constants , only : wp , fileplace use detectors , only : dect_array use historyStack , only : history_stack_t use iarray , only : phasor , phasorGLOBAL , jmean , jmeanGLOBAL , absorb , absorbGLOBAL use sim_state_mod , only : state use setupMod , only : dealloc_array use writer_mod , only : normalise_fluence , write_data , write_detected_photons use utils , only : get_time , print_time , str use tomlf , only : toml_table , set_value !> Total number of scattered photon packets real ( kind = wp ), intent ( in ) :: nscatt !> Start time of simulation. Used to calculate total runtime. real ( kind = wp ), intent ( in ) :: start !> Detector array type ( dect_array ), intent ( in ) :: dects (:) !> Photon histyor object type ( history_stack_t ), intent ( in ) :: history !> Dictionary of metadata type ( toml_table ), intent ( inout ) :: dict integer :: id , numproc , i real ( kind = wp ) :: nscattGLOBAL , time_taken id = 0 numproc = 1 #ifdef MPI ! collate fluence from all processes call mpi_reduce ( jmean , jmeanGLOBAL , size ( jmean ), MPI_DOUBLE_PRECISION , MPI_SUM , 0 , MPI_COMM_WORLD ) call mpi_reduce ( absorb , absorbGLOBAL , size ( absorb ), MPI_DOUBLE_PRECISION , MPI_SUM , 0 , MPI_COMM_WORLD ) call mpi_reduce ( phasor , phasorGLOBAL , size ( phasor ), MPI_DOUBLE_COMPLEX , MPI_SUM , 0 , MPI_COMM_WORLD ) call mpi_reduce ( nscatt , nscattGLOBAL , 1 , MPI_DOUBLE_PRECISION , MPI_SUM , 0 , MPI_COMM_WORLD ) #else jmeanGLOBAL = jmean absorbGLOBAL = absorb phasorGLOBAL = phasor nscattGLOBAL = nscatt #endif if ( id == 0 ) then #ifdef _OPENMP print * , 'Average # of scatters per photon:' , nscattGLOBAL / ( state % nphotons ) #else print * , 'Average # of scatters per photon:' , nscattGLOBAL / ( state % nphotons * numproc ) ! for testing purposes open ( newunit = i , file = \"nscatt.dat\" ) write ( i , * ) nscattGLOBAL / ( state % nphotons ) close ( i ) #endif !write out files !create dict to store metadata and nrrd hdr info call set_value ( dict , \"grid_data\" , \"fluence map\" ) call set_value ( dict , \"real_size\" , str ( state % grid % xmax , 7 ) // \" \" // str ( state % grid % ymax , 7 ) // \" \" // str ( state % grid % zmax , 7 )) call set_value ( dict , \"nphotons\" , state % nphotons ) call set_value ( dict , \"source\" , state % source ) call set_value ( dict , \"experiment\" , state % experiment ) call normalise_fluence ( state % grid , jmeanGLOBAL , state % nphotons ) call write_data ( jmeanGLOBAL , trim ( fileplace ) // \"jmean/\" // state % outfile , state , dict ) ! if(state%absorb)call write_data(absorbGLOBAL, trim(fileplace)//\"deposit/\"//state%outfile_absorb, state, dict) !INTENSITY ! call write_data(abs(phasorGLOBAL)**2, trim(fileplace)//\"phasor/\"//state%outfile, state, dict) end if !write out detected photons if ( size ( dects ) > 0 ) then call write_detected_photons ( dects ) block logical :: mask ( size ( dects )) do i = 1 , size ( dects ) mask ( i ) = dects ( i )% p % trackHistory end do if ( state % trackHistory ) call history % finish () end block end if time_taken = get_time () - start call print_time ( time_taken , 4 ) #ifdef MPI call MPI_Finalize () #endif call dealloc_array () end subroutine finalise","tags":"","loc":"proc/finalise.html"},{"title":"pathlength_scatter – signedMCRT","text":"public subroutine pathlength_scatter(input_file) Uses piecewiseMod random sim_state_mod detectors inttau2 tomlf constants sdfs vec4_class historyStack vector_class omp_lib tev_mod iarray utils photonMod detector_mod Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: input_file Contents Source Code pathlength_scatter Source Code subroutine pathlength_scatter ( input_file ) !Shared data use iarray use constants , only : wp !subroutines use detector_mod , only : hit_t use detectors , only : dect_array use historyStack , only : history_stack_t use inttau2 , only : tauint2 use photonMod , only : photon use piecewiseMod use random , only : ran2 , init_rng , seq use sdfs , only : sdf use sim_state_mod , only : state use utils , only : pbar use vec4_class , only : vec4 use vector_class , only : vector !external deps use tev_mod , only : tevipc use tomlf , only : toml_table #ifdef _OPENMP use omp_lib #endif character ( len =* ), intent ( in ) :: input_file integer :: numproc , id , j , i type ( history_stack_t ) :: history type ( pbar ) :: bar type ( photon ) :: packet type ( toml_table ) :: dict real ( kind = wp ), allocatable :: distances (:), image (:,:,:) type ( hit_t ) :: hpoint type ( vector ) :: dir type ( dect_array ), allocatable :: dects (:) type ( sdf ), allocatable :: array (:) real ( kind = wp ) :: ran , nscatt , start type ( tevipc ) :: tev type ( seq ) :: seqs ( 2 ) type ( spectrum_t ) :: spectrum call setup ( input_file , tev , dects , array , packet , spectrum , dict , distances , image , nscatt , start ) #ifdef _OPENMP !is state%seed private, i dont think so... !$omp parallel default(none) shared(dict, array, numproc, start, state, bar, jmean, phasor, tev, dects, spectrum)& !$omp& private(ran, id, distances, image, dir, hpoint, history, seqs) reduction(+:nscatt) firstprivate(packet) numproc = omp_get_num_threads () id = omp_get_thread_num () if ( numproc > state % nphotons . and . id == 0 ) print * , \"Warning, simulation may be underministic due to low photon count!\" if ( state % trackHistory ) history = history_stack_t ( state % historyFilename , id ) #elif MPI !nothing #else numproc = 1 id = 0 if ( state % trackHistory ) history = history_stack_t ( state % historyFilename , id ) #endif if ( id == 0 ) print ( \"(a,I3.1,a)\" ), 'Photons now running on' , numproc , ' cores.' ! set seed for rnd generator. id to change seed for each process call init_rng ( spread ( state % iseed + id , 1 , 8 ), fwd = . true .) seqs = [ seq (( id + 1 ) * ( state % nphotons / numproc ), 2 ),& seq (( id + 1 ) * ( state % nphotons / numproc ), 3 )] bar = pbar ( state % nphotons / 10 ) !$OMP BARRIER !$OMP do !loop over photons do j = 1 , state % nphotons if ( mod ( j , 10 ) == 0 ) call bar % progress () ! Release photon from point source call packet % emit ( spectrum , dict , seqs ) packet % step = 0 packet % id = id distances = 0._wp do i = 1 , size ( distances ) distances ( i ) = array ( i )% evaluate ( packet % pos ) if ( distances ( i ) > 0._wp ) distances ( i ) =- 99 9.0_wp end do packet % layer = minloc ( abs ( distances ), dim = 1 ) if ( state % trackHistory ) call history % push ( vec4 ( packet % pos , packet % step )) ! Find scattering location call tauint2 ( state % grid , packet , array ) do while (. not . packet % tflag ) if ( state % trackHistory ) call history % push ( vec4 ( packet % pos , packet % step )) ran = ran2 () if ( ran < array ( packet % layer )% getAlbedo ()) then !interacts with tissue call packet % scatter ( array ( packet % layer )% gethgg (), & array ( packet % layer )% getg2 (), dects ) nscatt = nscatt + 1 packet % step = packet % step + 1 else packet % tflag = . true . exit end if ! !Find next scattering location call tauint2 ( state % grid , packet , array ) end do dir = vector ( packet % nxp , packet % nyp , packet % nzp ) hpoint = hit_t ( packet % pos , dir , sqrt ( packet % pos % x ** 2 + packet % pos % y ** 2 ), packet % layer ) do i = 1 , size ( dects ) call dects ( i )% p % record_hit ( hpoint , history ) end do if ( id == 0 . and . mod ( j , 1000 ) == 0 ) then if ( state % tev ) then !$omp critical image = reshape ( jmean (:, 100 : 100 ,:), [ state % grid % nxg , state % grid % nzg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"I\" ], 0 , 0 , . false ., . false .) image = reshape ( phasor ( 100 : 100 ,:,:), [ state % grid % nyg , state % grid % nzg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"J\" ], 0 , 0 , . false ., . false .) image = reshape ( phasor (:,:, 100 : 100 ), [ state % grid % nxg , state % grid % nyg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"K\" ], 0 , 0 , . false ., . false .) !$omp end critical end if end if end do #ifdef _OPENMP !$OMP end do !$OMP end parallel #endif call finalise ( dict , dects , nscatt , start , history ) end subroutine pathlength_scatter","tags":"","loc":"proc/pathlength_scatter.html"},{"title":"setup – signedMCRT","text":"private subroutine setup(input_file, tev, dects, array, packet, spectrum, dict, distances, image, nscatt, start) Uses random piecewiseMod sim_state_mod photonMod detectors tomlf sdfs setupMod vector_class tev_mod iarray utils parse_mod constants setup simulation by reading in setting file, and setup variables to be used. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: input_file Filename for toml settings to be used type(tevipc), intent(out) :: tev handle for communicating with TEV type( dect_array ), intent(out), allocatable :: dects (:) array of photon detectors type( sdf ), intent(out), allocatable :: array (:) array of SDF objects that create the geometry type( photon ), intent(out) :: packet photon that is to be simulated type( spectrum_t ), intent(out) :: spectrum type(toml_table), intent(out) :: dict toml table of meta-data to be written to output files. real(kind=wp), intent(out), allocatable :: distances (:) real(kind=wp), intent(out), allocatable :: image (:,:,:) real(kind=wp), intent(out) :: nscatt real(kind=wp), intent(out) :: start Contents Source Code setup Source Code subroutine setup ( input_file , tev , dects , array , packet , spectrum , dict , distances , image , nscatt , start ) !! setup simulation by reading in setting file, and setup variables to be used. !shared data use iarray use constants , only : wp !subroutines use detectors , only : dect_array use parse_mod , only : parse_params use photonMod , only : photon use random , only : init_rng use piecewiseMod use sdfs , only : sdf , render use sim_state_mod , only : state use setupMod , only : setup_simulation , directory use utils , only : get_time , print_time , str use vector_class , only : vector ! !external deps use tev_mod , only : tevipc , tev_init use tomlf , only : toml_table , toml_error !> Filename for toml settings to be used character ( * ), intent ( in ) :: input_file !> array of SDF objects that create the geometry type ( sdf ), allocatable , intent ( out ) :: array (:) !> array of photon detectors type ( dect_array ), allocatable , intent ( out ) :: dects (:) !> toml table of meta-data to be written to output files. type ( toml_table ), intent ( out ) :: dict !> handle for communicating with TEV type ( tevipc ), intent ( out ) :: tev !> photon that is to be simulated type ( photon ), intent ( out ) :: packet real ( kind = wp ), allocatable , intent ( out ) :: distances (:), image (:,:,:) real ( kind = wp ), intent ( out ) :: nscatt , start type ( spectrum_t ), intent ( out ) :: spectrum ! mpi/mp variables integer :: id real ( kind = wp ) :: chance , threshold type ( toml_error ), allocatable :: error chance = 1._wp / 1 0._wp threshold = 1e-6_wp call directory () dict = toml_table () call parse_params ( \"res/\" // trim ( input_file ), packet , dects , spectrum , dict , error ) if ( allocated ( error )) then print * , error % message stop 1 end if allocate ( image ( state % grid % nxg , state % grid % nzg , 1 )) call display_settings ( state , input_file , packet , \"Pathlength\" ) if ( state % tev ) then !init TEV link tev = tevipc () call tev % close_image ( state % experiment ) call tev % create_image ( state % experiment , state % grid % nxg , state % grid % nzg , [ \"I\" , \"J\" , \"K\" ], . true .) end if nscatt = 0._wp call init_rng ( spread ( state % iseed + 0 , 1 , 8 ), fwd = . true .) call setup_simulation ( array , dict ) ! render geometry to voxel format for debugging if ( state % render_geom ) then print * , \"Rendering geometry to file\" call render ( array , state ) end if allocate ( distances ( size ( array ))) start = get_time () id = 0 if ( id == 0 ) then print * , '# of photons to run' , state % nphotons end if end subroutine setup","tags":"","loc":"proc/setup.html"},{"title":"test_kernel – signedMCRT","text":"public subroutine test_kernel(input_file, end_early) Uses piecewiseMod random sim_state_mod detectors inttau2 tomlf sdfs historyStack vector_class omp_lib tev_mod iarray utils photonMod constants Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: input_file logical, intent(in) :: end_early Contents Source Code test_kernel Source Code subroutine test_kernel ( input_file , end_early ) !Shared data use iarray use constants , only : wp !subroutines use detectors , only : dect_array use historyStack , only : history_stack_t use inttau2 , only : tauint2 use photonMod , only : photon use piecewiseMod use random , only : ran2 , init_rng use sdfs , only : sdf use sim_state_mod , only : state use utils , only : pbar use vector_class , only : vector !external deps use tev_mod , only : tevipc use tomlf , only : toml_table #ifdef _OPENMP use omp_lib #endif character ( len =* ), intent ( in ) :: input_file integer :: numproc , id , j , i type ( history_stack_t ) :: history ! type(pbar) :: bar type ( photon ) :: packet type ( toml_table ) :: dict real ( kind = wp ), allocatable :: distances (:), image (:,:,:) type ( dect_array ), allocatable :: dects (:) type ( sdf ), allocatable :: array (:) real ( kind = wp ) :: ran , nscatt , start type ( tevipc ) :: tev type ( vector ) :: pos ( 4 ), pos2 ( 4 ) logical , intent ( in ) :: end_early type ( spectrum_t ) :: spectrum pos = vector ( 0.0_wp , 0.0_wp , 0.0_wp ) pos2 = vector ( 0.0_wp , 0.0_wp , 0.0_wp ) call setup ( input_file , tev , dects , array , packet , spectrum , dict , distances , image , nscatt , start ) numproc = 1 id = 0 if ( id == 0 ) print ( \"(a,I3.1,a)\" ), 'Photons now running on' , numproc , ' cores.' ! set seed for rnd generator. id to change seed for each process call init_rng ( spread ( state % iseed + id , 1 , 8 ), fwd = . true .) ! bar = pbar(state%nphotons/ 10) !loop over photons do j = 1 , state % nphotons ! if(mod(j, 10) == 0)call bar%progress() ! Release photon from point source call packet % emit ( spectrum , dict ) packet % step = 0 packet % id = id distances = 0._wp do i = 1 , size ( distances ) distances ( i ) = array ( i )% evaluate ( packet % pos ) if ( distances ( i ) > 0._wp ) distances ( i ) =- 99 9.0_wp end do packet % layer = minloc ( abs ( distances ), dim = 1 ) ! Find scattering location call tauint2 ( state % grid , packet , array ) do while (. not . packet % tflag ) ran = ran2 () if ( ran < array ( packet % layer )% getalbedo ()) then !interacts with tissue call packet % scatter ( array ( packet % layer )% gethgg (), & array ( packet % layer )% getg2 ()) nscatt = nscatt + 1 packet % step = packet % step + 1 if ( packet % step == 1 ) then pos ( 1 ) = pos ( 1 ) + packet % pos pos2 ( 1 ) = pos2 ( 1 ) + packet % pos ** 2 elseif ( packet % step == 2 ) then pos ( 2 ) = pos ( 2 ) + packet % pos pos2 ( 2 ) = pos2 ( 2 ) + packet % pos ** 2 elseif ( packet % step == 3 ) then pos ( 3 ) = pos ( 3 ) + packet % pos pos2 ( 3 ) = pos2 ( 3 ) + packet % pos ** 2 elseif ( packet % step == 4 ) then pos ( 4 ) = pos ( 4 ) + packet % pos pos2 ( 4 ) = pos2 ( 4 ) + packet % pos ** 2 else if ( end_early ) packet % tflag = . true . end if else packet % tflag = . true . exit end if ! !Find next scattering location call tauint2 ( state % grid , packet , array ) end do end do open ( newunit = j , file = \"positions.dat\" ) do i = 1 , 4 write ( j , * ) 1 0. * pos ( i )% x / state % nphotons , 1 0. * pos ( i )% y / state % nphotons , 1 0. * pos ( i )% z / state % nphotons end do do i = 1 , 4 write ( j , * ) 10 0. * pos2 ( i )% x / state % nphotons , 10 0. * pos2 ( i )% y / state % nphotons , 10 0. * pos2 ( i )% z / state % nphotons end do close ( j ) call finalise ( dict , dects , nscatt , start , history ) end subroutine test_kernel","tags":"","loc":"proc/test_kernel.html"},{"title":"weight_scatter – signedMCRT","text":"public subroutine weight_scatter(input_file) Uses piecewiseMod random sim_state_mod detectors inttau2 tomlf constants sdfs vec4_class historyStack vector_class omp_lib tev_mod iarray utils photonMod detector_mod Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: input_file Contents Source Code weight_scatter Source Code subroutine weight_scatter ( input_file ) !Shared data use iarray use constants , only : wp , CHANCE , THRESHOLD !subroutines use detectors , only : dect_array use detector_mod , only : hit_t use historyStack , only : history_stack_t use inttau2 , only : tauint2 , update_voxels use photonMod , only : photon use piecewiseMod use random , only : ran2 , init_rng use sdfs , only : sdf use sim_state_mod , only : state use utils , only : pbar use vec4_class , only : vec4 use vector_class , only : vector !external deps use tev_mod , only : tevipc use tomlf , only : toml_table #ifdef _OPENMP use omp_lib #endif character ( len =* ), intent ( in ) :: input_file integer :: numproc , id , j , i type ( history_stack_t ) :: history type ( pbar ) :: bar type ( photon ) :: packet type ( toml_table ) :: dict real ( kind = wp ), allocatable :: distances (:), image (:,:,:) type ( hit_t ) :: hpoint type ( vector ) :: dir type ( dect_array ), allocatable :: dects (:) type ( sdf ), allocatable :: array (:) real ( kind = wp ) :: nscatt , start , weight_absorb type ( tevipc ) :: tev integer :: celli , cellj , cellk type ( spectrum_t ) :: spectrum call setup ( input_file , tev , dects , array , packet , spectrum , dict , distances , image , nscatt , start ) #ifdef _OPENMP !is state%seed private, i dont think so... !$omp parallel default(none) shared(dict, array, numproc, start, state, bar, jmean, tev, dects, spectrum)& !$omp& private(id, distances, image, dir, hpoint, history, weight_absorb, cellk, cellj, celli) & !$omp& reduction(+:nscatt) firstprivate(packet) numproc = omp_get_num_threads () id = omp_get_thread_num () if ( numproc > state % nphotons . and . id == 0 ) print * , \"Warning, simulation may be underministic due to low photon count!\" if ( state % trackHistory ) history = history_stack_t ( state % historyFilename , id ) #elif MPI !nothing #else numproc = 1 id = 0 if ( state % trackHistory ) history = history_stack_t ( state % historyFilename , id ) #endif if ( id == 0 ) print ( \"(a,I3.1,a)\" ), 'Photons now running on' , numproc , ' cores.' ! set seed for rnd generator. id to change seed for each process call init_rng ( spread ( state % iseed + id , 1 , 8 ), fwd = . true .) bar = pbar ( state % nphotons / 10 ) !$OMP BARRIER !$OMP do !loop over photons do j = 1 , state % nphotons if ( mod ( j , 10 ) == 0 ) call bar % progress () ! Release photon from point source call packet % emit ( spectrum , dict ) packet % step = 0 packet % id = id distances = 0._wp do i = 1 , size ( distances ) distances ( i ) = array ( i )% evaluate ( packet % pos ) if ( distances ( i ) > 0._wp ) distances ( i ) =- 99 9.0_wp end do packet % layer = minloc ( abs ( distances ), dim = 1 ) if ( state % trackHistory ) call history % push ( vec4 ( packet % pos , packet % step )) ! Find scattering location call tauint2 ( state % grid , packet , array ) do while (. not . packet % tflag ) if ( state % trackHistory ) call history % push ( vec4 ( packet % pos , packet % step )) weight_absorb = packet % weight * ( 1._wp - array ( packet % layer )% getAlbedo ()) packet % weight = packet % weight - weight_absorb call update_voxels ( state % grid , & packet % pos + vector ( state % grid % xmax , state % grid % ymax , state % grid % zmax ), celli , cellj , cellk ) if ( celli < 1 ) then packet % tflag = . true . exit end if if ( cellj < 1 ) then packet % tflag = . true . exit end if if ( cellk < 1 ) then packet % tflag = . true . exit end if !$omp atomic jmean ( celli , cellj , cellk ) = jmean ( celli , cellj , cellk ) + weight_absorb call packet % scatter ( array ( packet % layer )% gethgg (), array ( packet % layer )% getg2 (), dects ) if ( packet % weight < THRESHOLD ) then if ( ran2 () < CHANCE ) then packet % weight = packet % weight / CHANCE else packet % tflag = . true . exit end if end if ! !Find next scattering location call tauint2 ( state % grid , packet , array ) end do dir = vector ( packet % nxp , packet % nyp , packet % nzp ) hpoint = hit_t ( packet % pos , dir , packet % weight , packet % layer ) do i = 1 , size ( dects ) call dects ( i )% p % record_hit ( hpoint , history ) end do if ( id == 0 . and . mod ( j , 1000 ) == 0 ) then if ( state % tev ) then !$omp critical image = reshape ( jmean (:, 100 : 100 ,:), [ state % grid % nxg , state % grid % nzg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"I\" ], 0 , 0 , . false ., . false .) image = reshape ( jmean ( 100 : 100 ,:,:), [ state % grid % nyg , state % grid % nzg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"J\" ], 0 , 0 , . false ., . false .) image = reshape ( jmean (:,:, 100 : 100 ), [ state % grid % nxg , state % grid % nyg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"K\" ], 0 , 0 , . false ., . false .) !$omp end critical end if end if end do #ifdef _OPENMP !$OMP end do !$OMP end parallel #endif call finalise ( dict , dects , nscatt , start , history ) end subroutine weight_scatter","tags":"","loc":"proc/weight_scatter.html"},{"title":"intersectCircle – signedMCRT","text":"public function intersectCircle(n, p0, radius, l0, l, t) ref Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: n Normal to the circle type( vector ), intent(in) :: p0 a centre of the circle real(kind=wp), intent(in) :: radius Radius of the circle type( vector ), intent(in) :: l0 origin of the ray type( vector ), intent(in) :: l direction vector of the ray real(kind=wp), intent(inout) :: t Distance from l0 to the intersection point Return Value logical Contents Source Code intersectCircle Source Code logical function intersectCircle ( n , p0 , radius , l0 , l , t ) !![ref](https://www.scratchapixel.com/lessons/3d-basic-rendering/minimal-ray-tracer-rendering-simple-shapes/ray-plane-and-ray-disk-intersection) !> Normal to the circle type ( vector ), intent ( in ) :: n !> a centre of the circle type ( vector ), intent ( in ) :: p0 !> direction vector of the ray type ( vector ), intent ( in ) :: l !> origin of the ray type ( vector ), intent ( in ) :: l0 !> Radius of the circle real ( kind = wp ), intent ( in ) :: radius !> Distance from l0 to the intersection point real ( kind = wp ), intent ( inout ) :: t real ( kind = wp ) :: d2 type ( vector ) :: v , p intersectCircle = . false . t = 0._wp if ( intersectPlane ( n , p0 , l0 , l , t )) then p = l0 + l * t v = p - p0 d2 = v . dot . v if ( sqrt ( d2 ) <= radius ) intersectCircle = . true . end if end function intersectCircle","tags":"","loc":"proc/intersectcircle.html"},{"title":"intersectCone – signedMCRT","text":"public function intersectCone(orig, dir, t, centre, radius, height) calculates where a line, with origin:orig and direction:dir hits a cone, radius:radius and height:height with centre:centre.\ncentre is the point under the apex at the cone's base.\nreturns true if intersection exists\nreturns t, the paramertised parameter of the line equation\nadapted from scratchapixel and pbrt\nneed to check z height after moving ray\nif not this is an infinte cone\ncone lies height ways along z-axis Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: orig origin of the ray type( vector ), intent(in) :: dir Direction vector of the ray real(kind=wp), intent(out) :: t distance from orig to the intersection point type( vector ), intent(in) :: centre Centre of the cone real(kind=wp), intent(in) :: radius Radius of the cones base real(kind=wp), intent(in) :: height Height of the cone Return Value logical Contents Source Code intersectCone Source Code logical function intersectCone ( orig , dir , t , centre , radius , height ) !! calculates where a line, with origin:orig and direction:dir hits a cone, radius:radius and height:height with centre:centre. !! centre is the point under the apex at the cone's base. !! returns true if intersection exists !! returns t, the paramertised parameter of the line equation !! adapted from scratchapixel and pbrt !! need to check z height after moving ray !! if not this is an infinte cone !! cone lies height ways along z-axis !> Direction vector of the ray type ( vector ), intent ( IN ) :: dir !> origin of the ray type ( vector ), intent ( IN ) :: orig !> Centre of the cone type ( vector ), intent ( IN ) :: centre !> distance from orig to the intersection point real ( kind = wp ), intent ( OUT ) :: t !> Radius of the cones base real ( kind = wp ), intent ( IN ) :: radius !> Height of the cone real ( kind = wp ), intent ( IN ) :: height type ( vector ) :: L real ( kind = wp ) :: t0 , t1 , a , b , c , tmp , k intersectCone = . false . k = radius / height k = k ** 2 L = orig - centre a = dir % x ** 2 + dir % y ** 2 - ( k * dir % z ** 2 ) b = 2._wp * (( dir % x * L % x ) + ( dir % y * L % y ) - ( k * dir % z * ( L % z - height ))) c = L % x ** 2 + L % y ** 2 - ( k * ( L % z - height ) ** 2 ) if (. not . solveQuadratic ( a , b , c , t0 , t1 )) return if ( t0 > t1 ) then tmp = t1 t1 = t0 t0 = tmp end if if ( t0 < 0._wp ) then t0 = t1 if ( t0 < 0._wp ) return end if t = t0 intersectCone = . true . return end function intersectCone","tags":"","loc":"proc/intersectcone.html"},{"title":"intersectCylinder – signedMCRT","text":"public function intersectCylinder(orig, dir, t, centre, radius) calculates where a line, with origin:orig and direction:dir hits a cylinder, centre:centre and radius:radius\nThis solves for an infinitely long cylinder centered on the z axis with radius radius\nreturns true if intersection exists\nreturns t, the paramertised parameter of the line equation\nadapted from scratchapixel\nneed to check z height after moving ray\nif not this is an infinite cylinder Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: orig origin of the ray type( vector ), intent(in) :: dir Direction vector of the ray real(kind=wp), intent(out) :: t distance from orig to the intersection point type( vector ), intent(in) :: centre Centre of the cylinder real(kind=wp), intent(in) :: radius radius of the cylinder Return Value logical Contents Source Code intersectCylinder Source Code logical function intersectCylinder ( orig , dir , t , centre , radius ) !! calculates where a line, with origin:orig and direction:dir hits a cylinder, centre:centre and radius:radius !! This solves for an infinitely long cylinder centered on the z axis with radius radius !! returns true if intersection exists !! returns t, the paramertised parameter of the line equation !! adapted from scratchapixel !! need to check z height after moving ray !! if not this is an infinite cylinder !> Direction vector of the ray type ( vector ), intent ( IN ) :: dir !> origin of the ray type ( vector ), intent ( IN ) :: orig !> Centre of the cylinder type ( vector ), intent ( IN ) :: centre !> distance from orig to the intersection point real ( kind = wp ), intent ( OUT ) :: t !> radius of the cylinder real ( kind = wp ), intent ( IN ) :: radius type ( vector ) :: L real ( kind = wp ) :: t0 , t1 , a , b , c , tmp intersectCylinder = . false . L = orig - centre a = dir % x ** 2 + dir % y ** 2 b = 2._wp * ( dir % x * L % x + dir % y * L % y ) c = L % x ** 2 + L % y ** 2 - radius ** 2 if (. not . solveQuadratic ( a , b , c , t0 , t1 )) return if ( t0 > t1 ) then tmp = t1 t1 = t0 t0 = tmp end if if ( t0 < 0._wp ) then t0 = t1 if ( t0 < 0._wp ) return end if t = t0 intersectCylinder = . true . return end function intersectCylinder","tags":"","loc":"proc/intersectcylinder.html"},{"title":"intersectEllipse – signedMCRT","text":"public function intersectEllipse(orig, dir, t, centre, semia, semib) calculates where a line, with origin:orig and direction:dir hits a ellipse, centre:centre and axii:semia, semib\nreturns true if intersection exists\nreturns t, the paramertised parameter of the line equation\nadapted from scratchapixel and pbrt\nneed to check z height after moving ray\nif not this is an infinte ellipse-cylinder\nellipse lies length ways along z-axis\nsemia and semib are the semimajor axis which are the half width and height. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: orig origin of the ray type( vector ), intent(in) :: dir Direction vector of the ray real(kind=wp), intent(out) :: t distance from orig to the intersection point type( vector ), intent(in) :: centre Centre of the ellipse real(kind=wp), intent(in) :: semia Half width of the ellipse real(kind=wp), intent(in) :: semib Half height of the ellipse Return Value logical Contents Source Code intersectEllipse Source Code logical function intersectEllipse ( orig , dir , t , centre , semia , semib ) !! calculates where a line, with origin:orig and direction:dir hits a ellipse, centre:centre and axii:semia, semib !! returns true if intersection exists !! returns t, the paramertised parameter of the line equation !! adapted from scratchapixel and pbrt !! need to check z height after moving ray !! if not this is an infinte ellipse-cylinder !! ellipse lies length ways along z-axis !! semia and semib are the semimajor axis which are the half width and height. !> Direction vector of the ray type ( vector ), intent ( IN ) :: dir !> origin of the ray type ( vector ), intent ( IN ) :: orig !> Centre of the ellipse type ( vector ), intent ( IN ) :: centre !> distance from orig to the intersection point real ( kind = wp ), intent ( OUT ) :: t !> Half width of the ellipse real ( kind = wp ), intent ( IN ) :: semia !> Half height of the ellipse real ( kind = wp ), intent ( IN ) :: semib type ( vector ) :: L real ( kind = wp ) :: t0 , t1 , a , b , c , tmp , semia2div , semib2div intersectEllipse = . false . semia2div = 1._wp / semia ** 2 semib2div = 1._wp / semib ** 2 L = orig - centre a = semia2div * dir % z ** 2 + semib2div * dir % y ** 2 b = 2._wp * ( semia2div * dir % z * L % z + semib2div * dir % y * L % y ) c = semia2div * L % z ** 2 + semib2div * L % y ** 2 - 1._wp if (. not . solveQuadratic ( a , b , c , t0 , t1 )) return if ( t0 > t1 ) then tmp = t1 t1 = t0 t0 = tmp end if if ( t0 < 0._wp ) then t0 = t1 if ( t0 < 0._wp ) return end if t = t0 intersectEllipse = . true . return end function intersectEllipse","tags":"","loc":"proc/intersectellipse.html"},{"title":"intersectPlane – signedMCRT","text":"public function intersectPlane(n, p0, l0, l, t) ref Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: n Normal to the plane type( vector ), intent(in) :: p0 a point on the plane type( vector ), intent(in) :: l0 origin of the ray type( vector ), intent(in) :: l direction vector of the ray real(kind=wp), intent(inout) :: t Distance from l0 to the intersection point Return Value logical Contents Source Code intersectPlane Source Code logical function intersectPlane ( n , p0 , l0 , l , t ) !![ref](https://www.scratchapixel.com/lessons/3d-basic-rendering/minimal-ray-tracer-rendering-simple-shapes/ray-plane-and-ray-disk-intersection) !> Normal to the plane type ( vector ), intent ( in ) :: n !> a point on the plane type ( vector ), intent ( in ) :: p0 !> direction vector of the ray type ( vector ), intent ( in ) :: l !> origin of the ray type ( vector ), intent ( in ) :: l0 !> Distance from l0 to the intersection point real ( kind = wp ), intent ( inout ) :: t real ( kind = wp ) :: denom type ( vector ) :: p0l0 intersectPlane = . false . denom = n . dot . l if ( denom > 1e-6_wp ) then p0l0 = p0 - l0 t = p0l0 . dot . n t = t / denom if ( t >= 0._wp ) intersectPlane = . true . end if end function intersectPlane","tags":"","loc":"proc/intersectplane.html"},{"title":"intersectSphere – signedMCRT","text":"public function intersectSphere(orig, dir, t, centre, radius) calculates where a line, with origin:orig and direction:dir hits a sphere, centre:centre and radius:radius\nreturns true if intersection exists\nreturns t, the paramertised parameter of the line equation\nadapted from scratchapixel Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: orig Origin of the ray type( vector ), intent(in) :: dir Direction vector of the ray real(kind=wp), intent(out) :: t Distance from orig to the intersection point type( vector ), intent(in) :: centre Centre of the sphere real(kind=wp), intent(in) :: radius Radius of the sphere Return Value logical Contents Source Code intersectSphere Source Code logical function intersectSphere ( orig , dir , t , centre , radius ) !! calculates where a line, with origin:orig and direction:dir hits a sphere, centre:centre and radius:radius !! returns true if intersection exists !! returns t, the paramertised parameter of the line equation !! adapted from scratchapixel !> Direction vector of the ray type ( vector ), intent ( IN ) :: dir !> Origin of the ray type ( vector ), intent ( IN ) :: orig !> Centre of the sphere type ( vector ), intent ( IN ) :: centre !> Distance from orig to the intersection point real ( kind = wp ), intent ( OUT ) :: t !> Radius of the sphere real ( kind = wp ), intent ( IN ) :: radius type ( vector ) :: L real ( kind = wp ) :: t0 , t1 , a , b , c , tmp intersectSphere = . false . L = orig - centre a = dir . dot . dir b = 2._wp * ( dir . dot . L ) c = ( l . dot . l ) - radius ** 2 if (. not . solveQuadratic ( a , b , c , t0 , t1 )) return if ( t0 > t1 ) then tmp = t1 t1 = t0 t0 = tmp end if if ( t0 < 0._wp ) then t0 = t1 if ( t0 < 0._wp ) return end if t = t0 intersectSphere = . true . return end function intersectSphere","tags":"","loc":"proc/intersectsphere.html"},{"title":"solveQuadratic – signedMCRT","text":"private function solveQuadratic(a, b, c, x0, x1) solves quadratic equation given coeffs a, b, and c\nreturns true if real solution\nreturns x0 and x1\nadapted from scratchapixel Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a real(kind=wp), intent(in) :: b real(kind=wp), intent(in) :: c real(kind=wp), intent(out) :: x0 real(kind=wp), intent(out) :: x1 Return Value logical Contents Source Code solveQuadratic Source Code logical function solveQuadratic ( a , b , c , x0 , x1 ) !! solves quadratic equation given coeffs a, b, and c !! returns true if real solution !! returns x0 and x1 !! adapted from scratchapixel real ( kind = wp ), intent ( IN ) :: a , b , c real ( kind = wp ), intent ( OUT ) :: x0 , x1 real ( kind = wp ) :: discrim , q solveQuadratic = . false . discrim = b ** 2 - 4._wp * a * c if ( discrim < 0._wp ) then return elseif ( discrim == 0._wp ) then x0 = - 0.5_wp * b / a x1 = x0 else if ( b > 0._wp ) then q = - 0.5_wp * ( b + sqrt ( discrim )) else q = - 0.5_wp * ( b - sqrt ( discrim )) end if x0 = q / a x1 = c / q end if solveQuadratic = . true . return end function solveQuadratic","tags":"","loc":"proc/solvequadratic.html"},{"title":"next – signedMCRT","text":"private function next(this) result(res) Type Bound seq Arguments Type Intent Optional Attributes Name class( seq ) :: this Return Value real(kind=wp) Contents","tags":"","loc":"proc/next.html"},{"title":"ran2 – signedMCRT","text":"public function ran2() result(res) wrapper for call random number Arguments None Return Value real(kind=wp) Contents Source Code ran2 Source Code function ran2 () result ( res ) !! wrapper for call random number real ( kind = wp ) :: res call random_number ( res ) end function ran2","tags":"","loc":"proc/ran2.html"},{"title":"randint – signedMCRT","text":"public function randint(a, b) sample a random integer between [a, b] Arguments Type Intent Optional Attributes Name integer, intent(in) :: a lower bound integer, intent(in) :: b higher bound Return Value integer Contents Source Code randint Source Code integer function randint ( a , b ) !! sample a random integer between [a, b] !> lower bound integer , intent ( IN ) :: a !> higher bound integer , intent ( IN ) :: b randint = a + floor (( b + 1 - a ) * ran2 ()) end function randint","tags":"","loc":"proc/randint.html"},{"title":"ranu – signedMCRT","text":"public function ranu(a, b) result(res) uniformly sample in range[a, b) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a lower bound real(kind=wp), intent(in) :: b upper bound Return Value real(kind=wp) Contents Source Code ranu Source Code function ranu ( a , b ) result ( res ) !! uniformly sample in range[a, b) real ( kind = wp ) :: res !> lower bound real ( kind = wp ), intent ( IN ) :: a !> upper bound real ( kind = wp ), intent ( IN ) :: b res = a + ran2 () * ( b - a ) end function ranu","tags":"","loc":"proc/ranu.html"},{"title":"init_rng – signedMCRT","text":"public subroutine init_rng(input_seed, fwd) initiate RNG state with reproducible state Arguments Type Intent Optional Attributes Name integer, intent(in), optional :: input_seed (:) input seed logical, intent(in), optional :: fwd boolean that if True runs the generator for 100 steps before returning Contents Source Code init_rng Source Code subroutine init_rng ( input_seed , fwd ) !! initiate RNG state with reproducible state !> input seed integer , optional , intent ( IN ) :: input_seed (:) !> boolean that if True runs the generator for 100 steps before returning logical , optional , intent ( IN ) :: fwd integer , allocatable :: seed (:) integer :: n , i logical :: ffwd real ( kind = wp ) :: a call random_seed ( size = n ) allocate ( seed ( n )) if ( present ( input_seed )) then seed = 0 seed = input_seed else seed = 1234567 end if if ( present ( fwd )) then ffwd = fwd else ffwd = . false . end if call random_seed ( put = seed ) !fast forward rng state 100 times to avoid any potential bad seeds if ( ffwd ) then call random_seed ( get = seed ) do i = 1 , 100 a = ran2 () call random_seed ( get = seed ) end do end if end subroutine init_rng","tags":"","loc":"proc/init_rng.html"},{"title":"rang – signedMCRT","text":"public subroutine rang(x, y, avg, sigma) sample a 2D Guassian distribution Arguments Type Intent Optional Attributes Name real(kind=wp), intent(out) :: x first value to return real(kind=wp), intent(out) :: y 2nd value to return real(kind=wp), intent(in) :: avg mean of the gaussian to sample from real(kind=wp), intent(in) :: sigma of the guassian to sample from. Contents Source Code rang Source Code subroutine rang ( x , y , avg , sigma ) !! sample a 2D Guassian distribution !> mean of the gaussian to sample from real ( kind = wp ), intent ( IN ) :: avg !> \\sigma of the guassian to sample from. real ( kind = wp ), intent ( IN ) :: sigma !> first value to return real ( kind = wp ), intent ( OUT ) :: x !> 2nd value to return real ( kind = wp ), intent ( OUT ) :: y real ( kind = wp ) :: s , tmp s = 1._wp do while ( s >= 1._wp ) x = ranu ( - 1._wp , 1._wp ) y = ranu ( - 1._wp , 1._wp ) s = y ** 2 + x ** 2 end do tmp = x * sqrt ( - 2._wp * log ( s ) / s ) x = avg + sigma * tmp tmp = y * sqrt ( - 2._wp * log ( s ) / s ) y = avg + sigma * tmp end subroutine rang","tags":"","loc":"proc/rang.html"},{"title":"get_vector – signedMCRT","text":"private function get_vector(child, key, error, context, default) Vector helper function for parsing toml Arguments Type Intent Optional Attributes Name type(toml_table), intent(in), pointer :: child Input Toml entry to read character(len=*), intent(in) :: key Key to read type(toml_error), intent(out), allocatable :: error type(toml_context), intent(in) :: context Context handle for error reporting type( vector ), intent(in), optional :: default Default value to assign Return Value type( vector ) Contents Source Code get_vector Source Code type ( vector ) function get_vector ( child , key , error , context , default ) !! Vector helper function for parsing toml !> Input Toml entry to read type ( toml_table ), pointer , intent ( in ) :: child !> Key to read character ( * ), intent ( in ) :: key !> Default value to assign type ( vector ), optional , intent ( in ) :: default !> Context handle for error reporting type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_array ), pointer :: arr => null () real ( kind = wp ) :: tmp ( 3 ) type ( vector ) :: default_ integer :: j , origin if ( present ( default )) then default_ = default else default_ = vector ( 0._wp , 0._wp , 0._wp ) end if call get_value ( child , key , arr , origin = origin ) if ( associated ( arr )) then if ( len ( arr ) /= 3 ) then call make_error ( error , & context % report ( \"Expected vector of size 3\" , origin , \"Wrong vector size\" ), - 1 ) return end if do j = 1 , len ( arr ) call get_value ( arr , j , tmp ( j )) end do get_vector = vector ( tmp ( 1 ), tmp ( 2 ), tmp ( 3 )) else get_vector = default end if end function get_vector","tags":"","loc":"proc/get_vector.html"},{"title":"handle_annulus_dect – signedMCRT","text":"private subroutine handle_annulus_dect(child, dects, counts, context, error) Uses detectors sim_state_mod Read in Annulus_detector settings and initalise variable Arguments Type Intent Optional Attributes Name type(toml_table), intent(in), pointer :: child type( annulus_dect ), intent(inout) :: dects (:) integer, intent(inout) :: counts type(toml_context), intent(in) :: context type(toml_error), intent(out), allocatable :: error Contents Source Code handle_annulus_dect Source Code subroutine handle_annulus_dect ( child , dects , counts , context , error ) !! Read in Annulus_detector settings and initalise variable use detectors , only : annulus_dect use sim_state_mod , only : state type ( toml_table ), pointer , intent ( in ) :: child type ( annulus_dect ), intent ( inout ) :: dects (:) integer , intent ( inout ) :: counts type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error integer :: layer , nbins , origin real ( kind = wp ) :: maxval , radius1 , radius2 type ( vector ) :: pos , dir logical :: trackHistory pos = get_vector ( child , \"position\" , context = context , error = error ) dir = get_vector ( child , \"direction\" , default = vector ( 0.0 , 0.0 , - 1.0 ), context = context , error = error ) call get_value ( child , \"layer\" , layer , 1 ) call get_value ( child , \"radius1\" , radius1 ) call get_value ( child , \"radius2\" , radius2 , origin = origin ) if ( radius2 <= radius1 ) then call make_error ( error , context % report ( \"Radii are invalid\" , origin , \"Expected radius2 > radius 1\" ), - 1 ) return end if call get_value ( child , \"nbins\" , nbins , 100 ) call get_value ( child , \"maxval\" , maxval , 10 0._wp ) call get_value ( child , \"trackHistory\" , trackHistory , . false .) if ( trackHistory ) state % trackHistory = . true . #ifdef _OPENMP if ( trackHistory ) then call make_error ( error , \"Track history currently incompatable with OpenMP!\" , - 1 ) return end if #endif dects ( counts ) = annulus_dect ( pos , dir , layer , radius1 , radius2 , nbins , maxval , trackHistory ) counts = counts + 1 end subroutine handle_annulus_dect","tags":"","loc":"proc/handle_annulus_dect.html"},{"title":"handle_camera – signedMCRT","text":"private subroutine handle_camera(child, dects, counts, context, error) Uses detectors sim_state_mod Read in Camera settings and initalise variable Arguments Type Intent Optional Attributes Name type(toml_table), intent(in), pointer :: child type( camera ), intent(inout) :: dects (:) integer, intent(inout) :: counts type(toml_context), intent(in) :: context Context handle for error reporting. type(toml_error), intent(out), allocatable :: error Contents Source Code handle_camera Source Code subroutine handle_camera ( child , dects , counts , context , error ) !! Read in Camera settings and initalise variable use detectors , only : camera use sim_state_mod , only : state type ( toml_table ), pointer , intent ( in ) :: child type ( camera ), intent ( inout ) :: dects (:) integer , intent ( inout ) :: counts !> Context handle for error reporting. type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error integer :: layer , nbins real ( kind = wp ) :: maxval type ( vector ) :: p1 , p2 , p3 logical :: trackHistory p1 = get_vector ( child , \"p1\" , default = vector ( - 1.0 , - 1.0 , - 1.0 ), context = context , error = error ) p2 = get_vector ( child , \"p2\" , default = vector ( 2.0 , 0.0 , 0.0 ), context = context , error = error ) p3 = get_vector ( child , \"p3\" , default = vector ( 0.0 , 2.0 , 0.0 ), context = context , error = error ) call get_value ( child , \"layer\" , layer , 1 ) call get_value ( child , \"nbins\" , nbins , 100 ) call get_value ( child , \"maxval\" , maxval , 10 0._wp ) call get_value ( child , \"trackHistory\" , trackHistory , . false .) if ( trackHistory ) state % trackHistory = . true . #ifdef _OPENMP if ( trackHistory ) then call make_error ( error , \"Track history currently incompatable with OpenMP!\" , - 1 ) return end if #endif dects ( counts ) = camera ( p1 , p2 , p3 , layer , nbins , maxval , trackHistory ) counts = counts + 1 end subroutine handle_camera","tags":"","loc":"proc/handle_camera.html"},{"title":"handle_circle_dect – signedMCRT","text":"private subroutine handle_circle_dect(child, dects, counts, context, error) Uses detectors sim_state_mod Read in Circle_detector settings and initalise variable Arguments Type Intent Optional Attributes Name type(toml_table), intent(in), pointer :: child type( circle_dect ), intent(inout) :: dects (:) integer, intent(inout) :: counts type(toml_context), intent(in) :: context type(toml_error), intent(out), allocatable :: error Contents Source Code handle_circle_dect Source Code subroutine handle_circle_dect ( child , dects , counts , context , error ) !! Read in Circle_detector settings and initalise variable use detectors , only : circle_dect use sim_state_mod , only : state type ( toml_table ), pointer , intent ( in ) :: child type ( circle_dect ), intent ( inout ) :: dects (:) integer , intent ( inout ) :: counts type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error integer :: layer , nbins real ( kind = wp ) :: maxval , radius type ( vector ) :: pos , dir logical :: trackHistory pos = get_vector ( child , \"position\" , context = context , error = error ) dir = get_vector ( child , \"direction\" , default = vector ( 0.0 , 0.0 , - 1.0 ), context = context , error = error ) dir = dir % magnitude () call get_value ( child , \"layer\" , layer , 1 ) call get_value ( child , \"radius1\" , radius ) call get_value ( child , \"nbins\" , nbins , 100 ) call get_value ( child , \"maxval\" , maxval , 10 0._wp ) call get_value ( child , \"trackHistory\" , trackHistory , . false .) if ( trackHistory ) state % trackHistory = . true . #ifdef _OPENMP if ( trackHistory ) then call make_error ( error , \"Track history currently incompatable with OpenMP!\" , - 1 ) return end if #endif dects ( counts ) = circle_dect ( pos , dir , layer , radius , nbins , maxval , trackHistory ) counts = counts + 1 end subroutine handle_circle_dect","tags":"","loc":"proc/handle_circle_dect.html"},{"title":"parse_detectors – signedMCRT","text":"private subroutine parse_detectors(table, dects, context, error) Uses detectors sim_state_mod parse the detectors Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type( dect_array ), allocatable :: dects (:) Detector array to be filled. type(toml_context), intent(in) :: context Context handle for error reporting. type(toml_error), intent(out), allocatable :: error Contents Source Code parse_detectors Source Code subroutine parse_detectors ( table , dects , context , error ) !! parse the detectors use detectors , only : dect_array , circle_dect , annulus_dect , camera use sim_state_mod , only : state !> Input Toml table type ( toml_table ), intent ( inout ) :: table !> Detector array to be filled. type ( dect_array ), allocatable :: dects (:) !> Context handle for error reporting. type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_array ), pointer :: array type ( toml_table ), pointer :: child character ( len = :), allocatable :: dect_type type ( circle_dect ), target , save , allocatable :: dect_c (:) type ( annulus_dect ), target , save , allocatable :: dect_a (:) type ( camera ), target , save , allocatable :: dect_cam (:) integer :: i , c_counter , a_counter , cam_counter , j , k , origin c_counter = 0 a_counter = 0 cam_counter = 0 call get_value ( table , \"detectors\" , array ) allocate ( dects ( len ( array ))) do i = 1 , len ( array ) call get_value ( array , i , child ) call get_value ( child , \"type\" , dect_type , origin = origin ) select case ( dect_type ) case default call make_error ( error , & context % report ( \"Invalid detector type. Valid types are [circle, annulus, camera]\" , & origin , \"expected valid detector type\" ), - 1 ) return case ( \"circle\" ) c_counter = c_counter + 1 case ( \"annulus\" ) a_counter = a_counter + 1 case ( \"camera\" ) cam_counter = cam_counter + 1 end select end do if ( c_counter > 0 ) allocate ( dect_c ( c_counter )) if ( a_counter > 0 ) allocate ( dect_a ( a_counter )) if ( cam_counter > 0 ) allocate ( dect_cam ( cam_counter )) c_counter = 1 a_counter = 1 cam_counter = 1 state % trackHistory = . false . do i = 1 , len ( array ) call get_value ( array , i , child ) call get_value ( child , \"type\" , dect_type ) call get_value ( child , \"historyFileName\" , state % historyFilename , \"photPos.obj\" ) select case ( dect_type ) case ( \"circle\" ) call handle_circle_dect ( child , dect_c , c_counter , context , error ) if ( allocated ( error )) return case ( \"annulus\" ) call handle_annulus_dect ( child , dect_a , a_counter , context , error ) if ( allocated ( error )) return case ( \"camera\" ) call handle_camera ( child , dect_cam , cam_counter , context , error ) if ( allocated ( error )) return end select end do do i = 1 , c_counter - 1 allocate ( dects ( i )% p , source = dect_c ( i )) dects ( i )% p => dect_c ( i ) end do do j = 1 , a_counter - 1 allocate ( dects ( j + i - 1 )% p , source = dect_a ( j )) dects ( j + i - 1 )% p => dect_a ( j ) end do do k = 1 , cam_counter - 1 allocate ( dects ( j + i + k - 2 )% p , source = dect_cam ( k )) dects ( j + i + k - 2 )% p => dect_cam ( k ) end do if (. not . allocated ( state % historyFilename )) state % historyFilename = \"photPos.obj\" end subroutine parse_detectors","tags":"","loc":"proc/parse_detectors.html"},{"title":"parse_geometry – signedMCRT","text":"private subroutine parse_geometry(table, dict, error) Uses sim_state_mod parse geometry information Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type(toml_table), intent(inout) :: dict Dictonary used to store metadata type(toml_error), intent(out), allocatable :: error Contents Source Code parse_geometry Source Code subroutine parse_geometry ( table , dict , error ) !! parse geometry information use sim_state_mod , only : state !> Input Toml table type ( toml_table ), intent ( INOUT ) :: table !> Dictonary used to store metadata type ( toml_table ), intent ( INOUT ) :: dict type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), pointer :: child real ( kind = wp ) :: tau , musb , musc , muab , muac , hgg integer :: num_spheres call get_value ( table , \"geometry\" , child ) if ( associated ( child )) then call get_value ( child , \"geom_name\" , state % experiment , \"sphere\" ) call get_value ( child , \"tau\" , tau , 1 0._wp ) call set_value ( dict , \"tau\" , tau ) call get_value ( child , \"num_spheres\" , num_spheres , 10 ) call set_value ( dict , \"num_spheres\" , num_spheres ) call get_value ( child , \"musb\" , musb , 0.0_wp ) call set_value ( dict , \"musb\" , musb ) call get_value ( child , \"muab\" , muab , 0.01_wp ) call set_value ( dict , \"muab\" , muab ) call get_value ( child , \"musc\" , musc , 0.0_wp ) call set_value ( dict , \"musc\" , musc ) call get_value ( child , \"muac\" , muac , 0.01_wp ) call set_value ( dict , \"muac\" , muac ) call get_value ( child , \"hgg\" , hgg , 0.7_wp ) call set_value ( dict , \"hgg\" , hgg ) else call make_error ( error , \"Need geometry table in input param file\" , - 1 ) end if end subroutine parse_geometry","tags":"","loc":"proc/parse_geometry.html"},{"title":"parse_grid – signedMCRT","text":"private subroutine parse_grid(table, dict, error) Uses sim_state_mod gridMod parse grid input data Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type(toml_table), intent(inout) :: dict Dictonary used to store metadata type(toml_error), intent(out), allocatable :: error Contents Source Code parse_grid Source Code subroutine parse_grid ( table , dict , error ) !! parse grid input data use sim_state_mod , only : state use gridMod , only : init_grid !> Input Toml table type ( toml_table ), intent ( inout ) :: table !> Dictonary used to store metadata type ( toml_table ), intent ( inout ) :: dict type ( toml_error ), allocatable , intent ( out ) :: error character ( len = :), allocatable :: msg type ( toml_table ), pointer :: child integer :: nxg , nyg , nzg real ( kind = wp ) :: xmax , ymax , zmax character ( len = :), allocatable :: units call get_value ( table , \"grid\" , child ) if ( associated ( child )) then call get_value ( child , \"nxg\" , nxg , 200 ) call get_value ( child , \"nyg\" , nyg , 200 ) call get_value ( child , \"nzg\" , nzg , 200 ) call get_value ( child , \"xmax\" , xmax , 1.0_wp ) call get_value ( child , \"ymax\" , ymax , 1.0_wp ) call get_value ( child , \"zmax\" , zmax , 1.0_wp ) call get_value ( child , \"units\" , units , \"cm\" ) call set_value ( dict , \"units\" , units ) else msg = \"Need grid table in input param file\" call make_error ( error , msg ) return end if state % grid = init_grid ( nxg , nyg , nzg , xmax , ymax , zmax ) end subroutine parse_grid","tags":"","loc":"proc/parse_grid.html"},{"title":"parse_output – signedMCRT","text":"private subroutine parse_output(table, error) Uses sim_state_mod parse output file information Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type(toml_error), intent(out), allocatable :: error Contents Source Code parse_output Source Code subroutine parse_output ( table , error ) !! parse output file information use sim_state_mod , only : state !> Input Toml table type ( toml_table ), intent ( inout ) :: table type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), pointer :: child type ( toml_array ), pointer :: children integer :: i , nlen call get_value ( table , \"output\" , child ) if ( associated ( child )) then call get_value ( child , \"fluence\" , state % outfile , \"fluence.nrrd\" ) call get_value ( child , \"absorb\" , state % outfile_absorb , \"absorb.nrrd\" ) call get_value ( child , \"render\" , state % renderfile , \"geom_render.nrrd\" ) call get_value ( child , \"render_geom\" , state % render_geom , . false .) call get_value ( child , \"render_size\" , children , requested = . false .) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , \"Need a vector of size 3 for render_size.\" , - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , state % render_size ( i )) end do else state % render_size = [ 200 , 200 , 200 ] end if call get_value ( child , \"overwrite\" , state % overwrite , . false .) else call make_error ( error , \"Need output table in input param file\" , - 1 ) return end if end subroutine parse_output","tags":"","loc":"proc/parse_output.html"},{"title":"parse_params – signedMCRT","text":"public subroutine parse_params(filename, packet, dects, spectrum, dict, error) Uses detectors piecewiseMod photonMod entry point for parsing toml file Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: filename filename of input toml file type( photon ), intent(out) :: packet some input options set up data in the photon class type( dect_array ), intent(out), allocatable :: dects (:) detector array which is setup during parsing type( spectrum_t ), intent(out) :: spectrum spectrum type which is set up during parsing type(toml_table), intent(inout) :: dict dictionary that stores potential metadata to be saved with simulation output type(toml_error), intent(out), allocatable :: error Last error raised during parsing. Unallocated if no error raised. Need to handle this on return from parse_params. Contents Source Code parse_params Source Code subroutine parse_params ( filename , packet , dects , spectrum , dict , error ) !! entry point for parsing toml file use detectors , only : dect_array use photonmod use piecewiseMod !> filename of input toml file character ( * ), intent ( IN ) :: filename !> dictionary that stores potential metadata to be saved with simulation output type ( toml_table ), intent ( INOUT ) :: dict !> some input options set up data in the photon class type ( photon ), intent ( OUT ) :: packet !> detector array which is setup during parsing type ( dect_array ), allocatable , intent ( out ) :: dects (:) !> spectrum type which is set up during parsing type ( spectrum_t ), intent ( out ) :: spectrum !> Last error raised during parsing. Unallocated if no error raised. Need to handle this on return from parse_params. type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), allocatable :: table type ( toml_context ) :: context call toml_load ( table , trim ( filename ), context = context , error = error ) if ( allocated ( error )) return call parse_source ( table , packet , dict , spectrum , context , error ) if ( allocated ( error )) return call parse_grid ( table , dict , error ) if ( allocated ( error )) return call parse_geometry ( table , dict , error ) if ( allocated ( error )) return call parse_detectors ( table , dects , context , error ) if ( allocated ( error )) return call parse_output ( table , error ) if ( allocated ( error )) return call parse_simulation ( table , error ) if ( allocated ( error )) return end subroutine parse_params","tags":"","loc":"proc/parse_params.html"},{"title":"parse_simulation – signedMCRT","text":"private subroutine parse_simulation(table, error) Uses sim_state_mod parse simulation information Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type(toml_error), intent(out), allocatable :: error Contents Source Code parse_simulation Source Code subroutine parse_simulation ( table , error ) !! parse simulation information use sim_state_mod , only : state !> Input Toml table type ( toml_table ), intent ( inout ) :: table type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), pointer :: child call get_value ( table , \"simulation\" , child ) if ( associated ( child )) then call get_value ( child , \"iseed\" , state % iseed , 123456789 ) call get_value ( child , \"tev\" , state % tev , . false .) call get_value ( child , \"absorb\" , state % absorb , . false .) else call make_error ( error , \"Need simulation table in input param file\" , - 1 ) return end if end subroutine parse_simulation","tags":"","loc":"proc/parse_simulation.html"},{"title":"parse_source – signedMCRT","text":"private subroutine parse_source(table, packet, dict, spectrum, context, error) Uses sim_state_mod piecewiseMod tomlf_error photonMod Parse sources\nany updates here MUST be reflected in docs/config.md Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type( photon ), intent(out) :: packet Photon packet. Used to store information to save computation type(toml_table), intent(inout) :: dict Dictonary used to store metadata type( spectrum_t ), intent(out) :: spectrum Spectrum type. type(toml_context) :: context Context handle for error reporting type(toml_error), intent(out), allocatable :: error Error message Contents Source Code parse_source Source Code subroutine parse_source ( table , packet , dict , spectrum , context , error ) !! Parse sources !! any updates here MUST be reflected in docs/config.md use sim_state_mod , only : state use photonmod use piecewiseMod use tomlf_error !> Input Toml table type ( toml_table ), intent ( inout ) :: table !> Dictonary used to store metadata type ( toml_table ), intent ( inout ) :: dict !> Photon packet. Used to store information to save computation type ( photon ), intent ( out ) :: packet !> Spectrum type. type ( spectrum_t ), intent ( out ) :: spectrum !> Context handle for error reporting type ( toml_context ) :: context !> Error message type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), pointer :: child type ( toml_array ), pointer :: children type ( vector ) :: poss , dirr real ( kind = wp ) :: dir ( 3 ), pos ( 3 ), corners ( 3 , 3 ), radius , beta , rlo , rhi integer :: i , nlen , origin character ( len = 1 ) :: axis ( 3 ) character ( len = :), allocatable :: direction , annulus_type axis = [ \"x\" , \"y\" , \"z\" ] pos = 0._wp dir = 0._wp corners = reshape (( / - 1._wp , - 1._wp , 1._wp , & 2._wp , 0._wp , 0._wp , & 0._wp , 2._wp , 0._wp / ), & shape ( corners ), order = [ 2 , 1 ]) call get_value ( table , \"source\" , child , requested = . false .) if ( associated ( child )) then call get_value ( child , \"name\" , state % source , \"point\" ) call get_value ( child , \"nphotons\" , state % nphotons , 1000000 ) call get_value ( child , \"position\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a vector of size 3 for position\" , origin , \"expected vector of size 3\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , pos ( i )) end do else if ( state % source == \"point\" ) then call make_error ( error , & context % report ( \"Point source needs a position!\" , origin , \"Need vector of size 3 for position\" ), - 1 ) return end if end if poss = vector ( pos ( 1 ), pos ( 2 ), pos ( 3 )) children => null () call get_value ( child , \"direction\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then if ( state % source == \"point\" ) then print '(a)' , context % report (& \"Point source needs no direction!!\" , origin , level = toml_level % warning ) end if nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a vector of size 3 for direction\" , origin , \"expected vector of size 3\" ), - 1 ) return end if if ( state % source == \"circular\" ) then print '(a)' , context % report (& \"Direction not yet fully tested for source type Circular. Results may not be accurate!\" , origin ,& level = toml_level % warning ) end if do i = 1 , len ( children ) call get_value ( children , i , dir ( i )) end do dirr % x = dir ( 1 ) dirr % y = dir ( 2 ) dirr % z = dir ( 3 ) else call get_value ( child , \"direction\" , direction , origin = origin ) if ( allocated ( direction )) then if ( state % source == \"point\" ) then print '(a)' , context % report (& \"Point source needs no direction!!\" , origin , level = toml_level % warning ) end if select case ( direction ) case ( \"x\" ) dirr = vector ( 1._wp , 0._wp , 0._wp ) case ( \"-x\" ) dirr = vector ( - 1._wp , 0._wp , 0._wp ) case ( \"y\" ) dirr = vector ( 0._wp , 1._wp , 0._wp ) case ( \"-y\" ) dirr = vector ( 0._wp , - 1._wp , 0._wp ) case ( \"z\" ) dirr = vector ( 0._wp , 0._wp , 1._wp ) case ( \"-z\" ) dirr = vector ( 0._wp , 0._wp , - 1._wp ) case default call make_error ( error , context % report ( \"Direction needs a cardinal direction i.e x, y, or z\" , origin , & \"Expected cardinal direction\" ), - 1 ) return end select elseif ( state % source /= \"point\" ) then call make_error ( error , context % report ( \"Need to specify direction for source type!\" , origin , & \"No direction specified\" ), - 1 ) return end if end if children => null () call get_value ( child , \"point1\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a matrix row for points\" , origin , \"expected matrix row of size 3\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , corners ( i , 1 )) call set_value ( dict , \"pos1%\" // axis ( i ), corners ( i , 1 )) end do else if ( state % source == \"uniform\" ) then call make_error ( error , & context % report ( \"Uniform source requires point1 variable\" , origin , \"expected point1 variable\" ), - 1 ) return end if end if call get_value ( child , \"point2\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a matrix row for points\" , origin , \"expected matrix row of size 3\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , corners ( i , 2 )) call set_value ( dict , \"pos2%\" // axis ( i ), corners ( i , 2 )) end do else if ( state % source == \"uniform\" ) then call make_error ( error , & context % report ( \"Uniform source requires point2 variable\" , origin , \"expected point2 variable\" ), - 1 ) return end if end if call get_value ( child , \"point3\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a matrix row for points\" , origin , \"expected matrix row of size 3\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , corners ( i , 3 )) call set_value ( dict , \"pos3%\" // axis ( i ), corners ( i , 3 )) end do else if ( state % source == \"uniform\" ) then call make_error ( error , & context % report ( \"Uniform source requires point3 variable\" , origin , \"expected point3 variable\" ), - 1 ) return end if end if call get_value ( child , \"radius\" , radius , 0.5_wp ) call set_value ( dict , \"radius\" , radius ) ! parameters for annulus beam type call get_value ( child , \"beta\" , beta , 5._wp ) call set_value ( dict , \"beta\" , beta ) call get_value ( child , \"radius_hi\" , rhi , 0.6_wp ) call set_value ( dict , \"rhi\" , rhi ) call get_value ( child , \"annulus_type\" , annulus_type , \"gaussian\" ) call set_value ( dict , \"annulus_type\" , annulus_type ) ! parse spectrum call parse_spectrum ( child , spectrum , dict , context , error ) if ( allocated ( error )) return else call make_error ( error , context % report ( \"Simulation needs Source table\" , origin , \"Missing source table\" ), - 1 ) return end if call set_photon ( poss , dirr ) packet = photon ( state % source ) packet % pos = poss packet % nxp = dirr % x packet % nyp = dirr % y packet % nzp = dirr % z end subroutine parse_source","tags":"","loc":"proc/parse_source.html"},{"title":"parse_spectrum – signedMCRT","text":"private subroutine parse_spectrum(table, spectrum, dict, context, error) Uses stdlib_io piecewiseMod iso_c_binding stb_image_mod constants Parse spectrums to be used Arguments Type Intent Optional Attributes Name type(toml_table), pointer :: table type( spectrum_t ), intent(out) :: spectrum type(toml_table), intent(inout) :: dict type(toml_context) :: context type(toml_error), intent(out), allocatable :: error Contents Source Code parse_spectrum Source Code subroutine parse_spectrum ( table , spectrum , dict , context , error ) !! Parse spectrums to be used ! TODO seperate out each case to seperate functions. ! TODO add spectra type to input optical properties ! handle all possible errors ! document code and update config.md use piecewiseMod use stdlib_io , only : loadtxt use constants , only : resdir , sp use stb_image_mod use , intrinsic :: iso_c_binding type ( toml_table ), intent ( INOUT ) :: dict type ( toml_table ), pointer :: table type ( toml_context ) :: context type ( spectrum_t ), intent ( out ) :: spectrum type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_array ), pointer :: children integer :: origin , nlen , i , err , width , height , n_channels , u integer , allocatable :: image (:,:,:) type ( constant ), save , target :: const type ( piecewise1D ), save , target :: OneD type ( piecewise2D ), save , target :: TwoD character ( len = :), allocatable :: stype , sfile , filetype real ( kind = wp ) :: wavelength , cellsize ( 2 ) real ( kind = wp ), allocatable :: array (:,:) real ( kind = sp ), allocatable :: array_sp (:,:) call get_value ( table , \"spectrum_type\" , stype , \"constant\" , origin = origin ) select case ( stype ) case ( \"constant\" ) call get_value ( table , \"wavelength\" , wavelength , 50 0.0_wp ) const = constant ( wavelength ) allocate ( spectrum % p , source = const ) spectrum % p => const case ( \"1D\" ) allocate ( spectrum % p , source = OneD ) call get_value ( table , \"spectrum_file\" , sfile ) call loadtxt ( \"res/\" // sfile , array_sp ) array = array_sp deallocate ( array_sp ) OneD = piecewise1D ( array ) allocate ( spectrum % p , source = OneD ) spectrum % p => OneD case ( \"2D\" ) allocate ( spectrum % p , source = TwoD ) call get_value ( table , \"spectrum_file\" , sfile ) call get_value ( table , \"cell_size\" , children , requested = . true ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen /= 2 ) then call make_error ( error ,& context % report ( \"Need a vector of size 2 for cell_size\" , origin , \"expected vector of size 2\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , cellsize ( i )) end do else call make_error ( error ,& context % report ( \"Need a vector of size 2 for cell_size\" , origin , \"expected vector of size 2\" ), - 1 ) return end if filetype = sfile ( len ( sfile ) - 2 :) select case ( filetype ) case ( \"png\" ) err = stbi_info ( trim ( resdir ) // trim ( sfile ) // c_null_char , width , height , n_channels ) if ( err == 0 ) then call make_error ( error , \"Error reading file: \" // trim ( sfile ) // \" \" // stbi_failure_reason (), - 1 ) return end if image = stbi_load ( trim ( resdir ) // trim ( sfile ) // c_null_char , width , height , n_channels , 0 ) allocate ( array ( size ( image , 1 ), size ( image , 2 ))) array = image (:,:, 1 ) deallocate ( image ) case ( \"dat\" ) call loadtxt ( resdir // trim ( sfile ), array ) case ( \"txt\" ) call loadtxt ( resdir // trim ( sfile ), array ) case default print '(2a)' , \"Unknown spectrum file type:\" , filetype end select TwoD = piecewise2D ( cellsize ( 1 ), cellsize ( 2 ), array ) allocate ( spectrum % p , source = TwoD ) spectrum % p => TwoD case default call make_error ( error ,& context % report ( \"Not a valid spectrum type!\" , origin , \"expected one of either ['constant', '1D', '2D']\" ), - 1 ) return end select end subroutine parse_spectrum","tags":"","loc":"proc/parse_spectrum.html"},{"title":"init_vec4_vector_real – signedMCRT","text":"private function init_vec4_vector_real(vec, val) result(out) Uses vector_class Initalise vec4 from a vec3 and Scalar\ne.g vec4 = [vec3%x, vec3%y, vec3%z, scalar] Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: vec Input vec3 real(kind=wp), intent(in) :: val Input Scalar Return Value type( vec4 ) Contents Source Code init_vec4_vector_real Source Code type ( vec4 ) function init_vec4_vector_real ( vec , val ) result ( out ) !! Initalise vec4 from a vec3 and Scalar !! e.g vec4 = [vec3%x, vec3%y, vec3%z, scalar] use vector_class !> Input vec3 type ( vector ), intent ( in ) :: vec !> Input Scalar real ( kind = wp ), intent ( in ) :: val out % x = vec % x out % y = vec % y out % z = vec % z out % p = val end function init_vec4_vector_real","tags":"","loc":"proc/init_vec4_vector_real.html"},{"title":"length – signedMCRT","text":"private pure elemental function length(this) Returns the length of a vec4 Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: this Return Value real(kind=wp) Contents","tags":"","loc":"proc/length~2.html"},{"title":"magnitude_fn – signedMCRT","text":"private pure elemental function magnitude_fn(this) Returns the magnitude of a vec4 Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: this Return Value type( vec4 ) Contents Source Code magnitude_fn Source Code type ( vec4 ) pure elemental function magnitude_fn ( this ) !! Returns the magnitude of a vec4 class ( vec4 ), intent ( in ) :: this magnitude_fn = this / this % length () end function magnitude_fn","tags":"","loc":"proc/magnitude_fn.html"},{"title":"scal_add_vec – signedMCRT","text":"private pure elemental function scal_add_vec(a, b) Elementwise scalar + vec4 Type Bound vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to add class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) Contents Source Code scal_add_vec Source Code type ( vec4 ) pure elemental function scal_add_vec ( a , b ) !! Elementwise scalar + vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: b !> Scalar to add real ( kind = wp ), intent ( IN ) :: a scal_add_vec = vec4 ( b % x + a , b % y + a , b % z + a , b % p + a ) end function scal_add_vec","tags":"","loc":"proc/scal_add_vec~2.html"},{"title":"scal_minus_vec – signedMCRT","text":"private pure elemental function scal_minus_vec(a, b) Elementwise Scalar - vec4 Type Bound vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to subtract class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) Contents Source Code scal_minus_vec Source Code type ( vec4 ) pure elemental function scal_minus_vec ( a , b ) !! Elementwise Scalar - vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: b !> Scalar to subtract real ( kind = wp ), intent ( IN ) :: a scal_minus_vec = vec4 ( a - b % x , a - b % y , a - b % z , a - b % p ) end function scal_minus_vec","tags":"","loc":"proc/scal_minus_vec~2.html"},{"title":"scal_mult_vec – signedMCRT","text":"private pure elemental function scal_mult_vec(a, b) Elementwise Scalar * vec4 Type Bound vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) Contents Source Code scal_mult_vec Source Code type ( vec4 ) pure elemental function scal_mult_vec ( a , b ) !! Elementwise Scalar * vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: b !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: a scal_mult_vec = vec4 ( a * b % x , a * b % y , a * b % z , a * b % p ) end function scal_mult_vec","tags":"","loc":"proc/scal_mult_vec~2.html"},{"title":"sin_vec – signedMCRT","text":"private pure elemental function sin_vec(p) Sine of a vec4, elementwise Arguments Type Intent Optional Attributes Name type( vec4 ), intent(in) :: p Input vec4 Return Value type( vec4 ) Contents Source Code sin_vec Source Code type ( vec4 ) pure elemental function sin_vec ( p ) !! Sine of a vec4, elementwise !> Input vec4 type ( vec4 ), intent ( IN ) :: p sin_vec = vec4 ( sin ( p % x ), sin ( p % y ), sin ( p % z ), sin ( p % p )) end function sin_vec","tags":"","loc":"proc/sin_vec.html"},{"title":"vec_add_scal – signedMCRT","text":"private pure elemental function vec_add_scal(a, b) Elementwise vec4 + scalar Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to add Return Value type( vec4 ) Contents Source Code vec_add_scal Source Code type ( vec4 ) pure elemental function vec_add_scal ( a , b ) !! Elementwise vec4 + scalar !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to add real ( kind = wp ), intent ( IN ) :: b vec_add_scal = vec4 ( a % x + b , a % y + b , a % z + b , a % p + b ) end function vec_add_scal","tags":"","loc":"proc/vec_add_scal~2.html"},{"title":"vec_add_vec – signedMCRT","text":"private pure elemental function vec_add_vec(a, b) Elementwise vec4 + vec4 Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to add Return Value type( vec4 ) Contents Source Code vec_add_vec Source Code type ( vec4 ) pure elemental function vec_add_vec ( a , b ) !! Elementwise vec4 + vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> vec4 to add type ( vec4 ), intent ( IN ) :: b vec_add_vec = vec4 ( a % x + b % x , a % y + b % y , a % z + b % z , a % p + b % p ) end function vec_add_vec","tags":"","loc":"proc/vec_add_vec~2.html"},{"title":"vec_div_scal_int – signedMCRT","text":"private pure elemental function vec_div_scal_int(a, b) Elementwise vec4 / Scalar. Scalar is an integer Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 integer, intent(in) :: b Scalar to divide by Return Value type( vec4 ) Contents Source Code vec_div_scal_int Source Code type ( vec4 ) pure elemental function vec_div_scal_int ( a , b ) !! Elementwise vec4 / Scalar. Scalar is an integer !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to divide by integer , intent ( IN ) :: b vec_div_scal_int = vec4 ( a % x / real ( b , kind = wp ), a % y / real ( b , kind = wp ), a % z / real ( b , kind = wp ), a % p / real ( b , kind = wp )) end function vec_div_scal_int","tags":"","loc":"proc/vec_div_scal_int~2.html"},{"title":"vec_div_scal_r4 – signedMCRT","text":"private pure elemental function vec_div_scal_r4(a, b) Uses constants Elementwise vec4 / Scalar. Scalar is 32-bit float Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=sp), intent(in) :: b Scalar to divide by Return Value type( vec4 ) Contents Source Code vec_div_scal_r4 Source Code type ( vec4 ) pure elemental function vec_div_scal_r4 ( a , b ) !! Elementwise vec4 / Scalar. Scalar is 32-bit float use constants , only : sp !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to divide by real ( kind = sp ), intent ( IN ) :: b vec_div_scal_r4 = vec4 ( a % x / b , a % y / b , a % z / b , a % p / b ) end function vec_div_scal_r4","tags":"","loc":"proc/vec_div_scal_r4~2.html"},{"title":"vec_div_scal_r8 – signedMCRT","text":"private pure elemental function vec_div_scal_r8(a, b) Uses constants Elementwise vec4 / Scalar. Scalar is 32-bit float Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=dp), intent(in) :: b Scalar to divide by Return Value type( vec4 ) Contents Source Code vec_div_scal_r8 Source Code type ( vec4 ) pure elemental function vec_div_scal_r8 ( a , b ) !! Elementwise vec4 / Scalar. Scalar is 32-bit float use constants , only : dp !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to divide by real ( kind = dp ), intent ( IN ) :: b vec_div_scal_r8 = vec4 ( a % x / b , a % y / b , a % z / b , a % p / b ) end function vec_div_scal_r8","tags":"","loc":"proc/vec_div_scal_r8~2.html"},{"title":"vec_dot_vec – signedMCRT","text":"private pure elemental function vec_dot_vec(a, b) result(dot) dot product between two vec4s Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to dot with Return Value real(kind=wp) Contents Source Code vec_dot_vec Source Code pure elemental function vec_dot_vec ( a , b ) result ( dot ) !! dot product between two vec4s !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> vec4 to dot with type ( vec4 ), intent ( IN ) :: b real ( kind = wp ) :: dot dot = ( a % x * b % x ) + ( a % y * b % y ) + ( a % z * b % z ) + ( a % p * b % p ) end function vec_dot_vec","tags":"","loc":"proc/vec_dot_vec~2.html"},{"title":"vec_minus_scal – signedMCRT","text":"private pure elemental function vec_minus_scal(a, b) Elementwise vec4 - scalar Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( vec4 ) Contents Source Code vec_minus_scal Source Code type ( vec4 ) pure elemental function vec_minus_scal ( a , b ) !! Elementwise vec4 - scalar !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to subtract real ( kind = wp ), intent ( IN ) :: b vec_minus_scal = vec4 ( a % x - b , a % y - b , a % z - b , a % p - b ) end function vec_minus_scal","tags":"","loc":"proc/vec_minus_scal~2.html"},{"title":"vec_minus_vec – signedMCRT","text":"private pure elemental function vec_minus_vec(a, b) Elementwise vec4 - vec4 Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to subtract Return Value type( vec4 ) Contents Source Code vec_minus_vec Source Code type ( vec4 ) pure elemental function vec_minus_vec ( a , b ) !! Elementwise vec4 - vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> vec4 to subtract type ( vec4 ), intent ( IN ) :: b vec_minus_vec = vec4 ( a % x - b % x , a % y - b % y , a % z - b % z , a % p - b % p ) end function vec_minus_vec","tags":"","loc":"proc/vec_minus_vec~2.html"},{"title":"vec_mult_scal – signedMCRT","text":"private pure elemental function vec_mult_scal(a, b) Elementwise vec4 * Scalar Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( vec4 ) Contents Source Code vec_mult_scal Source Code type ( vec4 ) pure elemental function vec_mult_scal ( a , b ) !! Elementwise vec4 * Scalar !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: b vec_mult_scal = vec4 ( a % x * b , a % y * b , a % z * b , a % p * b ) end function vec_mult_scal","tags":"","loc":"proc/vec_mult_scal~2.html"},{"title":"vec_mult_vec – signedMCRT","text":"private pure elemental function vec_mult_vec(a, b) Elementwise vec4 * vec4 Type Bound vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to multiply by Return Value type( vec4 ) Contents Source Code vec_mult_vec Source Code type ( vec4 ) pure elemental function vec_mult_vec ( a , b ) !! Elementwise vec4 * vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> vec4 to multiply by type ( vec4 ), intent ( IN ) :: b vec_mult_vec = vec4 ( a % x * b % x , a % y * b % y , a % z * b % z , a % p * b % p ) end function vec_mult_vec","tags":"","loc":"proc/vec_mult_vec~2.html"},{"title":"sin – signedMCRT","text":"public interface sin Vec4 overload of the sin intrinsic Contents Module Procedures sin_vec Module Procedures private pure elemental function sin_vec (p) Sine of a vec4, elementwise Arguments Type Intent Optional Attributes Name type( vec4 ), intent(in) :: p Input vec4 Return Value type( vec4 )","tags":"","loc":"interface/sin.html"},{"title":"vec4 – signedMCRT","text":"public interface vec4 Initalise a vec4 from a vec3 and a scalar Contents Module Procedures init_vec4_vector_real Module Procedures private function init_vec4_vector_real (vec, val) result(out) Initalise vec4 from a vec3 and Scalar\ne.g vec4 = [vec3%x, vec3%y, vec3%z, scalar] Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: vec Input vec3 real(kind=wp), intent(in) :: val Input Scalar Return Value type( vec4 )","tags":"","loc":"interface/vec4.html"},{"title":"get_voxel – signedMCRT","text":"private function get_voxel(this, pos) result(res) Uses vector_class get current voxel the photon packet is in Type Bound cart_grid Arguments Type Intent Optional Attributes Name class( cart_grid ) :: this grid class type( vector ), intent(in) :: pos current vector position of photon packet Return Value integer, (3) Contents Source Code get_voxel Source Code function get_voxel ( this , pos ) result ( res ) !! get current voxel the photon packet is in use vector_class !> grid class class ( cart_grid ) :: this !> current vector position of photon packet type ( vector ), intent ( IN ) :: pos integer :: res ( 3 ) res ( 1 ) = int ( this % nxg * ( pos % x + this % xmax ) / ( 2._wp * this % xmax )) + 1 res ( 2 ) = int ( this % nyg * ( pos % y + this % ymax ) / ( 2._wp * this % ymax )) + 1 res ( 3 ) = int ( this % nzg * ( pos % z + this % zmax ) / ( 2._wp * this % zmax )) + 1 end function get_voxel","tags":"","loc":"proc/get_voxel.html"},{"title":"init_grid – signedMCRT","text":"public function init_grid(nxg, nyg, nzg, xmax, ymax, zmax) setup grid Arguments Type Intent Optional Attributes Name integer, intent(in) :: nxg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nyg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nzg number of voxels in each cardinal direction for fluence grid real(kind=wp), intent(in) :: xmax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: ymax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: zmax half size of each dimension in fluence grid. Return Value type( cart_grid ) Contents Source Code init_grid Source Code type ( cart_grid ) function init_grid ( nxg , nyg , nzg , xmax , ymax , zmax ) !! setup grid !> number of voxels in each cardinal direction for fluence grid integer , intent ( IN ) :: nxg , nyg , nzg !> half size of each dimension in fluence grid. real ( kind = wp ), intent ( IN ) :: xmax , ymax , zmax integer :: i init_grid % nxg = nxg init_grid % nyg = nyg init_grid % nzg = nzg init_grid % xmax = xmax init_grid % ymax = ymax init_grid % zmax = zmax allocate ( init_grid % xface ( nxg + 1 ), init_grid % yface ( nyg + 1 ), init_grid % zface ( nzg + 2 )) init_grid % xface = 0._wp init_grid % yface = 0._wp init_grid % zface = 0._wp ! Set small distance for use in optical depth integration routines ! for roundoff effects when crossing cell walls init_grid % delta = 1.e-8_wp * min ((( 2._wp * xmax ) / nxg ), (( 2._wp * ymax ) / nyg ), (( 2._wp * zmax ) / nzg )) do i = 1 , nxg + 1 init_grid % xface ( i ) = ( i - 1 ) * 2._wp * xmax / nxg end do do i = 1 , nyg + 1 init_grid % yface ( i ) = ( i - 1 ) * 2._wp * ymax / nyg end do do i = 1 , nzg + 2 init_grid % zface ( i ) = ( i - 1 ) * 2._wp * zmax / nzg end do end function init_grid","tags":"","loc":"proc/init_grid.html"},{"title":"cart_grid – signedMCRT","text":"public interface cart_grid Contents Module Procedures init_grid Module Procedures public function init_grid (nxg, nyg, nzg, xmax, ymax, zmax) setup grid Arguments Type Intent Optional Attributes Name integer, intent(in) :: nxg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nyg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nzg number of voxels in each cardinal direction for fluence grid real(kind=wp), intent(in) :: xmax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: ymax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: zmax half size of each dimension in fluence grid. Return Value type( cart_grid )","tags":"","loc":"interface/cart_grid.html"},{"title":"find – signedMCRT","text":"private function find(val, a) searches for bracketing indices for a value value in an array a Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val value to find in array real(kind=wp), intent(in) :: a (:) array to find val in Return Value integer Contents Source Code find Source Code integer function find ( val , a ) !! searches for bracketing indices for a value value in an array a !> value to find in array real ( kind = wp ), intent ( in ) :: val !> array to find val in real ( kind = wp ), intent ( in ) :: a (:) integer :: n , lo , mid , hi n = size ( a ) lo = 0 hi = n + 1 if ( val == a ( 1 )) then find = 1 else if ( val == a ( n )) then find = n - 1 else if (( val > a ( n )) . or . ( val < a ( 1 ))) then find = - 1 else do if ( hi - lo <= 1 ) exit mid = ( hi + lo ) / 2 if ( val >= a ( mid )) then lo = mid else hi = mid end if end do find = lo end if end function find","tags":"","loc":"proc/find.html"},{"title":"wall_dist – signedMCRT","text":"private function wall_dist(grid, celli, cellj, cellk, pos, dir, ldir) result(res) Uses vector_class gridMod funtion that returns distant to nearest wall and which wall that is (x, y, or z) Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid integer, intent(inout) :: celli integer, intent(inout) :: cellj integer, intent(inout) :: cellk type( vector ), intent(in) :: pos type( vector ), intent(in) :: dir logical, intent(inout) :: ldir (:) Return Value real(kind=wp) Contents Source Code wall_dist Source Code function wall_dist ( grid , celli , cellj , cellk , pos , dir , ldir ) result ( res ) !! funtion that returns distant to nearest wall and which wall that is (x, y, or z) use vector_class use gridMod type ( cart_grid ), intent ( IN ) :: grid type ( vector ), intent ( IN ) :: pos , dir logical , intent ( INOUT ) :: ldir (:) integer , intent ( INOUT ) :: celli , cellj , cellk real ( kind = wp ) :: res real ( kind = wp ) :: dx , dy , dz dx = - 99 9._wp dy = - 99 9._wp dz = - 99 9._wp if ( dir % x > 0._wp ) then dx = ( grid % xface ( celli + 1 ) - pos % x ) / dir % x elseif ( dir % x < 0._wp ) then dx = ( grid % xface ( celli ) - pos % x ) / dir % x elseif ( dir % x == 0._wp ) then dx = 10000 0._wp end if if ( dir % y > 0._wp ) then dy = ( grid % yface ( cellj + 1 ) - pos % y ) / dir % y elseif ( dir % y < 0._wp ) then dy = ( grid % yface ( cellj ) - pos % y ) / dir % y elseif ( dir % y == 0._wp ) then dy = 10000 0._wp end if if ( dir % z > 0._wp ) then dz = ( grid % zface ( cellk + 1 ) - pos % z ) / dir % z elseif ( dir % z < 0._wp ) then dz = ( grid % zface ( cellk ) - pos % z ) / dir % z elseif ( dir % z == 0._wp ) then dz = 10000 0._wp end if res = min ( dx , dy , dz ) if ( res < 0._wp ) then print * , 'dcell < 0.0 warning! ' , res print * , dx , dy , dz print * , dir print * , celli , cellj , cellk error stop 1 end if ldir = [ res == dx , res == dy , res == dz ] if (. not . ldir ( 1 ) . and . . not . ldir ( 2 ) . and . . not . ldir ( 3 )) print * , 'Error in dir flag' end function wall_dist","tags":"","loc":"proc/wall_dist.html"},{"title":"tauint2 – signedMCRT","text":"public subroutine tauint2(grid, packet, sdfs_array) Uses random gridMod sdfs vector_class photonMod surfaces optical depth integration subroutine\nMoves photons to interaction location\nCalculated is any reflection or refraction happens whilst moving Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid type( photon ), intent(inout) :: packet type( sdf ), intent(in) :: sdfs_array (:) Contents Source Code tauint2 Source Code subroutine tauint2 ( grid , packet , sdfs_array ) !! optical depth integration subroutine !! Moves photons to interaction location !! Calculated is any reflection or refraction happens whilst moving ! use gridMod , only : cart_grid use photonMod , only : photon use random , only : ran2 use sdfs , only : sdf , calcNormal use surfaces , only : reflect_refract use vector_class , only : vector type ( cart_grid ), intent ( in ) :: grid type ( photon ), intent ( inout ) :: packet type ( sdf ), intent ( in ) :: sdfs_array (:) real ( kind = wp ) :: tau , d_sdf , t_sdf , taurun , ds ( size ( sdfs_array )), dstmp ( size ( sdfs_array )) real ( kind = wp ) :: eps , dtot , old ( size ( sdfs_array )), new ( size ( sdfs_array )), n1 , n2 , Ri integer :: i , oldlayer , new_layer type ( vector ) :: pos , dir , oldpos , N logical :: rflag !setup temp variables pos = packet % pos oldpos = pos dir = vector ( packet % nxp , packet % nyp , packet % nzp ) !round off distance eps = 1e-8_wp !get random tau tau = - log ( ran2 ()) taurun = 0. dtot = 0. do !setup sdf distance and current layer ds = 0. do i = 1 , size ( ds ) ds ( i ) = abs ( sdfs_array ( i )% evaluate ( pos )) end do packet % cnts = packet % cnts + size ( ds ) d_sdf = minval ( ds ) if ( d_sdf < eps ) then packet % tflag = . true . exit end if do while ( d_sdf > eps ) t_sdf = d_sdf * sdfs_array ( packet % layer )% getkappa () if ( taurun + t_sdf <= tau ) then !move full distance to sdf surface taurun = taurun + t_sdf oldpos = pos !comment out for phase screen call update_grids ( grid , oldpos , dir , d_sdf , packet , sdfs_array ( packet % layer )% getmua ()) pos = pos + d_sdf * dir dtot = dtot + d_sdf else !run out of tau so move remaining tau and exit d_sdf = ( tau - taurun ) / sdfs_array ( packet % layer )% getkappa () dtot = dtot + d_sdf taurun = tau oldpos = pos pos = pos + d_sdf * dir !comment out for phase screen call update_grids ( grid , oldpos , dir , d_sdf , packet , sdfs_array ( packet % layer )% getmua ()) exit end if ! get distance to nearest sdf ds = 0._wp do i = 1 , size ( ds ) ds ( i ) = sdfs_array ( i )% evaluate ( pos ) end do d_sdf = minval ( abs ( ds ), dim = 1 ) packet % cnts = packet % cnts + size ( ds ) !check if outside all sdfs if ( minval ( ds ) >= 0._wp ) then packet % tflag = . true . exit end if end do !exit early if conditions met if ( taurun >= tau . or . packet % tflag ) then exit end if ds = 0._wp do i = 1 , size ( ds ) ds ( i ) = sdfs_array ( i )% evaluate ( pos ) end do packet % cnts = packet % cnts + size ( ds ) dstmp = ds ds = abs ( ds ) !step a bit into next sdf to get n2 d_sdf = minval ( ds ) + 2._wp * eps oldpos = pos pos = pos + d_sdf * dir ds = 0._wp do i = 1 , size ( ds ) ds ( i ) = sdfs_array ( i )% evaluate ( pos ) end do packet % cnts = packet % cnts + size ( ds ) new = 0._wp old = 0._wp do i = 1 , size ( ds ) if ( dstmp ( i ) < 0. ) then old ( i ) =- 1._wp exit end if end do do i = 1 , size ( ds ) if ( ds ( i ) < 0. ) then new ( i ) =- 1._wp exit end if end do !check for fresnel reflection n1 = sdfs_array ( packet % layer )% getn () new_layer = minloc ( new , dim = 1 ) n2 = sdfs_array ( new_layer )% getn () !carry out refelction/refraction if ( n1 /= n2 ) then !get correct sdf normal if ( ds ( packet % layer ) < 0._wp . and . ds ( new_layer ) < 0._wp ) then oldlayer = minloc ( abs ([ ds ( packet % layer ), ds ( new_layer )]), dim = 1 ) elseif ( dstmp ( packet % layer ) < 0._wp . and . dstmp ( new_layer ) < 0._wp ) then oldlayer = maxloc ([ dstmp ( packet % layer ), dstmp ( new_layer )], dim = 1 ) elseif ( ds ( packet % layer ) > 0._wp . and . ds ( new_layer ) < 0._wp ) then oldlayer = packet % layer elseif ( ds ( packet % layer ) > 0._wp . and . ds ( new_layer ) > 0._wp ) then packet % tflag = . true . exit else error stop \"This should not be reached!\" end if if ( oldlayer == 1 ) then oldlayer = packet % layer else oldlayer = new_layer end if N = calcNormal ( pos , sdfs_array ( oldlayer )) rflag = . false . call reflect_refract ( dir , N , n1 , n2 , rflag , Ri ) packet % weight = packet % weight * Ri tau = - log ( ran2 ()) taurun = 0._wp if (. not . rflag ) then packet % layer = new_layer else !step back inside original sdf pos = oldpos !reflect so incrment bounce counter packet % bounces = packet % bounces + 1 if ( packet % bounces > 1000 ) then packet % tflag = . true . exit end if end if else packet % layer = new_layer end if if ( packet % tflag ) exit end do packet % pos = pos packet % nxp = dir % x packet % nyp = dir % y packet % nzp = dir % z packet % phi = atan2 ( dir % y , dir % x ) packet % sinp = sin ( packet % phi ) packet % cosp = cos ( packet % phi ) packet % cost = dir % z packet % sint = sqrt ( 1._wp - packet % cost ** 2 ) ! packet%step = dtot if ( abs ( packet % pos % x ) > grid % xmax ) then packet % tflag = . true . end if if ( abs ( packet % pos % y ) > grid % ymax ) then packet % tflag = . true . end if if ( abs ( packet % pos % z ) > grid % zmax ) then packet % tflag = . true . end if end subroutine tauint2","tags":"","loc":"proc/tauint2.html"},{"title":"update_grids – signedMCRT","text":"private subroutine update_grids(grid, pos, dir, d_sdf, packet, mua) Uses gridMod vector_class iarray photonMod constants record fluence using path length estimators. Uses voxel grid Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid grid stores voxel grid information (voxel walls and etc) type( vector ), intent(inout) :: pos pos is current position with origin in centre of medium (0,0,0) type( vector ), intent(in) :: dir dir is the current direction (0,0,1) is up real(kind=wp), intent(in) :: d_sdf d_sdf is the distance to travel in voxel grid type( photon ), intent(inout) :: packet packet stores the photon related variables real(kind=wp), intent(in), optional :: mua absoprtion coefficent Contents Source Code update_grids Source Code subroutine update_grids ( grid , pos , dir , d_sdf , packet , mua ) !! record fluence using path length estimators. Uses voxel grid use vector_class use photonMod use gridMod use iarray , only : phasor , jmean , absorb use constants , only : sp !> grid stores voxel grid information (voxel walls and etc) type ( cart_grid ), intent ( IN ) :: grid !> dir is the current direction (0,0,1) is up type ( vector ), intent ( IN ) :: dir !> d_sdf is the distance to travel in voxel grid real ( kind = wp ), intent ( IN ) :: d_sdf !> absoprtion coefficent real ( kind = wp ), optional , intent ( IN ) :: mua !> pos is current position with origin in centre of medium (0,0,0) type ( vector ), intent ( INOUT ) :: pos !> packet stores the photon related variables type ( photon ), intent ( INOUT ) :: packet complex ( kind = sp ) :: phasec type ( vector ) :: old_pos logical :: ldir ( 3 ) integer :: celli , cellj , cellk real ( kind = wp ) :: dcell , delta = 1e-8_wp , d , mua_real if ( present ( mua )) then mua_real = mua else mua_real = 1._wp end if !convert to different coordinate system. Origin is at lower left corner of fluence grid old_pos = vector ( pos % x + grid % xmax , pos % y + grid % ymax , pos % z + grid % zmax ) call update_voxels ( grid , old_pos , celli , cellj , cellk ) packet % xcell = celli packet % ycell = cellj packet % zcell = cellk d = 0._wp !if packet outside grid return if ( celli == - 1 . or . cellj == - 1 . or . cellk == - 1 ) then packet % tflag = . true . pos = vector ( old_pos % x - grid % xmax , old_pos % y - grid % ymax , old_pos % z - grid % zmax ) return end if !move photon through grid updating path length estimators do ldir = ( / . FALSE ., . FALSE ., . FALSE . / ) dcell = wall_dist ( grid , celli , cellj , cellk , old_pos , dir , ldir ) if ( d + dcell > d_sdf ) then dcell = d_sdf - d d = d_sdf ! needs to be atomic so dont write to same array address with more than 1 thread at a time packet % phase = packet % phase + dcell !$omp atomic jmean ( celli , cellj , cellk ) = jmean ( celli , cellj , cellk ) + real ( dcell , kind = sp ) call update_pos ( grid , old_pos , celli , cellj , cellk , dcell , . false ., dir , ldir , delta ) exit else d = d + dcell packet % phase = packet % phase + dcell !$omp atomic jmean ( celli , cellj , cellk ) = jmean ( celli , cellj , cellk ) + real ( dcell , kind = sp ) call update_pos ( grid , old_pos , celli , cellj , cellk , dcell , . true ., dir , ldir , delta ) end if if ( celli == - 1 . or . cellj == - 1 . or . cellk == - 1 ) then packet % tflag = . true . exit end if end do pos = vector ( old_pos % x - grid % xmax , old_pos % y - grid % ymax , old_pos % z - grid % zmax ) packet % xcell = celli packet % ycell = cellj packet % zcell = cellk end subroutine update_grids","tags":"","loc":"proc/update_grids.html"},{"title":"update_pos – signedMCRT","text":"private subroutine update_pos(grid, pos, celli, cellj, cellk, dcell, wall_flag, dir, ldir, delta) Uses vector_class gridMod utils routine that updates positions of photon and calls Fresnel routines if photon leaves current voxel Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid type( vector ), intent(inout) :: pos integer, intent(inout) :: celli integer, intent(inout) :: cellj integer, intent(inout) :: cellk real(kind=wp), intent(in) :: dcell logical, intent(in) :: wall_flag type( vector ), intent(in) :: dir logical, intent(in) :: ldir (:) real(kind=wp), intent(in) :: delta Contents Source Code update_pos Source Code subroutine update_pos ( grid , pos , celli , cellj , cellk , dcell , wall_flag , dir , ldir , delta ) !! routine that updates positions of photon and calls Fresnel routines if photon leaves current voxel use vector_class use gridMod use utils , only : str type ( cart_grid ), intent ( IN ) :: grid type ( vector ), intent ( IN ) :: dir logical , intent ( IN ) :: wall_flag , ldir (:) real ( kind = wp ), intent ( IN ) :: dcell , delta type ( vector ), intent ( INOUT ) :: pos integer , intent ( INOUT ) :: celli , cellj , cellk if ( wall_flag ) then if ( ldir ( 1 )) then if ( dir % x > 0._wp ) then pos % x = grid % xface ( celli + 1 ) + delta elseif ( dir % x < 0._wp ) then pos % x = grid % xface ( celli ) - delta else print * , 'Error in x ldir in update_pos' , ldir , dir end if pos % y = pos % y + dir % y * dcell pos % z = pos % z + dir % z * dcell elseif ( ldir ( 2 )) then if ( dir % y > 0._wp ) then pos % y = grid % yface ( cellj + 1 ) + delta elseif ( dir % y < 0._wp ) then pos % y = grid % yface ( cellj ) - delta else print * , 'Error in y ldir in update_pos' , ldir , dir end if pos % x = pos % x + dir % x * dcell pos % z = pos % z + dir % z * dcell elseif ( ldir ( 3 )) then if ( dir % z > 0._wp ) then pos % z = grid % zface ( cellk + 1 ) + delta elseif ( dir % z < 0._wp ) then pos % z = grid % zface ( cellk ) - delta else print * , 'Error in z ldir in update_pos' , ldir , dir end if pos % x = pos % x + dir % x * dcell pos % y = pos % y + dir % y * dcell else print * , 'Error in update_pos... ' // str ( ldir ) error stop 1 end if else pos % x = pos % x + dir % x * dcell pos % y = pos % y + dir % y * dcell pos % z = pos % z + dir % z * dcell end if if ( wall_flag ) then call update_voxels ( grid , pos , celli , cellj , cellk ) end if end subroutine update_pos","tags":"","loc":"proc/update_pos.html"},{"title":"update_voxels – signedMCRT","text":"public subroutine update_voxels(grid, pos, celli, cellj, cellk) Uses vector_class gridMod updates the current voxel based upon position Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid grid type( vector ), intent(in) :: pos current photon packet position integer, intent(inout) :: celli position of photon packet in grid integer, intent(inout) :: cellj position of photon packet in grid integer, intent(inout) :: cellk position of photon packet in grid Contents Source Code update_voxels Source Code subroutine update_voxels ( grid , pos , celli , cellj , cellk ) !! updates the current voxel based upon position use vector_class use gridmod !> grid type ( cart_grid ), intent ( IN ) :: grid !> current photon packet position type ( vector ), intent ( IN ) :: pos !> position of photon packet in grid integer , intent ( INOUT ) :: celli , cellj , cellk !accurate but slow ! celli = find(pos%x, grid%xface) ! cellj = find(pos%y, grid%yface) ! cellk = find(pos%z, grid%zface) !fast but can be inaccurate in some cases... celli = floor ( grid % nxg * ( pos % x ) / ( 2. * grid % xmax )) + 1 cellj = floor ( grid % nyg * ( pos % y ) / ( 2. * grid % ymax )) + 1 cellk = floor ( grid % nzg * ( pos % z ) / ( 2. * grid % zmax )) + 1 if ( celli > grid % nxg . or . celli < 1 ) celli = - 1 if ( cellj > grid % nyg . or . cellj < 1 ) cellj = - 1 if ( cellk > grid % nzg . or . cellk < 1 ) cellk = - 1 end subroutine update_voxels","tags":"","loc":"proc/update_voxels.html"},{"title":"init_mono – signedMCRT","text":"private function init_mono(mus, mua, hgg, n) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: mus real(kind=wp), intent(in) :: mua real(kind=wp), intent(in) :: hgg real(kind=wp), intent(in) :: n Return Value type( mono ) Contents Source Code init_mono Source Code type ( mono ) function init_mono ( mus , mua , hgg , n ) result ( res ) real ( kind = wp ), intent ( in ) :: mus , mua , hgg , n res % mus = mus res % mua = mua res % kappa = mus + mua if ( res % mua < 1e-9_wp ) then res % albedo = 1. else res % albedo = res % mus / res % kappa end if res % hgg = hgg res % g2 = hgg ** 2 res % n = n end function init_mono","tags":"","loc":"proc/init_mono.html"},{"title":"init_spectral – signedMCRT","text":"private function init_spectral(mus, mua, hgg, n, flux) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), allocatable :: mus (:,:) real(kind=wp), intent(in), allocatable :: mua (:,:) real(kind=wp), intent(in), allocatable :: hgg (:,:) real(kind=wp), intent(in), allocatable :: n (:,:) real(kind=wp), intent(in), allocatable :: flux (:,:) Return Value type( spectral ) Contents Source Code init_spectral Source Code type ( spectral ) function init_spectral ( mus , mua , hgg , n , flux ) result ( res ) real ( kind = wp ), allocatable , intent ( in ) :: mus (:, :), mua (:, :), hgg (:, :), n (:, :), flux (:, :) real ( kind = wp ) :: wave , tmp !setup cdfs res % flux = piecewise1D ( flux ) res % mus_a = piecewise1D ( mus ) res % mua_a = piecewise1D ( mua ) res % hgg_a = piecewise1D ( hgg ) res % n_a = piecewise1D ( n ) !sample wavelength so we can sample from other optical properties at the correct points call res % flux % sample ( wave , tmp ) ! sample optical properties call res % mus_a % sample ( res % mus , wave ) call res % mua_a % sample ( res % mua , wave ) call res % hgg_a % sample ( res % hgg , wave ) res % g2 = res % hgg ** 2 call res % n_a % sample ( res % n , wave ) res % kappa = res % mus + res % mua if ( res % mua < 1e-9_wp ) then res % albedo = 1. else res % albedo = res % mus / res % kappa end if end function init_spectral","tags":"","loc":"proc/init_spectral.html"},{"title":"opticaProp_new – signedMCRT","text":"private function opticaProp_new(rhs) result(lhs) Arguments Type Intent Optional Attributes Name class( opticalProp_base ), intent(in) :: rhs Return Value type( opticalProp_t ) Contents Source Code opticaProp_new Source Code type ( opticalProp_t ) function opticaProp_new ( rhs ) result ( lhs ) class ( opticalProp_base ), intent ( in ) :: rhs allocate ( lhs % value , source = rhs ) end function opticaProp_new","tags":"","loc":"proc/opticaprop_new.html"},{"title":"opticalProp_t_assign – signedMCRT","text":"private subroutine opticalProp_t_assign(lhs, rhs) Type Bound opticalProp_t Arguments Type Intent Optional Attributes Name class( opticalProp_t ), intent(inout) :: lhs class( opticalProp_base ), intent(in) :: rhs Contents Source Code opticalProp_t_assign Source Code subroutine opticalProp_t_assign ( lhs , rhs ) class ( opticalProp_t ), intent ( inout ) :: lhs class ( opticalProp_base ), intent ( in ) :: rhs if ( allocated ( lhs % value )) deallocate ( lhs % value ) ! Prevent nested derived type select type ( rhsT => rhs ) class is ( opticalProp_t ) if ( allocated ( rhsT % value )) allocate ( lhs % value , source = rhsT % value ) class default allocate ( lhs % value , source = rhsT ) end select end subroutine opticalProp_t_assign","tags":"","loc":"proc/opticalprop_t_assign.html"},{"title":"updateMono – signedMCRT","text":"private subroutine updateMono(this, wavelength) Type Bound mono Arguments Type Intent Optional Attributes Name class( mono ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength Contents Source Code updateMono Source Code subroutine updateMono ( this , wavelength ) implicit none class ( Mono ), intent ( inout ) :: this real ( kind = wp ), intent ( out ) :: wavelength ! don't do anything as wavelength will not change wavelength = 0.0_wp end subroutine updateMono","tags":"","loc":"proc/updatemono.html"},{"title":"updateSpectral – signedMCRT","text":"private subroutine updateSpectral(this, wavelength) Type Bound spectral Arguments Type Intent Optional Attributes Name class( spectral ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength Contents Source Code updateSpectral Source Code subroutine updateSpectral ( this , wavelength ) implicit none class ( spectral ), intent ( inout ) :: this real ( kind = wp ), intent ( out ) :: wavelength real ( kind = wp ) :: tmp !get wavelength call this % flux % sample ( wavelength , tmp ) !update mus call this % mus_a % sample ( this % mus , tmp , wavelength ) !update mua call this % mua_a % sample ( this % mua , tmp , wavelength ) !update hgg call this % hgg_a % sample ( this % hgg , tmp , wavelength ) this % g2 = this % hgg ** 2 !update n call this % n_a % sample ( this % n , tmp , wavelength ) !update kappa and albedo this % kappa = this % mus + this % mua this % albedo = this % mus / this % kappa end subroutine updateSpectral","tags":"","loc":"proc/updatespectral.html"},{"title":"update_opticalProp_t – signedMCRT","text":"private subroutine update_opticalProp_t(this, wavelength) Type Bound opticalProp_t Arguments Type Intent Optional Attributes Name class( opticalProp_t ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength Contents Source Code update_opticalProp_t Source Code subroutine update_opticalProp_t ( this , wavelength ) class ( opticalProp_t ), intent ( inout ) :: this real ( kind = wp ), intent ( out ) :: wavelength call this % value % update ( wavelength ) end subroutine update_opticalProp_t","tags":"","loc":"proc/update_opticalprop_t.html"},{"title":"mono – signedMCRT","text":"public interface mono Contents Module Procedures init_mono Module Procedures private function init_mono (mus, mua, hgg, n) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: mus real(kind=wp), intent(in) :: mua real(kind=wp), intent(in) :: hgg real(kind=wp), intent(in) :: n Return Value type( mono )","tags":"","loc":"interface/mono.html"},{"title":"opticalProp_t – signedMCRT","text":"public interface opticalProp_t Contents Module Procedures opticaProp_new Module Procedures private function opticaProp_new (rhs) result(lhs) Arguments Type Intent Optional Attributes Name class( opticalProp_base ), intent(in) :: rhs Return Value type( opticalProp_t )","tags":"","loc":"interface/opticalprop_t.html"},{"title":"spectral – signedMCRT","text":"public interface spectral Contents Module Procedures init_spectral Module Procedures private function init_spectral (mus, mua, hgg, n, flux) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), allocatable :: mus (:,:) real(kind=wp), intent(in), allocatable :: mua (:,:) real(kind=wp), intent(in), allocatable :: hgg (:,:) real(kind=wp), intent(in), allocatable :: n (:,:) real(kind=wp), intent(in), allocatable :: flux (:,:) Return Value type( spectral )","tags":"","loc":"interface/spectral.html"},{"title":"init_piecewise1D – signedMCRT","text":"public function init_piecewise1D(array) result(res) Uses stdlib_quadrature initalise the piecewise1D type with an array size (n, 2). Calculates the CDF of this array.\nInput array Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:) Return Value type( piecewise1D ) Contents Source Code init_piecewise1D Source Code type ( piecewise1D ) function init_piecewise1D ( array ) result ( res ) !! initalise the piecewise1D type with an array size (n, 2). Calculates the CDF of this array. !> Input array use stdlib_quadrature , only : trapz_weights real ( kind = wp ), intent ( in ) :: array (:, :) integer :: i , length real ( kind = wp ) :: weights ( size ( array , 1 )), sumer if ( size ( array , 2 ) /= 2 ) error stop \"Array must be size (n, 2)\" res % array = array length = size ( array , 1 ) allocate ( res % cdf ( length )) res % cdf = 0. ! Generate CDF array from PDF array via Trapezoidal rule weights = trapz_weights ( array (:, 1 )) sumer = 0. do i = 2 , length sumer = sumer + weights ( i ) * array ( i , 2 ) res % cdf ( i ) = sumer end do ! normalise res % cdf = res % cdf / res % cdf ( length ) end function init_piecewise1D","tags":"","loc":"proc/init_piecewise1d.html"},{"title":"init_piecewise2D – signedMCRT","text":"public function init_piecewise2D(cell_width, cell_height, image) Initalise the piecewise2D type with a given cell_width, cell_height and input image Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: cell_width Input cell width real(kind=wp), intent(in) :: cell_height Input cell height real(kind=wp), intent(in) :: image (:,:) Input image Return Value type( piecewise2D ) Contents Source Code init_piecewise2D Source Code type ( piecewise2D ) function init_piecewise2D ( cell_width , cell_height , image ) !! Initalise the piecewise2D type with a given cell_width, cell_height and input image !> Input cell width real ( kind = wp ), intent ( in ) :: cell_width !> Input cell height real ( kind = wp ), intent ( in ) :: cell_height !> Input image real ( kind = wp ), intent ( in ) :: image (:,:) real ( kind = wp ), allocatable :: HC1D (:), imagenew (:,:) integer :: width , height , w2 , h2 integer ( kind = int64 ) :: i integer ( kind = int32 ) :: x , y width = size ( image , 1 ) height = size ( image , 2 ) ! need to pad image for z-order to work... w2 = nextpwr2 ( width ) h2 = nextpwr2 ( height ) allocate ( imagenew ( w2 , h2 )) imagenew = 0. init_piecewise2D % xoffset = ( h2 - height ) / 2 init_piecewise2D % yoffset = ( w2 - width ) / 2 imagenew ( init_piecewise2D % xoffset : init_piecewise2D % xoffset + width - 1 , & init_piecewise2D % yoffset : init_piecewise2D % yoffset + height - 1 ) = image allocate ( init_piecewise2D % cdf ( w2 * h2 )) allocate ( HC1D ( w2 * h2 )) HC1D = 0. do i = 0 , ( h2 * w2 ) - 1 call decode ( i , x , y ) HC1D ( i + 1 ) = imagenew ( x + 1 , y + 1 ) end do init_piecewise2D % cdf ( 1 ) = HC1D ( 1 ) do i = 2 , size ( HC1D ) init_piecewise2D % cdf ( i ) = init_piecewise2D % cdf ( i - 1 ) + HC1D ( i ) end do init_piecewise2D % cell_height = cell_height init_piecewise2D % cell_width = cell_width init_piecewise2D % cdf = init_piecewise2D % cdf / init_piecewise2D % cdf ( size ( init_piecewise2D % cdf )) end function init_piecewise2D","tags":"","loc":"proc/init_piecewise2d.html"},{"title":"nextpwr2 – signedMCRT","text":"public function nextpwr2(v) result(res) Get the next power of 2. i.e given 5 will return 8 (4^2)\nonly works on 32bit ints ref Arguments Type Intent Optional Attributes Name integer, intent(in) :: v Return Value integer Contents Source Code nextpwr2 Source Code integer function nextpwr2 ( v ) result ( res ) !! Get the next power of 2. i.e given 5 will return 8 (4^2) !! only works on 32bit ints !! [ref](https://graphics.stanford.edu/~seander/bithacks.html#RoundUpPowerOf2) integer , intent ( in ) :: v res = v - 1 res = ior ( res , rshift ( res , 1 )) res = ior ( res , rshift ( res , 2 )) res = ior ( res , rshift ( res , 4 )) res = ior ( res , rshift ( res , 8 )) res = ior ( res , rshift ( res , 16 )) res = res + 1 end function nextpwr2","tags":"","loc":"proc/nextpwr2.html"},{"title":"pack_bits – signedMCRT","text":"public function pack_bits(z) result(x) Reverse the split function. I.e go from 0a0b0c0d to abcd\nAdapted from archer2 cpp course Arguments Type Intent Optional Attributes Name integer(kind=int64), intent(in) :: z Input interleaved integer Return Value integer(kind=int64) Contents","tags":"","loc":"proc/pack_bits.html"},{"title":"decode – signedMCRT","text":"public subroutine decode(z, x, y) Compute the 2 indices from a Morton index\nAdapted from archer2 cpp course Arguments Type Intent Optional Attributes Name integer(kind=int64), intent(in) :: z Morton Index integer(kind=int32), intent(out) :: x The computed indices integer(kind=int32), intent(out) :: y The computed indices Contents Source Code decode Source Code subroutine decode ( z , x , y ) !! Compute the 2 indices from a Morton index !! Adapted from archer2 cpp [course](https://github.com/EPCCed/archer2-cpp/tree/main/exercises/morton-order) !> Morton Index integer ( kind = int64 ), intent ( in ) :: z !> The computed indices integer ( kind = int32 ), intent ( out ) :: x , y integer ( kind = int64 ) :: i , j i = z x = pack_bits ( i ) j = rshift ( z , 1 ) y = pack_bits ( j ) end subroutine decode","tags":"","loc":"proc/decode.html"},{"title":"getValue – signedMCRT","text":"public subroutine getValue(this, x, y, value) The constant version of sample Type Bound constant Arguments Type Intent Optional Attributes Name class( constant ), intent(in) :: this real(kind=wp), intent(out) :: x Output value real(kind=wp), intent(out) :: y Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D real(kind=wp), intent(in), optional :: value Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D Contents Source Code getValue Source Code subroutine getValue ( this , x , y , value ) !! The constant version of sample class ( constant ), intent ( in ) :: this !> Output value real ( kind = wp ), intent ( out ) :: x !> Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D real ( kind = wp ), intent ( out ) :: y !> Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D real ( kind = wp ), intent ( in ), optional :: value x = this % value y = - 999 9._wp end subroutine getValue","tags":"","loc":"proc/getvalue.html"},{"title":"sample1D – signedMCRT","text":"public subroutine sample1D(this, x, y, value) Uses random Randomly sample from 1D array Type Bound piecewise1D Arguments Type Intent Optional Attributes Name class( piecewise1D ), intent(in) :: this real(kind=wp), intent(out) :: x Return value real(kind=wp), intent(out) :: y Not used, but here so we can have same interface as 2D sample routine. real(kind=wp), intent(in), optional :: value Optional x value. If not present we generate a random one in the range [0., 1.] Contents Source Code sample1D Source Code subroutine sample1D ( this , x , y , value ) !! Randomly sample from 1D array use random , only : ran2 , ranu class ( piecewise1D ), intent ( in ) :: this !> Return value real ( kind = wp ), intent ( out ) :: x !> Not used, but here so we can have same interface as 2D sample routine. real ( kind = wp ), intent ( out ) :: y !> Optional x value. If not present we generate a random one in the range [0., 1.] real ( kind = wp ), intent ( in ), optional :: value integer ( kind = int64 ) :: idx real ( kind = wp ) :: val if (. not . present ( value )) then !get random x coordinate then get corresponding y val = ran2 () call search_1D ( this % cdf , idx , val ) x = this % array ( idx , 1 ) + & (( val - this % cdf ( idx )) * ( this % array ( idx + 1 , 1 ) - this % array ( idx , 1 ))) / ( this % cdf ( idx + 1 ) - this % cdf ( idx )) else !already have x so get y call search_2D ( this % array , idx , value ) x = this % array ( idx , 2 ) + ( this % array ( idx + 1 , 2 ) - this % array ( idx , 2 )) * & (( value - this % array ( idx , 1 )) / ( this % array ( idx + 1 , 1 ) - this % array ( idx , 1 ))) end if end subroutine sample1D","tags":"","loc":"proc/sample1d.html"},{"title":"sample2D – signedMCRT","text":"public subroutine sample2D(this, x, y, value) Uses random Type Bound piecewise2D Arguments Type Intent Optional Attributes Name class( piecewise2D ), intent(in) :: this real(kind=wp), intent(out) :: x real(kind=wp), intent(out) :: y real(kind=wp), intent(in), optional :: value Contents Source Code sample2D Source Code subroutine sample2D ( this , x , y , value ) ! TODO cite where you got this from... use random , only : ran2 , ranu class ( piecewise2D ), intent ( in ) :: this real ( kind = wp ), intent ( out ) :: x , y real ( kind = wp ), intent ( in ), optional :: value integer ( kind = int32 ) :: xr , yr integer ( kind = int64 ) :: idx real ( kind = wp ) :: val val = ran2 () call search_1D ( this % cdf , idx , val ) call decode ( idx , xr , yr ) x = real ( xr - this % xoffset , kind = wp ) + ranu ( - this % cell_width , this % cell_width ) y = real ( yr - this % yoffset , kind = wp ) + ranu ( - this % cell_height , this % cell_height ) end subroutine sample2D","tags":"","loc":"proc/sample2d.html"},{"title":"search_1D – signedMCRT","text":"public subroutine search_1D(array, nlow, value) search by bisection for 1D array Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:) Array to search integer(kind=int64), intent(out) :: nlow index of found value real(kind=wp), intent(in) :: value value to find in 1D array Contents Source Code search_1D Source Code subroutine search_1D ( array , nlow , value ) !! search by bisection for 1D array !> Array to search real ( kind = wp ), intent ( in ) :: array (:) !> index of found value integer ( kind = int64 ), intent ( out ) :: nlow !> value to find in 1D array real ( kind = wp ), intent ( in ) :: value integer :: nup , middle nup = size ( array ) nlow = 1 middle = int (( nup + nlow ) / 2. ) do while (( nup - nlow ) > 1 ) middle = int (( nup + nlow ) / 2. ) if ( value > array ( middle )) then nlow = middle else nup = middle end if end do end subroutine search_1D","tags":"","loc":"proc/search_1d.html"},{"title":"search_2D – signedMCRT","text":"public subroutine search_2D(array, nlow, value) search by bisection for 1D array Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:) 2D array to search. Only searches 1st column integer(kind=int64), intent(out) :: nlow Index of found index real(kind=wp), intent(in) :: value Value to find in the array. Contents Source Code search_2D Source Code subroutine search_2D ( array , nlow , value ) !! search by bisection for 1D array !> 2D array to search. Only searches 1st column real ( kind = wp ), intent ( in ) :: array (:, :) !> Index of found index integer ( kind = int64 ), intent ( out ) :: nlow !> Value to find in the array. real ( kind = wp ), intent ( in ) :: value integer :: nup , middle nup = size ( array , 1 ) nlow = 1 middle = int (( nup + nlow ) / 2. ) do while (( nup - nlow ) > 1 ) middle = int (( nup + nlow ) / 2. ) if ( value > array ( middle , 1 )) then nlow = middle else nup = middle end if end do end subroutine search_2D","tags":"","loc":"proc/search_2d.html"},{"title":"piecewise1D – signedMCRT","text":"public interface piecewise1D Contents Module Procedures init_piecewise1D Module Procedures public function init_piecewise1D (array) result(res) initalise the piecewise1D type with an array size (n, 2). Calculates the CDF of this array.\nInput array Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:) Return Value type( piecewise1D )","tags":"","loc":"interface/piecewise1d.html"},{"title":"piecewise2D – signedMCRT","text":"public interface piecewise2D Contents Module Procedures init_piecewise2D Module Procedures public function init_piecewise2D (cell_width, cell_height, image) Initalise the piecewise2D type with a given cell_width, cell_height and input image Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: cell_width Input cell width real(kind=wp), intent(in) :: cell_height Input cell height real(kind=wp), intent(in) :: image (:,:) Input image Return Value type( piecewise2D )","tags":"","loc":"interface/piecewise2d.html"},{"title":"check_hit_annulus – signedMCRT","text":"private function check_hit_annulus(this, hitpoint) Check if a hitpoint is in the annulus Type Bound annulus_dect Arguments Type Intent Optional Attributes Name class( annulus_dect ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Hitpoint to check Return Value logical Contents Source Code check_hit_annulus Source Code logical function check_hit_annulus ( this , hitpoint ) !! Check if a hitpoint is in the annulus class ( annulus_dect ), intent ( INOUT ) :: this !> Hitpoint to check type ( hit_t ), intent ( IN ) :: hitpoint real ( kind = wp ) :: newpos check_hit_annulus = . false . if ( this % layer /= hitpoint % layer ) return newpos = sqrt (( hitpoint % pos % x - this % pos % x ) ** 2 + ( hitpoint % pos % y - this % pos % y ) ** 2 + ( hitpoint % pos % z - this % pos % z ) ** 2 ) if ( newpos >= this % r1 . and . newpos <= this % r2 ) then check_hit_annulus = . true . end if end function check_hit_annulus","tags":"","loc":"proc/check_hit_annulus.html"},{"title":"check_hit_camera – signedMCRT","text":"private function check_hit_camera(this, hitpoint) Check if a hitpoint is in the camera detector ref Type Bound camera Arguments Type Intent Optional Attributes Name class( camera ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Hitpoint to check Return Value logical Contents Source Code check_hit_camera Source Code logical function check_hit_camera ( this , hitpoint ) !! Check if a hitpoint is in the camera detector !! [ref](https://www.scratchapixel.com/lessons/3d-basic-rendering/minimal-ray-tracer-rendering-simple-shapes/ray-plane-and-ray-disk-intersection) class ( camera ), intent ( inout ) :: this !> Hitpoint to check type ( hit_t ), intent ( in ) :: hitpoint real ( kind = wp ) :: t , proj1 , proj2 type ( vector ) :: v check_hit_camera = . false . if ( this % layer /= hitpoint % layer ) return t = (( this % pos - hitpoint % pos ) . dot . this % n ) / ( hitpoint % dir . dot . this % n ) if ( t >= 0._wp ) then v = ( hitpoint % pos + t * hitpoint % dir ) - this % pos proj1 = ( v . dot . this % e1 ) / this % width proj2 = ( v . dot . this % e2 ) / this % height if (( proj1 < this % width . and . proj1 > 0._wp ) . and . ( proj2 < this % height . and . proj2 > 0._wp )) then check_hit_camera = . true . end if end if end function check_hit_camera","tags":"","loc":"proc/check_hit_camera.html"},{"title":"check_hit_circle – signedMCRT","text":"private function check_hit_circle(this, hitpoint) Uses geometry Check if a hitpoint is in the circle Type Bound circle_dect Arguments Type Intent Optional Attributes Name class( circle_dect ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Hitpoint to check Return Value logical Contents Source Code check_hit_circle Source Code logical function check_hit_circle ( this , hitpoint ) !! Check if a hitpoint is in the circle use geometry , only : intersectCircle class ( circle_dect ), intent ( INOUT ) :: this !> Hitpoint to check type ( hit_t ), intent ( IN ) :: hitpoint real ( kind = wp ) :: t check_hit_circle = . false . if ( this % layer /= hitpoint % layer ) return check_hit_circle = intersectCircle ( this % dir , this % pos , this % radius , hitpoint % pos , hitpoint % dir , t ) if ( check_hit_circle ) then if ( t > 5e-3_wp ) check_hit_circle = . false . end if end function check_hit_circle","tags":"","loc":"proc/check_hit_circle.html"},{"title":"init_annulus_dect – signedMCRT","text":"private function init_annulus_dect(pos, dir, layer, r1, r2, nbins, maxval, trackHistory) result(out) Initalise Annular detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: r1 Inner radius real(kind=wp), intent(in) :: r2 Outer radius integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( annulus_dect ) Contents Source Code init_annulus_dect Source Code function init_annulus_dect ( pos , dir , layer , r1 , r2 , nbins , maxval , trackHistory ) result ( out ) !! Initalise Annular detector !> Centre of detector type ( vector ), intent ( in ) :: pos !> Normal of the detector type ( vector ), intent ( in ) :: dir !> Layer ID integer , intent ( in ) :: layer !> Inner radius real ( kind = wp ), intent ( IN ) :: r1 !> Outer radius real ( kind = wp ), intent ( IN ) :: r2 !> Number of bins in the detector integer , intent ( in ) :: nbins !> Maximum value to store in bins real ( kind = wp ), intent ( in ) :: maxval !> Boolean on if to store photon's history prior to hitting the detector. logical , intent ( in ) :: trackHistory type ( annulus_dect ) :: out out % pos = pos out % dir = dir out % layer = layer !extra bin for data beyond end of array out % nbins = nbins + 1 out % r1 = r1 out % r2 = r2 allocate ( out % data ( out % nbins )) out % data = 0.0_wp if ( nbins == 0 ) then out % bin_wid = 1._wp else out % bin_wid = maxval / real ( nbins , kind = wp ) end if out % trackHistory = trackHistory end function init_annulus_dect","tags":"","loc":"proc/init_annulus_dect.html"},{"title":"init_camera – signedMCRT","text":"private function init_camera(p1, p2, p3, layer, nbins, maxval, trackHistory) result(out) Initalise Camera detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: p1 Position of the 1st corner of the detector type( vector ), intent(in) :: p2 Distance from p1 to the 2nd corner type( vector ), intent(in) :: p3 Distance from p1 to the 3rd corner integer, intent(in) :: layer Layer ID integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( camera ) Contents Source Code init_camera Source Code function init_camera ( p1 , p2 , p3 , layer , nbins , maxval , trackHistory ) result ( out ) !! Initalise Camera detector !> Position of the 1st corner of the detector type ( vector ), intent ( in ) :: p1 !> Distance from p1 to the 2nd corner type ( vector ), intent ( in ) :: p2 !> Distance from p1 to the 3rd corner type ( vector ), intent ( in ) :: p3 !> Layer ID integer , intent ( in ) :: layer !> Number of bins in the detector integer , intent ( in ) :: nbins !> Maximum value to store in bins real ( kind = wp ), intent ( in ) :: maxval !> Boolean on if to store photon's history prior to hitting the detector. logical , intent ( in ) :: trackHistory type ( camera ) :: out out % pos = p1 out % p2 = p2 out % p3 = p3 out % e1 = p2 - p1 out % e2 = p3 - p1 out % width = length ( out % e1 ) out % height = length ( out % e2 ) out % n = out % e2 . cross . out % e1 out % n = out % n % magnitude () out % layer = layer !extra bin for data beyond end of array out % nbinsX = nbins + 1 out % nbinsY = nbins + 1 allocate ( out % data ( out % nbinsX , out % nbinsY )) out % data = 0.0_wp if ( nbins == 0 ) then out % bin_wid_x = 1._wp out % bin_wid_y = 1._wp else out % bin_wid_x = maxval / real ( out % nbinsX , kind = wp ) out % bin_wid_y = maxval / real ( out % nbinsY , kind = wp ) end if out % trackHistory = trackHistory end function init_camera","tags":"","loc":"proc/init_camera.html"},{"title":"init_circle_dect – signedMCRT","text":"private function init_circle_dect(pos, dir, layer, radius, nbins, maxval, trackHistory) result(out) Initalise Circle detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: radius Radius of the detector integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( circle_dect ) Contents Source Code init_circle_dect Source Code function init_circle_dect ( pos , dir , layer , radius , nbins , maxval , trackHistory ) result ( out ) !! Initalise Circle detector !> Centre of detector type ( vector ), intent ( in ) :: pos !> Normal of the detector type ( vector ), intent ( in ) :: dir !> Layer ID integer , intent ( in ) :: layer !> Number of bins in the detector integer , intent ( in ) :: nbins !> Radius of the detector real ( kind = wp ), intent ( in ) :: radius !> Maximum value to store in bins real ( kind = wp ), intent ( in ) :: maxval !> Boolean on if to store photon's history prior to hitting the detector. logical , intent ( in ) :: trackHistory type ( circle_dect ) :: out out % dir = dir out % pos = pos out % layer = layer !extra bin for data beyond end of array out % nbins = nbins + 1 out % radius = radius allocate ( out % data ( out % nbins )) out % data = 0.0_wp if ( nbins == 0 ) then out % bin_wid = 1._wp else out % bin_wid = maxval / real ( nbins - 1 , kind = wp ) end if out % trackHistory = trackHistory end function init_circle_dect","tags":"","loc":"proc/init_circle_dect.html"},{"title":"annulus_dect – signedMCRT","text":"public interface annulus_dect Contents Module Procedures init_annulus_dect Module Procedures private function init_annulus_dect (pos, dir, layer, r1, r2, nbins, maxval, trackHistory) result(out) Initalise Annular detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: r1 Inner radius real(kind=wp), intent(in) :: r2 Outer radius integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( annulus_dect )","tags":"","loc":"interface/annulus_dect.html"},{"title":"camera – signedMCRT","text":"public interface camera Contents Module Procedures init_camera Module Procedures private function init_camera (p1, p2, p3, layer, nbins, maxval, trackHistory) result(out) Initalise Camera detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: p1 Position of the 1st corner of the detector type( vector ), intent(in) :: p2 Distance from p1 to the 2nd corner type( vector ), intent(in) :: p3 Distance from p1 to the 3rd corner integer, intent(in) :: layer Layer ID integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( camera )","tags":"","loc":"interface/camera.html"},{"title":"circle_dect – signedMCRT","text":"public interface circle_dect Contents Module Procedures init_circle_dect Module Procedures private function init_circle_dect (pos, dir, layer, radius, nbins, maxval, trackHistory) result(out) Initalise Circle detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: radius Radius of the detector integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( circle_dect )","tags":"","loc":"interface/circle_dect.html"},{"title":"hit_init – signedMCRT","text":"private function hit_init(val) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val Return Value type( hit_t ) Contents Source Code hit_init Source Code type ( hit_t ) function hit_init ( val ) real ( kind = wp ), intent ( in ) :: val type ( vector ) :: tmp tmp = vector ( val , val , val ) hit_init = hit_t ( tmp , tmp , val , int ( val )) end function hit_init","tags":"","loc":"proc/hit_init.html"},{"title":"record_hit_1D_sub – signedMCRT","text":"private subroutine record_hit_1D_sub(this, hitpoint, history) Uses historyStack sim_state_mod check if a hit is on the detector and record it if so Type Bound detector1D Arguments Type Intent Optional Attributes Name class( detector1D ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Interaction information type( history_stack_t ), intent(inout) :: history Photon packet history Contents Source Code record_hit_1D_sub Source Code subroutine record_hit_1D_sub ( this , hitpoint , history ) !! check if a hit is on the detector and record it if so use historyStack , only : history_stack_t use sim_state_mod , only : state class ( detector1D ), intent ( inout ) :: this !> Interaction information type ( hit_t ), intent ( in ) :: hitpoint !> Photon packet history type ( history_stack_t ), intent ( inout ) :: history real ( kind = wp ) :: value integer :: idx if ( this % check_hit ( hitpoint )) then value = hitpoint % value idx = min ( nint ( value / this % bin_wid ) + 1 , this % nbins ) !$omp atomic this % data ( idx ) = this % data ( idx ) + 1 if ( this % trackHistory ) then call history % write () end if end if if ( state % trackHistory ) call history % zero () end subroutine record_hit_1D_sub","tags":"","loc":"proc/record_hit_1d_sub.html"},{"title":"record_hit_2D_sub – signedMCRT","text":"private subroutine record_hit_2D_sub(this, hitpoint, history) Uses historyStack sim_state_mod check if a hit is on the detector and record it if so Type Bound detector2D Arguments Type Intent Optional Attributes Name class( detector2D ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Interaction information type( history_stack_t ), intent(inout) :: history Photon packet history Contents Source Code record_hit_2D_sub Source Code subroutine record_hit_2D_sub ( this , hitpoint , history ) !! check if a hit is on the detector and record it if so use historyStack , only : history_stack_t use sim_state_mod , only : state class ( detector2D ), intent ( inout ) :: this !> Interaction information type ( hit_t ), intent ( in ) :: hitpoint !> Photon packet history type ( history_stack_t ), intent ( inout ) :: history real ( kind = wp ), volatile :: x , y integer :: idx , idy if ( this % check_hit ( hitpoint )) then x = hitpoint % pos % z + this % pos % x y = hitpoint % pos % y + this % pos % y idx = min ( int ( x / this % bin_wid_x ) + 1 , this % nbinsX ) idy = min ( int ( y / this % bin_wid_y ) + 1 , this % nbinsY ) if ( idx < 1 ) idx = this % nbinsX if ( idy < 1 ) idy = this % nbinsY !$omp atomic this % data ( idx , idy ) = this % data ( idx , idy ) + 1 if ( this % trackHistory ) then call history % write () end if end if if ( state % trackHistory ) call history % zero () end subroutine record_hit_2D_sub","tags":"","loc":"proc/record_hit_2d_sub.html"},{"title":"hit_t – signedMCRT","text":"public interface hit_t Contents Module Procedures hit_init Module Procedures private function hit_init (val) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val Return Value type( hit_t )","tags":"","loc":"interface/hit_t.html"},{"title":"box_init – signedMCRT","text":"private function box_init(lengths, optProp, layer, transform) result(out) Initalising function for Box SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: lengths Lengths of each dimension of the box type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( box ) Contents Source Code box_init Source Code function box_init ( lengths , optProp , layer , transform ) result ( out ) !! Initalising function for Box SDF. type ( box ) :: out !> Lengths of each dimension of the box type ( vector ), intent ( IN ) :: lengths !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % lengths = . 5_wp * lengths ! as only half lengths out % layer = layer out % transform = t out % optProps = optProp end function box_init","tags":"","loc":"proc/box_init.html"},{"title":"capsule_init – signedMCRT","text":"private function capsule_init(a, b, r, optProp, layer, transform) result(out) Initalising function for capsule SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Capsule startpoint type( vector ), intent(in) :: b Capsule endpoint real(kind=wp), intent(in) :: r Capsule radius type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( capsule ) Contents Source Code capsule_init Source Code function capsule_init ( a , b , r , optProp , layer , transform ) result ( out ) !! Initalising function for capsule SDF. type ( capsule ) :: out !> Capsule startpoint type ( vector ), intent ( IN ) :: a !> Capsule endpoint type ( vector ), intent ( IN ) :: b !> Capsule radius real ( kind = wp ), intent ( IN ) :: r !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % b = b out % r = r out % layer = layer out % transform = t out % optProps = optProp end function capsule_init","tags":"","loc":"proc/capsule_init.html"},{"title":"cone_init – signedMCRT","text":"private function cone_init(a, b, ra, rb, optProp, layer, transform) result(out) Initalising function for Capped Cone SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Centre of base of Cone type( vector ), intent(in) :: b Tip of cone real(kind=wp), intent(in) :: ra Radius of Cones base real(kind=wp), intent(in) :: rb Radius of Cones tip. For rb = 0.0 get normal uncapped cone. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cone ) Contents Source Code cone_init Source Code function cone_init ( a , b , ra , rb , optProp , layer , transform ) result ( out ) !! Initalising function for Capped Cone SDF. type ( cone ) :: out !> Centre of base of Cone type ( vector ), intent ( IN ) :: a !> Tip of cone type ( vector ), intent ( IN ) :: b !> Radius of Cones base real ( kind = wp ), intent ( IN ) :: ra !> Radius of Cones tip. For rb = 0.0 get normal uncapped cone. real ( kind = wp ), intent ( in ) :: rb !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % b = b out % ra = ra out % rb = rb out % layer = layer out % transform = t out % optProps = optProp end function cone_init","tags":"","loc":"proc/cone_init.html"},{"title":"cylinder_init – signedMCRT","text":"private function cylinder_init(a, b, radius, optProp, layer, transform) result(out) Initalising function for Cylinder SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Vector position at centre of the bottom circle type( vector ), intent(in) :: b Vector position at centre of the top circle real(kind=wp), intent(in) :: radius Radius of cylinder type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cylinder ) Contents Source Code cylinder_init Source Code function cylinder_init ( a , b , radius , optProp , layer , transform ) result ( out ) !! Initalising function for Cylinder SDF. type ( cylinder ) :: out !> Radius of cylinder real ( kind = wp ), intent ( in ) :: radius !> Vector position at centre of the bottom circle type ( vector ), intent ( IN ) :: a !> Vector position at centre of the top circle type ( vector ), intent ( IN ) :: b !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % b = b out % radius = radius out % layer = layer out % transform = t out % optProps = optProp end function cylinder_init","tags":"","loc":"proc/cylinder_init.html"},{"title":"egg_init – signedMCRT","text":"private function egg_init(r1, r2, h, optProp, layer, transform) result(out) Initalising function for egg SDF.\nmakes a Moss egg. ref . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: r1 R1 controls \"fatness\" of the egg. Actually controls the base circle radius. real(kind=wp), intent(in) :: r2 R2 contorls the pointiness of the egg. Actually controls radius of top circle. real(kind=wp), intent(in) :: h h controls the height of the egg. Actually controls y position of top circle. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( egg ) Contents Source Code egg_init Source Code function egg_init ( r1 , r2 , h , optProp , layer , transform ) result ( out ) !! Initalising function for egg SDF. !! makes a Moss egg. [ref](https://www.shadertoy.com/view/WsjfRt). type ( egg ) :: out !> R1 controls \"fatness\" of the egg. Actually controls the base circle radius. real ( kind = wp ), intent ( IN ) :: r1 !> R2 contorls the pointiness of the egg. Actually controls radius of top circle. real ( kind = wp ), intent ( in ) :: r2 !> h controls the height of the egg. Actually controls y position of top circle. real ( kind = wp ), intent ( in ) :: h !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % h = h out % r1 = r1 out % r2 = r2 out % layer = layer out % transform = t out % optProps = optProp end function egg_init","tags":"","loc":"proc/egg_init.html"},{"title":"evaluate_box – signedMCRT","text":"private pure elemental function evaluate_box(this, pos) result(res) Evaluation function for Box SDF. Type Bound box Arguments Type Intent Optional Attributes Name class( box ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Contents Source Code evaluate_box Source Code pure elemental function evaluate_box ( this , pos ) result ( res ) !! Evaluation function for Box SDF. class ( box ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: p , q p = pos . dot . this % transform q = abs ( p ) - this % lengths res = length ( max ( q , 0._wp )) + min ( max ( q % x , max ( q % y , q % z )), 0._wp ) end function evaluate_box","tags":"","loc":"proc/evaluate_box.html"},{"title":"evaluate_capsule – signedMCRT","text":"private pure elemental function evaluate_capsule(this, pos) result(res) Uses utils Evaluation function for Capsule SDF. Type Bound capsule Arguments Type Intent Optional Attributes Name class( capsule ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Contents Source Code evaluate_capsule Source Code pure elemental function evaluate_capsule ( this , pos ) result ( res ) !! Evaluation function for Capsule SDF. use utils , only : clamp class ( capsule ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: pa , ba , p real ( kind = wp ) :: h p = pos . dot . this % transform pa = p - this % a ba = this % b - this % a h = clamp (( pa . dot . ba ) / ( ba . dot . ba ), 0._wp , 1._wp ) res = length ( pa - ba * h ) - this % r end function evaluate_capsule","tags":"","loc":"proc/evaluate_capsule.html"},{"title":"evaluate_cone – signedMCRT","text":"private pure elemental function evaluate_cone(this, pos) result(res) Uses utils Evaluation function for Cone SDF. Type Bound cone Arguments Type Intent Optional Attributes Name class( cone ), intent(in) :: this type( vector ), intent(in) :: pos Return Value real(kind=wp) Contents Source Code evaluate_cone Source Code pure elemental function evaluate_cone ( this , pos ) result ( res ) !! Evaluation function for Cone SDF. use utils , only : clamp class ( cone ), intent ( in ) :: this type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: rba , baba , papa , paba , x , cax , cay , k , f , cbx , cby , s type ( vector ) :: p p = pos . dot . this % transform rba = this % rb - this % ra baba = ( this % b - this % a ) . dot . ( this % b - this % a ) papa = ( p - this % a ) . dot . ( p - this % a ) paba = (( p - this % a ) . dot . ( this % b - this % a )) / baba x = sqrt ( papa - baba * paba ** 2 ) if ( paba < 0.5_wp ) then cax = max ( 0._wp , x - this % ra ) else cax = max ( 0._wp , x - this % rb ) end if cay = abs ( paba - 0.5_wp ) - . 5_wp k = rba ** 2 + baba f = clamp (( rba * ( x - this % ra ) + paba * baba ) / k , 0._wp , 1._wp ) cbx = x - this % ra - f * rba cby = paba - f if ( cbx < 0._wp . and . cay < 0._wp ) then s = - 1._wp else s = 1._wp end if res = s * sqrt ( min ( cax ** 2 + baba * cay ** 2 , cbx ** 2 + baba * cby ** 2 )) end function evaluate_cone","tags":"","loc":"proc/evaluate_cone.html"},{"title":"evaluate_cylinder – signedMCRT","text":"private pure elemental function evaluate_cylinder(this, pos) result(res) Evaluation function for Cylinder SDF. Type Bound cylinder Arguments Type Intent Optional Attributes Name class( cylinder ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Contents Source Code evaluate_cylinder Source Code pure elemental function evaluate_cylinder ( this , pos ) result ( res ) !! Evaluation function for Cylinder SDF. class ( cylinder ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: p , ba , pa real ( kind = wp ) :: x , y , x2 , y2 , d , baba , paba p = pos . dot . this % transform ba = this % b - this % a pa = p - this % a baba = ba . dot . ba paba = pa . dot . ba x = length ( pa * baba - ba * paba ) - this % radius * baba y = abs ( paba - baba * . 5_wp ) - baba * . 5_wp x2 = x ** 2 y2 = ( y ** 2 ) * baba if ( max ( x , y ) < 0._wp ) then d = - min ( x2 , y2 ) else if ( x > 0._wp . and . y > 0._wp ) then d = x2 + y2 elseif ( x > 0._wp ) then d = x2 elseif ( y > 0._wp ) then d = y2 else d = 0._wp end if end if res = sign ( sqrt ( abs ( d )) / baba , d ) end function evaluate_cylinder","tags":"","loc":"proc/evaluate_cylinder.html"},{"title":"evaluate_egg – signedMCRT","text":"private pure elemental function evaluate_egg(this, pos) result(res) Evaluation function for Egg SDF. ref Type Bound egg Arguments Type Intent Optional Attributes Name class( egg ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Contents Source Code evaluate_egg Source Code pure elemental function evaluate_egg ( this , pos ) result ( res ) !! Evaluation function for Egg SDF. !! [ref](https://www.shadertoy.com/view/WsjfRt) class ( egg ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: r , l , h_in type ( vector ) :: p_in , p p = pos . dot . this % transform p_in = p p_in % x = abs ( p % x ) r = this % r1 - this % r2 h_in = this % h + r l = ( h_in ** 2 - r ** 2 ) / ( 2._wp * r ) if ( p_in % y <= 0._wp ) then res = length ( p_in ) - this % r1 else if (( p_in % y - h_in ) * l > p_in % x * h_in ) then res = length ( p_in - vector ( 0._wp , h_in , 0._wp )) - (( this % r1 + l ) - length ( vector ( h_in , l , 0._wp ))) else res = length ( p_in + vector ( l , 0._wp , 0._wp )) - ( this % r1 + l ) end if end if end function evaluate_egg","tags":"","loc":"proc/evaluate_egg.html"},{"title":"evaluate_plane – signedMCRT","text":"private pure elemental function evaluate_plane(this, pos) result(res) Evaluation function for Plane SDF. Type Bound plane Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Contents Source Code evaluate_plane Source Code pure elemental function evaluate_plane ( this , pos ) result ( res ) !! Evaluation function for Plane SDF. class ( plane ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: p p = pos . dot . this % transform !a must be normalised res = ( p . dot . this % a ) end function evaluate_plane","tags":"","loc":"proc/evaluate_plane.html"},{"title":"evaluate_segment – signedMCRT","text":"private pure elemental function evaluate_segment(this, pos) result(res) Uses utils Evaluation function for Segment SDF. Type Bound segment Arguments Type Intent Optional Attributes Name class( segment ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Contents Source Code evaluate_segment Source Code pure elemental function evaluate_segment ( this , pos ) result ( res ) !! Evaluation function for Segment SDF. !p = pos !a = pt1 !b = pt2 !draws segment along the axis between 2 points a and b use utils , only : clamp class ( segment ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: pa , ba , p real ( kind = wp ) :: h p = pos . dot . this % transform pa = p - this % a ba = this % b - this % a h = clamp (( pa . dot . ba ) / ( ba . dot . ba ), 0.0_wp , 1.0_wp ) res = length ( pa - ba * h ) - 0.1_wp end function evaluate_segment","tags":"","loc":"proc/evaluate_segment.html"},{"title":"evaluate_sphere – signedMCRT","text":"private pure elemental function evaluate_sphere(this, pos) result(res) Evaluation function for Sphere SDF. Type Bound sphere Arguments Type Intent Optional Attributes Name class( sphere ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Contents Source Code evaluate_sphere Source Code pure elemental function evaluate_sphere ( this , pos ) result ( res ) !! Evaluation function for Sphere SDF. class ( sphere ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: p p = pos . dot . this % transform res = sqrt ( p % x ** 2 + p % y ** 2 + p % z ** 2 ) - this % radius end function evaluate_sphere","tags":"","loc":"proc/evaluate_sphere.html"},{"title":"evaluate_torus – signedMCRT","text":"private pure elemental function evaluate_torus(this, pos) result(res) Evaluation function for Torus SDF. Type Bound torus Arguments Type Intent Optional Attributes Name class( torus ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Contents Source Code evaluate_torus Source Code pure elemental function evaluate_torus ( this , pos ) result ( res ) !! Evaluation function for Torus SDF. class ( torus ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: p , q p = pos . dot . this % transform q = vector ( length ( vector ( p % x , 0._wp , p % z )) - this % oradius , p % y , 0._wp ) res = length ( q ) - this % iradius end function evaluate_torus","tags":"","loc":"proc/evaluate_torus.html"},{"title":"evaluate_triprism – signedMCRT","text":"private pure elemental function evaluate_triprism(this, pos) result(res) Evaluation function for Triprisim SDF. Type Bound triprism Arguments Type Intent Optional Attributes Name class( triprism ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) Contents Source Code evaluate_triprism Source Code pure elemental function evaluate_triprism ( this , pos ) result ( res ) !! Evaluation function for Triprisim SDF. class ( triprism ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: q , p p = pos . dot . this % transform q = abs ( p ) res = max ( q % z - this % h2 , max ( q % x * . 866025_wp + p % y * . 5_wp , - p % y ) - this % h1 * . 5_wp ) end function evaluate_triprism","tags":"","loc":"proc/evaluate_triprism.html"},{"title":"plane_init – signedMCRT","text":"private function plane_init(a, optProp, layer, transform) result(out) Initalising function for plane SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Plane normal. must be normalised type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( plane ) Contents Source Code plane_init Source Code function plane_init ( a , optProp , layer , transform ) result ( out ) !! Initalising function for plane SDF. type ( plane ) :: out !> Plane normal. must be normalised type ( vector ), intent ( IN ) :: a !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % layer = layer out % transform = t out % optProps = optProp end function plane_init","tags":"","loc":"proc/plane_init.html"},{"title":"segment_init – signedMCRT","text":"private function segment_init(a, b, optProp, layer, transform) result(out) Initalising function for segment SDF.\nNote this is a 2D function Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a segment start point type( vector ), intent(in) :: b segment end point type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( segment ) Contents Source Code segment_init Source Code function segment_init ( a , b , optProp , layer , transform ) result ( out ) !! Initalising function for segment SDF. !! Note this is a 2D function type ( segment ) :: out !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp !> segment start point type ( vector ), intent ( IN ) :: a !> segment end point type ( vector ), intent ( IN ) :: b !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % b = b out % layer = layer out % transform = t out % optProps = optProp end function segment_init","tags":"","loc":"proc/segment_init.html"},{"title":"sphere_init – signedMCRT","text":"private function sphere_init(radius, optProp, layer, transform) result(out) Initalising function for Sphere SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: radius radius of the Sphere type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( sphere ) Contents Source Code sphere_init Source Code function sphere_init ( radius , optProp , layer , transform ) result ( out ) !! Initalising function for Sphere SDF. type ( sphere ) :: out !> radius of the Sphere real ( kind = wp ), intent ( IN ) :: radius !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % radius = radius out % layer = layer out % transform = t out % optProps = optProp end function sphere_init","tags":"","loc":"proc/sphere_init.html"},{"title":"torus_init – signedMCRT","text":"private function torus_init(oradius, iradius, optProp, layer, transform) result(out) Initalising function for Torus SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: oradius Outer radius of Torus real(kind=wp), intent(in) :: iradius Inner radius of Torus type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( torus ) Contents Source Code torus_init Source Code function torus_init ( oradius , iradius , optProp , layer , transform ) result ( out ) !! Initalising function for Torus SDF. type ( torus ) :: out !> Outer radius of Torus real ( kind = wp ), intent ( IN ) :: oradius !> Inner radius of Torus real ( kind = wp ), intent ( IN ) :: iradius !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % oradius = oradius out % iradius = iradius out % layer = layer out % transform = t out % optProps = optProp end function torus_init","tags":"","loc":"proc/torus_init.html"},{"title":"triprism_init – signedMCRT","text":"private function triprism_init(h1, h2, optProp, layer, transform) result(out) Initalising function for triprisim SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: h1 Height of triprisim real(kind=wp), intent(in) :: h2 length of triprisim type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( triprism ) Contents Source Code triprism_init Source Code function triprism_init ( h1 , h2 , optProp , layer , transform ) result ( out ) !! Initalising function for triprisim SDF. type ( triprism ) :: out !> Height of triprisim real ( kind = wp ), intent ( IN ) :: h1 !> length of triprisim real ( kind = wp ), intent ( IN ) :: h2 !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % h1 = h1 out % h2 = h2 out % layer = layer out % transform = t out % optProps = optProp end function triprism_init","tags":"","loc":"proc/triprism_init.html"},{"title":"box – signedMCRT","text":"public interface box Interface to box SDF initialising function Contents Module Procedures box_init Module Procedures private function box_init (lengths, optProp, layer, transform) result(out) Initalising function for Box SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: lengths Lengths of each dimension of the box type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( box )","tags":"","loc":"interface/box.html"},{"title":"capsule – signedMCRT","text":"public interface capsule Interface to capsule SDF initialising function Contents Module Procedures capsule_init Module Procedures private function capsule_init (a, b, r, optProp, layer, transform) result(out) Initalising function for capsule SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Capsule startpoint type( vector ), intent(in) :: b Capsule endpoint real(kind=wp), intent(in) :: r Capsule radius type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( capsule )","tags":"","loc":"interface/capsule.html"},{"title":"cone – signedMCRT","text":"public interface cone Interface to cone SDF initialising function Contents Module Procedures cone_init Module Procedures private function cone_init (a, b, ra, rb, optProp, layer, transform) result(out) Initalising function for Capped Cone SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Centre of base of Cone type( vector ), intent(in) :: b Tip of cone real(kind=wp), intent(in) :: ra Radius of Cones base real(kind=wp), intent(in) :: rb Radius of Cones tip. For rb = 0.0 get normal uncapped cone. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cone )","tags":"","loc":"interface/cone.html"},{"title":"cylinder – signedMCRT","text":"public interface cylinder Interface to cylinder SDF initialising function Contents Module Procedures cylinder_init Module Procedures private function cylinder_init (a, b, radius, optProp, layer, transform) result(out) Initalising function for Cylinder SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Vector position at centre of the bottom circle type( vector ), intent(in) :: b Vector position at centre of the top circle real(kind=wp), intent(in) :: radius Radius of cylinder type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cylinder )","tags":"","loc":"interface/cylinder.html"},{"title":"egg – signedMCRT","text":"public interface egg Interface to egg SDF initialising function Contents Module Procedures egg_init Module Procedures private function egg_init (r1, r2, h, optProp, layer, transform) result(out) Initalising function for egg SDF.\nmakes a Moss egg. ref . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: r1 R1 controls \"fatness\" of the egg. Actually controls the base circle radius. real(kind=wp), intent(in) :: r2 R2 contorls the pointiness of the egg. Actually controls radius of top circle. real(kind=wp), intent(in) :: h h controls the height of the egg. Actually controls y position of top circle. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( egg )","tags":"","loc":"interface/egg.html"},{"title":"plane – signedMCRT","text":"public interface plane Interface to plane SDF initialising function Contents Module Procedures plane_init Module Procedures private function plane_init (a, optProp, layer, transform) result(out) Initalising function for plane SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Plane normal. must be normalised type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( plane )","tags":"","loc":"interface/plane.html"},{"title":"segment – signedMCRT","text":"public interface segment Interface to segment SDF initialising function Contents Module Procedures segment_init Module Procedures private function segment_init (a, b, optProp, layer, transform) result(out) Initalising function for segment SDF.\nNote this is a 2D function Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a segment start point type( vector ), intent(in) :: b segment end point type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( segment )","tags":"","loc":"interface/segment.html"},{"title":"sphere – signedMCRT","text":"public interface sphere Contents Module Procedures sphere_init Module Procedures private function sphere_init (radius, optProp, layer, transform) result(out) Initalising function for Sphere SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: radius radius of the Sphere type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( sphere )","tags":"","loc":"interface/sphere.html"},{"title":"torus – signedMCRT","text":"public interface torus Interface to torus SDF initialising function Contents Module Procedures torus_init Module Procedures private function torus_init (oradius, iradius, optProp, layer, transform) result(out) Initalising function for Torus SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: oradius Outer radius of Torus real(kind=wp), intent(in) :: iradius Inner radius of Torus type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( torus )","tags":"","loc":"interface/torus.html"},{"title":"triprism – signedMCRT","text":"public interface triprism Interface to triprisim SDF initialising function Contents Module Procedures triprism_init Module Procedures private function triprism_init (h1, h2, optProp, layer, transform) result(out) Initalising function for triprisim SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: h1 Height of triprisim real(kind=wp), intent(in) :: h2 length of triprisim type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( triprism )","tags":"","loc":"interface/triprism.html"},{"title":"identity – signedMCRT","text":"public function identity() result(r) Returns the identity transformation matrix Arguments None Return Value real(kind=wp), (4,4) Contents Source Code identity Source Code function identity () result ( r ) !! Returns the identity transformation matrix real ( kind = wp ) :: r ( 4 , 4 ) r (:, 1 ) = [ 1._wp , 0._wp , 0._wp , 0._wp ] r (:, 2 ) = [ 0._wp , 1._wp , 0._wp , 0._wp ] r (:, 3 ) = [ 0._wp , 0._wp , 1._wp , 0._wp ] r (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function identity","tags":"","loc":"proc/identity.html"},{"title":"rotate_x – signedMCRT","text":"public function rotate_x(angle) result(r) Uses utils rotation in the x-axis function from here Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: angle Angle to rotate by Return Value real(kind=wp), (4,4) Contents Source Code rotate_x Source Code function rotate_x ( angle ) result ( r ) !! rotation in the x-axis function from [here](https://inspirnathan.com/posts/54-shadertoy-tutorial-part-8/) use utils , only : deg2rad !> Angle to rotate by real ( kind = wp ), intent ( IN ) :: angle real ( kind = wp ) :: r ( 4 , 4 ), c , s , a a = deg2rad ( angle ) c = cos ( a ) s = sin ( a ) r (:, 1 ) = [ 1._wp , 0._wp , 0._wp , 0._wp ] r (:, 2 ) = [ 0._wp , c , - s , 0._wp ] r (:, 3 ) = [ 0._wp , s , c , 0._wp ] r (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function rotate_x","tags":"","loc":"proc/rotate_x.html"},{"title":"rotate_y – signedMCRT","text":"public function rotate_y(angle) result(r) Uses utils rotation in the y-axis function from here Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: angle Angle to rotate by Return Value real(kind=wp), (4,4) Contents Source Code rotate_y Source Code function rotate_y ( angle ) result ( r ) !! rotation in the y-axis function from [here](https://inspirnathan.com/posts/54-shadertoy-tutorial-part-8/) use utils , only : deg2rad !> Angle to rotate by real ( kind = wp ), intent ( IN ) :: angle real ( kind = wp ) :: r ( 4 , 4 ), c , s , a a = deg2rad ( angle ) c = cos ( a ) s = sin ( a ) r (:, 1 ) = [ c , 0._wp , s , 0._wp ] r (:, 2 ) = [ 0._wp , 1._wp , 0._wp , 0._wp ] r (:, 3 ) = [ - s , 0._wp , c , 0._wp ] r (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function rotate_y","tags":"","loc":"proc/rotate_y.html"},{"title":"rotate_z – signedMCRT","text":"public function rotate_z(angle) result(r) Uses utils rotation in the z-axis function from here Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: angle Angle to rotate by Return Value real(kind=wp), (4,4) Contents Source Code rotate_z Source Code function rotate_z ( angle ) result ( r ) !! rotation in the z-axis function from [here](https://inspirnathan.com/posts/54-shadertoy-tutorial-part-8/) use utils , only : deg2rad !> Angle to rotate by real ( kind = wp ), intent ( IN ) :: angle real ( kind = wp ) :: r ( 4 , 4 ), c , s , a a = deg2rad ( angle ) c = cos ( a ) s = sin ( a ) r (:, 1 ) = [ c , - s , 0._wp , 0._wp ] r (:, 2 ) = [ s , c , 0._wp , 0._wp ] r (:, 3 ) = [ 0._wp , 0._wp , 1._wp , 0._wp ] r (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function rotate_z","tags":"","loc":"proc/rotate_z.html"},{"title":"rotationAlign – signedMCRT","text":"public function rotationAlign(a, b) result(res) Calculate the rotation matrix to rotate vector a onto b ref1 ref2 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Vector to rotate. Unit vector type( vector ), intent(in) :: b Vector to be rotated onto. Unit vector Return Value real(kind=wp), (4,4) Contents Source Code rotationAlign Source Code function rotationAlign ( a , b ) result ( res ) !! Calculate the rotation matrix to rotate vector a onto b !! [ref1](https://en.wikipedia.org/wiki/Rodrigues%27_rotation_formula) !! [ref2](https://math.stackexchange.com/questions/180418/calculate-rotation-matrix-to-align-vector-a-to-vector-b-in-3d) !> Vector to rotate. Unit vector type ( vector ), intent ( in ) :: a !> Vector to be rotated onto. Unit vector type ( vector ), intent ( in ) :: b type ( vector ) :: v real ( kind = wp ) :: c , k , res ( 4 , 4 ), v_x ( 4 , 4 ), v_x2 ( 4 , 4 ) v = a . cross . b c = a . dot . b k = 1._wp / ( 1._wp + c ) !skew-symmetric matrix v_x (:, 1 ) = [ 0._wp , - 1._wp * v % z , v % y , 0._wp ] v_x (:, 2 ) = [ v % z , 0._wp , - 1._wp * v % x , 0._wp ] v_x (:, 3 ) = [ - 1._wp * v % y , v % x , 0._wp , 0._wp ] v_x (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 0._wp ] v_x2 = matmul ( v_x , v_x ) res = identity () + v_x + v_x2 * k end function rotationAlign","tags":"","loc":"proc/rotationalign.html"},{"title":"rotmat – signedMCRT","text":"public function rotmat(axis, angle) Uses utils Rotate around around an axis by a given angle taken from here Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: axis Axis to rotate around real(kind=wp), intent(in) :: angle Angle to rotate by in degrees Return Value real(kind=wp), (4,4) Contents Source Code rotmat Source Code function rotmat ( axis , angle ) !! Rotate around around an axis by a given angle taken from [here](http://www.neilmendoza.com/glsl-rotation-about-an-arbitrary-axis/) use utils , only : deg2rad !> Axis to rotate around type ( vector ), intent ( in ) :: axis !> Angle to rotate by in degrees real ( kind = wp ), intent ( in ) :: angle type ( vector ) :: axist real ( kind = wp ) :: rotmat ( 4 , 4 ), s , c , oc , a axist = axis % magnitude () a = deg2rad ( angle ) s = sin ( a ) c = cos ( a ) oc = 1._wp - c rotmat (:, 1 ) = [ oc * axist % x * axist % x + c , oc * axist % x * axist % y - axist % z * s ,& oc * axist % z * axist % x + axist % y * s , 0.0_wp ] rotmat (:, 2 ) = [ oc * axist % x * axist % y + axist % z * s , oc * axist % y * axist % y + c ,& oc * axist % y * axist % z - axist % x * s , 0.0_wp ] rotmat (:, 3 ) = [ oc * axist % z * axist % x - axist % y * s , oc * axist % y * axist % z + axist % x * s ,& oc * axist % z * axist % z + c , 0.0_wp ] rotmat (:, 4 ) = [ 0.0_wp , 0.0_wp , 0.0_wp , 1.0_wp ] end function rotmat","tags":"","loc":"proc/rotmat.html"},{"title":"skewSymm – signedMCRT","text":"public function skewSymm(a) result(out) Calculate the Skew Symmetric matrix for a given vector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Vector to calculate the skew symmetric matrix for. Return Value real(kind=wp), (4,4) Contents Source Code skewSymm Source Code function skewSymm ( a ) result ( out ) !! Calculate the Skew Symmetric matrix for a given vector !> Vector to calculate the skew symmetric matrix for. type ( vector ), intent ( in ) :: a real ( kind = wp ) :: out ( 4 , 4 ) out (:, 1 ) = [ 0._wp , - a % z , a % y , 0._wp ] out (:, 2 ) = [ a % z , 0._wp , - a % x , 0._wp ] out (:, 3 ) = [ - a % y , a % x , 0._wp , 0._wp ] out (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 0._wp ] end function skewSymm","tags":"","loc":"proc/skewsymm.html"},{"title":"translate – signedMCRT","text":"public function translate(o) result(out) Returns the Translation matrix for a given vector translation. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: o Vector to translate by. Return Value real(kind=wp), (4,4) Contents Source Code translate Source Code function translate ( o ) result ( out ) !! Returns the Translation matrix for a given vector translation. !> Vector to translate by. type ( vector ), intent ( IN ) :: o real ( kind = wp ) :: out ( 4 , 4 ) out (:, 1 ) = [ 1._wp , 0._wp , 0._wp , o % x ] out (:, 2 ) = [ 0._wp , 1._wp , 0._wp , o % y ] out (:, 3 ) = [ 0._wp , 0._wp , 1._wp , o % z ] out (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function translate","tags":"","loc":"proc/translate.html"},{"title":"SmoothUnion – signedMCRT","text":"public pure function SmoothUnion(d1, d2, k) result(res) Smooth union. Joins two SDFs together smoothly Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 SDF_1 distance real(kind=wp), intent(in) :: d2 SDF_2 distance real(kind=wp), intent(in) :: k smoothing factor. Return Value real(kind=wp) Contents Source Code SmoothUnion Source Code pure function SmoothUnion ( d1 , d2 , k ) result ( res ) !! Smooth union. Joins two SDFs together smoothly !> SDF_1 distance real ( kind = wp ), intent ( IN ) :: d1 !> SDF_2 distance real ( kind = wp ), intent ( IN ) :: d2 !> smoothing factor. real ( kind = wp ), intent ( IN ) :: k real ( kind = wp ) :: res , h h = max ( k - abs ( d1 - d2 ), 0._wp ) / k res = min ( d1 , d2 ) - h * h * h * k * ( 1._wp / 6._wp ) end function SmoothUnion","tags":"","loc":"proc/smoothunion.html"},{"title":"bend_init – signedMCRT","text":"private function bend_init(prim, k) result(out) Initialise the Bend modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: k Amoun to bend by. Return Value type( bend ) Contents Source Code bend_init Source Code type ( bend ) function bend_init ( prim , k ) result ( out ) !! Initialise the Bend modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Amoun to bend by. real ( kind = wp ), intent ( IN ) :: k out % k = k out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function bend_init","tags":"","loc":"proc/bend_init.html"},{"title":"displacement_init – signedMCRT","text":"private function displacement_init(prim, func) result(out) Initialise the displacement modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify procedure( primitive ) :: func Function to displace the SDF with. Return Value type( displacement ) Contents Source Code displacement_init Source Code type ( displacement ) function displacement_init ( prim , func ) result ( out ) !! Initialise the displacement modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Function to displace the SDF with. procedure ( primitive ) :: func out % func => func out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function displacement_init","tags":"","loc":"proc/displacement_init.html"},{"title":"elongate_init – signedMCRT","text":"private function elongate_init(prim, size) result(out) Initialise the elongate modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify type( vector ), intent(in) :: size Distance to elongate by Return Value type( elongate ) Contents Source Code elongate_init Source Code type ( elongate ) function elongate_init ( prim , size ) result ( out ) !! Initialise the elongate modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Distance to elongate by type ( vector ), intent ( IN ) :: size out % size = size out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function elongate_init","tags":"","loc":"proc/elongate_init.html"},{"title":"eval_bend – signedMCRT","text":"private pure elemental function eval_bend(this, pos) result(res) Evaluation function for Bend modifier. Type Bound bend Arguments Type Intent Optional Attributes Name class( bend ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Contents Source Code eval_bend Source Code pure elemental function eval_bend ( this , pos ) result ( res ) !! Evaluation function for Bend modifier. class ( bend ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: c , s , x2 , y2 , z2 c = cos ( this % k * pos % x ) s = sin ( this % k * pos % x ) x2 = c * pos % x - s * pos % y y2 = s * pos % x + c * pos % y z2 = pos % z res = this % prim % evaluate ( vector ( x2 , y2 , z2 )) end function eval_bend","tags":"","loc":"proc/eval_bend.html"},{"title":"eval_disp – signedMCRT","text":"private pure elemental function eval_disp(this, pos) result(res) Evaluation function for displacement modifier. Type Bound displacement Arguments Type Intent Optional Attributes Name class( displacement ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Contents Source Code eval_disp Source Code pure elemental function eval_disp ( this , pos ) result ( res ) !! Evaluation function for displacement modifier. class ( displacement ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: d1 , d2 d1 = this % prim % evaluate ( pos ) d2 = this % func ( pos ) res = d1 + d2 end function eval_disp","tags":"","loc":"proc/eval_disp.html"},{"title":"eval_elongate – signedMCRT","text":"private pure elemental function eval_elongate(this, pos) result(res) Evaluation function for Elongate modifier. Type Bound elongate Arguments Type Intent Optional Attributes Name class( elongate ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Contents Source Code eval_elongate Source Code pure elemental function eval_elongate ( this , pos ) result ( res ) !! Evaluation function for Elongate modifier. class ( elongate ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: w type ( vector ) :: q q = abs ( pos ) - this % size w = min ( max ( q % x , max ( q % y , q % z )), 0._wp ) res = this % prim % evaluate ( max ( q , 0._wp )) + w end function eval_elongate","tags":"","loc":"proc/eval_elongate.html"},{"title":"eval_extrude – signedMCRT","text":"private pure elemental function eval_extrude(this, pos) result(res) Evaluation function for Extrude modifier. Type Bound extrude Arguments Type Intent Optional Attributes Name class( extrude ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Contents Source Code eval_extrude Source Code pure elemental function eval_extrude ( this , pos ) result ( res ) !! Evaluation function for Extrude modifier. class ( extrude ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: w real ( kind = wp ) :: d d = this % prim % evaluate ( pos ) w = vector ( d , abs ( pos % z ) - this % h , 0._wp ) res = min ( max ( w % x , w % y ), 0._wp ) + length ( max ( w , 0._wp )) end function eval_extrude","tags":"","loc":"proc/eval_extrude.html"},{"title":"eval_onion – signedMCRT","text":"private pure elemental function eval_onion(this, pos) result(res) Evaluation function for Onion modifier. Type Bound onion Arguments Type Intent Optional Attributes Name class( onion ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Contents Source Code eval_onion Source Code pure elemental function eval_onion ( this , pos ) result ( res ) !! Evaluation function for Onion modifier. class ( onion ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res res = abs ( this % prim % evaluate ( pos )) - this % thickness end function eval_onion","tags":"","loc":"proc/eval_onion.html"},{"title":"eval_repeat – signedMCRT","text":"private pure elemental function eval_repeat(this, pos) result(res) Evaluation function for Repeat modifier. Type Bound repeat Arguments Type Intent Optional Attributes Name class( repeat ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Contents Source Code eval_repeat Source Code pure elemental function eval_repeat ( this , pos ) result ( res ) !! Evaluation function for Repeat modifier. ! use utils, only : clamp class ( repeat ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: q error stop \"Not implmented as no vector dependacny in utils yet!\" ! q = pos - this%c*clamp(nint(pos/this%c), this%la, this%lb) res = this % prim % evaluate ( q ) end function eval_repeat","tags":"","loc":"proc/eval_repeat.html"},{"title":"eval_revolution – signedMCRT","text":"private pure elemental function eval_revolution(this, pos) result(res) Evaluation function for Revolution modifier. Type Bound revolution Arguments Type Intent Optional Attributes Name class( revolution ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Contents Source Code eval_revolution Source Code pure elemental function eval_revolution ( this , pos ) result ( res ) !! Evaluation function for Revolution modifier. class ( revolution ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: pxz , q pxz = vector ( pos % x , pos % z , 0._wp ) q = vector ( length ( pxz ) - this % o , pos % y , 0._wp ) res = this % prim % evaluate ( q ) end function eval_revolution","tags":"","loc":"proc/eval_revolution.html"},{"title":"eval_twist – signedMCRT","text":"private pure elemental function eval_twist(this, pos) result(res) Evaluation function for Twist modifier. Type Bound twist Arguments Type Intent Optional Attributes Name class( twist ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) Contents Source Code eval_twist Source Code pure elemental function eval_twist ( this , pos ) result ( res ) !! Evaluation function for Twist modifier. class ( twist ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: c , s , x2 , y2 , z2 c = cos ( this % k * pos % z ) s = sin ( this % k * pos % z ) x2 = c * pos % x - s * pos % y y2 = s * pos % x + c * pos % y z2 = pos % z res = this % prim % evaluate ( vector ( x2 , y2 , z2 )) end function eval_twist","tags":"","loc":"proc/eval_twist.html"},{"title":"extrude_init – signedMCRT","text":"private function extrude_init(prim, h) result(out) Initialise the extrude modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: h Distance to extrude by. Return Value type( extrude ) Contents Source Code extrude_init Source Code type ( extrude ) function extrude_init ( prim , h ) result ( out ) !! Initialise the extrude modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Distance to extrude by. real ( kind = wp ), intent ( IN ) :: h out % h = h out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function extrude_init","tags":"","loc":"proc/extrude_init.html"},{"title":"intersection – signedMCRT","text":"public pure function intersection(d1, d2, k) result(res) Intersection operator. Returns the intersection of two SDFs. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 SDF_1 distance real(kind=wp), intent(in) :: d2 SDF_2 distance real(kind=wp), intent(in) :: k smoothing factor. Return Value real(kind=wp) Contents Source Code intersection Source Code pure function intersection ( d1 , d2 , k ) result ( res ) !! Intersection operator. Returns the intersection of two SDFs. !> SDF_1 distance real ( kind = wp ), intent ( IN ) :: d1 !> SDF_2 distance real ( kind = wp ), intent ( IN ) :: d2 !> smoothing factor. real ( kind = wp ), intent ( IN ) :: k real ( kind = wp ) :: res res = max ( d1 , d2 ) end function intersection","tags":"","loc":"proc/intersection.html"},{"title":"onion_init – signedMCRT","text":"private function onion_init(prim, thickness) result(out) Initialise the Onion modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: thickness Thickned to onion by. Return Value type( onion ) Contents Source Code onion_init Source Code type ( onion ) function onion_init ( prim , thickness ) result ( out ) !! Initialise the Onion modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Thickned to onion by. real ( kind = wp ), intent ( IN ) :: thickness out % thickness = thickness out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function onion_init","tags":"","loc":"proc/onion_init.html"},{"title":"repeat_init – signedMCRT","text":"private function repeat_init(prim, c, la, lb) result(out) Initialise the Repeat modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: c type( vector ), intent(in) :: la type( vector ), intent(in) :: lb Return Value type( repeat ) Contents Source Code repeat_init Source Code type ( repeat ) function repeat_init ( prim , c , la , lb ) result ( out ) !! Initialise the Repeat modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> type ( vector ), intent ( IN ) :: la !> type ( vector ), intent ( IN ) :: lb !> real ( kind = wp ), intent ( IN ) :: c out % c = c out % la = la out % lb = lb out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function repeat_init","tags":"","loc":"proc/repeat_init.html"},{"title":"revolution_init – signedMCRT","text":"private function revolution_init(prim, o) result(out) Initialise the Revolution modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: o Amount to revolve by. Return Value type( revolution ) Contents Source Code revolution_init Source Code type ( revolution ) function revolution_init ( prim , o ) result ( out ) !! Initialise the Revolution modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Amount to revolve by. real ( kind = wp ), intent ( IN ) :: o out % o = o out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function revolution_init","tags":"","loc":"proc/revolution_init.html"},{"title":"subtraction – signedMCRT","text":"public pure function subtraction(d1, d2, k) result(res) Subtraction operator. Takes one SDF from another.\nTake the first SDF from the 2nd SDF Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 SDF_1 distance real(kind=wp), intent(in) :: d2 SDF_2 distance real(kind=wp), intent(in) :: k unused factor. Return Value real(kind=wp) Contents Source Code subtraction Source Code pure function subtraction ( d1 , d2 , k ) result ( res ) !! Subtraction operator. Takes one SDF from another. !! Take the first SDF from the 2nd SDF !> SDF_1 distance real ( kind = wp ), intent ( IN ) :: d1 !> SDF_2 distance real ( kind = wp ), intent ( IN ) :: d2 !> unused factor. real ( kind = wp ), intent ( IN ) :: k real ( kind = wp ) :: res res = max ( - d1 , d2 ) end function subtraction","tags":"","loc":"proc/subtraction.html"},{"title":"twist_init – signedMCRT","text":"private function twist_init(prim, k) result(out) Initialise the twist modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real, intent(in) :: k Twist parameter. Return Value type( twist ) Contents Source Code twist_init Source Code type ( twist ) function twist_init ( prim , k ) result ( out ) !! Initialise the twist modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Twist parameter. real , intent ( in ) :: k out % k = k out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function twist_init","tags":"","loc":"proc/twist_init.html"},{"title":"union – signedMCRT","text":"public pure function union(d1, d2, k) result(res) Union operation. Joins two SDFs together Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 SDF_1 distance real(kind=wp), intent(in) :: d2 SDF_2 distance real(kind=wp), intent(in) :: k unused factor Return Value real(kind=wp) Contents Source Code union Source Code pure function union ( d1 , d2 , k ) result ( res ) !! Union operation. Joins two SDFs together !> SDF_1 distance real ( kind = wp ), intent ( IN ) :: d1 !> SDF_2 distance real ( kind = wp ), intent ( IN ) :: d2 !> unused factor real ( kind = wp ), intent ( IN ) :: k real ( kind = wp ) :: res res = min ( d1 , d2 ) end function union","tags":"","loc":"proc/union.html"},{"title":"bend – signedMCRT","text":"public interface bend Contents Module Procedures bend_init Module Procedures private function bend_init (prim, k) result(out) Initialise the Bend modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: k Amoun to bend by. Return Value type( bend )","tags":"","loc":"interface/bend.html"},{"title":"displacement – signedMCRT","text":"public interface displacement Contents Module Procedures displacement_init Module Procedures private function displacement_init (prim, func) result(out) Initialise the displacement modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify procedure( primitive ) :: func Function to displace the SDF with. Return Value type( displacement )","tags":"","loc":"interface/displacement.html"},{"title":"elongate – signedMCRT","text":"public interface elongate Contents Module Procedures elongate_init Module Procedures private function elongate_init (prim, size) result(out) Initialise the elongate modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify type( vector ), intent(in) :: size Distance to elongate by Return Value type( elongate )","tags":"","loc":"interface/elongate.html"},{"title":"extrude – signedMCRT","text":"public interface extrude Contents Module Procedures extrude_init Module Procedures private function extrude_init (prim, h) result(out) Initialise the extrude modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: h Distance to extrude by. Return Value type( extrude )","tags":"","loc":"interface/extrude.html"},{"title":"onion – signedMCRT","text":"public interface onion Contents Module Procedures onion_init Module Procedures private function onion_init (prim, thickness) result(out) Initialise the Onion modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: thickness Thickned to onion by. Return Value type( onion )","tags":"","loc":"interface/onion.html"},{"title":"repeat – signedMCRT","text":"public interface repeat Contents Module Procedures repeat_init Module Procedures private function repeat_init (prim, c, la, lb) result(out) Initialise the Repeat modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: c type( vector ), intent(in) :: la type( vector ), intent(in) :: lb Return Value type( repeat )","tags":"","loc":"interface/repeat.html"},{"title":"revolution – signedMCRT","text":"public interface revolution Contents Module Procedures revolution_init Module Procedures private function revolution_init (prim, o) result(out) Initialise the Revolution modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: o Amount to revolve by. Return Value type( revolution )","tags":"","loc":"interface/revolution.html"},{"title":"twist – signedMCRT","text":"public interface twist Contents Module Procedures twist_init Module Procedures private function twist_init (prim, k) result(out) Initialise the twist modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real, intent(in) :: k Twist parameter. Return Value type( twist )","tags":"","loc":"interface/twist.html"},{"title":"calcNormal – signedMCRT","text":"public function calcNormal(p, obj) Calculate the surface normal of a SDF at the point p numerically. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: p Position to evaluate at class( sdf_base ) :: obj SDF to calcuate surface normal of. Return Value type( vector ) Contents Source Code calcNormal Source Code type ( vector ) function calcNormal ( p , obj ) !! Calculate the surface normal of a SDF at the point p numerically. !> Position to evaluate at type ( vector ), intent ( IN ) :: p !> SDF to calcuate surface normal of. class ( sdf_base ) :: obj real ( kind = wp ) :: h type ( vector ) :: xyy , yyx , yxy , xxx h = 1e-6_wp xyy = vector ( 1._wp , - 1._wp , - 1._wp ) yyx = vector ( - 1._wp , - 1._wp , 1._wp ) yxy = vector ( - 1._wp , 1._wp , - 1._wp ) xxx = vector ( 1._wp , 1._wp , 1._wp ) calcNormal = xyy * obj % evaluate ( p + xyy * h ) + & yyx * obj % evaluate ( p + yyx * h ) + & yxy * obj % evaluate ( p + yxy * h ) + & xxx * obj % evaluate ( p + xxx * h ) calcNormal = calcNormal % magnitude () end function calcNormal","tags":"","loc":"proc/calcnormal.html"},{"title":"eval_model – signedMCRT","text":"private pure elemental function eval_model(this, pos) result(res) Evaluate the model Type Bound model Arguments Type Intent Optional Attributes Name class( model ), intent(in) :: this type( vector ), intent(in) :: pos Vector position to evaluate at Return Value real(kind=wp) Contents Source Code eval_model Source Code pure elemental function eval_model ( this , pos ) result ( res ) !! Evaluate the model class ( model ), intent ( in ) :: this !> Vector position to evaluate at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res integer :: i res = this % array ( 1 )% value % evaluate ( pos ) do i = 2 , size ( this % array ) res = this % func ( res , this % array ( i )% value % evaluate ( pos ), this % k ) end do end function eval_model","tags":"","loc":"proc/eval_model.html"},{"title":"getAlbedo – signedMCRT","text":"private function getAlbedo(this) result(res) Return albedo for the current SDF. Type Bound sdf Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) Contents Source Code getAlbedo Source Code function getAlbedo ( this ) result ( res ) !! Return albedo for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % albedo end function getAlbedo","tags":"","loc":"proc/getalbedo.html"},{"title":"getKappa – signedMCRT","text":"private function getKappa(this) result(res) Return for the current SDF Type Bound sdf Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) Contents Source Code getKappa Source Code function getKappa ( this ) result ( res ) !! Return \\kappa for the current SDF class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % kappa end function getKappa","tags":"","loc":"proc/getkappa.html"},{"title":"getMua – signedMCRT","text":"private function getMua(this) result(res) Return for the current SDF. Type Bound sdf Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) Contents Source Code getMua Source Code function getMua ( this ) result ( res ) !! Return \\mu_a for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % mua end function getMua","tags":"","loc":"proc/getmua.html"},{"title":"getN – signedMCRT","text":"private function getN(this) result(res) Return refractive index for the current SDF. Type Bound sdf Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) Contents Source Code getN Source Code function getN ( this ) result ( res ) !! Return refractive index for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % n end function getN","tags":"","loc":"proc/getn.html"},{"title":"getg2 – signedMCRT","text":"private function getg2(this) result(res) Return factor for the current SDF. Type Bound sdf Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) Contents Source Code getg2 Source Code function getg2 ( this ) result ( res ) !! Return g^2 factor for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % g2 end function getg2","tags":"","loc":"proc/getg2.html"},{"title":"gethgg – signedMCRT","text":"private function gethgg(this) result(res) Return g-factor for the current SDF. Type Bound sdf Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) Contents Source Code gethgg Source Code function gethgg ( this ) result ( res ) !! Return g-factor for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % hgg end function gethgg","tags":"","loc":"proc/gethgg.html"},{"title":"model_init – signedMCRT","text":"private function model_init(array, func, kopt) result(out) Initalise the model type. Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: array (:) Array of SDFs procedure( op ) :: func Operator to apply to SDF. real(kind=wp), intent(in), optional :: kopt Parameter used in modifier Return Value type( model ) Contents Source Code model_init Source Code function model_init ( array , func , kopt ) result ( out ) !! Initalise the model type. type ( model ) :: out !> Operator to apply to SDF. procedure ( op ) :: func !> Array of SDFs type ( sdf ), intent ( IN ) :: array (:) !> Parameter used in modifier real ( kind = wp ), optional , intent ( IN ) :: kopt integer :: i out % array = array out % func => func if ( present ( kopt )) then out % k = kopt else out % k = 0._wp end if do i = 2 , size ( array ) if ( array ( 1 )% value % optProps % value % mus /= array ( i )% value % optProps % value % mus ) then print * , \"Error mismatch in model mus in object: \" , i end if if ( array ( 1 )% value % optProps % value % mua /= array ( i )% value % optProps % value % mua ) then print * , \"Error mismatch in model mua in object: \" , i end if if ( array ( 1 )% value % optProps % value % hgg /= array ( i )% value % optProps % value % hgg ) then print * , \"Error mismatch in model hgg in object: \" , i end if if ( array ( 1 )% value % optProps % value % n /= array ( i )% value % optProps % value % n ) then print * , \"Error mismatch in model n in object: \" , i end if if ( array ( 1 )% value % layer /= array ( i )% value % layer ) then print * , \"Error mismatch in model layer in object: \" , i end if end do out % optProps = array ( 1 )% value % optProps out % layer = array ( 1 )% value % layer end function model_init","tags":"","loc":"proc/model_init.html"},{"title":"sdf_evaluate – signedMCRT","text":"private pure elemental function sdf_evaluate(this, pos) result(res) Evaluate the SDF at a given position. Type Bound sdf Arguments Type Intent Optional Attributes Name class( sdf ), intent(in) :: this type( vector ), intent(in) :: pos Return Value real(kind=wp) Contents Source Code sdf_evaluate Source Code pure elemental function sdf_evaluate ( this , pos ) result ( res ) !! Evaluate the SDF at a given position. class ( sdf ), intent ( in ) :: this type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res res = this % value % evaluate ( pos ) end function sdf_evaluate","tags":"","loc":"proc/sdf_evaluate.html"},{"title":"sdf_new – signedMCRT","text":"private function sdf_new(rhs) result(lhs) sdf initializer Arguments Type Intent Optional Attributes Name class( sdf_base ), intent(in) :: rhs Return Value type( sdf ) Contents Source Code sdf_new Source Code type ( sdf ) function sdf_new ( rhs ) result ( lhs ) !! sdf initializer class ( sdf_base ), intent ( in ) :: rhs allocate ( lhs % value , source = rhs ) end function sdf_new","tags":"","loc":"proc/sdf_new.html"},{"title":"render_sub – signedMCRT","text":"private subroutine render_sub(cnt, extent, samples, state) Uses sim_state_mod writer_mod constants utils Render the SDFs onto a voxel grid Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: cnt (:) type( vector ), intent(in) :: extent integer, intent(in) :: samples (3) type( settings_t ), intent(in) :: state Contents Source Code render_sub Source Code subroutine render_sub ( cnt , extent , samples , state ) !! Render the SDFs onto a voxel grid use sim_state_mod , only : settings_t use utils , only : pbar use constants , only : fileplace , sp use writer_mod type ( settings_t ), intent ( IN ) :: state type ( sdf ), intent ( IN ) :: cnt (:) integer , intent ( IN ) :: samples ( 3 ) type ( vector ), intent ( IN ) :: extent type ( vector ) :: pos , wid integer :: i , j , k , u , id real ( kind = wp ) :: x , y , z , ds ( size ( cnt )), ns ( 3 ), minvalue real ( kind = sp ), allocatable :: image (:, :, :) type ( pbar ) :: bar ns = nint ( samples / 2._wp ) allocate ( image ( samples ( 1 ), samples ( 2 ), samples ( 3 ))) wid = vector ( extent % x / ns ( 1 ), extent % y / ns ( 2 ), extent % z / ns ( 3 )) bar = pbar ( samples ( 1 )) !$omp parallel default(none) shared(cnt, ns, wid, image, samples, bar)& !$omp private(i, x, y, z, pos, j, k, u, ds, id, minvalue) !$omp do do i = 1 , samples ( 1 ) x = ( i - ns ( 1 )) * wid % x do j = 1 , samples ( 2 ) y = ( j - ns ( 2 )) * wid % y do k = 1 , samples ( 3 ) z = ( k - ns ( 3 )) * wid % z pos = vector ( x , y , z ) ds = 0._wp do u = 1 , size ( ds ) ds ( u ) = cnt ( u )% evaluate ( pos ) end do image ( i , j , k ) = minval ( ds ) end do end do call bar % progress () end do !$OMP end do !$OMP end parallel call write_data ( image , trim ( fileplace ) // state % renderfile , state , overwrite = . true .) end subroutine render_sub","tags":"","loc":"proc/render_sub.html"},{"title":"render_vec – signedMCRT","text":"private subroutine render_vec(cnt, state) Uses sim_state_mod Render the SDF\nWrapper around the render function to allow ease of use Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: cnt (:) type( settings_t ), intent(in) :: state Contents Source Code render_vec Source Code subroutine render_vec ( cnt , state ) !! Render the SDF !! Wrapper around the render function to allow ease of use use sim_state_mod , only : settings_t type ( settings_t ), intent ( IN ) :: state type ( sdf ), intent ( IN ) :: cnt (:) type ( vector ) :: extent extent = vector ( state % grid % xmax , state % grid % ymax , state % grid % zmax ) call render_sub ( cnt , extent , state % render_size , state ) end subroutine render_vec","tags":"","loc":"proc/render_vec.html"},{"title":"sdf_assign – signedMCRT","text":"private subroutine sdf_assign(lhs, rhs) sdf initializer Type Bound sdf Arguments Type Intent Optional Attributes Name class( sdf ), intent(inout) :: lhs class( sdf_base ), intent(in) :: rhs Contents Source Code sdf_assign Source Code subroutine sdf_assign ( lhs , rhs ) !! sdf initializer class ( sdf ), intent ( inout ) :: lhs class ( sdf_base ), intent ( in ) :: rhs if ( allocated ( lhs % value )) deallocate ( lhs % value ) ! Prevent nested derived type select type ( rhsT => rhs ) class is ( sdf ) if ( allocated ( rhsT % value )) allocate ( lhs % value , source = rhsT % value ) class default allocate ( lhs % value , source = rhsT ) end select end subroutine sdf_assign","tags":"","loc":"proc/sdf_assign.html"},{"title":"model – signedMCRT","text":"public interface model Contents Module Procedures model_init Module Procedures private function model_init (array, func, kopt) result(out) Initalise the model type. Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: array (:) Array of SDFs procedure( op ) :: func Operator to apply to SDF. real(kind=wp), intent(in), optional :: kopt Parameter used in modifier Return Value type( model )","tags":"","loc":"interface/model.html"},{"title":"render – signedMCRT","text":"public interface render Contents Module Procedures render_sub render_vec Module Procedures private subroutine render_sub (cnt, extent, samples, state) Render the SDFs onto a voxel grid Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: cnt (:) type( vector ), intent(in) :: extent integer, intent(in) :: samples (3) type( settings_t ), intent(in) :: state private subroutine render_vec (cnt, state) Render the SDF\nWrapper around the render function to allow ease of use Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: cnt (:) type( settings_t ), intent(in) :: state","tags":"","loc":"interface/render.html"},{"title":"sdf – signedMCRT","text":"public interface sdf Contents Module Procedures sdf_new Module Procedures private function sdf_new (rhs) result(lhs) sdf initializer Arguments Type Intent Optional Attributes Name class( sdf_base ), intent(in) :: rhs Return Value type( sdf )","tags":"","loc":"interface/sdf.html"},{"title":"setupGeometry – signedMCRT","text":"contains all the routines that setup premade experimental geometry Uses tomlf constants Contents Functions get_vessels setup_egg setup_exp setup_logo setup_omg_sdf setup_scat_test setup_scat_test2 setup_sphere setup_sphere_scene Functions public function get_vessels () result(array) setup blood vessel scene Arguments None Return Value type( sdf ), allocatable, (:) public function setup_egg () result(array) setup an egg, with yolk, albumen and shell Arguments None Return Value type( sdf ), allocatable, (:) public function setup_exp (dict) result(array) Setup experimental geometry from Georgies paper. i.e a glass bottle with contents Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Return Value type( sdf ), allocatable, (:) public function setup_logo () result(array) setup uni crest geometry Arguments None Return Value type( sdf ), allocatable, (:) public function setup_omg_sdf () result(array) setup OMG scene Arguments None Return Value type( sdf ), allocatable, (:) public function setup_scat_test (dict) result(array) set up scattering test scene with user defined tau Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Return Value type( sdf ), allocatable, (:) public function setup_scat_test2 (dict) result(array) set up scattering test scene 2 with user defined tau and hgg Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Return Value type( sdf ), allocatable, (:) public function setup_sphere () result(array) setup the sphere test case from tran and jacques paper. Arguments None Return Value type( sdf ), allocatable, (:) public function setup_sphere_scene (dict) result(array) setup a test scene with user defined spheres Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Return Value type( sdf ), allocatable, (:)","tags":"","loc":"module/setupgeometry.html"},{"title":"photonMod – signedMCRT","text":"This source file contains the photon type, all the photon launch routines for different light sources, and the scattering code. Below are the current types of light sources available. Check here for parameters needed for each light source. uniform pencil annulus focus point circular SLM (2D image source) double slit square aperture Uses vector_class random constants Contents Variables photon_origin Interfaces photon Abstract Interfaces generic_emit Derived Types photon Functions init_photon init_source Subroutines annulus aperture circular dslit focus pencil point scatter set_photon slm uniform Variables Type Visibility Attributes Name Initial type( photon ), public :: photon_origin used to save some computation time Interfaces public interface photon public function init_source (choice) Bind emission function to photon object Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: choice Name of light source to use Return Value type( photon ) private function init_photon (val) set up all the variables in the photon object Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val value to assing to variables Return Value type( photon ) Abstract Interfaces abstract interface public subroutine generic_emit(this, spectrum, dict, seqs) Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) Derived Types type, public :: photon photon class Components Type Visibility Attributes Name Initial integer, public :: bounces Debug data. Number of SDF evals integer, public :: cnts Debug data. Number of SDF evals real(kind=wp), public :: cosp direction cosines real(kind=wp), public :: cost direction cosines procedure( generic_emit ), public, pointer :: emit => null() emission routine real(kind=wp), public :: energy Energy of the packet. TODO real(kind=wp), public :: fact . Used to save computational time integer, public :: id Thread ID of the packet integer, public :: layer ID of the SDF the packet is in real(kind=wp), public :: nxp direction vectors real(kind=wp), public :: nyp direction vectors real(kind=wp), public :: nzp direction vectors real(kind=wp), public :: phase Current phase of the packet real(kind=wp), public :: phi direction cosines type( vector ), public :: pos postion of photon packet in cm. (0,0,0) is the center of the grid. real(kind=wp), public :: sinp direction cosines real(kind=wp), public :: sint direction cosines real(kind=wp), public :: step used if photon packet weights are used logical, public :: tflag photon alive flag real(kind=wp), public :: wavelength Wavelength of the packet real(kind=wp), public :: weight used if photon packet weights are used integer, public :: xcell grid cell position integer, public :: ycell grid cell position integer, public :: zcell grid cell position Constructor public\n\n \n function init_source (choice) Bind emission function to photon object private\n\n \n function init_photon (val) set up all the variables in the photon object Type-Bound Procedures procedure\n , public\n, :: scatter Subroutine scattering routine Functions private function init_photon (val) set up all the variables in the photon object Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val value to assing to variables Return Value type( photon ) public function init_source (choice) Bind emission function to photon object Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: choice Name of light source to use Return Value type( photon ) Subroutines private subroutine annulus (this, spectrum, dict, seqs) annular source Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) private subroutine aperture (this, spectrum, dict, seqs) sample from square aperture to produce diff pattern Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) private subroutine circular (this, spectrum, dict, seqs) circular source Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) private subroutine dslit (this, spectrum, dict, seqs) sample from double slit to produce diff pattern Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) private subroutine focus (this, spectrum, dict, seqs) Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) private subroutine pencil (this, spectrum, dict, seqs) pencil beam source Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) private subroutine point (this, spectrum, dict, seqs) isotropic point source Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) private subroutine scatter (this, hgg, g2, dects) Scattering routine. Implments both isotropic and henyey-greenstein scattering\ntaken from mcxyz Arguments Type Intent Optional Attributes Name class( photon ), intent(inout) :: this real(kind=wp), intent(in) :: hgg g factor real(kind=wp), intent(in) :: g2 g factor squared type( dect_array ), intent(in), optional :: dects (:) array of detectors. Only used if biased scattering is enabled. public subroutine set_photon (pos, dir) Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos type( vector ), intent(in) :: dir private subroutine slm (this, spectrum, dict, seqs) Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2) private subroutine uniform (this, spectrum, dict, seqs) uniformly illuminate a surface of the simulation media Arguments Type Intent Optional Attributes Name class( photon ) :: this type( spectrum_t ), intent(in) :: spectrum type(toml_table), intent(inout), optional :: dict type( seq ), intent(inout), optional :: seqs (2)","tags":"","loc":"module/photonmod.html"},{"title":"surfaces – signedMCRT","text":"Contains the routines that handle reflection, and refraction via the Fresnel equations. Uses vector_class constants Contents Functions fresnel Subroutines reflect reflect_refract refract Functions private function fresnel (I, N, n1, n2) result(tir) calculates the fresnel coefficents Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: I incident vector type( vector ), intent(in) :: N Normal vector real(kind=wp), intent(in) :: n1 reffractive indicies real(kind=wp), intent(in) :: n2 reffractive indicies Return Value real(kind=wp) Subroutines private subroutine reflect (I, N) get vector of reflected photon Arguments Type Intent Optional Attributes Name type( vector ), intent(inout) :: I incident vector type( vector ), intent(in) :: N normal vector public subroutine reflect_refract (I, N, n1, n2, rflag, Ri) wrapper routine for fresnel calculation Arguments Type Intent Optional Attributes Name type( vector ), intent(inout) :: I incident vector type( vector ), intent(inout) :: N normal vector real(kind=wp), intent(in) :: n1 refractive indices real(kind=wp), intent(in) :: n2 refractive indices logical, intent(out) :: rflag reflection flag real(kind=wp), intent(out) :: Ri private subroutine refract (I, N, eta) get vector of refracted photon Arguments Type Intent Optional Attributes Name type( vector ), intent(inout) :: I incident vector type( vector ), intent(in) :: N normal vector real(kind=wp), intent(in) :: eta","tags":"","loc":"module/surfaces.html"},{"title":"setupMod – signedMCRT","text":"This file sets up some simulations variables and assigns the geometry for the simulation. Uses tomlf constants Contents Subroutines alloc_array create_directory dealloc_array directory setup_simulation zarray Subroutines private subroutine alloc_array (nxg, nyg, nzg) subroutine allocates allocatable arrays Arguments Type Intent Optional Attributes Name integer, intent(in) :: nxg grid size integer, intent(in) :: nyg grid size integer, intent(in) :: nzg grid size private subroutine create_directory (name, flag, appendname, newline) create directories if they don't exist Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: name logical, intent(in) :: flag character(len=*), intent(in) :: appendname logical, intent(in), optional :: newline public subroutine dealloc_array () deallocate data arrays Arguments None public subroutine directory () subroutine defines vars to hold paths to various folders Arguments None public subroutine setup_simulation (sdfarray, dict) Read in parameters\nSetup up various simulation parameters and routines Arguments Type Intent Optional Attributes Name type( sdf ), intent(out), allocatable :: sdfarray (:) output array of geometry type(toml_table), intent(inout), optional :: dict dictionary used to store metadata private subroutine zarray () zero data arrays Arguments None","tags":"","loc":"module/setupmod.html"},{"title":"mat_class – signedMCRT","text":"Matrix class module. Defines a matrix type (4x4 matrix) and associated operations on matrices and other types. not fully implmented matix class\nminimum implmented for neural sdf type Uses constants vec4_class Contents Interfaces mat Derived Types mat Functions invert mat_add_scal mat_div_scal mat_init mat_minus_scal mat_mult_mat mat_mult_scal scal_add_mat scal_mult_mat Interfaces public interface mat Intalise Matrix with 1D Array private function mat_init (array) Initalise matrix type from 1D array Arguments Type Intent Optional Attributes Name real(kind=wp) :: array (16) 1D array to initalise from. Return Value type( mat ) Derived Types type, public :: mat Components Type Visibility Attributes Name Initial real(kind=wp), public :: vals (4,4) Matrix values Constructor Intalise Matrix with 1D Array private\n\n \n function mat_init (array) Initalise matrix type from 1D array Type-Bound Procedures procedure\n , private\n, pass(a) :: mat_add_scal Function procedure\n , private\n, pass(a) :: mat_div_scal Function procedure\n , private\n, pass(a) :: mat_minus_scal Function procedure\n , private\n, pass(a) :: mat_mult_mat Function procedure\n , private\n, pass(a) :: mat_mult_scal Function generic,\n public\n, :: operator(*) => mat_mult_scal , scal_mult_mat , mat_mult_mat Overload for Multiplication operator generic,\n public\n, :: operator(+) => mat_add_scal , scal_add_mat Overload for Addition operator generic,\n public\n, :: operator(-) => mat_minus_scal Overload for Subtraction operator generic,\n public\n, :: operator(/) => mat_div_scal Overload for Division operator procedure\n , private\n, pass(b) :: scal_add_mat Function procedure\n , private\n, pass(b) :: scal_mult_mat Function Functions public pure function invert (A) result(B) Performs a direct calculation of the inverse of a 4×4 matrix.\nfrom http://fortranwiki.org/fortran/show/Matrix+inversion Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: A (4,4) Input Matric Return Value real(kind=wp), (4,4) private function mat_add_scal (a, b) Matrix + Scalar = Matrix Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to add Return Value type( mat ) private function mat_div_scal (a, b) Matrix / scalar Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to divide by Return Value type( mat ) private function mat_init (array) Initalise matrix type from 1D array Arguments Type Intent Optional Attributes Name real(kind=wp) :: array (16) 1D array to initalise from. Return Value type( mat ) private function mat_minus_scal (a, b) Matrix - Scalar Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( mat ) private function mat_mult_mat (a, b) Matrix * vec4 Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix type( vec4 ), intent(in) :: b Vec4 to multiply by Return Value type( vec4 ) private function mat_mult_scal (a, b) Matrix * Scalar Arguments Type Intent Optional Attributes Name class( mat ), intent(in) :: a Input Matrix real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( mat ) private function scal_add_mat (a, b) Scaler + Matrix Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalat to add class( mat ), intent(in) :: b Input Matrix Return Value type( mat ) private function scal_mult_mat (a, b) Matrix * Scalar Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( mat ), intent(in) :: b Input Matrix Return Value type( mat )","tags":"","loc":"module/mat_class.html"},{"title":"historyStack – signedMCRT","text":"Module contains the history stack type which stores the history of positions of a photon and th I/O routines\nnot fully implmented Uses constants vec4_class Contents Variables block_size Interfaces history_stack_t Derived Types history_stack_t Functions histempty_fn histpeek_fn histpop_fn init_historyStack Subroutines histfinish_sub histpush_sub histwrite_sub histzero_sub json_writer obj_writer ply_writer Variables Type Visibility Attributes Name Initial integer, public, parameter :: block_size = 32 Interfaces public interface history_stack_t private function init_historyStack (filename, id) Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: filename integer, intent(in) :: id Return Value type( history_stack_t ) Derived Types type, public :: history_stack_t Components Type Visibility Attributes Name Initial type( vec4 ), public, allocatable :: data (:) integer, public :: edge_counter character(len=:), public, allocatable :: filename integer, public :: size character(len=:), public, allocatable :: type integer, public :: vertex_counter Constructor private\n\n \n function init_historyStack (filename, id) Type-Bound Procedures procedure\n , public\n, :: empty => histempty_fn Function procedure\n , public\n, :: finish => histfinish_sub Subroutine procedure\n , public\n, :: peek => histpeek_fn Function procedure\n , public\n, :: pop => histpop_fn Function procedure\n , public\n, :: push => histpush_sub Subroutine procedure\n , public\n, :: write => histwrite_sub Subroutine procedure\n , public\n, :: zero => histzero_sub Subroutine Functions private function histempty_fn (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Return Value logical private function histpeek_fn (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Return Value type( vec4 ) private function histpop_fn (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this Return Value type( vec4 ) private function init_historyStack (filename, id) Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: filename integer, intent(in) :: id Return Value type( history_stack_t ) Subroutines private subroutine histfinish_sub (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this private subroutine histpush_sub (this, val) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this type( vec4 ), intent(in) :: val private subroutine histwrite_sub (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this private subroutine histzero_sub (this) Arguments Type Intent Optional Attributes Name class( history_stack_t ) :: this private subroutine json_writer (this) Arguments Type Intent Optional Attributes Name type( history_stack_t ), intent(inout) :: this private subroutine obj_writer (this) Arguments Type Intent Optional Attributes Name type( history_stack_t ), intent(inout) :: this private subroutine ply_writer (this) Arguments Type Intent Optional Attributes Name type( history_stack_t ), intent(inout) :: this","tags":"","loc":"module/historystack.html"},{"title":"vector_class – signedMCRT","text":"Vector class module. Defines a vector type (x, y, z) and associated operations on vectors and other types. Uses constants Contents Interfaces abs max min nint Derived Types vector Functions abs_vec length magnitude max_vec maxval_vec min_vec minval_vec nint_vec scal_add_vec scal_minus_vec scal_mult_vec vec_add_scal vec_add_vec vec_cross_vec vec_div_scal_int vec_div_scal_r4 vec_div_scal_r8 vec_dot_mat vec_dot_vec vec_equal_vec vec_minus_scal vec_minus_vec vec_mult_exp_scal_int vec_mult_exp_scal_r4 vec_mult_exp_scal_r8 vec_mult_scal vec_mult_vec Interfaces public interface abs Overload of the abs intrinsic for a vec3 private pure elemental function abs_vec (this) Calculate the absoulte of a vector elementwise Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value type( vector ) public interface max Overload of the max intrinsic for a vec3 private pure elemental function max_vec (this, val) Get the max value elementwise between a vec3 and a scalar Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector real(kind=wp), intent(in) :: val Input max value Return Value type( vector ) private pure elemental function maxval_vec (this) Get the max value in a vec3 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value real(kind=wp) public interface min Overload of the min intrinsic for a vec3 private pure elemental function min_vec (this, val) Get the min value elementwise between a vec3 and a scalar Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector real(kind=wp), intent(in) :: val Input minimum value Return Value type( vector ) private pure elemental function minval_vec (this) Get the min value in a vec3 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value real(kind=wp) public interface nint Overload of the nint intrinsic for a vec3 private pure elemental function nint_vec (this) Overload the nint intrinsic for a vec3 elementwise Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value type( vector ) Derived Types type, public :: vector Vector class Components Type Visibility Attributes Name Initial real(kind=wp), public :: x vector components real(kind=wp), public :: y vector components real(kind=wp), public :: z vector components Type-Bound Procedures procedure\n , public\n, :: length Function Returns the length of the vector procedure\n , public\n, :: magnitude Function Returns the magnitude of the vector generic,\n public\n, :: operator(*) => vec_mult_vec , vec_mult_scal , scal_mult_vec Overloads the Multiplication operator for vec3 generic,\n public\n, :: operator(**) => vec_mult_exp_scal_int , vec_mult_exp_scal_r4 , vec_mult_exp_scal_r8 Overloads the exponential operator for vec3 generic,\n public\n, :: operator(+) => vec_add_vec , vec_add_scal , scal_add_vec Overloads the Addition operator for vec3 generic,\n public\n, :: operator(-) => vec_minus_vec , vec_minus_scal , scal_minus_vec Overloads the Subtraction operator for vec3 generic,\n public\n, :: operator(.cross.) => vec_cross_vec .cross. operator. Cross product generic,\n public\n, :: operator(.dot.) => vec_dot_vec , vec_dot_mat .dot. operator. Dot product generic,\n public\n, :: operator(/) => vec_div_scal_r4 , vec_div_scal_r8 , vec_div_scal_int Overloads the Division operator for vec3 generic,\n public\n, :: operator(==) => vec_equal_vec Overloads the equal operator for vec3 procedure\n , private\n, pass(b) :: scal_add_vec Function procedure\n , private\n, pass(b) :: scal_minus_vec Function procedure\n , private\n, pass(b) :: scal_mult_vec Function procedure\n , private\n, pass(a) :: vec_add_scal Function procedure\n , private\n, pass(a) :: vec_add_vec Function procedure\n , private\n, pass(a) :: vec_cross_vec Function procedure\n , private\n, pass(a) :: vec_div_scal_int Function procedure\n , private\n, pass(a) :: vec_div_scal_r4 Function procedure\n , private\n, pass(a) :: vec_div_scal_r8 Function procedure\n , private\n, pass(a) :: vec_dot_mat Function procedure\n , private\n, pass(a) :: vec_dot_vec Function procedure\n , private\n, pass(a) :: vec_equal_vec Function procedure\n , private\n, pass(a) :: vec_minus_scal Function procedure\n , private\n, pass(a) :: vec_minus_vec Function procedure\n , private\n, pass(a) :: vec_mult_exp_scal_int Function procedure\n , private\n, pass(a) :: vec_mult_exp_scal_r4 Function procedure\n , private\n, pass(a) :: vec_mult_exp_scal_r8 Function procedure\n , private\n, pass(a) :: vec_mult_scal Function procedure\n , private\n, pass(a) :: vec_mult_vec Function Functions private pure elemental function abs_vec (this) Calculate the absoulte of a vector elementwise Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value type( vector ) public pure elemental function length (this) Returns the length of a vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: this Return Value real(kind=wp) public pure elemental function magnitude (this) Returns the magnitude of a vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: this Return Value type( vector ) private pure elemental function max_vec (this, val) Get the max value elementwise between a vec3 and a scalar Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector real(kind=wp), intent(in) :: val Input max value Return Value type( vector ) private pure elemental function maxval_vec (this) Get the max value in a vec3 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value real(kind=wp) private pure elemental function min_vec (this, val) Get the min value elementwise between a vec3 and a scalar Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector real(kind=wp), intent(in) :: val Input minimum value Return Value type( vector ) private pure elemental function minval_vec (this) Get the min value in a vec3 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value real(kind=wp) private pure elemental function nint_vec (this) Overload the nint intrinsic for a vec3 elementwise Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: this Input vector Return Value type( vector ) private pure elemental function scal_add_vec (a, b) vec3 + scalar Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to add class( vector ), intent(in) :: b Input vector Return Value type( vector ) private pure elemental function scal_minus_vec (a, b) scalar - vec3 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to subtract from class( vector ), intent(in) :: b Input vector Return Value type( vector ) private pure elemental function scal_mult_vec (a, b) Scalar * vec3 elementwise Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( vector ), intent(in) :: b input vec3 Return Value type( vector ) private pure elemental function vec_add_scal (a, b) vec3 + scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector real(kind=wp), intent(in) :: b Scalar to add Return Value type( vector ) private pure elemental function vec_add_vec (a, b) vec3 + vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b Vec3 to add Return Value type( vector ) private pure elemental function vec_cross_vec (a, b) result(cross) vec3 x vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b vec3 to cross with Return Value type( vector ) private pure elemental function vec_div_scal_int (a, b) vec3 / scalar elementwise. Scalar is an integer Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 integer, intent(in) :: b Scalar to divide by Return Value type( vector ) private pure elemental function vec_div_scal_r4 (a, b) vec3 / scalar elementwise. Scalar is a 32-bit float Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=sp), intent(in) :: b Scalar to divide by Return Value type( vector ) private pure elemental function vec_div_scal_r8 (a, b) vec3 / scalar elementwise. Scalar is a 64-bit float Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=dp), intent(in) :: b Scalar to divide by Return Value type( vector ) private pure function vec_dot_mat (a, b) result(dot) vec3 . matrix Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3 real(kind=wp), intent(in) :: b (4,4) Matrix to dot with Return Value type( vector ) private pure elemental function vec_dot_vec (a, b) result(dot) vec3 . vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3 type( vector ), intent(in) :: b vec3 to dot Return Value real(kind=wp) private pure elemental function vec_equal_vec (a, b) vec3 == vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vec3s class( vector ), intent(in) :: b Input vec3s Return Value logical private pure elemental function vec_minus_scal (a, b) vec3 - scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( vector ) private pure elemental function vec_minus_vec (a, b) vec3 - vec3 Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input vector type( vector ), intent(in) :: b vec3 to subtract Return Value type( vector ) private pure elemental function vec_mult_exp_scal_int (a, b) vec3**scalar for integer scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector integer, intent(in) :: b Input scalar Return Value type( vector ) private pure elemental function vec_mult_exp_scal_r4 (a, b) vec3**scalar for 32-bit float scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector real(kind=sp), intent(in) :: b Input scalar Return Value type( vector ) private pure elemental function vec_mult_exp_scal_r8 (a, b) vec3**scalar for 64-bit float scalar Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a Input Vector real(kind=dp), intent(in) :: b Input scalar Return Value type( vector ) private pure elemental function vec_mult_scal (a, b) vec3 * scalar elementwise Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( vector ) private pure elemental function vec_mult_vec (a, b) vec3 * vec3 elementwise Arguments Type Intent Optional Attributes Name class( vector ), intent(in) :: a input vec3 type( vector ), intent(in) :: b vec3 to multiply by Return Value type( vector )","tags":"","loc":"module/vector_class.html"},{"title":"sim_state_mod – signedMCRT","text":"This module defines the setting_t type which holds simulation metadata: Uses gridMod Contents Variables state Derived Types settings_t Variables Type Visibility Attributes Name Initial type( settings_t ), public :: state global var that stores simulation state Derived Types type, public :: settings_t Components Type Visibility Attributes Name Initial logical, public :: absorb Boolean to indicate whether to store absoption data. character(len=:), public, allocatable :: experiment Name of experiment/simulation type( cart_grid ), public :: grid Cart_grid type character(len=:), public, allocatable :: historyFilename Name of photon history file integer, public :: iseed initial seed for random number generator integer, public :: nphotons Number of photons to run character(len=:), public, allocatable :: outfile Name of fluence output file character(len=:), public, allocatable :: outfile_absorb Name of absoprtion output file logical, public :: overwrite Boolean to indicate whether to use overwrite datafiles if they have the same name. logical, public :: render_geom Boolean to indicate whether to render SDF to voxels or not. integer, public :: render_size (3) Size of the voxel grid to render SDFs to character(len=:), public, allocatable :: renderfile Name of voxel render file character(len=:), public, allocatable :: source Light source used logical, public :: tev Boolean to indicate whether to use TEV as debug viewer. logical, public :: trackHistory Boolean to indicate whether to store history of photons positions","tags":"","loc":"module/sim_state_mod.html"},{"title":"writer_mod – signedMCRT","text":"This module defines all functions that write simulation data to the disk or pre-process data before writing.\nnormalise_fluence. Normalises fluence by number of photons run and size of each voxel. !Does not normalise by power! write_fluence. Write out fluence in either raw or nrrd format. Default is nrrd.\nwrite_detected_photons. Write out photons detected by detectors. Changes should only be made here if there is a bug or new data types need to be written to disk (phase information) or new file format is needed. Uses constants Contents Interfaces nrrd_write raw_write Functions check_file get_new_file_name Subroutines normalise_fluence write_3d_r4_nrrd write_3d_r4_raw write_3d_r8_nrrd write_3d_r8_raw write_data write_detected_photons write_hdr Interfaces public interface nrrd_write private subroutine write_3d_r8_nrrd (array, filename, overwrite, dict) write 3D array of float64's to .nrrd fileformat Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:,:) array to be written to disk character(len=*), intent(in) :: filename filename logical, intent(in) :: overwrite overwrite flag type(toml_table), intent(inout), optional :: dict dictionary of metadata private subroutine write_3d_r4_nrrd (array, filename, overwrite, dict) write 3D array of float32's to .nrrd fileformat Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to be written to disk character(len=*), intent(in) :: filename filename logical, intent(in) :: overwrite overwrite flag type(toml_table), intent(inout), optional :: dict dictionary of metadata public interface raw_write private subroutine write_3d_r8_raw (array, filename, overwrite) write 3D array of float64s to disk as raw binary data Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:,:) array to write to disk character(len=*), intent(in) :: filename filename to save array as logical, intent(in) :: overwrite overwrite flag private subroutine write_3d_r4_raw (array, filename, overwrite) write 3D array of float32's to disk as raw binary data Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to write to disk character(len=*), intent(in) :: filename filename to save array as logical, intent(in) :: overwrite overwrite flag Functions private function check_file (file) result(res) Functional wrapper around inquire to check if file exits Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: file file to be checked Return Value logical private function get_new_file_name (file) result(res) If file exits, get numeral to append to filename Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: file file to be checked Return Value character(len=:), allocatable Subroutines public subroutine normalise_fluence (grid, array, nphotons) normalise fluence in the Lucy 1999 way Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid grid class real(kind=sp), intent(inout) :: array (:,:,:) array to normalise integer, intent(in) :: nphotons number of photons run private subroutine write_3d_r4_nrrd (array, filename, overwrite, dict) write 3D array of float32's to .nrrd fileformat Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to be written to disk character(len=*), intent(in) :: filename filename logical, intent(in) :: overwrite overwrite flag type(toml_table), intent(inout), optional :: dict dictionary of metadata private subroutine write_3d_r4_raw (array, filename, overwrite) write 3D array of float32's to disk as raw binary data Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to write to disk character(len=*), intent(in) :: filename filename to save array as logical, intent(in) :: overwrite overwrite flag private subroutine write_3d_r8_nrrd (array, filename, overwrite, dict) write 3D array of float64's to .nrrd fileformat Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:,:) array to be written to disk character(len=*), intent(in) :: filename filename logical, intent(in) :: overwrite overwrite flag type(toml_table), intent(inout), optional :: dict dictionary of metadata private subroutine write_3d_r8_raw (array, filename, overwrite) write 3D array of float64s to disk as raw binary data Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:,:) array to write to disk character(len=*), intent(in) :: filename filename to save array as logical, intent(in) :: overwrite overwrite flag public subroutine write_data (array, filename, state, dict, overwrite) routine automatically selects which way to write out results based upon file extension Arguments Type Intent Optional Attributes Name real(kind=sp), intent(in) :: array (:,:,:) array to write out character(len=*), intent(in) :: filename filename to save array as type( settings_t ), intent(in) :: state simulation state type(toml_table), intent(inout), optional :: dict dictionary of metadata logical, intent(in), optional :: overwrite overwrite flag public subroutine write_detected_photons (dects) Arguments Type Intent Optional Attributes Name type( dect_array ), intent(in) :: dects (:) private subroutine write_hdr (u, sizes, type) write out header information for .nrrd file format Arguments Type Intent Optional Attributes Name integer, intent(in) :: u file handle integer, intent(in) :: sizes (:) dimensions of data character(len=*), intent(in) :: type data dtype","tags":"","loc":"module/writer_mod.html"},{"title":"kernels – signedMCRT","text":"Contains the main program and scattering loop. Calls all other routine to setup, run and break down the simulation. Contents Subroutines display_settings finalise pathlength_scatter setup test_kernel weight_scatter Subroutines private subroutine display_settings (state, input_file, packet, kernel_type) Displays the settings used in the current simulation run Arguments Type Intent Optional Attributes Name type( settings_t ), intent(in) :: state Simulation state character(len=*), intent(in) :: input_file Input filenname type( photon ), intent(in) :: packet Photon packet character(len=*), intent(in) :: kernel_type Kernel type to run private subroutine finalise (dict, dects, nscatt, start, history) Routine writes out simulation data, deallocates arrays and prints total runtime Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: dict Dictionary of metadata type( dect_array ), intent(in) :: dects (:) Detector array real(kind=wp), intent(in) :: nscatt Total number of scattered photon packets real(kind=wp), intent(in) :: start Start time of simulation. Used to calculate total runtime. type( history_stack_t ), intent(in) :: history Photon histyor object public subroutine pathlength_scatter (input_file) Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: input_file private subroutine setup (input_file, tev, dects, array, packet, spectrum, dict, distances, image, nscatt, start) setup simulation by reading in setting file, and setup variables to be used. Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: input_file Filename for toml settings to be used type(tevipc), intent(out) :: tev handle for communicating with TEV type( dect_array ), intent(out), allocatable :: dects (:) array of photon detectors type( sdf ), intent(out), allocatable :: array (:) array of SDF objects that create the geometry type( photon ), intent(out) :: packet photon that is to be simulated type( spectrum_t ), intent(out) :: spectrum type(toml_table), intent(out) :: dict toml table of meta-data to be written to output files. real(kind=wp), intent(out), allocatable :: distances (:) real(kind=wp), intent(out), allocatable :: image (:,:,:) real(kind=wp), intent(out) :: nscatt real(kind=wp), intent(out) :: start public subroutine test_kernel (input_file, end_early) Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: input_file logical, intent(in) :: end_early public subroutine weight_scatter (input_file) Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: input_file","tags":"","loc":"module/kernels.html"},{"title":"geometry – signedMCRT","text":"Defines a set of functions for intersecting a ray and a surface. Circle Plane Cone Cylinder Ellipse Sphere Uses vector_class constants Contents Functions intersectCircle intersectCone intersectCylinder intersectEllipse intersectPlane intersectSphere solveQuadratic Functions public function intersectCircle (n, p0, radius, l0, l, t) ref Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: n Normal to the circle type( vector ), intent(in) :: p0 a centre of the circle real(kind=wp), intent(in) :: radius Radius of the circle type( vector ), intent(in) :: l0 origin of the ray type( vector ), intent(in) :: l direction vector of the ray real(kind=wp), intent(inout) :: t Distance from l0 to the intersection point Return Value logical public function intersectCone (orig, dir, t, centre, radius, height) calculates where a line, with origin:orig and direction:dir hits a cone, radius:radius and height:height with centre:centre.\ncentre is the point under the apex at the cone's base.\nreturns true if intersection exists\nreturns t, the paramertised parameter of the line equation\nadapted from scratchapixel and pbrt\nneed to check z height after moving ray\nif not this is an infinte cone\ncone lies height ways along z-axis Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: orig origin of the ray type( vector ), intent(in) :: dir Direction vector of the ray real(kind=wp), intent(out) :: t distance from orig to the intersection point type( vector ), intent(in) :: centre Centre of the cone real(kind=wp), intent(in) :: radius Radius of the cones base real(kind=wp), intent(in) :: height Height of the cone Return Value logical public function intersectCylinder (orig, dir, t, centre, radius) calculates where a line, with origin:orig and direction:dir hits a cylinder, centre:centre and radius:radius\nThis solves for an infinitely long cylinder centered on the z axis with radius radius\nreturns true if intersection exists\nreturns t, the paramertised parameter of the line equation\nadapted from scratchapixel\nneed to check z height after moving ray\nif not this is an infinite cylinder Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: orig origin of the ray type( vector ), intent(in) :: dir Direction vector of the ray real(kind=wp), intent(out) :: t distance from orig to the intersection point type( vector ), intent(in) :: centre Centre of the cylinder real(kind=wp), intent(in) :: radius radius of the cylinder Return Value logical public function intersectEllipse (orig, dir, t, centre, semia, semib) calculates where a line, with origin:orig and direction:dir hits a ellipse, centre:centre and axii:semia, semib\nreturns true if intersection exists\nreturns t, the paramertised parameter of the line equation\nadapted from scratchapixel and pbrt\nneed to check z height after moving ray\nif not this is an infinte ellipse-cylinder\nellipse lies length ways along z-axis\nsemia and semib are the semimajor axis which are the half width and height. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: orig origin of the ray type( vector ), intent(in) :: dir Direction vector of the ray real(kind=wp), intent(out) :: t distance from orig to the intersection point type( vector ), intent(in) :: centre Centre of the ellipse real(kind=wp), intent(in) :: semia Half width of the ellipse real(kind=wp), intent(in) :: semib Half height of the ellipse Return Value logical public function intersectPlane (n, p0, l0, l, t) ref Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: n Normal to the plane type( vector ), intent(in) :: p0 a point on the plane type( vector ), intent(in) :: l0 origin of the ray type( vector ), intent(in) :: l direction vector of the ray real(kind=wp), intent(inout) :: t Distance from l0 to the intersection point Return Value logical public function intersectSphere (orig, dir, t, centre, radius) calculates where a line, with origin:orig and direction:dir hits a sphere, centre:centre and radius:radius\nreturns true if intersection exists\nreturns t, the paramertised parameter of the line equation\nadapted from scratchapixel Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: orig Origin of the ray type( vector ), intent(in) :: dir Direction vector of the ray real(kind=wp), intent(out) :: t Distance from orig to the intersection point type( vector ), intent(in) :: centre Centre of the sphere real(kind=wp), intent(in) :: radius Radius of the sphere Return Value logical private function solveQuadratic (a, b, c, x0, x1) solves quadratic equation given coeffs a, b, and c\nreturns true if real solution\nreturns x0 and x1\nadapted from scratchapixel Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a real(kind=wp), intent(in) :: b real(kind=wp), intent(in) :: c real(kind=wp), intent(out) :: x0 real(kind=wp), intent(out) :: x1 Return Value logical","tags":"","loc":"module/geometry.html"},{"title":"random – signedMCRT","text":"module provides an interface to call random_numbers and various other random distributions======= !!This module defines a set of functions that return random numbers in different distributions. !!- ran2. Returns a single float uniformly in the range [0, 1) !!- ranu. Return a single float uniformly in the range [a, b) !!- randint. Returns a single integer uniformly in the range [a, b) !!- rang. Returns a single float from a Gaussian distribution with mean avg and std sigma . !!- init_rng. Seeds the internal random number generator with a reproducible seed. Uses vector_class constants Contents Derived Types seq Functions next ran2 randint ranu Subroutines init_rng rang Derived Types type, public :: seq Sequence type for quasi-monte carlo Components Type Visibility Attributes Name Initial integer, public :: base Base from which to calculate radical inverse from. integer, public :: index Current index to get value for. Type-Bound Procedures procedure\n , public\n, :: next Function Functions private function next (this) result(res) Arguments Type Intent Optional Attributes Name class( seq ) :: this Return Value real(kind=wp) public function ran2 () result(res) wrapper for call random number Arguments None Return Value real(kind=wp) public function randint (a, b) sample a random integer between [a, b] Arguments Type Intent Optional Attributes Name integer, intent(in) :: a lower bound integer, intent(in) :: b higher bound Return Value integer public function ranu (a, b) result(res) uniformly sample in range[a, b) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a lower bound real(kind=wp), intent(in) :: b upper bound Return Value real(kind=wp) Subroutines public subroutine init_rng (input_seed, fwd) initiate RNG state with reproducible state Arguments Type Intent Optional Attributes Name integer, intent(in), optional :: input_seed (:) input seed logical, intent(in), optional :: fwd boolean that if True runs the generator for 100 steps before returning public subroutine rang (x, y, avg, sigma) sample a 2D Guassian distribution Arguments Type Intent Optional Attributes Name real(kind=wp), intent(out) :: x first value to return real(kind=wp), intent(out) :: y 2nd value to return real(kind=wp), intent(in) :: avg mean of the gaussian to sample from real(kind=wp), intent(in) :: sigma of the guassian to sample from.","tags":"","loc":"module/random.html"},{"title":"iarray – signedMCRT","text":"The iarray module contains the variables that record the fluence. These are 3D arrays, with roughly the same dimensions as the cart_grid type.\nJmean is the local fluence. JmeanGLOBAL is the global fluence grid. The global version is the one that is written to disk at the simulations end. Uses constants Contents Variables absorb absorbGLOBAL jmean jmeanGLOBAL phasor phasorGLOBAL Variables Type Visibility Attributes Name Initial real(kind=sp), public, allocatable :: absorb (:,:,:) absorption data array real(kind=sp), public, allocatable :: absorbGLOBAL (:,:,:) absorption data array real(kind=sp), public, allocatable :: jmean (:,:,:) fluence data array real(kind=sp), public, allocatable :: jmeanGLOBAL (:,:,:) fluence data array complex(kind=sp), public, allocatable :: phasor (:,:,:) phase data array complex(kind=sp), public, allocatable :: phasorGLOBAL (:,:,:) phase data array","tags":"","loc":"module/iarray.html"},{"title":"constants – signedMCRT","text":"This module contains mathematical constants and strings that contain the various directories used by the program.\n Math constants:\n - PI\n - 2 PI\n - wp (working precision of the whole program). Default is double precision (64bit floats)\n Directories:\n - homedir. Root directory of this code\n - fileplace. data folder directory\n - resdir. holds the path to the directory that holds the parameter and other associated input files Uses iso_fortran_env Contents Variables CHANCE PI THRESHOLD TWOPI dp fileplace homedir resdir sp wp Variables Type Visibility Attributes Name Initial real(kind=wp), public, parameter :: CHANCE = 0.1_wp Proportion of packet that survive roulette real(kind=wp), public, parameter :: PI = 4._wp*atan(1._wp) real(kind=wp), public, parameter :: THRESHOLD = 0.01_wp Weight threshold for roulette real(kind=wp), public, parameter :: TWOPI = 2._wp*PI integer, public, parameter :: dp = real64 double precision variable. character(len=255), public :: fileplace place where output files are saved character(len=255), public :: homedir root directory character(len=255), public :: resdir directory to input files integer, public, parameter :: sp = real32 single precision variable. integer, public, parameter :: wp = real64 current working precision","tags":"","loc":"module/constants.html"},{"title":"parse_mod – signedMCRT","text":"Module contains all routines related to parsing the input toml config files.\nSee config for details of toml input file. Uses vector_class tomlf constants tomlf_error Contents Functions get_vector Subroutines handle_annulus_dect handle_camera handle_circle_dect parse_detectors parse_geometry parse_grid parse_output parse_params parse_simulation parse_source parse_spectrum Functions private function get_vector (child, key, error, context, default) Vector helper function for parsing toml Arguments Type Intent Optional Attributes Name type(toml_table), intent(in), pointer :: child Input Toml entry to read character(len=*), intent(in) :: key Key to read type(toml_error), intent(out), allocatable :: error type(toml_context), intent(in) :: context Context handle for error reporting type( vector ), intent(in), optional :: default Default value to assign Return Value type( vector ) Subroutines private subroutine handle_annulus_dect (child, dects, counts, context, error) Read in Annulus_detector settings and initalise variable Arguments Type Intent Optional Attributes Name type(toml_table), intent(in), pointer :: child type( annulus_dect ), intent(inout) :: dects (:) integer, intent(inout) :: counts type(toml_context), intent(in) :: context type(toml_error), intent(out), allocatable :: error private subroutine handle_camera (child, dects, counts, context, error) Read in Camera settings and initalise variable Arguments Type Intent Optional Attributes Name type(toml_table), intent(in), pointer :: child type( camera ), intent(inout) :: dects (:) integer, intent(inout) :: counts type(toml_context), intent(in) :: context Context handle for error reporting. type(toml_error), intent(out), allocatable :: error private subroutine handle_circle_dect (child, dects, counts, context, error) Read in Circle_detector settings and initalise variable Arguments Type Intent Optional Attributes Name type(toml_table), intent(in), pointer :: child type( circle_dect ), intent(inout) :: dects (:) integer, intent(inout) :: counts type(toml_context), intent(in) :: context type(toml_error), intent(out), allocatable :: error private subroutine parse_detectors (table, dects, context, error) parse the detectors Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type( dect_array ), allocatable :: dects (:) Detector array to be filled. type(toml_context), intent(in) :: context Context handle for error reporting. type(toml_error), intent(out), allocatable :: error private subroutine parse_geometry (table, dict, error) parse geometry information Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type(toml_table), intent(inout) :: dict Dictonary used to store metadata type(toml_error), intent(out), allocatable :: error private subroutine parse_grid (table, dict, error) parse grid input data Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type(toml_table), intent(inout) :: dict Dictonary used to store metadata type(toml_error), intent(out), allocatable :: error private subroutine parse_output (table, error) parse output file information Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type(toml_error), intent(out), allocatable :: error public subroutine parse_params (filename, packet, dects, spectrum, dict, error) entry point for parsing toml file Arguments Type Intent Optional Attributes Name character(len=*), intent(in) :: filename filename of input toml file type( photon ), intent(out) :: packet some input options set up data in the photon class type( dect_array ), intent(out), allocatable :: dects (:) detector array which is setup during parsing type( spectrum_t ), intent(out) :: spectrum spectrum type which is set up during parsing type(toml_table), intent(inout) :: dict dictionary that stores potential metadata to be saved with simulation output type(toml_error), intent(out), allocatable :: error Last error raised during parsing. Unallocated if no error raised. Need to handle this on return from parse_params. private subroutine parse_simulation (table, error) parse simulation information Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type(toml_error), intent(out), allocatable :: error private subroutine parse_source (table, packet, dict, spectrum, context, error) Parse sources\nany updates here MUST be reflected in docs/config.md Arguments Type Intent Optional Attributes Name type(toml_table), intent(inout) :: table Input Toml table type( photon ), intent(out) :: packet Photon packet. Used to store information to save computation type(toml_table), intent(inout) :: dict Dictonary used to store metadata type( spectrum_t ), intent(out) :: spectrum Spectrum type. type(toml_context) :: context Context handle for error reporting type(toml_error), intent(out), allocatable :: error Error message private subroutine parse_spectrum (table, spectrum, dict, context, error) Parse spectrums to be used Arguments Type Intent Optional Attributes Name type(toml_table), pointer :: table type( spectrum_t ), intent(out) :: spectrum type(toml_table), intent(inout) :: dict type(toml_context) :: context type(toml_error), intent(out), allocatable :: error","tags":"","loc":"module/parse_mod.html"},{"title":"vec4_class – signedMCRT","text":"Vector4 class module. Defines a vector4 type (x, y, z, p) and associated operations on vectors and other types. Uses constants Contents Interfaces sin vec4 Derived Types vec4 Functions init_vec4_vector_real length magnitude_fn scal_add_vec scal_minus_vec scal_mult_vec sin_vec vec_add_scal vec_add_vec vec_div_scal_int vec_div_scal_r4 vec_div_scal_r8 vec_dot_vec vec_minus_scal vec_minus_vec vec_mult_scal vec_mult_vec Interfaces public interface sin Vec4 overload of the sin intrinsic private pure elemental function sin_vec (p) Sine of a vec4, elementwise Arguments Type Intent Optional Attributes Name type( vec4 ), intent(in) :: p Input vec4 Return Value type( vec4 ) public interface vec4 Initalise a vec4 from a vec3 and a scalar private function init_vec4_vector_real (vec, val) result(out) Initalise vec4 from a vec3 and Scalar\ne.g vec4 = [vec3%x, vec3%y, vec3%z, scalar] Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: vec Input vec3 real(kind=wp), intent(in) :: val Input Scalar Return Value type( vec4 ) Derived Types type, public :: vec4 not fully implmented vec4 class Components Type Visibility Attributes Name Initial real(kind=wp), public :: p vec4 components real(kind=wp), public :: x vec4 components real(kind=wp), public :: y vec4 components real(kind=wp), public :: z vec4 components Constructor Initalise a vec4 from a vec3 and a scalar private\n\n \n function init_vec4_vector_real (vec, val) Initalise vec4 from a vec3 and Scalar\ne.g vec4 = [vec3%x, vec3%y, vec3%z, scalar] Type-Bound Procedures procedure\n , public\n, :: length Function procedure\n , public\n, :: magnitude => magnitude_fn Function generic,\n public\n, :: operator(*) => vec_mult_vec , vec_mult_scal , scal_mult_vec Overloaded Mulitiplication operator generic,\n public\n, :: operator(+) => vec_add_vec , vec_add_scal , scal_add_vec Overloaded Addition operator generic,\n public\n, :: operator(-) => vec_minus_vec , vec_minus_scal , scal_minus_vec Overloaded Subtraction operator generic,\n public\n, :: operator(.dot.) => vec_dot_vec .dot. operator generic,\n public\n, :: operator(/) => vec_div_scal_r4 , vec_div_scal_r8 , vec_div_scal_int Overloaded Division operator procedure\n , private\n, pass(b) :: scal_add_vec Function procedure\n , private\n, pass(b) :: scal_minus_vec Function procedure\n , private\n, pass(b) :: scal_mult_vec Function procedure\n , private\n, pass(a) :: vec_add_scal Function procedure\n , private\n, pass(a) :: vec_add_vec Function procedure\n , private\n, pass(a) :: vec_div_scal_int Function procedure\n , private\n, pass(a) :: vec_div_scal_r4 Function procedure\n , private\n, pass(a) :: vec_div_scal_r8 Function procedure\n , private\n, pass(a) :: vec_dot_vec Function procedure\n , private\n, pass(a) :: vec_minus_scal Function procedure\n , private\n, pass(a) :: vec_minus_vec Function procedure\n , private\n, pass(a) :: vec_mult_scal Function procedure\n , private\n, pass(a) :: vec_mult_vec Function Functions private function init_vec4_vector_real (vec, val) result(out) Initalise vec4 from a vec3 and Scalar\ne.g vec4 = [vec3%x, vec3%y, vec3%z, scalar] Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: vec Input vec3 real(kind=wp), intent(in) :: val Input Scalar Return Value type( vec4 ) private pure elemental function length (this) Returns the length of a vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: this Return Value real(kind=wp) private pure elemental function magnitude_fn (this) Returns the magnitude of a vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: this Return Value type( vec4 ) private pure elemental function scal_add_vec (a, b) Elementwise scalar + vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to add class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) private pure elemental function scal_minus_vec (a, b) Elementwise Scalar - vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to subtract class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) private pure elemental function scal_mult_vec (a, b) Elementwise Scalar * vec4 Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: a Scalar to multiply by class( vec4 ), intent(in) :: b Input vec4 Return Value type( vec4 ) private pure elemental function sin_vec (p) Sine of a vec4, elementwise Arguments Type Intent Optional Attributes Name type( vec4 ), intent(in) :: p Input vec4 Return Value type( vec4 ) private pure elemental function vec_add_scal (a, b) Elementwise vec4 + scalar Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to add Return Value type( vec4 ) private pure elemental function vec_add_vec (a, b) Elementwise vec4 + vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to add Return Value type( vec4 ) private pure elemental function vec_div_scal_int (a, b) Elementwise vec4 / Scalar. Scalar is an integer Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 integer, intent(in) :: b Scalar to divide by Return Value type( vec4 ) private pure elemental function vec_div_scal_r4 (a, b) Elementwise vec4 / Scalar. Scalar is 32-bit float Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=sp), intent(in) :: b Scalar to divide by Return Value type( vec4 ) private pure elemental function vec_div_scal_r8 (a, b) Elementwise vec4 / Scalar. Scalar is 32-bit float Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=dp), intent(in) :: b Scalar to divide by Return Value type( vec4 ) private pure elemental function vec_dot_vec (a, b) result(dot) dot product between two vec4s Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to dot with Return Value real(kind=wp) private pure elemental function vec_minus_scal (a, b) Elementwise vec4 - scalar Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to subtract Return Value type( vec4 ) private pure elemental function vec_minus_vec (a, b) Elementwise vec4 - vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to subtract Return Value type( vec4 ) private pure elemental function vec_mult_scal (a, b) Elementwise vec4 * Scalar Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 real(kind=wp), intent(in) :: b Scalar to multiply by Return Value type( vec4 ) private pure elemental function vec_mult_vec (a, b) Elementwise vec4 * vec4 Arguments Type Intent Optional Attributes Name class( vec4 ), intent(in) :: a Input vec4 type( vec4 ), intent(in) :: b vec4 to multiply by Return Value type( vec4 )","tags":"","loc":"module/vec4_class.html"},{"title":"gridMod – signedMCRT","text":"This module defines the cartesian grid type (cart_grid) and associated routines. The cart_grid type contains information related to the grid used to record the fluence. This includes the number of voxels in each cardinal direction (nxg, nyg, nzg), the half size of the grid in each direction (xmax, ymax, zmax), and the locations of the voxels walls in each direction (xface, yface, zface).\nThe type-bound function get_voxel takes a position (vector) and returns the voxel the position falls in. Init_grid initialises a cart_grid instance. Grid class Uses constants Contents Interfaces cart_grid Derived Types cart_grid Functions get_voxel init_grid Interfaces public interface cart_grid public function init_grid (nxg, nyg, nzg, xmax, ymax, zmax) setup grid Arguments Type Intent Optional Attributes Name integer, intent(in) :: nxg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nyg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nzg number of voxels in each cardinal direction for fluence grid real(kind=wp), intent(in) :: xmax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: ymax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: zmax half size of each dimension in fluence grid. Return Value type( cart_grid ) Derived Types type, public :: cart_grid Components Type Visibility Attributes Name Initial real(kind=wp), public :: delta Delta is the round off for near voxel cell walls integer, public :: nxg number of voxels in each cardinal direction for fluence grid integer, public :: nyg number of voxels in each cardinal direction for fluence grid integer, public :: nzg number of voxels in each cardinal direction for fluence grid real(kind=wp), public, allocatable :: xface (:) position of each cell wall in fluence grid real(kind=wp), public :: xmax half size of each dimension in fluence grid. real(kind=wp), public, allocatable :: yface (:) position of each cell wall in fluence grid real(kind=wp), public :: ymax half size of each dimension in fluence grid. real(kind=wp), public, allocatable :: zface (:) position of each cell wall in fluence grid real(kind=wp), public :: zmax half size of each dimension in fluence grid. Constructor public\n\n \n function init_grid (nxg, nyg, nzg, xmax, ymax, zmax) setup grid Type-Bound Procedures procedure\n , public\n, :: get_voxel Function Functions private function get_voxel (this, pos) result(res) get current voxel the photon packet is in Arguments Type Intent Optional Attributes Name class( cart_grid ) :: this grid class type( vector ), intent(in) :: pos current vector position of photon packet Return Value integer, (3) public function init_grid (nxg, nyg, nzg, xmax, ymax, zmax) setup grid Arguments Type Intent Optional Attributes Name integer, intent(in) :: nxg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nyg number of voxels in each cardinal direction for fluence grid integer, intent(in) :: nzg number of voxels in each cardinal direction for fluence grid real(kind=wp), intent(in) :: xmax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: ymax half size of each dimension in fluence grid. real(kind=wp), intent(in) :: zmax half size of each dimension in fluence grid. Return Value type( cart_grid )","tags":"","loc":"module/gridmod.html"},{"title":"inttau2 – signedMCRT","text":"inttau2 is the heart of the MCRT simulation. It moves the photons though the simulated media.\ntauint2 is the only public function here and is the main function that moves the photon.\nChanges should only be made here if bugs are discovered or new methods of tracking photons (i.e phase tracking) or moving photons (i.e new geometry method) is needed. Uses constants Contents Functions find wall_dist Subroutines tauint2 update_grids update_pos update_voxels Functions private function find (val, a) searches for bracketing indices for a value value in an array a Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val value to find in array real(kind=wp), intent(in) :: a (:) array to find val in Return Value integer private function wall_dist (grid, celli, cellj, cellk, pos, dir, ldir) result(res) funtion that returns distant to nearest wall and which wall that is (x, y, or z) Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid integer, intent(inout) :: celli integer, intent(inout) :: cellj integer, intent(inout) :: cellk type( vector ), intent(in) :: pos type( vector ), intent(in) :: dir logical, intent(inout) :: ldir (:) Return Value real(kind=wp) Subroutines public subroutine tauint2 (grid, packet, sdfs_array) optical depth integration subroutine\nMoves photons to interaction location\nCalculated is any reflection or refraction happens whilst moving Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid type( photon ), intent(inout) :: packet type( sdf ), intent(in) :: sdfs_array (:) private subroutine update_grids (grid, pos, dir, d_sdf, packet, mua) record fluence using path length estimators. Uses voxel grid Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid grid stores voxel grid information (voxel walls and etc) type( vector ), intent(inout) :: pos pos is current position with origin in centre of medium (0,0,0) type( vector ), intent(in) :: dir dir is the current direction (0,0,1) is up real(kind=wp), intent(in) :: d_sdf d_sdf is the distance to travel in voxel grid type( photon ), intent(inout) :: packet packet stores the photon related variables real(kind=wp), intent(in), optional :: mua absoprtion coefficent private subroutine update_pos (grid, pos, celli, cellj, cellk, dcell, wall_flag, dir, ldir, delta) routine that updates positions of photon and calls Fresnel routines if photon leaves current voxel Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid type( vector ), intent(inout) :: pos integer, intent(inout) :: celli integer, intent(inout) :: cellj integer, intent(inout) :: cellk real(kind=wp), intent(in) :: dcell logical, intent(in) :: wall_flag type( vector ), intent(in) :: dir logical, intent(in) :: ldir (:) real(kind=wp), intent(in) :: delta public subroutine update_voxels (grid, pos, celli, cellj, cellk) updates the current voxel based upon position Arguments Type Intent Optional Attributes Name type( cart_grid ), intent(in) :: grid grid type( vector ), intent(in) :: pos current photon packet position integer, intent(inout) :: celli position of photon packet in grid integer, intent(inout) :: cellj position of photon packet in grid integer, intent(inout) :: cellk position of photon packet in grid","tags":"","loc":"module/inttau2.html"},{"title":"opticalProperties – signedMCRT","text":"module implments the optical property abstract type and the types that inheirt from it\nabstract optical property type Uses piecewiseMod constants Contents Interfaces mono opticalProp_t spectral Abstract Interfaces updateInterface Derived Types mono opticalProp_base opticalProp_t spectral Functions init_mono init_spectral opticaProp_new Subroutines opticalProp_t_assign updateMono updateSpectral update_opticalProp_t Interfaces public interface mono private function init_mono (mus, mua, hgg, n) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: mus real(kind=wp), intent(in) :: mua real(kind=wp), intent(in) :: hgg real(kind=wp), intent(in) :: n Return Value type( mono ) public interface opticalProp_t private function opticaProp_new (rhs) result(lhs) Arguments Type Intent Optional Attributes Name class( opticalProp_base ), intent(in) :: rhs Return Value type( opticalProp_t ) public interface spectral private function init_spectral (mus, mua, hgg, n, flux) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), allocatable :: mus (:,:) real(kind=wp), intent(in), allocatable :: mua (:,:) real(kind=wp), intent(in), allocatable :: hgg (:,:) real(kind=wp), intent(in), allocatable :: n (:,:) real(kind=wp), intent(in), allocatable :: flux (:,:) Return Value type( spectral ) Abstract Interfaces abstract interface public subroutine updateInterface(this, wavelength) Arguments Type Intent Optional Attributes Name class( opticalProp_base ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength Derived Types type, public, extends( opticalProp_base ) :: mono Components Type Visibility Attributes Name Initial real(kind=wp), public :: albedo real(kind=wp), public :: g2 g factor squared real(kind=wp), public :: hgg g factor real(kind=wp), public :: kappa real(kind=wp), public :: mua absoprtion coeff. real(kind=wp), public :: mus scattering coeff. real(kind=wp), public :: n refractive index Constructor private\n\n \n function init_mono (mus, mua, hgg, n) Type-Bound Procedures procedure\n , public\n, :: update => updateMono Subroutine type, public :: opticalProp_base Components Type Visibility Attributes Name Initial real(kind=wp), public :: albedo real(kind=wp), public :: g2 g factor squared real(kind=wp), public :: hgg g factor real(kind=wp), public :: kappa real(kind=wp), public :: mua absoprtion coeff. real(kind=wp), public :: mus scattering coeff. real(kind=wp), public :: n refractive index Type-Bound Procedures procedure\n(updateInterface) , public\n :: update type, public, extends( opticalProp_base ) :: opticalProp_t Components Type Visibility Attributes Name Initial real(kind=wp), public :: albedo real(kind=wp), public :: g2 g factor squared real(kind=wp), public :: hgg g factor real(kind=wp), public :: kappa real(kind=wp), public :: mua absoprtion coeff. real(kind=wp), public :: mus scattering coeff. real(kind=wp), public :: n refractive index class( opticalProp_base ), public, allocatable :: value Constructor private\n\n \n function opticaProp_new (rhs) Type-Bound Procedures generic,\n public\n, :: assignment(=) => opticalProp_t_assign procedure\n , private\n :: opticalProp_t_assign Subroutine procedure\n , public\n, :: update => update_opticalProp_t Subroutine type, public, extends( opticalProp_base ) :: spectral Components Type Visibility Attributes Name Initial real(kind=wp), public :: albedo type( piecewise1D ), private :: flux real(kind=wp), public :: g2 g factor squared real(kind=wp), public :: hgg g factor type( piecewise1D ), private :: hgg_a real(kind=wp), public :: kappa real(kind=wp), public :: mua absoprtion coeff. type( piecewise1D ), private :: mua_a real(kind=wp), public :: mus scattering coeff. type( piecewise1D ), private :: mus_a real(kind=wp), public :: n refractive index type( piecewise1D ), private :: n_a Constructor private\n\n \n function init_spectral (mus, mua, hgg, n, flux) Type-Bound Procedures procedure\n , public\n, :: update => updateSpectral Subroutine Functions private function init_mono (mus, mua, hgg, n) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: mus real(kind=wp), intent(in) :: mua real(kind=wp), intent(in) :: hgg real(kind=wp), intent(in) :: n Return Value type( mono ) private function init_spectral (mus, mua, hgg, n, flux) result(res) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), allocatable :: mus (:,:) real(kind=wp), intent(in), allocatable :: mua (:,:) real(kind=wp), intent(in), allocatable :: hgg (:,:) real(kind=wp), intent(in), allocatable :: n (:,:) real(kind=wp), intent(in), allocatable :: flux (:,:) Return Value type( spectral ) private function opticaProp_new (rhs) result(lhs) Arguments Type Intent Optional Attributes Name class( opticalProp_base ), intent(in) :: rhs Return Value type( opticalProp_t ) Subroutines private subroutine opticalProp_t_assign (lhs, rhs) Arguments Type Intent Optional Attributes Name class( opticalProp_t ), intent(inout) :: lhs class( opticalProp_base ), intent(in) :: rhs private subroutine updateMono (this, wavelength) Arguments Type Intent Optional Attributes Name class( mono ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength private subroutine updateSpectral (this, wavelength) Arguments Type Intent Optional Attributes Name class( spectral ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength private subroutine update_opticalProp_t (this, wavelength) Arguments Type Intent Optional Attributes Name class( opticalProp_t ), intent(inout) :: this real(kind=wp), intent(out) :: wavelength","tags":"","loc":"module/opticalproperties.html"},{"title":"piecewiseMod – signedMCRT","text":"This file contains the piecewise abstract type, for sampling from constants, 1D or 2D arrays. Inspired by PBRT piecewise class.\nCurrently, the following public types are defined: Constant. Used in the case where there is only one value. 1D. Used in the case where there is a spectrum 2D. Used in the case where SLM or other image based source types are needed. The piecewise type ensures that there is a method (sample) that can be called on all inherited types, e.g\ncall 2Dimage%p%sample(x, y)\nwill return a position (x,y) from where to release a photon.\nThis class can be used to have multi-spectral or single valued wavelength, or used as a 2D image input source i.e SLMs.\nNOTE: optical properties are not currently adjusted on wavelength change. Uses iso_fortran_env constants Contents Interfaces piecewise1D piecewise2D Abstract Interfaces sampleInterface Derived Types constant piecewise piecewise1D piecewise2D spectrum_t Functions init_piecewise1D init_piecewise2D nextpwr2 pack_bits Subroutines decode getValue sample1D sample2D search_1D search_2D Interfaces public interface piecewise1D public function init_piecewise1D (array) result(res) initalise the piecewise1D type with an array size (n, 2). Calculates the CDF of this array.\nInput array Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:) Return Value type( piecewise1D ) public interface piecewise2D public function init_piecewise2D (cell_width, cell_height, image) Initalise the piecewise2D type with a given cell_width, cell_height and input image Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: cell_width Input cell width real(kind=wp), intent(in) :: cell_height Input cell height real(kind=wp), intent(in) :: image (:,:) Input image Return Value type( piecewise2D ) Abstract Interfaces abstract interface public subroutine sampleInterface(this, x, y, value) Arguments Type Intent Optional Attributes Name class( piecewise ), intent(in) :: this real(kind=wp), intent(out) :: x real(kind=wp), intent(out) :: y real(kind=wp), intent(in), optional :: value Derived Types type, public, extends( piecewise ) :: constant Constant piecewise type. i.e a piecewise function that does not change value Components Type Visibility Attributes Name Initial real(kind=wp), public :: value The constant value Type-Bound Procedures procedure\n , public\n, :: sample => getValue Subroutine Sampling routine type, public :: piecewise Abstract spectrum base type. Type-Bound Procedures procedure\n(sampleInterface) , public\n :: sample Deferred procdure. Used to generate a sample from spectrum or get constant value etc. type, public, extends( piecewise ) :: piecewise1D 1D piecewise type. Used for the spectral type Components Type Visibility Attributes Name Initial real(kind=wp), public, allocatable :: array (:,:) Input array to sample from. Should be size(n, 2). 1st column is x-axis, 2nd column is y-axis real(kind=wp), public, allocatable :: cdf (:) cumulative distribution function (CDF) of array. Constructor public\n\n \n function init_piecewise1D (array) initalise the piecewise1D type with an array size (n, 2). Calculates the CDF of this array.\nInput array Type-Bound Procedures procedure\n , public\n, :: sample => sample1D Subroutine Overloaded sampling function type, public, extends( piecewise ) :: piecewise2D 2D piecewise type. Used for images Components Type Visibility Attributes Name Initial real(kind=wp), public, allocatable :: cdf (:) cumulative distribution function (CDF) of array. real(kind=wp), public :: cell_height Height of each cell real(kind=wp), public :: cell_width Width of each cell integer, private :: xoffset Offsets integer, private :: yoffset Offsets Constructor public\n\n \n function init_piecewise2D (cell_width, cell_height, image) Initalise the piecewise2D type with a given cell_width, cell_height and input image Type-Bound Procedures procedure\n , public\n, :: sample => sample2D Subroutine Overloaded sampling function type, public :: spectrum_t Spectrum_t type. Used as a container type Components Type Visibility Attributes Name Initial class( piecewise ), public, pointer :: p => null() Functions public function init_piecewise1D (array) result(res) initalise the piecewise1D type with an array size (n, 2). Calculates the CDF of this array.\nInput array Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:) Return Value type( piecewise1D ) public function init_piecewise2D (cell_width, cell_height, image) Initalise the piecewise2D type with a given cell_width, cell_height and input image Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: cell_width Input cell width real(kind=wp), intent(in) :: cell_height Input cell height real(kind=wp), intent(in) :: image (:,:) Input image Return Value type( piecewise2D ) public function nextpwr2 (v) result(res) Get the next power of 2. i.e given 5 will return 8 (4^2)\nonly works on 32bit ints ref Arguments Type Intent Optional Attributes Name integer, intent(in) :: v Return Value integer public function pack_bits (z) result(x) Reverse the split function. I.e go from 0a0b0c0d to abcd\nAdapted from archer2 cpp course Arguments Type Intent Optional Attributes Name integer(kind=int64), intent(in) :: z Input interleaved integer Return Value integer(kind=int64) Subroutines public subroutine decode (z, x, y) Compute the 2 indices from a Morton index\nAdapted from archer2 cpp course Arguments Type Intent Optional Attributes Name integer(kind=int64), intent(in) :: z Morton Index integer(kind=int32), intent(out) :: x The computed indices integer(kind=int32), intent(out) :: y The computed indices public subroutine getValue (this, x, y, value) The constant version of sample Arguments Type Intent Optional Attributes Name class( constant ), intent(in) :: this real(kind=wp), intent(out) :: x Output value real(kind=wp), intent(out) :: y Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D real(kind=wp), intent(in), optional :: value Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D public subroutine sample1D (this, x, y, value) Randomly sample from 1D array Arguments Type Intent Optional Attributes Name class( piecewise1D ), intent(in) :: this real(kind=wp), intent(out) :: x Return value real(kind=wp), intent(out) :: y Not used, but here so we can have same interface as 2D sample routine. real(kind=wp), intent(in), optional :: value Optional x value. If not present we generate a random one in the range [0., 1.] public subroutine sample2D (this, x, y, value) Arguments Type Intent Optional Attributes Name class( piecewise2D ), intent(in) :: this real(kind=wp), intent(out) :: x real(kind=wp), intent(out) :: y real(kind=wp), intent(in), optional :: value public subroutine search_1D (array, nlow, value) search by bisection for 1D array Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:) Array to search integer(kind=int64), intent(out) :: nlow index of found value real(kind=wp), intent(in) :: value value to find in 1D array public subroutine search_2D (array, nlow, value) search by bisection for 1D array Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: array (:,:) 2D array to search. Only searches 1st column integer(kind=int64), intent(out) :: nlow Index of found index real(kind=wp), intent(in) :: value Value to find in the array.","tags":"","loc":"module/piecewisemod.html"},{"title":"detectors – signedMCRT","text":"Module contains each detector type which inherits from the base detector class.\ndetectors detect photon packets colliding with the detectors. Uses vector_class detector_mod constants Contents Interfaces annulus_dect camera circle_dect Derived Types annulus_dect camera circle_dect dect_array Functions check_hit_annulus check_hit_camera check_hit_circle init_annulus_dect init_camera init_circle_dect Interfaces public interface annulus_dect private function init_annulus_dect (pos, dir, layer, r1, r2, nbins, maxval, trackHistory) result(out) Initalise Annular detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: r1 Inner radius real(kind=wp), intent(in) :: r2 Outer radius integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( annulus_dect ) public interface camera private function init_camera (p1, p2, p3, layer, nbins, maxval, trackHistory) result(out) Initalise Camera detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: p1 Position of the 1st corner of the detector type( vector ), intent(in) :: p2 Distance from p1 to the 2nd corner type( vector ), intent(in) :: p3 Distance from p1 to the 3rd corner integer, intent(in) :: layer Layer ID integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( camera ) public interface circle_dect private function init_circle_dect (pos, dir, layer, radius, nbins, maxval, trackHistory) result(out) Initalise Circle detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: radius Radius of the detector integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( circle_dect ) Derived Types type, public, extends( detector1D ) :: annulus_dect Annuluar detector Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid Bin width real(kind=wp), public, allocatable :: data (:) Bins type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector integer, public :: nbins Number of bins type( vector ), public :: pos position of the detector real(kind=wp), public :: r1 Inner radius real(kind=wp), public :: r2 Outer radius logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Constructor private\n\n \n function init_annulus_dect (pos, dir, layer, r1, r2, nbins, maxval, trackHistory) Initalise Annular detector Type-Bound Procedures procedure\n , public\n, :: check_hit => check_hit_annulus Function procedure\n , public\n, :: record_hit => record_hit_1D_sub Subroutine type, public, extends( detector2D ) :: camera Rectangular or \"camera\" detector Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid_x Bin width in the x dimension real(kind=wp), public :: bin_wid_y Bin width in the y dimension real(kind=wp), public, allocatable :: data (:,:) Bins type( vector ), public :: dir Surface normal of the detector type( vector ), public :: e1 Edge vector of detector type( vector ), public :: e2 Edge vector of detector real(kind=wp), public :: height Height of the detector integer, public :: layer Layer ID of the detector type( vector ), public :: n Normal of the detector integer, public :: nbinsX Number of bins in x dimension (detector space) integer, public :: nbinsY Number of bins in y dimension (detector space) type( vector ), public :: p2 Vector from pos (1st corner) to the 2nd corner of the detector type( vector ), public :: p3 Vector from pos (1st corner) to the 3rd corner of the detector type( vector ), public :: pos position of the detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. real(kind=wp), public :: width Width of the detector Constructor private\n\n \n function init_camera (p1, p2, p3, layer, nbins, maxval, trackHistory) Initalise Camera detector Type-Bound Procedures procedure\n , public\n, :: check_hit => check_hit_camera Function procedure\n , public\n, :: record_hit => record_hit_2D_sub Subroutine type, public, extends( detector1D ) :: circle_dect Circle detector Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid Bin width real(kind=wp), public, allocatable :: data (:) Bins type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector integer, public :: nbins Number of bins type( vector ), public :: pos position of the detector real(kind=wp), public :: radius Radius of detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Constructor private\n\n \n function init_circle_dect (pos, dir, layer, radius, nbins, maxval, trackHistory) Initalise Circle detector Type-Bound Procedures procedure\n , public\n, :: check_hit => check_hit_circle Function procedure\n , public\n, :: record_hit => record_hit_1D_sub Subroutine type, public :: dect_array Detector array Components Type Visibility Attributes Name Initial class( detector ), public, pointer :: p => null() Functions private function check_hit_annulus (this, hitpoint) Check if a hitpoint is in the annulus Arguments Type Intent Optional Attributes Name class( annulus_dect ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Hitpoint to check Return Value logical private function check_hit_camera (this, hitpoint) Check if a hitpoint is in the camera detector ref Arguments Type Intent Optional Attributes Name class( camera ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Hitpoint to check Return Value logical private function check_hit_circle (this, hitpoint) Check if a hitpoint is in the circle Arguments Type Intent Optional Attributes Name class( circle_dect ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Hitpoint to check Return Value logical private function init_annulus_dect (pos, dir, layer, r1, r2, nbins, maxval, trackHistory) result(out) Initalise Annular detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: r1 Inner radius real(kind=wp), intent(in) :: r2 Outer radius integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( annulus_dect ) private function init_camera (p1, p2, p3, layer, nbins, maxval, trackHistory) result(out) Initalise Camera detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: p1 Position of the 1st corner of the detector type( vector ), intent(in) :: p2 Distance from p1 to the 2nd corner type( vector ), intent(in) :: p3 Distance from p1 to the 3rd corner integer, intent(in) :: layer Layer ID integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( camera ) private function init_circle_dect (pos, dir, layer, radius, nbins, maxval, trackHistory) result(out) Initalise Circle detector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos Centre of detector type( vector ), intent(in) :: dir Normal of the detector integer, intent(in) :: layer Layer ID real(kind=wp), intent(in) :: radius Radius of the detector integer, intent(in) :: nbins Number of bins in the detector real(kind=wp), intent(in) :: maxval Maximum value to store in bins logical, intent(in) :: trackHistory Boolean on if to store photon's history prior to hitting the detector. Return Value type( circle_dect )","tags":"","loc":"module/detectors.html"},{"title":"detector_mod – signedMCRT","text":"Module contains photon detector abstract class and the derived types the inherit from it\nnot fully implmented Uses vector_class constants Contents Interfaces hit_t Abstract Interfaces checkHitInterface recordHitInterface Derived Types detector detector1D detector2D hit_t Functions hit_init Subroutines record_hit_1D_sub record_hit_2D_sub Interfaces public interface hit_t private function hit_init (val) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val Return Value type( hit_t ) Abstract Interfaces abstract interface public function checkHitInterface(this, hitpoint) Arguments Type Intent Optional Attributes Name class( detector ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Return Value logical abstract interface public subroutine recordHitInterface(this, hitpoint, history) Arguments Type Intent Optional Attributes Name class( detector ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint type( history_stack_t ), intent(inout) :: history Derived Types type, public :: detector abstract detector Components Type Visibility Attributes Name Initial type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector type( vector ), public :: pos position of the detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Type-Bound Procedures procedure\n(checkHitInterface) , public\n :: check_hit procedure\n(recordHitInterface) , public\n :: record_hit type, public, extends( detector ) :: detector1D 1D detector type. Records linear information Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid Bin width real(kind=wp), public, allocatable :: data (:) Bins type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector integer, public :: nbins Number of bins type( vector ), public :: pos position of the detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Type-Bound Procedures procedure\n(checkHitInterface) , public\n :: check_hit procedure\n , public\n, :: record_hit => record_hit_1D_sub Subroutine type, public, extends( detector ) :: detector2D 2D detecctor type. Records spatial information Components Type Visibility Attributes Name Initial real(kind=wp), public :: bin_wid_x Bin width in the x dimension real(kind=wp), public :: bin_wid_y Bin width in the y dimension real(kind=wp), public, allocatable :: data (:,:) Bins type( vector ), public :: dir Surface normal of the detector integer, public :: layer Layer ID of the detector integer, public :: nbinsX Number of bins in x dimension (detector space) integer, public :: nbinsY Number of bins in y dimension (detector space) type( vector ), public :: pos position of the detector logical, public :: trackHistory Boolean, if true store the history of the photon prior to detection. Type-Bound Procedures procedure\n(checkHitInterface) , public\n :: check_hit procedure\n , public\n, :: record_hit => record_hit_2D_sub Subroutine type, public :: hit_t Hit type, which records possible interaction information Components Type Visibility Attributes Name Initial type( vector ), public :: dir Direction the photon came from integer, public :: layer Layer ID of interaction type( vector ), public :: pos Poition of the interaction real(kind=wp), public :: value Value to deposit Constructor private\n\n \n function hit_init (val) Functions private function hit_init (val) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: val Return Value type( hit_t ) Subroutines private subroutine record_hit_1D_sub (this, hitpoint, history) check if a hit is on the detector and record it if so Arguments Type Intent Optional Attributes Name class( detector1D ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Interaction information type( history_stack_t ), intent(inout) :: history Photon packet history private subroutine record_hit_2D_sub (this, hitpoint, history) check if a hit is on the detector and record it if so Arguments Type Intent Optional Attributes Name class( detector2D ), intent(inout) :: this type( hit_t ), intent(in) :: hitpoint Interaction information type( history_stack_t ), intent(inout) :: history Photon packet history","tags":"","loc":"module/detector_mod.html"},{"title":"sdfs – signedMCRT","text":"This module defines the signed distance function (SDF) abstract type and all types that inherit from it.\nThe SDF abstract type defines the optical properties of an SDF (mus, mua, kappa, albedo, hgg, g2,and n), as well as a transform (4x4 matrix), and the layer ID code of the SDF.\nThe SDF abstract type also provides an abstract interface (evaluate) which each inheriting function must implement. This evaluate function is the heart of the SDF implementation.\nEach individual evaluate is the direct implementation of that SDF, e.g. that function defines the mathematical SDF.\nFor more information on SDFs, check out Inigo Quilez's website from which most of the below SDFs and transforms have been taken. cylinder sphere box torus cone triprism (triangular prism) capsule plane segment egg This is the module the user should import to other module not sdf_base! Uses opticalProperties sdfHelpers sdf_baseMod vector_class constants Contents Interfaces box capsule cone cylinder egg plane segment sphere torus triprism Derived Types box capsule cone cylinder egg plane segment sphere torus triprism Functions box_init capsule_init cone_init cylinder_init egg_init evaluate_box evaluate_capsule evaluate_cone evaluate_cylinder evaluate_egg evaluate_plane evaluate_segment evaluate_sphere evaluate_torus evaluate_triprism plane_init segment_init sphere_init torus_init triprism_init Interfaces public interface box Interface to box SDF initialising function private function box_init (lengths, optProp, layer, transform) result(out) Initalising function for Box SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: lengths Lengths of each dimension of the box type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( box ) public interface capsule Interface to capsule SDF initialising function private function capsule_init (a, b, r, optProp, layer, transform) result(out) Initalising function for capsule SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Capsule startpoint type( vector ), intent(in) :: b Capsule endpoint real(kind=wp), intent(in) :: r Capsule radius type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( capsule ) public interface cone Interface to cone SDF initialising function private function cone_init (a, b, ra, rb, optProp, layer, transform) result(out) Initalising function for Capped Cone SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Centre of base of Cone type( vector ), intent(in) :: b Tip of cone real(kind=wp), intent(in) :: ra Radius of Cones base real(kind=wp), intent(in) :: rb Radius of Cones tip. For rb = 0.0 get normal uncapped cone. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cone ) public interface cylinder Interface to cylinder SDF initialising function private function cylinder_init (a, b, radius, optProp, layer, transform) result(out) Initalising function for Cylinder SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Vector position at centre of the bottom circle type( vector ), intent(in) :: b Vector position at centre of the top circle real(kind=wp), intent(in) :: radius Radius of cylinder type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cylinder ) public interface egg Interface to egg SDF initialising function private function egg_init (r1, r2, h, optProp, layer, transform) result(out) Initalising function for egg SDF.\nmakes a Moss egg. ref . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: r1 R1 controls \"fatness\" of the egg. Actually controls the base circle radius. real(kind=wp), intent(in) :: r2 R2 contorls the pointiness of the egg. Actually controls radius of top circle. real(kind=wp), intent(in) :: h h controls the height of the egg. Actually controls y position of top circle. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( egg ) public interface plane Interface to plane SDF initialising function private function plane_init (a, optProp, layer, transform) result(out) Initalising function for plane SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Plane normal. must be normalised type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( plane ) public interface segment Interface to segment SDF initialising function private function segment_init (a, b, optProp, layer, transform) result(out) Initalising function for segment SDF.\nNote this is a 2D function Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a segment start point type( vector ), intent(in) :: b segment end point type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( segment ) public interface sphere private function sphere_init (radius, optProp, layer, transform) result(out) Initalising function for Sphere SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: radius radius of the Sphere type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( sphere ) public interface torus Interface to torus SDF initialising function private function torus_init (oradius, iradius, optProp, layer, transform) result(out) Initalising function for Torus SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: oradius Outer radius of Torus real(kind=wp), intent(in) :: iradius Inner radius of Torus type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( torus ) public interface triprism Interface to triprisim SDF initialising function private function triprism_init (h1, h2, optProp, layer, transform) result(out) Initalising function for triprisim SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: h1 Height of triprisim real(kind=wp), intent(in) :: h2 length of triprisim type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( triprism ) Derived Types type, public, extends( sdf_base ) :: box Box SDF Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( vector ), public :: lengths Length of each dimension of the box type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor Interface to box SDF initialising function private\n\n \n function box_init (lengths, optProp, layer, transform) Initalising function for Box SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_box Function type, public, extends( sdf_base ) :: capsule Capsule SDF Components Type Visibility Attributes Name Initial type( vector ), public :: a type( vector ), public :: b integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: r real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor Interface to capsule SDF initialising function private\n\n \n function capsule_init (a, b, r, optProp, layer, transform) Initalising function for capsule SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_capsule Function type, public, extends( sdf_base ) :: cone Cone SDF Components Type Visibility Attributes Name Initial type( vector ), public :: a type( vector ), public :: b integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: ra real(kind=wp), public :: rb real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor Interface to cone SDF initialising function private\n\n \n function cone_init (a, b, ra, rb, optProp, layer, transform) Initalising function for Capped Cone SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_cone Function type, public, extends( sdf_base ) :: cylinder Cylinder SDF Components Type Visibility Attributes Name Initial type( vector ), public :: a type( vector ), public :: b integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: radius real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor Interface to cylinder SDF initialising function private\n\n \n function cylinder_init (a, b, radius, optProp, layer, transform) Initalising function for Cylinder SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_cylinder Function type, public, extends( sdf_base ) :: egg Egg SDF Components Type Visibility Attributes Name Initial real(kind=wp), public :: h integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: r1 real(kind=wp), public :: r2 real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor Interface to egg SDF initialising function private\n\n \n function egg_init (r1, r2, h, optProp, layer, transform) Initalising function for egg SDF.\nmakes a Moss egg. ref . Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_egg Function type, public, extends( sdf_base ) :: plane Plane SDF Components Type Visibility Attributes Name Initial type( vector ), public :: a integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor Interface to plane SDF initialising function private\n\n \n function plane_init (a, optProp, layer, transform) Initalising function for plane SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_plane Function type, public, extends( sdf_base ) :: segment Segment SDF (2D) Components Type Visibility Attributes Name Initial type( vector ), public :: a type( vector ), public :: b integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor Interface to segment SDF initialising function private\n\n \n function segment_init (a, b, optProp, layer, transform) Initalising function for segment SDF.\nNote this is a 2D function Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_segment Function type, public, extends( sdf_base ) :: sphere Sphere SDF Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: radius real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function sphere_init (radius, optProp, layer, transform) Initalising function for Sphere SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_sphere Function type, public, extends( sdf_base ) :: torus Torus SDF Components Type Visibility Attributes Name Initial real(kind=wp), public :: iradius integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: oradius real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor Interface to torus SDF initialising function private\n\n \n function torus_init (oradius, iradius, optProp, layer, transform) Initalising function for Torus SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_torus Function type, public, extends( sdf_base ) :: triprism Triprisim SDF Components Type Visibility Attributes Name Initial real(kind=wp), public :: h1 real(kind=wp), public :: h2 integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor Interface to triprisim SDF initialising function private\n\n \n function triprism_init (h1, h2, optProp, layer, transform) Initalising function for triprisim SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => evaluate_triprism Function Functions private function box_init (lengths, optProp, layer, transform) result(out) Initalising function for Box SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: lengths Lengths of each dimension of the box type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( box ) private function capsule_init (a, b, r, optProp, layer, transform) result(out) Initalising function for capsule SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Capsule startpoint type( vector ), intent(in) :: b Capsule endpoint real(kind=wp), intent(in) :: r Capsule radius type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( capsule ) private function cone_init (a, b, ra, rb, optProp, layer, transform) result(out) Initalising function for Capped Cone SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Centre of base of Cone type( vector ), intent(in) :: b Tip of cone real(kind=wp), intent(in) :: ra Radius of Cones base real(kind=wp), intent(in) :: rb Radius of Cones tip. For rb = 0.0 get normal uncapped cone. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cone ) private function cylinder_init (a, b, radius, optProp, layer, transform) result(out) Initalising function for Cylinder SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Vector position at centre of the bottom circle type( vector ), intent(in) :: b Vector position at centre of the top circle real(kind=wp), intent(in) :: radius Radius of cylinder type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( cylinder ) private function egg_init (r1, r2, h, optProp, layer, transform) result(out) Initalising function for egg SDF.\nmakes a Moss egg. ref . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: r1 R1 controls \"fatness\" of the egg. Actually controls the base circle radius. real(kind=wp), intent(in) :: r2 R2 contorls the pointiness of the egg. Actually controls radius of top circle. real(kind=wp), intent(in) :: h h controls the height of the egg. Actually controls y position of top circle. type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( egg ) private pure elemental function evaluate_box (this, pos) result(res) Evaluation function for Box SDF. Arguments Type Intent Optional Attributes Name class( box ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) private pure elemental function evaluate_capsule (this, pos) result(res) Evaluation function for Capsule SDF. Arguments Type Intent Optional Attributes Name class( capsule ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) private pure elemental function evaluate_cone (this, pos) result(res) Evaluation function for Cone SDF. Arguments Type Intent Optional Attributes Name class( cone ), intent(in) :: this type( vector ), intent(in) :: pos Return Value real(kind=wp) private pure elemental function evaluate_cylinder (this, pos) result(res) Evaluation function for Cylinder SDF. Arguments Type Intent Optional Attributes Name class( cylinder ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) private pure elemental function evaluate_egg (this, pos) result(res) Evaluation function for Egg SDF. ref Arguments Type Intent Optional Attributes Name class( egg ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) private pure elemental function evaluate_plane (this, pos) result(res) Evaluation function for Plane SDF. Arguments Type Intent Optional Attributes Name class( plane ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) private pure elemental function evaluate_segment (this, pos) result(res) Evaluation function for Segment SDF. Arguments Type Intent Optional Attributes Name class( segment ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) private pure elemental function evaluate_sphere (this, pos) result(res) Evaluation function for Sphere SDF. Arguments Type Intent Optional Attributes Name class( sphere ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) private pure elemental function evaluate_torus (this, pos) result(res) Evaluation function for Torus SDF. Arguments Type Intent Optional Attributes Name class( torus ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) private pure elemental function evaluate_triprism (this, pos) result(res) Evaluation function for Triprisim SDF. Arguments Type Intent Optional Attributes Name class( triprism ), intent(in) :: this type( vector ), intent(in) :: pos vector position to evaluate SDF at Return Value real(kind=wp) private function plane_init (a, optProp, layer, transform) result(out) Initalising function for plane SDF. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Plane normal. must be normalised type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( plane ) private function segment_init (a, b, optProp, layer, transform) result(out) Initalising function for segment SDF.\nNote this is a 2D function Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a segment start point type( vector ), intent(in) :: b segment end point type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( segment ) private function sphere_init (radius, optProp, layer, transform) result(out) Initalising function for Sphere SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: radius radius of the Sphere type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( sphere ) private function torus_init (oradius, iradius, optProp, layer, transform) result(out) Initalising function for Torus SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: oradius Outer radius of Torus real(kind=wp), intent(in) :: iradius Inner radius of Torus type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( torus ) private function triprism_init (h1, h2, optProp, layer, transform) result(out) Initalising function for triprisim SDF. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: h1 Height of triprisim real(kind=wp), intent(in) :: h2 length of triprisim type( opticalProp_t ), intent(in) :: optProp Optical properties of the SDF integer, intent(in) :: layer ID number of sdf real(kind=wp), intent(in), optional :: transform (4,4) Optional transform to apply to SDF Return Value type( triprism )","tags":"","loc":"module/sdfs.html"},{"title":"sdfHelpers – signedMCRT","text":"Collection of helper functions for SDFs: This module defines transforms that can be applied to each SDF: Rotate_{x,y,z} Translate RotationAlign (not tested) RotMat (not tested) Identity SkewSymm Uses vector_class constants Contents Functions identity rotate_x rotate_y rotate_z rotationAlign rotmat skewSymm translate Functions public function identity () result(r) Returns the identity transformation matrix Arguments None Return Value real(kind=wp), (4,4) public function rotate_x (angle) result(r) rotation in the x-axis function from here Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: angle Angle to rotate by Return Value real(kind=wp), (4,4) public function rotate_y (angle) result(r) rotation in the y-axis function from here Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: angle Angle to rotate by Return Value real(kind=wp), (4,4) public function rotate_z (angle) result(r) rotation in the z-axis function from here Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: angle Angle to rotate by Return Value real(kind=wp), (4,4) public function rotationAlign (a, b) result(res) Calculate the rotation matrix to rotate vector a onto b ref1 ref2 Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Vector to rotate. Unit vector type( vector ), intent(in) :: b Vector to be rotated onto. Unit vector Return Value real(kind=wp), (4,4) public function rotmat (axis, angle) Rotate around around an axis by a given angle taken from here Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: axis Axis to rotate around real(kind=wp), intent(in) :: angle Angle to rotate by in degrees Return Value real(kind=wp), (4,4) public function skewSymm (a) result(out) Calculate the Skew Symmetric matrix for a given vector Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: a Vector to calculate the skew symmetric matrix for. Return Value real(kind=wp), (4,4) public function translate (o) result(out) Returns the Translation matrix for a given vector translation. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: o Vector to translate by. Return Value real(kind=wp), (4,4)","tags":"","loc":"module/sdfhelpers.html"},{"title":"sdfModifiers – signedMCRT","text":"This module defines transforms that can be applied to each SDF:\n- Union\n- Intersection\n- Subtraction\n- Displacement\n- Bend\n- Twist\n- Elongate\n- Repeat\n- Extrude\n- Revolution\n- Onion Uses vector_class sdfHelpers sdf_baseMod constants Contents Interfaces bend displacement elongate extrude onion repeat revolution twist Derived Types bend displacement elongate extrude onion repeat revolution twist Functions SmoothUnion bend_init displacement_init elongate_init eval_bend eval_disp eval_elongate eval_extrude eval_onion eval_repeat eval_revolution eval_twist extrude_init intersection onion_init repeat_init revolution_init subtraction twist_init union Interfaces public interface bend private function bend_init (prim, k) result(out) Initialise the Bend modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: k Amoun to bend by. Return Value type( bend ) public interface displacement private function displacement_init (prim, func) result(out) Initialise the displacement modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify procedure( primitive ) :: func Function to displace the SDF with. Return Value type( displacement ) public interface elongate private function elongate_init (prim, size) result(out) Initialise the elongate modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify type( vector ), intent(in) :: size Distance to elongate by Return Value type( elongate ) public interface extrude private function extrude_init (prim, h) result(out) Initialise the extrude modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: h Distance to extrude by. Return Value type( extrude ) public interface onion private function onion_init (prim, thickness) result(out) Initialise the Onion modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: thickness Thickned to onion by. Return Value type( onion ) public interface repeat private function repeat_init (prim, c, la, lb) result(out) Initialise the Repeat modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: c type( vector ), intent(in) :: la type( vector ), intent(in) :: lb Return Value type( repeat ) public interface revolution private function revolution_init (prim, o) result(out) Initialise the Revolution modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: o Amount to revolve by. Return Value type( revolution ) public interface twist private function twist_init (prim, k) result(out) Initialise the twist modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real, intent(in) :: k Twist parameter. Return Value type( twist ) Derived Types type, public, extends( sdf_base ) :: bend Bend a SDF. Components Type Visibility Attributes Name Initial real(kind=wp), public :: k integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function bend_init (prim, k) Initialise the Bend modifier for a SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => eval_bend Function type, public, extends( sdf_base ) :: displacement Displace the surface of a SDF by a function. Components Type Visibility Attributes Name Initial procedure( primitive ), public, nopass, pointer :: func integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function displacement_init (prim, func) Initialise the displacement modifier for a SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => eval_disp Function type, public, extends( sdf_base ) :: elongate Elongate a SDF Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim type( vector ), public :: size real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function elongate_init (prim, size) Initialise the elongate modifier for a SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => eval_elongate Function type, public, extends( sdf_base ) :: extrude Extrude a 2D SDF into 3D Components Type Visibility Attributes Name Initial real(kind=wp), public :: h integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function extrude_init (prim, h) Initialise the extrude modifier for a SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => eval_extrude Function type, public, extends( sdf_base ) :: onion Carves or gives thickness to SDFs Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: thickness real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function onion_init (prim, thickness) Initialise the Onion modifier for a SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => eval_onion Function type, public, extends( sdf_base ) :: repeat Repeat a SDF Components Type Visibility Attributes Name Initial real(kind=wp), public :: c type( vector ), public :: la integer, public :: layer Layer ID of SDF type( vector ), public :: lb type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function repeat_init (prim, c, la, lb) Initialise the Repeat modifier for a SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => eval_repeat Function type, public, extends( sdf_base ) :: revolution Revoloution modifier. Revolves an SDF around the z axis (need to check this!!) Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF real(kind=wp), public :: o type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function revolution_init (prim, o) Initialise the Revolution modifier for a SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => eval_revolution Function type, public, extends( sdf_base ) :: twist Twist a SDF Components Type Visibility Attributes Name Initial real(kind=wp), public :: k integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF class( sdf_base ), public, pointer :: prim real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function twist_init (prim, k) Initialise the twist modifier for a SDF. Type-Bound Procedures procedure\n , public\n, :: evaluate => eval_twist Function Functions public pure function SmoothUnion (d1, d2, k) result(res) Smooth union. Joins two SDFs together smoothly Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 SDF_1 distance real(kind=wp), intent(in) :: d2 SDF_2 distance real(kind=wp), intent(in) :: k smoothing factor. Return Value real(kind=wp) private function bend_init (prim, k) result(out) Initialise the Bend modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: k Amoun to bend by. Return Value type( bend ) private function displacement_init (prim, func) result(out) Initialise the displacement modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify procedure( primitive ) :: func Function to displace the SDF with. Return Value type( displacement ) private function elongate_init (prim, size) result(out) Initialise the elongate modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify type( vector ), intent(in) :: size Distance to elongate by Return Value type( elongate ) private pure elemental function eval_bend (this, pos) result(res) Evaluation function for Bend modifier. Arguments Type Intent Optional Attributes Name class( bend ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) private pure elemental function eval_disp (this, pos) result(res) Evaluation function for displacement modifier. Arguments Type Intent Optional Attributes Name class( displacement ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) private pure elemental function eval_elongate (this, pos) result(res) Evaluation function for Elongate modifier. Arguments Type Intent Optional Attributes Name class( elongate ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) private pure elemental function eval_extrude (this, pos) result(res) Evaluation function for Extrude modifier. Arguments Type Intent Optional Attributes Name class( extrude ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) private pure elemental function eval_onion (this, pos) result(res) Evaluation function for Onion modifier. Arguments Type Intent Optional Attributes Name class( onion ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) private pure elemental function eval_repeat (this, pos) result(res) Evaluation function for Repeat modifier. Arguments Type Intent Optional Attributes Name class( repeat ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) private pure elemental function eval_revolution (this, pos) result(res) Evaluation function for Revolution modifier. Arguments Type Intent Optional Attributes Name class( revolution ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) private pure elemental function eval_twist (this, pos) result(res) Evaluation function for Twist modifier. Arguments Type Intent Optional Attributes Name class( twist ), intent(in) :: this type( vector ), intent(in) :: pos Position to evaluate the modifier at Return Value real(kind=wp) private function extrude_init (prim, h) result(out) Initialise the extrude modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: h Distance to extrude by. Return Value type( extrude ) public pure function intersection (d1, d2, k) result(res) Intersection operator. Returns the intersection of two SDFs. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 SDF_1 distance real(kind=wp), intent(in) :: d2 SDF_2 distance real(kind=wp), intent(in) :: k smoothing factor. Return Value real(kind=wp) private function onion_init (prim, thickness) result(out) Initialise the Onion modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: thickness Thickned to onion by. Return Value type( onion ) private function repeat_init (prim, c, la, lb) result(out) Initialise the Repeat modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: c type( vector ), intent(in) :: la type( vector ), intent(in) :: lb Return Value type( repeat ) private function revolution_init (prim, o) result(out) Initialise the Revolution modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real(kind=wp), intent(in) :: o Amount to revolve by. Return Value type( revolution ) public pure function subtraction (d1, d2, k) result(res) Subtraction operator. Takes one SDF from another.\nTake the first SDF from the 2nd SDF Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 SDF_1 distance real(kind=wp), intent(in) :: d2 SDF_2 distance real(kind=wp), intent(in) :: k unused factor. Return Value real(kind=wp) private function twist_init (prim, k) result(out) Initialise the twist modifier for a SDF. Arguments Type Intent Optional Attributes Name class( sdf_base ), target :: prim SDF to modify real, intent(in) :: k Twist parameter. Return Value type( twist ) public pure function union (d1, d2, k) result(res) Union operation. Joins two SDFs together Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 SDF_1 distance real(kind=wp), intent(in) :: d2 SDF_2 distance real(kind=wp), intent(in) :: k unused factor Return Value real(kind=wp)","tags":"","loc":"module/sdfmodifiers.html"},{"title":"sdf_baseMod – signedMCRT","text":"This module defines the signed distance function (SDF) abstract type, sdf_base type, and model type.\nThe SDF abstract type contains the optical properties of an SDF (mus, mua, kappa, albedo, hgg, g2,and n), as well as a transform (4x4 matrix), \nand the layer ID code of the SDF. The SDF abstract type also provides an abstract interface (evaluate) which each inheriting function must implement.\nThis evaluate function is the heart of the SDF implementation. Each individual evaluate is the direct implementation of that SDF, e.g. that function defines the mathematical SDF. \nFor more information on SDFs, check out Inigo Quilez's website from which most of the below SDFs and transforms have been taken.\nAPI based upon here Uses vector_class opticalProperties sdfHelpers constants Contents Interfaces model render sdf Abstract Interfaces evalInterface op primitive Derived Types model sdf sdf_base Functions calcNormal eval_model getAlbedo getKappa getMua getN getg2 gethgg model_init sdf_evaluate sdf_new Subroutines render_sub render_vec sdf_assign Interfaces public interface model private function model_init (array, func, kopt) result(out) Initalise the model type. Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: array (:) Array of SDFs procedure( op ) :: func Operator to apply to SDF. real(kind=wp), intent(in), optional :: kopt Parameter used in modifier Return Value type( model ) public interface render private subroutine render_sub (cnt, extent, samples, state) Render the SDFs onto a voxel grid Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: cnt (:) type( vector ), intent(in) :: extent integer, intent(in) :: samples (3) type( settings_t ), intent(in) :: state private subroutine render_vec (cnt, state) Render the SDF\nWrapper around the render function to allow ease of use Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: cnt (:) type( settings_t ), intent(in) :: state public interface sdf private function sdf_new (rhs) result(lhs) sdf initializer Arguments Type Intent Optional Attributes Name class( sdf_base ), intent(in) :: rhs Return Value type( sdf ) Abstract Interfaces abstract interface public pure elemental function evalInterface(this, pos) result(res) Evaluation function for SDF. ALL SDF must implment this. Arguments Type Intent Optional Attributes Name class( sdf_base ), intent(in) :: this type( vector ), intent(in) :: pos Return Value real(kind=wp) abstract interface public pure function op(d1, d2, k) result(res) Abstract function used as the base for SDF operators (union, subtraction etc) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: d1 real(kind=wp), intent(in) :: d2 real(kind=wp), intent(in) :: k Return Value real(kind=wp) abstract interface public pure function primitive(pos) result(res) Abstract function used as base for displacement function Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: pos vector position of photon packet. Return Value real(kind=wp) Derived Types type, public, extends( sdf_base ) :: model Model type. Allows the collection of multiple SDF into one model. Used to apply modifiers. Components Type Visibility Attributes Name Initial type( sdf ), public, allocatable :: array (:) Array of SDFs in the model procedure( op ), public, nopass, pointer :: func SDF modifier function real(kind=wp), public :: k Parameter that may be used in modifer function. integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Constructor private\n\n \n function model_init (array, func, kopt) Initalise the model type. Type-Bound Procedures procedure\n , public\n, :: evaluate => eval_model Function type, public, extends( sdf_base ) :: sdf Container type that allows the use of arrays of different SDF shapes Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. class( sdf_base ), public, allocatable :: value Container for any SDF that inherits from SDF_base Constructor private\n\n \n function sdf_new (rhs) sdf initializer Type-Bound Procedures generic,\n public\n, :: assignment(=) => sdf_assign procedure\n , public\n, :: evaluate => sdf_evaluate Function procedure\n , public\n, :: getAlbedo Function procedure\n , public\n, :: getG2 => getg2 Function procedure\n , public\n, :: getKappa Function procedure\n , public\n, :: getMua Function procedure\n , public\n, :: getN Function procedure\n , public\n, :: gethgg Function procedure\n , private\n :: sdf_assign Subroutine type, public :: sdf_base Abstract base type from which all SDF inherit from. Components Type Visibility Attributes Name Initial integer, public :: layer Layer ID of SDF type( opticalProp_t ), public :: optProps Optical property of the SDF real(kind=wp), public :: transform (4,4) Transform to apply to SDF. Type-Bound Procedures procedure\n(evalInterface) , public\n :: evaluate Functions public function calcNormal (p, obj) Calculate the surface normal of a SDF at the point p numerically. Arguments Type Intent Optional Attributes Name type( vector ), intent(in) :: p Position to evaluate at class( sdf_base ) :: obj SDF to calcuate surface normal of. Return Value type( vector ) private pure elemental function eval_model (this, pos) result(res) Evaluate the model Arguments Type Intent Optional Attributes Name class( model ), intent(in) :: this type( vector ), intent(in) :: pos Vector position to evaluate at Return Value real(kind=wp) private function getAlbedo (this) result(res) Return albedo for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) private function getKappa (this) result(res) Return for the current SDF Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) private function getMua (this) result(res) Return for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) private function getN (this) result(res) Return refractive index for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) private function getg2 (this) result(res) Return factor for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) private function gethgg (this) result(res) Return g-factor for the current SDF. Arguments Type Intent Optional Attributes Name class( sdf ) :: this Return Value real(kind=wp) private function model_init (array, func, kopt) result(out) Initalise the model type. Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: array (:) Array of SDFs procedure( op ) :: func Operator to apply to SDF. real(kind=wp), intent(in), optional :: kopt Parameter used in modifier Return Value type( model ) private pure elemental function sdf_evaluate (this, pos) result(res) Evaluate the SDF at a given position. Arguments Type Intent Optional Attributes Name class( sdf ), intent(in) :: this type( vector ), intent(in) :: pos Return Value real(kind=wp) private function sdf_new (rhs) result(lhs) sdf initializer Arguments Type Intent Optional Attributes Name class( sdf_base ), intent(in) :: rhs Return Value type( sdf ) Subroutines private subroutine render_sub (cnt, extent, samples, state) Render the SDFs onto a voxel grid Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: cnt (:) type( vector ), intent(in) :: extent integer, intent(in) :: samples (3) type( settings_t ), intent(in) :: state private subroutine render_vec (cnt, state) Render the SDF\nWrapper around the render function to allow ease of use Arguments Type Intent Optional Attributes Name type( sdf ), intent(in) :: cnt (:) type( settings_t ), intent(in) :: state private subroutine sdf_assign (lhs, rhs) sdf initializer Arguments Type Intent Optional Attributes Name class( sdf ), intent(inout) :: lhs class( sdf_base ), intent(in) :: rhs","tags":"","loc":"module/sdf_basemod.html"},{"title":"mcpolar – signedMCRT","text":"Uses kernels Entry point for program Contents Variables args i num_args Variables Type Attributes Name Initial character(len=64), allocatable :: args (:) integer :: i integer :: num_args","tags":"","loc":"program/mcpolar.html"},{"title":"setupGeometry.f90 – signedMCRT","text":"Contents Modules setupGeometry Source Code setupGeometry.f90 Source Code module setupGeometry !! contains all the routines that setup premade experimental geometry use constants , only : wp use tomlf , only : toml_table , get_value implicit none contains function setup_egg () result ( array ) !! setup an egg, with yolk, albumen and shell use sdfs , only : sdf , sphere , box , egg use sdfModifiers , only : onion , revolution use vector_class use opticalProperties type ( sdf ), allocatable :: array (:) type ( box ) :: bbox type ( revolution ), save :: albumen , rev1 type ( onion ) :: shell type ( sphere ) :: yolk type ( opticalProp_t ) :: opt ( 4 ) type ( egg ), save :: egg_shell , egg_albumen real ( kind = wp ) :: r1 , r2 , h r1 = 3._wp r2 = 3._wp * sqrt ( 2._wp - sqrt ( 2._wp )) h = r2 !width = 42mm !height = 62mm !shell opt ( 1 ) = mono ( 10 0._wp , 1 0._wp , 0.0_wp , 1.37_wp ) egg_shell = egg ( r1 , r2 , h , opt ( 1 ), 2 ) rev1 = revolution ( egg_shell , . 2_wp ) shell = onion ( rev1 , . 2_wp ) !albumen opt ( 2 ) = mono ( 1._wp , 0._wp , 0.0_wp , 1.37_wp ) egg_albumen = egg ( r1 - . 2_wp , r2 , h , opt ( 2 ), 3 ) albumen = revolution ( egg_albumen , . 2_wp ) !yolk opt ( 3 ) = mono ( 1 0._wp , 1._wp , 0.9_wp , 1.37_wp ) yolk = sphere ( 1.5_wp , opt ( 3 ), 1 ) !bounding box opt ( 4 ) = mono ( 0._wp , 0._wp , 0.0_wp , 1._wp ) bbox = box ( vector ( 2 0.001_wp , 2 0.001_wp , 2 0.001_wp ), opt ( 4 ), 4 ) allocate ( array ( 4 )) array ( 1 ) = yolk array ( 2 ) = albumen array ( 3 ) = shell array ( 4 ) = bbox end function setup_egg function setup_sphere_scene ( dict ) result ( array ) !! setup a test scene with user defined spheres use mat_class , only : invert use opticalProperties , only : opticalProp_t , mono use sdfs , only : sdf , sphere , box use sdfHelpers , only : translate use random , only : ranu use vector_class , only : vector type ( toml_table ), intent ( inout ) :: dict type ( sdf ), allocatable :: array (:) integer :: num_spheres , i real ( kind = wp ) :: t ( 4 , 4 ), mus , mua , hgg , n , radius type ( vector ) :: pos type ( opticalProp_t ) :: opt ( 2 ) call get_value ( dict , \"num_spheres\" , num_spheres ) allocate ( array ( num_spheres + 1 )) mus = 1e-17_wp mua = 1e-17_wp hgg = 0.0_wp n = 1.0_wp opt ( 2 ) = mono ( mus , mua , hgg , n ) array ( num_spheres + 1 ) = box ( vector ( 2._wp , 2._wp , 2._wp ), opt ( 2 ), num_spheres + 1 ) mus = 0.0_wp !ranu(1._wp, 50._wp) mua = 0.0_wp !ranu(0.01_wp, 1._wp) hgg = 0.9_wp n = 1.37_wp opt ( 1 ) = mono ( mus , mua , hgg , n ) do i = 1 , num_spheres radius = ranu ( 0.001_wp , 0.25_wp ) pos = vector ( ranu ( - 1._wp + radius , 1._wp - radius ), ranu ( - 1._wp + radius , 1._wp - radius ),& ranu ( - 1._wp + radius , 1._wp - radius )) t = invert ( translate ( pos )) array ( i ) = sphere ( radius , opt ( 1 ), i , transform = t ) end do end function setup_sphere_scene function setup_logo () result ( array ) !! setup uni crest geometry use sdfs , only : sdf , box , segment use sdfModifiers , only : extrude use opticalProperties use vector_class type ( sdf ), allocatable :: array (:) type ( segment ), allocatable , save :: seg (:) type ( opticalProp_t ) :: opt ( 2 ) type ( vector ) :: a , b real ( kind = wp ) :: hgg , mus , mua , n integer :: layer logical :: fexists allocate ( array ( 726 ), seg ( 725 )) mus = 1 0._wp mua = . 1_wp hgg = 0.9_wp n = 1.5_wp layer = 1 opt ( 1 ) = mono ( 0.0_wp , 0.0_wp , 0.0_wp , 1.0_wp ) opt ( 2 ) = mono ( mus , mua , hgg , n ) inquire ( file = \"res/svg.f90\" , exist = fexists ) if (. not . fexists ) error stop \"need to generate svg.f90 and place in res/\" error stop \"need to uncomment inlcude line!\" ! include \"../res/svg.f90\" array ( 726 ) = box ( vector ( 1 0._wp , 1 0._wp , 2.001_wp ), opt ( 1 ), 2 ) end function setup_logo function setup_sphere () result ( array ) !! setup the sphere test case from tran and jacques paper. use mat_class , only : invert use opticalProperties , only : mono , opticalProp_t use sdfs , only : sdf , box , sphere use sdfHelpers , only : translate use vector_class , only : vector type ( sdf ), allocatable :: array (:) type ( opticalProp_t ) :: opt ( 3 ) real ( kind = wp ) :: mus , mua , n , hgg , t ( 4 , 4 ) type ( vector ) :: a allocate ( array ( 3 )) mus = 0._wp ; mua = 1.e-17_wp ; hgg = 0._wp ; n = 1._wp ; opt ( 1 ) = mono ( mus , mua , hgg , n ) array ( 2 ) = box ( vector ( 2._wp , 2._wp , 2._wp ), opt ( 1 ), 2 ) opt ( 2 ) = mono ( mus , 1000000 0._wp , hgg , n ) array ( 3 ) = box ( vector ( 2.01_wp , 2.01_wp , 2.01_wp ), opt ( 2 ), 3 ) mus = 0._wp ; mua = 1.e-17_wp ; hgg = 0._wp ; n = 1.33_wp ; opt ( 3 ) = mono ( mus , mua , hgg , n ) a = vector (. 0_wp , 0._wp , 0._wp ) t = invert ( translate ( a )) array ( 1 ) = sphere ( 0.5_wp , opt ( 3 ), 1 , transform = t ) end function setup_sphere function setup_exp ( dict ) result ( array ) !! Setup experimental geometry from Georgies paper. i.e a glass bottle with contents use sdfs , only : sdf , box , cylinder !, subtraction use sdfHelpers , only : rotate_y , translate use utils , only : deg2rad use vector_class , only : vector use mat_class , only : invert use opticalProperties , only : mono , opticalProp_t type ( toml_table ), intent ( inout ) :: dict type ( sdf ), allocatable :: array (:) type ( opticalProp_t ) :: opt ( 3 ) type ( vector ) :: a , b real ( kind = wp ) :: n , optprop ( 5 ) error stop \"add model and subtraction here\" call get_value ( dict , \"musb\" , optprop ( 1 )) call get_value ( dict , \"muab\" , optprop ( 2 )) call get_value ( dict , \"musc\" , optprop ( 3 )) call get_value ( dict , \"muac\" , optprop ( 4 )) call get_value ( dict , \"hgg\" , optprop ( 5 )) n = 1._wp opt ( 1 ) = mono ( optprop ( 1 ), optprop ( 2 ), optprop ( 5 ), 1.5_wp ) opt ( 2 ) = mono ( optprop ( 3 ), optprop ( 4 ), optprop ( 5 ), 1.3_wp ) a = vector ( - 1 0._wp , 0._wp , 0._wp ) b = vector ( 1 0._wp , 0._wp , 0._wp ) !bottle array ( 2 ) = cylinder ( a , b , 1.75_wp , opt ( 1 ), 2 ) ! contents array ( 1 ) = cylinder ( a , b , 1.55_wp , opt ( 2 ), 1 ) ! t = invert(translate(vector(0._wp, 0._wp, -5._wp+1.75_wp))) ! slab = box(vector(10._wp, 10._wp, 10._wp), optprop(3), optprop(4), optprop(5), 1.3_wp, 1, transform=t) opt ( 3 ) = mono ( 0.0_wp , 0.0_wp , 0.0_wp , n ) array ( 3 ) = box ( vector ( 4._wp , 4._wp , 4._wp ), opt ( 3 ), 2 ) end function setup_exp function setup_scat_test ( dict ) result ( array ) !! set up scattering test scene with user defined tau use opticalProperties use sdfs , only : sdf , sphere , box use vector_class type ( toml_table ), intent ( inout ) :: dict type ( sdf ), allocatable :: array (:) type ( opticalProp_t ) :: opt ( 2 ) real ( kind = wp ) :: mus , mua , hgg , n , tau call get_value ( dict , \"tau\" , tau ) allocate ( array ( 2 )) n = 1._wp hgg = 0.0_wp mua = 0.00_wp mus = tau opt ( 1 ) = mono ( mus , mua , hgg , n ) array ( 1 ) = sphere ( 1._wp , opt ( 1 ), 1 ) opt ( 2 ) = mono ( 0.0_wp , mua , hgg , n ) array ( 2 ) = box ( vector ( 2._wp , 2._wp , 2._wp ), opt ( 2 ), 2 ) end function setup_scat_test function setup_scat_test2 ( dict ) result ( array ) !! set up scattering test scene 2 with user defined tau and hgg use opticalProperties use sdfs , only : sdf , box use vector_class type ( toml_table ), intent ( inout ) :: dict type ( sdf ), allocatable :: array (:) type ( opticalProp_t ) :: opt real ( kind = wp ) :: mus , mua , hgg , n , tau allocate ( array ( 1 )) call get_value ( dict , \"tau\" , tau ) call get_value ( dict , \"hgg\" , hgg ) n = 1._wp hgg = hgg mua = 1e-17_wp mus = tau opt = mono ( mus , mua , hgg , n ) array ( 1 ) = box ( vector ( 20 0._wp , 20 0._wp , 20 0._wp ), opt , 2 ) end function setup_scat_test2 function setup_omg_sdf () result ( array ) !! setup OMG scene use mat_class , only : invert use opticalProperties use sdfHelpers , only : translate , rotate_y use sdfModifiers , only : SmoothUnion use sdfs , only : sdf , cylinder , torus , box , model use vector_class , only : vector type ( sdf ), allocatable :: array (:) type ( sdf ), allocatable , save :: cnta (:) type ( opticalProp_t ), save :: opt ( 2 ) type ( vector ) :: a , b real ( kind = wp ) :: t ( 4 , 4 ), mus , mua , hgg , n integer :: layer allocate ( array ( 2 ), cnta ( 10 )) mus = 1 0._wp mua = 0.16_wp hgg = 0.0_wp n = 2.65_wp layer = 1 opt ( 1 ) = mono ( mus , mua , hgg , n ) opt ( 2 ) = mono ( 0._wp , 0._wp , 0._wp , 1.0_wp ) ! x ! | ! | ! | ! | ! |_____z !O letter a = vector ( 0._wp , 0._wp , - 0.7_wp ) t = invert ( translate ( a )) cnta ( 1 ) = torus (. 2_wp , 0.05_wp , opt ( 1 ), layer , transform = t ) !M letter a = vector ( - . 25_wp , 0._wp , - . 25_wp ) b = vector ( - . 25_wp , 0._wp , . 25_wp ) t = invert ( rotate_y ( 9 0._wp )) cnta ( 2 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer , transform = t ) a = vector ( - . 25_wp , 0._wp , - . 25_wp ) b = vector (. 25_wp , 0._wp , . 0_wp ) cnta ( 3 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector (. 25_wp , 0._wp , . 0_wp ) b = vector ( - . 25_wp , 0._wp , . 25_wp ) cnta ( 4 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector ( - . 25_wp , 0._wp , . 25_wp ) b = vector (. 25_wp , 0._wp , . 25_wp ) cnta ( 5 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) !G letter a = vector ( - . 25_wp , 0._wp , . 5_wp ) b = vector (. 25_wp , 0._wp , . 5_wp ) cnta ( 6 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector ( - . 25_wp , 0._wp , . 5_wp ) b = vector ( - . 25_wp , 0._wp , . 75_wp ) cnta ( 7 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector (. 25_wp , 0._wp , . 5_wp ) b = vector (. 25_wp , 0._wp , . 75_wp ) cnta ( 8 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector (. 25_wp , 0._wp , . 75_wp ) b = vector ( 0._wp , 0._wp , . 75_wp ) cnta ( 9 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) a = vector ( 0._wp , 0._wp , . 625_wp ) b = vector ( 0._wp , 0._wp , . 75_wp ) cnta ( 10 ) = cylinder ( a , b , . 05_wp , opt ( 1 ), layer ) array ( 1 ) = model ( cnta , smoothunion , 0.09_wp ) array ( 2 ) = box ( vector ( 2._wp , 2._wp , 2._wp ), opt ( 2 ), 2 ) end function setup_omg_sdf function get_vessels () result ( array ) !! setup blood vessel scene use opticalProperties use sdfs , only : sdf , capsule , box use vector_class , only : vector type ( sdf ), allocatable :: array (:) real ( kind = wp ), allocatable :: nodes (:, :), radii (:) integer , allocatable :: edges (:, :) integer :: io , edge_cnt , tmp1 , tmp2 , u , node_cnt , i real ( kind = wp ) :: x , y , z , radius , res , maxx , maxy , maxz real ( kind = wp ) :: musv , muav , gv , nv real ( kind = wp ) :: musd , muad , gd , nd type ( vector ) :: a , b type ( opticalProp_t ) :: opt ( 2 ) !MCmatlab: an open-source, user-friendly, MATLAB-integrated three-dimensional Monte Carlo light transport solver with heat diffusion and tissue damage muav = 23 1._wp musv = 9 4._wp gv = 0.9_wp nv = 1.37_wp muad = 0.458_wp musd = 35 7._wp gd = 0.9_wp nd = 1.37_wp opt ( 1 ) = mono ( musv , muav , gv , nv ) opt ( 2 ) = mono ( musd , muad , gd , nd ) !get number of edges open ( newunit = u , file = \"res/edges.dat\" , iostat = io ) edge_cnt = 0 do read ( u , * , iostat = io ) tmp1 , tmp2 if ( io /= 0 ) exit edge_cnt = edge_cnt + 1 end do close ( u ) !get number of nodes and radii open ( newunit = u , file = \"res/nodes.dat\" , iostat = io ) node_cnt = 0 do read ( u , * , iostat = io ) x , y , z if ( io /= 0 ) exit node_cnt = node_cnt + 1 end do allocate ( edges ( edge_cnt , 2 ), nodes ( node_cnt , 3 ), radii ( node_cnt )) !read in edges open ( newunit = u , file = \"res/edges.dat\" , iostat = io ) do i = 1 , edge_cnt read ( u , * , iostat = io ) edges ( i , :) if ( io /= 0 ) exit end do close ( u ) !read in nodes open ( newunit = u , file = \"res/nodes.dat\" , iostat = io ) do i = 1 , edge_cnt read ( u , * , iostat = io ) nodes ( i , :) if ( io /= 0 ) exit end do close ( u ) !read in radii open ( newunit = u , file = \"res/radii.dat\" , iostat = io ) do i = 1 , node_cnt read ( u , * , iostat = io ) radii ( i ) if ( io /= 0 ) exit end do close ( u ) res = 0.001_wp !0.01mm maxx = maxval ( abs ( nodes (:, 1 ))) maxy = maxval ( abs ( nodes (:, 2 ))) maxz = maxval ( abs ( nodes (:, 3 ))) nodes (:, 1 ) = ( nodes (:, 1 ) / maxx ) - 0.5_wp nodes (:, 2 ) = ( nodes (:, 2 ) / maxy ) - 0.5_wp nodes (:, 3 ) = ( nodes (:, 3 ) / maxz ) - 0.5_wp nodes (:, 1 ) = nodes (:, 1 ) * maxx * res nodes (:, 2 ) = nodes (:, 2 ) * maxy * res nodes (:, 3 ) = nodes (:, 3 ) * maxz * res allocate ( array ( edge_cnt + 1 )) do i = 1 , edge_cnt a = vector ( nodes ( edges ( i , 1 ), 1 ), nodes ( edges ( i , 1 ), 2 ), nodes ( edges ( i , 1 ), 3 )) b = vector ( nodes ( edges ( i , 2 ), 1 ), nodes ( edges ( i , 2 ), 2 ), nodes ( edges ( i , 2 ), 3 )) radius = radii ( edges ( i , 1 )) * res array ( i ) = capsule ( a , b , radius , opt ( 1 ), 1 ) end do array ( i ) = box ( vector (. 32_wp , . 18_wp , . 26_wp ), opt ( 2 ), 2 ) end function get_vessels end module setupGeometry","tags":"","loc":"sourcefile/setupgeometry.f90.html"},{"title":"photon.f90 – signedMCRT","text":"Contents Modules photonMod Source Code photon.f90 Source Code module photonMod !! This source file contains the photon type, all the photon launch routines for different light sources, and the scattering code. !! Below are the current types of light sources available. Check [here](config.md) for parameters needed for each light source. !! !! - uniform !! - pencil !! - annulus !! - focus !! - point !! - circular !! - SLM (2D image source) !! - double slit !! - square aperture use constants , only : wp use vector_class use random , only : seq implicit none !> photon class type :: photon !> postion of photon packet in cm. (0,0,0) is the center of the grid. type ( vector ) :: pos !> direction vectors real ( kind = wp ) :: nxp , nyp , nzp !> direction cosines real ( kind = wp ) :: sint , cost , sinp , cosp , phi !> Wavelength of the packet real ( kind = wp ) :: wavelength !> Current phase of the packet real ( kind = wp ) :: phase !> \\frac{2\\pi}{\\lambda}. Used to save computational time real ( kind = wp ) :: fact !> Energy of the packet. TODO real ( kind = wp ) :: energy !> grid cell position integer :: xcell , ycell , zcell !> photon alive flag logical :: tflag !> ID of the SDF the packet is in integer :: layer !> Thread ID of the packet integer :: id !> Debug data. Number of SDF evals integer :: cnts , bounces !> used if photon packet weights are used real ( kind = wp ) :: weight , step !, L !> emission routine procedure ( generic_emit ), pointer :: emit => null () contains !> scattering routine procedure :: scatter => scatter end type photon interface photon !> assign the emission function to the photon object module procedure init_source !> intialise the photon class module procedure init_photon end interface photon abstract interface subroutine generic_emit ( this , spectrum , dict , seqs ) use tomlf , only : toml_table , get_value use random , only : seq use piecewiseMod import :: photon class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) end subroutine generic_emit end interface !> used to save some computation time type ( photon ) :: photon_origin private public :: photon , init_source , set_photon contains subroutine set_photon ( pos , dir ) type ( vector ), intent ( in ) :: pos , dir photon_origin % pos = pos photon_origin % nxp = dir % x photon_origin % nyp = dir % y photon_origin % nzp = dir % z end subroutine set_photon type ( photon ) function init_photon ( val ) !! set up all the variables in the photon object !> value to assing to variables real ( kind = wp ), intent ( in ) :: val init_photon % pos = vector ( val , val , val ) init_photon % nxp = val init_photon % nyp = val init_photon % nzp = val init_photon % sint = val init_photon % cost = val init_photon % sinp = val init_photon % cosp = val init_photon % phi = val init_photon % wavelength = val init_photon % energy = val init_photon % fact = val init_photon % zcell = int ( val ) init_photon % ycell = int ( val ) init_photon % zcell = int ( val ) init_photon % tflag = . true . init_photon % layer = int ( val ) init_photon % id = int ( val ) init_photon % cnts = int ( val ) init_photon % bounces = int ( val ) init_photon % weight = val init_photon % step = val end function init_photon type ( photon ) function init_source ( choice ) !! Bind emission function to photon object !> Name of light source to use character ( * ), intent ( IN ) :: choice if ( choice == \"uniform\" ) then init_source % emit => uniform elseif ( choice == \"pencil\" ) then init_source % emit => pencil elseif ( choice == \"dslit\" ) then init_source % emit => dslit elseif ( choice == \"aperture\" ) then init_source % emit => aperture elseif ( choice == \"annulus\" ) then init_source % emit => annulus elseif ( choice == \"focus\" ) then init_source % emit => focus elseif ( choice == \"point\" ) then init_source % emit => point elseif ( choice == \"circular\" ) then init_source % emit => circular elseif ( choice == \"slm\" ) then init_source % emit => slm else error stop \"No such source!\" end if end function init_source subroutine slm ( this , spectrum , dict , seqs ) use piecewiseMod use tomlf , only : toml_table , get_value use random , only : ran2 , seq use sim_state_mod , only : state use constants , only : TWOPI class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: x , y this % pos = photon_origin % pos call spectrum % p % sample ( x , y ) this % pos % x = ( x - 100 ) / ( state % grid % nxg / ( 2. * state % grid % xmax )) this % pos % y = ( y - 100 ) / ( state % grid % nyg / ( 2. * state % grid % ymax )) this % nxp = photon_origin % nxp this % nyp = photon_origin % nyp this % nzp = photon_origin % nzp this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % tflag = . false . this % cnts = 0 this % bounces = 0 this % layer = 1 this % weight = 1.0_wp this % phase = 0.0_wp this % wavelength = 50 0.e-9_wp this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine slm subroutine circular ( this , spectrum , dict , seqs ) !! circular source use sim_state_mod , only : state use random , only : ran2 , seq use constants , only : twoPI use tomlf , only : toml_table , get_value use sdfHelpers , only : rotationAlign , translate use mat_class , only : invert use vector_class use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) type ( vector ) :: a , b integer :: cell ( 3 ) real ( kind = wp ) :: t ( 4 , 4 ), radius , r , theta , tmp this % nxp = photon_origin % nxp this % nyp = photon_origin % nyp this % nzp = photon_origin % nzp call get_value ( dict , \"radius\" , radius ) ! https://math.stackexchange.com/a/1681815 r = radius * sqrt ( ran2 ()) theta = ran2 () * TWOPI !set inital vector from which the source points a = vector ( 1._wp , 0._wp , 0._wp ) a = a % magnitude () !set vector to rotate to. User defined. b = vector ( this % nxp , this % nyp , this % nzp ) b = b % magnitude () ! method fails if below condition is true. So change a vector to point down x-axis if ( abs ( a ) == abs ( b )) then a = vector ( 0._wp , 0._wp , 1._wp ) a = a % magnitude () this % pos = vector ( r * cos ( theta ), r * sin ( theta ), 0._wp ) else this % pos = vector ( 0._wp , r * cos ( theta ), r * sin ( theta )) end if ! get rotation matrix t = rotationAlign ( a , b ) ! get translation matrix t = matmul ( t , invert ( translate ( photon_origin % pos ))) ! transform point this % pos = this % pos . dot . t this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) call spectrum % p % sample ( this % wavelength , tmp ) this % tflag = . false . this % cnts = 0 this % bounces = 0 this % layer = 1 this % weight = 1.0_wp ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine circular subroutine point ( this , spectrum , dict , seqs ) !! isotropic point source use sim_state_mod , only : state use random , only : ran2 , seq use constants , only : twoPI use tomlf , only : toml_table , get_value use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: wavelength , tmp this % pos = photon_origin % pos this % phi = ran2 () * twoPI this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = 2._wp * ran2 () - 1._wp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % nxp = this % sint * this % cosp this % nyp = this % sint * this % sinp this % nzp = this % cost this % tflag = . false . this % cnts = 0 this % bounces = 0 this % layer = 1 this % weight = 1.0_wp ! this%L = 1.0 call spectrum % p % sample ( wavelength , tmp ) this % wavelength = wavelength this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine point subroutine focus ( this , spectrum , dict , seqs ) use random , only : ranu , seq use sim_state_mod , only : state use utils , only : deg2rad use vector_class , only : length use tomlf , only : toml_table , get_value use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) type ( vector ) :: targ , dir real ( kind = wp ) :: dist , tmp integer :: cell ( 3 ) targ = vector ( 0._wp , 0._wp , 0._wp ) this % pos % x = ranu ( - state % grid % xmax , state % grid % xmax ) this % pos % y = ranu ( - state % grid % ymax , state % grid % ymax ) this % pos % z = state % grid % zmax - 1e-8_wp dist = length ( this % pos ) dir = ( - 1._wp ) * this % pos / dist dir = dir % magnitude () this % nxp = dir % x this % nyp = dir % y this % nzp = dir % z this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % nxp = this % sint * this % cosp this % nyp = this % sint * this % sinp this % nzp = this % cost this % tflag = . false . this % bounces = 0 this % cnts = 0 this % weight = 1.0_wp call spectrum % p % sample ( this % wavelength , tmp ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine focus subroutine uniform ( this , spectrum , dict , seqs ) !! uniformly illuminate a surface of the simulation media use random , only : ranu , ran2 , randint , seq use sim_state_mod , only : state use tomlf , only : toml_table , get_value use constants , only : TWOPI use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) type ( vector ) :: pos1 , pos2 , pos3 real ( kind = wp ) :: rx , ry , tmp this % nxp = photon_origin % nxp this % nyp = photon_origin % nyp this % nzp = photon_origin % nzp this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) call get_value ( dict , \"pos1%x\" , pos1 % x ) call get_value ( dict , \"pos1%y\" , pos1 % y ) call get_value ( dict , \"pos1%z\" , pos1 % z ) call get_value ( dict , \"pos2%x\" , pos2 % x ) call get_value ( dict , \"pos2%y\" , pos2 % y ) call get_value ( dict , \"pos2%z\" , pos2 % z ) call get_value ( dict , \"pos3%x\" , pos3 % x ) call get_value ( dict , \"pos3%y\" , pos3 % y ) call get_value ( dict , \"pos3%z\" , pos3 % z ) rx = ran2 () !seqs(1)%next() ry = ran2 () !seqs(2)%next() this % pos % x = pos1 % x + rx * pos2 % x + ry * pos3 % x this % pos % y = pos1 % y + rx * pos2 % y + ry * pos3 % y this % pos % z = pos1 % z + rx * pos2 % z + ry * pos3 % z this % tflag = . false . this % cnts = 0 this % bounces = 0 this % weight = 1.0_wp !FOR PHASE call spectrum % p % sample ( this % wavelength , tmp ) this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) this % phase = 0._wp ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine uniform subroutine pencil ( this , spectrum , dict , seqs ) !! pencil beam source use random , only : ranu , seq use sim_state_mod , only : state use tomlf , only : toml_table , get_value use piecewiseMod use constants , only : TWOPI class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: tmp this % pos = photon_origin % pos this % nxp = photon_origin % nxp this % nyp = photon_origin % nyp this % nzp = photon_origin % nzp this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % tflag = . false . this % bounces = 0 this % cnts = 0 this % weight = 1.0_wp call spectrum % p % sample ( this % wavelength , tmp ) this % energy = 1.0_wp this % fact = TWOPI / this % wavelength ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine pencil subroutine dslit ( this , spectrum , dict , seqs ) !!sample from double slit to produce diff pattern ! todo add in user defined slit widths ! add correct normalisation use random , only : ranu , ran2 , randint , seq use sim_state_mod , only : state use tomlf , only : toml_table , get_value use constants , only : TWOPI use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: x1 , y1 , z1 , x2 , y2 , z2 , a , b , tmp call spectrum % p % sample ( this % wavelength , tmp ) this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) a = 6 0._wp * this % wavelength !distance between slits b = 2 0._wp * this % wavelength !2 slit width if ( ran2 () > 0.5_wp ) then ! pick slit and sample x, y position x1 = ranu ( a / 2._wp , a / 2._wp + b ) y1 = ranu ( - b * 0.5_wp , b * 0.5_wp ) else x1 = ranu ( - a / 2._wp , - a / 2._wp - b ) y1 = ranu ( - b * 0.5_wp , b * 0.5_wp ) end if z2 = 5.0_wp - ( 1.e-5_wp * ( 2._wp * ( 5.0_wp / 40 0._wp ))) x2 = ranu ( - 5.0_wp , 5.0_wp ) y2 = ranu ( - 5.0_wp , 5.0_wp ) z1 = ( 1000 0._wp * this % wavelength ) - 5.0_wp !screen location this % pos % x = x2 this % pos % y = y2 this % pos % z = z2 this % phase = sqrt (( x2 - x1 ) ** 2 + ( y2 - y1 ) ** 2 + ( z2 - z1 ) ** 2 ) this % nxp = ( x2 - x1 ) / this % phase this % nyp = ( y2 - y1 ) / this % phase this % nzp = - abs (( z2 - z1 )) / this % phase this % tflag = . false . this % cnts = 0 this % bounces = 0 this % weight = 1.0_wp !Set direction cosine/sine this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine dslit subroutine aperture ( this , spectrum , dict , seqs ) !! sample from square aperture to produce diff pattern !add user defined apwid and F ! add correct normalisation use random , only : ranu , ran2 , randint , seq use sim_state_mod , only : state use tomlf , only : toml_table , get_value use constants , only : TWOPI use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) integer :: cell ( 3 ) real ( kind = wp ) :: x1 , y1 , z1 , x2 , y2 , z2 , b , F , apwid , tmp call spectrum % p % sample ( this % wavelength , tmp ) this % energy = 1._wp this % fact = TWOPI / ( this % wavelength ) apwid = 20 0e-6_wp !aperture width b = apwid / 2._wp !slit width ! Fresnel number F = 4.95_wp !sample aperture postiion x1 = ranu ( - b , b ) y1 = ranu ( - b , b ) z1 = ( 1._wp / (((( F / apwid ) ** 2 ) / 2._wp ) * this % wavelength )) - 0.5_wp x2 = ranu ( - 0.5_wp , 0.5_wp ) y2 = ranu ( - 0.5_wp , 0.5_wp ) z2 = 0.5_wp - ( 1.e-5_wp * ( 2._wp * 0.5_wp / 40 0._wp )) this % pos % x = x2 this % pos % y = y2 this % pos % z = z2 this % phase = sqrt (( x2 - x1 ) ** 2 + ( y2 - y1 ) ** 2 + ( z2 - z1 ) ** 2 ) this % nxp = ( x2 - x1 ) / this % phase this % nyp = ( y2 - y1 ) / this % phase this % nzp = - abs (( z2 - z1 )) / this % phase this % tflag = . false . this % cnts = 0 this % bounces = 0 this % weight = 1.0_wp !scattering stuff - not important this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % phi = atan2 ( this % nyp , this % nxp ) this % cosp = cos ( this % phi ) this % sinp = sin ( this % phi ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine aperture subroutine annulus ( this , spectrum , dict , seqs ) !! annular source use constants , only : TWOPI use utils , only : deg2rad use tomlf , only : toml_table , get_value use random , only : ran2 , rang , seq use sim_state_mod , only : state use piecewiseMod class ( photon ) :: this type ( spectrum_t ), intent ( in ) :: spectrum type ( toml_table ), optional , intent ( inout ) :: dict type ( seq ), optional , intent ( inout ) :: seqs ( 2 ) character ( len = :), allocatable :: beam_type real ( kind = wp ) :: beta , rlo , rhi , radius , tmp , mid , angle , x , y , z , phi , sinp , cosp type ( vector ) :: pos integer :: cell ( 3 ) call get_value ( dict , \"beta\" , beta ) call get_value ( dict , \"radius\" , rlo ) call get_value ( dict , \"radius_hi\" , rhi ) call get_value ( dict , \"annulus_type\" , beam_type ) if ( beam_type == \"tophat\" ) then radius = rlo + ( rhi - rlo ) * sqrt ( ran2 ()) elseif ( beam_type == \"gaussian\" ) then mid = ( rhi - rlo ) / 2. call rang ( radius , tmp , mid , 0.04_wp ) else error stop \"No such beam type!\" end if phi = TWOPI * ran2 () angle = deg2rad ( beta ) cosp = cos ( phi ) sinp = sin ( phi ) x = radius * cosp y = radius * sinp z = state % grid % zmax - 1e-8_wp ! just inside surface of medium. TODO make this user configurable? pos = vector ( x , y , z ) this % pos = pos this % nxp = sin ( angle ) * cosp this % nyp = sin ( angle ) * sinp this % nzp = - cos ( angle ) this % phi = phi this % cosp = cosp this % sinp = sinp this % cost = this % nzp this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % tflag = . false . this % bounces = 0 this % cnts = 0 this % weight = 1.0_wp call spectrum % p % sample ( this % wavelength , tmp ) ! Linear Grid cell = state % grid % get_voxel ( this % pos ) this % xcell = cell ( 1 ) this % ycell = cell ( 2 ) this % zcell = cell ( 3 ) end subroutine annulus subroutine scatter ( this , hgg , g2 , dects ) !! Scattering routine. Implments both isotropic and henyey-greenstein scattering !! taken from [mcxyz](https://omlc.org/software/mc/mcxyz/index.html) use constants , only : PI , TWOPI , wp use random , only : ran2 use detectors , only : dect_array class ( photon ), intent ( inout ) :: this !> g factor real ( kind = wp ), intent ( in ) :: hgg !> g factor squared real ( kind = wp ), intent ( in ) :: g2 !> array of detectors. Only used if biased scattering is enabled. type ( dect_array ), optional , intent ( in ) :: dects (:) real ( kind = wp ) :: temp , uxx , uyy , uzz , a , p a = 0.9_wp p = 0.0_wp if ( hgg == 0.0_wp ) then !isotropic scattering this % cost = 2._wp * ran2 () - 1._wp else !henyey-greenstein scattering if ( ran2 () < p . and . present ( dects )) then !bias scattering temp = ran2 () * (( 1._wp / ( 1._wp - a )) - ( 1._wp / sqrt ( a ** 2 + 1._wp ))) + ( 1._wp / sqrt ( a ** 2 + 1._wp )) temp = temp ** ( - 2._wp ) this % cost = ( 1._wp / ( 2._wp * a )) * ( a ** 2 + 1._wp - temp ) this % nxp = dects ( 1 )% p % pos % x - this % pos % x this % nyp = dects ( 1 )% p % pos % y - this % pos % y this % nzp = dects ( 1 )% p % pos % z - this % pos % z else !unbiased temp = ( 1.0_wp - g2 ) / ( 1.0_wp - hgg + 2._wp * hgg * ran2 ()) this % cost = ( 1.0_wp + g2 - temp ** 2 ) / ( 2._wp * hgg ) end if end if this % sint = sqrt ( 1._wp - this % cost ** 2 ) this % phi = TWOPI * ran2 () this % cosp = cos ( this % phi ) if ( this % phi < PI ) then this % sinp = sqrt ( 1._wp - this % cosp ** 2 ) else this % sinp = - sqrt ( 1._wp - this % cosp ** 2 ) end if if ( 1._wp - abs ( this % nzp ) <= 1e-12_wp ) then ! near perpindicular uxx = this % sint * this % cosp uyy = this % sint * this % sinp uzz = sign ( this % cost , this % nzp ) else temp = sqrt ( 1._wp - this % nzp ** 2 ) uxx = this % sint * ( this % nxp * this % nzp * this % cosp - this % nyp * this % sinp ) / temp + this % nxp * this % cost uyy = this % sint * ( this % nyp * this % nzp * this % cosp + this % nxp * this % sinp ) / temp + this % nyp * this % cost uzz = - 1._wp * this % sint * this % cosp * temp + this % nzp * this % cost end if this % nxp = uxx this % nyp = uyy this % nzp = uzz end subroutine scatter end module photonMod","tags":"","loc":"sourcefile/photon.f90.html"},{"title":"surfaces.f90 – signedMCRT","text":"Contents Modules surfaces Source Code surfaces.f90 Source Code module surfaces !! Contains the routines that handle reflection, and refraction via the Fresnel equations. use vector_class , only : vector use constants , only : wp implicit none private public :: reflect_refract contains subroutine reflect_refract ( I , N , n1 , n2 , rflag , ri ) !! wrapper routine for fresnel calculation use random , only : ran2 !> incident vector type ( vector ), intent ( INOUT ) :: I !> normal vector type ( vector ), intent ( INOUT ) :: N !> refractive indices real ( kind = wp ), intent ( IN ) :: n1 , n2 real ( kind = wp ), intent ( OUT ) :: Ri !> reflection flag logical , intent ( OUT ) :: rflag rflag = . FALSE . !draw random number, if less than fresnel coefficents, then reflect, else refract Ri = fresnel ( I , N , n1 , n2 ) if ( ran2 () <= Ri ) then call reflect ( I , N ) rflag = . true . else call refract ( I , N , n1 / n2 ) end if end subroutine reflect_refract subroutine reflect ( I , N ) !! get vector of reflected photon !> incident vector type ( vector ), intent ( INOUT ) :: I !> normal vector type ( vector ), intent ( IN ) :: N type ( vector ) :: R R = I - 2._wp * ( N . dot . I ) * N I = R end subroutine reflect subroutine refract ( I , N , eta ) !! get vector of refracted photon !> incident vector type ( vector ), intent ( INOUT ) :: I !> normal vector type ( vector ), intent ( IN ) :: N !> \\eta = \\frac{n_1}{n_2} real ( kind = wp ), intent ( IN ) :: eta type ( vector ) :: T , Ntmp real ( kind = wp ) :: c1 , c2 Ntmp = N c1 = ( Ntmp . dot . I ) if ( c1 < 0._wp ) then c1 = - c1 else Ntmp = ( - 1._wp ) * N end if c2 = sqrt ( 1._wp - ( eta ) ** 2 * ( 1._wp - c1 ** 2 )) T = eta * I + ( eta * c1 - c2 ) * Ntmp I = T end subroutine refract function fresnel ( I , N , n1 , n2 ) result ( tir ) !! calculates the fresnel coefficents use ieee_arithmetic , only : ieee_is_nan !> reffractive indicies real ( kind = wp ), intent ( IN ) :: n1 , n2 !> incident vector type ( vector ), intent ( IN ) :: I !> Normal vector type ( vector ), intent ( IN ) :: N real ( kind = wp ) :: costt , sintt , sint2 , cost2 , tir , f1 , f2 costt = abs ( I . dot . N ) sintt = sqrt ( 1._wp - costt * costt ) sint2 = n1 / n2 * sintt if ( sint2 > 1._wp ) then tir = 1.0_wp return elseif ( costt == 1._wp ) then tir = 0._wp return else sint2 = ( n1 / n2 ) * sintt cost2 = sqrt ( 1._wp - sint2 * sint2 ) f1 = abs (( n1 * costt - n2 * cost2 ) / ( n1 * costt + n2 * cost2 )) ** 2 f2 = abs (( n1 * cost2 - n2 * costt ) / ( n1 * cost2 + n2 * costt )) ** 2 tir = 0.5_wp * ( f1 + f2 ) if ( ieee_is_nan ( tir ) . or . tir > 1._wp . or . tir < 0._wp ) print * , 'TIR: ' , tir , f1 , f2 , costt , sintt , cost2 , sint2 return end if end function fresnel end module surfaces","tags":"","loc":"sourcefile/surfaces.f90.html"},{"title":"setup.f90 – signedMCRT","text":"Contents Modules setupMod Source Code setup.f90 Source Code module setupMod !! This file sets up some simulations variables and assigns the geometry for the simulation. use constants , only : wp use tomlf implicit none private public :: setup_simulation , dealloc_array , directory contains subroutine setup_simulation ( sdfarray , dict ) !! Read in parameters !! Setup up various simulation parameters and routines use sdfs , only : sdf use setupGeometry use sim_state_mod , only : settings => state use vector_class !> dictionary used to store metadata type ( toml_table ), optional , intent ( INOUT ) :: dict !> output array of geometry type ( sdf ), allocatable , intent ( OUT ) :: sdfarray (:) !allocate and set arrays to 0 call alloc_array ( settings % grid % nxg , settings % grid % nyg , settings % grid % nzg ) call zarray () ! setup geometry using SDFs select case ( settings % experiment ) case ( \"logo\" ) sdfarray = setup_logo () case ( \"omg\" ) sdfarray = setup_omg_sdf () case ( \"scat_test\" ) sdfarray = setup_scat_test ( dict ) case ( \"scat_test2\" ) sdfarray = setup_scat_test2 ( dict ) case ( \"aptran\" ) sdfarray = setup_sphere () case ( \"vessels\" ) sdfarray = get_vessels () case ( \"sphere_scene\" ) sdfarray = setup_sphere_scene ( dict ) case ( \"test_egg\" ) sdfarray = setup_egg () case default error stop \"no such routine\" end select end subroutine setup_simulation subroutine directory () !! subroutine defines vars to hold paths to various folders use constants , only : homedir , fileplace , resdir character ( len = 256 ) :: cwd logical :: dataExists , jmeanExists , depositExists , detectorsExists , phasorExists !get current working directory call get_environment_variable ( 'PWD' , cwd ) ! get 'home' dir from cwd homedir = trim ( cwd ) ! get data dir fileplace = trim ( homedir ) // '/data/' !check if data directory and subdirectories exists. if not create it #ifdef __GFORTRAN__ inquire ( file = trim ( fileplace ) // \"/.\" , exist = dataExists ) inquire ( file = trim ( fileplace ) // \"/jmean/.\" , exist = jmeanExists ) inquire ( file = trim ( fileplace ) // \"/deposit/.\" , exist = depositExists ) inquire ( file = trim ( fileplace ) // \"/detectors/.\" , exist = detectorsExists ) inquire ( file = trim ( fileplace ) // \"/phasor/.\" , exist = phasorExists ) #elif __INTEL_COMPILER inquire ( directory = trim ( fileplace ), exist = dataExists ) inquire ( directory = trim ( fileplace ) // \"/jmean\" , exist = jmeanExists ) inquire ( directory = trim ( fileplace ) // \"/deposit\" , exist = depositExists ) inquire ( directory = trim ( fileplace ) // \"/detectors\" , exist = detectorsExists ) inquire ( directory = trim ( fileplace ) // \"/phasor\" , exist = phasorExists ) #else error stop \"Compiler not supported!\" #endif if (. not . dataExists ) then call create_directory ( \"\" , dataExists , \"\" , . false .) call create_directory ( \"jmean/\" , jmeanExists , \"data/\" , . false .) call create_directory ( \"deposit/\" , depositExists , \"data/\" , . false .) call create_directory ( \"detectors/\" , detectorsExists , \"data/\" , . false .) call create_directory ( \"phasor/\" , phasorExists , \"data/\" , . false .) else call create_directory ( \"jmean/\" , jmeanExists , \"data/\" , . true .) call create_directory ( \"deposit/\" , depositExists , \"data/\" , . true .) call create_directory ( \"detectors/\" , detectorsExists , \"data/\" , . true .) call create_directory ( \"phasor/\" , phasorExists , \"data/\" , . true .) end if ! get res dir resdir = trim ( homedir ) // '/res/' end subroutine directory subroutine create_directory ( name , flag , appendname , newline ) !! create directories if they don't exist use constants , only : fileplace character ( * ), intent ( in ) :: name , appendname logical , intent ( in ) :: flag logical , optional , intent ( in ) :: newline character ( len = :), allocatable :: mkdirCMD if (. not . flag ) then mkdirCMD = \"mkdir -p \" // trim ( fileplace ) // name call execute_command_line ( mkdirCMD ) ! output correct message for base data dir if ( len ( name ) == 0 ) then mkdirCMD = \"Created \" // appendname // \"data/\" else mkdirCMD = \"Created \" // appendname // name end if if ( newline ) mkdirCMD = mkdirCMD // new_line ( \"a\" ) print * , mkdirCMD end if end subroutine create_directory subroutine zarray !! zero data arrays use iarray !sets all arrays to zer phasor = 0._wp phasorGLOBAL = 0._wp jmean = 0._wp jmeanGLOBAL = 0._wp absorb = 0.0_wp absorbGLOBAL = 0.0_wp end subroutine zarray subroutine alloc_array ( nxg , nyg , nzg ) !! subroutine allocates allocatable arrays use iarray !> grid size integer , intent ( IN ) :: nxg , nyg , nzg allocate ( phasor ( nxg , nyg , nzg ), phasorGLOBAL ( nxg , nyg , nzg )) allocate ( jmean ( nxg , nyg , nzg ), jmeanGLOBAL ( nxg , nyg , nzg )) allocate ( absorb ( nxg , nyg , nzg ), absorbGLOBAL ( nxg , nyg , nzg )) end subroutine alloc_array subroutine dealloc_array () !! deallocate data arrays use iarray deallocate ( jmean ) deallocate ( jmeanGLOBAL ) deallocate ( absorb ) deallocate ( absorbGLOBAL ) deallocate ( phasor ) deallocate ( phasorGLOBAL ) end subroutine dealloc_array end module setupMod","tags":"","loc":"sourcefile/setup.f90.html"},{"title":"mat_class.f90 – signedMCRT","text":"Contents Modules mat_class Source Code mat_class.f90 Source Code module mat_class !! Matrix class module. Defines a matrix type (4x4 matrix) and associated operations on matrices and other types. use constants , only : wp use vec4_class !! not fully implmented matix class !! minimum implmented for neural sdf type type :: mat !> Matrix values real ( kind = wp ) :: vals ( 4 , 4 ) contains !> Overload for Division operator generic :: operator ( / ) => mat_div_scal !> Overload for Multiplication operator generic :: operator ( * ) => mat_mult_scal , scal_mult_mat , mat_mult_mat !> Overload for Addition operator generic :: operator ( + ) => mat_add_scal , scal_add_mat !> Overload for Subtraction operator generic :: operator ( - ) => mat_minus_scal procedure , pass ( a ), private :: mat_div_scal procedure , pass ( a ), private :: mat_mult_mat procedure , pass ( a ), private :: mat_mult_scal procedure , pass ( b ), private :: scal_mult_mat procedure , pass ( a ), private :: mat_add_scal procedure , pass ( b ), private :: scal_add_mat procedure , pass ( a ), private :: mat_minus_scal end type mat interface mat !! Intalise Matrix with 1D Array module procedure mat_init end interface mat private public :: mat , invert contains type ( mat ) function mat_init ( array ) !! Initalise matrix type from 1D array !> 1D array to initalise from. real ( kind = wp ) :: array ( 16 ) integer :: i , cnt cnt = 1 do i = 1 , 4 mat_init % vals (:, i ) = array ( cnt : cnt + 3 ) cnt = cnt + 4 end do end function mat_init type ( mat ) function mat_add_scal ( a , b ) !! Matrix + Scalar = Matrix !> Input Matrix class ( mat ), intent ( IN ) :: a !> Scalar to add real ( kind = wp ), intent ( IN ) :: b mat_add_scal % vals = a % vals + b end function mat_add_scal type ( mat ) function scal_add_mat ( a , b ) !! Scaler + Matrix !> Input Matrix class ( mat ), intent ( IN ) :: b !> Scalat to add real ( kind = wp ), intent ( IN ) :: a scal_add_mat % vals = b % vals + a end function scal_add_mat type ( mat ) function mat_minus_scal ( a , b ) !! Matrix - Scalar !> Input Matrix class ( mat ), intent ( IN ) :: a !> Scalar to subtract real ( kind = wp ), intent ( IN ) :: b mat_minus_scal % vals = a % vals - b end function mat_minus_scal type ( mat ) function mat_div_scal ( a , b ) !! Matrix / scalar !> Input Matrix class ( mat ), intent ( IN ) :: a !> Scalar to divide by real ( kind = wp ), intent ( IN ) :: b mat_div_scal % vals = a % vals / b end function mat_div_scal type ( mat ) function mat_mult_scal ( a , b ) !! Matrix * Scalar !> Input Matrix class ( mat ), intent ( IN ) :: a !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: b mat_mult_scal % vals = a % vals * b end function mat_mult_scal type ( mat ) function scal_mult_mat ( a , b ) !! Matrix * Scalar !> Input Matrix class ( mat ), intent ( IN ) :: b !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: a scal_mult_mat % vals = b % vals * a end function scal_mult_mat type ( vec4 ) function mat_mult_mat ( a , b ) !! Matrix * vec4 use vec4_class !> Input Matrix class ( mat ), intent ( IN ) :: a !> Vec4 to multiply by type ( vec4 ), intent ( IN ) :: b real ( kind = wp ) :: tmp ( 4 ) tmp = matmul ( a % vals , [ b % x , b % y , b % z , b % p ]) mat_mult_mat = vec4 ( tmp ( 1 ), tmp ( 2 ), tmp ( 3 ), tmp ( 4 )) end function mat_mult_mat pure function invert ( A ) result ( B ) !! Performs a direct calculation of the inverse of a 4×4 matrix. !! from http://fortranwiki.org/fortran/show/Matrix+inversion !> Input Matric real ( kind = wp ), intent ( in ) :: A ( 4 , 4 ) real ( kind = wp ) :: B ( 4 , 4 ) ! Inverse matrix real ( kind = wp ) :: detinv ! Calculate the inverse determinant of the matrix detinv = & 1._wp / ( A ( 1 , 1 ) * ( A ( 2 , 2 ) * ( A ( 3 , 3 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 3 )) + & A ( 2 , 3 ) * ( A ( 3 , 4 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 2 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 2 )))& - A ( 1 , 2 ) * ( A ( 2 , 1 ) * ( A ( 3 , 3 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 3 )) + & A ( 2 , 3 ) * ( A ( 3 , 4 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 1 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 1 )))& + A ( 1 , 3 ) * ( A ( 2 , 1 ) * ( A ( 3 , 2 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 2 )) + & A ( 2 , 2 ) * ( A ( 3 , 4 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 1 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 1 )))& - A ( 1 , 4 ) * ( A ( 2 , 1 ) * ( A ( 3 , 2 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 2 )) + & A ( 2 , 2 ) * ( A ( 3 , 3 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 3 )) + A ( 2 , 3 ) * ( A ( 3 , 1 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 1 )))) ! Calculate the inverse of the matrix B ( 1 , 1 ) = detinv * ( A ( 2 , 2 ) * ( A ( 3 , 3 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 3 )) + & A ( 2 , 3 ) * ( A ( 3 , 4 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 2 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 2 ))) B ( 2 , 1 ) = detinv * ( A ( 2 , 1 ) * ( A ( 3 , 4 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 4 )) + & A ( 2 , 3 ) * ( A ( 3 , 1 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 1 )) + A ( 2 , 4 ) * ( A ( 3 , 3 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 3 ))) B ( 3 , 1 ) = detinv * ( A ( 2 , 1 ) * ( A ( 3 , 2 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 2 )) + & A ( 2 , 2 ) * ( A ( 3 , 4 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 4 )) + A ( 2 , 4 ) * ( A ( 3 , 1 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 1 ))) B ( 4 , 1 ) = detinv * ( A ( 2 , 1 ) * ( A ( 3 , 3 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 3 )) + & A ( 2 , 2 ) * ( A ( 3 , 1 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 1 )) + A ( 2 , 3 ) * ( A ( 3 , 2 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 2 ))) B ( 1 , 2 ) = detinv * ( A ( 1 , 2 ) * ( A ( 3 , 4 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 4 )) + & A ( 1 , 3 ) * ( A ( 3 , 2 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 2 )) + A ( 1 , 4 ) * ( A ( 3 , 3 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 3 ))) B ( 2 , 2 ) = detinv * ( A ( 1 , 1 ) * ( A ( 3 , 3 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 3 )) + & A ( 1 , 3 ) * ( A ( 3 , 4 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 4 )) + A ( 1 , 4 ) * ( A ( 3 , 1 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 1 ))) B ( 3 , 2 ) = detinv * ( A ( 1 , 1 ) * ( A ( 3 , 4 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 4 )) + & A ( 1 , 2 ) * ( A ( 3 , 1 ) * A ( 4 , 4 ) - A ( 3 , 4 ) * A ( 4 , 1 )) + A ( 1 , 4 ) * ( A ( 3 , 2 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 2 ))) B ( 4 , 2 ) = detinv * ( A ( 1 , 1 ) * ( A ( 3 , 2 ) * A ( 4 , 3 ) - A ( 3 , 3 ) * A ( 4 , 2 )) + & A ( 1 , 2 ) * ( A ( 3 , 3 ) * A ( 4 , 1 ) - A ( 3 , 1 ) * A ( 4 , 3 )) + A ( 1 , 3 ) * ( A ( 3 , 1 ) * A ( 4 , 2 ) - A ( 3 , 2 ) * A ( 4 , 1 ))) B ( 1 , 3 ) = detinv * ( A ( 1 , 2 ) * ( A ( 2 , 3 ) * A ( 4 , 4 ) - A ( 2 , 4 ) * A ( 4 , 3 )) + & A ( 1 , 3 ) * ( A ( 2 , 4 ) * A ( 4 , 2 ) - A ( 2 , 2 ) * A ( 4 , 4 )) + A ( 1 , 4 ) * ( A ( 2 , 2 ) * A ( 4 , 3 ) - A ( 2 , 3 ) * A ( 4 , 2 ))) B ( 2 , 3 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 4 ) * A ( 4 , 3 ) - A ( 2 , 3 ) * A ( 4 , 4 )) + & A ( 1 , 3 ) * ( A ( 2 , 1 ) * A ( 4 , 4 ) - A ( 2 , 4 ) * A ( 4 , 1 )) + A ( 1 , 4 ) * ( A ( 2 , 3 ) * A ( 4 , 1 ) - A ( 2 , 1 ) * A ( 4 , 3 ))) B ( 3 , 3 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 2 ) * A ( 4 , 4 ) - A ( 2 , 4 ) * A ( 4 , 2 )) + & A ( 1 , 2 ) * ( A ( 2 , 4 ) * A ( 4 , 1 ) - A ( 2 , 1 ) * A ( 4 , 4 )) + A ( 1 , 4 ) * ( A ( 2 , 1 ) * A ( 4 , 2 ) - A ( 2 , 2 ) * A ( 4 , 1 ))) B ( 4 , 3 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 3 ) * A ( 4 , 2 ) - A ( 2 , 2 ) * A ( 4 , 3 )) + & A ( 1 , 2 ) * ( A ( 2 , 1 ) * A ( 4 , 3 ) - A ( 2 , 3 ) * A ( 4 , 1 )) + A ( 1 , 3 ) * ( A ( 2 , 2 ) * A ( 4 , 1 ) - A ( 2 , 1 ) * A ( 4 , 2 ))) B ( 1 , 4 ) = detinv * ( A ( 1 , 2 ) * ( A ( 2 , 4 ) * A ( 3 , 3 ) - A ( 2 , 3 ) * A ( 3 , 4 )) + & A ( 1 , 3 ) * ( A ( 2 , 2 ) * A ( 3 , 4 ) - A ( 2 , 4 ) * A ( 3 , 2 )) + A ( 1 , 4 ) * ( A ( 2 , 3 ) * A ( 3 , 2 ) - A ( 2 , 2 ) * A ( 3 , 3 ))) B ( 2 , 4 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 3 ) * A ( 3 , 4 ) - A ( 2 , 4 ) * A ( 3 , 3 )) + & A ( 1 , 3 ) * ( A ( 2 , 4 ) * A ( 3 , 1 ) - A ( 2 , 1 ) * A ( 3 , 4 )) + A ( 1 , 4 ) * ( A ( 2 , 1 ) * A ( 3 , 3 ) - A ( 2 , 3 ) * A ( 3 , 1 ))) B ( 3 , 4 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 4 ) * A ( 3 , 2 ) - A ( 2 , 2 ) * A ( 3 , 4 )) + & A ( 1 , 2 ) * ( A ( 2 , 1 ) * A ( 3 , 4 ) - A ( 2 , 4 ) * A ( 3 , 1 )) + A ( 1 , 4 ) * ( A ( 2 , 2 ) * A ( 3 , 1 ) - A ( 2 , 1 ) * A ( 3 , 2 ))) B ( 4 , 4 ) = detinv * ( A ( 1 , 1 ) * ( A ( 2 , 2 ) * A ( 3 , 3 ) - A ( 2 , 3 ) * A ( 3 , 2 )) + & A ( 1 , 2 ) * ( A ( 2 , 3 ) * A ( 3 , 1 ) - A ( 2 , 1 ) * A ( 3 , 3 )) + A ( 1 , 3 ) * ( A ( 2 , 1 ) * A ( 3 , 2 ) - A ( 2 , 2 ) * A ( 3 , 1 ))) end function invert end module mat_class ! Program p ! use mat_class ! use vec4_class ! implicit none ! real(kind=wp) :: array(16) ! type(mat) :: m ! type(vec4) :: v4 ! v4 = vec4(1., 1., 1., 1.) ! array = [1., 1., 1., 1., 2., 2., 2., 2., 3., 3., 3., 3., 4., 4., 4., 4.] ! m = mat(array) ! write(*,\"(4f9.5)\")m%vals ! m = m + 1. ! print*,\" \" ! write(*,\"(4f9.5)\")m%vals ! m = 1. + m ! print*,\" \" ! write(*,\"(4f9.5)\")m%vals ! m = m - 2. ! print*,\" \" ! write(*,\"(4f9.5)\")m%vals ! m = m / 2. ! print*,\" \" ! write(*,\"(4f9.5)\")m%vals ! m = m * 2. ! print*,\" \" ! write(*,\"(4f9.5)\")m%vals ! ! m = 2. * m ! ! print*,\" \" ! ! write(*,\"(4f9.5)\")m%vals ! v4 = m * v4 ! print*,\" \" ! write(*,\"(4f9.5)\")v4 ! end program p","tags":"","loc":"sourcefile/mat_class.f90.html"},{"title":"historyStack.f90 – signedMCRT","text":"Contents Modules historyStack Source Code historyStack.f90 Source Code module historyStack !! Module contains the history stack type which stores the history of positions of a photon and th I/O routines !! not fully implmented use constants , only : wp use vec4_class , only : vec4 implicit none type :: history_stack_t type ( vec4 ), allocatable :: data (:) integer :: size , vertex_counter , edge_counter character ( len = :), allocatable :: filename , type contains procedure :: pop => histpop_fn procedure :: push => histpush_sub procedure :: peek => histpeek_fn procedure :: empty => histempty_fn procedure :: zero => histzero_sub procedure :: write => histwrite_sub procedure :: finish => histfinish_sub end type history_stack_t interface history_stack_t module procedure init_historyStack end interface integer , parameter :: block_size = 32 private public :: history_stack_t contains type ( history_stack_t ) function init_historyStack ( filename , id ) use utils , only : str use constants , only : fileplace character ( * ), intent ( in ) :: filename integer , intent ( in ) :: id character ( len = :), allocatable :: new_filename integer :: idx logical :: res idx = index ( filename , \".\" ) new_filename = filename ( 1 : idx - 1 ) // \"_\" // str ( id , 3 ) // filename ( idx :) init_historyStack % filename = new_filename if ( index ( new_filename , \"obj\" ) /= 0 ) then init_historyStack % type = \"obj\" elseif ( index ( new_filename , \"ply\" ) /= 0 ) then init_historyStack % type = \"ply\" elseif ( index ( new_filename , \"json\" ) /= 0 ) then init_historyStack % type = \"json\" else error stop \"Unsupported filetype for track History!\" end if inquire ( file = trim ( fileplace ) // new_filename , exist = res ) if ( res ) then print * , \"Deleting existing trackHistory files!\" call execute_command_line ( \"rm \" // trim ( fileplace ) // new_filename ) call execute_command_line ( \"rm \" // trim ( fileplace ) // \"scalars000.dat\" ) call execute_command_line ( \"rm \" // trim ( fileplace ) // new_filename // \"2\" ) end if init_historyStack % size = 0 init_historyStack % vertex_counter = 0 init_historyStack % edge_counter = 0 end function init_historyStack type ( vec4 ) function histpop_fn ( this ) class ( history_stack_t ) :: this if ( this % size == 0 . or . . not . allocated ( this % data )) then histpop_fn = vec4 ( - 9 9._wp , - 9 9._wp , - 9 9._wp , - 9 9._wp ) return end if histpop_fn = this % data ( this % size ) this % size = this % size - 1 end function histpop_fn subroutine histpush_sub ( this , val ) class ( history_stack_t ) :: this type ( vec4 ), intent ( in ) :: val type ( vec4 ), allocatable :: tmp (:) if (. not . allocated ( this % data ) . or . size ( this % data ) == 0 ) then !allocate space if not yet allocated allocate ( this % data ( block_size )) elseif ( this % size == size ( this % data )) then allocate ( tmp ( size ( this % data ) + block_size )) tmp ( 1 : this % size ) = this % data call move_alloc ( tmp , this % data ) end if this % size = this % size + 1 this % data ( this % size ) = val end subroutine histpush_sub type ( vec4 ) function histpeek_fn ( this ) class ( history_stack_t ) :: this if ( this % size == 0 . or . . not . allocated ( this % data )) then histpeek_fn = vec4 ( - 9 9._wp , - 9 9._wp , - 9 9._wp , - 9 9._wp ) return end if histpeek_fn = this % data ( this % size ) end function histpeek_fn logical function histempty_fn ( this ) class ( history_stack_t ) :: this histempty_fn = ( this % size == 0 . or . . not . allocated ( this % data )) end function histempty_fn subroutine histzero_sub ( this ) class ( history_stack_t ) :: this if ( allocated ( this % data )) deallocate ( this % data ) this % size = 0 end subroutine histzero_sub subroutine histwrite_sub ( this ) class ( history_stack_t ) :: this select case ( this % type ) case ( \"obj\" ) call obj_writer ( this ) case ( \"ply\" ) call ply_writer ( this ) case ( \"json\" ) call json_writer ( this ) case default error stop \"No such output type \" // this % type end select end subroutine histwrite_sub subroutine histfinish_sub ( this ) use constants , only : fileplace use utils , only : str class ( history_stack_t ) :: this integer :: u select case ( trim ( this % type )) case ( \"obj\" ) call execute_command_line ( \"cat \" // trim ( fileplace ) // this % filename // \"2 >> \" // trim ( fileplace ) // this % filename ) case ( \"ply\" ) ! this is the easiest way to edit the vertex count as we don't know how many photons we will track when writing the header. ! this saves storing all photons data in RAM for duration of simulation. ! taken from: https://stackoverflow.com/a/11145362 call execute_command_line ( \"sed -i '3s#.*#element vertex \" // str ( this % vertex_counter ) // \"#' \" // trim ( fileplace ) // this % filename ) call execute_command_line ( \"sed -i '7s#.*#element edge \" // str ( this % edge_counter ) // \"#' \" // trim ( fileplace ) // this % filename ) call execute_command_line ( \"cat \" // trim ( fileplace ) // this % filename // \"2 >> \" // trim ( fileplace ) // this % filename ) case ( \"json\" ) open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"old\" , position = \"append\" ) write ( u , \"(a)\" ) \"}\" close ( u ) case default error stop \"No such output type \" // this % type end select end subroutine histfinish_sub subroutine obj_writer ( this ) use constants , only : fileplace use utils , only : str use omp_lib type ( history_stack_t ), intent ( inout ) :: this type ( vec4 ) :: v integer :: u , io , id , counter , ioi logical :: res id = 0 inquire ( file = trim ( fileplace ) // this % filename , exist = res ) if ( res ) then open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"old\" , position = \"append\" ) open ( newunit = io , file = trim ( fileplace ) // this % filename // \"2\" , status = \"old\" , position = \"append\" ) open ( newunit = ioi , file = trim ( fileplace ) // \"scalars\" // str ( id , 3 ) // \".dat\" , status = \"old\" , position = \"append\" ) else open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"new\" ) open ( newunit = io , file = trim ( fileplace ) // this % filename // \"2\" , status = \"new\" ) open ( newunit = ioi , file = trim ( fileplace ) // \"scalars\" // str ( id , 3 ) // \".dat\" , status = \"new\" ) end if v = this % pop () ! write lines if ( this % size >= 1 ) write ( io , \"(a)\" , advance = \"no\" ) \"l \" do counter = this % vertex_counter + 1 , this % vertex_counter + this % size , 2 write ( io , \"(2(i0,1x))\" , advance = \"no\" ) counter , counter + 1 end do close ( io ) !write vertices do while (. not . this % empty ()) v = this % pop () write ( u , \"(a,1x,3(es15.8e2,1x))\" ) \"v\" , v % x , v % y , v % z write ( ioi , \"(es15.8e2)\" ) v % p this % vertex_counter = this % vertex_counter + 1 end do close ( u ) close ( ioi ) end subroutine obj_writer subroutine ply_writer ( this ) use constants , only : fileplace use utils , only : str type ( history_stack_t ), intent ( inout ) :: this integer :: io , counter , i , u logical :: res type ( vec4 ) :: v inquire ( file = trim ( fileplace ) // this % filename , exist = res ) if ( res ) then open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"old\" , position = \"append\" ) else open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"new\" ) write ( u , \"(a)\" ) \"ply\" // new_line ( \"a\" ) // \"format ascii 1.0\" // new_line ( \"a\" ) // \"element vertex \" // str ( this % size ) write ( u , \"(a)\" ) \"property float x\" write ( u , \"(a)\" ) \"property float y\" write ( u , \"(a)\" ) \"property float z\" write ( u , \"(a)\" ) \"element edge\" write ( u , \"(a)\" ) \"property int vertex1\" write ( u , \"(a)\" ) \"property int vertex2\" write ( u , \"(a)\" ) \"end_header\" end if inquire ( file = trim ( fileplace ) // this % filename // \"2\" , exist = res ) if ( res ) then open ( newunit = io , file = trim ( fileplace ) // this % filename // \"2\" , status = \"old\" , position = \"append\" ) else open ( newunit = io , file = trim ( fileplace ) // this % filename // \"2\" , status = \"new\" ) end if counter = this % vertex_counter do i = 1 , this % size - 1 write ( io , \"(2(i0,1x))\" ) counter , counter + 1 counter = counter + 1 this % edge_counter = this % edge_counter + 1 end do close ( io ) do while (. not . this % empty ()) v = this % pop () write ( u , \"(3(es15.8e2,1x))\" ) v % x , v % y , v % z this % vertex_counter = this % vertex_counter + 1 end do close ( u ) end subroutine ply_writer subroutine json_writer ( this ) use constants , only : fileplace use utils , only : str type ( history_stack_t ), intent ( inout ) :: this logical :: res integer :: id , u integer , save :: counter = 0 type ( vec4 ) :: v id = 0 !omp_() if ( id == 0 ) then inquire ( file = trim ( fileplace ) // this % filename , exist = res ) if ( res ) then open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"old\" , position = \"append\" ) write ( u , \"(a)\" ) \",\" // new_line ( \"a\" ) // '\"' // str ( counter ) // '_' // str ( id ) // '\": ' // \"[\" else open ( newunit = u , file = trim ( fileplace ) // this % filename , status = \"new\" ) write ( u , \"(a)\" ) \"{\" // new_line ( \"a\" ) // '\"' // str ( counter ) // '_' // str ( id ) // '\": ' // \"[\" end if counter = counter + 1 do while (. not . this % empty ()) v = this % pop () if ( this % size /= 0 ) then write ( u , \"(a,3(es15.8e2,a))\" ) \"[\" , v % x , \",\" , v % y , \",\" , v % z , \"],\" else write ( u , \"(a,3(es15.8e2,a))\" ) \"[\" , v % x , \",\" , v % y , \",\" , v % z , \"]\" end if end do write ( u , \"(a)\" ) \"]\" close ( u ) end if end subroutine json_writer end module historyStack","tags":"","loc":"sourcefile/historystack.f90.html"},{"title":"vector_class.f90 – signedMCRT","text":"Contents Modules vector_class Source Code vector_class.f90 Source Code module vector_class !! Vector class module. Defines a vector type (x, y, z) and associated operations on vectors and other types. use constants , only : wp implicit none !> Vector class type :: vector !> vector components real ( kind = wp ) :: x , y , z contains !> Returns the magnitude of the vector procedure :: magnitude => magnitude !> Returns the length of the vector procedure :: length => length !> .dot. operator. Dot product generic :: operator (. dot .) => vec_dot_vec , vec_dot_mat !> .cross. operator. Cross product generic :: operator (. cross .) => vec_cross_vec !> Overloads the Division operator for vec3 generic :: operator ( / ) => vec_div_scal_r4 , vec_div_scal_r8 , vec_div_scal_int !> Overloads the Multiplication operator for vec3 generic :: operator ( * ) => vec_mult_vec , vec_mult_scal , scal_mult_vec !> Overloads the exponential operator for vec3 generic :: operator ( ** ) => vec_mult_exp_scal_int , vec_mult_exp_scal_r4 , vec_mult_exp_scal_r8 !> Overloads the Addition operator for vec3 generic :: operator ( + ) => vec_add_vec , vec_add_scal , scal_add_vec !> Overloads the Subtraction operator for vec3 generic :: operator ( - ) => vec_minus_vec , vec_minus_scal , scal_minus_vec !> Overloads the equal operator for vec3 generic :: operator ( == ) => vec_equal_vec procedure , pass ( a ), private :: vec_dot_vec procedure , pass ( a ), private :: vec_dot_mat procedure , pass ( a ), private :: vec_cross_vec procedure , pass ( a ), private :: vec_div_scal_r4 procedure , pass ( a ), private :: vec_div_scal_r8 procedure , pass ( a ), private :: vec_div_scal_int procedure , pass ( a ), private :: vec_mult_vec procedure , pass ( a ), private :: vec_mult_scal procedure , pass ( b ), private :: scal_mult_vec procedure , pass ( a ), private :: vec_mult_exp_scal_int procedure , pass ( a ), private :: vec_mult_exp_scal_r4 procedure , pass ( a ), private :: vec_mult_exp_scal_r8 procedure , pass ( a ), private :: vec_add_vec procedure , pass ( a ), private :: vec_add_scal procedure , pass ( b ), private :: scal_add_vec procedure , pass ( a ), private :: vec_minus_vec procedure , pass ( a ), private :: vec_minus_scal procedure , pass ( b ), private :: scal_minus_vec procedure , pass ( a ), private :: vec_equal_vec end type vector private public :: magnitude , vector , abs , length , max , nint , min interface nint !! Overload of the nint intrinsic for a vec3 module procedure nint_vec end interface nint interface abs !! Overload of the abs intrinsic for a vec3 module procedure abs_vec end interface abs interface max !! Overload of the max intrinsic for a vec3 module procedure max_vec module procedure maxval_vec end interface max interface min !! Overload of the min intrinsic for a vec3 module procedure min_vec module procedure minval_vec end interface min contains type ( vector ) pure elemental function vec_mult_exp_scal_int ( a , b ) !! vec3**scalar for integer scalar !> Input Vector class ( vector ), intent ( in ) :: a !> Input scalar integer , intent ( in ) :: b vec_mult_exp_scal_int = vector ( a % x ** b , a % y ** b , a % z ** b ) end function vec_mult_exp_scal_int type ( vector ) pure elemental function vec_mult_exp_scal_r4 ( a , b ) !! vec3**scalar for 32-bit float scalar use constants , only : sp !> Input Vector class ( vector ), intent ( in ) :: a !> Input scalar real ( kind = sp ), intent ( in ) :: b vec_mult_exp_scal_r4 = vector ( a % x ** b , a % y ** b , a % z ** b ) end function vec_mult_exp_scal_r4 type ( vector ) pure elemental function vec_mult_exp_scal_r8 ( a , b ) !! vec3**scalar for 64-bit float scalar use constants , only : dp !> Input Vector class ( vector ), intent ( in ) :: a !> Input scalar real ( kind = dp ), intent ( in ) :: b vec_mult_exp_scal_r8 = vector ( a % x ** b , a % y ** b , a % z ** b ) end function vec_mult_exp_scal_r8 logical pure elemental function vec_equal_vec ( a , b ) !! vec3 == vec3 !> Input vec3s class ( vector ), intent ( in ) :: a , b vec_equal_vec = . false . if ( a % x == b % x ) then if ( a % y == b % y ) then if ( a % z == b % z ) then vec_equal_vec = . true . end if end if end if end function vec_equal_vec type ( vector ) pure elemental function nint_vec ( this ) !! Overload the nint intrinsic for a vec3 elementwise !> Input vector type ( vector ), intent ( IN ) :: this nint_vec = vector ( real ( nint ( this % x ), kind = wp ), real ( nint ( this % y ), kind = wp ), real ( nint ( this % z ), kind = wp )) end function nint_vec type ( vector ) pure elemental function abs_vec ( this ) !! Calculate the absoulte of a vector elementwise !> Input vector type ( vector ), intent ( IN ) :: this abs_vec = vector ( abs ( this % x ), abs ( this % y ), abs ( this % z )) end function abs_vec type ( vector ) pure elemental function max_vec ( this , val ) !! Get the max value elementwise between a vec3 and a scalar !> Input vector type ( vector ), intent ( IN ) :: this !> Input max value real ( kind = wp ), intent ( IN ) :: val max_vec = vector ( max ( this % x , val ), max ( this % y , val ), max ( this % z , val )) end function max_vec type ( vector ) pure elemental function min_vec ( this , val ) !! Get the min value elementwise between a vec3 and a scalar !> Input vector type ( vector ), intent ( IN ) :: this !> Input minimum value real ( kind = wp ), intent ( IN ) :: val min_vec = vector ( min ( this % x , val ), min ( this % y , val ), min ( this % z , val )) end function min_vec real ( kind = wp ) pure elemental function maxval_vec ( this ) !! Get the max value in a vec3 !> Input vector type ( vector ), intent ( IN ) :: this maxval_vec = max ( this % x , this % y , this % z ) end function maxval_vec real ( kind = wp ) pure elemental function minval_vec ( this ) !! Get the min value in a vec3 !> Input vector type ( vector ), intent ( IN ) :: this minval_vec = min ( this % x , this % y , this % z ) end function minval_vec type ( vector ) pure elemental function vec_minus_vec ( a , b ) !! vec3 - vec3 !> Input vector class ( vector ), intent ( IN ) :: a !> vec3 to subtract type ( vector ), intent ( IN ) :: b vec_minus_vec = vector ( a % x - b % x , a % y - b % y , a % z - b % z ) end function vec_minus_vec type ( vector ) pure elemental function vec_add_scal ( a , b ) !! vec3 + scalar !> Input vector class ( vector ), intent ( IN ) :: a !> Scalar to add real ( kind = wp ), intent ( IN ) :: b vec_add_scal = vector ( a % x + b , a % y + b , a % z + b ) end function vec_add_scal type ( vector ) pure elemental function scal_add_vec ( a , b ) !! vec3 + scalar !> Input vector class ( vector ), intent ( IN ) :: b !> Scalar to add real ( kind = wp ), intent ( IN ) :: a scal_add_vec = vector ( b % x + a , b % y + a , b % z + a ) end function scal_add_vec type ( vector ) pure elemental function vec_minus_scal ( a , b ) !! vec3 - scalar !> Input vector class ( vector ), intent ( IN ) :: a !> Scalar to subtract real ( kind = wp ), intent ( IN ) :: b vec_minus_scal = vector ( a % x - b , a % y - b , a % z - b ) end function vec_minus_scal type ( vector ) pure elemental function scal_minus_vec ( a , b ) !! scalar - vec3 !> Input vector class ( vector ), intent ( IN ) :: b !> Scalar to subtract from real ( kind = wp ), intent ( IN ) :: a scal_minus_vec = vector ( a - b % x , a - b % y , a - b % z ) end function scal_minus_vec type ( vector ) pure elemental function vec_add_vec ( a , b ) !! vec3 + vec3 !> Input vector class ( vector ), intent ( IN ) :: a !> Vec3 to add type ( vector ), intent ( IN ) :: b vec_add_vec = vector ( a % x + b % x , a % y + b % y , a % z + b % z ) end function vec_add_vec pure elemental function vec_dot_vec ( a , b ) result ( dot ) !! vec3 . vec3 !> Input vec3 class ( vector ), intent ( IN ) :: a !> vec3 to dot type ( vector ), intent ( IN ) :: b real ( kind = wp ) :: dot dot = ( a % x * b % x ) + ( a % y * b % y ) + ( a % z * b % z ) end function vec_dot_vec pure function vec_dot_mat ( a , b ) result ( dot ) !! vec3 . matrix !> Input vec3 class ( vector ), intent ( IN ) :: a !> Matrix to dot with real ( kind = wp ), intent ( IN ) :: b ( 4 , 4 ) type ( vector ) :: dot dot % x = b ( 1 , 1 ) * a % x + b ( 2 , 1 ) * a % y + b ( 3 , 1 ) * a % z + b ( 4 , 1 ) * 1. dot % y = b ( 1 , 2 ) * a % x + b ( 2 , 2 ) * a % y + b ( 3 , 2 ) * a % z + b ( 4 , 2 ) * 1. dot % z = b ( 1 , 3 ) * a % x + b ( 2 , 3 ) * a % y + b ( 3 , 3 ) * a % z + b ( 4 , 3 ) * 1. end function vec_dot_mat pure elemental function vec_cross_vec ( a , b ) result ( cross ) !! vec3 x vec3 !> Input vector class ( vector ), intent ( in ) :: a !> vec3 to cross with type ( vector ), intent ( in ) :: b type ( vector ) :: cross cross % x = a % y * b % z - a % z * b % y cross % y = - a % x * b % z + a % z * b % x cross % z = a % x * b % y - a % y * b % x end function vec_cross_vec type ( vector ) pure elemental function vec_mult_vec ( a , b ) !! vec3 * vec3 elementwise !> input vec3 class ( vector ), intent ( IN ) :: a !> vec3 to multiply by type ( vector ), intent ( IN ) :: b vec_mult_vec = vector ( a % x * b % x , a % y * b % y , a % z * b % z ) end function vec_mult_vec type ( vector ) pure elemental function vec_mult_scal ( a , b ) !! vec3 * scalar elementwise !> input vec3 class ( vector ), intent ( IN ) :: a !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: b vec_mult_scal = vector ( a % x * b , a % y * b , a % z * b ) end function vec_mult_scal type ( vector ) pure elemental function scal_mult_vec ( a , b ) !! Scalar * vec3 elementwise !> input vec3 class ( vector ), intent ( IN ) :: b !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: a scal_mult_vec = vector ( a * b % x , a * b % y , a * b % z ) end function scal_mult_vec type ( vector ) pure elemental function vec_div_scal_r4 ( a , b ) !! vec3 / scalar elementwise. Scalar is a 32-bit float use constants , only : sp !> input vec3 class ( vector ), intent ( IN ) :: a !> Scalar to divide by real ( kind = sp ), intent ( IN ) :: b vec_div_scal_r4 = vector ( a % x / b , a % y / b , a % z / b ) end function vec_div_scal_r4 type ( vector ) pure elemental function vec_div_scal_r8 ( a , b ) !! vec3 / scalar elementwise. Scalar is a 64-bit float use constants , only : dp !> input vec3 class ( vector ), intent ( IN ) :: a !> Scalar to divide by real ( kind = dp ), intent ( IN ) :: b vec_div_scal_r8 = vector ( a % x / b , a % y / b , a % z / b ) end function vec_div_scal_r8 type ( vector ) pure elemental function vec_div_scal_int ( a , b ) !! vec3 / scalar elementwise. Scalar is an integer !> input vec3 class ( vector ), intent ( IN ) :: a !> Scalar to divide by integer , intent ( IN ) :: b vec_div_scal_int = vector ( a % x / real ( b , kind = wp ), a % y / real ( b , kind = wp ), a % z / real ( b , kind = wp )) end function vec_div_scal_int type ( vector ) pure elemental function magnitude ( this ) !! Returns the magnitude of a vec3 class ( vector ), intent ( in ) :: this real ( kind = wp ) :: tmp tmp = this % length () magnitude = this / tmp end function magnitude real ( kind = wp ) pure elemental function length ( this ) !! Returns the length of a vec3 class ( vector ), intent ( in ) :: this length = sqrt ( this % x ** 2 + this % y ** 2 + this % z ** 2 ) end function length end Module vector_class","tags":"","loc":"sourcefile/vector_class.f90.html"},{"title":"sim_state.f90 – signedMCRT","text":"Contents Modules sim_state_mod Source Code sim_state.f90 Source Code module sim_state_mod !! This module defines the setting_t type which holds simulation metadata: use gridMod , only : cart_grid implicit none type :: settings_t !> Number of photons to run integer :: nphotons !> initial seed for random number generator integer :: iseed !> Size of the voxel grid to render SDFs to integer :: render_size ( 3 ) !> Name of experiment/simulation character ( len = :), allocatable :: experiment !> Name of fluence output file character ( len = :), allocatable :: outfile !> Name of voxel render file character ( len = :), allocatable :: renderfile !> Light source used character ( len = :), allocatable :: source !> Name of photon history file character ( len = :), allocatable :: historyFilename !> Name of absoprtion output file character ( len = :), allocatable :: outfile_absorb !> Cart_grid type type ( cart_grid ) :: grid !> Boolean to indicate whether to render SDF to voxels or not. logical :: render_geom !> Boolean to indicate whether to use TEV as debug viewer. logical :: tev !> Boolean to indicate whether to use overwrite datafiles if they have the same name. logical :: overwrite !> Boolean to indicate whether to store history of photons positions logical :: trackHistory !> Boolean to indicate whether to store absoption data. logical :: absorb end type settings_t !> global var that stores simulation state type ( settings_t ) :: state private public :: settings_t , state end module sim_state_mod","tags":"","loc":"sourcefile/sim_state.f90.html"},{"title":"writer.f90 – signedMCRT","text":"Contents Modules writer_mod Source Code writer.f90 Source Code module writer_mod !! This module defines all functions that write simulation data to the disk or pre-process data before writing. !! normalise_fluence. Normalises fluence by number of photons run and size of each voxel. **!Does not normalise by power!** !! write_fluence. Write out fluence in either raw or nrrd format. Default is nrrd. !! write_detected_photons. Write out photons detected by detectors. !! Changes should only be made here if there is a bug or new data types need to be written to disk (phase information) or new file format is needed. use constants , only : wp implicit none interface nrrd_write module procedure write_3d_r8_nrrd , write_3d_r4_nrrd end interface nrrd_write interface raw_write module procedure write_3d_r8_raw , write_3d_r4_raw end interface raw_write private public :: normalise_fluence , write_data , write_detected_photons contains subroutine normalise_fluence ( grid , array , nphotons ) !! normalise fluence in the Lucy 1999 way use gridMod use constants , only : sp !> grid class type ( cart_grid ), intent ( in ) :: grid !> array to normalise real ( kind = sp ), intent ( inout ) :: array (:, :, :) !> number of photons run integer , intent ( in ) :: nphotons real ( kind = wp ) :: xmax , ymax , zmax integer :: nxg , nyg , nzg nxg = grid % nxg nyg = grid % nyg nzg = grid % nzg xmax = grid % xmax ymax = grid % ymax zmax = grid % zmax array = array * (( 2._sp * xmax * 2._sp * ymax ) / ( nphotons * ( 2._sp * xmax / nxg ) * ( 2._sp * ymax / nyg ) * ( 2._sp * zmax / nzg ))) end subroutine normalise_fluence subroutine write_detected_photons ( dects ) use detectors use constants , only : fileplace use utils , only : str type ( dect_array ), intent ( in ) :: dects (:) integer :: i , j , u character ( len = :), allocatable :: hdr do i = 1 , size ( dects ) open ( newunit = u , file = trim ( fileplace ) // \"detectors/detector_\" // str ( i ) // \".dat\" ) associate ( x => dects ( i )% p ) select type ( x ) type is ( circle_dect ) ! hdr = \"# pos, layer, nbins, bin_wid, radius\"//new_line(\"a\")//str(x%pos)//\",\"//str(x%layer)//\",\"//str(x%nbins)//\",\"//str(x%bin_wid)//\",\"//str(x%radius) ! write(u, \"(a)\")hdr ! write(u, \"(a)\")\"#data:\" do j = 1 , x % nbins write ( u , * ) real ( j , kind = wp ) * x % bin_wid , x % data ( j ) end do type is ( annulus_dect ) ! hdr = \"#pos, layer, nbins, bin_wid, radius1, radius2\"//new_line(\"a\")//str(x%pos)//\",\"//str(x%layer)//\",\"//str(x%nbins)//\",\"//str(x%bin_wid)//\",\"//str(x%r1)//\",\"//str(x%r2) type is ( camera ) print * , \"Warning not yet implmented!\" end select end associate close ( u ) end do end subroutine write_detected_photons subroutine write_data ( array , filename , state , dict , overwrite ) !! routine automatically selects which way to write out results based upon file extension use sim_state_mod , only : settings_t use tomlf , only : toml_table , get_value use constants , only : sp !> simulation state type ( settings_t ), intent ( IN ) :: state !> array to write out real ( kind = sp ), intent ( IN ) :: array (:,:,:) !> filename to save array as character ( * ), intent ( IN ) :: filename !> dictionary of metadata type ( toml_table ), optional , intent ( INOUT ) :: dict !> overwrite flag logical , optional , intent ( IN ) :: overwrite Logical :: over_write integer :: pos if ( present ( overwrite )) then over_write = overwrite else over_write = state % overwrite end if pos = index ( filename , \".nrrd\" ) if ( pos > 0 ) then if ( present ( dict )) then call nrrd_write ( array , filename , over_write , dict ) else call nrrd_write ( array , filename , over_write ) end if return end if pos = index ( filename , \".raw\" ) if ( pos > 0 ) then call raw_write ( array , filename , over_write ) return end if pos = index ( filename , \".dat\" ) if ( pos > 0 ) then call raw_write ( array , filename , over_write ) return end if error stop \"File type not supported!\" end subroutine write_data subroutine write_3d_r8_raw ( array , filename , overwrite ) !! write 3D array of float64s to disk as raw binary data !> array to write to disk real ( kind = wp ), intent ( IN ) :: array (:, :, :) !> filename to save array as character ( * ), intent ( IN ) :: filename !> overwrite flag logical , intent ( IN ) :: overwrite integer :: u character ( len = :), allocatable :: file if ( check_file ( filename ) . and . . not . overwrite ) then file = get_new_file_name ( filename ) else file = filename end if open ( newunit = u , file = file , access = 'stream' , status = 'REPLACE' , form = 'unformatted' ) write ( u ) array close ( u ) end subroutine write_3d_r8_raw subroutine write_3d_r4_raw ( array , filename , overwrite ) !! write 3D array of float32's to disk as raw binary data use constants , only : sp !> array to write to disk real ( kind = sp ), intent ( IN ) :: array (:, :, :) !> filename to save array as character ( * ), intent ( IN ) :: filename !> overwrite flag logical , intent ( IN ) :: overwrite integer :: u character ( len = :), allocatable :: file if ( check_file ( filename ) . and . . not . overwrite ) then file = get_new_file_name ( filename ) else file = filename end if open ( newunit = u , file = file , access = 'stream' , status = 'REPLACE' , form = 'unformatted' ) write ( u ) array close ( u ) end subroutine write_3d_r4_raw function get_new_file_name ( file ) result ( res ) !! If file exits, get numeral to append to filename use utils , only : str !> file to be checked character ( len =* ), intent ( IN ) :: file character ( len = :), allocatable :: res integer :: pos , i i = 1 do pos = scan ( trim ( file ), \".\" , back = . true .) res = file ( 1 : pos - 1 ) // \" (\" // str ( i ) // \")\" // file ( pos :) if (. not . check_file ( res )) exit i = i + 1 end do end function get_new_file_name logical function check_file ( file ) result ( res ) !! Functional wrapper around inquire to check if file exits !> file to be checked character ( len =* ), intent ( IN ) :: file inquire ( file = trim ( file ), exist = res ) end function check_file subroutine write_hdr ( u , sizes , type ) !! write out header information for .nrrd file format use utils , only : str !> data dtype character ( * ), intent ( IN ) :: type !> file handle integer , intent ( IN ) :: u !> dimensions of data integer , intent ( IN ) :: sizes (:) character ( len = 100 ) :: string integer :: i string = \"\" do i = 1 , size ( sizes ) if ( i == 1 ) then string = str ( sizes ( i )) else string = trim ( string ) // \" \" // str ( sizes ( i )) end if end do write ( u , \"(A)\" ) \"NRRD0004\" write ( u , \"(A)\" ) \"type: \" // type write ( u , \"(A)\" ) \"dimension: \" // str ( size ( sizes )) write ( u , \"(A)\" ) \"sizes: \" // trim ( string ) write ( u , \"(A)\" ) \"space dimension: \" // str ( size ( sizes )) write ( u , \"(A)\" ) \"encoding: raw\" write ( u , \"(A)\" ) \"endian: little\" end subroutine write_hdr subroutine write_3d_r8_nrrd ( array , filename , overwrite , dict ) !! write 3D array of float64's to .nrrd fileformat use tomlf , only : toml_table , toml_dump , toml_error use iso_fortran_env , only : int32 , int64 , real32 , real64 use utils , only : str !> filename character ( * ), intent ( IN ) :: filename !> array to be written to disk real ( kind = wp ), intent ( IN ) :: array (:, :, :) !> dictionary of metadata type ( toml_table ), optional , intent ( INOUT ) :: dict !> overwrite flag logical , intent ( IN ) :: overwrite type ( toml_error ), allocatable :: error character ( len = :), allocatable :: file integer :: u if ( check_file ( filename ) . and . . not . overwrite ) then file = get_new_file_name ( filename ) else file = filename end if open ( newunit = u , file = file , form = \"formatted\" ) !to do fix precision call write_hdr ( u , [ size ( array , 1 ), size ( array , 2 ), size ( array , 3 )], \"double\" ) if ( present ( dict )) then call toml_dump ( dict , u , error ) end if write ( u , \"(A)\" ) new_line ( \"C\" ) close ( u ) open ( newunit = u , file = file , access = \"stream\" , form = \"unformatted\" , position = \"append\" ) write ( u ) array close ( u ) end subroutine write_3d_r8_nrrd subroutine write_3d_r4_nrrd ( array , filename , overwrite , dict ) !! write 3D array of float32's to .nrrd fileformat use tomlf , only : toml_table , toml_dump , toml_error use iso_fortran_env , only : int32 , int64 , real32 , real64 use utils , only : str use constants , only : sp !> filename character ( * ), intent ( IN ) :: filename !> array to be written to disk real ( kind = sp ), intent ( IN ) :: array (:, :, :) !> dictionary of metadata type ( toml_table ), optional , intent ( INOUT ) :: dict !> overwrite flag logical , intent ( IN ) :: overwrite type ( toml_error ), allocatable :: error character ( len = :), allocatable :: file integer :: u if ( check_file ( filename ) . and . . not . overwrite ) then file = get_new_file_name ( filename ) else file = filename end if open ( newunit = u , file = file , form = \"formatted\" ) !to do fix precision call write_hdr ( u , [ size ( array , 1 ), size ( array , 2 ), size ( array , 3 )], \"float\" ) if ( present ( dict )) then call toml_dump ( dict , u , error ) end if write ( u , \"(A)\" ) new_line ( \"C\" ) close ( u ) open ( newunit = u , file = file , access = \"stream\" , form = \"unformatted\" , position = \"append\" ) write ( u ) array close ( u ) end subroutine write_3d_r4_nrrd end module writer_mod","tags":"","loc":"sourcefile/writer.f90.html"},{"title":"kernelsMod.f90 – signedMCRT","text":"Contents Modules kernels Source Code kernelsMod.f90 Source Code module kernels !! Contains the main program and scattering loop. Calls all other routine to setup, run and break down the simulation. implicit none private public :: weight_scatter , pathlength_scatter , test_kernel contains !############################################################################### ! KERNELS subroutine weight_scatter ( input_file ) !Shared data use iarray use constants , only : wp , CHANCE , THRESHOLD !subroutines use detectors , only : dect_array use detector_mod , only : hit_t use historyStack , only : history_stack_t use inttau2 , only : tauint2 , update_voxels use photonMod , only : photon use piecewiseMod use random , only : ran2 , init_rng use sdfs , only : sdf use sim_state_mod , only : state use utils , only : pbar use vec4_class , only : vec4 use vector_class , only : vector !external deps use tev_mod , only : tevipc use tomlf , only : toml_table #ifdef _OPENMP use omp_lib #endif character ( len =* ), intent ( in ) :: input_file integer :: numproc , id , j , i type ( history_stack_t ) :: history type ( pbar ) :: bar type ( photon ) :: packet type ( toml_table ) :: dict real ( kind = wp ), allocatable :: distances (:), image (:,:,:) type ( hit_t ) :: hpoint type ( vector ) :: dir type ( dect_array ), allocatable :: dects (:) type ( sdf ), allocatable :: array (:) real ( kind = wp ) :: nscatt , start , weight_absorb type ( tevipc ) :: tev integer :: celli , cellj , cellk type ( spectrum_t ) :: spectrum call setup ( input_file , tev , dects , array , packet , spectrum , dict , distances , image , nscatt , start ) #ifdef _OPENMP !is state%seed private, i dont think so... !$omp parallel default(none) shared(dict, array, numproc, start, state, bar, jmean, tev, dects, spectrum)& !$omp& private(id, distances, image, dir, hpoint, history, weight_absorb, cellk, cellj, celli) & !$omp& reduction(+:nscatt) firstprivate(packet) numproc = omp_get_num_threads () id = omp_get_thread_num () if ( numproc > state % nphotons . and . id == 0 ) print * , \"Warning, simulation may be underministic due to low photon count!\" if ( state % trackHistory ) history = history_stack_t ( state % historyFilename , id ) #elif MPI !nothing #else numproc = 1 id = 0 if ( state % trackHistory ) history = history_stack_t ( state % historyFilename , id ) #endif if ( id == 0 ) print ( \"(a,I3.1,a)\" ), 'Photons now running on' , numproc , ' cores.' ! set seed for rnd generator. id to change seed for each process call init_rng ( spread ( state % iseed + id , 1 , 8 ), fwd = . true .) bar = pbar ( state % nphotons / 10 ) !$OMP BARRIER !$OMP do !loop over photons do j = 1 , state % nphotons if ( mod ( j , 10 ) == 0 ) call bar % progress () ! Release photon from point source call packet % emit ( spectrum , dict ) packet % step = 0 packet % id = id distances = 0._wp do i = 1 , size ( distances ) distances ( i ) = array ( i )% evaluate ( packet % pos ) if ( distances ( i ) > 0._wp ) distances ( i ) =- 99 9.0_wp end do packet % layer = minloc ( abs ( distances ), dim = 1 ) if ( state % trackHistory ) call history % push ( vec4 ( packet % pos , packet % step )) ! Find scattering location call tauint2 ( state % grid , packet , array ) do while (. not . packet % tflag ) if ( state % trackHistory ) call history % push ( vec4 ( packet % pos , packet % step )) weight_absorb = packet % weight * ( 1._wp - array ( packet % layer )% getAlbedo ()) packet % weight = packet % weight - weight_absorb call update_voxels ( state % grid , & packet % pos + vector ( state % grid % xmax , state % grid % ymax , state % grid % zmax ), celli , cellj , cellk ) if ( celli < 1 ) then packet % tflag = . true . exit end if if ( cellj < 1 ) then packet % tflag = . true . exit end if if ( cellk < 1 ) then packet % tflag = . true . exit end if !$omp atomic jmean ( celli , cellj , cellk ) = jmean ( celli , cellj , cellk ) + weight_absorb call packet % scatter ( array ( packet % layer )% gethgg (), array ( packet % layer )% getg2 (), dects ) if ( packet % weight < THRESHOLD ) then if ( ran2 () < CHANCE ) then packet % weight = packet % weight / CHANCE else packet % tflag = . true . exit end if end if ! !Find next scattering location call tauint2 ( state % grid , packet , array ) end do dir = vector ( packet % nxp , packet % nyp , packet % nzp ) hpoint = hit_t ( packet % pos , dir , packet % weight , packet % layer ) do i = 1 , size ( dects ) call dects ( i )% p % record_hit ( hpoint , history ) end do if ( id == 0 . and . mod ( j , 1000 ) == 0 ) then if ( state % tev ) then !$omp critical image = reshape ( jmean (:, 100 : 100 ,:), [ state % grid % nxg , state % grid % nzg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"I\" ], 0 , 0 , . false ., . false .) image = reshape ( jmean ( 100 : 100 ,:,:), [ state % grid % nyg , state % grid % nzg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"J\" ], 0 , 0 , . false ., . false .) image = reshape ( jmean (:,:, 100 : 100 ), [ state % grid % nxg , state % grid % nyg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"K\" ], 0 , 0 , . false ., . false .) !$omp end critical end if end if end do #ifdef _OPENMP !$OMP end do !$OMP end parallel #endif call finalise ( dict , dects , nscatt , start , history ) end subroutine weight_scatter subroutine pathlength_scatter ( input_file ) !Shared data use iarray use constants , only : wp !subroutines use detector_mod , only : hit_t use detectors , only : dect_array use historyStack , only : history_stack_t use inttau2 , only : tauint2 use photonMod , only : photon use piecewiseMod use random , only : ran2 , init_rng , seq use sdfs , only : sdf use sim_state_mod , only : state use utils , only : pbar use vec4_class , only : vec4 use vector_class , only : vector !external deps use tev_mod , only : tevipc use tomlf , only : toml_table #ifdef _OPENMP use omp_lib #endif character ( len =* ), intent ( in ) :: input_file integer :: numproc , id , j , i type ( history_stack_t ) :: history type ( pbar ) :: bar type ( photon ) :: packet type ( toml_table ) :: dict real ( kind = wp ), allocatable :: distances (:), image (:,:,:) type ( hit_t ) :: hpoint type ( vector ) :: dir type ( dect_array ), allocatable :: dects (:) type ( sdf ), allocatable :: array (:) real ( kind = wp ) :: ran , nscatt , start type ( tevipc ) :: tev type ( seq ) :: seqs ( 2 ) type ( spectrum_t ) :: spectrum call setup ( input_file , tev , dects , array , packet , spectrum , dict , distances , image , nscatt , start ) #ifdef _OPENMP !is state%seed private, i dont think so... !$omp parallel default(none) shared(dict, array, numproc, start, state, bar, jmean, phasor, tev, dects, spectrum)& !$omp& private(ran, id, distances, image, dir, hpoint, history, seqs) reduction(+:nscatt) firstprivate(packet) numproc = omp_get_num_threads () id = omp_get_thread_num () if ( numproc > state % nphotons . and . id == 0 ) print * , \"Warning, simulation may be underministic due to low photon count!\" if ( state % trackHistory ) history = history_stack_t ( state % historyFilename , id ) #elif MPI !nothing #else numproc = 1 id = 0 if ( state % trackHistory ) history = history_stack_t ( state % historyFilename , id ) #endif if ( id == 0 ) print ( \"(a,I3.1,a)\" ), 'Photons now running on' , numproc , ' cores.' ! set seed for rnd generator. id to change seed for each process call init_rng ( spread ( state % iseed + id , 1 , 8 ), fwd = . true .) seqs = [ seq (( id + 1 ) * ( state % nphotons / numproc ), 2 ),& seq (( id + 1 ) * ( state % nphotons / numproc ), 3 )] bar = pbar ( state % nphotons / 10 ) !$OMP BARRIER !$OMP do !loop over photons do j = 1 , state % nphotons if ( mod ( j , 10 ) == 0 ) call bar % progress () ! Release photon from point source call packet % emit ( spectrum , dict , seqs ) packet % step = 0 packet % id = id distances = 0._wp do i = 1 , size ( distances ) distances ( i ) = array ( i )% evaluate ( packet % pos ) if ( distances ( i ) > 0._wp ) distances ( i ) =- 99 9.0_wp end do packet % layer = minloc ( abs ( distances ), dim = 1 ) if ( state % trackHistory ) call history % push ( vec4 ( packet % pos , packet % step )) ! Find scattering location call tauint2 ( state % grid , packet , array ) do while (. not . packet % tflag ) if ( state % trackHistory ) call history % push ( vec4 ( packet % pos , packet % step )) ran = ran2 () if ( ran < array ( packet % layer )% getAlbedo ()) then !interacts with tissue call packet % scatter ( array ( packet % layer )% gethgg (), & array ( packet % layer )% getg2 (), dects ) nscatt = nscatt + 1 packet % step = packet % step + 1 else packet % tflag = . true . exit end if ! !Find next scattering location call tauint2 ( state % grid , packet , array ) end do dir = vector ( packet % nxp , packet % nyp , packet % nzp ) hpoint = hit_t ( packet % pos , dir , sqrt ( packet % pos % x ** 2 + packet % pos % y ** 2 ), packet % layer ) do i = 1 , size ( dects ) call dects ( i )% p % record_hit ( hpoint , history ) end do if ( id == 0 . and . mod ( j , 1000 ) == 0 ) then if ( state % tev ) then !$omp critical image = reshape ( jmean (:, 100 : 100 ,:), [ state % grid % nxg , state % grid % nzg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"I\" ], 0 , 0 , . false ., . false .) image = reshape ( phasor ( 100 : 100 ,:,:), [ state % grid % nyg , state % grid % nzg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"J\" ], 0 , 0 , . false ., . false .) image = reshape ( phasor (:,:, 100 : 100 ), [ state % grid % nxg , state % grid % nyg , 1 ]) call tev % update_image ( state % experiment , real ( image (:,:, 1 : 1 )), [ \"K\" ], 0 , 0 , . false ., . false .) !$omp end critical end if end if end do #ifdef _OPENMP !$OMP end do !$OMP end parallel #endif call finalise ( dict , dects , nscatt , start , history ) end subroutine pathlength_scatter subroutine test_kernel ( input_file , end_early ) !Shared data use iarray use constants , only : wp !subroutines use detectors , only : dect_array use historyStack , only : history_stack_t use inttau2 , only : tauint2 use photonMod , only : photon use piecewiseMod use random , only : ran2 , init_rng use sdfs , only : sdf use sim_state_mod , only : state use utils , only : pbar use vector_class , only : vector !external deps use tev_mod , only : tevipc use tomlf , only : toml_table #ifdef _OPENMP use omp_lib #endif character ( len =* ), intent ( in ) :: input_file integer :: numproc , id , j , i type ( history_stack_t ) :: history ! type(pbar) :: bar type ( photon ) :: packet type ( toml_table ) :: dict real ( kind = wp ), allocatable :: distances (:), image (:,:,:) type ( dect_array ), allocatable :: dects (:) type ( sdf ), allocatable :: array (:) real ( kind = wp ) :: ran , nscatt , start type ( tevipc ) :: tev type ( vector ) :: pos ( 4 ), pos2 ( 4 ) logical , intent ( in ) :: end_early type ( spectrum_t ) :: spectrum pos = vector ( 0.0_wp , 0.0_wp , 0.0_wp ) pos2 = vector ( 0.0_wp , 0.0_wp , 0.0_wp ) call setup ( input_file , tev , dects , array , packet , spectrum , dict , distances , image , nscatt , start ) numproc = 1 id = 0 if ( id == 0 ) print ( \"(a,I3.1,a)\" ), 'Photons now running on' , numproc , ' cores.' ! set seed for rnd generator. id to change seed for each process call init_rng ( spread ( state % iseed + id , 1 , 8 ), fwd = . true .) ! bar = pbar(state%nphotons/ 10) !loop over photons do j = 1 , state % nphotons ! if(mod(j, 10) == 0)call bar%progress() ! Release photon from point source call packet % emit ( spectrum , dict ) packet % step = 0 packet % id = id distances = 0._wp do i = 1 , size ( distances ) distances ( i ) = array ( i )% evaluate ( packet % pos ) if ( distances ( i ) > 0._wp ) distances ( i ) =- 99 9.0_wp end do packet % layer = minloc ( abs ( distances ), dim = 1 ) ! Find scattering location call tauint2 ( state % grid , packet , array ) do while (. not . packet % tflag ) ran = ran2 () if ( ran < array ( packet % layer )% getalbedo ()) then !interacts with tissue call packet % scatter ( array ( packet % layer )% gethgg (), & array ( packet % layer )% getg2 ()) nscatt = nscatt + 1 packet % step = packet % step + 1 if ( packet % step == 1 ) then pos ( 1 ) = pos ( 1 ) + packet % pos pos2 ( 1 ) = pos2 ( 1 ) + packet % pos ** 2 elseif ( packet % step == 2 ) then pos ( 2 ) = pos ( 2 ) + packet % pos pos2 ( 2 ) = pos2 ( 2 ) + packet % pos ** 2 elseif ( packet % step == 3 ) then pos ( 3 ) = pos ( 3 ) + packet % pos pos2 ( 3 ) = pos2 ( 3 ) + packet % pos ** 2 elseif ( packet % step == 4 ) then pos ( 4 ) = pos ( 4 ) + packet % pos pos2 ( 4 ) = pos2 ( 4 ) + packet % pos ** 2 else if ( end_early ) packet % tflag = . true . end if else packet % tflag = . true . exit end if ! !Find next scattering location call tauint2 ( state % grid , packet , array ) end do end do open ( newunit = j , file = \"positions.dat\" ) do i = 1 , 4 write ( j , * ) 1 0. * pos ( i )% x / state % nphotons , 1 0. * pos ( i )% y / state % nphotons , 1 0. * pos ( i )% z / state % nphotons end do do i = 1 , 4 write ( j , * ) 10 0. * pos2 ( i )% x / state % nphotons , 10 0. * pos2 ( i )% y / state % nphotons , 10 0. * pos2 ( i )% z / state % nphotons end do close ( j ) call finalise ( dict , dects , nscatt , start , history ) end subroutine test_kernel !#################################################################################################### ! Setup and break down helper routines subroutine setup ( input_file , tev , dects , array , packet , spectrum , dict , distances , image , nscatt , start ) !! setup simulation by reading in setting file, and setup variables to be used. !shared data use iarray use constants , only : wp !subroutines use detectors , only : dect_array use parse_mod , only : parse_params use photonMod , only : photon use random , only : init_rng use piecewiseMod use sdfs , only : sdf , render use sim_state_mod , only : state use setupMod , only : setup_simulation , directory use utils , only : get_time , print_time , str use vector_class , only : vector ! !external deps use tev_mod , only : tevipc , tev_init use tomlf , only : toml_table , toml_error !> Filename for toml settings to be used character ( * ), intent ( in ) :: input_file !> array of SDF objects that create the geometry type ( sdf ), allocatable , intent ( out ) :: array (:) !> array of photon detectors type ( dect_array ), allocatable , intent ( out ) :: dects (:) !> toml table of meta-data to be written to output files. type ( toml_table ), intent ( out ) :: dict !> handle for communicating with TEV type ( tevipc ), intent ( out ) :: tev !> photon that is to be simulated type ( photon ), intent ( out ) :: packet real ( kind = wp ), allocatable , intent ( out ) :: distances (:), image (:,:,:) real ( kind = wp ), intent ( out ) :: nscatt , start type ( spectrum_t ), intent ( out ) :: spectrum ! mpi/mp variables integer :: id real ( kind = wp ) :: chance , threshold type ( toml_error ), allocatable :: error chance = 1._wp / 1 0._wp threshold = 1e-6_wp call directory () dict = toml_table () call parse_params ( \"res/\" // trim ( input_file ), packet , dects , spectrum , dict , error ) if ( allocated ( error )) then print * , error % message stop 1 end if allocate ( image ( state % grid % nxg , state % grid % nzg , 1 )) call display_settings ( state , input_file , packet , \"Pathlength\" ) if ( state % tev ) then !init TEV link tev = tevipc () call tev % close_image ( state % experiment ) call tev % create_image ( state % experiment , state % grid % nxg , state % grid % nzg , [ \"I\" , \"J\" , \"K\" ], . true .) end if nscatt = 0._wp call init_rng ( spread ( state % iseed + 0 , 1 , 8 ), fwd = . true .) call setup_simulation ( array , dict ) ! render geometry to voxel format for debugging if ( state % render_geom ) then print * , \"Rendering geometry to file\" call render ( array , state ) end if allocate ( distances ( size ( array ))) start = get_time () id = 0 if ( id == 0 ) then print * , '# of photons to run' , state % nphotons end if end subroutine setup subroutine finalise ( dict , dects , nscatt , start , history ) !! Routine writes out simulation data, deallocates arrays and prints total runtime use constants , only : wp , fileplace use detectors , only : dect_array use historyStack , only : history_stack_t use iarray , only : phasor , phasorGLOBAL , jmean , jmeanGLOBAL , absorb , absorbGLOBAL use sim_state_mod , only : state use setupMod , only : dealloc_array use writer_mod , only : normalise_fluence , write_data , write_detected_photons use utils , only : get_time , print_time , str use tomlf , only : toml_table , set_value !> Total number of scattered photon packets real ( kind = wp ), intent ( in ) :: nscatt !> Start time of simulation. Used to calculate total runtime. real ( kind = wp ), intent ( in ) :: start !> Detector array type ( dect_array ), intent ( in ) :: dects (:) !> Photon histyor object type ( history_stack_t ), intent ( in ) :: history !> Dictionary of metadata type ( toml_table ), intent ( inout ) :: dict integer :: id , numproc , i real ( kind = wp ) :: nscattGLOBAL , time_taken id = 0 numproc = 1 #ifdef MPI ! collate fluence from all processes call mpi_reduce ( jmean , jmeanGLOBAL , size ( jmean ), MPI_DOUBLE_PRECISION , MPI_SUM , 0 , MPI_COMM_WORLD ) call mpi_reduce ( absorb , absorbGLOBAL , size ( absorb ), MPI_DOUBLE_PRECISION , MPI_SUM , 0 , MPI_COMM_WORLD ) call mpi_reduce ( phasor , phasorGLOBAL , size ( phasor ), MPI_DOUBLE_COMPLEX , MPI_SUM , 0 , MPI_COMM_WORLD ) call mpi_reduce ( nscatt , nscattGLOBAL , 1 , MPI_DOUBLE_PRECISION , MPI_SUM , 0 , MPI_COMM_WORLD ) #else jmeanGLOBAL = jmean absorbGLOBAL = absorb phasorGLOBAL = phasor nscattGLOBAL = nscatt #endif if ( id == 0 ) then #ifdef _OPENMP print * , 'Average # of scatters per photon:' , nscattGLOBAL / ( state % nphotons ) #else print * , 'Average # of scatters per photon:' , nscattGLOBAL / ( state % nphotons * numproc ) ! for testing purposes open ( newunit = i , file = \"nscatt.dat\" ) write ( i , * ) nscattGLOBAL / ( state % nphotons ) close ( i ) #endif !write out files !create dict to store metadata and nrrd hdr info call set_value ( dict , \"grid_data\" , \"fluence map\" ) call set_value ( dict , \"real_size\" , str ( state % grid % xmax , 7 ) // \" \" // str ( state % grid % ymax , 7 ) // \" \" // str ( state % grid % zmax , 7 )) call set_value ( dict , \"nphotons\" , state % nphotons ) call set_value ( dict , \"source\" , state % source ) call set_value ( dict , \"experiment\" , state % experiment ) call normalise_fluence ( state % grid , jmeanGLOBAL , state % nphotons ) call write_data ( jmeanGLOBAL , trim ( fileplace ) // \"jmean/\" // state % outfile , state , dict ) ! if(state%absorb)call write_data(absorbGLOBAL, trim(fileplace)//\"deposit/\"//state%outfile_absorb, state, dict) !INTENSITY ! call write_data(abs(phasorGLOBAL)**2, trim(fileplace)//\"phasor/\"//state%outfile, state, dict) end if !write out detected photons if ( size ( dects ) > 0 ) then call write_detected_photons ( dects ) block logical :: mask ( size ( dects )) do i = 1 , size ( dects ) mask ( i ) = dects ( i )% p % trackHistory end do if ( state % trackHistory ) call history % finish () end block end if time_taken = get_time () - start call print_time ( time_taken , 4 ) #ifdef MPI call MPI_Finalize () #endif call dealloc_array () end subroutine finalise subroutine display_settings ( state , input_file , packet , kernel_type ) !! Displays the settings used in the current simulation run use sim_state_mod , only : settings_t use photonMod , only : photon use utils , only : str !> Simulation state type ( settings_t ), intent ( IN ) :: state !> Input filenname character ( * ), intent ( IN ) :: input_file !> Kernel type to run character ( * ), intent ( IN ) :: kernel_type !> Photon packet type ( photon ), intent ( IN ) :: packet print * , repeat ( \"#\" , 20 ) // \" Settings \" // repeat ( \"#\" , 20 ) print * , \"# Config file: \" , trim ( input_file ), repeat ( \" \" , 50 - 16 - len ( trim ( input_file ))), \"#\" print * , \"# Using: \" // trim ( kernel_type ) // \"kernel\" // repeat ( \" \" , 50 - 16 - len ( kernel_type )), \"#\" print * , \"# Light source: \" // trim ( state % source ) // repeat ( \" \" , 50 - 17 - len ( trim ( state % source ))), \"#\" if ( state % source == \"point\" ) then print * , \"# Light Source Position: [\" // str ( packet % pos % x , 4 ) // \", \" // str ( packet % pos % y , 4 ) // \", \" // str ( packet % pos % z , 4 ) // & \"]\" // repeat ( \" \" , 6 ) // \"#\" else print * , \"# Light direction: [\" // str ( packet % nxp , 4 ) // \", \" // str ( packet % nyp , 4 ) // \", \" // str ( packet % nzp , 4 ) // & \"]\" // repeat ( \" \" , 12 ) // \"#\" end if print * , \"# Geometry: \" // trim ( state % experiment ) // repeat ( \" \" , 50 - 13 - len ( trim ( state % experiment ))), \"#\" print * , \"# Seed: \" // str ( state % iseed , 9 ) // repeat ( \" \" , 32 ) // \"#\" if ( state % tev ) then print * , \"# Tev enabled!\" // repeat ( \" \" , 35 ) // \"#\" end if if ( state % render_geom ) then print * , \"# Render geometry to file enabled!\" // repeat ( \" \" , 15 ) // \"#\" end if if ( state % overwrite ) then print * , \"# Overwrite Enabled!\" , repeat ( \" \" , 29 ) // \"#\" end if if ( state % absorb ) then print * , \"# Energy absorbed will be written to file.\" // repeat ( \" \" , 7 ) // \"#\" end if print * , repeat ( \"#\" , 50 ) print * , new_line ( \"a\" ) end subroutine display_settings end module kernels","tags":"","loc":"sourcefile/kernelsmod.f90.html"},{"title":"geometryMod.f90 – signedMCRT","text":"Contents Modules geometry Source Code geometryMod.f90 Source Code module geometry !! Defines a set of functions for intersecting a ray and a surface. !! !! - Circle !! - Plane !! - Cone !! - Cylinder !! - Ellipse !! - Sphere use vector_class , only : vector use constants , only : wp implicit none private public :: intersectCircle , intersectPlane , intersectCone , intersectCylinder , intersectEllipse , intersectSphere contains logical function intersectSphere ( orig , dir , t , centre , radius ) !! calculates where a line, with origin:orig and direction:dir hits a sphere, centre:centre and radius:radius !! returns true if intersection exists !! returns t, the paramertised parameter of the line equation !! adapted from scratchapixel !> Direction vector of the ray type ( vector ), intent ( IN ) :: dir !> Origin of the ray type ( vector ), intent ( IN ) :: orig !> Centre of the sphere type ( vector ), intent ( IN ) :: centre !> Distance from orig to the intersection point real ( kind = wp ), intent ( OUT ) :: t !> Radius of the sphere real ( kind = wp ), intent ( IN ) :: radius type ( vector ) :: L real ( kind = wp ) :: t0 , t1 , a , b , c , tmp intersectSphere = . false . L = orig - centre a = dir . dot . dir b = 2._wp * ( dir . dot . L ) c = ( l . dot . l ) - radius ** 2 if (. not . solveQuadratic ( a , b , c , t0 , t1 )) return if ( t0 > t1 ) then tmp = t1 t1 = t0 t0 = tmp end if if ( t0 < 0._wp ) then t0 = t1 if ( t0 < 0._wp ) return end if t = t0 intersectSphere = . true . return end function intersectSphere logical function intersectCylinder ( orig , dir , t , centre , radius ) !! calculates where a line, with origin:orig and direction:dir hits a cylinder, centre:centre and radius:radius !! This solves for an infinitely long cylinder centered on the z axis with radius radius !! returns true if intersection exists !! returns t, the paramertised parameter of the line equation !! adapted from scratchapixel !! need to check z height after moving ray !! if not this is an infinite cylinder !> Direction vector of the ray type ( vector ), intent ( IN ) :: dir !> origin of the ray type ( vector ), intent ( IN ) :: orig !> Centre of the cylinder type ( vector ), intent ( IN ) :: centre !> distance from orig to the intersection point real ( kind = wp ), intent ( OUT ) :: t !> radius of the cylinder real ( kind = wp ), intent ( IN ) :: radius type ( vector ) :: L real ( kind = wp ) :: t0 , t1 , a , b , c , tmp intersectCylinder = . false . L = orig - centre a = dir % x ** 2 + dir % y ** 2 b = 2._wp * ( dir % x * L % x + dir % y * L % y ) c = L % x ** 2 + L % y ** 2 - radius ** 2 if (. not . solveQuadratic ( a , b , c , t0 , t1 )) return if ( t0 > t1 ) then tmp = t1 t1 = t0 t0 = tmp end if if ( t0 < 0._wp ) then t0 = t1 if ( t0 < 0._wp ) return end if t = t0 intersectCylinder = . true . return end function intersectCylinder logical function intersectEllipse ( orig , dir , t , centre , semia , semib ) !! calculates where a line, with origin:orig and direction:dir hits a ellipse, centre:centre and axii:semia, semib !! returns true if intersection exists !! returns t, the paramertised parameter of the line equation !! adapted from scratchapixel and pbrt !! need to check z height after moving ray !! if not this is an infinte ellipse-cylinder !! ellipse lies length ways along z-axis !! semia and semib are the semimajor axis which are the half width and height. !> Direction vector of the ray type ( vector ), intent ( IN ) :: dir !> origin of the ray type ( vector ), intent ( IN ) :: orig !> Centre of the ellipse type ( vector ), intent ( IN ) :: centre !> distance from orig to the intersection point real ( kind = wp ), intent ( OUT ) :: t !> Half width of the ellipse real ( kind = wp ), intent ( IN ) :: semia !> Half height of the ellipse real ( kind = wp ), intent ( IN ) :: semib type ( vector ) :: L real ( kind = wp ) :: t0 , t1 , a , b , c , tmp , semia2div , semib2div intersectEllipse = . false . semia2div = 1._wp / semia ** 2 semib2div = 1._wp / semib ** 2 L = orig - centre a = semia2div * dir % z ** 2 + semib2div * dir % y ** 2 b = 2._wp * ( semia2div * dir % z * L % z + semib2div * dir % y * L % y ) c = semia2div * L % z ** 2 + semib2div * L % y ** 2 - 1._wp if (. not . solveQuadratic ( a , b , c , t0 , t1 )) return if ( t0 > t1 ) then tmp = t1 t1 = t0 t0 = tmp end if if ( t0 < 0._wp ) then t0 = t1 if ( t0 < 0._wp ) return end if t = t0 intersectEllipse = . true . return end function intersectEllipse logical function intersectCone ( orig , dir , t , centre , radius , height ) !! calculates where a line, with origin:orig and direction:dir hits a cone, radius:radius and height:height with centre:centre. !! centre is the point under the apex at the cone's base. !! returns true if intersection exists !! returns t, the paramertised parameter of the line equation !! adapted from scratchapixel and pbrt !! need to check z height after moving ray !! if not this is an infinte cone !! cone lies height ways along z-axis !> Direction vector of the ray type ( vector ), intent ( IN ) :: dir !> origin of the ray type ( vector ), intent ( IN ) :: orig !> Centre of the cone type ( vector ), intent ( IN ) :: centre !> distance from orig to the intersection point real ( kind = wp ), intent ( OUT ) :: t !> Radius of the cones base real ( kind = wp ), intent ( IN ) :: radius !> Height of the cone real ( kind = wp ), intent ( IN ) :: height type ( vector ) :: L real ( kind = wp ) :: t0 , t1 , a , b , c , tmp , k intersectCone = . false . k = radius / height k = k ** 2 L = orig - centre a = dir % x ** 2 + dir % y ** 2 - ( k * dir % z ** 2 ) b = 2._wp * (( dir % x * L % x ) + ( dir % y * L % y ) - ( k * dir % z * ( L % z - height ))) c = L % x ** 2 + L % y ** 2 - ( k * ( L % z - height ) ** 2 ) if (. not . solveQuadratic ( a , b , c , t0 , t1 )) return if ( t0 > t1 ) then tmp = t1 t1 = t0 t0 = tmp end if if ( t0 < 0._wp ) then t0 = t1 if ( t0 < 0._wp ) return end if t = t0 intersectCone = . true . return end function intersectCone logical function intersectPlane ( n , p0 , l0 , l , t ) !![ref](https://www.scratchapixel.com/lessons/3d-basic-rendering/minimal-ray-tracer-rendering-simple-shapes/ray-plane-and-ray-disk-intersection) !> Normal to the plane type ( vector ), intent ( in ) :: n !> a point on the plane type ( vector ), intent ( in ) :: p0 !> direction vector of the ray type ( vector ), intent ( in ) :: l !> origin of the ray type ( vector ), intent ( in ) :: l0 !> Distance from l0 to the intersection point real ( kind = wp ), intent ( inout ) :: t real ( kind = wp ) :: denom type ( vector ) :: p0l0 intersectPlane = . false . denom = n . dot . l if ( denom > 1e-6_wp ) then p0l0 = p0 - l0 t = p0l0 . dot . n t = t / denom if ( t >= 0._wp ) intersectPlane = . true . end if end function intersectPlane logical function intersectCircle ( n , p0 , radius , l0 , l , t ) !![ref](https://www.scratchapixel.com/lessons/3d-basic-rendering/minimal-ray-tracer-rendering-simple-shapes/ray-plane-and-ray-disk-intersection) !> Normal to the circle type ( vector ), intent ( in ) :: n !> a centre of the circle type ( vector ), intent ( in ) :: p0 !> direction vector of the ray type ( vector ), intent ( in ) :: l !> origin of the ray type ( vector ), intent ( in ) :: l0 !> Radius of the circle real ( kind = wp ), intent ( in ) :: radius !> Distance from l0 to the intersection point real ( kind = wp ), intent ( inout ) :: t real ( kind = wp ) :: d2 type ( vector ) :: v , p intersectCircle = . false . t = 0._wp if ( intersectPlane ( n , p0 , l0 , l , t )) then p = l0 + l * t v = p - p0 d2 = v . dot . v if ( sqrt ( d2 ) <= radius ) intersectCircle = . true . end if end function intersectCircle logical function solveQuadratic ( a , b , c , x0 , x1 ) !! solves quadratic equation given coeffs a, b, and c !! returns true if real solution !! returns x0 and x1 !! adapted from scratchapixel real ( kind = wp ), intent ( IN ) :: a , b , c real ( kind = wp ), intent ( OUT ) :: x0 , x1 real ( kind = wp ) :: discrim , q solveQuadratic = . false . discrim = b ** 2 - 4._wp * a * c if ( discrim < 0._wp ) then return elseif ( discrim == 0._wp ) then x0 = - 0.5_wp * b / a x1 = x0 else if ( b > 0._wp ) then q = - 0.5_wp * ( b + sqrt ( discrim )) else q = - 0.5_wp * ( b - sqrt ( discrim )) end if x0 = q / a x1 = c / q end if solveQuadratic = . true . return end function solveQuadratic end module geometry","tags":"","loc":"sourcefile/geometrymod.f90.html"},{"title":"random_mod.f90 – signedMCRT","text":"Contents Modules random Source Code random_mod.f90 Source Code module random !! module provides an interface to call random_numbers and various other random distributions======= !!This module defines a set of functions that return random numbers in different distributions. !!- ran2. Returns a single float uniformly in the range [0, 1) !!- ranu. Return a single float uniformly in the range [a, b) !!- randint. Returns a single integer uniformly in the range [a, b) !!- rang. Returns a single float from a Gaussian distribution with mean *avg* and std *sigma*. !!- init_rng. Seeds the internal random number generator with a reproducible seed. use vector_class use constants , only : wp implicit none !> Sequence type for quasi-monte carlo type :: seq !> Current index to get value for. integer :: index !> Base from which to calculate radical inverse from. integer :: base contains procedure :: next end type seq private public :: ran2 , ranu , rang , randint , init_rng , seq contains real ( kind = wp ) function next ( this ) result ( res ) class ( seq ) :: this real ( kind = wp ) :: fraction integer :: i fraction = 1. res = 0. i = this % index do while ( i > 0 ) fraction = fraction / this % base res = res + ( fraction * mod ( i , this % base )) i = floor ( i / real ( this % base , kind = wp )) end do this % index = this % index + 1 end function next subroutine init_rng ( input_seed , fwd ) !! initiate RNG state with reproducible state !> input seed integer , optional , intent ( IN ) :: input_seed (:) !> boolean that if True runs the generator for 100 steps before returning logical , optional , intent ( IN ) :: fwd integer , allocatable :: seed (:) integer :: n , i logical :: ffwd real ( kind = wp ) :: a call random_seed ( size = n ) allocate ( seed ( n )) if ( present ( input_seed )) then seed = 0 seed = input_seed else seed = 1234567 end if if ( present ( fwd )) then ffwd = fwd else ffwd = . false . end if call random_seed ( put = seed ) !fast forward rng state 100 times to avoid any potential bad seeds if ( ffwd ) then call random_seed ( get = seed ) do i = 1 , 100 a = ran2 () call random_seed ( get = seed ) end do end if end subroutine init_rng function ran2 () result ( res ) !! wrapper for call random number real ( kind = wp ) :: res call random_number ( res ) end function ran2 function ranu ( a , b ) result ( res ) !! uniformly sample in range[a, b) real ( kind = wp ) :: res !> lower bound real ( kind = wp ), intent ( IN ) :: a !> upper bound real ( kind = wp ), intent ( IN ) :: b res = a + ran2 () * ( b - a ) end function ranu subroutine rang ( x , y , avg , sigma ) !! sample a 2D Guassian distribution !> mean of the gaussian to sample from real ( kind = wp ), intent ( IN ) :: avg !> \\sigma of the guassian to sample from. real ( kind = wp ), intent ( IN ) :: sigma !> first value to return real ( kind = wp ), intent ( OUT ) :: x !> 2nd value to return real ( kind = wp ), intent ( OUT ) :: y real ( kind = wp ) :: s , tmp s = 1._wp do while ( s >= 1._wp ) x = ranu ( - 1._wp , 1._wp ) y = ranu ( - 1._wp , 1._wp ) s = y ** 2 + x ** 2 end do tmp = x * sqrt ( - 2._wp * log ( s ) / s ) x = avg + sigma * tmp tmp = y * sqrt ( - 2._wp * log ( s ) / s ) y = avg + sigma * tmp end subroutine rang integer function randint ( a , b ) !! sample a random integer between [a, b] !> lower bound integer , intent ( IN ) :: a !> higher bound integer , intent ( IN ) :: b randint = a + floor (( b + 1 - a ) * ran2 ()) end function randint end module random ! Program test ! use random, only : randint ! implicit none ! integer :: i ! do i = 1, 100 ! print*,randint(0, 5) ! end do ! end program test","tags":"","loc":"sourcefile/random_mod.f90.html"},{"title":"iarray.f90 – signedMCRT","text":"Contents Modules iarray Source Code iarray.f90 Source Code module iarray !! The iarray module contains the variables that record the fluence. These are 3D arrays, with roughly the same dimensions as the cart_grid type. !! Jmean is the *local* fluence. JmeanGLOBAL is the *global* fluence grid. The global version is the one that is written to disk at the simulations end. use constants , only : sp implicit none !> phase data array complex ( kind = sp ), allocatable :: phasor (:,:,:), phasorGLOBAL (:,:,:) !> fluence data array real ( kind = sp ), allocatable :: jmean (:,:,:), jmeanGLOBAL (:,:,:) !> absorption data array real ( kind = sp ), allocatable :: absorb (:,:,:), absorbGLOBAL (:,:,:) end module iarray","tags":"","loc":"sourcefile/iarray.f90.html"},{"title":"constants.f90 – signedMCRT","text":"Contents Modules constants Source Code constants.f90 Source Code module constants !! This module contains mathematical constants and strings that contain the various directories used by the program. !! Math constants: !! - PI !! - 2 PI !! - wp (working precision of the whole program). Default is double precision (64bit floats) !! Directories: !! - homedir. Root directory of this code !! - fileplace. data folder directory !! - resdir. holds the path to the directory that holds the parameter and other associated input files use iso_fortran_env , only : real64 , real32 implicit none !> current working precision integer , parameter :: wp = real64 !can change this to other precision, not tested for lower or higher precisions. !> single precision variable. integer , parameter :: sp = real32 !> double precision variable. integer , parameter :: dp = real64 !> \\pi real ( kind = wp ), parameter :: PI = 4._wp * atan ( 1._wp ) !> 2 \\pi real ( kind = wp ), parameter :: TWOPI = 2._wp * PI !> Weight threshold for roulette real ( kind = wp ), parameter :: THRESHOLD = 0.01_wp !> Proportion of packet that survive roulette real ( kind = wp ), parameter :: CHANCE = 0.1_wp !> root directory character ( len = 255 ) :: homedir !> place where output files are saved character ( len = 255 ) :: fileplace !> directory to input files character ( len = 255 ) :: resdir end module constants","tags":"","loc":"sourcefile/constants.f90.html"},{"title":"parse.f90 – signedMCRT","text":"Contents Modules parse_mod Source Code parse.f90 Source Code module parse_mod !! Module contains all routines related to parsing the input toml config files. !! See [config](../|page|/config.html) for details of toml input file. use tomlf use tomlf_error , only : make_error use constants , only : wp use vector_class implicit none private public :: parse_params contains subroutine parse_params ( filename , packet , dects , spectrum , dict , error ) !! entry point for parsing toml file use detectors , only : dect_array use photonmod use piecewiseMod !> filename of input toml file character ( * ), intent ( IN ) :: filename !> dictionary that stores potential metadata to be saved with simulation output type ( toml_table ), intent ( INOUT ) :: dict !> some input options set up data in the photon class type ( photon ), intent ( OUT ) :: packet !> detector array which is setup during parsing type ( dect_array ), allocatable , intent ( out ) :: dects (:) !> spectrum type which is set up during parsing type ( spectrum_t ), intent ( out ) :: spectrum !> Last error raised during parsing. Unallocated if no error raised. Need to handle this on return from parse_params. type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), allocatable :: table type ( toml_context ) :: context call toml_load ( table , trim ( filename ), context = context , error = error ) if ( allocated ( error )) return call parse_source ( table , packet , dict , spectrum , context , error ) if ( allocated ( error )) return call parse_grid ( table , dict , error ) if ( allocated ( error )) return call parse_geometry ( table , dict , error ) if ( allocated ( error )) return call parse_detectors ( table , dects , context , error ) if ( allocated ( error )) return call parse_output ( table , error ) if ( allocated ( error )) return call parse_simulation ( table , error ) if ( allocated ( error )) return end subroutine parse_params subroutine parse_detectors ( table , dects , context , error ) !! parse the detectors use detectors , only : dect_array , circle_dect , annulus_dect , camera use sim_state_mod , only : state !> Input Toml table type ( toml_table ), intent ( inout ) :: table !> Detector array to be filled. type ( dect_array ), allocatable :: dects (:) !> Context handle for error reporting. type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_array ), pointer :: array type ( toml_table ), pointer :: child character ( len = :), allocatable :: dect_type type ( circle_dect ), target , save , allocatable :: dect_c (:) type ( annulus_dect ), target , save , allocatable :: dect_a (:) type ( camera ), target , save , allocatable :: dect_cam (:) integer :: i , c_counter , a_counter , cam_counter , j , k , origin c_counter = 0 a_counter = 0 cam_counter = 0 call get_value ( table , \"detectors\" , array ) allocate ( dects ( len ( array ))) do i = 1 , len ( array ) call get_value ( array , i , child ) call get_value ( child , \"type\" , dect_type , origin = origin ) select case ( dect_type ) case default call make_error ( error , & context % report ( \"Invalid detector type. Valid types are [circle, annulus, camera]\" , & origin , \"expected valid detector type\" ), - 1 ) return case ( \"circle\" ) c_counter = c_counter + 1 case ( \"annulus\" ) a_counter = a_counter + 1 case ( \"camera\" ) cam_counter = cam_counter + 1 end select end do if ( c_counter > 0 ) allocate ( dect_c ( c_counter )) if ( a_counter > 0 ) allocate ( dect_a ( a_counter )) if ( cam_counter > 0 ) allocate ( dect_cam ( cam_counter )) c_counter = 1 a_counter = 1 cam_counter = 1 state % trackHistory = . false . do i = 1 , len ( array ) call get_value ( array , i , child ) call get_value ( child , \"type\" , dect_type ) call get_value ( child , \"historyFileName\" , state % historyFilename , \"photPos.obj\" ) select case ( dect_type ) case ( \"circle\" ) call handle_circle_dect ( child , dect_c , c_counter , context , error ) if ( allocated ( error )) return case ( \"annulus\" ) call handle_annulus_dect ( child , dect_a , a_counter , context , error ) if ( allocated ( error )) return case ( \"camera\" ) call handle_camera ( child , dect_cam , cam_counter , context , error ) if ( allocated ( error )) return end select end do do i = 1 , c_counter - 1 allocate ( dects ( i )% p , source = dect_c ( i )) dects ( i )% p => dect_c ( i ) end do do j = 1 , a_counter - 1 allocate ( dects ( j + i - 1 )% p , source = dect_a ( j )) dects ( j + i - 1 )% p => dect_a ( j ) end do do k = 1 , cam_counter - 1 allocate ( dects ( j + i + k - 2 )% p , source = dect_cam ( k )) dects ( j + i + k - 2 )% p => dect_cam ( k ) end do if (. not . allocated ( state % historyFilename )) state % historyFilename = \"photPos.obj\" end subroutine parse_detectors subroutine handle_camera ( child , dects , counts , context , error ) !! Read in Camera settings and initalise variable use detectors , only : camera use sim_state_mod , only : state type ( toml_table ), pointer , intent ( in ) :: child type ( camera ), intent ( inout ) :: dects (:) integer , intent ( inout ) :: counts !> Context handle for error reporting. type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error integer :: layer , nbins real ( kind = wp ) :: maxval type ( vector ) :: p1 , p2 , p3 logical :: trackHistory p1 = get_vector ( child , \"p1\" , default = vector ( - 1.0 , - 1.0 , - 1.0 ), context = context , error = error ) p2 = get_vector ( child , \"p2\" , default = vector ( 2.0 , 0.0 , 0.0 ), context = context , error = error ) p3 = get_vector ( child , \"p3\" , default = vector ( 0.0 , 2.0 , 0.0 ), context = context , error = error ) call get_value ( child , \"layer\" , layer , 1 ) call get_value ( child , \"nbins\" , nbins , 100 ) call get_value ( child , \"maxval\" , maxval , 10 0._wp ) call get_value ( child , \"trackHistory\" , trackHistory , . false .) if ( trackHistory ) state % trackHistory = . true . #ifdef _OPENMP if ( trackHistory ) then call make_error ( error , \"Track history currently incompatable with OpenMP!\" , - 1 ) return end if #endif dects ( counts ) = camera ( p1 , p2 , p3 , layer , nbins , maxval , trackHistory ) counts = counts + 1 end subroutine handle_camera subroutine handle_circle_dect ( child , dects , counts , context , error ) !! Read in Circle_detector settings and initalise variable use detectors , only : circle_dect use sim_state_mod , only : state type ( toml_table ), pointer , intent ( in ) :: child type ( circle_dect ), intent ( inout ) :: dects (:) integer , intent ( inout ) :: counts type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error integer :: layer , nbins real ( kind = wp ) :: maxval , radius type ( vector ) :: pos , dir logical :: trackHistory pos = get_vector ( child , \"position\" , context = context , error = error ) dir = get_vector ( child , \"direction\" , default = vector ( 0.0 , 0.0 , - 1.0 ), context = context , error = error ) dir = dir % magnitude () call get_value ( child , \"layer\" , layer , 1 ) call get_value ( child , \"radius1\" , radius ) call get_value ( child , \"nbins\" , nbins , 100 ) call get_value ( child , \"maxval\" , maxval , 10 0._wp ) call get_value ( child , \"trackHistory\" , trackHistory , . false .) if ( trackHistory ) state % trackHistory = . true . #ifdef _OPENMP if ( trackHistory ) then call make_error ( error , \"Track history currently incompatable with OpenMP!\" , - 1 ) return end if #endif dects ( counts ) = circle_dect ( pos , dir , layer , radius , nbins , maxval , trackHistory ) counts = counts + 1 end subroutine handle_circle_dect subroutine handle_annulus_dect ( child , dects , counts , context , error ) !! Read in Annulus_detector settings and initalise variable use detectors , only : annulus_dect use sim_state_mod , only : state type ( toml_table ), pointer , intent ( in ) :: child type ( annulus_dect ), intent ( inout ) :: dects (:) integer , intent ( inout ) :: counts type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error integer :: layer , nbins , origin real ( kind = wp ) :: maxval , radius1 , radius2 type ( vector ) :: pos , dir logical :: trackHistory pos = get_vector ( child , \"position\" , context = context , error = error ) dir = get_vector ( child , \"direction\" , default = vector ( 0.0 , 0.0 , - 1.0 ), context = context , error = error ) call get_value ( child , \"layer\" , layer , 1 ) call get_value ( child , \"radius1\" , radius1 ) call get_value ( child , \"radius2\" , radius2 , origin = origin ) if ( radius2 <= radius1 ) then call make_error ( error , context % report ( \"Radii are invalid\" , origin , \"Expected radius2 > radius 1\" ), - 1 ) return end if call get_value ( child , \"nbins\" , nbins , 100 ) call get_value ( child , \"maxval\" , maxval , 10 0._wp ) call get_value ( child , \"trackHistory\" , trackHistory , . false .) if ( trackHistory ) state % trackHistory = . true . #ifdef _OPENMP if ( trackHistory ) then call make_error ( error , \"Track history currently incompatable with OpenMP!\" , - 1 ) return end if #endif dects ( counts ) = annulus_dect ( pos , dir , layer , radius1 , radius2 , nbins , maxval , trackHistory ) counts = counts + 1 end subroutine handle_annulus_dect subroutine parse_spectrum ( table , spectrum , dict , context , error ) !! Parse spectrums to be used ! TODO seperate out each case to seperate functions. ! TODO add spectra type to input optical properties ! handle all possible errors ! document code and update config.md use piecewiseMod use stdlib_io , only : loadtxt use constants , only : resdir , sp use stb_image_mod use , intrinsic :: iso_c_binding type ( toml_table ), intent ( INOUT ) :: dict type ( toml_table ), pointer :: table type ( toml_context ) :: context type ( spectrum_t ), intent ( out ) :: spectrum type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_array ), pointer :: children integer :: origin , nlen , i , err , width , height , n_channels , u integer , allocatable :: image (:,:,:) type ( constant ), save , target :: const type ( piecewise1D ), save , target :: OneD type ( piecewise2D ), save , target :: TwoD character ( len = :), allocatable :: stype , sfile , filetype real ( kind = wp ) :: wavelength , cellsize ( 2 ) real ( kind = wp ), allocatable :: array (:,:) real ( kind = sp ), allocatable :: array_sp (:,:) call get_value ( table , \"spectrum_type\" , stype , \"constant\" , origin = origin ) select case ( stype ) case ( \"constant\" ) call get_value ( table , \"wavelength\" , wavelength , 50 0.0_wp ) const = constant ( wavelength ) allocate ( spectrum % p , source = const ) spectrum % p => const case ( \"1D\" ) allocate ( spectrum % p , source = OneD ) call get_value ( table , \"spectrum_file\" , sfile ) call loadtxt ( \"res/\" // sfile , array_sp ) array = array_sp deallocate ( array_sp ) OneD = piecewise1D ( array ) allocate ( spectrum % p , source = OneD ) spectrum % p => OneD case ( \"2D\" ) allocate ( spectrum % p , source = TwoD ) call get_value ( table , \"spectrum_file\" , sfile ) call get_value ( table , \"cell_size\" , children , requested = . true ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen /= 2 ) then call make_error ( error ,& context % report ( \"Need a vector of size 2 for cell_size\" , origin , \"expected vector of size 2\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , cellsize ( i )) end do else call make_error ( error ,& context % report ( \"Need a vector of size 2 for cell_size\" , origin , \"expected vector of size 2\" ), - 1 ) return end if filetype = sfile ( len ( sfile ) - 2 :) select case ( filetype ) case ( \"png\" ) err = stbi_info ( trim ( resdir ) // trim ( sfile ) // c_null_char , width , height , n_channels ) if ( err == 0 ) then call make_error ( error , \"Error reading file: \" // trim ( sfile ) // \" \" // stbi_failure_reason (), - 1 ) return end if image = stbi_load ( trim ( resdir ) // trim ( sfile ) // c_null_char , width , height , n_channels , 0 ) allocate ( array ( size ( image , 1 ), size ( image , 2 ))) array = image (:,:, 1 ) deallocate ( image ) case ( \"dat\" ) call loadtxt ( resdir // trim ( sfile ), array ) case ( \"txt\" ) call loadtxt ( resdir // trim ( sfile ), array ) case default print '(2a)' , \"Unknown spectrum file type:\" , filetype end select TwoD = piecewise2D ( cellsize ( 1 ), cellsize ( 2 ), array ) allocate ( spectrum % p , source = TwoD ) spectrum % p => TwoD case default call make_error ( error ,& context % report ( \"Not a valid spectrum type!\" , origin , \"expected one of either ['constant', '1D', '2D']\" ), - 1 ) return end select end subroutine parse_spectrum subroutine parse_source ( table , packet , dict , spectrum , context , error ) !! Parse sources !! any updates here MUST be reflected in docs/config.md use sim_state_mod , only : state use photonmod use piecewiseMod use tomlf_error !> Input Toml table type ( toml_table ), intent ( inout ) :: table !> Dictonary used to store metadata type ( toml_table ), intent ( inout ) :: dict !> Photon packet. Used to store information to save computation type ( photon ), intent ( out ) :: packet !> Spectrum type. type ( spectrum_t ), intent ( out ) :: spectrum !> Context handle for error reporting type ( toml_context ) :: context !> Error message type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), pointer :: child type ( toml_array ), pointer :: children type ( vector ) :: poss , dirr real ( kind = wp ) :: dir ( 3 ), pos ( 3 ), corners ( 3 , 3 ), radius , beta , rlo , rhi integer :: i , nlen , origin character ( len = 1 ) :: axis ( 3 ) character ( len = :), allocatable :: direction , annulus_type axis = [ \"x\" , \"y\" , \"z\" ] pos = 0._wp dir = 0._wp corners = reshape (( / - 1._wp , - 1._wp , 1._wp , & 2._wp , 0._wp , 0._wp , & 0._wp , 2._wp , 0._wp / ), & shape ( corners ), order = [ 2 , 1 ]) call get_value ( table , \"source\" , child , requested = . false .) if ( associated ( child )) then call get_value ( child , \"name\" , state % source , \"point\" ) call get_value ( child , \"nphotons\" , state % nphotons , 1000000 ) call get_value ( child , \"position\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a vector of size 3 for position\" , origin , \"expected vector of size 3\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , pos ( i )) end do else if ( state % source == \"point\" ) then call make_error ( error , & context % report ( \"Point source needs a position!\" , origin , \"Need vector of size 3 for position\" ), - 1 ) return end if end if poss = vector ( pos ( 1 ), pos ( 2 ), pos ( 3 )) children => null () call get_value ( child , \"direction\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then if ( state % source == \"point\" ) then print '(a)' , context % report (& \"Point source needs no direction!!\" , origin , level = toml_level % warning ) end if nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a vector of size 3 for direction\" , origin , \"expected vector of size 3\" ), - 1 ) return end if if ( state % source == \"circular\" ) then print '(a)' , context % report (& \"Direction not yet fully tested for source type Circular. Results may not be accurate!\" , origin ,& level = toml_level % warning ) end if do i = 1 , len ( children ) call get_value ( children , i , dir ( i )) end do dirr % x = dir ( 1 ) dirr % y = dir ( 2 ) dirr % z = dir ( 3 ) else call get_value ( child , \"direction\" , direction , origin = origin ) if ( allocated ( direction )) then if ( state % source == \"point\" ) then print '(a)' , context % report (& \"Point source needs no direction!!\" , origin , level = toml_level % warning ) end if select case ( direction ) case ( \"x\" ) dirr = vector ( 1._wp , 0._wp , 0._wp ) case ( \"-x\" ) dirr = vector ( - 1._wp , 0._wp , 0._wp ) case ( \"y\" ) dirr = vector ( 0._wp , 1._wp , 0._wp ) case ( \"-y\" ) dirr = vector ( 0._wp , - 1._wp , 0._wp ) case ( \"z\" ) dirr = vector ( 0._wp , 0._wp , 1._wp ) case ( \"-z\" ) dirr = vector ( 0._wp , 0._wp , - 1._wp ) case default call make_error ( error , context % report ( \"Direction needs a cardinal direction i.e x, y, or z\" , origin , & \"Expected cardinal direction\" ), - 1 ) return end select elseif ( state % source /= \"point\" ) then call make_error ( error , context % report ( \"Need to specify direction for source type!\" , origin , & \"No direction specified\" ), - 1 ) return end if end if children => null () call get_value ( child , \"point1\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a matrix row for points\" , origin , \"expected matrix row of size 3\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , corners ( i , 1 )) call set_value ( dict , \"pos1%\" // axis ( i ), corners ( i , 1 )) end do else if ( state % source == \"uniform\" ) then call make_error ( error , & context % report ( \"Uniform source requires point1 variable\" , origin , \"expected point1 variable\" ), - 1 ) return end if end if call get_value ( child , \"point2\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a matrix row for points\" , origin , \"expected matrix row of size 3\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , corners ( i , 2 )) call set_value ( dict , \"pos2%\" // axis ( i ), corners ( i , 2 )) end do else if ( state % source == \"uniform\" ) then call make_error ( error , & context % report ( \"Uniform source requires point2 variable\" , origin , \"expected point2 variable\" ), - 1 ) return end if end if call get_value ( child , \"point3\" , children , requested = . false ., origin = origin ) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , & context % report ( \"Need a matrix row for points\" , origin , \"expected matrix row of size 3\" ), - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , corners ( i , 3 )) call set_value ( dict , \"pos3%\" // axis ( i ), corners ( i , 3 )) end do else if ( state % source == \"uniform\" ) then call make_error ( error , & context % report ( \"Uniform source requires point3 variable\" , origin , \"expected point3 variable\" ), - 1 ) return end if end if call get_value ( child , \"radius\" , radius , 0.5_wp ) call set_value ( dict , \"radius\" , radius ) ! parameters for annulus beam type call get_value ( child , \"beta\" , beta , 5._wp ) call set_value ( dict , \"beta\" , beta ) call get_value ( child , \"radius_hi\" , rhi , 0.6_wp ) call set_value ( dict , \"rhi\" , rhi ) call get_value ( child , \"annulus_type\" , annulus_type , \"gaussian\" ) call set_value ( dict , \"annulus_type\" , annulus_type ) ! parse spectrum call parse_spectrum ( child , spectrum , dict , context , error ) if ( allocated ( error )) return else call make_error ( error , context % report ( \"Simulation needs Source table\" , origin , \"Missing source table\" ), - 1 ) return end if call set_photon ( poss , dirr ) packet = photon ( state % source ) packet % pos = poss packet % nxp = dirr % x packet % nyp = dirr % y packet % nzp = dirr % z end subroutine parse_source subroutine parse_grid ( table , dict , error ) !! parse grid input data use sim_state_mod , only : state use gridMod , only : init_grid !> Input Toml table type ( toml_table ), intent ( inout ) :: table !> Dictonary used to store metadata type ( toml_table ), intent ( inout ) :: dict type ( toml_error ), allocatable , intent ( out ) :: error character ( len = :), allocatable :: msg type ( toml_table ), pointer :: child integer :: nxg , nyg , nzg real ( kind = wp ) :: xmax , ymax , zmax character ( len = :), allocatable :: units call get_value ( table , \"grid\" , child ) if ( associated ( child )) then call get_value ( child , \"nxg\" , nxg , 200 ) call get_value ( child , \"nyg\" , nyg , 200 ) call get_value ( child , \"nzg\" , nzg , 200 ) call get_value ( child , \"xmax\" , xmax , 1.0_wp ) call get_value ( child , \"ymax\" , ymax , 1.0_wp ) call get_value ( child , \"zmax\" , zmax , 1.0_wp ) call get_value ( child , \"units\" , units , \"cm\" ) call set_value ( dict , \"units\" , units ) else msg = \"Need grid table in input param file\" call make_error ( error , msg ) return end if state % grid = init_grid ( nxg , nyg , nzg , xmax , ymax , zmax ) end subroutine parse_grid subroutine parse_geometry ( table , dict , error ) !! parse geometry information use sim_state_mod , only : state !> Input Toml table type ( toml_table ), intent ( INOUT ) :: table !> Dictonary used to store metadata type ( toml_table ), intent ( INOUT ) :: dict type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), pointer :: child real ( kind = wp ) :: tau , musb , musc , muab , muac , hgg integer :: num_spheres call get_value ( table , \"geometry\" , child ) if ( associated ( child )) then call get_value ( child , \"geom_name\" , state % experiment , \"sphere\" ) call get_value ( child , \"tau\" , tau , 1 0._wp ) call set_value ( dict , \"tau\" , tau ) call get_value ( child , \"num_spheres\" , num_spheres , 10 ) call set_value ( dict , \"num_spheres\" , num_spheres ) call get_value ( child , \"musb\" , musb , 0.0_wp ) call set_value ( dict , \"musb\" , musb ) call get_value ( child , \"muab\" , muab , 0.01_wp ) call set_value ( dict , \"muab\" , muab ) call get_value ( child , \"musc\" , musc , 0.0_wp ) call set_value ( dict , \"musc\" , musc ) call get_value ( child , \"muac\" , muac , 0.01_wp ) call set_value ( dict , \"muac\" , muac ) call get_value ( child , \"hgg\" , hgg , 0.7_wp ) call set_value ( dict , \"hgg\" , hgg ) else call make_error ( error , \"Need geometry table in input param file\" , - 1 ) end if end subroutine parse_geometry subroutine parse_output ( table , error ) !! parse output file information use sim_state_mod , only : state !> Input Toml table type ( toml_table ), intent ( inout ) :: table type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), pointer :: child type ( toml_array ), pointer :: children integer :: i , nlen call get_value ( table , \"output\" , child ) if ( associated ( child )) then call get_value ( child , \"fluence\" , state % outfile , \"fluence.nrrd\" ) call get_value ( child , \"absorb\" , state % outfile_absorb , \"absorb.nrrd\" ) call get_value ( child , \"render\" , state % renderfile , \"geom_render.nrrd\" ) call get_value ( child , \"render_geom\" , state % render_geom , . false .) call get_value ( child , \"render_size\" , children , requested = . false .) if ( associated ( children )) then nlen = len ( children ) if ( nlen < 3 ) then call make_error ( error , \"Need a vector of size 3 for render_size.\" , - 1 ) return end if do i = 1 , len ( children ) call get_value ( children , i , state % render_size ( i )) end do else state % render_size = [ 200 , 200 , 200 ] end if call get_value ( child , \"overwrite\" , state % overwrite , . false .) else call make_error ( error , \"Need output table in input param file\" , - 1 ) return end if end subroutine parse_output subroutine parse_simulation ( table , error ) !! parse simulation information use sim_state_mod , only : state !> Input Toml table type ( toml_table ), intent ( inout ) :: table type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_table ), pointer :: child call get_value ( table , \"simulation\" , child ) if ( associated ( child )) then call get_value ( child , \"iseed\" , state % iseed , 123456789 ) call get_value ( child , \"tev\" , state % tev , . false .) call get_value ( child , \"absorb\" , state % absorb , . false .) else call make_error ( error , \"Need simulation table in input param file\" , - 1 ) return end if end subroutine parse_simulation type ( vector ) function get_vector ( child , key , error , context , default ) !! Vector helper function for parsing toml !> Input Toml entry to read type ( toml_table ), pointer , intent ( in ) :: child !> Key to read character ( * ), intent ( in ) :: key !> Default value to assign type ( vector ), optional , intent ( in ) :: default !> Context handle for error reporting type ( toml_context ), intent ( in ) :: context type ( toml_error ), allocatable , intent ( out ) :: error type ( toml_array ), pointer :: arr => null () real ( kind = wp ) :: tmp ( 3 ) type ( vector ) :: default_ integer :: j , origin if ( present ( default )) then default_ = default else default_ = vector ( 0._wp , 0._wp , 0._wp ) end if call get_value ( child , key , arr , origin = origin ) if ( associated ( arr )) then if ( len ( arr ) /= 3 ) then call make_error ( error , & context % report ( \"Expected vector of size 3\" , origin , \"Wrong vector size\" ), - 1 ) return end if do j = 1 , len ( arr ) call get_value ( arr , j , tmp ( j )) end do get_vector = vector ( tmp ( 1 ), tmp ( 2 ), tmp ( 3 )) else get_vector = default end if end function get_vector end module parse_mod","tags":"","loc":"sourcefile/parse.f90.html"},{"title":"vec4_class.f90 – signedMCRT","text":"Contents Modules vec4_class Source Code vec4_class.f90 Source Code Module vec4_class !! Vector4 class module. Defines a vector4 type (x, y, z, p) and associated operations on vectors and other types. use constants , only : wp implicit none !> not fully implmented vec4 class type :: vec4 !> vec4 components real ( kind = wp ) :: x , y , z , p contains procedure :: magnitude => magnitude_fn procedure :: length => length !> .dot. operator generic :: operator (. dot .) => vec_dot_vec !> Overloaded Division operator generic :: operator ( / ) => vec_div_scal_r4 , vec_div_scal_r8 , vec_div_scal_int !> Overloaded Mulitiplication operator generic :: operator ( * ) => vec_mult_vec , vec_mult_scal , scal_mult_vec !> Overloaded Addition operator generic :: operator ( + ) => vec_add_vec , vec_add_scal , scal_add_vec !> Overloaded Subtraction operator generic :: operator ( - ) => vec_minus_vec , vec_minus_scal , scal_minus_vec procedure , pass ( a ), private :: vec_dot_vec procedure , pass ( a ), private :: vec_div_scal_r4 procedure , pass ( a ), private :: vec_div_scal_r8 procedure , pass ( a ), private :: vec_div_scal_int procedure , pass ( a ), private :: vec_mult_vec procedure , pass ( a ), private :: vec_mult_scal procedure , pass ( b ), private :: scal_mult_vec procedure , pass ( a ), private :: vec_add_vec procedure , pass ( a ), private :: vec_add_scal procedure , pass ( b ), private :: scal_add_vec procedure , pass ( a ), private :: vec_minus_vec procedure , pass ( a ), private :: vec_minus_scal procedure , pass ( b ), private :: scal_minus_vec end type vec4 interface sin !! Vec4 overload of the sin intrinsic module procedure sin_vec end interface sin interface vec4 !! Initalise a vec4 from a vec3 and a scalar module procedure init_vec4_vector_real end interface vec4 private public :: vec4 , sin contains type ( vec4 ) function init_vec4_vector_real ( vec , val ) result ( out ) !! Initalise vec4 from a vec3 and Scalar !! e.g vec4 = [vec3%x, vec3%y, vec3%z, scalar] use vector_class !> Input vec3 type ( vector ), intent ( in ) :: vec !> Input Scalar real ( kind = wp ), intent ( in ) :: val out % x = vec % x out % y = vec % y out % z = vec % z out % p = val end function init_vec4_vector_real type ( vec4 ) pure elemental function sin_vec ( p ) !! Sine of a vec4, elementwise !> Input vec4 type ( vec4 ), intent ( IN ) :: p sin_vec = vec4 ( sin ( p % x ), sin ( p % y ), sin ( p % z ), sin ( p % p )) end function sin_vec type ( vec4 ) pure elemental function vec_minus_vec ( a , b ) !! Elementwise vec4 - vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> vec4 to subtract type ( vec4 ), intent ( IN ) :: b vec_minus_vec = vec4 ( a % x - b % x , a % y - b % y , a % z - b % z , a % p - b % p ) end function vec_minus_vec type ( vec4 ) pure elemental function vec_add_scal ( a , b ) !! Elementwise vec4 + scalar !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to add real ( kind = wp ), intent ( IN ) :: b vec_add_scal = vec4 ( a % x + b , a % y + b , a % z + b , a % p + b ) end function vec_add_scal type ( vec4 ) pure elemental function scal_add_vec ( a , b ) !! Elementwise scalar + vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: b !> Scalar to add real ( kind = wp ), intent ( IN ) :: a scal_add_vec = vec4 ( b % x + a , b % y + a , b % z + a , b % p + a ) end function scal_add_vec type ( vec4 ) pure elemental function vec_minus_scal ( a , b ) !! Elementwise vec4 - scalar !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to subtract real ( kind = wp ), intent ( IN ) :: b vec_minus_scal = vec4 ( a % x - b , a % y - b , a % z - b , a % p - b ) end function vec_minus_scal type ( vec4 ) pure elemental function scal_minus_vec ( a , b ) !! Elementwise Scalar - vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: b !> Scalar to subtract real ( kind = wp ), intent ( IN ) :: a scal_minus_vec = vec4 ( a - b % x , a - b % y , a - b % z , a - b % p ) end function scal_minus_vec type ( vec4 ) pure elemental function vec_add_vec ( a , b ) !! Elementwise vec4 + vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> vec4 to add type ( vec4 ), intent ( IN ) :: b vec_add_vec = vec4 ( a % x + b % x , a % y + b % y , a % z + b % z , a % p + b % p ) end function vec_add_vec pure elemental function vec_dot_vec ( a , b ) result ( dot ) !! dot product between two vec4s !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> vec4 to dot with type ( vec4 ), intent ( IN ) :: b real ( kind = wp ) :: dot dot = ( a % x * b % x ) + ( a % y * b % y ) + ( a % z * b % z ) + ( a % p * b % p ) end function vec_dot_vec type ( vec4 ) pure elemental function vec_mult_vec ( a , b ) !! Elementwise vec4 * vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> vec4 to multiply by type ( vec4 ), intent ( IN ) :: b vec_mult_vec = vec4 ( a % x * b % x , a % y * b % y , a % z * b % z , a % p * b % p ) end function vec_mult_vec type ( vec4 ) pure elemental function vec_mult_scal ( a , b ) !! Elementwise vec4 * Scalar !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: b vec_mult_scal = vec4 ( a % x * b , a % y * b , a % z * b , a % p * b ) end function vec_mult_scal type ( vec4 ) pure elemental function scal_mult_vec ( a , b ) !! Elementwise Scalar * vec4 !> Input vec4 class ( vec4 ), intent ( IN ) :: b !> Scalar to multiply by real ( kind = wp ), intent ( IN ) :: a scal_mult_vec = vec4 ( a * b % x , a * b % y , a * b % z , a * b % p ) end function scal_mult_vec type ( vec4 ) pure elemental function vec_div_scal_r4 ( a , b ) !! Elementwise vec4 / Scalar. Scalar is 32-bit float use constants , only : sp !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to divide by real ( kind = sp ), intent ( IN ) :: b vec_div_scal_r4 = vec4 ( a % x / b , a % y / b , a % z / b , a % p / b ) end function vec_div_scal_r4 type ( vec4 ) pure elemental function vec_div_scal_r8 ( a , b ) !! Elementwise vec4 / Scalar. Scalar is 32-bit float use constants , only : dp !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to divide by real ( kind = dp ), intent ( IN ) :: b vec_div_scal_r8 = vec4 ( a % x / b , a % y / b , a % z / b , a % p / b ) end function vec_div_scal_r8 type ( vec4 ) pure elemental function vec_div_scal_int ( a , b ) !! Elementwise vec4 / Scalar. Scalar is an integer !> Input vec4 class ( vec4 ), intent ( IN ) :: a !> Scalar to divide by integer , intent ( IN ) :: b vec_div_scal_int = vec4 ( a % x / real ( b , kind = wp ), a % y / real ( b , kind = wp ), a % z / real ( b , kind = wp ), a % p / real ( b , kind = wp )) end function vec_div_scal_int type ( vec4 ) pure elemental function magnitude_fn ( this ) !! Returns the magnitude of a vec4 class ( vec4 ), intent ( in ) :: this magnitude_fn = this / this % length () end function magnitude_fn real ( kind = wp ) pure elemental function length ( this ) !! Returns the length of a vec4 class ( vec4 ), intent ( in ) :: this length = sqrt ( this % x ** 2 + this % y ** 2 + this % z ** 2 + this % p ** 2 ) end function length end Module vec4_class","tags":"","loc":"sourcefile/vec4_class.f90.html"},{"title":"grid.f90 – signedMCRT","text":"Contents Modules gridMod Source Code grid.f90 Source Code module gridMod !! This module defines the cartesian grid type (cart_grid) and associated routines. !! The cart_grid type contains information related to the grid used to record the fluence. This includes the number of voxels in each cardinal direction (nxg, nyg, nzg), the **half** size of the grid in each direction (xmax, ymax, zmax), and the locations of the voxels walls in each direction (xface, yface, zface). !! The type-bound function get_voxel takes a position (vector) and returns the voxel the position falls in. !! !! Init_grid initialises a cart_grid instance. use constants , only : wp implicit none !! Grid class type :: cart_grid !> number of voxels in each cardinal direction for fluence grid integer :: nxg , nyg , nzg !> half size of each dimension in fluence grid. real ( kind = wp ) :: xmax , ymax , zmax !> Delta is the round off for near voxel cell walls real ( kind = wp ) :: delta !> position of each cell wall in fluence grid real ( kind = wp ), allocatable :: xface (:), yface (:), zface (:) contains procedure :: get_voxel end type cart_grid interface cart_grid module procedure init_grid end interface cart_grid public :: cart_grid , init_grid private contains function get_voxel ( this , pos ) result ( res ) !! get current voxel the photon packet is in use vector_class !> grid class class ( cart_grid ) :: this !> current vector position of photon packet type ( vector ), intent ( IN ) :: pos integer :: res ( 3 ) res ( 1 ) = int ( this % nxg * ( pos % x + this % xmax ) / ( 2._wp * this % xmax )) + 1 res ( 2 ) = int ( this % nyg * ( pos % y + this % ymax ) / ( 2._wp * this % ymax )) + 1 res ( 3 ) = int ( this % nzg * ( pos % z + this % zmax ) / ( 2._wp * this % zmax )) + 1 end function get_voxel type ( cart_grid ) function init_grid ( nxg , nyg , nzg , xmax , ymax , zmax ) !! setup grid !> number of voxels in each cardinal direction for fluence grid integer , intent ( IN ) :: nxg , nyg , nzg !> half size of each dimension in fluence grid. real ( kind = wp ), intent ( IN ) :: xmax , ymax , zmax integer :: i init_grid % nxg = nxg init_grid % nyg = nyg init_grid % nzg = nzg init_grid % xmax = xmax init_grid % ymax = ymax init_grid % zmax = zmax allocate ( init_grid % xface ( nxg + 1 ), init_grid % yface ( nyg + 1 ), init_grid % zface ( nzg + 2 )) init_grid % xface = 0._wp init_grid % yface = 0._wp init_grid % zface = 0._wp ! Set small distance for use in optical depth integration routines ! for roundoff effects when crossing cell walls init_grid % delta = 1.e-8_wp * min ((( 2._wp * xmax ) / nxg ), (( 2._wp * ymax ) / nyg ), (( 2._wp * zmax ) / nzg )) do i = 1 , nxg + 1 init_grid % xface ( i ) = ( i - 1 ) * 2._wp * xmax / nxg end do do i = 1 , nyg + 1 init_grid % yface ( i ) = ( i - 1 ) * 2._wp * ymax / nyg end do do i = 1 , nzg + 2 init_grid % zface ( i ) = ( i - 1 ) * 2._wp * zmax / nzg end do end function init_grid end module gridMod","tags":"","loc":"sourcefile/grid.f90.html"},{"title":"inttau2.f90 – signedMCRT","text":"Contents Modules inttau2 Source Code inttau2.f90 Source Code module inttau2 !! inttau2 is the heart of the MCRT simulation. It moves the photons though the simulated media. !! tauint2 is the only public function here and is the main function that moves the photon. !! Changes should only be made here if bugs are discovered or new methods of tracking photons (i.e phase tracking) or moving photons (i.e new geometry method) is needed. use constants , only : wp implicit none private public :: tauint2 , update_voxels contains subroutine tauint2 ( grid , packet , sdfs_array ) !! optical depth integration subroutine !! Moves photons to interaction location !! Calculated is any reflection or refraction happens whilst moving ! use gridMod , only : cart_grid use photonMod , only : photon use random , only : ran2 use sdfs , only : sdf , calcNormal use surfaces , only : reflect_refract use vector_class , only : vector type ( cart_grid ), intent ( in ) :: grid type ( photon ), intent ( inout ) :: packet type ( sdf ), intent ( in ) :: sdfs_array (:) real ( kind = wp ) :: tau , d_sdf , t_sdf , taurun , ds ( size ( sdfs_array )), dstmp ( size ( sdfs_array )) real ( kind = wp ) :: eps , dtot , old ( size ( sdfs_array )), new ( size ( sdfs_array )), n1 , n2 , Ri integer :: i , oldlayer , new_layer type ( vector ) :: pos , dir , oldpos , N logical :: rflag !setup temp variables pos = packet % pos oldpos = pos dir = vector ( packet % nxp , packet % nyp , packet % nzp ) !round off distance eps = 1e-8_wp !get random tau tau = - log ( ran2 ()) taurun = 0. dtot = 0. do !setup sdf distance and current layer ds = 0. do i = 1 , size ( ds ) ds ( i ) = abs ( sdfs_array ( i )% evaluate ( pos )) end do packet % cnts = packet % cnts + size ( ds ) d_sdf = minval ( ds ) if ( d_sdf < eps ) then packet % tflag = . true . exit end if do while ( d_sdf > eps ) t_sdf = d_sdf * sdfs_array ( packet % layer )% getkappa () if ( taurun + t_sdf <= tau ) then !move full distance to sdf surface taurun = taurun + t_sdf oldpos = pos !comment out for phase screen call update_grids ( grid , oldpos , dir , d_sdf , packet , sdfs_array ( packet % layer )% getmua ()) pos = pos + d_sdf * dir dtot = dtot + d_sdf else !run out of tau so move remaining tau and exit d_sdf = ( tau - taurun ) / sdfs_array ( packet % layer )% getkappa () dtot = dtot + d_sdf taurun = tau oldpos = pos pos = pos + d_sdf * dir !comment out for phase screen call update_grids ( grid , oldpos , dir , d_sdf , packet , sdfs_array ( packet % layer )% getmua ()) exit end if ! get distance to nearest sdf ds = 0._wp do i = 1 , size ( ds ) ds ( i ) = sdfs_array ( i )% evaluate ( pos ) end do d_sdf = minval ( abs ( ds ), dim = 1 ) packet % cnts = packet % cnts + size ( ds ) !check if outside all sdfs if ( minval ( ds ) >= 0._wp ) then packet % tflag = . true . exit end if end do !exit early if conditions met if ( taurun >= tau . or . packet % tflag ) then exit end if ds = 0._wp do i = 1 , size ( ds ) ds ( i ) = sdfs_array ( i )% evaluate ( pos ) end do packet % cnts = packet % cnts + size ( ds ) dstmp = ds ds = abs ( ds ) !step a bit into next sdf to get n2 d_sdf = minval ( ds ) + 2._wp * eps oldpos = pos pos = pos + d_sdf * dir ds = 0._wp do i = 1 , size ( ds ) ds ( i ) = sdfs_array ( i )% evaluate ( pos ) end do packet % cnts = packet % cnts + size ( ds ) new = 0._wp old = 0._wp do i = 1 , size ( ds ) if ( dstmp ( i ) < 0. ) then old ( i ) =- 1._wp exit end if end do do i = 1 , size ( ds ) if ( ds ( i ) < 0. ) then new ( i ) =- 1._wp exit end if end do !check for fresnel reflection n1 = sdfs_array ( packet % layer )% getn () new_layer = minloc ( new , dim = 1 ) n2 = sdfs_array ( new_layer )% getn () !carry out refelction/refraction if ( n1 /= n2 ) then !get correct sdf normal if ( ds ( packet % layer ) < 0._wp . and . ds ( new_layer ) < 0._wp ) then oldlayer = minloc ( abs ([ ds ( packet % layer ), ds ( new_layer )]), dim = 1 ) elseif ( dstmp ( packet % layer ) < 0._wp . and . dstmp ( new_layer ) < 0._wp ) then oldlayer = maxloc ([ dstmp ( packet % layer ), dstmp ( new_layer )], dim = 1 ) elseif ( ds ( packet % layer ) > 0._wp . and . ds ( new_layer ) < 0._wp ) then oldlayer = packet % layer elseif ( ds ( packet % layer ) > 0._wp . and . ds ( new_layer ) > 0._wp ) then packet % tflag = . true . exit else error stop \"This should not be reached!\" end if if ( oldlayer == 1 ) then oldlayer = packet % layer else oldlayer = new_layer end if N = calcNormal ( pos , sdfs_array ( oldlayer )) rflag = . false . call reflect_refract ( dir , N , n1 , n2 , rflag , Ri ) packet % weight = packet % weight * Ri tau = - log ( ran2 ()) taurun = 0._wp if (. not . rflag ) then packet % layer = new_layer else !step back inside original sdf pos = oldpos !reflect so incrment bounce counter packet % bounces = packet % bounces + 1 if ( packet % bounces > 1000 ) then packet % tflag = . true . exit end if end if else packet % layer = new_layer end if if ( packet % tflag ) exit end do packet % pos = pos packet % nxp = dir % x packet % nyp = dir % y packet % nzp = dir % z packet % phi = atan2 ( dir % y , dir % x ) packet % sinp = sin ( packet % phi ) packet % cosp = cos ( packet % phi ) packet % cost = dir % z packet % sint = sqrt ( 1._wp - packet % cost ** 2 ) ! packet%step = dtot if ( abs ( packet % pos % x ) > grid % xmax ) then packet % tflag = . true . end if if ( abs ( packet % pos % y ) > grid % ymax ) then packet % tflag = . true . end if if ( abs ( packet % pos % z ) > grid % zmax ) then packet % tflag = . true . end if end subroutine tauint2 subroutine update_grids ( grid , pos , dir , d_sdf , packet , mua ) !! record fluence using path length estimators. Uses voxel grid use vector_class use photonMod use gridMod use iarray , only : phasor , jmean , absorb use constants , only : sp !> grid stores voxel grid information (voxel walls and etc) type ( cart_grid ), intent ( IN ) :: grid !> dir is the current direction (0,0,1) is up type ( vector ), intent ( IN ) :: dir !> d_sdf is the distance to travel in voxel grid real ( kind = wp ), intent ( IN ) :: d_sdf !> absoprtion coefficent real ( kind = wp ), optional , intent ( IN ) :: mua !> pos is current position with origin in centre of medium (0,0,0) type ( vector ), intent ( INOUT ) :: pos !> packet stores the photon related variables type ( photon ), intent ( INOUT ) :: packet complex ( kind = sp ) :: phasec type ( vector ) :: old_pos logical :: ldir ( 3 ) integer :: celli , cellj , cellk real ( kind = wp ) :: dcell , delta = 1e-8_wp , d , mua_real if ( present ( mua )) then mua_real = mua else mua_real = 1._wp end if !convert to different coordinate system. Origin is at lower left corner of fluence grid old_pos = vector ( pos % x + grid % xmax , pos % y + grid % ymax , pos % z + grid % zmax ) call update_voxels ( grid , old_pos , celli , cellj , cellk ) packet % xcell = celli packet % ycell = cellj packet % zcell = cellk d = 0._wp !if packet outside grid return if ( celli == - 1 . or . cellj == - 1 . or . cellk == - 1 ) then packet % tflag = . true . pos = vector ( old_pos % x - grid % xmax , old_pos % y - grid % ymax , old_pos % z - grid % zmax ) return end if !move photon through grid updating path length estimators do ldir = ( / . FALSE ., . FALSE ., . FALSE . / ) dcell = wall_dist ( grid , celli , cellj , cellk , old_pos , dir , ldir ) if ( d + dcell > d_sdf ) then dcell = d_sdf - d d = d_sdf ! needs to be atomic so dont write to same array address with more than 1 thread at a time packet % phase = packet % phase + dcell !$omp atomic jmean ( celli , cellj , cellk ) = jmean ( celli , cellj , cellk ) + real ( dcell , kind = sp ) call update_pos ( grid , old_pos , celli , cellj , cellk , dcell , . false ., dir , ldir , delta ) exit else d = d + dcell packet % phase = packet % phase + dcell !$omp atomic jmean ( celli , cellj , cellk ) = jmean ( celli , cellj , cellk ) + real ( dcell , kind = sp ) call update_pos ( grid , old_pos , celli , cellj , cellk , dcell , . true ., dir , ldir , delta ) end if if ( celli == - 1 . or . cellj == - 1 . or . cellk == - 1 ) then packet % tflag = . true . exit end if end do pos = vector ( old_pos % x - grid % xmax , old_pos % y - grid % ymax , old_pos % z - grid % zmax ) packet % xcell = celli packet % ycell = cellj packet % zcell = cellk end subroutine update_grids function wall_dist ( grid , celli , cellj , cellk , pos , dir , ldir ) result ( res ) !! funtion that returns distant to nearest wall and which wall that is (x, y, or z) use vector_class use gridMod type ( cart_grid ), intent ( IN ) :: grid type ( vector ), intent ( IN ) :: pos , dir logical , intent ( INOUT ) :: ldir (:) integer , intent ( INOUT ) :: celli , cellj , cellk real ( kind = wp ) :: res real ( kind = wp ) :: dx , dy , dz dx = - 99 9._wp dy = - 99 9._wp dz = - 99 9._wp if ( dir % x > 0._wp ) then dx = ( grid % xface ( celli + 1 ) - pos % x ) / dir % x elseif ( dir % x < 0._wp ) then dx = ( grid % xface ( celli ) - pos % x ) / dir % x elseif ( dir % x == 0._wp ) then dx = 10000 0._wp end if if ( dir % y > 0._wp ) then dy = ( grid % yface ( cellj + 1 ) - pos % y ) / dir % y elseif ( dir % y < 0._wp ) then dy = ( grid % yface ( cellj ) - pos % y ) / dir % y elseif ( dir % y == 0._wp ) then dy = 10000 0._wp end if if ( dir % z > 0._wp ) then dz = ( grid % zface ( cellk + 1 ) - pos % z ) / dir % z elseif ( dir % z < 0._wp ) then dz = ( grid % zface ( cellk ) - pos % z ) / dir % z elseif ( dir % z == 0._wp ) then dz = 10000 0._wp end if res = min ( dx , dy , dz ) if ( res < 0._wp ) then print * , 'dcell < 0.0 warning! ' , res print * , dx , dy , dz print * , dir print * , celli , cellj , cellk error stop 1 end if ldir = [ res == dx , res == dy , res == dz ] if (. not . ldir ( 1 ) . and . . not . ldir ( 2 ) . and . . not . ldir ( 3 )) print * , 'Error in dir flag' end function wall_dist subroutine update_pos ( grid , pos , celli , cellj , cellk , dcell , wall_flag , dir , ldir , delta ) !! routine that updates positions of photon and calls Fresnel routines if photon leaves current voxel use vector_class use gridMod use utils , only : str type ( cart_grid ), intent ( IN ) :: grid type ( vector ), intent ( IN ) :: dir logical , intent ( IN ) :: wall_flag , ldir (:) real ( kind = wp ), intent ( IN ) :: dcell , delta type ( vector ), intent ( INOUT ) :: pos integer , intent ( INOUT ) :: celli , cellj , cellk if ( wall_flag ) then if ( ldir ( 1 )) then if ( dir % x > 0._wp ) then pos % x = grid % xface ( celli + 1 ) + delta elseif ( dir % x < 0._wp ) then pos % x = grid % xface ( celli ) - delta else print * , 'Error in x ldir in update_pos' , ldir , dir end if pos % y = pos % y + dir % y * dcell pos % z = pos % z + dir % z * dcell elseif ( ldir ( 2 )) then if ( dir % y > 0._wp ) then pos % y = grid % yface ( cellj + 1 ) + delta elseif ( dir % y < 0._wp ) then pos % y = grid % yface ( cellj ) - delta else print * , 'Error in y ldir in update_pos' , ldir , dir end if pos % x = pos % x + dir % x * dcell pos % z = pos % z + dir % z * dcell elseif ( ldir ( 3 )) then if ( dir % z > 0._wp ) then pos % z = grid % zface ( cellk + 1 ) + delta elseif ( dir % z < 0._wp ) then pos % z = grid % zface ( cellk ) - delta else print * , 'Error in z ldir in update_pos' , ldir , dir end if pos % x = pos % x + dir % x * dcell pos % y = pos % y + dir % y * dcell else print * , 'Error in update_pos... ' // str ( ldir ) error stop 1 end if else pos % x = pos % x + dir % x * dcell pos % y = pos % y + dir % y * dcell pos % z = pos % z + dir % z * dcell end if if ( wall_flag ) then call update_voxels ( grid , pos , celli , cellj , cellk ) end if end subroutine update_pos subroutine update_voxels ( grid , pos , celli , cellj , cellk ) !! updates the current voxel based upon position use vector_class use gridmod !> grid type ( cart_grid ), intent ( IN ) :: grid !> current photon packet position type ( vector ), intent ( IN ) :: pos !> position of photon packet in grid integer , intent ( INOUT ) :: celli , cellj , cellk !accurate but slow ! celli = find(pos%x, grid%xface) ! cellj = find(pos%y, grid%yface) ! cellk = find(pos%z, grid%zface) !fast but can be inaccurate in some cases... celli = floor ( grid % nxg * ( pos % x ) / ( 2. * grid % xmax )) + 1 cellj = floor ( grid % nyg * ( pos % y ) / ( 2. * grid % ymax )) + 1 cellk = floor ( grid % nzg * ( pos % z ) / ( 2. * grid % zmax )) + 1 if ( celli > grid % nxg . or . celli < 1 ) celli = - 1 if ( cellj > grid % nyg . or . cellj < 1 ) cellj = - 1 if ( cellk > grid % nzg . or . cellk < 1 ) cellk = - 1 end subroutine update_voxels integer function find ( val , a ) !! searches for bracketing indices for a value value in an array a !> value to find in array real ( kind = wp ), intent ( in ) :: val !> array to find val in real ( kind = wp ), intent ( in ) :: a (:) integer :: n , lo , mid , hi n = size ( a ) lo = 0 hi = n + 1 if ( val == a ( 1 )) then find = 1 else if ( val == a ( n )) then find = n - 1 else if (( val > a ( n )) . or . ( val < a ( 1 ))) then find = - 1 else do if ( hi - lo <= 1 ) exit mid = ( hi + lo ) / 2 if ( val >= a ( mid )) then lo = mid else hi = mid end if end do find = lo end if end function find end module inttau2","tags":"","loc":"sourcefile/inttau2.f90.html"},{"title":"opticalProperties.f90 – signedMCRT","text":"Contents Modules opticalProperties Source Code opticalProperties.f90 Source Code module opticalProperties !! module implments the optical property abstract type and the types that inheirt from it use constants , only : wp use piecewiseMod implicit none !! abstract optical property type type , abstract :: opticalProp_base !> scattering coeff. cm^{-1} real ( kind = wp ) :: mus !> absoprtion coeff. cm^{-1} real ( kind = wp ) :: mua !> g factor real ( kind = wp ) :: hgg !> g factor squared real ( kind = wp ) :: g2 !> refractive index real ( kind = wp ) :: n !> \\kappa = \\mu_s + \\mu_a real ( kind = wp ) :: kappa !> a = \\frac{\\mu_s}{\\mu_s + \\mu_a} real ( kind = wp ) :: albedo contains procedure ( updateInterface ), deferred :: update end type opticalProp_base abstract interface subroutine updateInterface ( this , wavelength ) use constants , only : wp use piecewiseMod import opticalProp_base implicit none class ( opticalProp_base ), intent ( inout ) :: this real ( kind = wp ), intent ( out ) :: wavelength end subroutine updateInterface end interface type , extends ( opticalProp_base ) :: opticalProp_t class ( opticalProp_base ), allocatable :: value contains procedure :: update => update_opticalProp_t procedure , private :: opticalProp_t_assign generic :: assignment ( = ) => opticalProp_t_assign end type opticalProp_t type , extends ( opticalProp_base ) :: mono contains procedure :: update => updateMono end type mono type , extends ( opticalProp_base ) :: spectral type ( piecewise1D ), private :: mus_a , mua_a , hgg_a , n_a , flux contains procedure :: update => updateSpectral end type spectral interface opticalProp_t module procedure opticaProp_new end interface interface spectral module procedure init_spectral end interface spectral interface mono module procedure init_mono end interface mono private public :: spectral , mono , opticalProp_base , opticalProp_t contains subroutine opticalProp_t_assign ( lhs , rhs ) class ( opticalProp_t ), intent ( inout ) :: lhs class ( opticalProp_base ), intent ( in ) :: rhs if ( allocated ( lhs % value )) deallocate ( lhs % value ) ! Prevent nested derived type select type ( rhsT => rhs ) class is ( opticalProp_t ) if ( allocated ( rhsT % value )) allocate ( lhs % value , source = rhsT % value ) class default allocate ( lhs % value , source = rhsT ) end select end subroutine opticalProp_t_assign ! optical_property initializer type ( opticalProp_t ) function opticaProp_new ( rhs ) result ( lhs ) class ( opticalProp_base ), intent ( in ) :: rhs allocate ( lhs % value , source = rhs ) end function opticaProp_new subroutine update_opticalProp_t ( this , wavelength ) class ( opticalProp_t ), intent ( inout ) :: this real ( kind = wp ), intent ( out ) :: wavelength call this % value % update ( wavelength ) end subroutine update_opticalProp_t type ( mono ) function init_mono ( mus , mua , hgg , n ) result ( res ) real ( kind = wp ), intent ( in ) :: mus , mua , hgg , n res % mus = mus res % mua = mua res % kappa = mus + mua if ( res % mua < 1e-9_wp ) then res % albedo = 1. else res % albedo = res % mus / res % kappa end if res % hgg = hgg res % g2 = hgg ** 2 res % n = n end function init_mono type ( spectral ) function init_spectral ( mus , mua , hgg , n , flux ) result ( res ) real ( kind = wp ), allocatable , intent ( in ) :: mus (:, :), mua (:, :), hgg (:, :), n (:, :), flux (:, :) real ( kind = wp ) :: wave , tmp !setup cdfs res % flux = piecewise1D ( flux ) res % mus_a = piecewise1D ( mus ) res % mua_a = piecewise1D ( mua ) res % hgg_a = piecewise1D ( hgg ) res % n_a = piecewise1D ( n ) !sample wavelength so we can sample from other optical properties at the correct points call res % flux % sample ( wave , tmp ) ! sample optical properties call res % mus_a % sample ( res % mus , wave ) call res % mua_a % sample ( res % mua , wave ) call res % hgg_a % sample ( res % hgg , wave ) res % g2 = res % hgg ** 2 call res % n_a % sample ( res % n , wave ) res % kappa = res % mus + res % mua if ( res % mua < 1e-9_wp ) then res % albedo = 1. else res % albedo = res % mus / res % kappa end if end function init_spectral subroutine updateMono ( this , wavelength ) implicit none class ( Mono ), intent ( inout ) :: this real ( kind = wp ), intent ( out ) :: wavelength ! don't do anything as wavelength will not change wavelength = 0.0_wp end subroutine updateMono subroutine updateSpectral ( this , wavelength ) implicit none class ( spectral ), intent ( inout ) :: this real ( kind = wp ), intent ( out ) :: wavelength real ( kind = wp ) :: tmp !get wavelength call this % flux % sample ( wavelength , tmp ) !update mus call this % mus_a % sample ( this % mus , tmp , wavelength ) !update mua call this % mua_a % sample ( this % mua , tmp , wavelength ) !update hgg call this % hgg_a % sample ( this % hgg , tmp , wavelength ) this % g2 = this % hgg ** 2 !update n call this % n_a % sample ( this % n , tmp , wavelength ) !update kappa and albedo this % kappa = this % mus + this % mua this % albedo = this % mus / this % kappa end subroutine updateSpectral end module opticalProperties","tags":"","loc":"sourcefile/opticalproperties.f90.html"},{"title":"piecewise.f90 – signedMCRT","text":"Contents Modules piecewiseMod Source Code piecewise.f90 Source Code module piecewiseMod !! This file contains the piecewise abstract type, for sampling from constants, 1D or 2D arrays. Inspired by [PBRT](https://www.pbr-book.org/) piecewise class. !! Currently, the following public types are defined: !! - Constant. Used in the case where there is only one value. !! - 1D. Used in the case where there is a spectrum !! - 2D. Used in the case where SLM or other image based source types are needed. !! The piecewise type ensures that there is a method (sample) that can be called on all inherited types, e.g !! call 2Dimage%p%sample(x, y) !! will return a position (x,y) from where to release a photon. !! This class can be used to have multi-spectral or single valued wavelength, or used as a 2D image input source i.e SLMs. !! NOTE: optical properties are not currently adjusted on wavelength change. use iso_fortran_env , only : int32 , int64 use constants , only : wp implicit none !> Abstract spectrum base type. type , abstract :: piecewise contains !> Deferred procdure. Used to generate a sample from spectrum or get constant value etc. procedure ( sampleInterface ), deferred :: sample end type piecewise abstract interface subroutine sampleInterface ( this , x , y , value ) use constants , only : wp import piecewise implicit none class ( piecewise ), intent ( in ) :: this real ( kind = wp ), intent ( out ) :: x , y real ( kind = wp ), intent ( in ), optional :: value end subroutine sampleInterface end interface !> Spectrum_t type. Used as a container type type :: spectrum_t class ( piecewise ), pointer :: p => null () end type spectrum_t !> Constant piecewise type. i.e a piecewise function that does not change value type , extends ( piecewise ) :: constant !> The constant value real ( kind = wp ) :: value contains !> Sampling routine procedure :: sample => getValue end type constant !> 1D piecewise type. Used for the spectral type type , extends ( piecewise ) :: piecewise1D !> Input array to sample from. Should be size(n, 2). 1st column is x-axis, 2nd column is y-axis real ( kind = wp ), allocatable :: array (:, :) !> cumulative distribution function (CDF) of array. real ( kind = wp ), allocatable :: cdf (:) contains !> Overloaded sampling function procedure :: sample => sample1D end type piecewise1D !> 2D piecewise type. Used for images type , extends ( piecewise ) :: piecewise2D !> Height of each cell real ( kind = wp ) :: cell_height !> Width of each cell real ( kind = wp ) :: cell_width !>cumulative distribution function (CDF) of array. real ( kind = wp ), allocatable :: cdf (:) !> Offsets integer , private :: xoffset , yoffset contains !> Overloaded sampling function procedure :: sample => sample2D end type piecewise2D interface piecewise1D !> Initalise piecewise1D module procedure init_piecewise1D end interface piecewise1D interface piecewise2D !> Initalise piecewise2D module procedure init_piecewise2D end interface piecewise2D ! private public :: spectrum_t , piecewise , piecewise1D , piecewise2D , constant contains subroutine getValue ( this , x , y , value ) !! The constant version of sample class ( constant ), intent ( in ) :: this !> Output value real ( kind = wp ), intent ( out ) :: x !> Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D real ( kind = wp ), intent ( out ) :: y !> Not used. Kept to keep interface the same for constant, piecewise1D and piecewise2D real ( kind = wp ), intent ( in ), optional :: value x = this % value y = - 999 9._wp end subroutine getValue subroutine sample1D ( this , x , y , value ) !! Randomly sample from 1D array use random , only : ran2 , ranu class ( piecewise1D ), intent ( in ) :: this !> Return value real ( kind = wp ), intent ( out ) :: x !> Not used, but here so we can have same interface as 2D sample routine. real ( kind = wp ), intent ( out ) :: y !> Optional x value. If not present we generate a random one in the range [0., 1.] real ( kind = wp ), intent ( in ), optional :: value integer ( kind = int64 ) :: idx real ( kind = wp ) :: val if (. not . present ( value )) then !get random x coordinate then get corresponding y val = ran2 () call search_1D ( this % cdf , idx , val ) x = this % array ( idx , 1 ) + & (( val - this % cdf ( idx )) * ( this % array ( idx + 1 , 1 ) - this % array ( idx , 1 ))) / ( this % cdf ( idx + 1 ) - this % cdf ( idx )) else !already have x so get y call search_2D ( this % array , idx , value ) x = this % array ( idx , 2 ) + ( this % array ( idx + 1 , 2 ) - this % array ( idx , 2 )) * & (( value - this % array ( idx , 1 )) / ( this % array ( idx + 1 , 1 ) - this % array ( idx , 1 ))) end if end subroutine sample1D type ( piecewise1D ) function init_piecewise1D ( array ) result ( res ) !! initalise the piecewise1D type with an array size (n, 2). Calculates the CDF of this array. !> Input array use stdlib_quadrature , only : trapz_weights real ( kind = wp ), intent ( in ) :: array (:, :) integer :: i , length real ( kind = wp ) :: weights ( size ( array , 1 )), sumer if ( size ( array , 2 ) /= 2 ) error stop \"Array must be size (n, 2)\" res % array = array length = size ( array , 1 ) allocate ( res % cdf ( length )) res % cdf = 0. ! Generate CDF array from PDF array via Trapezoidal rule weights = trapz_weights ( array (:, 1 )) sumer = 0. do i = 2 , length sumer = sumer + weights ( i ) * array ( i , 2 ) res % cdf ( i ) = sumer end do ! normalise res % cdf = res % cdf / res % cdf ( length ) end function init_piecewise1D subroutine sample2D ( this , x , y , value ) ! TODO cite where you got this from... use random , only : ran2 , ranu class ( piecewise2D ), intent ( in ) :: this real ( kind = wp ), intent ( out ) :: x , y real ( kind = wp ), intent ( in ), optional :: value integer ( kind = int32 ) :: xr , yr integer ( kind = int64 ) :: idx real ( kind = wp ) :: val val = ran2 () call search_1D ( this % cdf , idx , val ) call decode ( idx , xr , yr ) x = real ( xr - this % xoffset , kind = wp ) + ranu ( - this % cell_width , this % cell_width ) y = real ( yr - this % yoffset , kind = wp ) + ranu ( - this % cell_height , this % cell_height ) end subroutine sample2D type ( piecewise2D ) function init_piecewise2D ( cell_width , cell_height , image ) !! Initalise the piecewise2D type with a given cell_width, cell_height and input image !> Input cell width real ( kind = wp ), intent ( in ) :: cell_width !> Input cell height real ( kind = wp ), intent ( in ) :: cell_height !> Input image real ( kind = wp ), intent ( in ) :: image (:,:) real ( kind = wp ), allocatable :: HC1D (:), imagenew (:,:) integer :: width , height , w2 , h2 integer ( kind = int64 ) :: i integer ( kind = int32 ) :: x , y width = size ( image , 1 ) height = size ( image , 2 ) ! need to pad image for z-order to work... w2 = nextpwr2 ( width ) h2 = nextpwr2 ( height ) allocate ( imagenew ( w2 , h2 )) imagenew = 0. init_piecewise2D % xoffset = ( h2 - height ) / 2 init_piecewise2D % yoffset = ( w2 - width ) / 2 imagenew ( init_piecewise2D % xoffset : init_piecewise2D % xoffset + width - 1 , & init_piecewise2D % yoffset : init_piecewise2D % yoffset + height - 1 ) = image allocate ( init_piecewise2D % cdf ( w2 * h2 )) allocate ( HC1D ( w2 * h2 )) HC1D = 0. do i = 0 , ( h2 * w2 ) - 1 call decode ( i , x , y ) HC1D ( i + 1 ) = imagenew ( x + 1 , y + 1 ) end do init_piecewise2D % cdf ( 1 ) = HC1D ( 1 ) do i = 2 , size ( HC1D ) init_piecewise2D % cdf ( i ) = init_piecewise2D % cdf ( i - 1 ) + HC1D ( i ) end do init_piecewise2D % cell_height = cell_height init_piecewise2D % cell_width = cell_width init_piecewise2D % cdf = init_piecewise2D % cdf / init_piecewise2D % cdf ( size ( init_piecewise2D % cdf )) end function init_piecewise2D integer function nextpwr2 ( v ) result ( res ) !! Get the next power of 2. i.e given 5 will return 8 (4^2) !! only works on 32bit ints !! [ref](https://graphics.stanford.edu/~seander/bithacks.html#RoundUpPowerOf2) integer , intent ( in ) :: v res = v - 1 res = ior ( res , rshift ( res , 1 )) res = ior ( res , rshift ( res , 2 )) res = ior ( res , rshift ( res , 4 )) res = ior ( res , rshift ( res , 8 )) res = ior ( res , rshift ( res , 16 )) res = res + 1 end function nextpwr2 subroutine search_1D ( array , nlow , value ) !! search by bisection for 1D array !> Array to search real ( kind = wp ), intent ( in ) :: array (:) !> index of found value integer ( kind = int64 ), intent ( out ) :: nlow !> value to find in 1D array real ( kind = wp ), intent ( in ) :: value integer :: nup , middle nup = size ( array ) nlow = 1 middle = int (( nup + nlow ) / 2. ) do while (( nup - nlow ) > 1 ) middle = int (( nup + nlow ) / 2. ) if ( value > array ( middle )) then nlow = middle else nup = middle end if end do end subroutine search_1D subroutine search_2D ( array , nlow , value ) !! search by bisection for 1D array !> 2D array to search. Only searches 1st column real ( kind = wp ), intent ( in ) :: array (:, :) !> Index of found index integer ( kind = int64 ), intent ( out ) :: nlow !> Value to find in the array. real ( kind = wp ), intent ( in ) :: value integer :: nup , middle nup = size ( array , 1 ) nlow = 1 middle = int (( nup + nlow ) / 2. ) do while (( nup - nlow ) > 1 ) middle = int (( nup + nlow ) / 2. ) if ( value > array ( middle , 1 )) then nlow = middle else nup = middle end if end do end subroutine search_2D integer ( kind = int64 ) function pack_bits ( z ) result ( x ) !! Reverse the split function. I.e go from 0a0b0c0d to abcd !! Adapted from archer2 cpp [course](https://github.com/EPCCed/archer2-cpp/tree/main/exercises/morton-order) !> Input interleaved integer integer ( kind = int64 ), intent ( in ) :: z x = z x = iand ( x , 6148914691236517205_int64 ) x = ior ( rshift ( x , 1 ), x ) x = iand ( x , 3689348814741910323_int64 ) x = ior ( rshift ( x , 2 ), x ) x = iand ( x , 1085102592571150095_int64 ) x = ior ( rshift ( x , 4 ), x ) x = iand ( x , 71777214294589695_int64 ) x = ior ( rshift ( x , 8 ), x ) x = iand ( x , 281470681808895_int64 ) x = ior ( rshift ( x , 16 ), x ) end function pack_bits subroutine decode ( z , x , y ) !! Compute the 2 indices from a Morton index !! Adapted from archer2 cpp [course](https://github.com/EPCCed/archer2-cpp/tree/main/exercises/morton-order) !> Morton Index integer ( kind = int64 ), intent ( in ) :: z !> The computed indices integer ( kind = int32 ), intent ( out ) :: x , y integer ( kind = int64 ) :: i , j i = z x = pack_bits ( i ) j = rshift ( z , 1 ) y = pack_bits ( j ) end subroutine decode end module piecewiseMod","tags":"","loc":"sourcefile/piecewise.f90.html"},{"title":"detectors.f90 – signedMCRT","text":"Contents Modules detectors Source Code detectors.f90 Source Code module detectors !! Module contains each detector type which inherits from the base detector class. !! detectors detect photon packets colliding with the detectors. use constants , only : wp use detector_mod , only : detector , detector1D , detector2D , hit_t use vector_class , only : vector , length implicit none !> Circle detector type , extends ( detector1D ) :: circle_dect !> Radius of detector real ( kind = wp ) :: radius contains procedure :: check_hit => check_hit_circle end type circle_dect interface circle_dect !> Initialise circular detector module procedure init_circle_dect end interface circle_dect !> Annuluar detector type , extends ( detector1D ) :: annulus_dect !> Inner radius real ( kind = wp ) :: r1 !> Outer radius real ( kind = wp ) :: r2 contains procedure :: check_hit => check_hit_annulus end type annulus_dect interface annulus_dect !> Initialise annuluar detector module procedure init_annulus_dect end interface annulus_dect !> Rectangular or \"camera\" detector type , extends ( detector2D ) :: camera !> Normal of the detector type ( vector ) :: n !> Vector from pos (1st corner) to the 2nd corner of the detector type ( vector ) :: p2 !> Vector from pos (1st corner) to the 3rd corner of the detector type ( vector ) :: p3 !> Edge vector of detector type ( vector ) :: e1 !> Edge vector of detector type ( vector ) :: e2 !> Width of the detector real ( kind = wp ) :: width !> Height of the detector real ( kind = wp ) :: height contains procedure :: check_hit => check_hit_camera end type camera interface camera module procedure init_camera end interface camera !> Detector array type :: dect_array class ( detector ), pointer :: p => null () end type dect_array private public :: camera , annulus_dect , circle_dect , dect_array contains function init_circle_dect ( pos , dir , layer , radius , nbins , maxval , trackHistory ) result ( out ) !! Initalise Circle detector !> Centre of detector type ( vector ), intent ( in ) :: pos !> Normal of the detector type ( vector ), intent ( in ) :: dir !> Layer ID integer , intent ( in ) :: layer !> Number of bins in the detector integer , intent ( in ) :: nbins !> Radius of the detector real ( kind = wp ), intent ( in ) :: radius !> Maximum value to store in bins real ( kind = wp ), intent ( in ) :: maxval !> Boolean on if to store photon's history prior to hitting the detector. logical , intent ( in ) :: trackHistory type ( circle_dect ) :: out out % dir = dir out % pos = pos out % layer = layer !extra bin for data beyond end of array out % nbins = nbins + 1 out % radius = radius allocate ( out % data ( out % nbins )) out % data = 0.0_wp if ( nbins == 0 ) then out % bin_wid = 1._wp else out % bin_wid = maxval / real ( nbins - 1 , kind = wp ) end if out % trackHistory = trackHistory end function init_circle_dect logical function check_hit_circle ( this , hitpoint ) !! Check if a hitpoint is in the circle use geometry , only : intersectCircle class ( circle_dect ), intent ( INOUT ) :: this !> Hitpoint to check type ( hit_t ), intent ( IN ) :: hitpoint real ( kind = wp ) :: t check_hit_circle = . false . if ( this % layer /= hitpoint % layer ) return check_hit_circle = intersectCircle ( this % dir , this % pos , this % radius , hitpoint % pos , hitpoint % dir , t ) if ( check_hit_circle ) then if ( t > 5e-3_wp ) check_hit_circle = . false . end if end function check_hit_circle function init_annulus_dect ( pos , dir , layer , r1 , r2 , nbins , maxval , trackHistory ) result ( out ) !! Initalise Annular detector !> Centre of detector type ( vector ), intent ( in ) :: pos !> Normal of the detector type ( vector ), intent ( in ) :: dir !> Layer ID integer , intent ( in ) :: layer !> Inner radius real ( kind = wp ), intent ( IN ) :: r1 !> Outer radius real ( kind = wp ), intent ( IN ) :: r2 !> Number of bins in the detector integer , intent ( in ) :: nbins !> Maximum value to store in bins real ( kind = wp ), intent ( in ) :: maxval !> Boolean on if to store photon's history prior to hitting the detector. logical , intent ( in ) :: trackHistory type ( annulus_dect ) :: out out % pos = pos out % dir = dir out % layer = layer !extra bin for data beyond end of array out % nbins = nbins + 1 out % r1 = r1 out % r2 = r2 allocate ( out % data ( out % nbins )) out % data = 0.0_wp if ( nbins == 0 ) then out % bin_wid = 1._wp else out % bin_wid = maxval / real ( nbins , kind = wp ) end if out % trackHistory = trackHistory end function init_annulus_dect logical function check_hit_annulus ( this , hitpoint ) !! Check if a hitpoint is in the annulus class ( annulus_dect ), intent ( INOUT ) :: this !> Hitpoint to check type ( hit_t ), intent ( IN ) :: hitpoint real ( kind = wp ) :: newpos check_hit_annulus = . false . if ( this % layer /= hitpoint % layer ) return newpos = sqrt (( hitpoint % pos % x - this % pos % x ) ** 2 + ( hitpoint % pos % y - this % pos % y ) ** 2 + ( hitpoint % pos % z - this % pos % z ) ** 2 ) if ( newpos >= this % r1 . and . newpos <= this % r2 ) then check_hit_annulus = . true . end if end function check_hit_annulus function init_camera ( p1 , p2 , p3 , layer , nbins , maxval , trackHistory ) result ( out ) !! Initalise Camera detector !> Position of the 1st corner of the detector type ( vector ), intent ( in ) :: p1 !> Distance from p1 to the 2nd corner type ( vector ), intent ( in ) :: p2 !> Distance from p1 to the 3rd corner type ( vector ), intent ( in ) :: p3 !> Layer ID integer , intent ( in ) :: layer !> Number of bins in the detector integer , intent ( in ) :: nbins !> Maximum value to store in bins real ( kind = wp ), intent ( in ) :: maxval !> Boolean on if to store photon's history prior to hitting the detector. logical , intent ( in ) :: trackHistory type ( camera ) :: out out % pos = p1 out % p2 = p2 out % p3 = p3 out % e1 = p2 - p1 out % e2 = p3 - p1 out % width = length ( out % e1 ) out % height = length ( out % e2 ) out % n = out % e2 . cross . out % e1 out % n = out % n % magnitude () out % layer = layer !extra bin for data beyond end of array out % nbinsX = nbins + 1 out % nbinsY = nbins + 1 allocate ( out % data ( out % nbinsX , out % nbinsY )) out % data = 0.0_wp if ( nbins == 0 ) then out % bin_wid_x = 1._wp out % bin_wid_y = 1._wp else out % bin_wid_x = maxval / real ( out % nbinsX , kind = wp ) out % bin_wid_y = maxval / real ( out % nbinsY , kind = wp ) end if out % trackHistory = trackHistory end function init_camera logical function check_hit_camera ( this , hitpoint ) !! Check if a hitpoint is in the camera detector !! [ref](https://www.scratchapixel.com/lessons/3d-basic-rendering/minimal-ray-tracer-rendering-simple-shapes/ray-plane-and-ray-disk-intersection) class ( camera ), intent ( inout ) :: this !> Hitpoint to check type ( hit_t ), intent ( in ) :: hitpoint real ( kind = wp ) :: t , proj1 , proj2 type ( vector ) :: v check_hit_camera = . false . if ( this % layer /= hitpoint % layer ) return t = (( this % pos - hitpoint % pos ) . dot . this % n ) / ( hitpoint % dir . dot . this % n ) if ( t >= 0._wp ) then v = ( hitpoint % pos + t * hitpoint % dir ) - this % pos proj1 = ( v . dot . this % e1 ) / this % width proj2 = ( v . dot . this % e2 ) / this % height if (( proj1 < this % width . and . proj1 > 0._wp ) . and . ( proj2 < this % height . and . proj2 > 0._wp )) then check_hit_camera = . true . end if end if end function check_hit_camera end module detectors","tags":"","loc":"sourcefile/detectors.f90.html"},{"title":"detector_base.f90 – signedMCRT","text":"Contents Modules detector_mod Source Code detector_base.f90 Source Code module detector_mod !! Module contains photon detector abstract class and the derived types the inherit from it !! not fully implmented use vector_class use constants , only : wp implicit none !> Hit type, which records possible interaction information type :: hit_t !> Poition of the interaction type ( vector ) :: pos !> Direction the photon came from type ( vector ) :: dir !> Value to deposit real ( kind = wp ) :: value !> Layer ID of interaction integer :: layer end type hit_t !only needed if using a stack to init with a single null value interface hit_t module procedure hit_init end interface hit_t !> abstract detector type , abstract :: detector !> position of the detector type ( vector ) :: pos !> Surface normal of the detector type ( vector ) :: dir !> Layer ID of the detector integer :: layer !> Boolean, if true store the history of the photon prior to detection. logical :: trackHistory contains procedure ( recordHitInterface ), deferred , public :: record_hit procedure ( checkHitInterface ), deferred , public :: check_hit end type detector abstract interface logical function checkHitInterface ( this , hitpoint ) use vector_class use constants , only : wp import detector , hit_t class ( detector ), intent ( inout ) :: this type ( hit_t ), intent ( in ) :: hitpoint end function checkHitInterface subroutine recordHitInterface ( this , hitpoint , history ) use constants , only : wp use historyStack , only : history_stack_t use vector_class import detector , hit_t class ( detector ), intent ( inout ) :: this type ( hit_t ), intent ( in ) :: hitpoint type ( history_stack_t ), intent ( inout ) :: history end subroutine recordHitInterface end interface !> 1D detector type. Records linear information type , abstract , extends ( detector ) :: detector1D !> Number of bins integer :: nbins !> Bin width real ( kind = wp ) :: bin_wid !> Bins real ( kind = wp ), allocatable :: data (:) contains procedure :: record_hit => record_hit_1D_sub end type detector1D !> 2D detecctor type. Records spatial information type , abstract , extends ( detector ) :: detector2D !> Number of bins in x dimension (detector space) integer :: nbinsX !> Number of bins in y dimension (detector space) integer :: nbinsY !> Bin width in the x dimension real ( kind = wp ) :: bin_wid_x !> Bin width in the y dimension real ( kind = wp ) :: bin_wid_y !> Bins real ( kind = wp ), allocatable :: data (:,:) contains procedure :: record_hit => record_hit_2D_sub end type detector2D private public :: detector , detector1D , detector2D , hit_t contains type ( hit_t ) function hit_init ( val ) real ( kind = wp ), intent ( in ) :: val type ( vector ) :: tmp tmp = vector ( val , val , val ) hit_init = hit_t ( tmp , tmp , val , int ( val )) end function hit_init subroutine record_hit_1D_sub ( this , hitpoint , history ) !! check if a hit is on the detector and record it if so use historyStack , only : history_stack_t use sim_state_mod , only : state class ( detector1D ), intent ( inout ) :: this !> Interaction information type ( hit_t ), intent ( in ) :: hitpoint !> Photon packet history type ( history_stack_t ), intent ( inout ) :: history real ( kind = wp ) :: value integer :: idx if ( this % check_hit ( hitpoint )) then value = hitpoint % value idx = min ( nint ( value / this % bin_wid ) + 1 , this % nbins ) !$omp atomic this % data ( idx ) = this % data ( idx ) + 1 if ( this % trackHistory ) then call history % write () end if end if if ( state % trackHistory ) call history % zero () end subroutine record_hit_1D_sub subroutine record_hit_2D_sub ( this , hitpoint , history ) !! check if a hit is on the detector and record it if so use historyStack , only : history_stack_t use sim_state_mod , only : state class ( detector2D ), intent ( inout ) :: this !> Interaction information type ( hit_t ), intent ( in ) :: hitpoint !> Photon packet history type ( history_stack_t ), intent ( inout ) :: history real ( kind = wp ), volatile :: x , y integer :: idx , idy if ( this % check_hit ( hitpoint )) then x = hitpoint % pos % z + this % pos % x y = hitpoint % pos % y + this % pos % y idx = min ( int ( x / this % bin_wid_x ) + 1 , this % nbinsX ) idy = min ( int ( y / this % bin_wid_y ) + 1 , this % nbinsY ) if ( idx < 1 ) idx = this % nbinsX if ( idy < 1 ) idy = this % nbinsY !$omp atomic this % data ( idx , idy ) = this % data ( idx , idy ) + 1 if ( this % trackHistory ) then call history % write () end if end if if ( state % trackHistory ) call history % zero () end subroutine record_hit_2D_sub end module detector_mod ! program test ! use detector_mod ! use vector_class ! use constants, only : wp ! implicit none ! type(hit_t) :: hit ! type(vector) :: pos, dir ! integer :: layer ! type(circle_dect) :: dect_c ! type(annulus_dect) :: dect_a ! dect_c = circle_dect(vector(0._wp, 0._wp, 0._wp), 1, .5_wp, 100, 100._wp) ! dect_a = annulus_dect(vector(0._wp, 0._wp, 0._wp), 1, .25_wp, .5_wp, 100, 100._wp) ! layer = 1 ! pos = vector(0._wp, .5_wp, 0._wp) ! dir = vector(0._wp, 0._wp, 1._wp) ! hit = hit_t(pos, dir, 99._wp, layer) ! call dect_c%record_hit(hit) ! print*,sum(dect_c%data) ! pos = vector(0._wp, .25_wp, 0._wp) ! dir = vector(0._wp, 0._wp, 1._wp) ! hit = hit_t(pos, dir, 99._wp, layer) ! call dect_a%record_hit(hit) ! print*,sum(dect_a%data) ! end program test","tags":"","loc":"sourcefile/detector_base.f90.html"},{"title":"sdfs.f90 – signedMCRT","text":"Contents Modules sdfs Source Code sdfs.f90 Source Code module sdfs !! This module defines the signed distance function (SDF) abstract type and all types that inherit from it. !! The SDF abstract type defines the optical properties of an SDF (mus, mua, kappa, albedo, hgg, g2,and n), as well as a transform (4x4 matrix), and the layer ID code of the SDF. !! The SDF abstract type also provides an abstract interface (evaluate) which each inheriting function must implement. This evaluate function is the heart of the SDF implementation. !! Each individual evaluate is the direct implementation of that SDF, e.g. that function defines the mathematical SDF. !! For more information on SDFs, check out Inigo Quilez's [website](https://iquilezles.org/articles/) from which most of the below SDFs and transforms have been taken. !! - cylinder !! - sphere !! - box !! - torus !! - cone !! - triprism (triangular prism) !! - capsule !! - plane !! - segment !! - egg !! **This is the module the user should import to other module not sdf_base!** use constants , only : wp use opticalProperties , only : opticalProp_t use sdf_baseMod , only : sdf , sdf_base , model , calcNormal , render use sdfHelpers , only : identity use vector_class implicit none !> Box SDF type , extends ( sdf_base ) :: box !> Length of each dimension of the box type ( vector ) :: lengths contains procedure :: evaluate => evaluate_box end type box !> Sphere SDF type , extends ( sdf_base ) :: sphere real ( kind = wp ) :: radius contains procedure :: evaluate => evaluate_sphere end type sphere !> Cylinder SDF type , extends ( sdf_base ) :: cylinder real ( kind = wp ) :: radius type ( vector ) :: a , b contains procedure :: evaluate => evaluate_cylinder end type cylinder !> Torus SDF type , extends ( sdf_base ) :: torus real ( kind = wp ) :: oradius , iradius contains procedure :: evaluate => evaluate_torus end type torus !> Triprisim SDF type , extends ( sdf_base ) :: triprism real ( kind = wp ) :: h1 , h2 contains procedure :: evaluate => evaluate_triprism end type triprism !> Cone SDF type , extends ( sdf_base ) :: cone type ( vector ) :: a , b real ( kind = wp ) :: ra , rb contains procedure :: evaluate => evaluate_cone end type cone !> Capsule SDF type , extends ( sdf_base ) :: capsule type ( vector ) :: a , b real ( kind = wp ) :: r contains procedure :: evaluate => evaluate_capsule end type capsule !> Plane SDF type , extends ( sdf_base ) :: plane type ( vector ) :: a contains procedure :: evaluate => evaluate_plane end type plane !> Segment SDF (2D) type , extends ( sdf_base ) :: segment type ( vector ) :: a , b contains procedure :: evaluate => evaluate_segment end type segment !> Egg SDF type , extends ( sdf_base ) :: egg real ( kind = wp ) :: r1 , r2 , h contains procedure :: evaluate => evaluate_egg end type egg interface sphere module procedure sphere_init end interface sphere interface box !! Interface to box SDF initialising function module procedure box_init end interface box interface torus !! Interface to torus SDF initialising function module procedure torus_init end interface torus interface cylinder !! Interface to cylinder SDF initialising function module procedure cylinder_init end interface cylinder interface triprism !! Interface to triprisim SDF initialising function module procedure triprism_init end interface triprism interface egg !! Interface to egg SDF initialising function module procedure egg_init end interface egg interface segment !! Interface to segment SDF initialising function module procedure segment_init end interface segment interface cone !! Interface to cone SDF initialising function module procedure cone_init end interface cone interface capsule !! Interface to capsule SDF initialising function module procedure capsule_init end interface capsule interface plane !! Interface to plane SDF initialising function module procedure plane_init end interface plane private public :: plane , capsule , cone , segment , egg , triprism , cylinder , torus , box , sphere , sdf , model , calcNormal , render contains function segment_init ( a , b , optProp , layer , transform ) result ( out ) !! Initalising function for segment SDF. !! Note this is a 2D function type ( segment ) :: out !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp !> segment start point type ( vector ), intent ( IN ) :: a !> segment end point type ( vector ), intent ( IN ) :: b !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % b = b out % layer = layer out % transform = t out % optProps = optProp end function segment_init function egg_init ( r1 , r2 , h , optProp , layer , transform ) result ( out ) !! Initalising function for egg SDF. !! makes a Moss egg. [ref](https://www.shadertoy.com/view/WsjfRt). type ( egg ) :: out !> R1 controls \"fatness\" of the egg. Actually controls the base circle radius. real ( kind = wp ), intent ( IN ) :: r1 !> R2 contorls the pointiness of the egg. Actually controls radius of top circle. real ( kind = wp ), intent ( in ) :: r2 !> h controls the height of the egg. Actually controls y position of top circle. real ( kind = wp ), intent ( in ) :: h !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % h = h out % r1 = r1 out % r2 = r2 out % layer = layer out % transform = t out % optProps = optProp end function egg_init function plane_init ( a , optProp , layer , transform ) result ( out ) !! Initalising function for plane SDF. type ( plane ) :: out !> Plane normal. must be normalised type ( vector ), intent ( IN ) :: a !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % layer = layer out % transform = t out % optProps = optProp end function plane_init function capsule_init ( a , b , r , optProp , layer , transform ) result ( out ) !! Initalising function for capsule SDF. type ( capsule ) :: out !> Capsule startpoint type ( vector ), intent ( IN ) :: a !> Capsule endpoint type ( vector ), intent ( IN ) :: b !> Capsule radius real ( kind = wp ), intent ( IN ) :: r !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % b = b out % r = r out % layer = layer out % transform = t out % optProps = optProp end function capsule_init function triprism_init ( h1 , h2 , optProp , layer , transform ) result ( out ) !! Initalising function for triprisim SDF. type ( triprism ) :: out !> Height of triprisim real ( kind = wp ), intent ( IN ) :: h1 !> length of triprisim real ( kind = wp ), intent ( IN ) :: h2 !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % h1 = h1 out % h2 = h2 out % layer = layer out % transform = t out % optProps = optProp end function triprism_init function cone_init ( a , b , ra , rb , optProp , layer , transform ) result ( out ) !! Initalising function for Capped Cone SDF. type ( cone ) :: out !> Centre of base of Cone type ( vector ), intent ( IN ) :: a !> Tip of cone type ( vector ), intent ( IN ) :: b !> Radius of Cones base real ( kind = wp ), intent ( IN ) :: ra !> Radius of Cones tip. For rb = 0.0 get normal uncapped cone. real ( kind = wp ), intent ( in ) :: rb !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % b = b out % ra = ra out % rb = rb out % layer = layer out % transform = t out % optProps = optProp end function cone_init function cylinder_init ( a , b , radius , optProp , layer , transform ) result ( out ) !! Initalising function for Cylinder SDF. type ( cylinder ) :: out !> Radius of cylinder real ( kind = wp ), intent ( in ) :: radius !> Vector position at centre of the bottom circle type ( vector ), intent ( IN ) :: a !> Vector position at centre of the top circle type ( vector ), intent ( IN ) :: b !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % a = a out % b = b out % radius = radius out % layer = layer out % transform = t out % optProps = optProp end function cylinder_init function torus_init ( oradius , iradius , optProp , layer , transform ) result ( out ) !! Initalising function for Torus SDF. type ( torus ) :: out !> Outer radius of Torus real ( kind = wp ), intent ( IN ) :: oradius !> Inner radius of Torus real ( kind = wp ), intent ( IN ) :: iradius !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % oradius = oradius out % iradius = iradius out % layer = layer out % transform = t out % optProps = optProp end function torus_init function box_init ( lengths , optProp , layer , transform ) result ( out ) !! Initalising function for Box SDF. type ( box ) :: out !> Lengths of each dimension of the box type ( vector ), intent ( IN ) :: lengths !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % lengths = . 5_wp * lengths ! as only half lengths out % layer = layer out % transform = t out % optProps = optProp end function box_init function sphere_init ( radius , optProp , layer , transform ) result ( out ) !! Initalising function for Sphere SDF. type ( sphere ) :: out !> radius of the Sphere real ( kind = wp ), intent ( IN ) :: radius !> ID number of sdf integer , intent ( IN ) :: layer !> Optional transform to apply to SDF real ( kind = wp ), optional , intent ( IN ) :: transform ( 4 , 4 ) !> Optical properties of the SDF type ( opticalProp_t ), intent ( in ) :: optProp real ( kind = wp ) :: t ( 4 , 4 ) if ( present ( transform )) then t = transform else t = identity () end if out % radius = radius out % layer = layer out % transform = t out % optProps = optProp end function sphere_init pure elemental function evaluate_sphere ( this , pos ) result ( res ) !! Evaluation function for Sphere SDF. class ( sphere ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: p p = pos . dot . this % transform res = sqrt ( p % x ** 2 + p % y ** 2 + p % z ** 2 ) - this % radius end function evaluate_sphere pure elemental function evaluate_box ( this , pos ) result ( res ) !! Evaluation function for Box SDF. class ( box ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: p , q p = pos . dot . this % transform q = abs ( p ) - this % lengths res = length ( max ( q , 0._wp )) + min ( max ( q % x , max ( q % y , q % z )), 0._wp ) end function evaluate_box pure elemental function evaluate_torus ( this , pos ) result ( res ) !! Evaluation function for Torus SDF. class ( torus ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: p , q p = pos . dot . this % transform q = vector ( length ( vector ( p % x , 0._wp , p % z )) - this % oradius , p % y , 0._wp ) res = length ( q ) - this % iradius end function evaluate_torus pure elemental function evaluate_cylinder ( this , pos ) result ( res ) !! Evaluation function for Cylinder SDF. class ( cylinder ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: p , ba , pa real ( kind = wp ) :: x , y , x2 , y2 , d , baba , paba p = pos . dot . this % transform ba = this % b - this % a pa = p - this % a baba = ba . dot . ba paba = pa . dot . ba x = length ( pa * baba - ba * paba ) - this % radius * baba y = abs ( paba - baba * . 5_wp ) - baba * . 5_wp x2 = x ** 2 y2 = ( y ** 2 ) * baba if ( max ( x , y ) < 0._wp ) then d = - min ( x2 , y2 ) else if ( x > 0._wp . and . y > 0._wp ) then d = x2 + y2 elseif ( x > 0._wp ) then d = x2 elseif ( y > 0._wp ) then d = y2 else d = 0._wp end if end if res = sign ( sqrt ( abs ( d )) / baba , d ) end function evaluate_cylinder pure elemental function evaluate_triprism ( this , pos ) result ( res ) !! Evaluation function for Triprisim SDF. class ( triprism ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: q , p p = pos . dot . this % transform q = abs ( p ) res = max ( q % z - this % h2 , max ( q % x * . 866025_wp + p % y * . 5_wp , - p % y ) - this % h1 * . 5_wp ) end function evaluate_triprism pure elemental function evaluate_segment ( this , pos ) result ( res ) !! Evaluation function for Segment SDF. !p = pos !a = pt1 !b = pt2 !draws segment along the axis between 2 points a and b use utils , only : clamp class ( segment ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: pa , ba , p real ( kind = wp ) :: h p = pos . dot . this % transform pa = p - this % a ba = this % b - this % a h = clamp (( pa . dot . ba ) / ( ba . dot . ba ), 0.0_wp , 1.0_wp ) res = length ( pa - ba * h ) - 0.1_wp end function evaluate_segment pure elemental function evaluate_capsule ( this , pos ) result ( res ) !! Evaluation function for Capsule SDF. use utils , only : clamp class ( capsule ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res type ( vector ) :: pa , ba , p real ( kind = wp ) :: h p = pos . dot . this % transform pa = p - this % a ba = this % b - this % a h = clamp (( pa . dot . ba ) / ( ba . dot . ba ), 0._wp , 1._wp ) res = length ( pa - ba * h ) - this % r end function evaluate_capsule pure elemental function evaluate_cone ( this , pos ) result ( res ) !! Evaluation function for Cone SDF. use utils , only : clamp class ( cone ), intent ( in ) :: this type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: rba , baba , papa , paba , x , cax , cay , k , f , cbx , cby , s type ( vector ) :: p p = pos . dot . this % transform rba = this % rb - this % ra baba = ( this % b - this % a ) . dot . ( this % b - this % a ) papa = ( p - this % a ) . dot . ( p - this % a ) paba = (( p - this % a ) . dot . ( this % b - this % a )) / baba x = sqrt ( papa - baba * paba ** 2 ) if ( paba < 0.5_wp ) then cax = max ( 0._wp , x - this % ra ) else cax = max ( 0._wp , x - this % rb ) end if cay = abs ( paba - 0.5_wp ) - . 5_wp k = rba ** 2 + baba f = clamp (( rba * ( x - this % ra ) + paba * baba ) / k , 0._wp , 1._wp ) cbx = x - this % ra - f * rba cby = paba - f if ( cbx < 0._wp . and . cay < 0._wp ) then s = - 1._wp else s = 1._wp end if res = s * sqrt ( min ( cax ** 2 + baba * cay ** 2 , cbx ** 2 + baba * cby ** 2 )) end function evaluate_cone pure elemental function evaluate_egg ( this , pos ) result ( res ) !! Evaluation function for Egg SDF. !! [ref](https://www.shadertoy.com/view/WsjfRt) class ( egg ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: r , l , h_in type ( vector ) :: p_in , p p = pos . dot . this % transform p_in = p p_in % x = abs ( p % x ) r = this % r1 - this % r2 h_in = this % h + r l = ( h_in ** 2 - r ** 2 ) / ( 2._wp * r ) if ( p_in % y <= 0._wp ) then res = length ( p_in ) - this % r1 else if (( p_in % y - h_in ) * l > p_in % x * h_in ) then res = length ( p_in - vector ( 0._wp , h_in , 0._wp )) - (( this % r1 + l ) - length ( vector ( h_in , l , 0._wp ))) else res = length ( p_in + vector ( l , 0._wp , 0._wp )) - ( this % r1 + l ) end if end if end function evaluate_egg pure elemental function evaluate_plane ( this , pos ) result ( res ) !! Evaluation function for Plane SDF. class ( plane ), intent ( in ) :: this !> vector position to evaluate SDF at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: p p = pos . dot . this % transform !a must be normalised res = ( p . dot . this % a ) end function evaluate_plane end module sdfs","tags":"","loc":"sourcefile/sdfs.f90.html"},{"title":"sdfHelpers.f90 – signedMCRT","text":"Contents Modules sdfHelpers Source Code sdfHelpers.f90 Source Code module sdfHelpers !! Collection of helper functions for SDFs: !! This module defines transforms that can be applied to each SDF: !! - Rotate_{x,y,z} !! - Translate !! - RotationAlign (not tested) !! - RotMat (not tested) !! - Identity !! - SkewSymm use vector_class use constants , only : wp implicit none private public :: rotate_x , rotate_y , rotate_z , rotmat , rotationAlign , identity , skewSymm , translate contains function rotate_x ( angle ) result ( r ) !! rotation in the x-axis function from [here](https://inspirnathan.com/posts/54-shadertoy-tutorial-part-8/) use utils , only : deg2rad !> Angle to rotate by real ( kind = wp ), intent ( IN ) :: angle real ( kind = wp ) :: r ( 4 , 4 ), c , s , a a = deg2rad ( angle ) c = cos ( a ) s = sin ( a ) r (:, 1 ) = [ 1._wp , 0._wp , 0._wp , 0._wp ] r (:, 2 ) = [ 0._wp , c , - s , 0._wp ] r (:, 3 ) = [ 0._wp , s , c , 0._wp ] r (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function rotate_x function rotate_y ( angle ) result ( r ) !! rotation in the y-axis function from [here](https://inspirnathan.com/posts/54-shadertoy-tutorial-part-8/) use utils , only : deg2rad !> Angle to rotate by real ( kind = wp ), intent ( IN ) :: angle real ( kind = wp ) :: r ( 4 , 4 ), c , s , a a = deg2rad ( angle ) c = cos ( a ) s = sin ( a ) r (:, 1 ) = [ c , 0._wp , s , 0._wp ] r (:, 2 ) = [ 0._wp , 1._wp , 0._wp , 0._wp ] r (:, 3 ) = [ - s , 0._wp , c , 0._wp ] r (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function rotate_y function rotate_z ( angle ) result ( r ) !! rotation in the z-axis function from [here](https://inspirnathan.com/posts/54-shadertoy-tutorial-part-8/) use utils , only : deg2rad !> Angle to rotate by real ( kind = wp ), intent ( IN ) :: angle real ( kind = wp ) :: r ( 4 , 4 ), c , s , a a = deg2rad ( angle ) c = cos ( a ) s = sin ( a ) r (:, 1 ) = [ c , - s , 0._wp , 0._wp ] r (:, 2 ) = [ s , c , 0._wp , 0._wp ] r (:, 3 ) = [ 0._wp , 0._wp , 1._wp , 0._wp ] r (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function rotate_z function rotmat ( axis , angle ) !! Rotate around around an axis by a given angle taken from [here](http://www.neilmendoza.com/glsl-rotation-about-an-arbitrary-axis/) use utils , only : deg2rad !> Axis to rotate around type ( vector ), intent ( in ) :: axis !> Angle to rotate by in degrees real ( kind = wp ), intent ( in ) :: angle type ( vector ) :: axist real ( kind = wp ) :: rotmat ( 4 , 4 ), s , c , oc , a axist = axis % magnitude () a = deg2rad ( angle ) s = sin ( a ) c = cos ( a ) oc = 1._wp - c rotmat (:, 1 ) = [ oc * axist % x * axist % x + c , oc * axist % x * axist % y - axist % z * s ,& oc * axist % z * axist % x + axist % y * s , 0.0_wp ] rotmat (:, 2 ) = [ oc * axist % x * axist % y + axist % z * s , oc * axist % y * axist % y + c ,& oc * axist % y * axist % z - axist % x * s , 0.0_wp ] rotmat (:, 3 ) = [ oc * axist % z * axist % x - axist % y * s , oc * axist % y * axist % z + axist % x * s ,& oc * axist % z * axist % z + c , 0.0_wp ] rotmat (:, 4 ) = [ 0.0_wp , 0.0_wp , 0.0_wp , 1.0_wp ] end function rotmat function rotationAlign ( a , b ) result ( res ) !! Calculate the rotation matrix to rotate vector a onto b !! [ref1](https://en.wikipedia.org/wiki/Rodrigues%27_rotation_formula) !! [ref2](https://math.stackexchange.com/questions/180418/calculate-rotation-matrix-to-align-vector-a-to-vector-b-in-3d) !> Vector to rotate. Unit vector type ( vector ), intent ( in ) :: a !> Vector to be rotated onto. Unit vector type ( vector ), intent ( in ) :: b type ( vector ) :: v real ( kind = wp ) :: c , k , res ( 4 , 4 ), v_x ( 4 , 4 ), v_x2 ( 4 , 4 ) v = a . cross . b c = a . dot . b k = 1._wp / ( 1._wp + c ) !skew-symmetric matrix v_x (:, 1 ) = [ 0._wp , - 1._wp * v % z , v % y , 0._wp ] v_x (:, 2 ) = [ v % z , 0._wp , - 1._wp * v % x , 0._wp ] v_x (:, 3 ) = [ - 1._wp * v % y , v % x , 0._wp , 0._wp ] v_x (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 0._wp ] v_x2 = matmul ( v_x , v_x ) res = identity () + v_x + v_x2 * k end function rotationAlign function identity () result ( r ) !! Returns the identity transformation matrix real ( kind = wp ) :: r ( 4 , 4 ) r (:, 1 ) = [ 1._wp , 0._wp , 0._wp , 0._wp ] r (:, 2 ) = [ 0._wp , 1._wp , 0._wp , 0._wp ] r (:, 3 ) = [ 0._wp , 0._wp , 1._wp , 0._wp ] r (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function identity function skewSymm ( a ) result ( out ) !! Calculate the Skew Symmetric matrix for a given vector !> Vector to calculate the skew symmetric matrix for. type ( vector ), intent ( in ) :: a real ( kind = wp ) :: out ( 4 , 4 ) out (:, 1 ) = [ 0._wp , - a % z , a % y , 0._wp ] out (:, 2 ) = [ a % z , 0._wp , - a % x , 0._wp ] out (:, 3 ) = [ - a % y , a % x , 0._wp , 0._wp ] out (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 0._wp ] end function skewSymm function translate ( o ) result ( out ) !! Returns the Translation matrix for a given vector translation. !> Vector to translate by. type ( vector ), intent ( IN ) :: o real ( kind = wp ) :: out ( 4 , 4 ) out (:, 1 ) = [ 1._wp , 0._wp , 0._wp , o % x ] out (:, 2 ) = [ 0._wp , 1._wp , 0._wp , o % y ] out (:, 3 ) = [ 0._wp , 0._wp , 1._wp , o % z ] out (:, 4 ) = [ 0._wp , 0._wp , 0._wp , 1._wp ] end function translate end module sdfHelpers","tags":"","loc":"sourcefile/sdfhelpers.f90.html"},{"title":"sdfModifiers.f90 – signedMCRT","text":"Contents Modules sdfModifiers Source Code sdfModifiers.f90 Source Code module sdfModifiers !! This module defines transforms that can be applied to each SDF: !! - Union !! - Intersection !! - Subtraction !! - Displacement !! - Bend !! - Twist !! - Elongate !! - Repeat !! - Extrude !! - Revolution !! - Onion use constants , only : wp use sdf_baseMod , only : sdf_base , primitive use sdfHelpers , only : identity use vector_class implicit none !> Revoloution modifier. Revolves an SDF around the z axis (need to check this!!) type , extends ( sdf_base ) :: revolution real ( kind = wp ) :: o class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_revolution end type revolution !> Extrude a 2D SDF into 3D type , extends ( sdf_base ) :: extrude real ( kind = wp ) :: h class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_extrude end type extrude !> Carves or gives thickness to SDFs type , extends ( sdf_base ) :: onion real ( kind = wp ) :: thickness class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_onion end type onion !> Twist a SDF type , extends ( sdf_base ) :: twist real ( kind = wp ) :: k class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_twist end type twist !> Displace the surface of a SDF by a function. type , extends ( sdf_base ) :: displacement procedure ( primitive ), nopass , pointer :: func class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_disp end type displacement !> Bend a SDF. type , extends ( sdf_base ) :: bend real ( kind = wp ) :: k class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_bend end type bend !> Elongate a SDF type , extends ( sdf_base ) :: elongate type ( vector ) :: size class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_elongate end type elongate !> Repeat a SDF type , extends ( sdf_base ) :: repeat real ( kind = wp ) :: c type ( vector ) :: la , lb class ( sdf_base ), pointer :: prim contains procedure :: evaluate => eval_repeat end type repeat interface revolution module procedure revolution_init end interface revolution interface extrude module procedure extrude_init end interface extrude interface onion module procedure onion_init end interface onion interface twist module procedure twist_init end interface twist interface displacement module procedure displacement_init end interface displacement interface bend module procedure bend_init end interface bend interface elongate module procedure elongate_init end interface elongate interface repeat module procedure repeat_init end interface repeat private public :: onion , extrude , twist , displacement , bend , elongate , repeat , revolution public :: union , SmoothUnion , intersection , subtraction contains type ( twist ) function twist_init ( prim , k ) result ( out ) !! Initialise the twist modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Twist parameter. real , intent ( in ) :: k out % k = k out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function twist_init type ( extrude ) function extrude_init ( prim , h ) result ( out ) !! Initialise the extrude modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Distance to extrude by. real ( kind = wp ), intent ( IN ) :: h out % h = h out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function extrude_init type ( elongate ) function elongate_init ( prim , size ) result ( out ) !! Initialise the elongate modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Distance to elongate by type ( vector ), intent ( IN ) :: size out % size = size out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function elongate_init type ( displacement ) function displacement_init ( prim , func ) result ( out ) !! Initialise the displacement modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Function to displace the SDF with. procedure ( primitive ) :: func out % func => func out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function displacement_init type ( bend ) function bend_init ( prim , k ) result ( out ) !! Initialise the Bend modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Amoun to bend by. real ( kind = wp ), intent ( IN ) :: k out % k = k out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function bend_init type ( repeat ) function repeat_init ( prim , c , la , lb ) result ( out ) !! Initialise the Repeat modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> type ( vector ), intent ( IN ) :: la !> type ( vector ), intent ( IN ) :: lb !> real ( kind = wp ), intent ( IN ) :: c out % c = c out % la = la out % lb = lb out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function repeat_init type ( revolution ) function revolution_init ( prim , o ) result ( out ) !! Initialise the Revolution modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Amount to revolve by. real ( kind = wp ), intent ( IN ) :: o out % o = o out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function revolution_init type ( onion ) function onion_init ( prim , thickness ) result ( out ) !! Initialise the Onion modifier for a SDF. !> SDF to modify class ( sdf_base ), target :: prim !> Thickned to onion by. real ( kind = wp ), intent ( IN ) :: thickness out % thickness = thickness out % prim => prim out % optProps = prim % optProps out % layer = prim % layer out % transform = identity () end function onion_init pure elemental function eval_extrude ( this , pos ) result ( res ) !! Evaluation function for Extrude modifier. class ( extrude ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: w real ( kind = wp ) :: d d = this % prim % evaluate ( pos ) w = vector ( d , abs ( pos % z ) - this % h , 0._wp ) res = min ( max ( w % x , w % y ), 0._wp ) + length ( max ( w , 0._wp )) end function eval_extrude pure elemental function eval_revolution ( this , pos ) result ( res ) !! Evaluation function for Revolution modifier. class ( revolution ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: pxz , q pxz = vector ( pos % x , pos % z , 0._wp ) q = vector ( length ( pxz ) - this % o , pos % y , 0._wp ) res = this % prim % evaluate ( q ) end function eval_revolution pure elemental function eval_onion ( this , pos ) result ( res ) !! Evaluation function for Onion modifier. class ( onion ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res res = abs ( this % prim % evaluate ( pos )) - this % thickness end function eval_onion pure elemental function eval_elongate ( this , pos ) result ( res ) !! Evaluation function for Elongate modifier. class ( elongate ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: w type ( vector ) :: q q = abs ( pos ) - this % size w = min ( max ( q % x , max ( q % y , q % z )), 0._wp ) res = this % prim % evaluate ( max ( q , 0._wp )) + w end function eval_elongate pure elemental function eval_twist ( this , pos ) result ( res ) !! Evaluation function for Twist modifier. class ( twist ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: c , s , x2 , y2 , z2 c = cos ( this % k * pos % z ) s = sin ( this % k * pos % z ) x2 = c * pos % x - s * pos % y y2 = s * pos % x + c * pos % y z2 = pos % z res = this % prim % evaluate ( vector ( x2 , y2 , z2 )) end function eval_twist pure elemental function eval_bend ( this , pos ) result ( res ) !! Evaluation function for Bend modifier. class ( bend ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: c , s , x2 , y2 , z2 c = cos ( this % k * pos % x ) s = sin ( this % k * pos % x ) x2 = c * pos % x - s * pos % y y2 = s * pos % x + c * pos % y z2 = pos % z res = this % prim % evaluate ( vector ( x2 , y2 , z2 )) end function eval_bend pure elemental function eval_disp ( this , pos ) result ( res ) !! Evaluation function for displacement modifier. class ( displacement ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res real ( kind = wp ) :: d1 , d2 d1 = this % prim % evaluate ( pos ) d2 = this % func ( pos ) res = d1 + d2 end function eval_disp pure elemental function eval_repeat ( this , pos ) result ( res ) !! Evaluation function for Repeat modifier. ! use utils, only : clamp class ( repeat ), intent ( in ) :: this !> Position to evaluate the modifier at type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res type ( vector ) :: q error stop \"Not implmented as no vector dependacny in utils yet!\" ! q = pos - this%c*clamp(nint(pos/this%c), this%la, this%lb) res = this % prim % evaluate ( q ) end function eval_repeat pure function union ( d1 , d2 , k ) result ( res ) !! Union operation. Joins two SDFs together !> SDF_1 distance real ( kind = wp ), intent ( IN ) :: d1 !> SDF_2 distance real ( kind = wp ), intent ( IN ) :: d2 !> unused factor real ( kind = wp ), intent ( IN ) :: k real ( kind = wp ) :: res res = min ( d1 , d2 ) end function union pure function SmoothUnion ( d1 , d2 , k ) result ( res ) !! Smooth union. Joins two SDFs together smoothly !> SDF_1 distance real ( kind = wp ), intent ( IN ) :: d1 !> SDF_2 distance real ( kind = wp ), intent ( IN ) :: d2 !> smoothing factor. real ( kind = wp ), intent ( IN ) :: k real ( kind = wp ) :: res , h h = max ( k - abs ( d1 - d2 ), 0._wp ) / k res = min ( d1 , d2 ) - h * h * h * k * ( 1._wp / 6._wp ) end function SmoothUnion pure function subtraction ( d1 , d2 , k ) result ( res ) !! Subtraction operator. Takes one SDF from another. !! Take the first SDF from the 2nd SDF !> SDF_1 distance real ( kind = wp ), intent ( IN ) :: d1 !> SDF_2 distance real ( kind = wp ), intent ( IN ) :: d2 !> unused factor. real ( kind = wp ), intent ( IN ) :: k real ( kind = wp ) :: res res = max ( - d1 , d2 ) end function subtraction pure function intersection ( d1 , d2 , k ) result ( res ) !! Intersection operator. Returns the intersection of two SDFs. !> SDF_1 distance real ( kind = wp ), intent ( IN ) :: d1 !> SDF_2 distance real ( kind = wp ), intent ( IN ) :: d2 !> smoothing factor. real ( kind = wp ), intent ( IN ) :: k real ( kind = wp ) :: res res = max ( d1 , d2 ) end function intersection end module sdfModifiers","tags":"","loc":"sourcefile/sdfmodifiers.f90.html"},{"title":"sdf_base.f90 – signedMCRT","text":"Contents Modules sdf_baseMod Source Code sdf_base.f90 Source Code module sdf_baseMod !! This module defines the signed distance function (SDF) abstract type, sdf_base type, and model type. !! The SDF abstract type contains the optical properties of an SDF (mus, mua, kappa, albedo, hgg, g2,and n), as well as a transform (4x4 matrix), !! and the layer ID code of the SDF. The SDF abstract type also provides an abstract interface (evaluate) which each inheriting function must implement. !! This evaluate function is the heart of the SDF implementation. Each individual evaluate is the direct implementation of that SDF, e.g. that function defines the mathematical SDF. !! For more information on SDFs, check out Inigo Quilez's [website](https://iquilezles.org/articles/) from which most of the below SDFs and transforms have been taken. !! API based upon [here](https://fortran-lang.discourse.group/t/attempting-type-erasure-in-fortran/4402/2) use constants , only : wp use opticalProperties , only : opticalProp_t use sdfHelpers , only : identity use vector_class implicit none !> Abstract base type from which all SDF inherit from. type , abstract :: sdf_base !> Optical property of the SDF type ( opticalProp_t ) :: optProps !> Transform to apply to SDF. real ( kind = wp ) :: transform ( 4 , 4 ) !> Layer ID of SDF integer :: layer contains procedure ( evalInterface ), deferred :: evaluate end type sdf_base !> Container type that allows the use of arrays of different SDF shapes type , extends ( sdf_base ) :: sdf !> Container for any SDF that inherits from SDF_base class ( sdf_base ), allocatable :: value contains procedure :: getKappa procedure :: getAlbedo procedure :: getMua , gethgg , getG2 , getN procedure :: evaluate => sdf_evaluate procedure , private :: sdf_assign generic :: assignment ( = ) => sdf_assign end type sdf !> Model type. Allows the collection of multiple SDF into one model. Used to apply modifiers. type , extends ( sdf_base ) :: model !> Array of SDFs in the model type ( sdf ), allocatable :: array (:) !> SDF modifier function procedure ( op ), nopass , pointer :: func !> Parameter that may be used in modifer function. real ( kind = wp ) :: k contains procedure :: evaluate => eval_model end type model !#################################################################### abstract interface pure elemental function evalInterface ( this , pos ) result ( res ) !! Evaluation function for SDF. ALL SDF must implment this. use vector_class use constants , only : wp import sdf_base class ( sdf_base ), intent ( in ) :: this type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res end function pure function primitive ( pos ) result ( res ) !! Abstract function used as base for displacement function use vector_class , only : vector use constants , only : wp implicit none !> vector position of photon packet. type ( vector ), intent ( IN ) :: pos real ( kind = wp ) :: res end function primitive pure function op ( d1 , d2 , k ) result ( res ) !! Abstract function used as the base for SDF operators (union, subtraction etc) use constants , only : wp implicit none real ( kind = wp ), intent ( IN ) :: d1 , d2 , k real ( kind = wp ) :: res end function op end interface interface sdf module procedure sdf_new end interface interface model module procedure model_init end interface interface render module procedure render_sub , render_vec end interface private public :: model , sdf , sdf_base , primitive , op , calcNormal , render contains function model_init ( array , func , kopt ) result ( out ) !! Initalise the model type. type ( model ) :: out !> Operator to apply to SDF. procedure ( op ) :: func !> Array of SDFs type ( sdf ), intent ( IN ) :: array (:) !> Parameter used in modifier real ( kind = wp ), optional , intent ( IN ) :: kopt integer :: i out % array = array out % func => func if ( present ( kopt )) then out % k = kopt else out % k = 0._wp end if do i = 2 , size ( array ) if ( array ( 1 )% value % optProps % value % mus /= array ( i )% value % optProps % value % mus ) then print * , \"Error mismatch in model mus in object: \" , i end if if ( array ( 1 )% value % optProps % value % mua /= array ( i )% value % optProps % value % mua ) then print * , \"Error mismatch in model mua in object: \" , i end if if ( array ( 1 )% value % optProps % value % hgg /= array ( i )% value % optProps % value % hgg ) then print * , \"Error mismatch in model hgg in object: \" , i end if if ( array ( 1 )% value % optProps % value % n /= array ( i )% value % optProps % value % n ) then print * , \"Error mismatch in model n in object: \" , i end if if ( array ( 1 )% value % layer /= array ( i )% value % layer ) then print * , \"Error mismatch in model layer in object: \" , i end if end do out % optProps = array ( 1 )% value % optProps out % layer = array ( 1 )% value % layer end function model_init pure elemental function eval_model ( this , pos ) result ( res ) !! Evaluate the model class ( model ), intent ( in ) :: this !> Vector position to evaluate at type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res integer :: i res = this % array ( 1 )% value % evaluate ( pos ) do i = 2 , size ( this % array ) res = this % func ( res , this % array ( i )% value % evaluate ( pos ), this % k ) end do end function eval_model !############################################################# ! Helpers !############################################################# type ( vector ) function calcNormal ( p , obj ) !! Calculate the surface normal of a SDF at the point p numerically. !> Position to evaluate at type ( vector ), intent ( IN ) :: p !> SDF to calcuate surface normal of. class ( sdf_base ) :: obj real ( kind = wp ) :: h type ( vector ) :: xyy , yyx , yxy , xxx h = 1e-6_wp xyy = vector ( 1._wp , - 1._wp , - 1._wp ) yyx = vector ( - 1._wp , - 1._wp , 1._wp ) yxy = vector ( - 1._wp , 1._wp , - 1._wp ) xxx = vector ( 1._wp , 1._wp , 1._wp ) calcNormal = xyy * obj % evaluate ( p + xyy * h ) + & yyx * obj % evaluate ( p + yyx * h ) + & yxy * obj % evaluate ( p + yxy * h ) + & xxx * obj % evaluate ( p + xxx * h ) calcNormal = calcNormal % magnitude () end function calcNormal function getKappa ( this ) result ( res ) !! Return \\kappa for the current SDF class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % kappa end function getKappa function getMua ( this ) result ( res ) !! Return \\mu_a for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % mua end function getMua function gethgg ( this ) result ( res ) !! Return g-factor for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % hgg end function gethgg function getg2 ( this ) result ( res ) !! Return g^2 factor for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % g2 end function getg2 function getN ( this ) result ( res ) !! Return refractive index for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % n end function getN function getAlbedo ( this ) result ( res ) !! Return albedo for the current SDF. class ( sdf ) :: this real ( kind = wp ) :: res res = this % value % optProps % value % albedo end function getAlbedo !######################################################################### ! SDF bound procedures !######################################################################### pure elemental function sdf_evaluate ( this , pos ) result ( res ) !! Evaluate the SDF at a given position. class ( sdf ), intent ( in ) :: this type ( vector ), intent ( in ) :: pos real ( kind = wp ) :: res res = this % value % evaluate ( pos ) end function sdf_evaluate subroutine sdf_assign ( lhs , rhs ) !! sdf initializer class ( sdf ), intent ( inout ) :: lhs class ( sdf_base ), intent ( in ) :: rhs if ( allocated ( lhs % value )) deallocate ( lhs % value ) ! Prevent nested derived type select type ( rhsT => rhs ) class is ( sdf ) if ( allocated ( rhsT % value )) allocate ( lhs % value , source = rhsT % value ) class default allocate ( lhs % value , source = rhsT ) end select end subroutine sdf_assign type ( sdf ) function sdf_new ( rhs ) result ( lhs ) !! sdf initializer class ( sdf_base ), intent ( in ) :: rhs allocate ( lhs % value , source = rhs ) end function sdf_new subroutine render_vec ( cnt , state ) !! Render the SDF !! Wrapper around the render function to allow ease of use use sim_state_mod , only : settings_t type ( settings_t ), intent ( IN ) :: state type ( sdf ), intent ( IN ) :: cnt (:) type ( vector ) :: extent extent = vector ( state % grid % xmax , state % grid % ymax , state % grid % zmax ) call render_sub ( cnt , extent , state % render_size , state ) end subroutine render_vec subroutine render_sub ( cnt , extent , samples , state ) !! Render the SDFs onto a voxel grid use sim_state_mod , only : settings_t use utils , only : pbar use constants , only : fileplace , sp use writer_mod type ( settings_t ), intent ( IN ) :: state type ( sdf ), intent ( IN ) :: cnt (:) integer , intent ( IN ) :: samples ( 3 ) type ( vector ), intent ( IN ) :: extent type ( vector ) :: pos , wid integer :: i , j , k , u , id real ( kind = wp ) :: x , y , z , ds ( size ( cnt )), ns ( 3 ), minvalue real ( kind = sp ), allocatable :: image (:, :, :) type ( pbar ) :: bar ns = nint ( samples / 2._wp ) allocate ( image ( samples ( 1 ), samples ( 2 ), samples ( 3 ))) wid = vector ( extent % x / ns ( 1 ), extent % y / ns ( 2 ), extent % z / ns ( 3 )) bar = pbar ( samples ( 1 )) !$omp parallel default(none) shared(cnt, ns, wid, image, samples, bar)& !$omp private(i, x, y, z, pos, j, k, u, ds, id, minvalue) !$omp do do i = 1 , samples ( 1 ) x = ( i - ns ( 1 )) * wid % x do j = 1 , samples ( 2 ) y = ( j - ns ( 2 )) * wid % y do k = 1 , samples ( 3 ) z = ( k - ns ( 3 )) * wid % z pos = vector ( x , y , z ) ds = 0._wp do u = 1 , size ( ds ) ds ( u ) = cnt ( u )% evaluate ( pos ) end do image ( i , j , k ) = minval ( ds ) end do end do call bar % progress () end do !$OMP end do !$OMP end parallel call write_data ( image , trim ( fileplace ) // state % renderfile , state , overwrite = . true .) end subroutine render_sub end module sdf_baseMod","tags":"","loc":"sourcefile/sdf_base.f90.html"},{"title":"main.f90 – signedMCRT","text":"Contents Programs mcpolar Source Code main.f90 Source Code program mcpolar !! Entry point for program use kernels , only : weight_scatter , pathlength_scatter integer :: num_args , i character ( len = 64 ), allocatable :: args (:) num_args = command_argument_count () if ( num_args == 0 ) then allocate ( args ( 1 )) args ( 1 ) = \"scat_test.toml\" else allocate ( args ( num_args )) do i = 1 , num_args call get_command_argument ( i , args ( i )) end do end if ! call weight_scatter(trim(args(1))) call pathlength_scatter ( trim ( args ( 1 ))) end program","tags":"","loc":"sourcefile/main.f90.html"},{"title":"main – signedMCRT","text":"Documentation This document is the incomplete documentation of signedMCRT . Build system To build signedMCRT, the only current method is using FPM .\nFPM can be easily installed on any platform, and is simple to use to pull all dependencies, and build and compile signedMCRT.\nWe also provide several commands via FPM response file ( found here ), to enable the use of OpenMP, other compliers, and various debug modes. Running the code The code is run using FPM. To run on a single core with no debug flags enabled: fpm run To run on all available threads on current computer with no debug flags: fpm @runmp To run the code on one thread with all debug flags enabled: fpm @debug To run the code on all threads with all debug flags enabled: fpm @debugmp Please see ( here ) for other possible options. Dependencies Below is the current list of dependencies: test drive Fortran TEV Bindings stdlib stb_image Fortran Utilities Test drive is used to run all tests.\nFortran TEV Bindings is used to interface with TEV, to show live slices of fluences as the simulation is run, which is handy for debugging purposes.\nStdlib is a collection of routines purposed for inclusion within the Fortran standard. Stdlib is used here for it's loadtxt function to load arbitrary plain text data into arrays. More of stdlib may be used in future.\nFortran_stb_Image is used to load images into arrays. Fortran_stb_image are the Fortran bindings for stb_image .\nFinally, Fortran Utilities is my personal collection of useful Fortran utilities such as mathematical functions, or progress bars. Config file signedMCRT uses TOML as it's configuration file format.\nDocumentation of the input file format can be found in here Plotting Results To view the output of simulations you can use this .\nAlternatively to customise the plot you can adjust the following script . Monte Carlo Radiation Transfer (MCRT) method Please see my thesis for an overview of the MCRT method. Citation SignedMCRT has so far been used in 2 papers: MESHLESS MONTE CARLO RADIATION TRANSFER METHOD FOR CURVED GEOMETRIES USING SIGNED DISTANCE FUNCTIONS\nL. McMillan, G. D. Bruce, K. Dholakia, J. Biomed. Opt. 27(8), 083003 (2022) / arXiv:2112.08035 (2021) TO FOCUS-MATCH OR NOT TO FOCUS-MATCH INVERSE SPATIALLY OFFSET RAMAN SPECTROSCOPY: A QUESTION OF LIGHT PENETRATION\nG.E. Shillito, L. McMillan, G. D. Bruce, K. Dholakia, Opt. Express 30, 8876 (2022) / arXiv:2112.08877 TODO's The current TODO list of planned features and current bugs can be found here .","tags":"","loc":"page/index.html"},{"title":"todos – signedMCRT","text":"TODOs List of ToDo's for SignedMCRT. Additional Features Finished Features Make CI run tests Add Code Coverage reports Remove spurious implicit nones Make sure all optical properties are the same for a model instance (SDF) [x] Add \"Scattering\" kernels path length counter method Weight method [x] Add documentation on piecewise Constant 1D 2D [x] Finish new SDF API add all SDFs add adjustment functions (twist, union etc) propagate to subs.f90 Minor Features Add more saved state to photon_origin to save compute time [ ] Finish Circular, focus, and annulus source types Circular Focus Annulus. Partially done via control of Beta parameter. [ ] Add Direction component to rest of Detectors Circle Camera Annulus [ ] Add photon trajectory history tracking Add to each detector separately Fix openMP troubles Fix speed issues Major Features Make code work on Windows Automate benchmarking so we can catch performance regressions Add voxel geometry Add mesh geometry Improve performance of SDF intersection [ ] Make code serializable so that we can checkpoint simulations Save input toml file photons run [ ] Save output data Detectors Fluence Absorb NScatt Add optics to Camera type [x] Add phase tracking (https://github.com/lewisfish/signedMCRT/pull/2). Add phase screen detector to camera Add refractive index accounting Compress output data (https://github.com/aras-p/float_compr_tester/blob/main/src/compression_helpers.cpp) Add more error handling for spectrums in parse.f90 [ ] Add optical property type, to allow for multi-spectral input. [x] base optical property type function defined Tabulated propagate to SDFs propagate to subs.f90 Document optical properties Change API to match that of SDFs, i.e easier to use Add MPI + openMP mode (e.g. run openMP on N nodes with minimal communication) Testing Vec3 class Matrix class Vec4 Class [ ] SDF Class Helpers Modifiers Base Shapes [x] Detector Class Circle Camera Annulus Surfaces Grid Optical Properties [ ] Photon class Uniform Point Pencil Circular Annulus Scattering Isotropic Henyey-Greenstein Importance sampling biased scattering Photon movement code History Stack Class I/O Random Numbers [x] Fresnel reflections Simple reflect Simple refract Complex reflect Complex refract [ ] End to End tests Scattering Test Others [ ] test phase double slit square aperture gaussian beam bessel beam Bugs [ ] Fix CI so that build on Macos run, and builds using Intel run. Macos Intel [ ] Can't operate trackHistory in parallel Make each thread write to tmp file and finish method collate results Added default array option to get_vector in parse.f90","tags":"","loc":"page/TODO.html"},{"title":"config – signedMCRT","text":"Config file settings The configuration file format used is Tom's Obvious Minimal Language ( TOML ).\nThe below sections describe the tables (dictionaries) that are able to be defined for SignedMCRT. Source This table defines the parameters for the light source used in the simulation it can have the following: Parameter Type Options Default Notes name string point, circular, uniform, pencil, annulus, focus point - nphotons integer - 1000000 - position float array size 3 - [0.0, 0.0, 0.0] Default value only set for point source type direction float array size 3 or string - -z String type applies to all source types bar: Uniform and circular point1 float array size 3 - [-1.0, -1.0, -1.0] Used by uniform source only to set location and size of source point2 float array size 3 - [2.0, 0.0, 0.0] See Above point3 float array size 3 - [0.0, 2.0, 0.0] See Above Radius float - 0.5 Used by circular source and annular source (as lower radius) rhi float - 0.6 Annular source upper radius Beta float - 5.0 Annular source convergence angle (Bessel beam beta parameter) annulus_type string gaussian, tophat gaussian Type of annular beam spectrum_type string constant, 1D, 2D constant Type of spectrum used spectrum_file string - - filename of 1D or 2D spectrum/image cell_size float array size 2 - - size of pixel in 2D spectrum in simulation units. wavelength float - 500 nm Wavelength for constant spectrum Note point1, point2, and point3 define a rectangle. Point1 is the origin,point2 and point3 are the vectors that describe the sides. Grid Parameter Type Default Notes nxg integer 200 Number of voxel in x direction nyg integer 200 Number of voxel in y direction nyg integer 200 Number of voxel in z direction xmax float 1.0 Half size of simulated medium in x direction ymax float 1.0 Half size of simulated medium in y direction zmax float 1.0 Half size of simulated medium in z direction units string cm Units of simulation (currently need to manually adjust optical properties to account) Geometry Parameter Type Default Notes geom_name string sphere Name of experiment for metadata tau float 10.0 Tau value for MCRT scattering test experiment num_spheres integer 10 Number of random spheres for sphere scene musb float 0.0 Optical properties for experimental geometry for whiskey Raman sensing paper muab float 0.01 See above musc float 0.0 See Above muac float 0.01 See Above hgg float 0.7 See Above Detectors Parameter Type Options Default Notes type string annulus, circle, camera - - position float array size 3 - NO DEFAULT! Central position of detector direction float array size 3 - [0.0, 0.0, -1.0] - radius1 float - - Radius of circular detector. Inner radius of annular detector radius2 float - - Outer radius of annulus detector. Must be larger than radius1 p1 float array size 3 - [-1.0, -1.0, -1.0] Used by camera detector only to set location and size of source p2 float array size 3 - [2.0, 0.0, 0.0] See above p3 float array size 3 - [0.0, 2.0, 0.0] See above layer integer - 1 layer to match SDF layer label nbins integer - 100 Number of bins in detector maxval float - 100.0 Maximum value to bin historyFileName string - \"photPos.obj\" Name of output file of detected photons histories trackHistory boolean - false If true record detected photons histories. !!!Does not work with openMP!!! Output Parameter Type Default Notes fluence string fluence.nrrd Filename for fluence output absorb string absorb.nrrd Filename for energy absorbed output render string geom_render.nrrd Filename for render geometry output render_geom boolean false Render geometry out. For debugging purposes render_size integer array size 3 [200, 200, 200] Size in voxels of render overwrite boolean false Overwrite files if they have the same name Simulation Parameter Type Default Notes iseed integer 123456789 seed for simulation. Each thread get its own copy + threadID tev boolean false Enables TEV image viewer to display simulation as it runs. Must have opened TEV prior to launching simulation. absorb boolean false Enables writing to file of absorbed energy.","tags":"","loc":"page/config.html"}]} \ No newline at end of file