PageRenderTime 100ms CodeModel.GetById 3ms app.highlight 87ms RepoModel.GetById 1ms app.codeStats 1ms

/src/characteristic_equation_routines.f90

http://github.com/adamreeve/cm
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

  1!> \file  
  2!> \author David Ladd
  3!> \brief This module handles the characteristic equation routines. These 
  4!>  equations are often used in concert with 1D fluid modelling to describe
  5!>  wave propagation phenomena, which is particularly useful for models of
  6!>  vascular trees. These equations are also often solved using a discontinuous
  7!>  nodal solution method, rather than FEM.
  8!>
  9!> \section LICENSE
 10!>
 11!> Version: MPL 1.1/GPL 2.0/LGPL 2.1
 12!>
 13!> The contents of this file are subject to the Mozilla Public License
 14!> Version 1.1 (the "License"); you may not use this file except in
 15!> compliance with the License. You may obtain a copy of the License at
 16!> http://www.mozilla.org/MPL/
 17!>
 18!> Software distributed under the License is distributed on an "AS IS"
 19!> basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
 20!> License for the specific language governing rights and limitations
 21!> under the License.
 22!>
 23!> The Original Code is OpenCMISS
 24!>
 25!> The Initial Developer of the Original Code is University of Auckland,
 26!> Auckland, New Zealand, the University of Oxford, Oxford, United
 27!> Kingdom and King's College, London, United Kingdom. Portions created
 28!> by the University of Auckland, the University of Oxford and King's
 29!> College, London are Copyright (C) 2007-2010 by the University of
 30!> Auckland, the University of Oxford and King's College, London.
 31!> All Rights Reserved.
 32!>
 33!> Contributor(s): Soroush Safaei
 34!>
 35!> Alternatively, the contents of this file may be used under the terms of
 36!> either the GNU General Public License Version 2 or later (the "GPL"), or
 37!> the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
 38!> in which case the provisions of the GPL or the LGPL are applicable instead
 39!> of those above. If you wish to allow use of your version of this file only
 40!> under the terms of either the GPL or the LGPL, and not to allow others to
 41!> use your version of this file under the terms of the MPL, indicate your
 42!> decision by deleting the provisions above and replace them with the notice
 43!> and other provisions required by the GPL or the LGPL. If you do not delete
 44!> the provisions above, a recipient may use your version of this file under
 45!> the terms of any one of the MPL, the GPL or the LGPL.
 46!>
 47
 48!>This module handles all characteristic equation routines.
 49MODULE CHARACTERISTIC_EQUATION_ROUTINES
 50
 51  USE BASE_ROUTINES
 52  USE BASIS_ROUTINES
 53  USE BOUNDARY_CONDITIONS_ROUTINES
 54  USE CONSTANTS
 55  USE CONTROL_LOOP_ROUTINES
 56  USE DISTRIBUTED_MATRIX_VECTOR
 57  USE DOMAIN_MAPPINGS
 58  USE EQUATIONS_ROUTINES
 59  USE EQUATIONS_MAPPING_ROUTINES
 60  USE EQUATIONS_MATRICES_ROUTINES
 61  USE EQUATIONS_SET_CONSTANTS
 62  USE FIELD_ROUTINES
 63  USE FIELD_IO_ROUTINES
 64  USE FLUID_MECHANICS_IO_ROUTINES
 65  USE INPUT_OUTPUT
 66  USE ISO_VARYING_STRING
 67  USE KINDS
 68  USE MATHS
 69  USE MATRIX_VECTOR
 70  USE MESH_ROUTINES
 71  USE NODE_ROUTINES
 72  USE PROBLEM_CONSTANTS
 73  USE STRINGS
 74  USE SOLVER_ROUTINES
 75  USE TIMER
 76  USE TYPES
 77
 78  IMPLICIT NONE
 79
 80  PRIVATE
 81
 82  PUBLIC Characteristic_EquationsSet_SubtypeSet
 83  PUBLIC Characteristic_EquationsSet_SolutionMethodSet
 84  PUBLIC Characteristic_EquationsSet_Setup
 85  PUBLIC Characteristic_NodalJacobianEvaluate
 86  PUBLIC Characteristic_NodalResidualEvaluate
 87
 88CONTAINS 
 89
 90!
 91!================================================================================================================================
 92!
 93
 94  !>Sets/changes the solution method for a Characteristic equation type of an fluid mechanics equations set class.
 95  SUBROUTINE Characteristic_EquationsSet_SolutionMethodSet(equationsSet,solutionMethod,err,error,*)
 96
 97    !Argument variables
 98    TYPE(EQUATIONS_SET_TYPE), POINTER :: equationsSet !<A pointer to the equations set to set the solution method for
 99    INTEGER(INTG), INTENT(IN) :: solutionMethod !<The solution method to set
100    INTEGER(INTG), INTENT(OUT) :: err !<The error code
101    TYPE(VARYING_STRING), INTENT(OUT) :: error !<The error string
102    !Local Variables
103    TYPE(VARYING_STRING) :: localError
104    
105    CALL ENTERS("Characteristic_EquationsSet_SolutionMethodSet",err,error,*999)
106    
107    IF(ASSOCIATED(equationsSet)) THEN
108      SELECT CASE(equationsSet%SUBTYPE)
109      CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)                                
110        SELECT CASE(solutionMethod)
111        CASE(EQUATIONS_SET_FEM_SOLUTION_METHOD)
112          CALL FLAG_ERROR("Not implemented.",err,error,*999)
113        CASE(EQUATIONS_SET_NODAL_SOLUTION_METHOD)
114          equationsSet%SOLUTION_METHOD=EQUATIONS_SET_NODAL_SOLUTION_METHOD
115        CASE(EQUATIONS_SET_BEM_SOLUTION_METHOD)
116          CALL FLAG_ERROR("Not implemented.",err,error,*999)
117        CASE(EQUATIONS_SET_FD_SOLUTION_METHOD)
118          CALL FLAG_ERROR("Not implemented.",err,error,*999)
119        CASE(EQUATIONS_SET_FV_SOLUTION_METHOD)
120          CALL FLAG_ERROR("Not implemented.",err,error,*999)
121        CASE(EQUATIONS_SET_GFEM_SOLUTION_METHOD)
122          CALL FLAG_ERROR("Not implemented.",err,error,*999)
123        CASE(EQUATIONS_SET_GFV_SOLUTION_METHOD)
124          CALL FLAG_ERROR("Not implemented.",err,error,*999)
125        CASE DEFAULT
126          localError="The specified solution method of "//TRIM(NUMBER_TO_VSTRING(solutionMethod,"*",err,error))// &
127            & " is invalid."
128          CALL FLAG_ERROR(localError,err,error,*999)
129        END SELECT
130      CASE DEFAULT
131        localError="Equations set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
132          & " is not valid for a Characteristic equation type of a fluid mechanics equations set class."
133        CALL FLAG_ERROR(localError,err,error,*999)
134      END SELECT
135    ELSE
136      CALL FLAG_ERROR("Equations set is not associated.",err,error,*999)
137    ENDIF
138       
139    CALL EXITS("Characteristic_EquationsSet_SolutionMethodSet")
140    RETURN
141999 CALL ERRORS("Characteristic_EquationsSet_SolutionMethodSet",err,error)
142    CALL EXITS("Characteristic_EquationsSet_SolutionMethodSet")
143    RETURN 1
144  END SUBROUTINE Characteristic_EquationsSet_SolutionMethodSet
145
146!
147!================================================================================================================================
148!
149
150  !>Sets/changes the equation subtype for a Characteristic type of a fluid mechanics equations set class.
151  SUBROUTINE Characteristic_EquationsSet_SubtypeSet(equationsSet,equationsSetSubtype,err,error,*)
152
153    !Argument variables
154    TYPE(EQUATIONS_SET_TYPE), POINTER :: equationsSet !<A pointer to the equations set to set the equation subtype for
155    INTEGER(INTG), INTENT(IN) :: equationsSetSubtype !<The equation subtype to set
156    INTEGER(INTG), INTENT(OUT) :: err !<The error code
157    TYPE(VARYING_STRING), INTENT(OUT) :: error !<The error string
158    !Local Variables
159    TYPE(VARYING_STRING) :: localError
160
161    CALL ENTERS("Characteristic_EquationsSet_SubtypeSet",err,error,*999)
162
163    IF(ASSOCIATED(equationsSet)) THEN
164      SELECT CASE(equationsSetSubtype)
165      CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE)
166        equationsSet%CLASS=EQUATIONS_SET_FLUID_MECHANICS_CLASS
167        equationsSet%TYPE=EQUATIONS_SET_CHARACTERISTIC_EQUATION_TYPE
168        equationsSet%SUBTYPE=EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE
169      CASE(EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
170        equationsSet%CLASS=EQUATIONS_SET_FLUID_MECHANICS_CLASS
171        equationsSet%TYPE=EQUATIONS_SET_CHARACTERISTIC_EQUATION_TYPE
172        equationsSet%SUBTYPE=EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE
173      CASE DEFAULT
174        localError="Equations set subtype "//TRIM(NUMBER_TO_VSTRING(equationsSetSubtype,"*",err,error))// &
175          & " is not valid for a Characteristic fluid type of a fluid mechanics equations set class."
176        CALL FLAG_ERROR(localError,err,error,*999)
177      END SELECT
178    ELSE
179      CALL FLAG_ERROR("Equations set is not associated.",err,error,*999)
180    ENDIF
181
182    CALL EXITS("Characteristic_EquationsSet_SubtypeSet")
183    RETURN
184999 CALL ERRORS("Characteristic_EquationsSet_SubtypeSet",err,error)
185    CALL EXITS("Characteristic_EquationsSet_SubtypeSet")
186    RETURN 1
187  END SUBROUTINE Characteristic_EquationsSet_SubtypeSet
188
189!
190!================================================================================================================================
191!
192
193  !>Sets up the Characteristic equations fluid setup.
194  SUBROUTINE Characteristic_EquationsSet_Setup(equationsSet,equationsSetSetup,err,error,*)
195
196    !Argument variables
197    TYPE(EQUATIONS_SET_TYPE), POINTER :: equationsSet !<A pointer to the equations set to setup
198    TYPE(EQUATIONS_SET_SETUP_TYPE), INTENT(INOUT) :: equationsSetSetup !<The equations set setup information
199    INTEGER(INTG), INTENT(OUT) :: err !<The error code
200    TYPE(VARYING_STRING), INTENT(OUT) :: error !<The error string
201    !Local Variables
202    TYPE(EQUATIONS_TYPE), POINTER :: equations
203    TYPE(EQUATIONS_MAPPING_TYPE), POINTER :: equationsMapping
204    TYPE(EQUATIONS_MATRICES_TYPE), POINTER :: equationsMatrices
205    TYPE(EQUATIONS_SET_MATERIALS_TYPE), POINTER :: equationsMaterials
206    TYPE(DECOMPOSITION_TYPE), POINTER :: geometricDecomposition
207    INTEGER(INTG) :: numberOfDimensions,componentIdx
208    INTEGER(INTG) :: geometricScalingType,geometricMeshComponent,geometricComponentNumber    
209    INTEGER(INTG) :: dependentFieldNumberOfVariables,dependentFieldNumberOfComponents,numberComponentsU2
210    INTEGER(INTG) :: independentFieldNumberOfComponents,independentFieldNumberOfVariables,numberComponentsV,numberComponentsU1
211    INTEGER(INTG) :: materialsFieldNumberOfVariables,materialsField1DNumberOfComponents,materialsFieldCoupledNumberOfComponents
212    TYPE(VARYING_STRING) :: localError
213
214    CALL ENTERS("Characteristic_EquationsSet_Setup",err,error,*999)
215
216    NULLIFY(equations)
217    NULLIFY(equationsMapping)
218    NULLIFY(equationsMatrices)
219    NULLIFY(equationsMaterials)
220    NULLIFY(geometricDecomposition)
221
222    IF(ASSOCIATED(equationsSet)) THEN
223      SELECT CASE(equationsSet%SUBTYPE)
224      CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
225        SELECT CASE(equationsSetSetup%SETUP_TYPE)
226        !-----------------------------------------------------------------
227        ! I n i t i a l   s e t u p
228        !-----------------------------------------------------------------
229        CASE(EQUATIONS_SET_SETUP_INITIAL_TYPE)
230          SELECT CASE(equationsSet%SUBTYPE)
231          CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
232            SELECT CASE(equationsSetSetup%ACTION_TYPE)
233            CASE(EQUATIONS_SET_SETUP_START_ACTION)
234              CALL Characteristic_EquationsSet_SolutionMethodSet(equationsSet, &
235                & EQUATIONS_SET_NODAL_SOLUTION_METHOD,err,error,*999)
236              equationsSet%SOLUTION_METHOD=EQUATIONS_SET_NODAL_SOLUTION_METHOD
237            CASE(EQUATIONS_SET_SETUP_FINISH_ACTION)
238              !Do nothing
239            CASE DEFAULT
240              localError="The action type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup%ACTION_TYPE, &
241                & "*",err,error))// " for a setup type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup% &
242                & SETUP_TYPE,"*",err,error))// " is not implemented for a characteristic equations set."
243              CALL FLAG_ERROR(localError,err,error,*999)
244            END SELECT
245          CASE DEFAULT
246            localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
247              & " for a setup sub type of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
248              & " is invalid for a characteristic equations set."
249            CALL FLAG_ERROR(localError,err,error,*999)
250          END SELECT
251        !-----------------------------------------------------------------
252        ! G e o m e t r i c   f i e l d
253        !-----------------------------------------------------------------
254        CASE(EQUATIONS_SET_SETUP_GEOMETRY_TYPE)
255          SELECT CASE(equationsSet%SUBTYPE)
256          CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
257            !Do nothing???
258          CASE DEFAULT
259            localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
260              & " is invalid for a characteristic equations set."
261            CALL FLAG_ERROR(localError,err,error,*999)
262          END SELECT
263        !-----------------------------------------------------------------
264        ! D e p e n d e n t   f i e l d
265        !-----------------------------------------------------------------
266        CASE(EQUATIONS_SET_SETUP_DEPENDENT_TYPE)
267          SELECT CASE(equationsSet%SUBTYPE)
268          CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
269            SELECT CASE(equationsSetSetup%ACTION_TYPE)
270            !Set start action
271            CASE(EQUATIONS_SET_SETUP_START_ACTION)
272              IF(equationsSet%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
273                !Create the auto created dependent field
274                !start field creation with name 'DEPENDENT_FIELD'
275                CALL FIELD_CREATE_START(equationsSetSetup%FIELD_USER_NUMBER,equationsSet%REGION, &
276                  & equationsSet%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
277                !start creation of a new field
278                CALL FIELD_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_GENERAL_TYPE,err,error,*999)
279                !label the field
280                CALL FIELD_LABEL_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
281                !define new created field to be dependent
282                CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
283                  & FIELD_DEPENDENT_TYPE,err,error,*999)
284                !look for decomposition rule already defined
285                CALL FIELD_MESH_DECOMPOSITION_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,geometricDecomposition, &
286                  & err,error,*999)
287                !apply decomposition rule found on new created field
288                CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
289                  & geometricDecomposition,err,error,*999)
290                !point new field to geometric field
291                CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,equationsSet%GEOMETRY% &
292                  & GEOMETRIC_FIELD,err,error,*999)
293                !set number of variables to 5 (U,DELUDELN,V,U1,U2)=>(Q,A;dQ,dA;W(1,2);pCellML,Pressure)
294                dependentFieldNumberOfVariables=5
295                CALL FIELD_NUMBER_OF_VARIABLES_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
296                  & dependentFieldNumberOfVariables,err,error,*999)
297                CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,[FIELD_U_VARIABLE_TYPE, &
298                  & FIELD_DELUDELN_VARIABLE_TYPE,FIELD_V_VARIABLE_TYPE,FIELD_U1_VARIABLE_TYPE,FIELD_U2_VARIABLE_TYPE], &
299                  & err,error,*999)
300                ! set dimension
301                CALL FIELD_DIMENSION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
302                  & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
303                CALL FIELD_DIMENSION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE, &
304                  & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
305                CALL FIELD_DIMENSION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_V_VARIABLE_TYPE, &
306                  & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
307                CALL FIELD_DIMENSION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_U1_VARIABLE_TYPE, &
308                  & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
309                CALL FIELD_DIMENSION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_U2_VARIABLE_TYPE, &
310                  & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
311                ! set data type
312                CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
313                  & FIELD_DP_TYPE,err,error,*999)
314                CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE, &
315                  & FIELD_DP_TYPE,err,error,*999)
316                CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_V_VARIABLE_TYPE, &
317                  & FIELD_DP_TYPE,err,error,*999)
318                CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_U1_VARIABLE_TYPE, &
319                  & FIELD_DP_TYPE,err,error,*999)
320                CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD,FIELD_U2_VARIABLE_TYPE, &
321                  & FIELD_DP_TYPE,err,error,*999)
322                ! number of components for U,DELUDELN=2 (Q,A)
323                dependentFieldNumberOfComponents=2
324                CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
325                  & FIELD_U_VARIABLE_TYPE,dependentFieldNumberOfComponents,err,error,*999)
326                CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
327                  & FIELD_DELUDELN_VARIABLE_TYPE,dependentFieldNumberOfComponents,err,error,*999)
328!                IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
329                numberComponentsV=2
330                numberComponentsU1=1
331                numberComponentsU2=1
332!                ENDIF
333                ! set number of components for V
334                CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
335                 & FIELD_V_VARIABLE_TYPE,numberComponentsV,err,error,*999)
336                CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
337                 & FIELD_U1_VARIABLE_TYPE,numberComponentsU1,err,error,*999)
338                CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
339                 & FIELD_U2_VARIABLE_TYPE,numberComponentsU2,err,error,*999)
340
341                CALL FIELD_COMPONENT_MESH_COMPONENT_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & 
342                  & 1,geometricMeshComponent,err,error,*999)
343                !Default to the geometric interpolation setup for U,dUdN
344                DO componentIdx=1,dependentFieldNumberOfComponents
345                  CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD, & 
346                    & FIELD_U_VARIABLE_TYPE,componentIdx,geometricMeshComponent,err,error,*999)
347                  CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
348                    & FIELD_DELUDELN_VARIABLE_TYPE,componentIdx,geometricMeshComponent,err,error,*999)
349                END DO
350                !Default to the geometric interpolation setup for V
351                CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD, & 
352                  & FIELD_V_VARIABLE_TYPE,1,geometricMeshComponent,err,error,*999)
353                CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD, & 
354                  & FIELD_U1_VARIABLE_TYPE,1,geometricMeshComponent,err,error,*999)
355                CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD, & 
356                  & FIELD_U2_VARIABLE_TYPE,1,geometricMeshComponent,err,error,*999)
357
358                SELECT CASE(equationsSet%SOLUTION_METHOD)
359                !Specify nodal solution method
360                CASE(EQUATIONS_SET_NODAL_SOLUTION_METHOD)
361                  ! (U, dUdN); 2 components (Q,A)
362                  DO componentIdx=1,dependentFieldNumberOfComponents
363                    CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
364                      & FIELD_U_VARIABLE_TYPE,componentIdx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
365                    CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
366                      & FIELD_DELUDELN_VARIABLE_TYPE,componentIdx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
367                  END DO
368                  ! V; 2 components (W1,W2 )
369                  DO componentIdx=1,numberComponentsV
370                    CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
371                      & FIELD_V_VARIABLE_TYPE,componentIdx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
372                  ENDDO
373                  DO componentIdx=1,numberComponentsU1
374                    CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
375                      & FIELD_U1_VARIABLE_TYPE,componentIdx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
376                  ENDDO
377                  DO componentIdx=1,numberComponentsU2
378                    CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(equationsSet%DEPENDENT%DEPENDENT_FIELD, &
379                      & FIELD_U2_VARIABLE_TYPE,componentIdx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
380                  ENDDO
381                  CALL FIELD_SCALING_TYPE_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,geometricScalingType, &
382                    & err,error,*999)
383                  CALL FIELD_SCALING_TYPE_SET(equationsSet%DEPENDENT%DEPENDENT_FIELD,geometricScalingType, &
384                    & err,error,*999)
385                CASE DEFAULT
386                  localError="The solution method of " &
387                    & //TRIM(NUMBER_TO_VSTRING(equationsSet%SOLUTION_METHOD,"*",err,error))// " is invalid."
388                  CALL FLAG_ERROR(localError,err,error,*999)
389                END SELECT
390
391              ELSE 
392                !Check the user specified field
393                CALL FIELD_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_GENERAL_TYPE,err,error,*999)
394                CALL FIELD_DEPENDENT_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_DEPENDENT_TYPE,err,error,*999)
395                dependentFieldNumberOfVariables=4 ! U,dUdN,V,U2
396                CALL FIELD_NUMBER_OF_VARIABLES_CHECK(equationsSetSetup%FIELD,dependentFieldNumberOfVariables,err,error,*999)
397                CALL FIELD_VARIABLE_TYPES_CHECK(equationsSetSetup%FIELD,[FIELD_U_VARIABLE_TYPE, &
398                  & FIELD_DELUDELN_VARIABLE_TYPE,FIELD_V_VARIABLE_TYPE,FIELD_U2_VARIABLE_TYPE],err,error,*999)
399                CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE, & 
400                  & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
401                CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_DELUDELN_VARIABLE_TYPE, &
402                  & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
403                CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE, & 
404                  & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
405                CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_U2_VARIABLE_TYPE, & 
406                  & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
407                CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999)
408                CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,FIELD_DP_TYPE, &
409                  & err,error,*999)
410                CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999)
411                CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_U2_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999)
412                CALL FIELD_NUMBER_OF_COMPONENTS_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
413                  & numberOfDimensions,err,error,*999)
414                !calculate number of components (Q,A) for U and dUdN
415                dependentFieldNumberOfComponents=2
416                CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE, &
417                  & dependentFieldNumberOfComponents,err,error,*999)
418                CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_DELUDELN_VARIABLE_TYPE, &
419                  & dependentFieldNumberOfComponents,err,error,*999)
420                IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
421                  numberComponentsV=3
422                  numberComponentsU2=1
423                ELSE
424                  numberComponentsV=2
425                  numberComponentsU2=1
426                ENDIF
427                CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE, &
428                  & numberComponentsV,err,error,*999)
429                CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE, &
430                  & numberComponentsU2,err,error,*999)
431                SELECT CASE(equationsSet%SOLUTION_METHOD)
432                CASE(EQUATIONS_SET_NODAL_SOLUTION_METHOD)
433                  CALL FIELD_COMPONENT_INTERPOLATION_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE,1, &
434                    & FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
435                  CALL FIELD_COMPONENT_INTERPOLATION_CHECK(equationsSetSetup%FIELD,FIELD_DELUDELN_VARIABLE_TYPE,1, &
436                    & FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
437                  CALL FIELD_COMPONENT_INTERPOLATION_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE,1, &
438                    & FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
439                  CALL FIELD_COMPONENT_INTERPOLATION_CHECK(equationsSetSetup%FIELD,FIELD_U2_VARIABLE_TYPE,1, &
440                    & FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
441                CASE DEFAULT
442                  localError="The solution method of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SOLUTION_METHOD, &
443                    & "*",err,error))//" is invalid."
444                  CALL FLAG_ERROR(localError,err,error,*999)
445                END SELECT
446              ENDIF
447
448            !Specify finish action
449            CASE(EQUATIONS_SET_SETUP_FINISH_ACTION)
450              IF(equationsSet%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
451                CALL FIELD_CREATE_FINISH(equationsSet%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
452              ENDIF
453            CASE DEFAULT
454              localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
455                & " for a setup sub type of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
456                & " is invalid for a characteristic equations set."
457              CALL FLAG_ERROR(localError,err,error,*999)
458            END SELECT
459          CASE DEFAULT
460            localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
461              & " for a setup sub type of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
462              & " is invalid for a characteristic equations set."
463            CALL FLAG_ERROR(localError,err,error,*999)
464          END SELECT
465        !-----------------------------------------------------------------
466        ! I n d e p e n d e n t   f i e l d
467        !-----------------------------------------------------------------
468        CASE(EQUATIONS_SET_SETUP_INDEPENDENT_TYPE)
469          SELECT CASE(equationsSet%SUBTYPE)
470          CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
471            SELECT CASE(equationsSetSetup%ACTION_TYPE)
472            !Set start action
473            CASE(EQUATIONS_SET_SETUP_START_ACTION)
474              independentFieldNumberOfComponents=2 ! normalDirection for wave relative to node for W1,W2
475              IF(equationsSet%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
476                !Create the auto created independent field
477                !start field creation with name 'INDEPENDENT_FIELD'
478                CALL FIELD_CREATE_START(equationsSetSetup%FIELD_USER_NUMBER,equationsSet%REGION, &
479                  & equationsSet%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
480                !start creation of a new field
481                CALL FIELD_TYPE_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,FIELD_GENERAL_TYPE,err,error,*999)
482                !label the field
483                CALL FIELD_LABEL_SET(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,"Independent Field",err,error, & 
484                  & *999)
485                !define new created field to be independent
486                CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, &
487                  & FIELD_INDEPENDENT_TYPE,err,error,*999)
488                !look for decomposition rule already defined
489                CALL FIELD_MESH_DECOMPOSITION_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,geometricDecomposition, &
490                  & err,error,*999)
491                !apply decomposition rule found on new created field
492                CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, &
493                  & geometricDecomposition,err,error,*999)
494                !point new field to geometric field
495                CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,equationsSet% & 
496                  & GEOMETRY%GEOMETRIC_FIELD,err,error,*999)
497                !set number of variables to 1 (1 for U)
498                independentFieldNumberOfVariables=1
499                CALL FIELD_NUMBER_OF_VARIABLES_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, &
500                  & independentFieldNumberOfVariables,err,error,*999)
501                CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, & 
502                  & [FIELD_U_VARIABLE_TYPE],err,error,*999)
503                CALL FIELD_DIMENSION_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
504                  & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
505                ! characteristic normal direction (normalWave) is +/- 1
506                CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
507                  & FIELD_DP_TYPE,err,error,*999)
508                CALL FIELD_NUMBER_OF_COMPONENTS_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
509                  & numberOfDimensions,err,error,*999)
510                !calculate number of components with one component for each dimension
511                CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, & 
512                  & FIELD_U_VARIABLE_TYPE,independentFieldNumberOfComponents,err,error,*999)
513                CALL FIELD_COMPONENT_MESH_COMPONENT_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, & 
514                  & 1,geometricMeshComponent,err,error,*999)
515                !Default to the geometric interpolation setup
516                DO componentIdx=1,independentFieldNumberOfComponents
517                  CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, & 
518                    & FIELD_U_VARIABLE_TYPE,componentIdx,geometricMeshComponent,err,error,*999)
519                END DO
520                SELECT CASE(equationsSet%SOLUTION_METHOD)
521                CASE(EQUATIONS_SET_NODAL_SOLUTION_METHOD)
522                  DO componentIdx=1,independentFieldNumberOfComponents
523                    CALL FIELD_COMPONENT_INTERPOLATION_SET_AND_LOCK(equationsSet%INDEPENDENT%INDEPENDENT_FIELD, &
524                      & FIELD_U_VARIABLE_TYPE,componentIdx,FIELD_NODE_BASED_INTERPOLATION,err,error,*999)
525                  END DO !componentIdx
526                  CALL FIELD_SCALING_TYPE_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,geometricScalingType, &
527                    & err,error,*999)
528                  CALL FIELD_SCALING_TYPE_SET(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,geometricScalingType, &
529                    & err,error,*999)
530                CASE DEFAULT
531                  localError="The solution method of " &
532                    & //TRIM(NUMBER_TO_VSTRING(equationsSet%SOLUTION_METHOD,"*",err,error))// " is invalid."
533                  CALL FLAG_ERROR(localError,err,error,*999)
534                END SELECT 
535
536              ELSE
537                !Check the user specified field
538                CALL FIELD_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_GENERAL_TYPE,err,error,*999)
539                CALL FIELD_DEPENDENT_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999)
540                CALL FIELD_NUMBER_OF_VARIABLES_CHECK(equationsSetSetup%FIELD,1,err,error,*999)
541                CALL FIELD_VARIABLE_TYPES_CHECK(equationsSetSetup%FIELD,[FIELD_U_VARIABLE_TYPE],err,error,*999)
542                CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VECTOR_DIMENSION_TYPE, &
543                  & err,error,*999)
544                CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE,err,error,*999)
545                CALL FIELD_NUMBER_OF_COMPONENTS_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
546                  & numberOfDimensions,err,error,*999)
547                CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE, &
548                  & independentFieldNumberOfComponents,err,error,*999)
549              ENDIF    
550            !Specify finish action
551            CASE(EQUATIONS_SET_SETUP_FINISH_ACTION)
552              IF(equationsSet%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
553                CALL FIELD_CREATE_FINISH(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
554                CALL FIELD_PARAMETER_SET_CREATE(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
555                  & FIELD_MESH_DISPLACEMENT_SET_TYPE,err,error,*999)
556                CALL FIELD_PARAMETER_SET_CREATE(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
557                  & FIELD_MESH_VELOCITY_SET_TYPE,err,error,*999)
558                CALL FIELD_PARAMETER_SET_CREATE(equationsSet%INDEPENDENT%INDEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
559                  & FIELD_BOUNDARY_SET_TYPE,err,error,*999)
560              ENDIF
561            CASE DEFAULT
562              localError="The action type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup%ACTION_TYPE,"*",err,error))// &
563                & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup%SETUP_TYPE,"*",err,error))// &
564                & " is invalid for a standard characteristic equations set"
565              CALL FLAG_ERROR(localError,err,error,*999)
566            END SELECT
567          CASE DEFAULT
568            localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
569              & " for a setup sub type of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
570              & " is invalid for a standard characteristic equations set."
571            CALL FLAG_ERROR(localError,err,error,*999)
572          END SELECT
573        !-----------------------------------------------------------------
574        ! M a t e r i a l s   f i e l d 
575        !-----------------------------------------------------------------
576        CASE(EQUATIONS_SET_SETUP_MATERIALS_TYPE)
577          SELECT CASE(equationsSet%SUBTYPE)
578          CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
579            IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
580              materialsFieldNumberOfVariables=2 ! 1 U-type container variable w/ 10 components, 1 V-type w/ 2 components
581              materialsField1DNumberOfComponents=10
582              materialsFieldCoupledNumberOfComponents=2
583            ELSE
584              materialsFieldNumberOfVariables=1 ! 1 U-type container variable w/ 10 components
585              materialsField1DNumberOfComponents=10
586              materialsFieldCoupledNumberOfComponents=0
587            ENDIF
588            SELECT CASE(equationsSetSetup%ACTION_TYPE)
589            !Specify start action
590            CASE(EQUATIONS_SET_SETUP_START_ACTION)
591              equationsMaterials=>equationsSet%MATERIALS
592              IF(ASSOCIATED(equationsMaterials)) THEN
593                IF(equationsMaterials%MATERIALS_FIELD_AUTO_CREATED) THEN
594                  !Create the auto created materials field
595                  !start field creation with name 'MATERIAL_FIELD'
596                  CALL FIELD_CREATE_START(equationsSetSetup%FIELD_USER_NUMBER,equationsSet%REGION, & 
597                    & equationsSet%MATERIALS%MATERIALS_FIELD,err,error,*999)
598                  CALL FIELD_TYPE_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD,FIELD_MATERIAL_TYPE,err,error,*999)
599                  !label the field
600                  CALL FIELD_LABEL_SET(equationsMaterials%MATERIALS_FIELD,"Materials Field",err,error,*999)
601                  CALL FIELD_DEPENDENT_TYPE_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD,FIELD_INDEPENDENT_TYPE, &
602                    & err,error,*999)
603                  CALL FIELD_MESH_DECOMPOSITION_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,geometricDecomposition, & 
604                    & err,error,*999)
605                  !apply decomposition rule found on new created field
606                  CALL FIELD_MESH_DECOMPOSITION_SET_AND_LOCK(equationsSet%MATERIALS%MATERIALS_FIELD, & 
607                    & geometricDecomposition,err,error,*999)
608                  !point new field to geometric field
609                  CALL FIELD_GEOMETRIC_FIELD_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD,equationsSet%GEOMETRY% &
610                    & GEOMETRIC_FIELD,err,error,*999)
611                  CALL FIELD_NUMBER_OF_VARIABLES_SET(equationsMaterials%MATERIALS_FIELD, & 
612                    & materialsFieldNumberOfVariables,err,error,*999)
613                  CALL FIELD_VARIABLE_TYPES_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD, & 
614                    & [FIELD_U_VARIABLE_TYPE],err,error,*999)
615                  CALL FIELD_DIMENSION_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, &
616                    & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
617                  CALL FIELD_DATA_TYPE_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, &
618                    & FIELD_DP_TYPE,err,error,*999)
619                  CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(equationsMaterials%MATERIALS_FIELD, & 
620                    & FIELD_U_VARIABLE_TYPE,materialsField1DNumberOfComponents,err,error,*999)
621                  CALL FIELD_COMPONENT_MESH_COMPONENT_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD, & 
622                    & FIELD_U_VARIABLE_TYPE,1,geometricComponentNumber,err,error,*999)
623                  CALL FIELD_COMPONENT_MESH_COMPONENT_SET(equationsMaterials%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, &
624                    & 1,geometricComponentNumber,err,error,*999)
625                  DO componentIdx=1,7 !(MU,RHO,K,As,Re,Fr,St)
626                    CALL FIELD_COMPONENT_INTERPOLATION_SET(equationsMaterials%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, &
627                      & componentIdx,FIELD_CONSTANT_INTERPOLATION,ERR,ERROR,*999)
628                  ENDDO
629                  DO componentIdx=8,10 !(A0,E,H0)
630                    CALL FIELD_COMPONENT_INTERPOLATION_SET(equationsMaterials%MATERIALS_FIELD,FIELD_U_VARIABLE_TYPE, &
631                      & componentIdx,FIELD_NODE_BASED_INTERPOLATION,ERR,ERROR,*999)
632                  ENDDO
633                  !Default the field scaling to that of the geometric field
634                  CALL FIELD_SCALING_TYPE_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,geometricScalingType, & 
635                    & err,error,*999)
636                  CALL FIELD_SCALING_TYPE_SET(equationsMaterials%MATERIALS_FIELD,geometricScalingType,err,error,*999)
637                ELSE
638                  !Check the user specified field
639                  CALL FIELD_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_MATERIAL_TYPE,err,error,*999)
640                  CALL FIELD_DEPENDENT_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_INDEPENDENT_TYPE,err,error,*999)
641                  CALL FIELD_NUMBER_OF_VARIABLES_CHECK(equationsSetSetup%FIELD,materialsFieldNumberOfVariables,err,error,*999)
642                  IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
643                    CALL FIELD_VARIABLE_TYPES_CHECK(equationsSetSetup%FIELD,[FIELD_U_VARIABLE_TYPE,FIELD_V_VARIABLE_TYPE], &
644                      & err,error,*999)
645                  ELSE
646                    CALL FIELD_VARIABLE_TYPES_CHECK(equationsSetSetup%FIELD,[FIELD_U_VARIABLE_TYPE],err,error,*999)
647                  ENDIF
648                  ! U-variable
649                  CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE, & 
650                    & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
651                  CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE,FIELD_DP_TYPE, & 
652                    & err,error,*999)
653                  CALL FIELD_NUMBER_OF_COMPONENTS_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
654                    & numberOfDimensions,err,error,*999)
655                  CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_U_VARIABLE_TYPE, &
656                    & materialsField1DNumberOfComponents,err,error,*999)
657                  IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
658                    ! V-variable
659                    CALL FIELD_DIMENSION_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE, & 
660                      & FIELD_VECTOR_DIMENSION_TYPE,err,error,*999)
661                    CALL FIELD_DATA_TYPE_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE,FIELD_DP_TYPE, & 
662                      & err,error,*999)
663                    CALL FIELD_NUMBER_OF_COMPONENTS_GET(equationsSet%GEOMETRY%GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE, &
664                      & numberOfDimensions,err,error,*999)
665                    CALL FIELD_NUMBER_OF_COMPONENTS_CHECK(equationsSetSetup%FIELD,FIELD_V_VARIABLE_TYPE, &
666                      & materialsFieldCoupledNumberOfComponents,err,error,*999)
667                  ENDIF
668                ENDIF
669              ELSE
670                CALL FLAG_ERROR("Equations set materials is not associated.",err,error,*999)
671              END IF
672              !Specify start action
673            CASE(EQUATIONS_SET_SETUP_FINISH_ACTION)
674              equationsMaterials=>equationsSet%MATERIALS
675              IF(ASSOCIATED(equationsMaterials)) THEN
676                IF(equationsMaterials%MATERIALS_FIELD_AUTO_CREATED) THEN
677                  !Finish creating the materials field
678                  CALL FIELD_CREATE_FINISH(equationsMaterials%MATERIALS_FIELD,err,error,*999)
679                  ! Should be initialized from example file
680                ENDIF
681              ELSE
682                CALL FLAG_ERROR("Equations set materials is not associated.",err,error,*999)
683              ENDIF
684            CASE DEFAULT
685              localError="The action type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup%ACTION_TYPE,"*", & 
686                & err,error))//" for a setup type of "//TRIM(NUMBER_TO_VSTRING(equationsSetSetup%SETUP_TYPE,"*", & 
687                & err,error))//" is invalid for characteristic equation."
688              CALL FLAG_ERROR(localError,err,error,*999)
689            END SELECT
690          CASE DEFAULT
691            localError="The equation set subtype of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
692              & " for a setup sub type of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SUBTYPE,"*",err,error))// &
693              & " is invalid for a characteristic equation."
694            CALL FLAG_ERROR(localError,err,error,*999)
695          END SELECT
696        !-----------------------------------------------------------------
697        ! E q u a t i o n s    t y p e
698        !-----------------------------------------------------------------
699        CASE(EQUATIONS_SET_SETUP_EQUATIONS_TYPE)
700          SELECT CASE(equationsSet%SUBTYPE)
701          CASE(EQUATIONS_SET_STATIC_CHARACTERISTIC_SUBTYPE,EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE)
702            SELECT CASE(equationsSetSetup%ACTION_TYPE)
703            CASE(EQUATIONS_SET_SETUP_START_ACTION)
704              equationsMaterials=>equationsSet%MATERIALS
705              IF(ASSOCIATED(equationsMaterials)) THEN              
706                IF(equationsMaterials%MATERIALS_FINISHED) THEN
707                  CALL EQUATIONS_CREATE_START(equationsSet,equations,err,error,*999)
708                  CALL EQUATIONS_LINEARITY_TYPE_SET(equations,EQUATIONS_NONLINEAR,err,error,*999)
709                  CALL EQUATIONS_TIME_DEPENDENCE_TYPE_SET(equations,EQUATIONS_STATIC,err,error,*999)
710                ELSE
711                  CALL FLAG_ERROR("Equations set materials has not been finished.",err,error,*999)
712                ENDIF
713              ELSE
714                CALL FLAG_ERROR("Equations materials is not associated.",err,error,*999)
715              ENDIF
716            CASE(EQUATIONS_SET_SETUP_FINISH_ACTION)
717              SELECT CASE(equationsSet%SOLUTION_METHOD)
718              CASE(EQUATIONS_SET_NODAL_SOLUTION_METHOD)
719                !Finish the creation of the equations
720                CALL EQUATIONS_SET_EQUATIONS_GET(equationsSet,equations,err,error,*999)
721                CALL EQUATIONS_CREATE_FINISH(equations,err,error,*999)
722                !Create the equations mapping.
723                CALL EQUATIONS_MAPPING_CREATE_START(equations,equationsMapping,err,error,*999)
724                IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN                   
725                  CALL EQUATIONS_MAPPING_LINEAR_MATRICES_NUMBER_SET(equationsMapping,1,err,error,*999)
726                  CALL EQUATIONS_MAPPING_LINEAR_MATRICES_VARIABLE_TYPES_SET(equationsMapping,[FIELD_U_VARIABLE_TYPE],err,error,*999)
727                  CALL EQUATIONS_MAPPING_RHS_VARIABLE_TYPE_SET(equationsMapping,FIELD_DELUDELN_VARIABLE_TYPE, & 
728                    & err,error,*999)
729                ELSE
730                  CALL EQUATIONS_MAPPING_LINEAR_MATRICES_NUMBER_SET(equationsMapping,1,err,error,*999)
731                  CALL EQUATIONS_MAPPING_LINEAR_MATRICES_VARIABLE_TYPES_SET(equationsMapping,[FIELD_U_VARIABLE_TYPE],err,error,*999)
732                  CALL EQUATIONS_MAPPING_RHS_VARIABLE_TYPE_SET(equationsMapping,FIELD_DELUDELN_VARIABLE_TYPE, & 
733                    & err,error,*999)
734                ENDIF
735                CALL EQUATIONS_MAPPING_CREATE_FINISH(equationsMapping,err,error,*999)
736                !Create the equations matrices
737                CALL EQUATIONS_MATRICES_CREATE_START(equations,equationsMatrices,err,error,*999)
738                ! Use the analytic Jacobian calculation
739                CALL EquationsMatrices_JacobianTypesSet(equationsMatrices,[EQUATIONS_JACOBIAN_ANALYTIC_CALCULATED], &
740                  & err,error,*999)
741                SELECT CASE(equations%SPARSITY_TYPE)
742                CASE(EQUATIONS_MATRICES_FULL_MATRICES)
743                  CALL EQUATIONS_MATRICES_LINEAR_STORAGE_TYPE_SET(equationsMatrices,[MATRIX_BLOCK_STORAGE_TYPE], &
744                    & err,error,*999)
745                  CALL EQUATIONS_MATRICES_NONLINEAR_STORAGE_TYPE_SET(equationsMatrices,MATRIX_BLOCK_STORAGE_TYPE, &
746                    & err,error,*999)
747                CASE(EQUATIONS_MATRICES_SPARSE_MATRICES)
748                  IF(equationsSet%SUBTYPE==EQUATIONS_SET_Coupled1D0D_CHARACTERISTIC_SUBTYPE) THEN
749                    CALL EQUATIONS_MATRICES_LINEAR_STORAGE_TYPE_SET(equationsMatrices, & 
750                      & [MATRIX_COMPRESSED_ROW_STORAGE_TYPE],err,error,*999)
751                    CALL EQUATIONS_MATRICES_LINEAR_STRUCTURE_TYPE_SET(equationsMatrices, & 
752                      & [EquationsMatrix_NodalStructure],err,error,*999)
753                    CALL EQUATIONS_MATRICES_NONLINEAR_STORAGE_TYPE_SET(equationsMatrices, & 
754                      & MATRIX_COMPRESSED_ROW_STORAGE_TYPE,err,error,*999)
755!                    CALL EQUATIONS_MATRICES_NONLINEAR_STRUCTURE_TYPE_SET(equationsMatrices, & 
756!                      & EquationsMatrix_NodalStructure,err,error,*999)
757                  ELSE
758                    CALL EQUATIONS_MATRICES_LINEAR_STORAGE_TYPE_SET(equationsMatrices, & 
759                      & [MATRIX_COMPRESSED_ROW_STORAGE_TYPE],err,error,*999)
760                    CALL EQUATIONS_MATRICES_NONLINEAR_STORAGE_TYPE_SET(equationsMatrices, & 
761                      & MATRIX_COMPRESSED_ROW_STORAGE_TYPE,err,error,*999)
762                    CALL EQUATIONS_MATRICES_LINEAR_STRUCTURE_TYPE_SET(equationsMatrices, & 
763                      & [EquationsMatrix_NodalStructure],err,error,*999)
764                  ENDIF
765                  CALL EQUATIONS_MATRICES_NONLINEAR_STRUCTURE_TYPE_SET(equationsMatrices, & 
766                    & EquationsMatrix_NodalStructure,err,error,*999)
767                CASE DEFAULT
768                  localError="The equations matrices sparsity type of "// &
769                    & TRIM(NUMBER_TO_VSTRING(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
770                  CALL FLAG_ERROR(localError,err,error,*999)
771                END SELECT
772                CALL EQUATIONS_MATRICES_CREATE_FINISH(equationsMatrices,err,error,*999)
773              CASE(EQUATIONS_SET_BEM_SOLUTION_METHOD)
774                CALL FLAG_ERROR("Not implemented.",err,error,*999)
775              CASE(EQUATIONS_SET_FD_SOLUTION_METHOD)
776                CALL FLAG_ERROR("Not implemented.",err,error,*999)
777              CASE(EQUATIONS_SET_FV_SOLUTION_METHOD)
778                CALL FLAG_ERROR("Not implemented.",err,error,*999)
779              CASE(EQUATIONS_SET_GFEM_SOLUTION_METHOD)
780                CALL FLAG_ERROR("Not implemented.",err,error,*999)
781              CASE(EQUATIONS_SET_GFV_SOLUTION_METHOD)
782                CALL FLAG_ERROR("Not implemented.",err,error,*999)
783              CASE DEFAULT
784                localError="The solution method of "//TRIM(NUMBER_TO_VSTRING(equationsSet%SOLUTION_METHOD, &
785                  & "*",err,error))//" is invalid."
786                CALL FL

Large files files are truncated, but you can click here to view the full file