/src/characteristic_equation_routines.f90
FORTRAN Modern | 1457 lines | 1167 code | 74 blank | 216 comment | 27 complexity | aec5fbbc27d8bbd27383ec53537d0aec MD5 | raw file
Large files files are truncated, but you can click here to view the full file
- !> \file
- !> \author David Ladd
- !> \brief This module handles the characteristic equation routines. These
- !> equations are often used in concert with 1D fluid modelling to describe
- !> wave propagation phenomena, which is particularly useful for models of
- !> vascular trees. These equations are also often solved using a discontinuous
- !> nodal solution method, rather than FEM.
- !>
- !> \section LICENSE
- !>
- !> Version: MPL 1.1/GPL 2.0/LGPL 2.1
- !>
- !> The contents of this file are subject to the Mozilla Public License
- !> Version 1.1 (the "License"); you may not use this file except in
- !> compliance with the License. You may obtain a copy of the License at
- !> http://www.mozilla.org/MPL/
- !>
- !> Software distributed under the License is distributed on an "AS IS"
- !> basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
- !> License for the specific language governing rights and limitations
- !> under the License.
- !>
- !> The Original Code is OpenCMISS
- !>
- !> The Initial Developer of the Original Code is University of Auckland,
- !> Auckland, New Zealand, the University of Oxford, Oxford, United
- !> Kingdom and King's College, London, United Kingdom. Portions created
- !> by the University of Auckland, the University of Oxford and King's
- !> College, London are Copyright (C) 2007-2010 by the University of
- !> Auckland, the University of Oxford and King's College, London.
- !> All Rights Reserved.
- !>
- !> Contributor(s): Soroush Safaei
- !>
- !> Alternatively, the contents of this file may be used under the terms of
- !> either the GNU General Public License Version 2 or later (the "GPL"), or
- !> the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
- !> in which case the provisions of the GPL or the LGPL are applicable instead
- !> of those above. If you wish to allow use of your version of this file only
- !> under the terms of either the GPL or the LGPL, and not to allow others to
- !> use your version of this file under the terms of the MPL, indicate your
- !> decision by deleting the provisions above and replace them with the notice
- !> and other provisions required by the GPL or the LGPL. If you do not delete
- !> the provisions above, a recipient may use your version of this file under
- !> the terms of any one of the MPL, the GPL or the LGPL.
- !>
- !>This module handles all characteristic equation routines.
- MODULE CHARACTERISTIC_EQUATION_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 FIELD_IO_ROUTINES
- USE FLUID_MECHANICS_IO_ROUTINES
- USE INPUT_OUTPUT
- USE ISO_VARYING_STRING
- USE KINDS
- USE MATHS
- USE MATRIX_VECTOR
- USE MESH_ROUTINES
- USE NODE_ROUTINES
- USE PROBLEM_CONSTANTS
- USE STRINGS
- USE SOLVER_ROUTINES
- USE TIMER
- USE TYPES
- IMPLICIT NONE
- PRIVATE
- PUBLIC Characteristic_EquationsSet_SubtypeSet
- PUBLIC Characteristic_EquationsSet_SolutionMethodSet
- PUBLIC Characteristic_EquationsSet_Setup
- PUBLIC Characteristic_NodalJacobianEvaluate
- PUBLIC Characteristic_NodalResidualEvaluate
- CONTAINS
- !
- !================================================================================================================================
- !
- !>Sets/changes the solution method for a Characteristic equation type of an fluid mechanics equations set class.
- SUBROUTINE Characteristic_EquationsSet_SolutionMethodSet(equationsSet,solutionMethod,err,error,*)
- !Argument variables
- TYPE(EQUATIONS_SET_TYPE), POINTER :: equationsSet !<A pointer to the equations set to set the solution method for
- INTEGER(INTG), INTENT(IN) :: solutionMethod !<The solution method to set
- INTEGER(INTG), INTENT(OUT) :: err !<The error code
- TYPE(VARYING_STRING), INTENT(OUT) :: error !<The error string
- !Local Variables
- TYPE(VARYING_STRING) :: localError
-
- CALL ENTERS("Characteristic_EquationsSet_SolutionMethodSet",err,error,*999)
-
- IF(ASSOCIATED(equationsSet)) THEN
- SELECT CASE(equationsSet%SUBTYPE)
- CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
- SELECT CASE(solutionMethod)
- CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD)
- CALL FLAG_ERROR("Not implemented.",err,error,*999)
- CASE(EQUATIONS_SET_NODAL_SOLUTION_METHOD)
- equationsSet%SOLUTION_METHOD=EQUATIONS_SET_NODAL_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
- localError="The specified solution method of "//TRIM(NUMBER_TO_VSTRING(solutionMethod,"*",err,error))// &
- & " is invalid."
- CALL FLAG_ERROR(localError,err,error,*999)
- END SELECT
- CASE DEFAULT
- localError="Equations set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
- & " is not valid for a Characteristic equation type of a fluid mechanics equations set class."
- CALL FLAG_ERROR(localError,err,error,*999)
- END SELECT
- ELSE
- CALL FLAG_ERROR("Equations set is not associated.",err,error,*999)
- ENDIF
-
- CALL EXITS("Characteristic_EquationsSet_SolutionMethodSet")
- RETURN
- 999 CALL ERRORS("Characteristic_EquationsSet_SolutionMethodSet",err,error)
- CALL EXITS("Characteristic_EquationsSet_SolutionMethodSet")
- RETURN 1
- END SUBROUTINE Characteristic_EquationsSet_SolutionMethodSet
- !
- !================================================================================================================================
- !
- !>Sets/changes the equation subtype for a Characteristic type of a fluid mechanics equations set class.
- SUBROUTINE Characteristic_EquationsSet_SubtypeSet(equationsSet,equationsSetSubtype,err,error,*)
- !Argument variables
- TYPE(EQUATIONS_SET_TYPE), POINTER :: equationsSet !<A pointer to the equations set to set the equation subtype for
- INTEGER(INTG), INTENT(IN) :: equationsSetSubtype !<The equation subtype to set
- INTEGER(INTG), INTENT(OUT) :: err !<The error code
- TYPE(VARYING_STRING), INTENT(OUT) :: error !<The error string
- !Local Variables
- TYPE(VARYING_STRING) :: localError
- CALL ENTERS("Characteristic_EquationsSet_SubtypeSet",err,error,*999)
- IF(ASSOCIATED(equationsSet)) THEN
- SELECT CASE(equationsSetSubtype)
- CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE)
- equationsSet%CLASS=EQUATIONS_SET_FLUID_MECHANICS_CLASS
- equationsSet%TYPE=EQUATIONS_SET_CHARACTERISTIC_EQUATION_TYPE
- equationsSet%SUBTYPE=EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE
- CASE(EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
- equationsSet%CLASS=EQUATIONS_SET_FLUID_MECHANICS_CLASS
- equationsSet%TYPE=EQUATIONS_SET_CHARACTERISTIC_EQUATION_TYPE
- equationsSet%SUBTYPE=EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE
- CASE DEFAULT
- localError="Equations set subtype "//TRIM(NUMBER_TO_VSTRING(equationsSetSubtype,"*",err,error))// &
- & " is not valid for a Characteristic fluid type of a fluid mechanics equations set class."
- CALL FLAG_ERROR(localError,err,error,*999)
- END SELECT
- ELSE
- CALL FLAG_ERROR("Equations set is not associated.",err,error,*999)
- ENDIF
- CALL EXITS("Characteristic_EquationsSet_SubtypeSet")
- RETURN
- 999 CALL ERRORS("Characteristic_EquationsSet_SubtypeSet",err,error)
- CALL EXITS("Characteristic_EquationsSet_SubtypeSet")
- RETURN 1
- END SUBROUTINE Characteristic_EquationsSet_SubtypeSet
- !
- !================================================================================================================================
- !
- !>Sets up the Characteristic equations fluid setup.
- SUBROUTINE Characteristic_EquationsSet_Setup(equationsSet,equationsSetSetup,err,error,*)
- !Argument variables
- TYPE(EQUATIONS_SET_TYPE), POINTER :: equationsSet !<A pointer to the equations set to setup
- TYPE(EQUATIONS_SET_SETUP_TYPE), INTENT(INOUT) :: equationsSetSetup !<The equations set setup information
- INTEGER(INTG), INTENT(OUT) :: err !<The error code
- TYPE(VARYING_STRING), INTENT(OUT) :: error !<The error string
- !Local Variables
- TYPE(EQUATIONS_TYPE), POINTER :: equations
- TYPE(EQUATIONS_MAPPING_TYPE), POINTER :: equationsMapping
- TYPE(EQUATIONS_MATRICES_TYPE), POINTER :: equationsMatrices
- TYPE(EQUATIONS_SET_MATERIALS_TYPE), POINTER :: equationsMaterials
- TYPE(DECOMPOSITION_TYPE), POINTER :: geometricDecomposition
- INTEGER(INTG) :: numberOfDimensions,componentIdx
- INTEGER(INTG) :: geometricScalingType,geometricMeshComponent,geometricComponentNumber
- INTEGER(INTG) :: dependentFieldNumberOfVariables,dependentFieldNumberOfComponents,numberComponentsU2
- INTEGER(INTG) :: independentFieldNumberOfComponents,independentFieldNumberOfVariables,numberComponentsV,numberComponentsU1
- INTEGER(INTG) :: materialsFieldNumberOfVariables,materialsField1DNumberOfComponents,materialsFieldCoupledNumberOfComponents
- TYPE(VARYING_STRING) :: localError
- CALL ENTERS("Characteristic_EquationsSet_Setup",err,error,*999)
- NULLIFY(equations)
- NULLIFY(equationsMapping)
- NULLIFY(equationsMatrices)
- NULLIFY(equationsMaterials)
- NULLIFY(geometricDecomposition)
- IF(ASSOCIATED(equationsSet)) THEN
- SELECT CASE(equationsSet%SUBTYPE)
- CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
- SELECT CASE(equationsSetSetup%SETUP_TYPE)
- !-----------------------------------------------------------------
- ! I n i t i a l s e t u p
- !-----------------------------------------------------------------
- CASE(EQUATIONS_SET_SETUP_INITIAL_TYPE)
- SELECT CASE(equationsSet%SUBTYPE)
- CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
- SELECT CASE(equationsSetSetup%ACTION_TYPE)
- CASE(EQUATIONS_SET_SETUP_START_ACTION)
- CALL Characteristic_EquationsSet_SolutionMethodSet(equationsSet, &
- & EQUATIONS_SET_NODAL_SOLUTION_METHOD,err,error,*999)
- equationsSet%SOLUTION_METHOD=EQUATIONS_SET_NODAL_SOLUTION_METHOD
- CASE(EQUATIONS_SET_SETUP_FINISH_ACTION)
- !Do nothing
- CASE DEFAULT
- localError="The action type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup%ACTION_TYPE, &
- & "*",err,error))// " for a setup type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup% &
- & SETUP_TYPE,"*",err,error))// " is not implemented for a characteristic equations set."
- CALL FLAG_ERROR(localError,err,error,*999)
- END SELECT
- CASE DEFAULT
- localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
- & " for a setup sub type of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
- & " is invalid for a characteristic equations set."
- CALL FLAG_ERROR(localError,err,error,*999)
- END SELECT
- !-----------------------------------------------------------------
- ! G e o m e t r i c f i e l d
- !-----------------------------------------------------------------
- CASE(EQUATIONS_SET_SETUP_GEOMETRY_TYPE)
- SELECT CASE(equationsSet%SUBTYPE)
- CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
- !Do nothing???
- CASE DEFAULT
- localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
- & " is invalid for a characteristic equations set."
- CALL FLAG_ERROR(localError,err,error,*999)
- END SELECT
- !-----------------------------------------------------------------
- ! D e p e n d e n t f i e l d
- !-----------------------------------------------------------------
- CASE(EQUATIONS_SET_SETUP_DEPENDENT_TYPE)
- SELECT CASE(equationsSet%SUBTYPE)
- CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
- SELECT CASE(equationsSetSetup%ACTION_TYPE)
- !Set start action
- CASE(EQUATIONS_SET_SETUP_START_ACTION)
- IF(equationsSet%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
- !Create the auto created dependent field
- !start field creation with name 'DEPENDENT_FIELD'
- CALL FIELD_CREATE_START(equationsSetSetup%FIELD_USER_NUMBER,equationsSet%REGION, &
- & equationsSet%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
- !start creation of a new field
- CALL FIELD_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_GENERAL_TYPE,err,error,*999)
- !label the field
- CALL FIELD_LABEL_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
- !define new created field to be dependent
- CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
- & FIELD_DEPENDENT_TYPE,err,error,*999)
- !look for decomposition rule already defined
- CALL FIELD_MESH_DECOMPOSITION_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,geometricDecomposition, &
- & err,error,*999)
- !apply decomposition rule found on new created field
- CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
- & geometricDecomposition,err,error,*999)
- !point new field to geometric field
- CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,equationsSet%GEOMETRY% &
- & GEOMETRIC_FIELD,err,error,*999)
- !set number of variables to 5 (U,DELUDELN,V,U1,U2)=>(Q,A;dQ,dA;W(1,2);pCellML,Pressure)
- dependentFieldNumberOfVariables=5
- CALL FIELD_NUMBER_OF_VARIABLES_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
- & dependentFieldNumberOfVariables,err,error,*999)
- CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,[FIELD_U_VARIABLE_TYPE, &
- & FIELD_DELUDELN_VARIABLE_TYPE,FIELD_V_VARIABLE_TYPE,FIELD_U1_VARIABLE_TYPE,FIELD_U2_VARIABLE_TYPE], &
- & err,error,*999)
- ! set dimension
- CALL FIELD_DIMENSION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
- & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
- CALL FIELD_DIMENSION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE, &
- & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
- CALL FIELD_DIMENSION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_V_VARIABLE_TYPE, &
- & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
- CALL FIELD_DIMENSION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_U1_VARIABLE_TYPE, &
- & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
- CALL FIELD_DIMENSION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_U2_VARIABLE_TYPE, &
- & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
- ! set data type
- CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
- & FIELD_DP_TYPE,err,error,*999)
- CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE, &
- & FIELD_DP_TYPE,err,error,*999)
- CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_V_VARIABLE_TYPE, &
- & FIELD_DP_TYPE,err,error,*999)
- CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_U1_VARIABLE_TYPE, &
- & FIELD_DP_TYPE,err,error,*999)
- CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_U2_VARIABLE_TYPE, &
- & FIELD_DP_TYPE,err,error,*999)
- ! number of components for U,DELUDELN=2 (Q,A)
- dependentFieldNumberOfComponents=2
- CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
- & FIELD_U_VARIABLE_TYPE,dependentFieldNumberOfComponents,err,error,*999)
- CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
- & FIELD_DELUDELN_VARIABLE_TYPE,dependentFieldNumberOfComponents,err,error,*999)
- ! IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
- numberComponentsV=2
- numberComponentsU1=1
- numberComponentsU2=1
- ! ENDIF
- ! set number of components for V
- CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
- & FIELD_V_VARIABLE_TYPE,numberComponentsV,err,error,*999)
- CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
- & FIELD_U1_VARIABLE_TYPE,numberComponentsU1,err,error,*999)
- CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
- & FIELD_U2_VARIABLE_TYPE,numberComponentsU2,err,error,*999)
- CALL FIELD_COMPONENT_MESH_COMPONENT_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
- & 1,geometricMeshComponent,err,error,*999)
- !Default to the geometric interpolation setup for U,dUdN
- DO componentIdx=1,dependentFieldNumberOfComponents
- CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
- & FIELD_U_VARIABLE_TYPE,componentIdx,geometricMeshComponent,err,error,*999)
- CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
- & FIELD_DELUDELN_VARIABLE_TYPE,componentIdx,geometricMeshComponent,err,error,*999)
- END DO
- !Default to the geometric interpolation setup for V
- CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
- & FIELD_V_VARIABLE_TYPE,1,geometricMeshComponent,err,error,*999)
- CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
- & FIELD_U1_VARIABLE_TYPE,1,geometricMeshComponent,err,error,*999)
- CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
- & FIELD_U2_VARIABLE_TYPE,1,geometricMeshComponent,err,error,*999)
- SELECT CASE(equationsSet%SOLUTION_METHOD)
- !Specify nodal solution method
- CASE(EQUATIONS_SET_NODAL_SOLUTION_METHOD)
- ! (U, dUdN); 2 components (Q,A)
- DO componentIdx=1,dependentFieldNumberOfComponents
- CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
- & FIELD_U_VARIABLE_TYPE,componentIdx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
- CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
- & FIELD_DELUDELN_VARIABLE_TYPE,componentIdx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
- END DO
- ! V; 2 components (W1,W2 )
- DO componentIdx=1,numberComponentsV
- CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
- & FIELD_V_VARIABLE_TYPE,componentIdx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
- ENDDO
- DO componentIdx=1,numberComponentsU1
- CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
- & FIELD_U1_VARIABLE_TYPE,componentIdx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
- ENDDO
- DO componentIdx=1,numberComponentsU2
- CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
- & FIELD_U2_VARIABLE_TYPE,componentIdx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
- ENDDO
- CALL FIELD_SCALING_TYPE_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,geometricScalingType, &
- & err,error,*999)
- CALL FIELD_SCALING_TYPE_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD,geometricScalingType, &
- & err,error,*999)
- CASE DEFAULT
- localError="The solution method of " &
- & //TRIM(NUMBER_TO_VSTRING(equationsSet%SOLUTION_METHOD,"*",err,error))// " is invalid."
- CALL FLAG_ERROR(localError,err,error,*999)
- END SELECT
- ELSE
- !Check the user specified field
- CALL FIELD_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_GENERAL_TYPE,err,error,*999)
- CALL FIELD_DEPENDENT_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_DEPENDENT_TYPE,err,error,*999)
- dependentFieldNumberOfVariables=4 ! U,dUdN,V,U2
- CALL FIELD_NUMBER_OF_VARIABLES_CHECK(equationsSetSetup%FIELD,dependentFieldNumberOfVariables,err,error,*999)
- CALL FIELD_VARIABLE_TYPES_CHECK(equationsSetSetup%FIELD,[FIELD_U_VARIABLE_TYPE, &
- & FIELD_DELUDELN_VARIABLE_TYPE,FIELD_V_VARIABLE_TYPE,FIELD_U2_VARIABLE_TYPE],err,error,*999)
- CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE, &
- & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
- CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_DELUDELN_VARIABLE_TYPE, &
- & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
- CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE, &
- & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
- CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_U2_VARIABLE_TYPE, &
- & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
- CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999)
- CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,FIELD_DP_TYPE, &
- & err,error,*999)
- CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999)
- CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_U2_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999)
- CALL FIELD_NUMBER_OF_COMPONENTS_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
- & numberOfDimensions,err,error,*999)
- !calculate number of components (Q,A) for U and dUdN
- dependentFieldNumberOfComponents=2
- CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE, &
- & dependentFieldNumberOfComponents,err,error,*999)
- CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_DELUDELN_VARIABLE_TYPE, &
- & dependentFieldNumberOfComponents,err,error,*999)
- IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
- numberComponentsV=3
- numberComponentsU2=1
- ELSE
- numberComponentsV=2
- numberComponentsU2=1
- ENDIF
- CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE, &
- & numberComponentsV,err,error,*999)
- CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE, &
- & numberComponentsU2,err,error,*999)
- SELECT CASE(equationsSet%SOLUTION_METHOD)
- CASE(EQUATIONS_SET_NODAL_SOLUTION_METHOD)
- CALL FIELD_COMPONENT_INTERPOLATION_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE,1, &
- & FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
- CALL FIELD_COMPONENT_INTERPOLATION_CHECK(equationsSetSetup%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,1, &
- & FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
- CALL FIELD_COMPONENT_INTERPOLATION_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE,1, &
- & FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
- CALL FIELD_COMPONENT_INTERPOLATION_CHECK(equationsSetSetup%FIELD,FIELD_U2_VARIABLE_TYPE,1, &
- & FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
- CASE DEFAULT
- localError="The solution method of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SOLUTION_METHOD, &
- & "*",err,error))//" is invalid."
- CALL FLAG_ERROR(localError,err,error,*999)
- END SELECT
- ENDIF
- !Specify finish action
- CASE(EQUATIONS_SET_SETUP_FINISH_ACTION)
- IF(equationsSet%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
- CALL FIELD_CREATE_FINISH(equationsSet%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
- ENDIF
- CASE DEFAULT
- localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
- & " for a setup sub type of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
- & " is invalid for a characteristic equations set."
- CALL FLAG_ERROR(localError,err,error,*999)
- END SELECT
- CASE DEFAULT
- localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
- & " for a setup sub type of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
- & " is invalid for a characteristic equations set."
- CALL FLAG_ERROR(localError,err,error,*999)
- END SELECT
- !-----------------------------------------------------------------
- ! I n d e p e n d e n t f i e l d
- !-----------------------------------------------------------------
- CASE(EQUATIONS_SET_SETUP_INDEPENDENT_TYPE)
- SELECT CASE(equationsSet%SUBTYPE)
- CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
- SELECT CASE(equationsSetSetup%ACTION_TYPE)
- !Set start action
- CASE(EQUATIONS_SET_SETUP_START_ACTION)
- independentFieldNumberOfComponents=2 ! normalDirection for wave relative to node for W1,W2
- IF(equationsSet%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
- !Create the auto created independent field
- !start field creation with name 'INDEPENDENT_FIELD'
- CALL FIELD_CREATE_START(equationsSetSetup%FIELD_USER_NUMBER,equationsSet%REGION, &
- & equationsSet%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
- !start creation of a new field
- CALL FIELD_TYPE_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,FIELD_GENERAL_TYPE,err,error,*999)
- !label the field
- CALL FIELD_LABEL_SET(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,"Independent Field",err,error, &
- & *999)
- !define new created field to be independent
- CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, &
- & FIELD_INDEPENDENT_TYPE,err,error,*999)
- !look for decomposition rule already defined
- CALL FIELD_MESH_DECOMPOSITION_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,geometricDecomposition, &
- & err,error,*999)
- !apply decomposition rule found on new created field
- CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, &
- & geometricDecomposition,err,error,*999)
- !point new field to geometric field
- CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,equationsSet% &
- & GEOMETRY%GEOMETRIC_FIELD,err,error,*999)
- !set number of variables to 1 (1 for U)
- independentFieldNumberOfVariables=1
- CALL FIELD_NUMBER_OF_VARIABLES_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, &
- & independentFieldNumberOfVariables,err,error,*999)
- CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, &
- & [FIELD_U_VARIABLE_TYPE],err,error,*999)
- CALL FIELD_DIMENSION_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
- & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
- ! characteristic normal direction (normalWave) is +/- 1
- CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
- & FIELD_DP_TYPE,err,error,*999)
- CALL FIELD_NUMBER_OF_COMPONENTS_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
- & numberOfDimensions,err,error,*999)
- !calculate number of components with one component for each dimension
- CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, &
- & FIELD_U_VARIABLE_TYPE,independentFieldNumberOfComponents,err,error,*999)
- CALL FIELD_COMPONENT_MESH_COMPONENT_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
- & 1,geometricMeshComponent,err,error,*999)
- !Default to the geometric interpolation setup
- DO componentIdx=1,independentFieldNumberOfComponents
- CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, &
- & FIELD_U_VARIABLE_TYPE,componentIdx,geometricMeshComponent,err,error,*999)
- END DO
- SELECT CASE(equationsSet%SOLUTION_METHOD)
- CASE(EQUATIONS_SET_NODAL_SOLUTION_METHOD)
- DO componentIdx=1,independentFieldNumberOfComponents
- CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, &
- & FIELD_U_VARIABLE_TYPE,componentIdx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
- END DO !componentIdx
- CALL FIELD_SCALING_TYPE_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,geometricScalingType, &
- & err,error,*999)
- CALL FIELD_SCALING_TYPE_SET(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,geometricScalingType, &
- & err,error,*999)
- CASE DEFAULT
- localError="The solution method of " &
- & //TRIM(NUMBER_TO_VSTRING(equationsSet%SOLUTION_METHOD,"*",err,error))// " is invalid."
- CALL FLAG_ERROR(localError,err,error,*999)
- END SELECT
- ELSE
- !Check the user specified field
- CALL FIELD_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_GENERAL_TYPE,err,error,*999)
- CALL FIELD_DEPENDENT_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999)
- CALL FIELD_NUMBER_OF_VARIABLES_CHECK(equationsSetSetup%FIELD,1,err,error,*999)
- CALL FIELD_VARIABLE_TYPES_CHECK(equationsSetSetup%FIELD,[FIELD_U_VARIABLE_TYPE],err,error,*999)
- CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, &
- & err,error,*999)
- CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999)
- CALL FIELD_NUMBER_OF_COMPONENTS_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
- & numberOfDimensions,err,error,*999)
- CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE, &
- & independentFieldNumberOfComponents,err,error,*999)
- ENDIF
- !Specify finish action
- CASE(EQUATIONS_SET_SETUP_FINISH_ACTION)
- IF(equationsSet%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
- CALL FIELD_CREATE_FINISH(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
- CALL FIELD_PARAMETER_SET_CREATE(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
- & FIELD_MESH_DISPLACEMENT_SET_TYPE,err,error,*999)
- CALL FIELD_PARAMETER_SET_CREATE(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
- & FIELD_MESH_VELOCITY_SET_TYPE,err,error,*999)
- CALL FIELD_PARAMETER_SET_CREATE(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
- & FIELD_BOUNDARY_SET_TYPE,err,error,*999)
- ENDIF
- CASE DEFAULT
- localError="The action type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup%ACTION_TYPE,"*",err,error))// &
- & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup%SETUP_TYPE,"*",err,error))// &
- & " is invalid for a standard characteristic equations set"
- CALL FLAG_ERROR(localError,err,error,*999)
- END SELECT
- CASE DEFAULT
- localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
- & " for a setup sub type of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
- & " is invalid for a standard characteristic equations set."
- CALL FLAG_ERROR(localError,err,error,*999)
- END SELECT
- !-----------------------------------------------------------------
- ! M a t e r i a l s f i e l d
- !-----------------------------------------------------------------
- CASE(EQUATIONS_SET_SETUP_MATERIALS_TYPE)
- SELECT CASE(equationsSet%SUBTYPE)
- CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
- IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
- materialsFieldNumberOfVariables=2 ! 1 U-type container variable w/ 10 components, 1 V-type w/ 2 components
- materialsField1DNumberOfComponents=10
- materialsFieldCoupledNumberOfComponents=2
- ELSE
- materialsFieldNumberOfVariables=1 ! 1 U-type container variable w/ 10 components
- materialsField1DNumberOfComponents=10
- materialsFieldCoupledNumberOfComponents=0
- ENDIF
- SELECT CASE(equationsSetSetup%ACTION_TYPE)
- !Specify start action
- CASE(EQUATIONS_SET_SETUP_START_ACTION)
- equationsMaterials=>equationsSet%MATERIALS
- IF(ASSOCIATED(equationsMaterials)) THEN
- IF(equationsMaterials%MATERIALS_FIELD_AUTO_CREATED) THEN
- !Create the auto created materials field
- !start field creation with name 'MATERIAL_FIELD'
- CALL FIELD_CREATE_START(equationsSetSetup%FIELD_USER_NUMBER,equationsSet%REGION, &
- & equationsSet%MATERIALS%MATERIALS_FIELD,err,error,*999)
- CALL FIELD_TYPE_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD,FIELD_MATERIAL_TYPE,err,error,*999)
- !label the field
- CALL FIELD_LABEL_SET(equationsMaterials%MATERIALS_FIELD,"Materials Field",err,error,*999)
- CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD,FIELD_INDEPENDENT_TYPE, &
- & err,error,*999)
- CALL FIELD_MESH_DECOMPOSITION_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,geometricDecomposition, &
- & err,error,*999)
- !apply decomposition rule found on new created field
- CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(equationsSet%MATERIALS%MATERIALS_FIELD, &
- & geometricDecomposition,err,error,*999)
- !point new field to geometric field
- CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD,equationsSet%GEOMETRY% &
- & GEOMETRIC_FIELD,err,error,*999)
- CALL FIELD_NUMBER_OF_VARIABLES_SET(equationsMaterials%MATERIALS_FIELD, &
- & materialsFieldNumberOfVariables,err,error,*999)
- CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD, &
- & [FIELD_U_VARIABLE_TYPE],err,error,*999)
- CALL FIELD_DIMENSION_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, &
- & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
- CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, &
- & FIELD_DP_TYPE,err,error,*999)
- CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD, &
- & FIELD_U_VARIABLE_TYPE,materialsField1DNumberOfComponents,err,error,*999)
- CALL FIELD_COMPONENT_MESH_COMPONENT_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD, &
- & FIELD_U_VARIABLE_TYPE,1,geometricComponentNumber,err,error,*999)
- CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsMaterials%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, &
- & 1,geometricComponentNumber,err,error,*999)
- DO componentIdx=1,7 !(MU,RHO,K,As,Re,Fr,St)
- CALL FIELD_COMPONENT_INTERPOLATION_SET(equationsMaterials%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, &
- & componentIdx,FIELD_CONSTANT_INTERPOLATION,ERR,ERROR,*999)
- ENDDO
- DO componentIdx=8,10 !(A0,E,H0)
- CALL FIELD_COMPONENT_INTERPOLATION_SET(equationsMaterials%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, &
- & componentIdx,FIELD_NODE_BASED_INTERPOLATION,ERR,ERROR,*999)
- ENDDO
- !Default the field scaling to that of the geometric field
- CALL FIELD_SCALING_TYPE_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,geometricScalingType, &
- & err,error,*999)
- CALL FIELD_SCALING_TYPE_SET(equationsMaterials%MATERIALS_FIELD,geometricScalingType,err,error,*999)
- ELSE
- !Check the user specified field
- CALL FIELD_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_MATERIAL_TYPE,err,error,*999)
- CALL FIELD_DEPENDENT_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999)
- CALL FIELD_NUMBER_OF_VARIABLES_CHECK(equationsSetSetup%FIELD,materialsFieldNumberOfVariables,err,error,*999)
- IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
- CALL FIELD_VARIABLE_TYPES_CHECK(equationsSetSetup%FIELD,[FIELD_U_VARIABLE_TYPE,FIELD_V_VARIABLE_TYPE], &
- & err,error,*999)
- ELSE
- CALL FIELD_VARIABLE_TYPES_CHECK(equationsSetSetup%FIELD,[FIELD_U_VARIABLE_TYPE],err,error,*999)
- ENDIF
- ! U-variable
- CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE, &
- & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
- CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE, &
- & err,error,*999)
- CALL FIELD_NUMBER_OF_COMPONENTS_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
- & numberOfDimensions,err,error,*999)
- CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE, &
- & materialsField1DNumberOfComponents,err,error,*999)
- IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
- ! V-variable
- CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE, &
- & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
- CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE,FIELD_DP_TYPE, &
- & err,error,*999)
- CALL FIELD_NUMBER_OF_COMPONENTS_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
- & numberOfDimensions,err,error,*999)
- CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE, &
- & materialsFieldCoupledNumberOfComponents,err,error,*999)
- ENDIF
- ENDIF
- ELSE
- CALL FLAG_ERROR("Equations set materials is not associated.",err,error,*999)
- END IF
- !Specify start action
- CASE(EQUATIONS_SET_SETUP_FINISH_ACTION)
- equationsMaterials=>equationsSet%MATERIALS
- IF(ASSOCIATED(equationsMaterials)) THEN
- IF(equationsMaterials%MATERIALS_FIELD_AUTO_CREATED) THEN
- !Finish creating the materials field
- CALL FIELD_CREATE_FINISH(equationsMaterials%MATERIALS_FIELD,err,error,*999)
- ! Should be initialized from example file
- ENDIF
- ELSE
- CALL FLAG_ERROR("Equations set materials is not associated.",err,error,*999)
- ENDIF
- CASE DEFAULT
- localError="The action type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup%ACTION_TYPE,"*", &
- & err,error))//" for a setup type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup%SETUP_TYPE,"*", &
- & err,error))//" is invalid for characteristic equation."
- CALL FLAG_ERROR(localError,err,error,*999)
- END SELECT
- CASE DEFAULT
- localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
- & " for a setup sub type of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
- & " is invalid for a characteristic equation."
- CALL FLAG_ERROR(localError,err,error,*999)
- END SELECT
- !-----------------------------------------------------------------
- ! E q u a t i o n s t y p e
- !-----------------------------------------------------------------
- CASE(EQUATIONS_SET_SETUP_EQUATIONS_TYPE)
- SELECT CASE(equationsSet%SUBTYPE)
- CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
- SELECT CASE(equationsSetSetup%ACTION_TYPE)
- CASE(EQUATIONS_SET_SETUP_START_ACTION)
- equationsMaterials=>equationsSet%MATERIALS
- IF(ASSOCIATED(equationsMaterials)) THEN
- IF(equationsMaterials%MATERIALS_FINISHED) THEN
- CALL EQUATIONS_CREATE_START(equationsSet,equations,err,error,*999)
- CALL EQUATIONS_LINEARITY_TYPE_SET(equations,EQUATIONS_NONLINEAR,err,error,*999)
- CALL EQUATIONS_TIME_DEPENDENCE_TYPE_SET(equations,EQUATIONS_STATIC,err,error,*999)
- ELSE
- CALL FLAG_ERROR("Equations set materials has not been finished.",err,error,*999)
- ENDIF
- ELSE
- CALL FLAG_ERROR("Equations materials is not associated.",err,error,*999)
- ENDIF
- CASE(EQUATIONS_SET_SETUP_FINISH_ACTION)
- SELECT CASE(equationsSet%SOLUTION_METHOD)
- CASE(EQUATIONS_SET_NODAL_SOLUTION_METHOD)
- !Finish the creation of the equations
- CALL EQUATIONS_SET_EQUATIONS_GET(equationsSet,equations,err,error,*999)
- CALL EQUATIONS_CREATE_FINISH(equations,err,error,*999)
- !Create the equations mapping.
- CALL EQUATIONS_MAPPING_CREATE_START(equations,equationsMapping,err,error,*999)
- IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
- CALL EQUATIONS_MAPPING_LINEAR_MATRICES_NUMBER_SET(equationsMapping,1,err,error,*999)
- CALL EQUATIONS_MAPPING_LINEAR_MATRICES_VARIABLE_TYPES_SET(equationsMapping,[FIELD_U_VARIABLE_TYPE],err,error,*999)
- CALL EQUATIONS_MAPPING_RHS_VARIABLE_TYPE_SET(equationsMapping,FIELD_DELUDELN_VARIABLE_TYPE, &
- & err,error,*999)
- ELSE
- CALL EQUATIONS_MAPPING_LINEAR_MATRICES_NUMBER_SET(equationsMapping,1,err,error,*999)
- CALL EQUATIONS_MAPPING_LINEAR_MATRICES_VARIABLE_TYPES_SET(equationsMapping,[FIELD_U_VARIABLE_TYPE],err,error,*999)
- CALL EQUATIONS_MAPPING_RHS_VARIABLE_TYPE_SET(equationsMapping,FIELD_DELUDELN_VARIABLE_TYPE, &
- & err,error,*999)
- ENDIF
- CALL EQUATIONS_MAPPING_CREATE_FINISH(equationsMapping,err,error,*999)
- !Create the equations matrices
- CALL EQUATIONS_MATRICES_CREATE_START(equations,equationsMatrices,err,error,*999)
- ! Use the analytic Jacobian calculation
- CALL EquationsMatrices_JacobianTypesSet(equationsMatrices,[EQUATIONS_JACOBIAN_ANALYTIC_CALCULATED], &
- & err,error,*999)
- SELECT CASE(equations%SPARSITY_TYPE)
- CASE(EQUATIONS_MATRICES_FULL_MATRICES)
- CALL EQUATIONS_MATRICES_LINEAR_STORAGE_TYPE_SET(equationsMatrices,[MATRIX_BLOCK_STORAGE_TYPE], &
- & err,error,*999)
- CALL EQUATIONS_MATRICES_NONLINEAR_STORAGE_TYPE_SET(equationsMatrices,MATRIX_BLOCK_STORAGE_TYPE, &
- & err,error,*999)
- CASE(EQUATIONS_MATRICES_SPARSE_MATRICES)
- IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
- CALL EQUATIONS_MATRICES_LINEAR_STORAGE_TYPE_SET(equationsMatrices, &
- & [MATRIX_COMPRESSED_ROW_STORAGE_TYPE],err,error,*999)
- CALL EQUATIONS_MATRICES_LINEAR_STRUCTURE_TYPE_SET(equationsMatrices, &
- & [EquationsMatrix_NodalStructure],err,error,*999)
- CALL EQUATIONS_MATRICES_NONLINEAR_STORAGE_TYPE_SET(equationsMatrices, &
- & MATRIX_COMPRESSED_ROW_STORAGE_TYPE,err,error,*999)
- ! CALL EQUATIONS_MATRICES_NONLINEAR_STRUCTURE_TYPE_SET(equationsMatrices, &
- ! & EquationsMatrix_NodalStructure,err,error,*999)
- ELSE
- CALL EQUATIONS_MATRICES_LINEAR_STORAGE_TYPE_SET(equationsMatrices, &
- & [MATRIX_COMPRESSED_ROW_STORAGE_TYPE],err,error,*999)
- CALL EQUATIONS_MATRICES_NONLINEAR_STORAGE_TYPE_SET(equationsMatrices, &
- & MATRIX_COMPRESSED_ROW_STORAGE_TYPE,err,error,*999)
- CALL EQUATIONS_MATRICES_LINEAR_STRUCTURE_TYPE_SET(equationsMatrices, &
- & [EquationsMatrix_NodalStructure],err,error,*999)
- ENDIF
- CALL EQUATIONS_MATRICES_NONLINEAR_STRUCTURE_TYPE_SET(equationsMatrices, &
- & EquationsMatrix_NodalStructure,err,error,*999)
- CASE DEFAULT
- localError="The equations matrices sparsity type of "// &
- & TRIM(NUMBER_TO_VSTRING(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
- CALL FLAG_ERROR(localError,err,error,*999)
- END SELECT
- CALL EQUATIONS_MATRICES_CREATE_FINISH(equationsMatrices,err,error,*999)
- 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
- localError="The solution method of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SOLUTION_METHOD, &
- & "*",err,error))//" is invalid."
- CALL FL…
Large files files are truncated, but you can click here to view the full file