diff --git a/src/pre_process/m_check_patches.fpp b/src/pre_process/m_check_patches.fpp index b09f221c0..535c3208f 100644 --- a/src/pre_process/m_check_patches.fpp +++ b/src/pre_process/m_check_patches.fpp @@ -381,396 +381,412 @@ contains 'geometric parameters of 3D analytical '// & 'patch '//trim(iStr)//'. Exiting...') end if - end subroutine s_check_3D_analytical_patch_geometry + end subroutine s_check_3D_analytical_patch_geometry - !> This subroutine verifies that the geometric parameters of + !> This subroutine verifies that the geometric parameters of !! the sphere patch have consistently been inputted by the !! user. !! @param patch_id Patch identifier - subroutine s_check_sphere_patch_geometry(patch_id) + subroutine s_check_sphere_patch_geometry(patch_id) - integer, intent(in) :: patch_id - call s_int_to_str(patch_id, iStr) + integer, intent(in) :: patch_id + call s_int_to_str(patch_id, iStr) - ! Constraints on the geometric parameters of the sphere patch - if (p == 0 & - .or. & - patch_icpp(patch_id)%radius <= 0d0 & - .or. & - patch_icpp(patch_id)%x_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%y_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%z_centroid == dflt_real) then + ! Constraints on the geometric parameters of the sphere patch + if (p == 0 & + .or. & + patch_icpp(patch_id)%radius <= 0d0 & + .or. & + patch_icpp(patch_id)%x_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%y_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%z_centroid == dflt_real) then - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of sphere '// & - 'patch '//trim(iStr)//'. Exiting ...') + call s_mpi_abort('Inconsistency(ies) detected in '// & + 'geometric parameters of sphere '// & + 'patch '//trim(iStr)//'. Exiting ...') - end if + end if - end subroutine s_check_sphere_patch_geometry + end subroutine s_check_sphere_patch_geometry - !> This subroutine verifies that the geometric parameters of + !> This subroutine verifies that the geometric parameters of !! the spherical harmonic patch have consistently been !! inputted by the user. !! @param patch_id Patch identifier - subroutine s_check_spherical_harmonic_patch_geometry(patch_id) - integer, intent(in) :: patch_id + subroutine s_check_spherical_harmonic_patch_geometry(patch_id) + integer, intent(in) :: patch_id - call s_int_to_str(patch_id, iStr) + call s_int_to_str(patch_id, iStr) - ! Constraints on the geometric parameters of the spherical harmonic patch - if (p == 0 & - .or. & - patch_icpp(patch_id)%radius <= 0d0 & - .or. & - patch_icpp(patch_id)%x_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%y_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%z_centroid == dflt_real & - .or. & - all(patch_icpp(patch_id)%epsilon /= (/1d0, 2d0, 3d0, 4d0, 5d0/)) & - .or. & - patch_icpp(patch_id)%beta < 0d0 & - .or. & - patch_icpp(patch_id)%beta > patch_icpp(patch_id)%epsilon) then + ! Constraints on the geometric parameters of the spherical harmonic patch + if (p == 0 & + .or. & + patch_icpp(patch_id)%radius <= 0d0 & + .or. & + patch_icpp(patch_id)%x_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%y_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%z_centroid == dflt_real & + .or. & + all(patch_icpp(patch_id)%epsilon /= (/1d0, 2d0, 3d0, 4d0, 5d0/)) & + .or. & + patch_icpp(patch_id)%beta < 0d0 & + .or. & + patch_icpp(patch_id)%beta > patch_icpp(patch_id)%epsilon) then - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of spherical '// & - 'harmonic patch '//trim(iStr)//'. Exiting ...') + call s_mpi_abort('Inconsistency(ies) detected in '// & + 'geometric parameters of spherical '// & + 'harmonic patch '//trim(iStr)//'. Exiting ...') - end if + end if - end subroutine s_check_spherical_harmonic_patch_geometry + end subroutine s_check_spherical_harmonic_patch_geometry - !> This subroutine verifies that the geometric parameters of + !> This subroutine verifies that the geometric parameters of !! the cuboid patch have consistently been inputted by the !! user. !! @param patch_id Patch identifier - subroutine s_check_cuboid_patch_geometry(patch_id) + subroutine s_check_cuboid_patch_geometry(patch_id) - ! Patch identifier - integer, intent(in) :: patch_id - call s_int_to_str(patch_id, iStr) + ! Patch identifier + integer, intent(in) :: patch_id + call s_int_to_str(patch_id, iStr) - ! Constraints on the geometric parameters of the cuboid patch - if (p == 0 & - .or. & - patch_icpp(patch_id)%x_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%y_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%z_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%length_x <= 0d0 & - .or. & - patch_icpp(patch_id)%length_y <= 0d0 & - .or. & - patch_icpp(patch_id)%length_z <= 0d0) then + ! Constraints on the geometric parameters of the cuboid patch + if (p == 0 & + .or. & + patch_icpp(patch_id)%x_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%y_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%z_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%length_x <= 0d0 & + .or. & + patch_icpp(patch_id)%length_y <= 0d0 & + .or. & + patch_icpp(patch_id)%length_z <= 0d0) then - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of cuboid '// & - 'patch '//trim(iStr)//'. Exiting ...') + call s_mpi_abort('Inconsistency(ies) detected in '// & + 'geometric parameters of cuboid '// & + 'patch '//trim(iStr)//'. Exiting ...') - end if + end if - end subroutine s_check_cuboid_patch_geometry + end subroutine s_check_cuboid_patch_geometry - !> This subroutine verifies that the geometric parameters of + !> This subroutine verifies that the geometric parameters of !! the cylinder patch have consistently been inputted by the !! user. !! @param patch_id Patch identifier - subroutine s_check_cylinder_patch_geometry(patch_id) + subroutine s_check_cylinder_patch_geometry(patch_id) - ! Patch identifier - integer, intent(in) :: patch_id - call s_int_to_str(patch_id, iStr) + ! Patch identifier + integer, intent(in) :: patch_id + call s_int_to_str(patch_id, iStr) - ! Constraints on the geometric parameters of the cylinder patch - if (p == 0 & - .or. & - patch_icpp(patch_id)%x_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%y_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%z_centroid == dflt_real & - .or. & - (patch_icpp(patch_id)%length_x <= 0d0 .and. & - patch_icpp(patch_id)%length_y <= 0d0 .and. & - patch_icpp(patch_id)%length_z <= 0d0) & - .or. & - (patch_icpp(patch_id)%length_x > 0d0 .and. & - (patch_icpp(patch_id)%length_y /= dflt_real .or. & - patch_icpp(patch_id)%length_z /= dflt_real)) & - .or. & - (patch_icpp(patch_id)%length_y > 0d0 .and. & - (patch_icpp(patch_id)%length_x /= dflt_real .or. & - patch_icpp(patch_id)%length_z /= dflt_real)) & - .or. & - (patch_icpp(patch_id)%length_z > 0d0 .and. & - (patch_icpp(patch_id)%length_x /= dflt_real .or. & - patch_icpp(patch_id)%length_y /= dflt_real)) & - .or. & - patch_icpp(patch_id)%radius <= 0d0) then + ! Constraints on the geometric parameters of the cylinder patch + if (p == 0 & + .or. & + patch_icpp(patch_id)%x_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%y_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%z_centroid == dflt_real & + .or. & + (patch_icpp(patch_id)%length_x <= 0d0 .and. & + patch_icpp(patch_id)%length_y <= 0d0 .and. & + patch_icpp(patch_id)%length_z <= 0d0) & + .or. & + (patch_icpp(patch_id)%length_x > 0d0 .and. & + (patch_icpp(patch_id)%length_y /= dflt_real .or. & + patch_icpp(patch_id)%length_z /= dflt_real)) & + .or. & + (patch_icpp(patch_id)%length_y > 0d0 .and. & + (patch_icpp(patch_id)%length_x /= dflt_real .or. & + patch_icpp(patch_id)%length_z /= dflt_real)) & + .or. & + (patch_icpp(patch_id)%length_z > 0d0 .and. & + (patch_icpp(patch_id)%length_x /= dflt_real .or. & + patch_icpp(patch_id)%length_y /= dflt_real)) & + .or. & + patch_icpp(patch_id)%radius <= 0d0) then - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of cylinder '// & - 'patch '//trim(iStr)//'. Exiting ...') + call s_mpi_abort('Inconsistency(ies) detected in '// & + 'geometric parameters of cylinder '// & + 'patch '//trim(iStr)//'. Exiting ...') - end if + end if - end subroutine s_check_cylinder_patch_geometry + end subroutine s_check_cylinder_patch_geometry - !> This subroutine verifies that the geometric parameters of + !> This subroutine verifies that the geometric parameters of !! the plane sweep patch have consistently been inputted by !! the user. !! @param patch_id Patch identifier - subroutine s_check_plane_sweep_patch_geometry(patch_id) + subroutine s_check_plane_sweep_patch_geometry(patch_id) - ! Patch identifier - integer, intent(in) :: patch_id - call s_int_to_str(patch_id, iStr) + ! Patch identifier + integer, intent(in) :: patch_id + call s_int_to_str(patch_id, iStr) - ! Constraints on the geometric parameters of the plane sweep patch - if (p == 0 & - .or. & - patch_icpp(patch_id)%x_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%y_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%z_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%normal(1) == dflt_real & - .or. & - patch_icpp(patch_id)%normal(2) == dflt_real & - .or. & - patch_icpp(patch_id)%normal(3) == dflt_real) then + ! Constraints on the geometric parameters of the plane sweep patch + if (p == 0 & + .or. & + patch_icpp(patch_id)%x_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%y_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%z_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%normal(1) == dflt_real & + .or. & + patch_icpp(patch_id)%normal(2) == dflt_real & + .or. & + patch_icpp(patch_id)%normal(3) == dflt_real) then - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of plane sweep '// & - 'patch '//trim(iStr)//'. Exiting ...') + call s_mpi_abort('Inconsistency(ies) detected in '// & + 'geometric parameters of plane sweep '// & + 'patch '//trim(iStr)//'. Exiting ...') - end if + end if - end subroutine s_check_plane_sweep_patch_geometry + end subroutine s_check_plane_sweep_patch_geometry - !> This subroutine verifies that the geometric parameters of + !> This subroutine verifies that the geometric parameters of !! the ellipsoid patch have consistently been inputted by !! the user. !! @param patch_id Patch identifier - subroutine s_check_ellipsoid_patch_geometry(patch_id) + subroutine s_check_ellipsoid_patch_geometry(patch_id) - integer, intent(in) :: patch_id - call s_int_to_str(patch_id, iStr) + integer, intent(in) :: patch_id + call s_int_to_str(patch_id, iStr) - ! Constraints on the geometric parameters of the ellipsoid patch - if (p == 0 & - .or. & - patch_icpp(patch_id)%x_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%y_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%z_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%radii(1) == dflt_real & - .or. & - patch_icpp(patch_id)%radii(2) == dflt_real & - .or. & - patch_icpp(patch_id)%radii(3) == dflt_real) then + ! Constraints on the geometric parameters of the ellipsoid patch + if (p == 0 & + .or. & + patch_icpp(patch_id)%x_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%y_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%z_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%radii(1) == dflt_real & + .or. & + patch_icpp(patch_id)%radii(2) == dflt_real & + .or. & + patch_icpp(patch_id)%radii(3) == dflt_real) then - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of ellipsoid '// & - 'patch '//trim(iStr)//'. Exiting ...') + call s_mpi_abort('Inconsistency(ies) detected in '// & + 'geometric parameters of ellipsoid '// & + 'patch '//trim(iStr)//'. Exiting ...') - end if + end if - end subroutine s_check_ellipsoid_patch_geometry + end subroutine s_check_ellipsoid_patch_geometry !!> This subroutine verifies that the geometric parameters of !! the inactive patch remain unaltered by the user inputs. !! @param patch_id Patch identifier - subroutine s_check_inactive_patch_geometry(patch_id) + subroutine s_check_inactive_patch_geometry(patch_id) - integer, intent(in) :: patch_id - call s_int_to_str(patch_id, iStr) + integer, intent(in) :: patch_id + call s_int_to_str(patch_id, iStr) - ! Constraints on the geometric parameters of the inactive patch - if (patch_icpp(patch_id)%x_centroid /= dflt_real & - .or. & - patch_icpp(patch_id)%y_centroid /= dflt_real & - .or. & - patch_icpp(patch_id)%z_centroid /= dflt_real & - .or. & - patch_icpp(patch_id)%length_x /= dflt_real & - .or. & - patch_icpp(patch_id)%length_y /= dflt_real & - .or. & - patch_icpp(patch_id)%length_z /= dflt_real & - .or. & - patch_icpp(patch_id)%radius /= dflt_real & - .or. & - patch_icpp(patch_id)%epsilon /= dflt_real & - .or. & - patch_icpp(patch_id)%beta /= dflt_real & - .or. & - patch_icpp(patch_id)%normal(1) /= dflt_real & - .or. & - patch_icpp(patch_id)%normal(2) /= dflt_real & - .or. & - patch_icpp(patch_id)%normal(3) /= dflt_real & - .or. & - patch_icpp(patch_id)%radii(1) /= dflt_real & - .or. & - patch_icpp(patch_id)%radii(2) /= dflt_real & - .or. & - patch_icpp(patch_id)%radii(3) /= dflt_real) then + ! Constraints on the geometric parameters of the inactive patch + if (patch_icpp(patch_id)%x_centroid /= dflt_real & + .or. & + patch_icpp(patch_id)%y_centroid /= dflt_real & + .or. & + patch_icpp(patch_id)%z_centroid /= dflt_real & + .or. & + patch_icpp(patch_id)%length_x /= dflt_real & + .or. & + patch_icpp(patch_id)%length_y /= dflt_real & + .or. & + patch_icpp(patch_id)%length_z /= dflt_real & + .or. & + patch_icpp(patch_id)%radius /= dflt_real & + .or. & + patch_icpp(patch_id)%epsilon /= dflt_real & + .or. & + patch_icpp(patch_id)%beta /= dflt_real & + .or. & + patch_icpp(patch_id)%normal(1) /= dflt_real & + .or. & + patch_icpp(patch_id)%normal(2) /= dflt_real & + .or. & + patch_icpp(patch_id)%normal(3) /= dflt_real & + .or. & + patch_icpp(patch_id)%radii(1) /= dflt_real & + .or. & + patch_icpp(patch_id)%radii(2) /= dflt_real & + .or. & + patch_icpp(patch_id)%radii(3) /= dflt_real) then - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of inactive '// & - 'patch '//trim(iStr)//'. Exiting ...') + call s_mpi_abort('Inconsistency(ies) detected in '// & + 'geometric parameters of inactive '// & + 'patch '//trim(iStr)//'. Exiting ...') - end if + end if - end subroutine s_check_inactive_patch_geometry + end subroutine s_check_inactive_patch_geometry - !> This subroutine verifies that any rights granted to the + !> This subroutine verifies that any rights granted to the !! given active patch, to overwrite the preceding active !! patches, were consistently inputted by the user. !! @param patch_id Patch identifier - subroutine s_check_active_patch_alteration_rights(patch_id) + subroutine s_check_active_patch_alteration_rights(patch_id) - integer, intent(in) :: patch_id - call s_int_to_str(patch_id, iStr) + integer, intent(in) :: patch_id + call s_int_to_str(patch_id, iStr) - ! Constraints on the alteration rights of an active patch - if (patch_icpp(patch_id)%alter_patch(0) .eqv. .false. & - .or. & - any(patch_icpp(patch_id)%alter_patch(patch_id:))) then + ! Constraints on the alteration rights of an active patch + if (patch_icpp(patch_id)%alter_patch(0) .eqv. .false. & + .or. & + any(patch_icpp(patch_id)%alter_patch(patch_id:))) then - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'alteration rights of active '// & - 'patch '//trim(iStr)//'. Exiting ...') + call s_mpi_abort('Inconsistency(ies) detected in '// & + 'alteration rights of active '// & + 'patch '//trim(iStr)//'. Exiting ...') - end if + end if - end subroutine s_check_active_patch_alteration_rights + end subroutine s_check_active_patch_alteration_rights - !> This subroutine verifies that the rights of the given + !> This subroutine verifies that the rights of the given !! inactive patch, to overwrite the preceding patches, !! remain unaltered by the user inputs. !! @param patch_id Patch identifier - subroutine s_check_inactive_patch_alteration_rights(patch_id) + subroutine s_check_inactive_patch_alteration_rights(patch_id) - ! Patch identifier - integer, intent(in) :: patch_id - call s_int_to_str(patch_id, iStr) + ! Patch identifier + integer, intent(in) :: patch_id + call s_int_to_str(patch_id, iStr) - ! Constraints on the alteration rights of an inactive patch - if (patch_icpp(patch_id)%alter_patch(0) .eqv. .false. & - .or. & - any(patch_icpp(patch_id)%alter_patch(1:))) then + ! Constraints on the alteration rights of an inactive patch + if (patch_icpp(patch_id)%alter_patch(0) .eqv. .false. & + .or. & + any(patch_icpp(patch_id)%alter_patch(1:))) then - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'alteration rights of inactive '// & - 'patch '//trim(iStr)//'. Exiting ...') + call s_mpi_abort('Inconsistency(ies) detected in '// & + 'alteration rights of inactive '// & + 'patch '//trim(iStr)//'. Exiting ...') - end if + end if - end subroutine s_check_inactive_patch_alteration_rights + end subroutine s_check_inactive_patch_alteration_rights - !> This subroutine verifies that the smoothing parameters of + !> This subroutine verifies that the smoothing parameters of !! the given patch, which supports the smoothing out of its !! boundaries, have consistently been inputted by the user. !! @param patch_id Patch identifier - subroutine s_check_supported_patch_smoothing(patch_id) - - integer, intent(in) :: patch_id - call s_int_to_str(patch_id, iStr) - - ! Constraints on the smoothing parameters of a supported patch - if ((patch_icpp(patch_id)%smoothen & - .and. & - (patch_icpp(patch_id)%smooth_patch_id >= patch_id & - .or. & - patch_icpp(patch_id)%smooth_patch_id == 0 & - .or. & - patch_icpp(patch_id)%smooth_coeff <= 0d0)) & - .or. & - ((patch_icpp(patch_id)%smoothen .neqv. .true.) & - .and. & - (patch_icpp(patch_id)%smooth_patch_id /= patch_id & - .or. & - patch_icpp(patch_id)%smooth_coeff /= dflt_real))) then + subroutine s_check_supported_patch_smoothing(patch_id) - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'smoothing parameters of supported '// & - 'patch '//trim(iStr)//'. Exiting ...') + integer, intent(in) :: patch_id + call s_int_to_str(patch_id, iStr) - end if + ! Constraints on the smoothing parameters of a supported patch + if ((patch_icpp(patch_id)%smoothen & + .and. & + (patch_icpp(patch_id)%smooth_patch_id >= patch_id & + .or. & + patch_icpp(patch_id)%smooth_patch_id == 0 & + .or. & + patch_icpp(patch_id)%smooth_coeff <= 0d0)) & + .or. & + ((patch_icpp(patch_id)%smoothen .neqv. .true.) & + .and. & + (patch_icpp(patch_id)%smooth_patch_id /= patch_id & + .or. & + patch_icpp(patch_id)%smooth_coeff /= dflt_real))) then + + call s_mpi_abort('Inconsistency(ies) detected in '// & + 'smoothing parameters of supported '// & + 'patch '//trim(iStr)//'. Exiting ...') + + end if - end subroutine s_check_supported_patch_smoothing + end subroutine s_check_supported_patch_smoothing - !> This subroutine verifies that the smoothing parameters of + !> This subroutine verifies that the smoothing parameters of !! the given patch, which does not support the smoothing out !! of its boundaries, remain unaltered by the user inputs. !! @param patch_id Patch identifier - subroutine s_check_unsupported_patch_smoothing(patch_id) + subroutine s_check_unsupported_patch_smoothing(patch_id) - ! Patch identifier - integer, intent(in) :: patch_id - ! call s_int_to_str(patch_id, iStr) + ! Patch identifier + integer, intent(in) :: patch_id + ! call s_int_to_str(patch_id, iStr) - ! Constraints on the smoothing parameters of an unsupported patch - if (patch_icpp(patch_id)%smoothen & - .or. & - patch_icpp(patch_id)%smooth_patch_id /= patch_id & - .or. & - patch_icpp(patch_id)%smooth_coeff /= dflt_real) then + ! Constraints on the smoothing parameters of an unsupported patch + if (patch_icpp(patch_id)%smoothen & + .or. & + patch_icpp(patch_id)%smooth_patch_id /= patch_id & + .or. & + patch_icpp(patch_id)%smooth_coeff /= dflt_real) then - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'smoothing parameters of unsupported '// & - 'patch '//trim(iStr)//'. Exiting ...') + call s_mpi_abort('Inconsistency(ies) detected in '// & + 'smoothing parameters of unsupported '// & + 'patch '//trim(iStr)//'. Exiting ...') - end if + end if - end subroutine s_check_unsupported_patch_smoothing + end subroutine s_check_unsupported_patch_smoothing - !> This subroutine verifies that the primitive variables + !> This subroutine verifies that the primitive variables !! associated with the given active patch are physically !! consistent. !! @param patch_id Patch identifier - subroutine s_check_active_patch_primitive_variables(patch_id) + subroutine s_check_active_patch_primitive_variables(patch_id) - integer, intent(in) :: patch_id - call s_int_to_str(patch_id, iStr) + integer, intent(in) :: patch_id + call s_int_to_str(patch_id, iStr) - ! Constraints on the primitive variables of an active patch - if (patch_icpp(patch_id)%vel(1) == dflt_real & - .or. & - (n == 0 .and. patch_icpp(patch_id)%vel(2) /= dflt_real .and. patch_icpp(patch_id)%vel(2) /= 0) & - .or. & - (n > 0 .and. patch_icpp(patch_id)%vel(2) == dflt_real) & - .or. & - (p == 0 .and. patch_icpp(patch_id)%vel(3) /= dflt_real .and. patch_icpp(patch_id)%vel(3) /= 0) & - .or. & - (p > 0 .and. patch_icpp(patch_id)%vel(3) == dflt_real) & - ! .OR. & - ! patch_icpp(patch_id)%pres <= 0d0 & - .or. & - (model_eqns == 1 .and. & - (patch_icpp(patch_id)%rho <= 0d0 .or. & - patch_icpp(patch_id)%gamma <= 0d0 .or. & - patch_icpp(patch_id)%pi_inf < 0d0)) & + ! Constraints on the primitive variables of an active patch + if (patch_icpp(patch_id)%vel(1) == dflt_real & + .or. & + (n == 0 .and. patch_icpp(patch_id)%vel(2) /= dflt_real .and. patch_icpp(patch_id)%vel(2) /= 0) & + .or. & + (n > 0 .and. patch_icpp(patch_id)%vel(2) == dflt_real) & + .or. & + (p == 0 .and. patch_icpp(patch_id)%vel(3) /= dflt_real .and. patch_icpp(patch_id)%vel(3) /= 0) & + .or. & + (p > 0 .and. patch_icpp(patch_id)%vel(3) == dflt_real) & + ! .OR. & + ! patch_icpp(patch_id)%pres <= 0d0 & + .or. & + (model_eqns == 1 .and. & + (patch_icpp(patch_id)%rho <= 0d0 .or. & + patch_icpp(patch_id)%gamma <= 0d0 .or. & + patch_icpp(patch_id)%pi_inf < 0d0)) & + .or. & + (patch_icpp(patch_id)%geometry == 5 & + .and. & + patch_icpp(patch_id)%pi_inf > 0) & + .or. & + (model_eqns == 2 & + .and. & + (any(patch_icpp(patch_id)%alpha_rho(1:num_fluids) < 0d0)))) then + + call s_mpi_abort('Inconsistency(ies) detected in '// & + 'primitive variables of active '// & + 'patch '//trim(iStr)//'. Exiting ...') + + end if + + if (model_eqns == 2 .and. num_fluids < num_fluids) then + + if (any(patch_icpp(patch_id)%alpha_rho(num_fluids + 1:) & + /= dflt_real) & .or. & - (patch_icpp(patch_id)%geometry == 5 & - .and. & - patch_icpp(patch_id)%pi_inf > 0) & + any(patch_icpp(patch_id)%alpha(num_fluids + 1:) & + /= dflt_real) & .or. & - (model_eqns == 2 & - .and. & - (any(patch_icpp(patch_id)%alpha_rho(1:num_fluids) < 0d0)))) then + (patch_icpp(patch_id)%alpha(num_fluids) == dflt_real)) then call s_mpi_abort('Inconsistency(ies) detected in '// & 'primitive variables of active '// & @@ -778,75 +794,59 @@ contains end if - if (model_eqns == 2 .and. num_fluids < num_fluids) then - - if (any(patch_icpp(patch_id)%alpha_rho(num_fluids + 1:) & - /= dflt_real) & - .or. & - any(patch_icpp(patch_id)%alpha(num_fluids + 1:) & - /= dflt_real) & - .or. & - (patch_icpp(patch_id)%alpha(num_fluids) == dflt_real)) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'primitive variables of active '// & - 'patch '//trim(iStr)//'. Exiting ...') - - end if - - end if + end if - end subroutine s_check_active_patch_primitive_variables + end subroutine s_check_active_patch_primitive_variables - !> This subroutine verifies that the primitive variables + !> This subroutine verifies that the primitive variables !! associated with the given inactive patch remain unaltered !! by the user inputs. !! @param patch_id Patch identifier - subroutine s_check_inactive_patch_primitive_variables(patch_id) + subroutine s_check_inactive_patch_primitive_variables(patch_id) - integer, intent(in) :: patch_id - call s_int_to_str(patch_id, iStr) + integer, intent(in) :: patch_id + call s_int_to_str(patch_id, iStr) - ! Constraints on the primitive variables of an inactive patch - if (any(patch_icpp(patch_id)%alpha_rho /= dflt_real) & - .or. & - patch_icpp(patch_id)%rho /= dflt_real & - .or. & - any(patch_icpp(patch_id)%vel /= dflt_real) & - .or. & - patch_icpp(patch_id)%pres /= dflt_real & - .or. & - any(patch_icpp(patch_id)%alpha /= dflt_real) & - .or. & - patch_icpp(patch_id)%gamma /= dflt_real & - .or. & - patch_icpp(patch_id)%pi_inf /= dflt_real) then + ! Constraints on the primitive variables of an inactive patch + if (any(patch_icpp(patch_id)%alpha_rho /= dflt_real) & + .or. & + patch_icpp(patch_id)%rho /= dflt_real & + .or. & + any(patch_icpp(patch_id)%vel /= dflt_real) & + .or. & + patch_icpp(patch_id)%pres /= dflt_real & + .or. & + any(patch_icpp(patch_id)%alpha /= dflt_real) & + .or. & + patch_icpp(patch_id)%gamma /= dflt_real & + .or. & + patch_icpp(patch_id)%pi_inf /= dflt_real) then - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'primitive variables of inactive '// & - 'patch '//trim(iStr)//'. Exiting ...') + call s_mpi_abort('Inconsistency(ies) detected in '// & + 'primitive variables of inactive '// & + 'patch '//trim(iStr)//'. Exiting ...') - end if + end if - end subroutine s_check_inactive_patch_primitive_variables + end subroutine s_check_inactive_patch_primitive_variables - subroutine s_check_model_geometry(patch_id) + subroutine s_check_model_geometry(patch_id) - integer, intent(in) :: patch_id + integer, intent(in) :: patch_id - logical :: file_exists + logical :: file_exists - inquire (file=patch_icpp(patch_id)%model%filepath, exist=file_exists) + inquire (file=patch_icpp(patch_id)%model%filepath, exist=file_exists) - if (.not. file_exists) then + if (.not. file_exists) then - print '(A,I0,A)', 'Model file '//trim(patch_icpp(patch_id)%model%filepath)// & - ' requested by patch ', patch_id, ' does not exist. Exiting ...' + print '(A,I0,A)', 'Model file '//trim(patch_icpp(patch_id)%model%filepath)// & + ' requested by patch ', patch_id, ' does not exist. Exiting ...' - call s_mpi_abort() + call s_mpi_abort() - end if + end if - end subroutine s_check_model_geometry + end subroutine s_check_model_geometry - end module m_check_patches +end module m_check_patches