Helmholtz_TEMPLATE_equations_routines.f90

Go to the documentation of this file.

MODULE helmholtz_equations_routines

  USE base_routines
  USE basis_routines
  USE boundary_conditions_routines
  USE constants
  USE control_loop_routines
  USE distributed_matrix_vector
  USE domain_mappings
  USE equations_routines
  USE equations_mapping_routines
  USE equations_matrices_routines
  USE equations_set_constants
  USE field_routines
  USE input_output
  USE iso_varying_string
  USE kinds
  USE matrix_vector
  USE node_routines
  USE problem_constants
  USE strings
  USE solver_routines
  USE timer
  USE types

#include "macros.h"  

  IMPLICIT NONE

  PRIVATE

  !Module parameters

  !Module types

  !Module variables

  !Interfaces

  PUBLIC helmholtz_equation_finite_element_calculate,helmholtz_equation_equations_set_setup, &
    & helmholtz_equation_equations_set_solution_method_set,helmholtzequation_equationssetspecificationset, &
    & helmholtz_equation_problem_subtype_set,helmholtz_equation_problem_setup
  
CONTAINS

  !
  !================================================================================================================================
  !

  SUBROUTINE helmholtz_equation_finite_element_calculate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)

    !Argument variables
    TYPE(equations_set_type), POINTER :: EQUATIONS_SET
    INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Local Variables
    TYPE(equations_type), POINTER :: EQUATIONS
    TYPE(varying_string) :: LOCAL_ERROR
    
    enters("HELMHOLTZ_EQUATION_FINITE_ELEMENT_CALCULATE",err,error,*999)
    
    IF(ASSOCIATED(equations_set)) THEN
      equations=>equations_set%EQUATIONS
      IF(ASSOCIATED(equations)) THEN
        SELECT CASE(equations_set%SUBTYPE)
        CASE(equations_set_no_source_helmholtz_subtype)


          
        CASE DEFAULT
          local_error="Equations set subtype "//trim(number_to_vstring(equations_set%SUBTYPE,"*",err,error))// &
            & " is not valid for a Helmholtz equation type of a classical field equations set class."
          CALL flag_error(local_error,err,error,*999)
        END SELECT
      ELSE
        CALL flag_error("Equations set equations is not associated.",err,error,*999)
      ENDIF
    ELSE
      CALL flag_error("Equations set is not associated.",err,error,*999)
    ENDIF
    
    exits("HELMHOLTZ_EQUATION_FINITE_ELEMENT_CALCULATE")
    RETURN
999 errorsexits("HELMHOLTZ_EQUATION_FINITE_ELEMENT_CALCULATE",err,error)
    RETURN 1
  END SUBROUTINE helmholtz_equation_finite_element_calculate

  !
  !================================================================================================================================
  !

  SUBROUTINE helmholtz_equation_equations_set_setup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)

    !Argument variables
    TYPE(equations_set_type), POINTER :: EQUATIONS_SET
    TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Local Variables
    TYPE(varying_string) :: LOCAL_ERROR
    
    enters("HELMHOLTZ_EQUATION_EQUATIONS_SET_SETUP",err,error,*999)

    IF(ASSOCIATED(equations_set)) THEN
      SELECT CASE(equations_set%SUBTYPE)
      CASE(equations_set_no_source_helmholtz_subtype)
        CALL helmholtz_equation_equations_set_linear_setup(equations_set,equations_set_setup,err,error,*999)        
      CASE DEFAULT
        local_error="Equations set subtype "//trim(number_to_vstring(equations_set%SUBTYPE,"*",err,error))// &
          & " is not valid for a Helmholtz equation type of a classical field equation set class."
        CALL flag_error(local_error,err,error,*999)
      END SELECT
    ELSE
      CALL flag_error("Equations set is not associated.",err,error,*999)
    ENDIF
       
    exits("HELMHOLTZ_EQUATION_EQUATIONS_SET_SETUP")
    RETURN
999 errorsexits("HELMHOLTZ_EQUATION_EQUATIONS_SET_SETUP",err,error)
    RETURN 1
  END SUBROUTINE helmholtz_equation_equations_set_setup

  !
  !================================================================================================================================
  !

  SUBROUTINE helmholtz_equation_equations_set_solution_method_set(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)

    !Argument variables
    TYPE(equations_set_type), POINTER :: EQUATIONS_SET
    INTEGER(INTG), INTENT(IN) :: SOLUTION_METHOD
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Local Variables
    TYPE(varying_string) :: LOCAL_ERROR
    
    enters("HELMHOLTZ_EQUATIONS_SET_SOLUTION_METHOD_SET",err,error,*999)
    
    IF(ASSOCIATED(equations_set)) THEN
      SELECT CASE(equations_set%SUBTYPE)
      CASE(equations_set_no_subtype)        
        SELECT CASE(solution_method)
        CASE(equations_set_fem_solution_method)
          equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
        CASE(equations_set_bem_solution_method)
          CALL flag_error("Not implemented.",err,error,*999)
        CASE(equations_set_fd_solution_method)
          CALL flag_error("Not implemented.",err,error,*999)
        CASE(equations_set_fv_solution_method)
          CALL flag_error("Not implemented.",err,error,*999)
        CASE(equations_set_gfem_solution_method)
          CALL flag_error("Not implemented.",err,error,*999)
        CASE(equations_set_gfv_solution_method)
          CALL flag_error("Not implemented.",err,error,*999)
        CASE DEFAULT
          local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
          CALL flag_error(local_error,err,error,*999)
        END SELECT
      CASE DEFAULT
        local_error="Equations set subtype of "//trim(number_to_vstring(equations_set%SUBTYPE,"*",err,error))// &
          & " is not valid for a Helmholtz equation type of an classical field equations set class."
        CALL flag_error(local_error,err,error,*999)
      END SELECT
    ELSE
      CALL flag_error("Equations set is not associated.",err,error,*999)
    ENDIF
       
    exits("HELMHOLTZ_EQUATION_EQUATIONS_SET_SOLUTION_METHOD_SET")
    RETURN
999 errorsexits("HELMHOLTZ_EQUATION_EQUATIONS_SET_SOLUTION_METHOD_SET",err,error)
    RETURN 1
  END SUBROUTINE helmholtz_equation_equations_set_solution_method_set

  !
  !================================================================================================================================
  !

  SUBROUTINE helmholtzequation_equationssetspecificationset(equationsSet,specification,err,error,*)

    !Argument variables
    TYPE(equations_set_type), POINTER :: equationsSet
    INTEGER(INTG), INTENT(IN) :: specification(:)
    INTEGER(INTG), INTENT(OUT) :: err
    TYPE(varying_string), INTENT(OUT) :: error
    !Local Variables
    TYPE(varying_string) :: localError
    INTEGER(INTG) :: subtype

    enters("HelmholtzEquation_EquationsSetSpecificationSet",err,error,*999)

    IF(ASSOCIATED(equationsset)) THEN
      IF(SIZE(specification,1)/=3) THEN
        CALL flagerror("Equations set specification must have three entries for a Helmholtz type equations set.", &
          & err,error,*999)
      END IF
      subtype=specification(3)
      SELECT CASE(subtype)
      CASE(equations_set_no_source_helmholtz_subtype)
        !ok
      CASE DEFAULT
        localerror="The third equations set specification of "//trim(numbertovstring(subtype,"*",err,error))// &
          & " is not valid for a Helmholtz type of a classical field equations set."
        CALL flagerror(localerror,err,error,*999)
      END SELECT
      !Set full specification
      IF(ALLOCATED(equationsset%specification)) THEN
        CALL flagerror("Equations set specification is already allocated.",err,error,*999)
      ELSE
        ALLOCATE(equationsset%specification(3),stat=err)
        IF(err/=0) CALL flagerror("Could not allocate equations set specification.",err,error,*999)
      END IF
      equationsset%specification(1:3)=[equations_set_classical_field_class,equations_set_helmholtz_equation_type,subtype]
    ELSE
      CALL flagerror("Equations set is not associated.",err,error,*999)
    END IF

    exits("HelmholtzEquation_EquationsSetSpecificationSet")
    RETURN
999 errors("HelmholtzEquation_EquationsSetSpecificationSet",err,error)
    exits("HelmholtzEquation_EquationsSetSpecificationSet")
    RETURN 1
    
  END SUBROUTINE helmholtzequation_equationssetspecificationset

  !
  !================================================================================================================================
  !

  SUBROUTINE helmholtz_equation_equations_set_linear_setup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)

    !Argument variables
    TYPE(equations_set_type), POINTER :: EQUATIONS_SET
    TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Local Variables
    TYPE(varying_string) :: LOCAL_ERROR
    
    enters("HELMHOLTZ_EQUATION_EQUATION_SET_LINEAR_SETUP",err,error,*999)

    IF(ASSOCIATED(equations_set)) THEN
      IF(equations_set%SUBTYPE==equations_set_no_source_helmholtz_subtype) THEN
        SELECT CASE(equations_set_setup%SETUP_TYPE)
        CASE(equations_set_setup_initial_type)
        CASE(equations_set_setup_geometry_type)
        CASE(equations_set_setup_dependent_type)
        CASE(equations_set_setup_materials_type)
        CASE(equations_set_setup_source_type)
        CASE(equations_set_setup_analytic_type)
        CASE(equations_set_setup_equations_type)
        CASE DEFAULT
          local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
            & " is invalid for a standard Helmholtz equation."
          CALL flag_error(local_error,err,error,*999)
        END SELECT
      ELSE
        local_error="The equations set subtype of "//trim(number_to_vstring(equations_set%SUBTYPE,"*",err,error))// &
          & " does not equal a linear Helmholtz equation subtype."
        CALL flag_error(local_error,err,error,*999)
      ENDIF
    ELSE
      CALL flag_error("Equations set is not associated.",err,error,*999)
    ENDIF
       
    exits("HELMHOLTZ_EQUATION_EQUATIONS_SET_LINEAR_SETUP")
    RETURN
999 errorsexits("HELMHOLTZ_EQUATION_EQUATIONS_SET_LINEAR_SETUP",err,error)
    RETURN 1
  END SUBROUTINE helmholtz_equation_equations_set_linear_setup

  !
  !================================================================================================================================
  !
 
  SUBROUTINE helmholtz_equation_problem_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
    
    !Argument variables
    TYPE(problem_type), POINTER :: PROBLEM
    TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Local Variables
    TYPE(varying_string) :: LOCAL_ERROR
    
    enters("HELMHOLTZ_EQUATION_PROBLEM_SETUP",err,error,*999)

    IF(ASSOCIATED(problem)) THEN
      SELECT CASE(problem%SUBTYPE)
      CASE(problem_no_source_helmholtz_subtype)
        CALL helmholtz_equation_problem_linear_setup(problem,problem_setup,err,error,*999)
      CASE DEFAULT
        local_error="Problem subtype "//trim(number_to_vstring(problem%SUBTYPE,"*",err,error))// &
          & " is not valid for a Helmholtz equation type of a classical field problem class."
        CALL flag_error(local_error,err,error,*999)
      END SELECT
    ELSE
      CALL flag_error("Problem is not associated.",err,error,*999)
    ENDIF
       
    exits("HELMHOLTZ_EQUATION_PROBLEM_SETUP")
    RETURN
999 errorsexits("HELMHOLTZ_EQUATION_PROBLEM_SETUP",err,error)
    RETURN 1
  END SUBROUTINE helmholtz_equation_problem_setup
  
  !
  !================================================================================================================================
  !

  SUBROUTINE helmholtz_equation_problem_subtype_set(PROBLEM,PROBLEM_SUBTYPE,ERR,ERROR,*)

    !Argument variables
    TYPE(problem_type), POINTER :: PROBLEM
    INTEGER(INTG), INTENT(IN) :: PROBLEM_SUBTYPE
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Local Variables
    TYPE(varying_string) :: LOCAL_ERROR
    
    enters("HELMHOLTZ_EQUATION_PROBLEM_SUBTYPE_SET",err,error,*999)
    
    IF(ASSOCIATED(problem)) THEN
      SELECT CASE(problem_subtype)
      CASE(problem_no_source_helmholtz_subtype)        
        problem%CLASS=problem_classical_field_class
        problem%TYPE=problem_helmholtz_equation_type
        problem%SUBTYPE=problem_no_source_helmholtz_subtype     
      CASE DEFAULT
        local_error="Problem subtype "//trim(number_to_vstring(problem_subtype,"*",err,error))// &
          & " is not valid for a Helmholtz equation type of a classical field problem class."
        CALL flag_error(local_error,err,error,*999)
      END SELECT
    ELSE
      CALL flag_error("Problem is not associated.",err,error,*999)
    ENDIF
       
    exits("HELMHOLTZ_EQUATION_PROBLEM_SUBTYPE_SET")
    RETURN
999 errorsexits("HELMHOLTZ_EQUATION_PROBLEM_SUBTYPE_SET",err,error)
    RETURN 1
  END SUBROUTINE helmholtz_equation_problem_subtype_set

  !
  !================================================================================================================================
  !

  SUBROUTINE helmholtz_equation_problem_linear_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)

    !Argument variables
    TYPE(problem_type), POINTER :: PROBLEM
    TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Local Variables
    TYPE(varying_string) :: LOCAL_ERROR
    
    enters("HELMHOLTZ_EQUATION_PROBLEM_LINEAR_SETUP",err,error,*999)

    IF(ASSOCIATED(problem)) THEN
      IF(problem%SUBTYPE==problem_no_source_helmholtz_subtype) THEN
        SELECT CASE(problem_setup%SETUP_TYPE)
        CASE(problem_setup_initial_type)
        CASE(problem_setup_control_type)
        CASE(problem_setup_solvers_type)
        CASE(problem_setup_solver_equations_type)
        CASE DEFAULT
          local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
            & " is invalid for a linear Helmholtz equation."
          CALL flag_error(local_error,err,error,*999)
        END SELECT
      ELSE
        local_error="The problem subtype of "//trim(number_to_vstring(problem%SUBTYPE,"*",err,error))// &
          & " does not equal a linear Helmholtz equation subtype."
        CALL flag_error(local_error,err,error,*999)
      ENDIF
    ELSE
      CALL flag_error("Problem is not associated.",err,error,*999)
    ENDIF
    
    exits("HELMHOLTZ_EQUATION_PROBLEM_LINEAR_SETUP")
    RETURN
999 errorsexits("HELMHOLTZ_EQUATION_PROBLEM_LINEAR_SETUP",err,error)
    RETURN 1
  END SUBROUTINE helmholtz_equation_problem_linear_setup

  !
  !================================================================================================================================
  !
 
END MODULE helmholtz_equations_routines