22!>
33!! @file m_helper.f90
44!! @brief Contains module m_helper
5+
56module m_helper
67
78 ! Dependencies =============================================================
@@ -20,7 +21,14 @@ module m_helper
2021 s_initialize_nonpoly, &
2122 s_simpson, &
2223 s_transcoeff, &
23- s_int_to_str
24+ s_int_to_str, &
25+ s_transform_vec, &
26+ s_transform_triangle, &
27+ s_transform_model, &
28+ s_swap, &
29+ f_cross, &
30+ f_create_transform_matrix, &
31+ f_create_bbox
2432
2533contains
2634
@@ -148,15 +156,9 @@ contains
148156 rhol0 = rhoref
149157 pl0 = pref
150158
151- #ifdef MFC_SIMULATION
152159 @:ALLOCATE(pb0(nb), mass_n0(nb), mass_v0(nb), Pe_T(nb))
153160 @:ALLOCATE(k_n(nb), k_v(nb), omegaN(nb))
154161 @:ALLOCATE(Re_trans_T(nb), Re_trans_c(nb), Im_trans_T(nb), Im_trans_c(nb))
155- #else
156- allocate(pb0(nb), mass_n0(nb), mass_v0(nb), Pe_T(nb))
157- allocate(k_n(nb), k_v(nb), omegaN(nb))
158- allocate(Re_trans_T(nb), Re_trans_c(nb), Im_trans_T(nb), Im_trans_c(nb))
159- #endif
160162
161163 pb0(:) = dflt_real
162164 mass_n0(:) = dflt_real
@@ -331,5 +333,150 @@ contains
331333 tmp = DEXP(- 0.5d0 * (phi(nb)/ sd)** 2 )/ DSQRT(2.d0 * pi)/ sd
332334 weight(nb) = tmp* dphi/ 3.d0
333335 end subroutine s_simpson
336+
337+ !> This procedure computes the cross product of two vectors.
338+ !! @param a First vector.
339+ !! @param b Second vector.
340+ !! @return The cross product of the two vectors.
341+ function f_cross (a , b ) result(c)
342+ real (kind (0d0 )), dimension (3 ), intent (in ) :: a, b
343+ real (kind (0d0 )), dimension (3 ) :: c
344+
345+ c(1 ) = a(2 ) * b(3 ) - a(3 ) * b(2 )
346+ c(2 ) = a(3 ) * b(1 ) - a(1 ) * b(3 )
347+ c(3 ) = a(1 ) * b(2 ) - a(2 ) * b(1 )
348+ end function f_cross
349+
350+ !> This procedure swaps two real numbers.
351+ !! @param lhs Left- hand side.
352+ !! @param rhs Right- hand side.
353+ subroutine s_swap (lhs , rhs )
354+ real (kind (0d0 )), intent (inout ) :: lhs, rhs
355+ real (kind (0d0 )) :: ltemp
356+
357+ ltemp = lhs
358+ lhs = rhs
359+ rhs = ltemp
360+ end subroutine s_swap
361+
362+ !> This procedure creates a transformation matrix.
363+ !! @param p Parameters for the transformation.
364+ !! @return Transformation matrix.
365+ function f_create_transform_matrix (p ) result(out_matrix)
366+
367+ type(ic_model_parameters) :: p
368+
369+ t_mat4x4 :: sc, rz, rx, ry, tr, out_matrix
370+
371+ sc = transpose (reshape ([ &
372+ p%scale (1 ), 0d0 , 0d0 , 0d0 , &
373+ 0d0 , p%scale (2 ), 0d0 , 0d0 , &
374+ 0d0 , 0d0 , p%scale (3 ), 0d0 , &
375+ 0d0 , 0d0 , 0d0 , 1d0 ], shape (sc)))
376+
377+ rz = transpose (reshape ([ &
378+ cos (p%rotate(3 )), - sin (p%rotate(3 )), 0d0 , 0d0 , &
379+ sin (p%rotate(3 )), cos (p%rotate(3 )), 0d0 , 0d0 , &
380+ 0d0 , 0d0 , 1d0 , 0d0 , &
381+ 0d0 , 0d0 , 0d0 , 1d0 ], shape (rz)))
382+
383+ rx = transpose (reshape ([ &
384+ 1d0 , 0d0 , 0d0 , 0d0 , &
385+ 0d0 , cos (p%rotate(1 )), - sin (p%rotate(1 )), 0d0 , &
386+ 0d0 , sin (p%rotate(1 )), cos (p%rotate(1 )), 0d0 , &
387+ 0d0 , 0d0 , 0d0 , 1d0 ], shape (rx)))
388+
389+ ry = transpose (reshape ([ &
390+ cos (p%rotate(2 )), 0d0 , sin (p%rotate(2 )), 0d0 , &
391+ 0d0 , 1d0 , 0d0 , 0d0 , &
392+ - sin (p%rotate(2 )), 0d0 , cos (p%rotate(2 )), 0d0 , &
393+ 0d0 , 0d0 , 0d0 , 1d0 ], shape (ry)))
394+
395+ tr = transpose (reshape ([ &
396+ 1d0 , 0d0 , 0d0 , p%translate(1 ), &
397+ 0d0 , 1d0 , 0d0 , p%translate(2 ), &
398+ 0d0 , 0d0 , 1d0 , p%translate(3 ), &
399+ 0d0 , 0d0 , 0d0 , 1d0 ], shape (tr)))
400+
401+ out_matrix = matmul (tr, matmul (ry, matmul (rx, matmul (rz, sc))))
402+
403+ end function f_create_transform_matrix
404+
405+ !> This procedure transforms a vector by a matrix.
406+ !! @param vec Vector to transform.
407+ !! @param matrix Transformation matrix.
408+ subroutine s_transform_vec (vec , matrix )
409+
410+ t_vec3, intent (inout ) :: vec
411+ t_mat4x4, intent (in ) :: matrix
412+
413+ real (kind (0d0 )), dimension (1 :4 ) :: tmp
414+
415+ tmp = matmul (matrix, [ vec(1 ), vec(2 ), vec(3 ), 1d0 ])
416+ vec = tmp(1 :3 )
417+
418+ end subroutine s_transform_vec
419+
420+ !> This procedure transforms a triangle by a matrix, one vertex at a time.
421+ !! @param triangle Triangle to transform.
422+ !! @param matrix Transformation matrix.
423+ subroutine s_transform_triangle (triangle , matrix )
424+
425+ type(t_triangle), intent (inout ) :: triangle
426+ t_mat4x4, intent (in ) :: matrix
427+
428+ integer :: i
429+
430+ real (kind (0d0 )), dimension (1 :4 ) :: tmp
431+
432+ do i = 1 , 3
433+ call s_transform_vec(triangle%v(i,:), matrix)
434+ end do
435+
436+ end subroutine s_transform_triangle
437+
438+ !> This procedure transforms a model by a matrix, one triangle at a time.
439+ !! @param model Model to transform.
440+ !! @param matrix Transformation matrix.
441+ subroutine s_transform_model (model , matrix )
442+
443+ type(t_model), intent (inout ) :: model
444+ t_mat4x4, intent (in ) :: matrix
445+
446+ integer :: i
447+
448+ do i = 1 , size (model%trs)
449+ call s_transform_triangle(model%trs(i), matrix)
450+ end do
451+
452+ end subroutine s_transform_model
453+
454+ !> This procedure creates a bounding box for a model.
455+ !! @param model Model to create bounding box for.
456+ !! @return Bounding box.
457+ function f_create_bbox (model ) result(bbox)
458+
459+ type(t_model), intent (in ) :: model
460+ type(t_bbox) :: bbox
461+
462+ integer :: i, j
463+
464+ if (size (model%trs) == 0 ) then
465+ bbox%min = 0d0
466+ bbox%max = 0d0
467+ return
468+ end if
469+
470+ bbox%min = model%trs(1 )%v(1 ,:)
471+ bbox%max = model%trs(1 )%v(1 ,:)
472+
473+ do i = 1 , size (model%trs)
474+ do j = 1 , 3
475+ bbox%min = min (bbox%min, model%trs(i)%v(j,:))
476+ bbox%max = max (bbox%max, model%trs(i)%v(j,:))
477+ end do
478+ end do
479+
480+ end function f_create_bbox
334481
335482end module m_helper
0 commit comments