classical_field_routines.f90

Go to the documentation of this file.

MODULE classical_field_routines

  USE advection_equation_routines
  USE advection_diffusion_equation_routines
  USE base_routines
  USE diffusion_equation_routines
  USE equations_set_constants
  USE helmholtz_equations_routines
  USE iso_varying_string
  USE kinds
  USE hamilton_jacobi_equations_routines
  USE laplace_equations_routines
  USE poisson_equations_routines
  USE problem_constants
  USE reaction_diffusion_equation_routines
  USE strings
  USE types

#include "macros.h"

  IMPLICIT NONE

  PRIVATE

  !Module parameters

  !Module types

  !Module variables

  !Interfaces

  PUBLIC classical_field_analytic_functions_evaluate
  
  PUBLIC classical_field_control_loop_post_loop

  PUBLIC classicalfield_finiteelementjacobianevaluate,classicalfield_finiteelementresidualevaluate
  
  PUBLIC classicalfield_equationssetspecificationset

  PUBLIC classical_field_finite_element_calculate
  
  PUBLIC classical_field_equations_set_setup

  PUBLIC classicalfield_equationssetsolutionmethodset

  PUBLIC classicalfield_problemspecificationset

  PUBLIC classical_field_problem_setup

  PUBLIC classical_field_pre_solve,classical_field_post_solve

  PUBLIC classicalfield_boundaryconditionsanalyticcalculate

CONTAINS

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

  SUBROUTINE classical_field_analytic_functions_evaluate(EQUATIONS_SET,EQUATIONS_TYPE,ANALYTIC_FUNCTION_TYPE,POSITION,TANGENTS, &
    & normal,time,variable_type,global_derivative,component_number,analytic_parameters,materials_parameters,VALUE,err,error,*)

    !Argument variables
    TYPE(equations_set_type), POINTER :: EQUATIONS_SET
    INTEGER(INTG), INTENT(IN) :: EQUATIONS_TYPE
    INTEGER(INTG), INTENT(IN) :: ANALYTIC_FUNCTION_TYPE
    REAL(DP), INTENT(IN) :: POSITION(:)
    REAL(DP), INTENT(IN) :: TANGENTS(:,:)
    REAL(DP), INTENT(IN) :: NORMAL(:)
    REAL(DP), INTENT(IN) :: TIME
    INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
    INTEGER(INTG), INTENT(IN) :: GLOBAL_DERIVATIVE
    INTEGER(INTG), INTENT(IN) :: COMPONENT_NUMBER
    REAL(DP), INTENT(IN) :: ANALYTIC_PARAMETERS(:)
    REAL(DP), INTENT(IN) :: MATERIALS_PARAMETERS(:)
    REAL(DP), INTENT(OUT) :: VALUE
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Local Variables
    TYPE(varying_string) :: LOCAL_ERROR

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

    IF(ASSOCIATED(equations_set)) THEN
     SELECT CASE(equations_type)
      CASE(equations_set_laplace_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_hj_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_poisson_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_helmholtz_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_wave_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_diffusion_equation_type)
        CALL diffusion_analyticfunctionsevaluate(equations_set,analytic_function_type,position, &
          & tangents,normal,time,variable_type,global_derivative,component_number,analytic_parameters, &
          & materials_parameters,VALUE,err,error,*999)
      CASE(equations_set_advection_diffusion_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_advection_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_reaction_diffusion_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_biharmonic_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE DEFAULT
        local_error="Equations set equation type "//trim(number_to_vstring(equations_type,"*",err,error))// &
          & " is not valid for a classical field equations set class."
        CALL flagerror(local_error,err,error,*999)
      END SELECT
    ELSE
      CALL flagerror("Equations set is not associated.",err,error,*999)
    ENDIF
       
    exits("CLASSICAL_FIELD_ANALYTIC_FUNCTIONS_EVALUATE")
    RETURN
999 errorsexits("CLASSICAL_FIELD_ANALYTIC_FUNCTIONS_EVALUATE",err,error)
    RETURN 1
  END SUBROUTINE classical_field_analytic_functions_evaluate

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

  SUBROUTINE classical_field_control_loop_post_loop(CONTROL_LOOP,ERR,ERROR,*)

    !Argument variables
    TYPE(control_loop_type), POINTER :: CONTROL_LOOP
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Local Variables
    TYPE(problem_type), POINTER :: PROBLEM
    TYPE(varying_string) :: LOCAL_ERROR

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

    IF(ASSOCIATED(control_loop)) THEN
      problem=>control_loop%PROBLEM
      IF(ASSOCIATED(problem)) THEN
        SELECT CASE(control_loop%LOOP_TYPE)
        CASE(problem_control_time_loop_type)
          SELECT CASE(problem%specification(2))
          CASE(problem_diffusion_equation_type)
            CALL diffusion_equation_control_loop_post_loop(control_loop,err,error,*999)
          CASE(problem_reaction_diffusion_equation_type)
            CALL reaction_diffusion_control_loop_post_loop(control_loop,err,error,*999)
          CASE DEFAULT
            local_error="The second problem specification of "// &
              & trim(number_to_vstring(problem%specification(2),"*",err,error))// &
              & " is not valid for a classical field problem."
            CALL flagerror(local_error,err,error,*999)
          END SELECT
        CASE DEFAULT
          !do nothing
        END SELECT
      ELSE
        CALL flagerror("Control loop problem is not associated.",err,error,*999)
      ENDIF
    ELSE
      CALL flagerror("Control loop is not associated.",err,error,*999)
    ENDIF

    exits("CLASSICAL_FIELD_CONTROL_LOOP_POST_LOOP")
    RETURN
999 errorsexits("CLASSICAL_FIELD_LOOP_POST_LOOP",err,error)
    RETURN 1
    
  END SUBROUTINE classical_field_control_loop_post_loop

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

  SUBROUTINE classicalfield_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

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

    IF(ASSOCIATED(equationsset)) THEN
      IF(SIZE(specification,1)<2) THEN
        CALL flagerror("Equations set specification must have at least two entries for a classical field class equations set.", &
          & err,error,*999)
      END IF
      SELECT CASE(specification(2))
      CASE(equations_set_laplace_equation_type)
        CALL laplace_equationssetspecificationset(equationsset,specification,err,error,*999)
      CASE(equations_set_hj_equation_type)
        CALL hjequation_equationssetspecificationset(equationsset,specification,err,error,*999)
      CASE(equations_set_poisson_equation_type)
        CALL poisson_equationssetspecificationset(equationsset,specification,err,error,*999)
      CASE(equations_set_helmholtz_equation_type)
        CALL helmholtz_equationssetspecificationset(equationsset,specification,err,error,*999)
      CASE(equations_set_wave_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_diffusion_equation_type)
        CALL diffusion_equationssetspecificationset(equationsset,specification,err,error,*999)
      CASE(equations_set_advection_equation_type)
        CALL advection_equationssetspecificationset(equationsset,specification,err,error,*999)
      CASE(equations_set_advection_diffusion_equation_type)
        CALL advectiondiffusion_equationssetspecificationset(equationsset,specification,err,error,*999)
      CASE(equations_set_reaction_diffusion_equation_type)
        CALL reactiondiffusion_equationssetspecificationset(equationsset,specification,err,error,*999)
      CASE(equations_set_biharmonic_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE DEFAULT
        localerror="The second equations set specification of "//trim(numbertovstring(specification(2),"*",err,error))// &
          & " is not valid for a classical field equations set."
       CALL flagerror(localerror,err,error,*999)
      END SELECT
    ELSE
      CALL flagerror("Equations set is not associated",err,error,*999)
    END IF

    exits("ClassicalField_EquationsSetSpecificationSet")
    RETURN
999 errors("ClassicalField_EquationsSetSpecificationSet",err,error)
    exits("ClassicalField_EquationsSetSpecificationSet")
    RETURN 1
    
  END SUBROUTINE classicalfield_equationssetspecificationset

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

  SUBROUTINE classical_field_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(varying_string) :: LOCAL_ERROR
    
    enters("CLASSICAL_FIELD_FINITE_ELEMENT_CALCULATE",err,error,*999)

    IF(ASSOCIATED(equations_set)) THEN
      IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
        CALL flagerror("Equations set specification is not allocated.",err,error,*999)
      ELSE IF(SIZE(equations_set%SPECIFICATION,1)<2) THEN
        CALL flagerror("Equations set specification must have at least two entries for a classical field class equations set.", &
          & err,error,*999)
      END IF
      SELECT CASE(equations_set%SPECIFICATION(2))
      CASE(equations_set_laplace_equation_type)
        CALL laplaceequation_finiteelementcalculate(equations_set,element_number,err,error,*999)
      CASE(equations_set_hj_equation_type)
        CALL hj_equation_finite_element_calculate(equations_set,element_number,err,error,*999)
      CASE(equations_set_poisson_equation_type)
        CALL poisson_equation_finite_element_calculate(equations_set,element_number,err,error,*999)
      CASE(equations_set_helmholtz_equation_type)
        CALL helmholtz_equation_finite_element_calculate(equations_set,element_number,err,error,*999)
      CASE(equations_set_wave_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_diffusion_equation_type)
        CALL diffusion_equation_finite_element_calculate(equations_set,element_number,err,error,*999)
      CASE(equations_set_advection_diffusion_equation_type)
        CALL advectiondiffusion_finiteelementcalculate(equations_set,element_number,err,error,*999)
      CASE(equations_set_advection_equation_type)
        CALL advection_equation_finite_element_calculate(equations_set,element_number,err,error,*999)
      CASE(equations_set_reaction_diffusion_equation_type)
        CALL reactiondiffusion_finiteelementcalculate(equations_set,element_number,err,error,*999)
      CASE(equations_set_biharmonic_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE DEFAULT
        local_error="Equations set type "//trim(number_to_vstring(equations_set%SPECIFICATION(2),"*",err,error))// &
          & " is not valid for a classical field equation set class."
        CALL flagerror(local_error,err,error,*999)
      END SELECT
    ELSE
      CALL flagerror("Equations set is not associated",err,error,*999)
    ENDIF
       
    exits("CLASSICAL_FIELD_FINITE_ELEMENT_CALCULATE")
    RETURN
999 errorsexits("CLASSICAL_FIELD_FINITE_ELEMENT_CALCULATE",err,error)
    RETURN 1
  END SUBROUTINE classical_field_finite_element_calculate

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

  SUBROUTINE classicalfield_finiteelementjacobianevaluate(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(varying_string) :: LOCAL_ERROR
    
    enters("ClassicalField_FiniteElementJacobianEvaluate",err,error,*999)

    IF(ASSOCIATED(equations_set)) THEN
      IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
        CALL flagerror("Equations set specification is not allocated.",err,error,*999)
      ELSE IF(SIZE(equations_set%SPECIFICATION,1)<2) THEN
        CALL flagerror("Equations set specification must have at least two entries for a classical field class equations set.", &
          & err,error,*999)
      END IF
      SELECT CASE(equations_set%SPECIFICATION(2))
      CASE(equations_set_laplace_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_hj_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_poisson_equation_type)
        CALL poisson_finiteelementjacobianevaluate(equations_set,element_number,err,error,*999)
      CASE(equations_set_helmholtz_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_wave_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_diffusion_equation_type)
        CALL diffusion_finiteelementjacobianevaluate(equations_set,element_number,err,error,*999)
      CASE(equations_set_advection_diffusion_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_advection_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_reaction_diffusion_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_biharmonic_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE DEFAULT
        local_error="Equations set type "//trim(number_to_vstring(equations_set%SPECIFICATION(2),"*",err,error))// &
          & " is not valid for a classical field equation set class."
        CALL flagerror(local_error,err,error,*999)
      END SELECT
    ELSE
      CALL flagerror("Equations set is not associated",err,error,*999)
    ENDIF
       
    exits("ClassicalField_FiniteElementJacobianEvaluate")
    RETURN
999 errors("ClassicalField_FiniteElementJacobianEvaluate",err,error)
    exits("ClassicalField_FiniteElementJacobianEvaluate")
    RETURN 1
    
  END SUBROUTINE classicalfield_finiteelementjacobianevaluate

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

  SUBROUTINE classicalfield_finiteelementresidualevaluate(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(varying_string) :: LOCAL_ERROR
    
    enters("ClassicalField_FiniteElementResidualEvaluate",err,error,*999)

    IF(ASSOCIATED(equations_set)) THEN
      IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
        CALL flagerror("Equations set specification is not allocated.",err,error,*999)
      ELSE IF(SIZE(equations_set%SPECIFICATION,1)<2) THEN
        CALL flagerror("Equations set specification must have at least two entries for a classical field class equations set.", &
          & err,error,*999)
      END IF
      SELECT CASE(equations_set%SPECIFICATION(2))
      CASE(equations_set_laplace_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_hj_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_poisson_equation_type)
        CALL poisson_finiteelementresidualevaluate(equations_set,element_number,err,error,*999)
      CASE(equations_set_helmholtz_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_wave_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_diffusion_equation_type)
        CALL diffusion_finiteelementresidualevaluate(equations_set,element_number,err,error,*999)
      CASE(equations_set_advection_diffusion_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_advection_equation_type)
        CALL advection_equation_finite_element_calculate(equations_set,element_number,err,error,*999)
      CASE(equations_set_reaction_diffusion_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_biharmonic_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE DEFAULT
        local_error="Equations set type "//trim(number_to_vstring(equations_set%SPECIFICATION(2),"*",err,error))// &
          & " is not valid for a classical field equation set class."
        CALL flagerror(local_error,err,error,*999)
      END SELECT
    ELSE
      CALL flagerror("Equations set is not associated",err,error,*999)
    ENDIF
       
    exits("ClassicalField_FiniteElementResidualEvaluate")
    RETURN
999 errors("ClassicalField_FiniteElementResidualEvaluate",err,error)
    exits("ClassicalField_FiniteElementResidualEvaluate")
    RETURN 1
    
  END SUBROUTINE classicalfield_finiteelementresidualevaluate

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

  SUBROUTINE classical_field_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("CLASSICAL_FIELD_EQUATIONS_SET_SETUP",err,error,*999)

    IF(ASSOCIATED(equations_set)) THEN
      IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
        CALL flagerror("Equations set specification is not allocated.",err,error,*999)
      ELSE IF(SIZE(equations_set%SPECIFICATION,1)<2) THEN
        CALL flagerror("Equations set specification must have at least two entries for a classical field class equations set.", &
          & err,error,*999)
      END IF
      SELECT CASE(equations_set%SPECIFICATION(2))
      CASE(equations_set_laplace_equation_type)
        CALL laplace_equation_equations_set_setup(equations_set,equations_set_setup,err,error,*999)
      CASE(equations_set_hj_equation_type)
        CALL hj_equation_equations_set_setup(equations_set,equations_set_setup,err,error,*999)
      CASE(equations_set_poisson_equation_type)
        CALL poisson_equation_equations_set_setup(equations_set,equations_set_setup,err,error,*999)
      CASE(equations_set_helmholtz_equation_type)
        CALL helmholtz_equation_equations_set_setup(equations_set,equations_set_setup,err,error,*999)
      CASE(equations_set_wave_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_diffusion_equation_type)
        CALL diffusion_equation_equations_set_setup(equations_set,equations_set_setup,err,error,*999)
      CASE(equations_set_advection_diffusion_equation_type)
        CALL advectiondiffusion_equationssetsetup(equations_set,equations_set_setup,err,error,*999)
      CASE(equations_set_advection_equation_type)
        CALL advection_equationssetsetup(equations_set,equations_set_setup,err,error,*999)
      CASE(equations_set_reaction_diffusion_equation_type)
        CALL reactiondiffusion_equationssetsetup(equations_set,equations_set_setup,err,error,*999)
      CASE(equations_set_biharmonic_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE DEFAULT
        local_error="Equation set type "//trim(number_to_vstring(equations_set%SPECIFICATION(2),"*",err,error))// &
          & " is not valid for a classical field equation set class."
        CALL flagerror(local_error,err,error,*999)
      END SELECT
    ELSE
      CALL flagerror("Equations set is not associated.",err,error,*999)
    ENDIF
       
    exits("CLASSICAL_FIELD_EQUATIONS_SET_SETUP")
    RETURN
999 errorsexits("CLASSICAL_FIELD_EQUATIONS_SET_SETUP",err,error)
    RETURN 1
  END SUBROUTINE classical_field_equations_set_setup
  
  !
  !================================================================================================================================
  !

  SUBROUTINE classicalfield_equationssetsolutionmethodset(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("CLASSICAL_FIELD_EQUATIONS_SOLUTION_METHOD_SET",err,error,*999)

    IF(ASSOCIATED(equations_set)) THEN
      IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
        CALL flagerror("Equations set specification is not allocated.",err,error,*999)
      ELSE IF(SIZE(equations_set%SPECIFICATION,1)<2) THEN
        CALL flagerror("Equations set specification must have at least two entries for a classical field class equations set.", &
          & err,error,*999)
      END IF
      SELECT CASE(equations_set%SPECIFICATION(2))
      CASE(equations_set_laplace_equation_type)
        CALL laplace_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
      CASE(equations_set_hj_equation_type)
        CALL hjequation_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
      CASE(equations_set_poisson_equation_type)
        CALL poisson_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
      CASE(equations_set_helmholtz_equation_type)
        CALL helmholtz_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
      CASE(equations_set_wave_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_diffusion_equation_type)
        CALL diffusion_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
      CASE(equations_set_advection_diffusion_equation_type)
        CALL advectiondiffusion_equationssetsolnmethodset(equations_set,solution_method,err,error,*999)
      CASE(equations_set_advection_equation_type)
        CALL advection_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
      CASE(equations_set_reaction_diffusion_equation_type)
        CALL reactiondiffusion_equationssetsolutionmethodset(equations_set,solution_method,err,error,*999)
      CASE(equations_set_biharmonic_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE DEFAULT
        local_error="Equations set equation type of "//trim(number_to_vstring(equations_set%SPECIFICATION(2),"*",err,error))// &
          & " is not valid for a classical field equations set class."
        CALL flagerror(local_error,err,error,*999)
      END SELECT
    ELSE
      CALL flagerror("Equations set is not associated",err,error,*999)
    ENDIF
       
    exits("ClassicalField_EquationsSetSolutionMethodSet")
    RETURN
999 errors("ClassicalField_EquationsSetSolutionMethodSet",err,error)
    exits("ClassicalField_EquationsSetSolutionMethodSet")
    RETURN 1
    
  END SUBROUTINE classicalfield_equationssetsolutionmethodset

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

  SUBROUTINE classicalfield_boundaryconditionsanalyticcalculate(EQUATIONS_SET,BOUNDARY_CONDITIONS,ERR,ERROR,*)

    !Argument variables
    TYPE(equations_set_type), POINTER :: EQUATIONS_SET
    TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Local Variables
    TYPE(varying_string) :: LOCAL_ERROR

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

    IF(ASSOCIATED(equations_set)) THEN
      IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
        CALL flagerror("Equations set specification is not allocated.",err,error,*999)
      ELSE IF(SIZE(equations_set%SPECIFICATION,1)<2) THEN
        CALL flagerror("Equations set specification must have at least two entries for a classical field class equations set.", &
          & err,error,*999)
      END IF
      SELECT CASE(equations_set%SPECIFICATION(2))
      CASE(equations_set_laplace_equation_type)
        CALL laplace_boundaryconditionsanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
      CASE(equations_set_hj_equation_type)
        CALL hj_boundaryconditionsanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
      CASE(equations_set_poisson_equation_type)
        CALL poisson_boundaryconditionsanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
      CASE(equations_set_helmholtz_equation_type)
        CALL helmholtz_boundaryconditionsanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
      CASE(equations_set_wave_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_diffusion_equation_type)
        CALL diffusion_boundaryconditionanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
      CASE(equations_set_advection_diffusion_equation_type)
        CALL advectiondiffusion_boundaryconditionsanalyticcalculate(equations_set,boundary_conditions,err,error,*999)
      CASE(equations_set_reaction_diffusion_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(equations_set_biharmonic_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE DEFAULT
        local_error="Equations set equation type of "//trim(number_to_vstring(equations_set%SPECIFICATION(2),"*",err,error))// &
          & " is not valid for a classical field equations set class."
        CALL flagerror(local_error,err,error,*999)
      END SELECT
    ELSE
      CALL flagerror("Equations set is not associated",err,error,*999)
    ENDIF

    exits("ClassicalField_BoundaryConditionsAnalyticCalculate")
    RETURN
999 errors("ClassicalField_BoundaryConditionsAnalyticCalculate",err,error)
    exits("ClassicalField_BoundaryConditionsAnalyticCalculate")
    RETURN 1
    
  END SUBROUTINE classicalfield_boundaryconditionsanalyticcalculate

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

  SUBROUTINE classicalfield_problemspecificationset(problem,problemSpecification,err,error,*)

    !Argument variables
    TYPE(problem_type), POINTER :: problem
    INTEGER(INTG), INTENT(IN) :: problemSpecification(:)
    INTEGER(INTG), INTENT(OUT) :: err
    TYPE(varying_string), INTENT(OUT) :: error
    !Local Variables
    TYPE(varying_string) :: localError
    INTEGER(INTG) :: problemType

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

    IF(ASSOCIATED(problem)) THEN
      IF(SIZE(problemspecification,1)>=2) THEN
        problemtype=problemspecification(2)
        SELECT CASE(problemtype)
        CASE(problem_laplace_equation_type)
          CALL laplace_problemspecificationset(problem,problemspecification,err,error,*999)
        CASE(problem_hj_equation_type)
          CALL hjequation_problemspecificationset(problem,problemspecification,err,error,*999)
        CASE(problem_poisson_equation_type)
          CALL poisson_problemspecificationset(problem,problemspecification,err,error,*999)
        CASE(problem_helmholtz_equation_type)
          CALL helmholtz_problemspecificationset(problem,problemspecification,err,error,*999)
        CASE(problem_wave_equation_type)
          CALL flagerror("Not implemented.",err,error,*999)
        CASE(problem_diffusion_equation_type)
          CALL diffusion_problemspecificationset(problem,problemspecification,err,error,*999)
        CASE(problem_advection_equation_type)
          CALL advection_problemspecificationset(problem,problemspecification,err,error,*999)
        CASE(problem_advection_diffusion_equation_type)
          CALL advectiondiffusion_problemspecificationset(problem,problemspecification,err,error,*999)
        CASE(problem_reaction_diffusion_equation_type)
          CALL reactiondiffusion_problemspecificationset(problem,problemspecification,err,error,*999)
        CASE(problem_biharmonic_equation_type)
          CALL flagerror("Not implemented.",err,error,*999)
        CASE DEFAULT
          localerror="The second problem specification of "//trim(numbertovstring(problemtype,"*",err,error))// &
            & " is not valid for a classical field problem."
          CALL flagerror(localerror,err,error,*999)
        END SELECT
      ELSE
        CALL flagerror("Classical field problem specification must have a type set.",err,error,*999)
      END IF
    ELSE
      CALL flagerror("Problem is not associated.",err,error,*999)
    END IF

    exits("ClassicalField_ProblemSpecificationSet")
    RETURN
999 errors("ClassicalField_ProblemSpecificationSet",err,error)
    exits("ClassicalField_ProblemSpecificationSet")
    RETURN 1
    
  END SUBROUTINE classicalfield_problemspecificationset

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

  SUBROUTINE classical_field_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("CLASSICAL_FIELD_PROBLEM_SETUP",err,error,*999)

    IF(ASSOCIATED(problem)) THEN
      IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
        CALL flagerror("Problem specification is not allocated.",err,error,*999)
      ELSE IF(SIZE(problem%SPECIFICATION,1)<2) THEN
        CALL flagerror("Problem specification must have at least two entries for a classical field problem.",err,error,*999)
      END IF
      SELECT CASE(problem%SPECIFICATION(2))
      CASE(problem_laplace_equation_type)
        CALL laplace_equation_problem_setup(problem,problem_setup,err,error,*999)
      CASE(problem_hj_equation_type)
        CALL hj_equation_problem_setup(problem,problem_setup,err,error,*999)
      CASE(problem_poisson_equation_type)
        CALL poisson_equation_problem_setup(problem,problem_setup,err,error,*999)
      CASE(problem_helmholtz_equation_type)
        CALL helmholtz_equation_problem_setup(problem,problem_setup,err,error,*999)
      CASE(problem_wave_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE(problem_diffusion_equation_type)
        CALL diffusion_equation_problem_setup(problem,problem_setup,err,error,*999)
      CASE(problem_advection_equation_type)
        CALL advection_equation_problem_setup(problem,problem_setup,err,error,*999)
      CASE(problem_advection_diffusion_equation_type)
        CALL advection_diffusion_equation_problem_setup(problem,problem_setup,err,error,*999)
      CASE(problem_reaction_diffusion_equation_type)
        CALL reaction_diffusion_equation_problem_setup(problem,problem_setup,err,error,*999)
      CASE(problem_biharmonic_equation_type)
        CALL flagerror("Not implemented.",err,error,*999)
      CASE DEFAULT
        local_error="Problem type "//trim(number_to_vstring(problem%SPECIFICATION(2),"*",err,error))// &
          & " is not valid for a classical field problem class."
        CALL flagerror(local_error,err,error,*999)
      END SELECT
    ELSE
      CALL flagerror("Problem is not associated.",err,error,*999)
    ENDIF
       
    exits("CLASSICAL_FIELD_PROBLEM_SETUP")
    RETURN
999 errorsexits("CLASSICAL_FIELD_PROBLEM_SETUP",err,error)
    RETURN 1
  END SUBROUTINE classical_field_problem_setup

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

  SUBROUTINE classical_field_pre_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)

    !Argument variables
    TYPE(control_loop_type), POINTER :: CONTROL_LOOP
    TYPE(solver_type), POINTER :: SOLVER
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Local Variables
    TYPE(varying_string) :: LOCAL_ERROR
    
    enters("CLASSICAL_FIELD_PRE_SOLVE",err,error,*999)

    IF(ASSOCIATED(control_loop%PROBLEM)) THEN
      IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
        CALL flagerror("Problem specification is not allocated.",err,error,*999)
      ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<2) THEN
        CALL flagerror("Problem specification must have at least two entries for a classical field problem.",err,error,*999)
      END IF
      SELECT CASE(control_loop%PROBLEM%SPECIFICATION(2))
      CASE(problem_laplace_equation_type)
        !CALL LAPLACE_PRE_SOLVE(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
      CASE(problem_hj_equation_type)
        !CALL HJ_PRE_SOLVE(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
      CASE(problem_poisson_equation_type)
        CALL poisson_pre_solve(control_loop,solver,err,error,*999)
      CASE(problem_helmholtz_equation_type)
        !CALL HELMHOLTZ_PRE_SOLVE(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
      CASE(problem_wave_equation_type)
        !CALL WAVE_EQUATION_PRE_SOLVE(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
      CASE(problem_diffusion_equation_type)
        CALL diffusion_equation_pre_solve(control_loop,solver,err,error,*999)
      CASE(problem_advection_equation_type)
        CALL advection_pre_solve(solver,err,error,*999)
      CASE(problem_advection_diffusion_equation_type)
        CALL advection_diffusion_pre_solve(control_loop,solver,err,error,*999)
      CASE(problem_reaction_diffusion_equation_type)
        CALL reaction_diffusion_pre_solve(solver,err,error,*999)
      CASE(problem_biharmonic_equation_type)
        !CALL BIHARMONIC_EQUATION_PRE_SOLVE(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
      CASE DEFAULT
        local_error="Problem type "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(2),"*",err,error))// &
          & " is not valid for a classical field problem class."
        CALL flagerror(local_error,err,error,*999)
      END SELECT
    ELSE
      CALL flagerror("Problem is not associated.",err,error,*999)
    ENDIF
       
    exits("CLASSICAL_FIELD_PRE_SOLVE")
    RETURN
999 errorsexits("CLASSICAL_FIELD_PRE_SOLVE",err,error)
    RETURN 1
  END SUBROUTINE classical_field_pre_solve

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

  SUBROUTINE classical_field_post_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)

    !Argument variables
    TYPE(control_loop_type), POINTER :: CONTROL_LOOP
    TYPE(solver_type), POINTER :: SOLVER
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Local Variables
    TYPE(varying_string) :: LOCAL_ERROR
    
    enters("CLASSICAL_FIELD_POST_SOLVE",err,error,*999)

    IF(ASSOCIATED(control_loop%PROBLEM)) THEN
      IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
        CALL flagerror("Problem specification is not allocated.",err,error,*999)
      ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<2) THEN
        CALL flagerror("Problem specification must have at least two entries for a classical field problem.",err,error,*999)
      END IF
      SELECT CASE(control_loop%PROBLEM%SPECIFICATION(2))
      CASE(problem_laplace_equation_type)
        !CALL LAPLACE_POST_SOLVE(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
      CASE(problem_hj_equation_type)
        !CALL HJ_POST_SOLVE(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
      CASE(problem_poisson_equation_type)
        CALL poisson_post_solve(control_loop,solver,err,error,*999)
      CASE(problem_helmholtz_equation_type)
        !CALL HELMHOLTZ_POST_SOLVE(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
      CASE(problem_wave_equation_type)
        !CALL WAVE_EQUATION_POST_SOLVE(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
      CASE(problem_diffusion_equation_type)
        CALL diffusion_equation_post_solve(control_loop,solver,err,error,*999)
      CASE(problem_advection_equation_type)
        !CALL ADVECTION_POST_SOLVE(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
      CASE(problem_advection_diffusion_equation_type)
        CALL advection_diffusion_post_solve(control_loop,solver,err,error,*999)
      CASE(problem_reaction_diffusion_equation_type)
        CALL reaction_diffusion_post_solve(control_loop,solver,err,error,*999)
      CASE(problem_biharmonic_equation_type)
        !CALL BIHARMONIC_EQUATION_POST_SOLVE(CONTROL_LOOP,SOLVER,ERR,ERROR,*999)
      CASE DEFAULT
        local_error="Problem type "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(2),"*",err,error))// &
          & " is not valid for a classical field problem class."
        CALL flagerror(local_error,err,error,*999)
      END SELECT
    ELSE
      CALL flagerror("Problem is not associated.",err,error,*999)
    ENDIF
       
    exits("CLASSICAL_FIELD_POST_SOLVE")
    RETURN
999 errorsexits("CLASSICAL_FIELD_POST_SOLVE",err,error)
    RETURN 1
  END SUBROUTINE classical_field_post_solve


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

END MODULE classical_field_routines