OpenCMISS-Iron Internal API Documentation
fitting_routines.f90
Go to the documentation of this file.
1 
43 
45 MODULE fitting_routines
46 
47  USE base_routines
48  USE basis_routines
49  USE boundary_conditions_routines
50  USE constants
51  USE control_loop_routines
52  USE darcy_equations_routines, ONLY: idebug1
53  USE distributed_matrix_vector
54  USE domain_mappings
55  USE equations_routines
56  USE equations_mapping_routines
57  USE equations_matrices_routines
58  USE equations_set_constants
59  USE field_routines
60  USE fluid_mechanics_io_routines
61  USE input_output
62  USE iso_varying_string
63  USE kinds
64  USE matrix_vector
65  USE maths
66  USE node_routines
67  USE problem_constants
68  USE strings
69  USE solver_routines
70  USE timer
71  USE types
72 
73 #include "macros.h"
74 
75  IMPLICIT NONE
76 
77  PRIVATE
78 
79  !Module parameters
80 
81  !Module types
82 
83  !Module variables
84 
85  !Interfaces
86 
87 !!MERGE: move
88 
89  PUBLIC fitting_equations_set_setup
90  PUBLIC fitting_equations_set_vectordata_setup
91  PUBLIC fitting_equationssetspecificationset
92  PUBLIC fitting_equations_set_solution_method_set
93 
94  PUBLIC fitting_problem_setup
95  PUBLIC fitting_problemspecificationset
96 
97  PUBLIC fitting_finite_element_calculate
98 
99  PUBLIC fitting_pre_solve
100  PUBLIC fitting_post_solve
101  PUBLIC fitting_pre_solve_update_input_data
102 
103 CONTAINS
104 
105  !
106  !================================================================================================================================
107  !
108 
109 
110 ! ! ! !>Calculates the analytic solution and sets the boundary conditions for an analytic problem.
111 ! ! ! SUBROUTINE FITTING_ANALYTIC_CALCULATE(EQUATIONS_SET,ERR,ERROR,*)
112 ! ! !
113 ! ! ! !Argument variables
114 ! ! ! TYPE(EQUATIONS_SET_TYPE), POINTER :: EQUATIONS_SET
115 ! ! ! INTEGER(INTG), INTENT(OUT) :: ERR !<The error code
116 ! ! ! TYPE(VARYING_STRING), INTENT(OUT) :: ERROR !<The error string
117 ! ! ! !Local Variables
118 ! ! ! INTEGER(INTG) :: component_idx,deriv_idx,dim_idx,local_ny,node_idx,NUMBER_OF_DIMENSIONS,variable_idx,variable_type
119 ! ! ! REAL(DP) :: VALUE,X(3)
120 ! ! ! REAL(DP), POINTER :: GEOMETRIC_PARAMETERS(:)
121 ! ! ! TYPE(BOUNDARY_CONDITIONS_TYPE), POINTER :: BOUNDARY_CONDITIONS
122 ! ! ! TYPE(DOMAIN_TYPE), POINTER :: DOMAIN
123 ! ! ! TYPE(DOMAIN_NODES_TYPE), POINTER :: DOMAIN_NODES
124 ! ! ! TYPE(FIELD_TYPE), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD
125 ! ! ! TYPE(FIELD_VARIABLE_TYPE), POINTER :: FIELD_VARIABLE,GEOMETRIC_VARIABLE
126 ! ! ! TYPE(VARYING_STRING) :: LOCAL_ERROR
127 ! ! !
128 ! ! ! ENTERS("FITTING_ANALYTIC_CALCULATE",ERR,ERROR,*999)
129 ! ! !
130 ! ! ! IF(ASSOCIATED(EQUATIONS_SET)) THEN
131 ! ! ! IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN
132 ! ! ! DEPENDENT_FIELD=>EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD
133 ! ! ! IF(ASSOCIATED(DEPENDENT_FIELD)) THEN
134 ! ! ! GEOMETRIC_FIELD=>EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD
135 ! ! ! IF(ASSOCIATED(GEOMETRIC_FIELD)) THEN
136 ! ! ! CALL FIELD_NUMBER_OF_COMPONENTS_GET(GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE,NUMBER_OF_DIMENSIONS,ERR,ERROR,*999)
137 ! ! ! NULLIFY(GEOMETRIC_VARIABLE)
138 ! ! ! CALL FIELD_VARIABLE_GET(GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE,GEOMETRIC_VARIABLE,ERR,ERROR,*999)
139 ! ! ! CALL FIELD_PARAMETER_SET_DATA_GET(GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,GEOMETRIC_PARAMETERS, &
140 ! ! ! & ERR,ERROR,*999)
141 ! ! ! NULLIFY(BOUNDARY_CONDITIONS)
142 ! ! ! CALL BOUNDARY_CONDITIONS_CREATE_START(EQUATIONS_SET,BOUNDARY_CONDITIONS,ERR,ERROR,*999)
143 ! ! ! DO variable_idx=1,DEPENDENT_FIELD%NUMBER_OF_VARIABLES
144 ! ! ! variable_type=DEPENDENT_FIELD%VARIABLES(variable_idx)%VARIABLE_TYPE
145 ! ! ! FIELD_VARIABLE=>DEPENDENT_FIELD%VARIABLE_TYPE_MAP(variable_type)%PTR
146 ! ! ! IF(ASSOCIATED(FIELD_VARIABLE)) THEN
147 ! ! ! CALL FIELD_PARAMETER_SET_CREATE(DEPENDENT_FIELD,variable_type,FIELD_ANALYTIC_VALUES_SET_TYPE,ERR,ERROR,*999)
148 ! ! ! DO component_idx=1,FIELD_VARIABLE%NUMBER_OF_COMPONENTS
149 ! ! ! IF(FIELD_VARIABLE%COMPONENTS(component_idx)%INTERPOLATION_TYPE==FIELD_NODE_BASED_INTERPOLATION) THEN
150 ! ! ! DOMAIN=>FIELD_VARIABLE%COMPONENTS(component_idx)%DOMAIN
151 ! ! ! IF(ASSOCIATED(DOMAIN)) THEN
152 ! ! ! IF(ASSOCIATED(DOMAIN%TOPOLOGY)) THEN
153 ! ! ! DOMAIN_NODES=>DOMAIN%TOPOLOGY%NODES
154 ! ! ! IF(ASSOCIATED(DOMAIN_NODES)) THEN
155 ! ! ! !Loop over the local nodes excluding the ghosts.
156 ! ! ! DO node_idx=1,DOMAIN_NODES%NUMBER_OF_NODES
157 ! ! ! !!TODO \todo We should interpolate the geometric field here and the node position.
158 ! ! ! DO dim_idx=1,NUMBER_OF_DIMENSIONS
159 ! ! ! local_ny=GEOMETRIC_VARIABLE%COMPONENTS(dim_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP(1,node_idx)
160 ! ! ! X(dim_idx)=GEOMETRIC_PARAMETERS(local_ny)
161 ! ! ! ENDDO !dim_idx
162 ! ! ! !Loop over the derivatives
163 ! ! ! DO deriv_idx=1,DOMAIN_NODES%NODES(node_idx)%NUMBER_OF_DERIVATIVES
164 ! ! ! SELECT CASE(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE)
165 ! ! ! CASE(EQUATIONS_SET_FITTING_TWO_DIM_1)
166 ! ! ! !u=x^2+2.x.y-y^2
167 ! ! ! SELECT CASE(variable_type)
168 ! ! ! CASE(FIELD_U_VARIABLE_TYPE)
169 ! ! ! SELECT CASE(DOMAIN_NODES%NODES(node_idx)%GLOBAL_DERIVATIVE_INDEX(deriv_idx))
170 ! ! ! CASE(NO_GLOBAL_DERIV)
171 ! ! ! VALUE=X(1)*X(1)-2.0_DP*X(1)*X(2)-X(2)*X(2)
172 ! ! ! CASE(GLOBAL_DERIV_S1)
173 ! ! ! VALUE=2.0_DP*X(1)+2.0_DP*X(2)
174 ! ! ! CASE(GLOBAL_DERIV_S2)
175 ! ! ! VALUE=2.0_DP*X(1)-2.0_DP*X(2)
176 ! ! ! CASE(GLOBAL_DERIV_S1_S2)
177 ! ! ! VALUE=2.0_DP
178 ! ! ! CASE DEFAULT
179 ! ! ! LOCAL_ERROR="The global derivative index of "//TRIM(NUMBER_TO_VSTRING( &
180 ! ! ! DOMAIN_NODES%NODES(node_idx)%GLOBAL_DERIVATIVE_INDEX(deriv_idx),"*",ERR,ERROR))// &
181 ! ! ! & " is invalid."
182 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
183 ! ! ! END SELECT
184 ! ! ! CASE(FIELD_DELUDELN_VARIABLE_TYPE)
185 ! ! ! SELECT CASE(DOMAIN_NODES%NODES(node_idx)%GLOBAL_DERIVATIVE_INDEX(deriv_idx))
186 ! ! ! CASE(NO_GLOBAL_DERIV)
187 ! ! ! VALUE=0.0_DP !!TODO
188 ! ! ! CASE(GLOBAL_DERIV_S1)
189 ! ! ! CALL FlagError("Not implemented.",ERR,ERROR,*999)
190 ! ! ! CASE(GLOBAL_DERIV_S2)
191 ! ! ! CALL FlagError("Not implemented.",ERR,ERROR,*999)
192 ! ! ! CASE(GLOBAL_DERIV_S1_S2)
193 ! ! ! CALL FlagError("Not implemented.",ERR,ERROR,*999)
194 ! ! ! CASE DEFAULT
195 ! ! ! LOCAL_ERROR="The global derivative index of "//TRIM(NUMBER_TO_VSTRING( &
196 ! ! ! DOMAIN_NODES%NODES(node_idx)%GLOBAL_DERIVATIVE_INDEX(deriv_idx),"*",ERR,ERROR))// &
197 ! ! ! & " is invalid."
198 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
199 ! ! ! END SELECT
200 ! ! ! CASE DEFAULT
201 ! ! ! LOCAL_ERROR="The variable type of "//TRIM(NUMBER_TO_VSTRING(variable_type,"*",ERR,ERROR))// &
202 ! ! ! & " is invalid."
203 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
204 ! ! ! END SELECT
205 ! ! ! CASE(EQUATIONS_SET_FITTING_TWO_DIM_2)
206 ! ! ! !u=cos(x).cosh(y)
207 ! ! ! SELECT CASE(variable_type)
208 ! ! ! CASE(FIELD_U_VARIABLE_TYPE)
209 ! ! ! SELECT CASE(DOMAIN_NODES%NODES(node_idx)%GLOBAL_DERIVATIVE_INDEX(deriv_idx))
210 ! ! ! CASE(NO_GLOBAL_DERIV)
211 ! ! ! VALUE=COS(X(1))*COSH(X(2))
212 ! ! ! CASE(GLOBAL_DERIV_S1)
213 ! ! ! VALUE=-SIN(X(1))*COSH(X(2))
214 ! ! ! CASE(GLOBAL_DERIV_S2)
215 ! ! ! VALUE=COS(X(1))*SINH(X(2))
216 ! ! ! CASE(GLOBAL_DERIV_S1_S2)
217 ! ! ! VALUE=-SIN(X(1))*SINH(X(2))
218 ! ! ! CASE DEFAULT
219 ! ! ! LOCAL_ERROR="The global derivative index of "//TRIM(NUMBER_TO_VSTRING( &
220 ! ! ! DOMAIN_NODES%NODES(node_idx)%GLOBAL_DERIVATIVE_INDEX(deriv_idx),"*",ERR,ERROR))// &
221 ! ! ! & " is invalid."
222 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
223 ! ! ! END SELECT
224 ! ! ! CASE(FIELD_DELUDELN_VARIABLE_TYPE)
225 ! ! ! SELECT CASE(DOMAIN_NODES%NODES(node_idx)%GLOBAL_DERIVATIVE_INDEX(deriv_idx))
226 ! ! ! CASE(NO_GLOBAL_DERIV)
227 ! ! ! VALUE=0.0_DP !!TODO
228 ! ! ! CASE(GLOBAL_DERIV_S1)
229 ! ! ! !CALL FlagError("Not implemented.",ERR,ERROR,*999)
230 ! ! ! CASE(GLOBAL_DERIV_S2)
231 ! ! ! !CALL FlagError("Not implemented.",ERR,ERROR,*999)
232 ! ! ! CASE(GLOBAL_DERIV_S1_S2)
233 ! ! ! !CALL FlagError("Not implemented.",ERR,ERROR,*999)
234 ! ! ! CASE DEFAULT
235 ! ! ! LOCAL_ERROR="The global derivative index of "//TRIM(NUMBER_TO_VSTRING( &
236 ! ! ! DOMAIN_NODES%NODES(node_idx)%GLOBAL_DERIVATIVE_INDEX(deriv_idx),"*",ERR,ERROR))// &
237 ! ! ! & " is invalid."
238 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
239 ! ! ! END SELECT
240 ! ! ! CASE DEFAULT
241 ! ! ! LOCAL_ERROR="The variable type of "//TRIM(NUMBER_TO_VSTRING(variable_type,"*",ERR,ERROR))// &
242 ! ! ! & " is invalid."
243 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
244 ! ! ! END SELECT
245 ! ! ! CASE(EQUATIONS_SET_FITTING_THREE_DIM_1)
246 ! ! ! !u=x^2+y^2-2.z^2
247 ! ! ! SELECT CASE(variable_type)
248 ! ! ! CASE(FIELD_U_VARIABLE_TYPE)
249 ! ! ! SELECT CASE(DOMAIN_NODES%NODES(node_idx)%GLOBAL_DERIVATIVE_INDEX(deriv_idx))
250 ! ! ! CASE(NO_GLOBAL_DERIV)
251 ! ! ! VALUE=X(1)*X(1)+X(2)*X(2)-2.0_DP*X(3)*X(3)
252 ! ! ! CASE(GLOBAL_DERIV_S1)
253 ! ! ! VALUE=2.0_DP*X(1)
254 ! ! ! CASE(GLOBAL_DERIV_S2)
255 ! ! ! VALUE=2.0_DP*X(2)
256 ! ! ! CASE(GLOBAL_DERIV_S1_S2)
257 ! ! ! VALUE=0.0_DP
258 ! ! ! CASE(GLOBAL_DERIV_S3)
259 ! ! ! VALUE=-4.0_DP*X(3)
260 ! ! ! CASE(GLOBAL_DERIV_S1_S3)
261 ! ! ! VALUE=0.0_DP
262 ! ! ! CASE(GLOBAL_DERIV_S2_S3)
263 ! ! ! VALUE=0.0_DP
264 ! ! ! CASE(GLOBAL_DERIV_S1_S2_S3)
265 ! ! ! VALUE=0.0_DP
266 ! ! ! CASE DEFAULT
267 ! ! ! LOCAL_ERROR="The global derivative index of "//TRIM(NUMBER_TO_VSTRING( &
268 ! ! ! DOMAIN_NODES%NODES(node_idx)%GLOBAL_DERIVATIVE_INDEX(deriv_idx),"*",ERR,ERROR))// &
269 ! ! ! & " is invalid."
270 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
271 ! ! ! END SELECT
272 ! ! ! CASE(FIELD_DELUDELN_VARIABLE_TYPE)
273 ! ! ! SELECT CASE(DOMAIN_NODES%NODES(node_idx)%GLOBAL_DERIVATIVE_INDEX(deriv_idx))
274 ! ! ! CASE(NO_GLOBAL_DERIV)
275 ! ! ! VALUE=0.0_DP !!TODO
276 ! ! ! CASE(GLOBAL_DERIV_S1)
277 ! ! ! CALL FlagError("Not implemented.",ERR,ERROR,*999)
278 ! ! ! CASE(GLOBAL_DERIV_S2)
279 ! ! ! CALL FlagError("Not implemented.",ERR,ERROR,*999)
280 ! ! ! CASE(GLOBAL_DERIV_S1_S2)
281 ! ! ! CALL FlagError("Not implemented.",ERR,ERROR,*999)
282 ! ! ! CASE(GLOBAL_DERIV_S3)
283 ! ! ! CALL FlagError("Not implemented.",ERR,ERROR,*999)
284 ! ! ! CASE(GLOBAL_DERIV_S1_S3)
285 ! ! ! CALL FlagError("Not implemented.",ERR,ERROR,*999)
286 ! ! ! CASE(GLOBAL_DERIV_S2_S3)
287 ! ! ! CALL FlagError("Not implemented.",ERR,ERROR,*999)
288 ! ! ! CASE(GLOBAL_DERIV_S1_S2_S3)
289 ! ! ! CALL FlagError("Not implemented.",ERR,ERROR,*999)
290 ! ! ! CASE DEFAULT
291 ! ! ! LOCAL_ERROR="The global derivative index of "//TRIM(NUMBER_TO_VSTRING( &
292 ! ! ! DOMAIN_NODES%NODES(node_idx)%GLOBAL_DERIVATIVE_INDEX(deriv_idx),"*",ERR,ERROR))// &
293 ! ! ! & " is invalid."
294 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
295 ! ! ! END SELECT
296 ! ! ! CASE DEFAULT
297 ! ! ! LOCAL_ERROR="The variable type of "//TRIM(NUMBER_TO_VSTRING(variable_type,"*",ERR,ERROR))// &
298 ! ! ! & " is invalid."
299 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
300 ! ! ! END SELECT
301 ! ! ! CASE(EQUATIONS_SET_FITTING_THREE_DIM_2)
302 ! ! ! !u=cos(x).cosh(y).z
303 ! ! ! SELECT CASE(variable_type)
304 ! ! ! CASE(FIELD_U_VARIABLE_TYPE)
305 ! ! ! SELECT CASE(DOMAIN_NODES%NODES(node_idx)%GLOBAL_DERIVATIVE_INDEX(deriv_idx))
306 ! ! ! CASE(NO_GLOBAL_DERIV)
307 ! ! ! VALUE=COS(X(1))*COSH(X(2))*X(3)
308 ! ! ! CASE(GLOBAL_DERIV_S1)
309 ! ! ! VALUE=-SIN(X(1))*COSH(X(2))*X(3)
310 ! ! ! CASE(GLOBAL_DERIV_S2)
311 ! ! ! VALUE=COS(X(1))*SINH(X(2))*X(3)
312 ! ! ! CASE(GLOBAL_DERIV_S1_S2)
313 ! ! ! VALUE=-SIN(X(1))*SINH(X(2))*X(3)
314 ! ! ! CASE(GLOBAL_DERIV_S3)
315 ! ! ! VALUE=COS(X(1))*COSH(X(2))
316 ! ! ! CASE(GLOBAL_DERIV_S1_S3)
317 ! ! ! VALUE=-SIN(X(1))*COSH(X(2))
318 ! ! ! CASE(GLOBAL_DERIV_S2_S3)
319 ! ! ! VALUE=COS(X(1))*SINH(X(2))
320 ! ! ! CASE(GLOBAL_DERIV_S1_S2_S3)
321 ! ! ! VALUE=-SIN(X(1))*SINH(X(2))
322 ! ! ! CASE DEFAULT
323 ! ! ! LOCAL_ERROR="The global derivative index of "//TRIM(NUMBER_TO_VSTRING( &
324 ! ! ! DOMAIN_NODES%NODES(node_idx)%GLOBAL_DERIVATIVE_INDEX(deriv_idx),"*",ERR,ERROR))// &
325 ! ! ! & " is invalid."
326 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
327 ! ! ! END SELECT
328 ! ! ! CASE(FIELD_DELUDELN_VARIABLE_TYPE)
329 ! ! ! SELECT CASE(DOMAIN_NODES%NODES(node_idx)%GLOBAL_DERIVATIVE_INDEX(deriv_idx))
330 ! ! ! CASE(NO_GLOBAL_DERIV)
331 ! ! ! VALUE=0.0_DP !!TODO
332 ! ! ! CASE(GLOBAL_DERIV_S1)
333 ! ! ! !CALL FlagError("Not implemented.",ERR,ERROR,*999)
334 ! ! ! CASE(GLOBAL_DERIV_S2)
335 ! ! ! !CALL FlagError("Not implemented.",ERR,ERROR,*999)
336 ! ! ! CASE(GLOBAL_DERIV_S1_S2)
337 ! ! ! !CALL FlagError("Not implemented.",ERR,ERROR,*999)
338 ! ! ! CASE(GLOBAL_DERIV_S3)
339 ! ! ! !CALL FlagError("Not implemented.",ERR,ERROR,*999)
340 ! ! ! CASE(GLOBAL_DERIV_S1_S3)
341 ! ! ! !CALL FlagError("Not implemented.",ERR,ERROR,*999)
342 ! ! ! CASE(GLOBAL_DERIV_S2_S3)
343 ! ! ! !CALL FlagError("Not implemented.",ERR,ERROR,*999)
344 ! ! ! CASE(GLOBAL_DERIV_S1_S2_S3)
345 ! ! ! !CALL FlagError("Not implemented.",ERR,ERROR,*999)
346 ! ! ! CASE DEFAULT
347 ! ! ! LOCAL_ERROR="The global derivative index of "//TRIM(NUMBER_TO_VSTRING( &
348 ! ! ! DOMAIN_NODES%NODES(node_idx)%GLOBAL_DERIVATIVE_INDEX(deriv_idx),"*",ERR,ERROR))// &
349 ! ! ! & " is invalid."
350 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
351 ! ! ! END SELECT
352 ! ! ! CASE DEFAULT
353 ! ! ! LOCAL_ERROR="The variable type of "//TRIM(NUMBER_TO_VSTRING(variable_type,"*",ERR,ERROR))// &
354 ! ! ! & " is invalid."
355 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
356 ! ! ! END SELECT
357 ! ! ! CASE DEFAULT
358 ! ! ! LOCAL_ERROR="The analytic function type of "// &
359 ! ! ! & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE,"*",ERR,ERROR))// &
360 ! ! ! & " is invalid."
361 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
362 ! ! ! END SELECT
363 ! ! ! local_ny=FIELD_VARIABLE%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
364 ! ! ! & NODE_PARAM2DOF_MAP(deriv_idx,node_idx)
365 ! ! ! CALL FIELD_PARAMETER_SET_UPDATE_LOCAL_DOF(DEPENDENT_FIELD,variable_type, &
366 ! ! ! & FIELD_ANALYTIC_VALUES_SET_TYPE,local_ny,VALUE,ERR,ERROR,*999)
367 ! ! ! IF(variable_type==FIELD_U_VARIABLE_TYPE) THEN
368 ! ! ! IF(DOMAIN_NODES%NODES(node_idx)%BOUNDARY_NODE) THEN
369 ! ! ! !If we are a boundary node then set the analytic value on the boundary
370 ! ! ! CALL BOUNDARY_CONDITIONS_SET_LOCAL_DOF(BOUNDARY_CONDITIONS,variable_type,local_ny, &
371 ! ! ! & BOUNDARY_CONDITION_FIXED,VALUE,ERR,ERROR,*999)
372 ! ! ! ENDIF
373 ! ! ! ENDIF
374 ! ! ! ENDDO !deriv_idx
375 ! ! ! ENDDO !node_idx
376 ! ! ! ELSE
377 ! ! ! CALL FlagError("Domain topology nodes is not associated.",ERR,ERROR,*999)
378 ! ! ! ENDIF
379 ! ! ! ELSE
380 ! ! ! CALL FlagError("Domain topology is not associated.",ERR,ERROR,*999)
381 ! ! ! ENDIF
382 ! ! ! ELSE
383 ! ! ! CALL FlagError("Domain is not associated.",ERR,ERROR,*999)
384 ! ! ! ENDIF
385 ! ! ! ELSE
386 ! ! ! CALL FlagError("Only node based interpolation is implemented.",ERR,ERROR,*999)
387 ! ! ! ENDIF
388 ! ! ! ENDDO !component_idx
389 ! ! ! CALL FIELD_PARAMETER_SET_UPDATE_START(DEPENDENT_FIELD,variable_type,FIELD_ANALYTIC_VALUES_SET_TYPE, &
390 ! ! ! & ERR,ERROR,*999)
391 ! ! ! CALL FIELD_PARAMETER_SET_UPDATE_FINISH(DEPENDENT_FIELD,variable_type,FIELD_ANALYTIC_VALUES_SET_TYPE, &
392 ! ! ! & ERR,ERROR,*999)
393 ! ! ! ELSE
394 ! ! ! CALL FlagError("Field variable is not associated.",ERR,ERROR,*999)
395 ! ! ! ENDIF
396 ! ! !
397 ! ! ! ENDDO !variable_idx
398 ! ! ! CALL BOUNDARY_CONDITIONS_CREATE_FINISH(BOUNDARY_CONDITIONS,ERR,ERROR,*999)
399 ! ! ! CALL FIELD_PARAMETER_SET_DATA_RESTORE(GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, &
400 ! ! ! & GEOMETRIC_PARAMETERS,ERR,ERROR,*999)
401 ! ! ! ELSE
402 ! ! ! CALL FlagError("Equations set geometric field is not associated.",ERR,ERROR,*999)
403 ! ! ! ENDIF
404 ! ! ! ELSE
405 ! ! ! CALL FlagError("Equations set dependent field is not associated.",ERR,ERROR,*999)
406 ! ! ! ENDIF
407 ! ! ! ELSE
408 ! ! ! CALL FlagError("Equations set analytic is not associated.",ERR,ERROR,*999)
409 ! ! ! ENDIF
410 ! ! ! ELSE
411 ! ! ! CALL FlagError("Equations set is not associated.",ERR,ERROR,*999)
412 ! ! ! ENDIF
413 ! ! !
414 ! ! ! EXITS("FITTING_ANALYTIC_CALCULATE")
415 ! ! ! RETURN
416 ! ! ! 999 ERRORSEXITS("FITTING_ANALYTIC_CALCULATE",ERR,ERROR)
417 ! ! ! RETURN 1
418 ! ! ! END SUBROUTINE FITTING_ANALYTIC_CALCULATE
419 
420  !
421  !================================================================================================================================
422  !
423 
425  SUBROUTINE fitting_finite_element_calculate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
426 
427  !Argument variables
428  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
429  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
430  INTEGER(INTG), INTENT(OUT) :: ERR
431  TYPE(varying_string), INTENT(OUT) :: ERROR
432  !Local Variables
433  INTEGER(INTG) :: FIELD_VAR_TYPE,ng,mh,mhs,ms,nh,nhs,ns,mi,ni
434  REAL(DP) :: RWG,SUM,jacobianGaussWeight
435  REAL(DP) :: PGM,PGN,PGMSI(3),PGNSI(3)
436  REAL(DP) :: U_VALUE(3)
437  TYPE(data_projection_type), POINTER :: dataProjection
438  TYPE(decomposition_topology_type), POINTER :: decompositionTopology
439  TYPE(decompositiondatapointstype), POINTER :: dataPoints
440  TYPE(basis_type), POINTER :: DEPENDENT_BASIS,GEOMETRIC_BASIS,SOURCE_BASIS,DEPENDENT_BASIS1,DEPENDENT_BASIS2
441  TYPE(equations_type), POINTER :: EQUATIONS
442  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
443  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
444  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
445  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
446  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
447  TYPE(equations_matrices_source_type), POINTER :: SOURCE_VECTOR
448  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
449  TYPE(field_type), POINTER :: GEOMETRIC_FIELD,DEPENDENT_FIELD,MATERIALS_FIELD,SOURCE_FIELD
450  TYPE(field_type), POINTER :: independentField
451  TYPE(field_variable_type), POINTER :: fieldVariable
452  TYPE(field_variable_type), POINTER :: mappingVariable
453  TYPE(field_interpolated_point_type), POINTER :: MATERIALS_INTERPOLATED_POINT
454  TYPE(field_interpolated_point_type), POINTER :: GEOMETRIC_INTERPOLATED_POINT
455  TYPE(field_interpolated_point_type), POINTER :: REFERENCE_GEOMETRIC_INTERPOLATED_POINT
456  TYPE(quadrature_scheme_type), POINTER :: QUADRATURE_SCHEME,QUADRATURE_SCHEME1,QUADRATURE_SCHEME2
457  TYPE(varying_string) :: localError
458 
459  REAL(DP), POINTER :: independentVectorParameters(:),independentWeightParameters(:)
460  REAL(DP), ALLOCATABLE :: projectionXi(:)
461  REAL(DP):: POROSITY_0, POROSITY, PERM_OVER_VIS_PARAM_0, PERM_OVER_VIS_PARAM,TAU_PARAM,KAPPA_PARAM
462  REAL(DP):: tension,curvature
463  REAL(DP):: MATERIAL_FACT
464  REAL(DP):: DXDY(3,3), DXDXI(3,3), DYDXI(3,3), DXIDY(3,3), DXI_DX(3,3)
465  REAL(DP):: Jxy, Jyxi
466  REAL(DP):: dataPointWeight,dataPointVector(3)
467  INTEGER(INTG) :: derivative_idx, component_idx, xi_idx, NUMBER_OF_DIMENSIONS
468  INTEGER(INTG) :: dataPointIdx,dataPointUserNumber,dataPointLocalNumber,dataPointGlobalNumber
469  INTEGER(INTG) :: numberOfXi
470  INTEGER(INTG) :: componentIdx
471  INTEGER(INTG) :: variableType,localDof
472 
473  INTEGER(INTG) NDOFS
474  INTEGER(INTG) MESH_COMPONENT1,MESH_COMPONENT2
475 
476 
477 
478  enters("FITTING_FINITE_ELEMENT_CALCULATE",err,error,*999)
479 
480  NULLIFY(dependent_basis,geometric_basis)
481  NULLIFY(equations)
482  NULLIFY(equations_mapping)
483  NULLIFY(linear_mapping)
484  NULLIFY(equations_matrices)
485  NULLIFY(linear_matrices)
486  NULLIFY(rhs_vector)
487  NULLIFY(equations_matrix)
488  NULLIFY(dependent_field,geometric_field,materials_field)
489  NULLIFY(datapoints)
490  NULLIFY(dataprojection)
491  NULLIFY(decompositiontopology)
492  NULLIFY(independentfield)
493  NULLIFY(independentvectorparameters)
494  NULLIFY(independentweightparameters)
495  NULLIFY(fieldvariable)
496  NULLIFY(mappingvariable)
497  NULLIFY(quadrature_scheme)
498  NULLIFY(geometric_interpolated_point,materials_interpolated_point)
499 
500  datapointvector = 0.0_dp
501 
502  IF(ASSOCIATED(equations_set)) THEN
503  equations=>equations_set%EQUATIONS
504  IF(ASSOCIATED(equations)) THEN
505  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
506  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
507  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
508  CALL flagerror("Equations set specification must have three entries for a fitting type equations set.", &
509  & err,error,*999)
510  END IF
511  SELECT CASE(equations_set%SPECIFICATION(3))
512  CASE(equationsset_datapointvectorstaticfittingsubtype, &
513  & equationsset_datapointvectorquasistaticfittingsubtype)
514  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
515  independentfield=>equations%INTERPOLATION%INDEPENDENT_FIELD
516  dataprojection=>independentfield%dataProjection
517  IF(.NOT.ASSOCIATED(dataprojection)) THEN
518  localerror="Data projection is not associated on independent field."
519  CALL flagerror(localerror,err,error,*999)
520  ENDIF
521  decompositiontopology=>independentfield%decomposition%topology
522  IF(ASSOCIATED(decompositiontopology)) THEN
523  datapoints=>decompositiontopology%dataPoints
524  IF(.NOT.ASSOCIATED(datapoints)) THEN
525  localerror="Data points are not associated on the decomposition topology of the independent field."
526  CALL flagerror(localerror,err,error,*999)
527  ENDIF
528  ELSE
529  localerror="Decomposition topology is not associated on the independent field."
530  CALL flagerror(localerror,err,error,*999)
531  ENDIF
532  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
533  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
534  equations_matrices=>equations%EQUATIONS_MATRICES
535  linear_matrices=>equations_matrices%LINEAR_MATRICES
536  equations_matrix=>linear_matrices%MATRICES(1)%PTR
537  rhs_vector=>equations_matrices%RHS_VECTOR
538  equations_mapping=>equations%EQUATIONS_MAPPING
539  linear_mapping=>equations_mapping%LINEAR_MAPPING
540  mappingvariable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(1)%VARIABLE
541  field_var_type=mappingvariable%VARIABLE_TYPE
542  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
543  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
544  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
545  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
546  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
547  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
548  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
549  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
550  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
551  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
552  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
553  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
554  numberofxi = dependent_basis%NUMBER_OF_XI
555  ALLOCATE(projectionxi(numberofxi))
556  projectionxi=0.0_dp
557  ! Get data point vector parameters
558  CALL field_parameter_set_data_get(independentfield,field_u_variable_type,field_values_set_type, &
559  & independentvectorparameters,err,error,*999)
560  ! Get data point weight parameters
561  CALL field_parameter_set_data_get(independentfield,field_v_variable_type,field_values_set_type, &
562  & independentweightparameters,err,error,*999)
563 
564  !===========================================
565  ! D a t a P o i n t V e c t o r F i t
566  !===========================================
567  !Loop over data points
568  DO datapointidx=1,datapoints%elementDataPoint(element_number)%numberOfProjectedData
569  datapointusernumber = datapoints%elementDataPoint(element_number)%dataIndices(datapointidx)%userNumber
570  datapointlocalnumber = datapoints%elementDataPoint(element_number)%dataIndices(datapointidx)%localNumber
571  datapointglobalnumber = datapoints%elementDataPoint(element_number)%dataIndices(datapointidx)%globalNumber
572  ! Need to use global number to get the correct projection results
573  projectionxi = dataprojection%data_projection_results(datapointglobalnumber)%xi
574  CALL field_interpolate_xi(first_part_deriv,projectionxi,equations%INTERPOLATION% &
575  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
576  CALL field_interpolate_xi(first_part_deriv,projectionxi,equations%INTERPOLATION% &
577  & dependent_interp_point(field_u_variable_type)%PTR,err,error,*999)
578  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
579  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
580 
581  ! Get data point vector value
582  variabletype=independentfield%VARIABLES(1)%VARIABLE_TYPE
583  fieldvariable=>independentfield%VARIABLE_TYPE_MAP(variabletype)%PTR
584  DO componentidx=1,numberofxi
585  localdof=fieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP% &
586  & data_point_param2dof_map%DATA_POINTS(datapointlocalnumber)
587  datapointvector(componentidx)=independentvectorparameters(localdof)
588  ENDDO
589 
590  variabletype=independentfield%VARIABLES(2)%VARIABLE_TYPE
591  fieldvariable=>independentfield%VARIABLE_TYPE_MAP(variabletype)%PTR
592  localdof=fieldvariable%COMPONENTS(1)%PARAM_TO_DOF_MAP% &
593  & data_point_param2dof_map%DATA_POINTS(datapointlocalnumber)
594  datapointweight=independentweightparameters(localdof)
595 
596  mhs=0
597  !Loop over element rows
598  DO mh=1,mappingvariable%NUMBER_OF_COMPONENTS
599  mesh_component1=mappingvariable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
600  dependent_basis1=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component1)%PTR% &
601  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
602  DO ms=1,dependent_basis1%NUMBER_OF_ELEMENT_PARAMETERS
603  mhs=mhs+1
604  nhs=0
605  pgm=basis_evaluate_xi(dependent_basis1,ms,no_part_deriv,projectionxi,err,error)
606  IF(equations_matrix%UPDATE_MATRIX) THEN
607  !Loop over element columns
608  DO nh=1,mappingvariable%NUMBER_OF_COMPONENTS
609  mesh_component2=mappingvariable%COMPONENTS(nh)%MESH_COMPONENT_NUMBER
610  dependent_basis2=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component2)%PTR% &
611  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
612  DO ns=1,dependent_basis2%NUMBER_OF_ELEMENT_PARAMETERS
613  nhs=nhs+1
614  pgn=basis_evaluate_xi(dependent_basis2,ns,no_part_deriv,projectionxi,err,error)
615  sum=0.0_dp
616  IF(mh==nh) THEN
617  sum = sum + pgm * pgn * datapointweight
618  ENDIF
619  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum
620  ENDDO !ns
621  ENDDO !nh
622  ENDIF
623  sum=0.0_dp
624  IF(rhs_vector%UPDATE_VECTOR) THEN
625  sum = sum + pgm*datapointvector(mh)*datapointweight
626  rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=rhs_vector%ELEMENT_VECTOR%VECTOR(mhs) + sum
627  ENDIF
628  ENDDO !ms
629  ENDDO !mh
630  ENDDO !dataPointIdx
631 
632  !Restore data point vector parameters
633  CALL field_parameter_set_data_restore(independentfield,field_u_variable_type,field_values_set_type, &
634  & independentvectorparameters,err,error,*999)
635  !Restore data point weight parameters
636  CALL field_parameter_set_data_restore(independentfield,field_v_variable_type,field_values_set_type, &
637  & independentweightparameters,err,error,*999)
638 
639  !===========================================
640  ! S o b e l o v S m o o t h i n g
641  !===========================================
642  !Loop over gauss points
643  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
644  CALL field_interpolate_gauss(second_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
645  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
646  CALL field_interpolate_gauss(second_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
647  & dependent_interp_point(field_var_type)%PTR,err,error,*999)
648  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
649  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
650  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
651  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
652  tau_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,no_part_deriv)
653  kappa_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,no_part_deriv)
654  !Loop over field components
655  jacobiangaussweight=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
656  & quadrature_scheme%GAUSS_WEIGHTS(ng)
657 
658  mhs=0
659  DO mh=1,mappingvariable%NUMBER_OF_COMPONENTS
660  !Loop over element rows
661  mesh_component1=mappingvariable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
662  dependent_basis1=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component1)%PTR% &
663  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
664  quadrature_scheme1=>dependent_basis1%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
665  DO ms=1,dependent_basis1%NUMBER_OF_ELEMENT_PARAMETERS
666  mhs=mhs+1
667  nhs=0
668  IF(equations_matrix%UPDATE_MATRIX) THEN
669  !Loop over element columns
670  DO nh=1,mappingvariable%NUMBER_OF_COMPONENTS
671  mesh_component2=mappingvariable%COMPONENTS(nh)%MESH_COMPONENT_NUMBER
672  dependent_basis2=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component2)%PTR% &
673  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
674  quadrature_scheme2=>dependent_basis2%QUADRATURE%QUADRATURE_SCHEME_MAP &
675  & (basis_default_quadrature_scheme)%PTR
676  DO ns=1,dependent_basis2%NUMBER_OF_ELEMENT_PARAMETERS
677  nhs=nhs+1
678  sum = 0.0_dp
679 
680  !Calculate sobelov surface tension and curvature smoothing terms
681  tension = tau_param*2.0_dp* ( &
682  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s1,ng)* &
683  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s1,ng))
684  curvature = kappa_param*2.0_dp* ( &
685  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s1_s1,ng)* &
686  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s1_s1,ng))
687 
688  IF(mappingvariable%NUMBER_OF_COMPONENTS > 1) THEN
689  tension = tension + tau_param*2.0_dp* ( &
690  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s2,ng)* &
691  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s2,ng))
692  curvature = curvature + kappa_param*2.0_dp* ( &
693  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s2_s2,ng)* &
694  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s2_s2,ng) + &
695  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s1_s2,ng)* &
696  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s1_s2,ng))
697 
698  IF(mappingvariable%NUMBER_OF_COMPONENTS > 2) THEN
699  tension = tension + tau_param*2.0_dp* ( &
700  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s3,ng)* &
701  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s3,ng))
702  curvature = curvature + kappa_param*2.0_dp* ( &
703  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s3_s3,ng)* &
704  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s3_s3,ng)+ &
705  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s1_s3,ng)* &
706  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s1_s3,ng)+ &
707  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s2_s3,ng)* &
708  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s2_s3,ng))
709  ENDIF ! 3D
710  ENDIF ! 2 or 3D
711 
712  ! Add in smoothing terms to the element matrix
713  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs) = &
714  & equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs) + (tension + curvature) * jacobiangaussweight
715 
716  ENDDO !ns
717  ENDDO !nh
718  ENDIF ! update matrix
719  ENDDO !ms
720  ENDDO !mh
721  ENDDO !ng
722 
723  !Scale factor adjustment
724  IF(dependent_field%SCALINGS%SCALING_TYPE/=field_no_scaling) THEN
725  CALL field_interpolationparametersscalefactorselementget(element_number,equations%INTERPOLATION% &
726  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
727  mhs=0
728  DO mh=1,mappingvariable%NUMBER_OF_COMPONENTS
729  !Loop over element rows
730  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
731  mhs=mhs+1
732  nhs=0
733  IF(equations_matrix%UPDATE_MATRIX) THEN
734  !Loop over element columns
735  DO nh=1,mappingvariable%NUMBER_OF_COMPONENTS
736  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
737  nhs=nhs+1
738  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)* &
739  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)* &
740  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
741  ENDDO !ns
742  ENDDO !nh
743  ENDIF
744  IF(rhs_vector%UPDATE_VECTOR) THEN
745  rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)* &
746  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)
747  ENDIF
748  ENDDO !ms
749  ENDDO !mh
750  ENDIF
751 
752  CASE(equations_set_standard_data_fitting_subtype)
753 !!TODO: move these and scale factor adjustment out once generalised Galerkin projection is put in.
754  !Store all these in equations matrices/somewhere else?????
755  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
756  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
757  equations_matrices=>equations%EQUATIONS_MATRICES
758  linear_matrices=>equations_matrices%LINEAR_MATRICES
759  equations_matrix=>linear_matrices%MATRICES(1)%PTR
760  rhs_vector=>equations_matrices%RHS_VECTOR
761  equations_mapping=>equations%EQUATIONS_MAPPING
762  linear_mapping=>equations_mapping%LINEAR_MAPPING
763  fieldvariable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(1)%VARIABLE
764  field_var_type=fieldvariable%VARIABLE_TYPE
765  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
766  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
767  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
768  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
769  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
770  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
771  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
772  !Loop over gauss points
773  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
774  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
775  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
776  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
777  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
778  !Calculate RWG.
779 !!TODO: Think about symmetric problems.
780  rwg=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
781  & quadrature_scheme%GAUSS_WEIGHTS(ng)
782  !Loop over field components
783  mhs=0
784  DO mh=1,fieldvariable%NUMBER_OF_COMPONENTS
785  !Loop over element rows
786 !!TODO: CHANGE ELEMENT CALCULATE TO WORK OF ns ???
787  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
788  mhs=mhs+1
789  nhs=0
790  IF(equations_matrix%UPDATE_MATRIX) THEN
791  !Loop over element columns
792  DO nh=1,fieldvariable%NUMBER_OF_COMPONENTS
793  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
794  nhs=nhs+1
795 
796  pgm=quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
797  pgn=quadrature_scheme%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)
798 
799  sum = 0.0_dp
800  IF(mh==nh) THEN
801  sum = sum + pgm * pgn
802  ENDIF
803  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs) = &
804  & equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs) + sum * rwg
805  ENDDO !ns
806  ENDDO !nh
807  ENDIF
808  IF(rhs_vector%UPDATE_VECTOR) rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=0.0_dp
809  ENDDO !ms
810  ENDDO !mh
811  ENDDO !ng
812 
813  !Scale factor adjustment
814  IF(dependent_field%SCALINGS%SCALING_TYPE/=field_no_scaling) THEN
815  CALL field_interpolationparametersscalefactorselementget(element_number,equations%INTERPOLATION% &
816  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
817  mhs=0
818  DO mh=1,fieldvariable%NUMBER_OF_COMPONENTS
819  !Loop over element rows
820  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
821  mhs=mhs+1
822  nhs=0
823  IF(equations_matrix%UPDATE_MATRIX) THEN
824  !Loop over element columns
825  DO nh=1,fieldvariable%NUMBER_OF_COMPONENTS
826  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
827  nhs=nhs+1
828  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)* &
829  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)* &
830  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
831  ENDDO !ns
832  ENDDO !nh
833  ENDIF
834  IF(rhs_vector%UPDATE_VECTOR) rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)* &
835  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)
836  ENDDO !ms
837  ENDDO !mh
838  ENDIF
839 
840  CASE(equations_set_mat_properties_data_fitting_subtype, &
841  & equations_set_mat_properties_inria_model_data_fitting_subtype)
842 !!TODO: move these and scale factor adjustment out once generalised Galerkin projection is put in.
843  !Store all these in equations matrices/somewhere else?????
844  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
845  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
846  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
847 
848  equations_matrices=>equations%EQUATIONS_MATRICES
849  linear_matrices=>equations_matrices%LINEAR_MATRICES
850  equations_matrix=>linear_matrices%MATRICES(1)%PTR
851  rhs_vector=>equations_matrices%RHS_VECTOR
852  equations_mapping=>equations%EQUATIONS_MAPPING
853  linear_mapping=>equations_mapping%LINEAR_MAPPING
854  fieldvariable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(1)%VARIABLE
855  field_var_type=fieldvariable%VARIABLE_TYPE
856 
857  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
858  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
859  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
860  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
861 
862  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number, &
863  & equations%INTERPOLATION%GEOMETRIC_INTERP_PARAMETERS(field_u_variable_type)%PTR,err,error,*999)
864  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number, &
865  & equations%INTERPOLATION%MATERIALS_INTERP_PARAMETERS(field_u_variable_type)%PTR,err,error,*999)
866 
867  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
868 
869  !--- Loop over gauss points
870  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
871 
872  !--- Interpolation of Reference Geometry
873  CALL field_interpolation_parameters_element_get(field_initial_values_set_type,element_number, &
874  & equations%INTERPOLATION%GEOMETRIC_INTERP_PARAMETERS(field_u_variable_type)%PTR,err,error,*999)
875  reference_geometric_interpolated_point=>equations%INTERPOLATION%GEOMETRIC_INTERP_POINT(field_u_variable_type)%PTR
876  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng, &
877  & reference_geometric_interpolated_point,err,error,*999)
878  !--- Retrieve local map DYDXI
879  DO component_idx=1,dependent_basis%NUMBER_OF_XI
880  DO xi_idx=1,dependent_basis%NUMBER_OF_XI
881  derivative_idx=partial_derivative_first_derivative_map(xi_idx) !2,4,7
882  dydxi(component_idx,xi_idx)=reference_geometric_interpolated_point%VALUES(component_idx,derivative_idx) !dy/dxi (y = referential)
883  ENDDO
884  ENDDO
885 
886  !--- Interpolation of (actual) Geometry and Metrics
887  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number, &
888  & equations%INTERPOLATION%GEOMETRIC_INTERP_PARAMETERS(field_u_variable_type)%PTR,err,error,*999)
889  geometric_interpolated_point=>equations%INTERPOLATION%GEOMETRIC_INTERP_POINT(field_u_variable_type)%PTR
890  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng, &
891  & geometric_interpolated_point,err,error,*999)
892  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI, &
893  & equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR,err,error,*999)
894  !--- Retrieve local map DXDXI
895  DO component_idx=1,dependent_basis%NUMBER_OF_XI
896  DO xi_idx=1,dependent_basis%NUMBER_OF_XI
897  derivative_idx=partial_derivative_first_derivative_map(xi_idx) !2,4,7
898  dxdxi(component_idx,xi_idx)=geometric_interpolated_point%VALUES(component_idx,derivative_idx) !dx/dxi
899  ENDDO
900  ENDDO
901 
902  !--- Compute deformation gradient tensor DXDY and its Jacobian Jxy
903  CALL invert(dydxi,dxidy,jyxi,err,error,*999) !dy/dxi -> dxi/dy
904  CALL matrix_product(dxdxi,dxidy,dxdy,err,error,*999) !dx/dxi * dxi/dy = dx/dy (deformation gradient tensor, F)
905  jxy=determinant(dxdy,err,error)
906 
907  !--- Interpolation of Materials Field
908  materials_interpolated_point => equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR
909  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng, &
910  & materials_interpolated_point,err,error,*999)
911 
912  !--- Retrieve reference material parameters:
913  porosity_0 = materials_interpolated_point%VALUES(1,no_part_deriv)
914  perm_over_vis_param_0 = materials_interpolated_point%VALUES(2,no_part_deriv)
915 
916  !--- Material dependence on structural deformation
917  IF( abs(jxy) > 1.0e-10_dp ) THEN
918  porosity = 1.0_dp - ( 1.0_dp - porosity_0 ) / jxy
919  ELSE
920  localerror="Jacobian Jxy is smaller than 1.0E-10_DP."
921  CALL flagerror(localerror,err,error,*999)
922  END IF
923 
924  IF(equations_set%SPECIFICATION(3)==equations_set_mat_properties_inria_model_data_fitting_subtype) THEN
925  perm_over_vis_param = perm_over_vis_param_0
926  ELSE
927  material_fact = ( jxy * porosity / porosity_0 )**2.0_dp
928  perm_over_vis_param = material_fact * perm_over_vis_param_0
929  !material modeling could use gradient information, or solve some PDE
930  END IF
931 
932  IF(diagnostics2) THEN
933  IF(idebug1) THEN
934  CALL write_string_value(diagnostic_output_type,"GEOMETRIC_INTERP_POINT_METRICS%JACOBIAN = ", &
935  & equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN,err,error,*999)
936  CALL write_string_value(diagnostic_output_type,"Jxy = ",jxy,err,error,*999)
937  CALL write_string_value(diagnostic_output_type,"POROSITY = ",porosity,err,error,*999)
938  CALL write_string_value(diagnostic_output_type,"PERM_OVER_VIS_PARAM = ",perm_over_vis_param,err,error,*999)
939  CALL write_string(diagnostic_output_type," ",err,error,*999)
940  idebug1 = .false.
941  ENDIF
942  ENDIF
943 
944 !!TODO: Think about symmetric problems.
945  rwg=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
946  & quadrature_scheme%GAUSS_WEIGHTS(ng)
947 
948  !Loop over field components
949  mhs=0
950  DO mh=1,fieldvariable%NUMBER_OF_COMPONENTS
951  !Loop over element rows
952 !!TODO: CHANGE ELEMENT CALCULATE TO WORK OF ns ???
953  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
954  mhs=mhs+1
955  nhs=0
956  IF(equations_matrix%UPDATE_MATRIX) THEN
957 
958  !Loop over element columns
959  DO nh=1,fieldvariable%NUMBER_OF_COMPONENTS
960  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
961  nhs=nhs+1
962 
963  pgm=quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
964  pgn=quadrature_scheme%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)
965 
966  sum = 0.0_dp
967  IF(mh==nh) THEN
968  sum = sum + pgm * pgn
969  ENDIF
970  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs) = &
971  & equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs) + sum * rwg
972 
973  ENDDO !ns
974  ENDDO !nh
975  ENDIF
976  IF(rhs_vector%UPDATE_VECTOR) THEN
977  pgm=quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
978 
979  sum = 0.0_dp
980  IF(mh==1) THEN
981  sum = sum + pgm * porosity
982  ELSE IF(mh==2) THEN
983  sum = sum + pgm * perm_over_vis_param
984  END IF
985  rhs_vector%ELEMENT_VECTOR%VECTOR(mhs) = rhs_vector%ELEMENT_VECTOR%VECTOR(mhs) + sum * rwg
986  ENDIF
987 
988  ENDDO !ms
989  ENDDO !mh
990  ENDDO !ng
991 
992 
993 !-----------------------------------------------------------------------------------------------------------------------------------
994 ! CHECK STIFFNESS MATRIX AND RHS VECTOR WITH CMHEART
995  IF(diagnostics5) THEN
996  IF( element_number == 1 ) THEN
997  ndofs = 0
998  DO mh=1,fieldvariable%NUMBER_OF_COMPONENTS
999  mesh_component1 = fieldvariable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
1000  dependent_basis1 => dependent_field%DECOMPOSITION%DOMAIN(mesh_component1)%PTR% &
1001  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
1002  ndofs = ndofs + dependent_basis1%NUMBER_OF_ELEMENT_PARAMETERS
1003  END DO
1004 
1005  CALL write_string(diagnostic_output_type,"Element Matrix for element number 1 (Galerkin Projection):",err,error,*999)
1006  DO mhs=1,ndofs
1007  CALL write_string_value(diagnostic_output_type,"row number = ",mhs,err,error,*999)
1008  CALL write_string_vector(diagnostic_output_type,1,1,ndofs,ndofs,ndofs,&
1009  & equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,:), &
1010  & '("",4(X,E13.6))','4(4(X,E13.6))',err,error,*999)
1011  CALL write_string(diagnostic_output_type," ",err,error,*999)
1012  END DO
1013  END IF
1014  END IF
1015 !-----------------------------------------------------------------------------------------------------------------------------------
1016 
1017  !Scale factor adjustment
1018  IF(dependent_field%SCALINGS%SCALING_TYPE/=field_no_scaling) THEN
1019  CALL field_interpolationparametersscalefactorselementget(element_number,equations%INTERPOLATION% &
1020  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
1021  mhs=0
1022  DO mh=1,fieldvariable%NUMBER_OF_COMPONENTS
1023  !Loop over element rows
1024  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
1025  mhs=mhs+1
1026  nhs=0
1027  IF(equations_matrix%UPDATE_MATRIX) THEN
1028  !Loop over element columns
1029  DO nh=1,fieldvariable%NUMBER_OF_COMPONENTS
1030  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
1031  nhs=nhs+1
1032  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)* &
1033  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)* &
1034  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
1035  ENDDO !ns
1036  ENDDO !nh
1037  ENDIF
1038  IF(rhs_vector%UPDATE_VECTOR) rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)* &
1039  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)
1040  ENDDO !ms
1041  ENDDO !mh
1042  ENDIF
1043 
1044  CASE(equations_set_vector_data_fitting_subtype,equations_set_divfree_vector_data_fitting_subtype, &
1045  & equations_set_vector_data_pre_fitting_subtype,equations_set_divfree_vector_data_pre_fitting_subtype)
1046  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
1047  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
1048  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
1049  source_field=>equations%INTERPOLATION%SOURCE_FIELD
1050  equations_matrices=>equations%EQUATIONS_MATRICES
1051  linear_matrices=>equations_matrices%LINEAR_MATRICES
1052  equations_matrix=>linear_matrices%MATRICES(1)%PTR
1053  rhs_vector=>equations_matrices%RHS_VECTOR
1054  source_vector=>equations_matrices%SOURCE_VECTOR
1055  equations_mapping=>equations%EQUATIONS_MAPPING
1056  linear_mapping=>equations_mapping%LINEAR_MAPPING
1057  fieldvariable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(1)%VARIABLE
1058  field_var_type=fieldvariable%VARIABLE_TYPE
1059  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
1060  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
1061  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
1062  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
1063  source_basis=>source_field%DECOMPOSITION%DOMAIN(source_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
1064  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
1065  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
1066  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
1067  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
1068  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
1069  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
1070  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
1071  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
1072  CALL field_number_of_components_get(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
1073  !Loop over gauss points
1074  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
1075 ! CALL FIELD_INTERPOLATE_GAUSS(FIRST_PART_DERIV,BASIS_DEFAULT_QUADRATURE_SCHEME,ng,EQUATIONS%INTERPOLATION% &
1076  CALL field_interpolate_gauss(second_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
1077  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
1078  CALL field_interpolate_gauss(second_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
1079  & dependent_interp_point(field_var_type)%PTR,err,error,*999)
1080  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
1081  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
1082  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
1083  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
1084  tau_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,no_part_deriv)
1085  kappa_param=equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,no_part_deriv)
1086 ! WRITE(*,*)'TAU_PARAM ',TAU_PARAM
1087  u_value=0.0_dp
1088  IF(source_vector%UPDATE_VECTOR) THEN
1089  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number, &
1090  & equations%INTERPOLATION%SOURCE_INTERP_PARAMETERS(field_u_variable_type)%PTR,err,error,*999)
1091  CALL field_interpolate_gauss(second_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
1092  & source_interp_point(field_u_variable_type)%PTR,err,error,*999)
1093  u_value(1)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(1,no_part_deriv)
1094  u_value(2)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,no_part_deriv)
1095  IF(dependent_basis%NUMBER_OF_XI==3) THEN
1096  u_value(3)=equations%INTERPOLATION%SOURCE_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,no_part_deriv)
1097  ENDIF
1098  ENDIF
1099  !Calculate RWG.
1100  rwg=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
1101  & quadrature_scheme%GAUSS_WEIGHTS(ng)
1102  !Loop over field components
1103  mhs=0
1104  DO mh=1,fieldvariable%NUMBER_OF_COMPONENTS
1105  !Loop over element rows
1106  mesh_component1=fieldvariable%COMPONENTS(mh)%MESH_COMPONENT_NUMBER
1107  dependent_basis1=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component1)%PTR% &
1108  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
1109  quadrature_scheme1=>dependent_basis1%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
1110  DO ms=1,dependent_basis1%NUMBER_OF_ELEMENT_PARAMETERS
1111  mhs=mhs+1
1112  nhs=0
1113  IF(equations_matrix%UPDATE_MATRIX) THEN
1114  !Loop over element columns
1115  DO nh=1,fieldvariable%NUMBER_OF_COMPONENTS
1116  mesh_component2=fieldvariable%COMPONENTS(nh)%MESH_COMPONENT_NUMBER
1117  dependent_basis2=>dependent_field%DECOMPOSITION%DOMAIN(mesh_component2)%PTR% &
1118  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
1119  quadrature_scheme2=>dependent_basis2%QUADRATURE%QUADRATURE_SCHEME_MAP &
1120  & (basis_default_quadrature_scheme)%PTR
1121  DO ns=1,dependent_basis2%NUMBER_OF_ELEMENT_PARAMETERS
1122  nhs=nhs+1
1123  pgm=quadrature_scheme1%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
1124  pgn=quadrature_scheme2%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)
1125  DO ni=1,dependent_basis2%NUMBER_OF_XI
1126  DO mi=1,dependent_basis1%NUMBER_OF_XI
1127  dxi_dx(mi,ni)=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR% &
1128  & dxi_dx(mi,ni)
1129  END DO
1130  pgmsi(ni)=quadrature_scheme1%GAUSS_BASIS_FNS(ms,partial_derivative_first_derivative_map(ni),ng)
1131  pgnsi(ni)=quadrature_scheme2%GAUSS_BASIS_FNS(ns,partial_derivative_first_derivative_map(ni),ng)
1132  END DO !ni
1133  sum = 0.0_dp
1134  !Calculate SUM
1135  IF(equations_set%SPECIFICATION(3)==equations_set_vector_data_fitting_subtype.OR. &
1136  & equations_set%SPECIFICATION(3)==equations_set_vector_data_pre_fitting_subtype) THEN
1137  IF(mh==nh) THEN
1138  !This stiffness matrix contribution is without "integration" means ng=nd in fact = least square!
1139  sum = sum + pgm * pgn
1140  ENDIF
1141  !
1142 ! IF(mh==nh) THEN
1143 ! !This stiffness matrix happens with "integration" so the integral error is reduced!
1144 ! SUM = SUM + PGM * PGN * RWG
1145 ! ENDIF
1146 !REDUCED SOBOLEV SMOOTHING
1147  !This stiffness matrix contribution is with "integration" means ng=ng in fact!
1148  sum = sum + ( &
1149  & tau_param*2.0_dp* ( &
1150  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s1,ng)* &
1151  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s1,ng)+ &
1152  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s2,ng)* &
1153  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s2,ng)+ &
1154  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s3,ng)* &
1155  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s3,ng)) +&
1156  & kappa_param*2.0_dp* ( &
1157  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s1_s1,ng)* &
1158  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s1_s1,ng)+ &
1159  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s2_s2,ng)* &
1160  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s2_s2,ng)+ &
1161  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s3_s3,ng)* &
1162  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s3_s3,ng)+ &
1163  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s1_s2,ng)* &
1164  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s1_s2,ng)+ &
1165  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s1_s3,ng)* &
1166  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s1_s3,ng)+ &
1167  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s2_s3,ng)* &
1168  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s2_s3,ng))) !&
1169 ! no weighting either?
1170 ! & * RWG
1171 
1172  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs) = &
1173  & equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs) + sum
1174 
1175  ELSEIF(equations_set%SPECIFICATION(3)==equations_set_divfree_vector_data_fitting_subtype.OR. &
1176  & equations_set%SPECIFICATION(3)==equations_set_divfree_vector_data_pre_fitting_subtype) THEN
1177  IF(mh==nh.AND.mh<=number_of_dimensions) THEN
1178  sum = sum + pgm * pgn
1179 !REDUCED SOBOLEV SMOOTHING
1180  !This stiffness matrix contribution is with "integration" means ng=ng in fact!
1181  ENDIF
1182 !REDUCED SOBOLEV SMOOTHING
1183  !This stiffness matrix contribution is with "integration" means ng=ng in fact!
1184  sum = sum + ( &
1185  & tau_param*2.0_dp* ( &
1186  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s1,ng)* &
1187  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s1,ng)+ &
1188  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s2,ng)* &
1189  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s2,ng)+ &
1190  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s3,ng)* &
1191  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s3,ng)) +&
1192  & kappa_param*2.0_dp* ( &
1193  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s1_s1,ng)* &
1194  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s1_s1,ng)+ &
1195  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s2_s2,ng)* &
1196  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s2_s2,ng)+ &
1197  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s3_s3,ng)* &
1198  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s3_s3,ng)+ &
1199  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s1_s2,ng)* &
1200  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s1_s2,ng)+ &
1201  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s1_s3,ng)* &
1202  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s1_s3,ng)+ &
1203  & quadrature_scheme1%GAUSS_BASIS_FNS(ms,part_deriv_s2_s3,ng)* &
1204  & quadrature_scheme2%GAUSS_BASIS_FNS(ns,part_deriv_s2_s3,ng))) !&
1205 ! no weighting either?
1206 ! & * RWG
1207 
1208  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs) = &
1209  & equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs) + sum
1210  IF(nh==fieldvariable%NUMBER_OF_COMPONENTS.AND.mh<=number_of_dimensions) THEN
1211  sum=0.0_dp
1212  !Calculate SUM
1213  DO ni=1,dependent_basis1%NUMBER_OF_XI
1214  sum=sum+pgn*pgmsi(ni)*dxi_dx(ni,mh)
1215  ENDDO !ni
1216  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs) = &
1217  & equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs) + sum * rwg
1218  equations_matrix%ELEMENT_MATRIX%MATRIX(nhs,mhs) = &
1219  & equations_matrix%ELEMENT_MATRIX%MATRIX(nhs,mhs) + sum * rwg
1220  ENDIF
1221  ENDIF
1222  ENDDO !ns
1223  ENDDO !nh
1224 
1225  ENDIF
1226  IF(rhs_vector%UPDATE_VECTOR) rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=0.0_dp
1227  IF(source_vector%UPDATE_VECTOR) THEN
1228  IF(equations_set%SPECIFICATION(3)==equations_set_vector_data_fitting_subtype.OR. &
1229  & equations_set%SPECIFICATION(3)==equations_set_vector_data_pre_fitting_subtype) THEN
1230  sum=0.0_dp
1231  pgm=quadrature_scheme1%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
1232  sum=u_value(mh)*pgm
1233 ! SUM=42.0_DP*PGM
1234  source_vector%ELEMENT_VECTOR%VECTOR(mhs)=source_vector%ELEMENT_VECTOR%VECTOR(mhs)+sum
1235  ELSEIF(equations_set%SPECIFICATION(3)==equations_set_divfree_vector_data_fitting_subtype.OR. &
1236  & equations_set%SPECIFICATION(3)==equations_set_divfree_vector_data_pre_fitting_subtype) THEN
1237  IF(mh<=number_of_dimensions) THEN
1238  sum=0.0_dp
1239  pgm=quadrature_scheme1%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)
1240  sum=u_value(mh)*pgm
1241 ! SUM=42.0_DP*PGM
1242  source_vector%ELEMENT_VECTOR%VECTOR(mhs)=source_vector%ELEMENT_VECTOR%VECTOR(mhs)+sum
1243  ENDIF
1244  ENDIF
1245  ENDIF
1246  ENDDO !ms
1247  ENDDO !mh
1248  ENDDO !ng
1249  !Scale factor adjustment
1250  IF(dependent_field%SCALINGS%SCALING_TYPE/=field_no_scaling) THEN
1251  CALL field_interpolationparametersscalefactorselementget(element_number,equations%INTERPOLATION% &
1252  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
1253  mhs=0
1254  DO mh=1,fieldvariable%NUMBER_OF_COMPONENTS
1255  !Loop over element rows
1256  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
1257  mhs=mhs+1
1258  nhs=0
1259  IF(equations_matrix%UPDATE_MATRIX) THEN
1260  !Loop over element columns
1261  DO nh=1,fieldvariable%NUMBER_OF_COMPONENTS
1262  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
1263  nhs=nhs+1
1264  equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=equations_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)* &
1265  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)* &
1266  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
1267  ENDDO !ns
1268  ENDDO !nh
1269  ENDIF
1270  IF(source_vector%UPDATE_VECTOR) THEN
1271  source_vector%ELEMENT_VECTOR%VECTOR(mhs)=source_vector%ELEMENT_VECTOR%VECTOR(mhs)* &
1272  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)
1273  ENDIF
1274  IF(rhs_vector%UPDATE_VECTOR) THEN
1275  rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)* &
1276  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)
1277  ENDIF
1278  ENDDO !ms
1279  ENDDO !mh
1280  ENDIF
1281  CASE(equations_set_generalised_data_fitting_subtype)
1282  CALL flagerror("Not implemented.",err,error,*999)
1283  CASE DEFAULT
1284  localerror="Equations set subtype "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
1285  & " is not valid for a Galerkin projection type of a data fitting equations set class."
1286  CALL flagerror(localerror,err,error,*999)
1287  END SELECT
1288 
1289  ELSE
1290  CALL flagerror("Equations set equations is not associated.",err,error,*999)
1291  ENDIF
1292  ELSE
1293  CALL flagerror("Equations set is not associated.",err,error,*999)
1294  ENDIF
1295 
1296  exits("FITTING_FINITE_ELEMENT_CALCULATE")
1297  RETURN
1298 999 errorsexits("FITTING_FINITE_ELEMENT_CALCULATE",err,error)
1299  RETURN 1
1300  END SUBROUTINE fitting_finite_element_calculate
1301 
1302  !
1303  !================================================================================================================================
1304  !
1305 
1307  SUBROUTINE fitting_equations_set_mat_properties_setup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
1308 
1309  !Argument variables
1310  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1311  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
1312  INTEGER(INTG), INTENT(OUT) :: ERR
1313  TYPE(varying_string), INTENT(OUT) :: ERROR
1314  !Local Variables
1315  INTEGER(INTG) :: GEOMETRIC_MESH_COMPONENT,GEOMETRIC_SCALING_TYPE,GEOMETRIC_COMPONENT_NUMBER,MATERIAL_FIELD_NUMBER_OF_COMPONENTS
1316  INTEGER(INTG) :: DEPENDENT_FIELD_NUMBER_OF_COMPONENTS,NUMBER_OF_DIMENSIONS,I,MATERIAL_FIELD_NUMBER_OF_VARIABLES
1317  INTEGER(INTG) :: INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS,INDEPENDENT_FIELD_NUMBER_OF_VARIABLES
1318  TYPE(decomposition_type), POINTER :: GEOMETRIC_DECOMPOSITION
1319 ! TYPE(FIELD_TYPE), POINTER :: ANALYTIC_FIELD,DEPENDENT_FIELD,GEOMETRIC_FIELD
1320  TYPE(equations_type), POINTER :: EQUATIONS
1321  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
1322  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
1323  TYPE(equations_set_materials_type), POINTER :: EQUATIONS_MATERIALS
1324  TYPE(varying_string) :: LOCAL_ERROR
1325 
1326  enters("FITTING_EQUATIONS_SET_MAT_PROPERTIES_SETUP",err,error,*999)
1327 
1328  NULLIFY(equations)
1329  NULLIFY(equations_mapping)
1330  NULLIFY(equations_matrices)
1331  NULLIFY(geometric_decomposition)
1332 
1333  IF(ASSOCIATED(equations_set)) THEN
1334  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
1335  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
1336  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
1337  CALL flagerror("Equations set specification must have three entries for a fitting type equations set.", &
1338  & err,error,*999)
1339  END IF
1340  IF(equations_set%SPECIFICATION(3)==equations_set_mat_properties_data_fitting_subtype.OR. &
1341  & equations_set%SPECIFICATION(3)==equations_set_mat_properties_inria_model_data_fitting_subtype) THEN
1342  SELECT CASE(equations_set_setup%SETUP_TYPE)
1343 
1344  !-----------------------------------------------------------------
1345  ! s o l u t i o n m e t h o d
1346  !-----------------------------------------------------------------
1347  CASE(equations_set_setup_initial_type)
1348  SELECT CASE(equations_set_setup%ACTION_TYPE)
1349  CASE(equations_set_setup_start_action)
1350  CALL fitting_equations_set_solution_method_set(equations_set,equations_set_fem_solution_method, &
1351  & err,error,*999)
1352  CASE(equations_set_setup_finish_action)
1353  !Do nothing
1354  CASE DEFAULT
1355  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1356  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1357  & " is invalid for an update-materials Galerkin projection."
1358  CALL flagerror(local_error,err,error,*999)
1359  END SELECT
1360 
1361  !-----------------------------------------------------------------
1362  ! g e o m e t r y f i e l d
1363  !-----------------------------------------------------------------
1364  CASE(equations_set_setup_geometry_type)
1365  !Do nothing
1366 
1367  !-----------------------------------------------------------------
1368  ! d e p e n d e n t f i e l d
1369  !-----------------------------------------------------------------
1370  CASE(equations_set_setup_dependent_type)
1371  SELECT CASE(equations_set_setup%ACTION_TYPE)
1372  CASE(equations_set_setup_start_action)
1373  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
1374  !Create the auto created dependent field
1375  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
1376  & dependent_field,err,error,*999)
1377  CALL field_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
1378  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
1379  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
1380  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
1381  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
1382  & err,error,*999)
1383  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
1384  & geometric_field,err,error,*999)
1385 
1386 
1387  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,2,err,error,*999)
1388  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,(/field_u_variable_type, &
1389  & field_deludeln_variable_type/),err,error,*999)
1390  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,"Phi",err,error,*999)
1391  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,"del Phi/del n", &
1392  & err,error,*999)
1393 
1394  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1395  & field_vector_dimension_type,err,error,*999)
1396  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
1397  & field_vector_dimension_type,err,error,*999)
1398  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1399  & field_dp_type,err,error,*999)
1400  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
1401  & field_dp_type,err,error,*999)
1402  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1403  & number_of_dimensions,err,error,*999)
1404 
1405  !component 1: dependent porosity variable, component 2: dependent permeability variable
1406  dependent_field_number_of_components=2
1407  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
1408  & dependent_field_number_of_components,err,error,*999)
1409  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
1410  & dependent_field_number_of_components,err,error,*999)
1411 
1412  DO i=1,dependent_field_number_of_components
1413  !Default to the geometric interpolation setup
1414  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,i, &
1415  & geometric_mesh_component,err,error,*999)
1416  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,i, &
1417  & geometric_mesh_component,err,error,*999)
1418  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,i, &
1419  & geometric_mesh_component,err,error,*999)
1420  END DO
1421 
1422 
1423  SELECT CASE(equations_set%SOLUTION_METHOD)
1424 
1425  CASE(equations_set_fem_solution_method)
1426  DO i=1,dependent_field_number_of_components
1427  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1428  & field_u_variable_type,i,field_node_based_interpolation,err,error,*999)
1429  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
1430  & field_deludeln_variable_type,i,field_node_based_interpolation,err,error,*999)
1431  END DO
1432  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
1433  & err,error,*999)
1434  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type, &
1435  & err,error,*999)
1436  !Other solutions not defined yet
1437  CASE(equations_set_bem_solution_method)
1438  CALL flagerror("Not implemented.",err,error,*999)
1439  CASE(equations_set_fd_solution_method)
1440  CALL flagerror("Not implemented.",err,error,*999)
1441  CASE(equations_set_fv_solution_method)
1442  CALL flagerror("Not implemented.",err,error,*999)
1443  CASE(equations_set_gfem_solution_method)
1444  CALL flagerror("Not implemented.",err,error,*999)
1445  CASE(equations_set_gfv_solution_method)
1446  CALL flagerror("Not implemented.",err,error,*999)
1447  CASE DEFAULT
1448  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1449  & " is invalid."
1450  CALL flagerror(local_error,err,error,*999)
1451  END SELECT
1452  ELSE
1453  !Check the user specified field
1454  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1455  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
1456  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
1457  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type,field_deludeln_variable_type/), &
1458  & err,error,*999)
1459  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
1460  & err,error,*999)
1461  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_vector_dimension_type, &
1462  & err,error,*999)
1463  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1464  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
1465 
1466  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1467  & number_of_dimensions,err,error,*999)
1468 
1469  !component 1: dependent porosity variable, component 2: dependent permeability variable
1470  dependent_field_number_of_components=2
1471  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
1472  & dependent_field_number_of_components,err,error,*999)
1473  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
1474  & dependent_field_number_of_components,err,error,*999)
1475  SELECT CASE(equations_set%SOLUTION_METHOD)
1476  CASE(equations_set_fem_solution_method)
1477  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
1478  & field_node_based_interpolation,err,error,*999)
1479  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
1480  & field_node_based_interpolation,err,error,*999)
1481  CASE(equations_set_bem_solution_method)
1482  CALL flagerror("Not implemented.",err,error,*999)
1483  CASE(equations_set_fd_solution_method)
1484  CALL flagerror("Not implemented.",err,error,*999)
1485  CASE(equations_set_fv_solution_method)
1486  CALL flagerror("Not implemented.",err,error,*999)
1487  CASE(equations_set_gfem_solution_method)
1488  CALL flagerror("Not implemented.",err,error,*999)
1489  CASE(equations_set_gfv_solution_method)
1490  CALL flagerror("Not implemented.",err,error,*999)
1491  CASE DEFAULT
1492  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1493  & " is invalid."
1494  CALL flagerror(local_error,err,error,*999)
1495  END SELECT
1496  ENDIF
1497  CASE(equations_set_setup_finish_action)
1498  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
1499  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
1500  ENDIF
1501  CASE DEFAULT
1502  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1503  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1504  & " is invalid for an update-materials Galerkin projection"
1505  CALL flagerror(local_error,err,error,*999)
1506  END SELECT
1507 
1508  !-----------------------------------------------------------------
1509  ! I N d e p e n d e n t f i e l d
1510  !-----------------------------------------------------------------
1511  CASE(equations_set_setup_independent_type)
1512  SELECT CASE(equations_set_setup%ACTION_TYPE)
1513  !Set start action
1514  CASE(equations_set_setup_start_action)
1515  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
1516  !Create the auto created independent field
1517  !start field creation with name 'INDEPENDENT_FIELD'
1518  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
1519  & equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
1520  !start creation of a new field
1521  CALL field_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
1522  !define new created field to be independent
1523  CALL field_dependent_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1524  & field_independent_type,err,error,*999)
1525  !look for decomposition rule already defined
1526  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
1527  & err,error,*999)
1528  !apply decomposition rule found on new created field
1529  CALL field_mesh_decomposition_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1530  & geometric_decomposition,err,error,*999)
1531  !point new field to geometric field
1532  CALL field_geometric_field_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,equations_set% &
1533  & geometry%GEOMETRIC_FIELD,err,error,*999)
1534  !set number of variables to 1 (1 for U)
1535  independent_field_number_of_variables=1
1536  CALL field_number_of_variables_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1537  & independent_field_number_of_variables,err,error,*999)
1538  CALL field_variable_types_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1539  & (/field_u_variable_type/),err,error,*999)
1540  CALL field_dimension_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1541  & field_vector_dimension_type,err,error,*999)
1542  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1543  & field_dp_type,err,error,*999)
1544  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1545  & number_of_dimensions,err,error,*999)
1546  !calculate number of components with one component for each dimension
1547  independent_field_number_of_components=number_of_dimensions
1548  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1549  & field_u_variable_type,independent_field_number_of_components,err,error,*999)
1550  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1551  & 1,geometric_mesh_component,err,error,*999)
1552  !Default to the geometric interpolation setup
1553  DO i=1,independent_field_number_of_components
1554  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
1555  & field_u_variable_type,i,geometric_mesh_component,err,error,*999)
1556  END DO
1557  ELSE
1558  !Check the user specified field
1559  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
1560  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1561  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
1562  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type/),err,error,*999)
1563  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
1564  & err,error,*999)
1565  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1566  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1567  & number_of_dimensions,err,error,*999)
1568  !calculate number of components with one component for each dimension
1569  independent_field_number_of_components=number_of_dimensions
1570  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
1571  & independent_field_number_of_components,err,error,*999)
1572  ENDIF
1573  !Specify finish action
1574  CASE(equations_set_setup_finish_action)
1575  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
1576  CALL field_create_finish(equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
1577  ENDIF
1578  CALL field_parameter_set_create(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
1579  & field_boundary_set_type,err,error,*999)
1580  CASE DEFAULT
1581  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1582  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1583  & " is invalid for an update-materials Galerkin projection"
1584  CALL flagerror(local_error,err,error,*999)
1585  END SELECT
1586 
1587  !-----------------------------------------------------------------
1588  ! m a t e r i a l f i e l d
1589  !-----------------------------------------------------------------
1590  CASE(equations_set_setup_materials_type)
1591  SELECT CASE(equations_set_setup%ACTION_TYPE)
1592  CASE(equations_set_setup_start_action)
1593  !Do nothing
1594  material_field_number_of_variables=1
1595  material_field_number_of_components=2
1596 
1597  equations_materials=>equations_set%MATERIALS
1598  IF(ASSOCIATED(equations_materials)) THEN
1599  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
1600  !Create the auto created materials field
1601  !start field creation with name 'MATERIAL_FIELD'
1602  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set% &
1603  & materials%MATERIALS_FIELD,err,error,*999)
1604  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
1605  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type, &
1606  & err,error,*999)
1607  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
1608  & err,error,*999)
1609  !apply decomposition rule found on new created field
1610  CALL field_mesh_decomposition_set_and_lock(equations_set%MATERIALS%MATERIALS_FIELD, &
1611  & geometric_decomposition,err,error,*999)
1612  !point new field to geometric field
1613  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
1614  & geometric_field,err,error,*999)
1615  CALL field_number_of_variables_set(equations_materials%MATERIALS_FIELD, &
1616  & material_field_number_of_variables,err,error,*999)
1617  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,(/field_u_variable_type/), &
1618  & err,error,*999)
1619  CALL field_variable_label_set(equations_materials%MATERIALS_FIELD,field_u_variable_type,"Fitting Materials", &
1620  & err,error,*999)
1621  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1622  & field_vector_dimension_type,err,error,*999)
1623  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1624  & field_dp_type,err,error,*999)
1625  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1626  & material_field_number_of_components,err,error,*999)
1627  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1628  & 1,geometric_component_number,err,error,*999)
1629  DO i = 1, material_field_number_of_components
1630  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1631  & i,geometric_component_number,err,error,*999)
1632  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1633  & i,field_node_based_interpolation,err,error,*999)
1634  END DO
1635  !Default the field scaling to that of the geometric field
1636  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
1637  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
1638  ELSE
1639  !Check the user specified field
1640  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
1641  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
1642  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
1643  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type/),err,error,*999)
1644  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
1645  & err,error,*999)
1646  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
1647  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
1648  & number_of_dimensions,err,error,*999)
1649  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1,err,error,*999)
1650  ENDIF
1651  ELSE
1652  CALL flagerror("Equations set materials is not associated.",err,error,*999)
1653  END IF
1654  CASE(equations_set_setup_finish_action)
1655  equations_materials=>equations_set%MATERIALS
1656  IF(ASSOCIATED(equations_materials)) THEN
1657  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
1658  !Finish creating the materials field
1659  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
1660  !Set the default values for the materials field
1661  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
1662  & field_values_set_type,1,1.0_dp,err,error,*999)
1663  ENDIF
1664  ELSE
1665  CALL flagerror("Equations set materials is not associated.",err,error,*999)
1666  ENDIF
1667  CASE DEFAULT
1668  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1669  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1670  & " is invalid for an update-materials Galerkin projection."
1671  CALL flagerror(local_error,err,error,*999)
1672  END SELECT
1673 
1674  !-----------------------------------------------------------------
1675  ! s o u r c e t y p e
1676  !-----------------------------------------------------------------
1677  CASE(equations_set_setup_source_type)
1678  SELECT CASE(equations_set_setup%ACTION_TYPE)
1679  CASE(equations_set_setup_start_action)
1680  !Do nothing
1681  CASE(equations_set_setup_finish_action)
1682  !Do nothing
1683  CASE DEFAULT
1684  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1685  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1686  & " is invalid for an update-materials Galerkin projection."
1687  CALL flagerror(local_error,err,error,*999)
1688  END SELECT
1689 ! ! ! CASE(EQUATIONS_SET_SETUP_ANALYTIC_TYPE)
1690 ! ! ! SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE)
1691 ! ! ! CASE(EQUATIONS_SET_SETUP_START_ACTION)
1692 ! ! ! IF(EQUATIONS_SET%DEPENDENT%DEPENDENT_FINISHED) THEN
1693 ! ! ! DEPENDENT_FIELD=>EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD
1694 ! ! ! IF(ASSOCIATED(DEPENDENT_FIELD)) THEN
1695 ! ! ! GEOMETRIC_FIELD=>EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD
1696 ! ! ! IF(ASSOCIATED(GEOMETRIC_FIELD)) THEN
1697 ! ! ! CALL FIELD_NUMBER_OF_COMPONENTS_GET(GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE,NUMBER_OF_DIMENSIONS,ERR,ERROR,*999)
1698 ! ! ! SELECT CASE(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE)
1699 ! ! ! CASE(EQUATIONS_SET_FITTING_TWO_DIM_1)
1700 ! ! ! !Check that we are in 2D
1701 ! ! ! IF(NUMBER_OF_DIMENSIONS/=2) THEN
1702 ! ! ! LOCAL_ERROR="The number of geometric dimensions of "// &
1703 ! ! ! & TRIM(NUMBER_TO_VSTRING(NUMBER_OF_DIMENSIONS,"*",ERR,ERROR))// &
1704 ! ! ! & " is invalid. The analytic function type of "// &
1705 ! ! ! & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",ERR,ERROR))// &
1706 ! ! ! & " requires that there be 2 geometric dimensions."
1707 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
1708 ! ! ! ENDIF
1709 ! ! ! !Create analytic field if required
1710 ! ! ! !Set analtyic function type
1711 ! ! ! EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_FITTING_TWO_DIM_1
1712 ! ! ! CASE(EQUATIONS_SET_FITTING_TWO_DIM_2)
1713 ! ! ! !Check that we are in 2D
1714 ! ! ! IF(NUMBER_OF_DIMENSIONS/=2) THEN
1715 ! ! ! LOCAL_ERROR="The number of geometric dimensions of "// &
1716 ! ! ! & TRIM(NUMBER_TO_VSTRING(NUMBER_OF_DIMENSIONS,"*",ERR,ERROR))// &
1717 ! ! ! & " is invalid. The analytic function type of "// &
1718 ! ! ! & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",ERR,ERROR))// &
1719 ! ! ! & " requires that there be 2 geometric dimensions."
1720 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
1721 ! ! ! ENDIF
1722 ! ! ! !Create analytic field if required
1723 ! ! ! !Set analtyic function type
1724 ! ! ! EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_FITTING_TWO_DIM_2
1725 ! ! ! CASE(EQUATIONS_SET_FITTING_THREE_DIM_1)
1726 ! ! ! !Check that we are in 3D
1727 ! ! ! IF(NUMBER_OF_DIMENSIONS/=3) THEN
1728 ! ! ! LOCAL_ERROR="The number of geometric dimensions of "// &
1729 ! ! ! & TRIM(NUMBER_TO_VSTRING(NUMBER_OF_DIMENSIONS,"*",ERR,ERROR))// &
1730 ! ! ! & " is invalid. The analytic function type of "// &
1731 ! ! ! & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",ERR,ERROR))// &
1732 ! ! ! & " requires that there be 3 geometric dimensions."
1733 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
1734 ! ! ! ENDIF
1735 ! ! ! !Create analytic field if required
1736 ! ! ! !Set analtyic function type
1737 ! ! ! EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_FITTING_THREE_DIM_1
1738 ! ! ! CASE(EQUATIONS_SET_FITTING_THREE_DIM_2)
1739 ! ! ! !Check that we are in 3D
1740 ! ! ! IF(NUMBER_OF_DIMENSIONS/=3) THEN
1741 ! ! ! LOCAL_ERROR="The number of geometric dimensions of "// &
1742 ! ! ! & TRIM(NUMBER_TO_VSTRING(NUMBER_OF_DIMENSIONS,"*",ERR,ERROR))// &
1743 ! ! ! & " is invalid. The analytic function type of "// &
1744 ! ! ! & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",ERR,ERROR))// &
1745 ! ! ! & " requires that there be 3 geometric dimensions."
1746 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
1747 ! ! ! ENDIF
1748 ! ! ! !Create analytic field if required
1749 ! ! ! !Set analtyic function type
1750 ! ! ! EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_FITTING_THREE_DIM_2
1751 ! ! ! CASE DEFAULT
1752 ! ! ! LOCAL_ERROR="The specified analytic function type of "// &
1753 ! ! ! & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",ERR,ERROR))// &
1754 ! ! ! & " is invalid for a moving mesh Galerkin projection."
1755 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
1756 ! ! ! END SELECT
1757 ! ! ! ELSE
1758 ! ! ! CALL FlagError("Equations set geometric field is not associated.",ERR,ERROR,*999)
1759 ! ! ! ENDIF
1760 ! ! ! ELSE
1761 ! ! ! CALL FlagError("Equations set dependent field is not associated.",ERR,ERROR,*999)
1762 ! ! ! ENDIF
1763 ! ! ! ELSE
1764 ! ! ! CALL FlagError("Equations set dependent field has not been finished.",ERR,ERROR,*999)
1765 ! ! ! ENDIF
1766 ! ! ! CASE(EQUATIONS_SET_SETUP_FINISH_ACTION)
1767 ! ! ! IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN
1768 ! ! ! ANALYTIC_FIELD=>EQUATIONS_SET%ANALYTIC%ANALYTIC_FIELD
1769 ! ! ! IF(ASSOCIATED(ANALYTIC_FIELD)) THEN
1770 ! ! ! IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED) THEN
1771 ! ! ! CALL FIELD_CREATE_FINISH(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,ERR,ERROR,*999)
1772 ! ! ! ENDIF
1773 ! ! ! ENDIF
1774 ! ! ! ELSE
1775 ! ! ! CALL FlagError("Equations set analytic is not associated.",ERR,ERROR,*999)
1776 ! ! ! ENDIF
1777 ! ! ! CASE(EQUATIONS_SET_SETUP_GENERATE_ACTION)
1778 ! ! ! IF(EQUATIONS_SET%DEPENDENT%DEPENDENT_FINISHED) THEN
1779 ! ! ! IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN
1780 ! ! ! IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FINISHED) THEN
1781 ! ! ! CALL FITTING_ANALYTIC_CALCULATE(EQUATIONS_SET,ERR,ERROR,*999)
1782 ! ! ! ELSE
1783 ! ! ! CALL FlagError("Equations set analtyic has not been finished.",ERR,ERROR,*999)
1784 ! ! ! ENDIF
1785 ! ! ! ELSE
1786 ! ! ! CALL FlagError("Equations set analtyic is not associated.",ERR,ERROR,*999)
1787 ! ! ! ENDIF
1788 ! ! ! ELSE
1789 ! ! ! CALL FlagError("Equations set dependent has not been finished.",ERR,ERROR,*999)
1790 ! ! ! ENDIF
1791 ! ! ! CASE DEFAULT
1792 ! ! ! LOCAL_ERROR="The action type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",ERR,ERROR))// &
1793 ! ! ! & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",ERR,ERROR))// &
1794 ! ! ! & " is invalid for an update-materials Galerkin projection."
1795 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
1796 ! ! ! END SELECT
1797 
1798  !-----------------------------------------------------------------
1799  ! e q u a t i o n s t y p e
1800  !-----------------------------------------------------------------
1801  CASE(equations_set_setup_equations_type)
1802  SELECT CASE(equations_set_setup%ACTION_TYPE)
1803  CASE(equations_set_setup_start_action)
1804  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
1805  CALL equations_create_start(equations_set,equations,err,error,*999)
1806  CALL equations_linearity_type_set(equations,equations_linear,err,error,*999)
1807  CALL equations_time_dependence_type_set(equations,equations_quasistatic,err,error,*999)
1808  ELSE
1809  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
1810  ENDIF
1811  CASE(equations_set_setup_finish_action)
1812  SELECT CASE(equations_set%SOLUTION_METHOD)
1813  CASE(equations_set_fem_solution_method)
1814  !Finish the equations creation
1815  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
1816  CALL equations_create_finish(equations,err,error,*999)
1817  !Create the equations mapping.
1818  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
1819  CALL equationsmapping_linearmatricesnumberset(equations_mapping,1,err,error,*999)
1820  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,(/field_u_variable_type/), &
1821  & err,error,*999)
1822  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
1823  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
1824  !Create the equations matrices
1825  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
1826  SELECT CASE(equations%SPARSITY_TYPE)
1827  CASE(equations_matrices_full_matrices)
1828  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_block_storage_type/), &
1829  & err,error,*999)
1830  CASE(equations_matrices_sparse_matrices)
1831  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_compressed_row_storage_type/), &
1832  & err,error,*999)
1833  CALL equationsmatrices_linearstructuretypeset(equations_matrices,(/equations_matrix_fem_structure/), &
1834  & err,error,*999)
1835  CASE DEFAULT
1836  local_error="The equations matrices sparsity type of "// &
1837  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
1838  CALL flagerror(local_error,err,error,*999)
1839  END SELECT
1840  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
1841  CASE(equations_set_bem_solution_method)
1842  CALL flagerror("Not implemented.",err,error,*999)
1843  CASE(equations_set_fd_solution_method)
1844  CALL flagerror("Not implemented.",err,error,*999)
1845  CASE(equations_set_fv_solution_method)
1846  CALL flagerror("Not implemented.",err,error,*999)
1847  CASE(equations_set_gfem_solution_method)
1848  CALL flagerror("Not implemented.",err,error,*999)
1849  CASE(equations_set_gfv_solution_method)
1850  CALL flagerror("Not implemented.",err,error,*999)
1851  CASE DEFAULT
1852  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1853  & " is invalid."
1854  CALL flagerror(local_error,err,error,*999)
1855  END SELECT
1856  CASE DEFAULT
1857  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1858  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1859  & " is invalid for an update-materials Galerkin projection."
1860  CALL flagerror(local_error,err,error,*999)
1861  END SELECT
1862 
1863  !-----------------------------------------------------------------
1864  ! c a s e d e f a u l t
1865  !-----------------------------------------------------------------
1866  CASE DEFAULT
1867  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1868  & " is invalid for an update-materials Galerkin projection."
1869  CALL flagerror(local_error,err,error,*999)
1870  END SELECT
1871  ELSE
1872  local_error="The equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
1873  & " does not equal an update-materials Galerkin projection subtype."
1874  CALL flagerror(local_error,err,error,*999)
1875  ENDIF
1876  ELSE
1877  CALL flagerror("Equations set is not associated.",err,error,*999)
1878  ENDIF
1879 
1880  exits("FITTING_EQUATIONS_SET_MAT_PROPERTIES_SETUP")
1881  RETURN
1882 999 errorsexits("FITTING_EQUATIONS_SET_MAT_PROPERTIES_SETUP",err,error)
1883  RETURN 1
1884  END SUBROUTINE fitting_equations_set_mat_properties_setup
1885 
1886  !
1887  !================================================================================================================================
1888  !
1889 
1891  SUBROUTINE fitting_equations_set_setup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
1892 
1893  !Argument variables
1894  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1895  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
1896  INTEGER(INTG), INTENT(OUT) :: ERR
1897  TYPE(varying_string), INTENT(OUT) :: ERROR
1898  !Local Variables
1899  TYPE(varying_string) :: LOCAL_ERROR
1900 
1901  enters("FITTING_EQUATIONS_SET_SETUP",err,error,*999)
1902 
1903  IF(ASSOCIATED(equations_set)) THEN
1904  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
1905  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
1906  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
1907  CALL flagerror("Equations set specification must have three entries for a fitting type equations set.", &
1908  & err,error,*999)
1909  END IF
1910  SELECT CASE(equations_set%SPECIFICATION(3))
1911  CASE(equations_set_standard_data_fitting_subtype)
1912  CALL fitting_equations_set_standard_setup(equations_set,equations_set_setup,err,error,*999)
1913  CASE(equations_set_vector_data_fitting_subtype,equations_set_vector_data_pre_fitting_subtype)
1914  CALL fitting_equations_set_vectordata_setup(equations_set,equations_set_setup,err,error,*999)
1915  CASE(equations_set_divfree_vector_data_fitting_subtype,equations_set_divfree_vector_data_pre_fitting_subtype)
1916  CALL fitting_equations_set_vectordata_setup(equations_set,equations_set_setup,err,error,*999)
1917  CASE(equationsset_datapointvectorstaticfittingsubtype, &
1918  & equationsset_datapointvectorquasistaticfittingsubtype)
1919  CALL fitting_equations_set_vectordata_setup(equations_set,equations_set_setup,err,error,*999)
1920  CASE(equations_set_mat_properties_data_fitting_subtype, &
1921  & equations_set_mat_properties_inria_model_data_fitting_subtype)
1922  CALL fitting_equations_set_mat_properties_setup(equations_set,equations_set_setup,err,error,*999)
1923  CASE(equations_set_generalised_data_fitting_subtype)
1924  CALL flagerror("Not implemented.",err,error,*999)
1925  CASE DEFAULT
1926  local_error="Equations set subtype "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
1927  & " is not valid for a Galerkin projection type of a data fitting equation set class."
1928  CALL flagerror(local_error,err,error,*999)
1929  END SELECT
1930  ELSE
1931  CALL flagerror("Equations set is not associated.",err,error,*999)
1932  ENDIF
1933 
1934  exits("FITTING_EQUATIONS_SET_SETUP")
1935  RETURN
1936 999 errorsexits("FITTING_EQUATIONS_SET_SETUP",err,error)
1937  RETURN 1
1938  END SUBROUTINE fitting_equations_set_setup
1939 
1940  !
1941  !================================================================================================================================
1942  !
1943 
1945  SUBROUTINE fitting_equations_set_solution_method_set(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)
1946 
1947  !Argument variables
1948  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
1949  INTEGER(INTG), INTENT(IN) :: SOLUTION_METHOD
1950  INTEGER(INTG), INTENT(OUT) :: ERR
1951  TYPE(varying_string), INTENT(OUT) :: ERROR
1952  !Local Variables
1953  TYPE(varying_string) :: LOCAL_ERROR
1954 
1955  enters("FITTING_EQUATIONS_SET_SOLUTION_METHOD_SET",err,error,*999)
1956 
1957  IF(ASSOCIATED(equations_set)) THEN
1958  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
1959  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
1960  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
1961  CALL flagerror("Equations set specification must have three entries for a fitting type equations set.", &
1962  & err,error,*999)
1963  END IF
1964  SELECT CASE(equations_set%SPECIFICATION(3))
1965  CASE(equations_set_standard_data_fitting_subtype)
1966  SELECT CASE(solution_method)
1967  CASE(equations_set_fem_solution_method)
1968  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
1969  CASE(equations_set_bem_solution_method)
1970  CALL flagerror("Not implemented.",err,error,*999)
1971  CASE(equations_set_fd_solution_method)
1972  CALL flagerror("Not implemented.",err,error,*999)
1973  CASE(equations_set_fv_solution_method)
1974  CALL flagerror("Not implemented.",err,error,*999)
1975  CASE(equations_set_gfem_solution_method)
1976  CALL flagerror("Not implemented.",err,error,*999)
1977  CASE(equations_set_gfv_solution_method)
1978  CALL flagerror("Not implemented.",err,error,*999)
1979  CASE DEFAULT
1980  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
1981  CALL flagerror(local_error,err,error,*999)
1982  END SELECT
1983  CASE(equations_set_mat_properties_data_fitting_subtype, &
1984  & equations_set_mat_properties_inria_model_data_fitting_subtype)
1985  SELECT CASE(solution_method)
1986  CASE(equations_set_fem_solution_method)
1987  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
1988  CASE(equations_set_bem_solution_method)
1989  CALL flagerror("Not implemented.",err,error,*999)
1990  CASE(equations_set_fd_solution_method)
1991  CALL flagerror("Not implemented.",err,error,*999)
1992  CASE(equations_set_fv_solution_method)
1993  CALL flagerror("Not implemented.",err,error,*999)
1994  CASE(equations_set_gfem_solution_method)
1995  CALL flagerror("Not implemented.",err,error,*999)
1996  CASE(equations_set_gfv_solution_method)
1997  CALL flagerror("Not implemented.",err,error,*999)
1998  CASE DEFAULT
1999  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
2000  CALL flagerror(local_error,err,error,*999)
2001  END SELECT
2002  CASE(equations_set_generalised_data_fitting_subtype)
2003  SELECT CASE(solution_method)
2004  CASE(equations_set_fem_solution_method)
2005  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
2006  CASE(equations_set_bem_solution_method)
2007  CALL flagerror("Not implemented.",err,error,*999)
2008  CASE(equations_set_fd_solution_method)
2009  CALL flagerror("Not implemented.",err,error,*999)
2010  CASE(equations_set_fv_solution_method)
2011  CALL flagerror("Not implemented.",err,error,*999)
2012  CASE(equations_set_gfem_solution_method)
2013  CALL flagerror("Not implemented.",err,error,*999)
2014  CASE(equations_set_gfv_solution_method)
2015  CALL flagerror("Not implemented.",err,error,*999)
2016  CASE DEFAULT
2017  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
2018  CALL flagerror(local_error,err,error,*999)
2019  END SELECT
2020  CASE(equations_set_vector_data_fitting_subtype,equations_set_vector_data_pre_fitting_subtype, &
2021  & equations_set_divfree_vector_data_fitting_subtype,equations_set_divfree_vector_data_pre_fitting_subtype, &
2022  & equationsset_datapointvectorstaticfittingsubtype,equationsset_datapointvectorquasistaticfittingsubtype)
2023  SELECT CASE(solution_method)
2024  CASE(equations_set_fem_solution_method)
2025  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
2026  CASE(equations_set_bem_solution_method)
2027  CALL flagerror("Not implemented.",err,error,*999)
2028  CASE(equations_set_fd_solution_method)
2029  CALL flagerror("Not implemented.",err,error,*999)
2030  CASE(equations_set_fv_solution_method)
2031  CALL flagerror("Not implemented.",err,error,*999)
2032  CASE(equations_set_gfem_solution_method)
2033  CALL flagerror("Not implemented.",err,error,*999)
2034  CASE(equations_set_gfv_solution_method)
2035  CALL flagerror("Not implemented.",err,error,*999)
2036  CASE DEFAULT
2037  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
2038  CALL flagerror(local_error,err,error,*999)
2039  END SELECT
2040  CASE DEFAULT
2041  local_error="Equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2042  & " is not valid for a Galerkin projection type of an data fitting equations set class."
2043  CALL flagerror(local_error,err,error,*999)
2044  END SELECT
2045  ELSE
2046  CALL flagerror("Equations set is not associated.",err,error,*999)
2047  ENDIF
2048 
2049  exits("FITTING_EQUATIONS_SET_SOLUTION_METHOD_SET")
2050  RETURN
2051 999 errorsexits("FITTING_EQUATIONS_SET_SOLUTION_METHOD_SET",err,error)
2052  RETURN 1
2053  END SUBROUTINE fitting_equations_set_solution_method_set
2054 
2055  !
2056  !================================================================================================================================
2057  !
2058 
2060  SUBROUTINE fitting_equationssetspecificationset(equationsSet,specification,err,error,*)
2061 
2062  !Argument variables
2063  TYPE(equations_set_type), POINTER :: equationsSet
2064  INTEGER(INTG), INTENT(IN) :: specification(:)
2065  INTEGER(INTG), INTENT(OUT) :: err
2066  TYPE(varying_string), INTENT(OUT) :: error
2067  !Local Variables
2068  TYPE(varying_string) :: localError
2069  INTEGER(INTG) :: equationsSetType,equationsSetSubtype
2070 
2071  enters("Fitting_EquationsSetSpecificationSet",err,error,*999)
2072 
2073  IF(ASSOCIATED(equationsset)) THEN
2074  IF(SIZE(specification,1)/=3) THEN
2075  CALL flagerror("Equations set specification must have three entries for a fitting class equations set.", &
2076  & err,error,*999)
2077  END IF
2078  equationssettype=specification(2)
2079  SELECT CASE(equationssettype)
2080  CASE(equations_set_data_fitting_equation_type)
2081  equationssetsubtype=specification(3)
2082  SELECT CASE(equationssetsubtype)
2083  CASE(equations_set_standard_data_fitting_subtype, &
2084  & equations_set_vector_data_fitting_subtype, &
2085  & equations_set_divfree_vector_data_fitting_subtype, &
2086  & equations_set_vector_data_pre_fitting_subtype, &
2087  & equations_set_divfree_vector_data_pre_fitting_subtype, &
2088  & equations_set_mat_properties_data_fitting_subtype, &
2089  & equations_set_mat_properties_inria_model_data_fitting_subtype, &
2090  & equationsset_datapointvectorstaticfittingsubtype, &
2091  & equationsset_datapointvectorquasistaticfittingsubtype)
2092  !ok
2093  CASE(equations_set_generalised_data_fitting_subtype)
2094  CALL flagerror("Not implemented.",err,error,*999)
2095  CASE DEFAULT
2096  localerror="The third equations set specifiction of "//trim(numbertovstring(equationssetsubtype,"*",err,error))// &
2097  & " is not valid for a Galerkin projection type of a data fitting equations set."
2098  CALL flagerror(localerror,err,error,*999)
2099  END SELECT
2100  CASE DEFAULT
2101  localerror="The second equations set specification of "//trim(numbertovstring(equationssettype,"*",err,error))// &
2102  & " is not valid for a data fitting equations set."
2103  CALL flagerror(localerror,err,error,*999)
2104  END SELECT
2105  !Set full specification
2106  IF(ALLOCATED(equationsset%specification)) THEN
2107  CALL flagerror("Equations set specification is already allocated.",err,error,*999)
2108  ELSE
2109  ALLOCATE(equationsset%specification(3),stat=err)
2110  IF(err/=0) CALL flagerror("Could not allocate equations set specification.",err,error,*999)
2111  END IF
2112  equationsset%specification(1:3)=[equations_set_fitting_class,equationssettype,equationssetsubtype]
2113  ELSE
2114  CALL flagerror("Equations set is not associated.",err,error,*999)
2115  END IF
2116 
2117  exits("Fitting_EquationsSetSpecificationSet")
2118  RETURN
2119 999 errors("Fitting_EquationsSetSpecificationSet",err,error)
2120  exits("Fitting_EquationsSetSpecificationSet")
2121  RETURN 1
2122 
2123  END SUBROUTINE fitting_equationssetspecificationset
2124 
2125  !
2126  !================================================================================================================================
2127  !
2128 
2130  SUBROUTINE fitting_equations_set_standard_setup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
2131 
2132  !Argument variables
2133  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2134  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
2135  INTEGER(INTG), INTENT(OUT) :: ERR
2136  TYPE(varying_string), INTENT(OUT) :: ERROR
2137  !Local Variables
2138  INTEGER(INTG) :: GEOMETRIC_MESH_COMPONENT,GEOMETRIC_SCALING_TYPE !,NUMBER_OF_DIMENSIONS
2139  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
2140  TYPE(decomposition_type), POINTER :: GEOMETRIC_DECOMPOSITION
2141 ! TYPE(FIELD_TYPE), POINTER :: ANALYTIC_FIELD,DEPENDENT_FIELD,GEOMETRIC_FIELD
2142  TYPE(equations_type), POINTER :: EQUATIONS
2143  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2144  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
2145  TYPE(varying_string) :: LOCAL_ERROR
2146 
2147  enters("FITTING_EQUATION_SET_STANDARD_SETUP",err,error,*999)
2148 
2149  NULLIFY(boundary_conditions)
2150  NULLIFY(equations)
2151  NULLIFY(equations_mapping)
2152  NULLIFY(equations_matrices)
2153  NULLIFY(geometric_decomposition)
2154 
2155  IF(ASSOCIATED(equations_set)) THEN
2156  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
2157  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
2158  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
2159  CALL flagerror("Equations set specification must have three entries for a fitting type equations set.", &
2160  & err,error,*999)
2161  END IF
2162  IF(equations_set%SPECIFICATION(3)==equations_set_standard_data_fitting_subtype) THEN
2163  SELECT CASE(equations_set_setup%SETUP_TYPE)
2164 
2165  !-----------------------------------------------------------------
2166  ! s o l u t i o n m e t h o d
2167  !-----------------------------------------------------------------
2168  CASE(equations_set_setup_initial_type)
2169  SELECT CASE(equations_set_setup%ACTION_TYPE)
2170  CASE(equations_set_setup_start_action)
2171  CALL fitting_equations_set_solution_method_set(equations_set,equations_set_fem_solution_method, &
2172  & err,error,*999)
2173  CASE(equations_set_setup_finish_action)
2174  !Do nothing
2175  CASE DEFAULT
2176  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2177  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2178  & " is invalid for a standard Galerkin projection."
2179  CALL flagerror(local_error,err,error,*999)
2180  END SELECT
2181 
2182  !-----------------------------------------------------------------
2183  ! g e o m e t r y f i e l d
2184  !-----------------------------------------------------------------
2185  CASE(equations_set_setup_geometry_type)
2186  !Do nothing
2187 
2188  !-----------------------------------------------------------------
2189  ! d e p e n d e n t f i e l d
2190  !-----------------------------------------------------------------
2191  CASE(equations_set_setup_dependent_type)
2192  SELECT CASE(equations_set_setup%ACTION_TYPE)
2193  CASE(equations_set_setup_start_action)
2194  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
2195  !Create the auto created dependent field
2196  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
2197  & dependent_field,err,error,*999)
2198  CALL field_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
2199  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
2200  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
2201  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
2202  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
2203  & err,error,*999)
2204  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
2205  & geometric_field,err,error,*999)
2206  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,2,err,error,*999)
2207  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,(/field_u_variable_type, &
2208  & field_deludeln_variable_type/),err,error,*999)
2209  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,"Phi",err,error,*999)
2210  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,"del Phi/del n", &
2211  & err,error,*999)
2212  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
2213  & field_scalar_dimension_type,err,error,*999)
2214  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
2215  & field_scalar_dimension_type,err,error,*999)
2216  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
2217  & field_dp_type,err,error,*999)
2218  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
2219  & field_dp_type,err,error,*999)
2220  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
2221  & err,error,*999)
2222  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
2223  & err,error,*999)
2224  CALL field_component_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1,"Phi",err,error,*999)
2225  CALL field_component_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
2226  & "del Phi/del n",err,error,*999)
2227  !Default to the geometric interpolation setup
2228  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,1, &
2229  & geometric_mesh_component,err,error,*999)
2230  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
2231  & geometric_mesh_component,err,error,*999)
2232  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
2233  & geometric_mesh_component,err,error,*999)
2234  SELECT CASE(equations_set%SOLUTION_METHOD)
2235  CASE(equations_set_fem_solution_method)
2236  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
2237  & field_u_variable_type,1,field_node_based_interpolation,err,error,*999)
2238  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
2239  & field_deludeln_variable_type,1,field_node_based_interpolation,err,error,*999)
2240  !Default the scaling to the geometric field scaling
2241  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
2242  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
2243  CASE(equations_set_bem_solution_method)
2244  CALL flagerror("Not implemented.",err,error,*999)
2245  CASE(equations_set_fd_solution_method)
2246  CALL flagerror("Not implemented.",err,error,*999)
2247  CASE(equations_set_fv_solution_method)
2248  CALL flagerror("Not implemented.",err,error,*999)
2249  CASE(equations_set_gfem_solution_method)
2250  CALL flagerror("Not implemented.",err,error,*999)
2251  CASE(equations_set_gfv_solution_method)
2252  CALL flagerror("Not implemented.",err,error,*999)
2253  CASE DEFAULT
2254  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
2255  & " is invalid."
2256  CALL flagerror(local_error,err,error,*999)
2257  END SELECT
2258  ELSE
2259  !Check the user specified field
2260  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
2261  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
2262  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
2263  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type,field_deludeln_variable_type/), &
2264  & err,error,*999)
2265  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_scalar_dimension_type,err,error,*999)
2266  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_scalar_dimension_type, &
2267  & err,error,*999)
2268  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
2269  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
2270  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1,err,error,*999)
2271  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type,1,err,error,*999)
2272  SELECT CASE(equations_set%SOLUTION_METHOD)
2273  CASE(equations_set_fem_solution_method)
2274  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
2275  & field_node_based_interpolation,err,error,*999)
2276  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
2277  & field_node_based_interpolation,err,error,*999)
2278  CASE(equations_set_bem_solution_method)
2279  CALL flagerror("Not implemented.",err,error,*999)
2280  CASE(equations_set_fd_solution_method)
2281  CALL flagerror("Not implemented.",err,error,*999)
2282  CASE(equations_set_fv_solution_method)
2283  CALL flagerror("Not implemented.",err,error,*999)
2284  CASE(equations_set_gfem_solution_method)
2285  CALL flagerror("Not implemented.",err,error,*999)
2286  CASE(equations_set_gfv_solution_method)
2287  CALL flagerror("Not implemented.",err,error,*999)
2288  CASE DEFAULT
2289  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
2290  & " is invalid."
2291  CALL flagerror(local_error,err,error,*999)
2292  END SELECT
2293  ENDIF
2294  CASE(equations_set_setup_finish_action)
2295  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
2296  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
2297  ENDIF
2298  CASE DEFAULT
2299  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2300  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2301  & " is invalid for a standard Galerkin projection"
2302  CALL flagerror(local_error,err,error,*999)
2303  END SELECT
2304 
2305  !-----------------------------------------------------------------
2306  ! m a t e r i a l f i e l d
2307  !-----------------------------------------------------------------
2308  CASE(equations_set_setup_materials_type)
2309  SELECT CASE(equations_set_setup%ACTION_TYPE)
2310  CASE(equations_set_setup_start_action)
2311  !Do nothing
2312  CASE(equations_set_setup_finish_action)
2313  !Do nothing
2314  CASE DEFAULT
2315  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2316  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2317  & " is invalid for a standard Galerkin projection."
2318  CALL flagerror(local_error,err,error,*999)
2319  END SELECT
2320 
2321  !-----------------------------------------------------------------
2322  ! s o u r c e t y p e
2323  !-----------------------------------------------------------------
2324  CASE(equations_set_setup_source_type)
2325  SELECT CASE(equations_set_setup%ACTION_TYPE)
2326  CASE(equations_set_setup_start_action)
2327  !Do nothing
2328  CASE(equations_set_setup_finish_action)
2329  !Do nothing
2330  CASE DEFAULT
2331  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2332  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2333  & " is invalid for a standard Galerkin projection."
2334  CALL flagerror(local_error,err,error,*999)
2335  END SELECT
2336 ! ! ! CASE(EQUATIONS_SET_SETUP_ANALYTIC_TYPE)
2337 ! ! ! SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE)
2338 ! ! ! CASE(EQUATIONS_SET_SETUP_START_ACTION)
2339 ! ! ! IF(EQUATIONS_SET%DEPENDENT%DEPENDENT_FINISHED) THEN
2340 ! ! ! DEPENDENT_FIELD=>EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD
2341 ! ! ! IF(ASSOCIATED(DEPENDENT_FIELD)) THEN
2342 ! ! ! GEOMETRIC_FIELD=>EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD
2343 ! ! ! IF(ASSOCIATED(GEOMETRIC_FIELD)) THEN
2344 ! ! ! CALL FIELD_NUMBER_OF_COMPONENTS_GET(GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE,NUMBER_OF_DIMENSIONS,ERR,ERROR,*999)
2345 ! ! ! SELECT CASE(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE)
2346 ! ! ! CASE(EQUATIONS_SET_FITTING_TWO_DIM_1)
2347 ! ! ! !Check that we are in 2D
2348 ! ! ! IF(NUMBER_OF_DIMENSIONS/=2) THEN
2349 ! ! ! LOCAL_ERROR="The number of geometric dimensions of "// &
2350 ! ! ! & TRIM(NUMBER_TO_VSTRING(NUMBER_OF_DIMENSIONS,"*",ERR,ERROR))// &
2351 ! ! ! & " is invalid. The analytic function type of "// &
2352 ! ! ! & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",ERR,ERROR))// &
2353 ! ! ! & " requires that there be 2 geometric dimensions."
2354 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
2355 ! ! ! ENDIF
2356 ! ! ! !Create analytic field if required
2357 ! ! ! !Set analtyic function type
2358 ! ! ! EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_FITTING_TWO_DIM_1
2359 ! ! ! CASE(EQUATIONS_SET_FITTING_TWO_DIM_2)
2360 ! ! ! !Check that we are in 2D
2361 ! ! ! IF(NUMBER_OF_DIMENSIONS/=2) THEN
2362 ! ! ! LOCAL_ERROR="The number of geometric dimensions of "// &
2363 ! ! ! & TRIM(NUMBER_TO_VSTRING(NUMBER_OF_DIMENSIONS,"*",ERR,ERROR))// &
2364 ! ! ! & " is invalid. The analytic function type of "// &
2365 ! ! ! & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",ERR,ERROR))// &
2366 ! ! ! & " requires that there be 2 geometric dimensions."
2367 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
2368 ! ! ! ENDIF
2369 ! ! ! !Create analytic field if required
2370 ! ! ! !Set analtyic function type
2371 ! ! ! EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_FITTING_TWO_DIM_2
2372 ! ! ! CASE(EQUATIONS_SET_FITTING_THREE_DIM_1)
2373 ! ! ! !Check that we are in 3D
2374 ! ! ! IF(NUMBER_OF_DIMENSIONS/=3) THEN
2375 ! ! ! LOCAL_ERROR="The number of geometric dimensions of "// &
2376 ! ! ! & TRIM(NUMBER_TO_VSTRING(NUMBER_OF_DIMENSIONS,"*",ERR,ERROR))// &
2377 ! ! ! & " is invalid. The analytic function type of "// &
2378 ! ! ! & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",ERR,ERROR))// &
2379 ! ! ! & " requires that there be 3 geometric dimensions."
2380 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
2381 ! ! ! ENDIF
2382 ! ! ! !Create analytic field if required
2383 ! ! ! !Set analtyic function type
2384 ! ! ! EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_FITTING_THREE_DIM_1
2385 ! ! ! CASE(EQUATIONS_SET_FITTING_THREE_DIM_2)
2386 ! ! ! !Check that we are in 3D
2387 ! ! ! IF(NUMBER_OF_DIMENSIONS/=3) THEN
2388 ! ! ! LOCAL_ERROR="The number of geometric dimensions of "// &
2389 ! ! ! & TRIM(NUMBER_TO_VSTRING(NUMBER_OF_DIMENSIONS,"*",ERR,ERROR))// &
2390 ! ! ! & " is invalid. The analytic function type of "// &
2391 ! ! ! & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",ERR,ERROR))// &
2392 ! ! ! & " requires that there be 3 geometric dimensions."
2393 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
2394 ! ! ! ENDIF
2395 ! ! ! !Create analytic field if required
2396 ! ! ! !Set analtyic function type
2397 ! ! ! EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_FITTING_THREE_DIM_2
2398 ! ! ! CASE DEFAULT
2399 ! ! ! LOCAL_ERROR="The specified analytic function type of "// &
2400 ! ! ! & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",ERR,ERROR))// &
2401 ! ! ! & " is invalid for a standard Galerkin projection."
2402 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
2403 ! ! ! END SELECT
2404 ! ! ! ELSE
2405 ! ! ! CALL FlagError("Equations set geometric field is not associated.",ERR,ERROR,*999)
2406 ! ! ! ENDIF
2407 ! ! ! ELSE
2408 ! ! ! CALL FlagError("Equations set dependent field is not associated.",ERR,ERROR,*999)
2409 ! ! ! ENDIF
2410 ! ! ! ELSE
2411 ! ! ! CALL FlagError("Equations set dependent field has not been finished.",ERR,ERROR,*999)
2412 ! ! ! ENDIF
2413 ! ! ! CASE(EQUATIONS_SET_SETUP_FINISH_ACTION)
2414 ! ! ! IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN
2415 ! ! ! ANALYTIC_FIELD=>EQUATIONS_SET%ANALYTIC%ANALYTIC_FIELD
2416 ! ! ! IF(ASSOCIATED(ANALYTIC_FIELD)) THEN
2417 ! ! ! IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED) THEN
2418 ! ! ! CALL FIELD_CREATE_FINISH(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,ERR,ERROR,*999)
2419 ! ! ! ENDIF
2420 ! ! ! ENDIF
2421 ! ! ! ELSE
2422 ! ! ! CALL FlagError("Equations set analytic is not associated.",ERR,ERROR,*999)
2423 ! ! ! ENDIF
2424 ! ! ! CASE(EQUATIONS_SET_SETUP_GENERATE_ACTION)
2425 ! ! ! IF(EQUATIONS_SET%DEPENDENT%DEPENDENT_FINISHED) THEN
2426 ! ! ! IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN
2427 ! ! ! IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FINISHED) THEN
2428 ! ! ! CALL FITTING_ANALYTIC_CALCULATE(EQUATIONS_SET,ERR,ERROR,*999)
2429 ! ! ! ELSE
2430 ! ! ! CALL FlagError("Equations set analtyic has not been finished.",ERR,ERROR,*999)
2431 ! ! ! ENDIF
2432 ! ! ! ELSE
2433 ! ! ! CALL FlagError("Equations set analtyic is not associated.",ERR,ERROR,*999)
2434 ! ! ! ENDIF
2435 ! ! ! ELSE
2436 ! ! ! CALL FlagError("Equations set dependent has not been finished.",ERR,ERROR,*999)
2437 ! ! ! ENDIF
2438 ! ! ! CASE DEFAULT
2439 ! ! ! LOCAL_ERROR="The action type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",ERR,ERROR))// &
2440 ! ! ! & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",ERR,ERROR))// &
2441 ! ! ! & " is invalid for a standard Galerkin projection."
2442 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
2443 ! ! ! END SELECT
2444 
2445  !-----------------------------------------------------------------
2446  ! e q u a t i o n s t y p e
2447  !-----------------------------------------------------------------
2448  CASE(equations_set_setup_equations_type)
2449  SELECT CASE(equations_set_setup%ACTION_TYPE)
2450  CASE(equations_set_setup_start_action)
2451  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
2452  CALL equations_create_start(equations_set,equations,err,error,*999)
2453  CALL equations_linearity_type_set(equations,equations_linear,err,error,*999)
2454  CALL equations_time_dependence_type_set(equations,equations_static,err,error,*999)
2455  ELSE
2456  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
2457  ENDIF
2458  CASE(equations_set_setup_finish_action)
2459  SELECT CASE(equations_set%SOLUTION_METHOD)
2460  CASE(equations_set_fem_solution_method)
2461  !Finish the equations creation
2462  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
2463  CALL equations_create_finish(equations,err,error,*999)
2464  !Create the equations mapping.
2465  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
2466  CALL equationsmapping_linearmatricesnumberset(equations_mapping,1,err,error,*999)
2467  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,(/field_u_variable_type/), &
2468  & err,error,*999)
2469  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
2470  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
2471  !Create the equations matrices
2472  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
2473  SELECT CASE(equations%SPARSITY_TYPE)
2474  CASE(equations_matrices_full_matrices)
2475  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_block_storage_type/), &
2476  & err,error,*999)
2477  CASE(equations_matrices_sparse_matrices)
2478  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_compressed_row_storage_type/), &
2479  & err,error,*999)
2480  CALL equationsmatrices_linearstructuretypeset(equations_matrices,(/equations_matrix_fem_structure/), &
2481  & err,error,*999)
2482  CASE DEFAULT
2483  local_error="The equations matrices sparsity type of "// &
2484  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
2485  CALL flagerror(local_error,err,error,*999)
2486  END SELECT
2487  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
2488  CASE(equations_set_bem_solution_method)
2489  CALL flagerror("Not implemented.",err,error,*999)
2490  CASE(equations_set_fd_solution_method)
2491  CALL flagerror("Not implemented.",err,error,*999)
2492  CASE(equations_set_fv_solution_method)
2493  CALL flagerror("Not implemented.",err,error,*999)
2494  CASE(equations_set_gfem_solution_method)
2495  CALL flagerror("Not implemented.",err,error,*999)
2496  CASE(equations_set_gfv_solution_method)
2497  CALL flagerror("Not implemented.",err,error,*999)
2498  CASE DEFAULT
2499  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
2500  & " is invalid."
2501  CALL flagerror(local_error,err,error,*999)
2502  END SELECT
2503  CASE DEFAULT
2504  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2505  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2506  & " is invalid for a standard Galerkin projection."
2507  CALL flagerror(local_error,err,error,*999)
2508  END SELECT
2509 
2510  !-----------------------------------------------------------------
2511  ! c a s e d e f a u l t
2512  !-----------------------------------------------------------------
2513  CASE DEFAULT
2514  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2515  & " is invalid for a standard Galerkin projection."
2516  CALL flagerror(local_error,err,error,*999)
2517  END SELECT
2518  ELSE
2519  local_error="The equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
2520  & " does not equal a standard Galerkin projection subtype."
2521  CALL flagerror(local_error,err,error,*999)
2522  ENDIF
2523  ELSE
2524  CALL flagerror("Equations set is not associated.",err,error,*999)
2525  ENDIF
2526 
2527  exits("FITTING_EQUATIONS_SET_STANDARD_SETUP")
2528  RETURN
2529 999 errorsexits("FITTING_EQUATIONS_SET_STANDARD_SETUP",err,error)
2530  RETURN 1
2531  END SUBROUTINE fitting_equations_set_standard_setup
2532 
2533  !
2534  !================================================================================================================================
2535  !
2536 
2538  SUBROUTINE fitting_equations_set_vectordata_setup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
2539 
2540  !Argument variables
2541  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
2542  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
2543  INTEGER(INTG), INTENT(OUT) :: ERR
2544  TYPE(varying_string), INTENT(OUT) :: ERROR
2545  !Local Variables
2546  INTEGER(INTG) :: GEOMETRIC_MESH_COMPONENT,GEOMETRIC_SCALING_TYPE,GEOMETRIC_COMPONENT_NUMBER
2547  INTEGER(INTG) :: NUMBER_OF_DIMENSIONS,I !,MATERIAL_FIELD_NUMBER_OF_VARIABLES
2548  INTEGER(INTG) :: INDEPENDENT_FIELD_NUMBER_OF_COMPONENTS,INDEPENDENT_FIELD_NUMBER_OF_VARIABLES
2549  INTEGER(INTG) :: dependentFieldNumberOfVariables
2550  INTEGER(INTG) :: dimensionIdx
2551  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
2552  TYPE(decomposition_type), POINTER :: GEOMETRIC_DECOMPOSITION
2553 ! TYPE(FIELD_TYPE), POINTER :: ANALYTIC_FIELD,DEPENDENT_FIELD,GEOMETRIC_FIELD
2554  TYPE(equations_type), POINTER :: EQUATIONS
2555  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
2556  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
2557  TYPE(equations_set_materials_type), POINTER :: EQUATIONS_MATERIALS
2558  TYPE(varying_string) :: LOCAL_ERROR
2559 
2560  enters("FITTING_EQUATION_SET_VECTORDATA_SETUP",err,error,*999)
2561 
2562  NULLIFY(boundary_conditions)
2563  NULLIFY(equations)
2564  NULLIFY(equations_mapping)
2565  NULLIFY(equations_matrices)
2566  NULLIFY(geometric_decomposition)
2567 
2568  IF(ASSOCIATED(equations_set)) THEN
2569  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
2570  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
2571  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
2572  CALL flagerror("Equations set specification must have three entries for a fitting type equations set.", &
2573  & err,error,*999)
2574  END IF
2575  SELECT CASE(equations_set%SPECIFICATION(3))
2576  CASE(equations_set_vector_data_fitting_subtype, &
2577  & equations_set_vector_data_pre_fitting_subtype, &
2578  & equations_set_divfree_vector_data_fitting_subtype, &
2579  & equations_set_divfree_vector_data_pre_fitting_subtype)
2580  SELECT CASE(equations_set_setup%SETUP_TYPE)
2581  !-----------------------------------------------------------------
2582  ! s o l u t i o n m e t h o d
2583  !-----------------------------------------------------------------
2584  CASE(equations_set_setup_initial_type)
2585  SELECT CASE(equations_set_setup%ACTION_TYPE)
2586  CASE(equations_set_setup_start_action)
2587  CALL fitting_equations_set_solution_method_set(equations_set,equations_set_fem_solution_method, &
2588  & err,error,*999)
2589  CASE(equations_set_setup_finish_action)
2590  !Do nothing
2591  CASE DEFAULT
2592  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2593  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2594  & " is invalid for a vector data Galerkin projection."
2595  CALL flagerror(local_error,err,error,*999)
2596  END SELECT
2597 
2598  !-----------------------------------------------------------------
2599  ! g e o m e t r y f i e l d
2600  !-----------------------------------------------------------------
2601  CASE(equations_set_setup_geometry_type)
2602  !Do nothing
2603 
2604  !-----------------------------------------------------------------
2605  ! d e p e n d e n t f i e l d
2606  !-----------------------------------------------------------------
2607  CASE(equations_set_setup_dependent_type)
2608  SELECT CASE(equations_set_setup%ACTION_TYPE)
2609  CASE(equations_set_setup_start_action)
2610  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
2611  !Create the auto created dependent field
2612  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
2613  & dependent_field,err,error,*999)
2614  CALL field_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,"Dependent Field",err,error,*999)
2615  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
2616  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
2617  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
2618  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
2619  & err,error,*999)
2620  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
2621  & geometric_field,err,error,*999)
2622  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,2,err,error,*999)
2623  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,(/field_u_variable_type, &
2624  & field_deludeln_variable_type/),err,error,*999)
2625  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,"Phi",err,error,*999)
2626  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,"del Phi/del n", &
2627  & err,error,*999)
2628  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
2629  & field_vector_dimension_type,err,error,*999)
2630  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
2631  & field_vector_dimension_type,err,error,*999)
2632  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
2633  & field_dp_type,err,error,*999)
2634  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
2635  & field_dp_type,err,error,*999)
2636  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2637  & number_of_dimensions,err,error,*999)
2638  !calculate number of components with one component for each dimension and one for pressure
2639  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,1, &
2640  & geometric_mesh_component,err,error,*999)
2641  IF(equations_set%SPECIFICATION(3)==equations_set_vector_data_fitting_subtype.OR. &
2642  & equations_set%SPECIFICATION(3)==equations_set_vector_data_pre_fitting_subtype) THEN
2643  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
2644  & number_of_dimensions,err,error,*999)
2645 ! ! CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
2646 ! ! & 1,ERR,ERROR,*999)
2647 
2648  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
2649  & number_of_dimensions,err,error,*999)
2650 ! ! CALL FIELD_NUMBER_OF_COMPONENTS_SET_AND_LOCK(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_DELUDELN_VARIABLE_TYPE, &
2651 ! ! & 1,ERR,ERROR,*999)
2652 
2653 ! DO I=1,1
2654  DO i=1,number_of_dimensions
2655  !Default to the geometric interpolation setup
2656  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,i, &
2657  & geometric_mesh_component,err,error,*999)
2658  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,i, &
2659  & geometric_mesh_component,err,error,*999)
2660  END DO
2661  ELSE IF(equations_set%SPECIFICATION(3)==equations_set_divfree_vector_data_fitting_subtype.OR. &
2662  equations_set%SPECIFICATION(3)==equations_set_divfree_vector_data_pre_fitting_subtype) THEN
2663  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
2664  & number_of_dimensions+1,err,error,*999)
2665  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
2666  & number_of_dimensions+1,err,error,*999)
2667  DO i=1,number_of_dimensions+1
2668  !Default to the geometric interpolation setup
2669  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,i, &
2670  & geometric_mesh_component,err,error,*999)
2671  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,i, &
2672  & geometric_mesh_component,err,error,*999)
2673  END DO
2674  ENDIF
2675  SELECT CASE(equations_set%SOLUTION_METHOD)
2676  CASE(equations_set_fem_solution_method)
2677  IF(equations_set%SPECIFICATION(3)==equations_set_vector_data_fitting_subtype) THEN
2678 ! DO I=1,NUMBER_OF_DIMENSIONS
2679  DO i=1,1
2680  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
2681  & field_u_variable_type,i,field_node_based_interpolation,err,error,*999)
2682  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
2683  & field_deludeln_variable_type,i,field_node_based_interpolation,err,error,*999)
2684  END DO
2685  ELSE IF(equations_set%SPECIFICATION(3)==equations_set_divfree_vector_data_fitting_subtype) THEN
2686  DO i=1,number_of_dimensions+1
2687  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
2688  & field_u_variable_type,i,field_node_based_interpolation,err,error,*999)
2689  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
2690  & field_deludeln_variable_type,i,field_node_based_interpolation,err,error,*999)
2691  END DO
2692  ENDIF
2693  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
2694  & err,error,*999)
2695  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type, &
2696  & err,error,*999)
2697  !Other solutions not defined yet
2698  CASE(equations_set_bem_solution_method)
2699  CALL flagerror("Not implemented.",err,error,*999)
2700  CASE(equations_set_fd_solution_method)
2701  CALL flagerror("Not implemented.",err,error,*999)
2702  CASE(equations_set_fv_solution_method)
2703  CALL flagerror("Not implemented.",err,error,*999)
2704  CASE(equations_set_gfem_solution_method)
2705  CALL flagerror("Not implemented.",err,error,*999)
2706  CASE(equations_set_gfv_solution_method)
2707  CALL flagerror("Not implemented.",err,error,*999)
2708  CASE DEFAULT
2709  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
2710  & " is invalid."
2711  CALL flagerror(local_error,err,error,*999)
2712  END SELECT
2713  ELSE
2714  !Check the user specified field
2715  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
2716  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
2717  CALL field_number_of_variables_check(equations_set_setup%FIELD,2,err,error,*999)
2718  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type,field_deludeln_variable_type/), &
2719  & err,error,*999)
2720  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
2721  & err,error,*999)
2722  CALL field_dimension_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_vector_dimension_type, &
2723  & err,error,*999)
2724  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
2725  CALL field_data_type_check(equations_set_setup%FIELD,field_deludeln_variable_type,field_dp_type,err,error,*999)
2726  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2727  & number_of_dimensions,err,error,*999)
2728  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
2729  & number_of_dimensions,err,error,*999)
2730  CALL field_number_of_components_check(equations_set_setup%FIELD,field_deludeln_variable_type, &
2731  & number_of_dimensions,err,error,*999)
2732  SELECT CASE(equations_set%SOLUTION_METHOD)
2733  CASE(equations_set_fem_solution_method)
2734  IF(equations_set%SPECIFICATION(3)==equations_set_vector_data_fitting_subtype) THEN
2735  DO i=1,number_of_dimensions
2736  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
2737  & field_u_variable_type,i,field_node_based_interpolation,err,error,*999)
2738  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
2739  & field_deludeln_variable_type,i,field_node_based_interpolation,err,error,*999)
2740  END DO
2741  ELSEIF(equations_set%SPECIFICATION(3)==equations_set_divfree_vector_data_fitting_subtype) THEN
2742  DO i=1,number_of_dimensions+1
2743  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
2744  & field_u_variable_type,i,field_node_based_interpolation,err,error,*999)
2745  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
2746  & field_deludeln_variable_type,i,field_node_based_interpolation,err,error,*999)
2747  END DO
2748  ENDIF
2749  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
2750  & err,error,*999)
2751  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type, &
2752  & err,error,*999)
2753  !Other solutions not defined yet
2754  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
2755  & field_node_based_interpolation,err,error,*999)
2756  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
2757  & field_node_based_interpolation,err,error,*999)
2758  CASE(equations_set_bem_solution_method)
2759  CALL flagerror("Not implemented.",err,error,*999)
2760  CASE(equations_set_fd_solution_method)
2761  CALL flagerror("Not implemented.",err,error,*999)
2762  CASE(equations_set_fv_solution_method)
2763  CALL flagerror("Not implemented.",err,error,*999)
2764  CASE(equations_set_gfem_solution_method)
2765  CALL flagerror("Not implemented.",err,error,*999)
2766  CASE(equations_set_gfv_solution_method)
2767  CALL flagerror("Not implemented.",err,error,*999)
2768  CASE DEFAULT
2769  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
2770  & " is invalid."
2771  CALL flagerror(local_error,err,error,*999)
2772  END SELECT
2773  ENDIF
2774  CASE(equations_set_setup_finish_action)
2775  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
2776  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
2777  ENDIF
2778  CASE DEFAULT
2779  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2780  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2781  & " is invalid for an update-materials Galerkin projection"
2782  CALL flagerror(local_error,err,error,*999)
2783  END SELECT
2784 
2785  !-----------------------------------------------------------------
2786  ! I N d e p e n d e n t f i e l d
2787  !-----------------------------------------------------------------
2788  CASE(equations_set_setup_independent_type)
2789  SELECT CASE(equations_set_setup%ACTION_TYPE)
2790  !Set start action
2791  CASE(equations_set_setup_start_action)
2792  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
2793  !Create the auto created independent field
2794  !start field creation with name 'INDEPENDENT_FIELD'
2795  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
2796  & equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
2797  !start creation of a new field
2798  CALL field_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
2799  !define new created field to be independent
2800  CALL field_dependent_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
2801  & field_independent_type,err,error,*999)
2802  !look for decomposition rule already defined
2803  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
2804  & err,error,*999)
2805  !apply decomposition rule found on new created field
2806  CALL field_mesh_decomposition_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
2807  & geometric_decomposition,err,error,*999)
2808  !point new field to geometric field
2809  CALL field_geometric_field_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,equations_set% &
2810  & geometry%GEOMETRIC_FIELD,err,error,*999)
2811  !set number of variables to 1 (1 for U)
2812  independent_field_number_of_variables=1
2813  CALL field_number_of_variables_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
2814  & independent_field_number_of_variables,err,error,*999)
2815  CALL field_variable_types_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
2816  & (/field_u_variable_type/),err,error,*999)
2817  CALL field_dimension_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
2818  & field_vector_dimension_type,err,error,*999)
2819  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
2820  & field_dp_type,err,error,*999)
2821  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2822  & number_of_dimensions,err,error,*999)
2823  !calculate number of components with one component for each dimension
2824  independent_field_number_of_components=number_of_dimensions
2825  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
2826  & field_u_variable_type,independent_field_number_of_components,err,error,*999)
2827  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2828  & 1,geometric_mesh_component,err,error,*999)
2829  !Default to the geometric interpolation setup
2830  DO i=1,independent_field_number_of_components
2831  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
2832  & field_u_variable_type,i,geometric_mesh_component,err,error,*999)
2833  END DO
2834  ELSE
2835  !Check the user specified field
2836  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
2837  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
2838  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
2839  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type/),err,error,*999)
2840  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
2841  & err,error,*999)
2842  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
2843  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2844  & number_of_dimensions,err,error,*999)
2845  !calculate number of components with one component for each dimension
2846  independent_field_number_of_components=number_of_dimensions
2847  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
2848  & independent_field_number_of_components,err,error,*999)
2849  ENDIF
2850  !Specify finish action
2851  CASE(equations_set_setup_finish_action)
2852  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
2853  CALL field_create_finish(equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
2854  ENDIF
2855  CALL field_parameter_set_create(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
2856  & field_boundary_set_type,err,error,*999)
2857  CASE DEFAULT
2858  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2859  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2860  & " is invalid for an update-materials Galerkin projection"
2861  CALL flagerror(local_error,err,error,*999)
2862  END SELECT
2863 
2864  !-----------------------------------------------------------------
2865  ! m a t e r i a l f i e l d
2866  !-----------------------------------------------------------------
2867  CASE(equations_set_setup_materials_type)
2868  SELECT CASE(equations_set_setup%ACTION_TYPE)
2869  CASE(equations_set_setup_start_action)
2870  !Do nothing
2871  equations_materials=>equations_set%MATERIALS
2872  IF(ASSOCIATED(equations_materials)) THEN
2873  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
2874  !Create the auto created materials field
2875  !start field creation with name 'MATERIAL_FIELD'
2876  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set% &
2877  & materials%MATERIALS_FIELD,err,error,*999)
2878  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
2879  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type, &
2880  & err,error,*999)
2881  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
2882  & err,error,*999)
2883  !apply decomposition rule found on new created field
2884  CALL field_mesh_decomposition_set_and_lock(equations_set%MATERIALS%MATERIALS_FIELD, &
2885  & geometric_decomposition,err,error,*999)
2886  !point new field to geometric field
2887  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
2888  & geometric_field,err,error,*999)
2889  CALL field_number_of_variables_set(equations_materials%MATERIALS_FIELD, &
2890  & 1,err,error,*999)
2891  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,(/field_u_variable_type/), &
2892  & err,error,*999)
2893  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2894  & field_vector_dimension_type,err,error,*999)
2895  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2896  & field_dp_type,err,error,*999)
2897  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2898  & 2,err,error,*999)
2899  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2900  & 1,geometric_component_number,err,error,*999)
2901  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2902  & 1,geometric_component_number,err,error,*999)
2903  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2904  & 2,geometric_component_number,err,error,*999)
2905  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2906  & 1,field_node_based_interpolation,err,error,*999)
2907  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2908  & 2,field_node_based_interpolation,err,error,*999)
2909  !Default the field scaling to that of the geometric field
2910  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
2911  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
2912  ELSE
2913  !Check the user specified field
2914  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
2915  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
2916  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
2917  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type/),err,error,*999)
2918  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
2919  & err,error,*999)
2920  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
2921  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2922  & number_of_dimensions,err,error,*999)
2923  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1,err,error,*999)
2924  ENDIF
2925  ELSE
2926  CALL flagerror("Equations set materials is not associated.",err,error,*999)
2927  END IF
2928  CASE(equations_set_setup_finish_action)
2929  equations_materials=>equations_set%MATERIALS
2930  IF(ASSOCIATED(equations_materials)) THEN
2931  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
2932  !Finish creating the materials field
2933  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
2934  !Set the default values for the materials field
2935  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2936  & field_values_set_type,1,0.0_dp,err,error,*999)
2937  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
2938  & field_values_set_type,2,0.0_dp,err,error,*999)
2939  ENDIF
2940  ELSE
2941  CALL flagerror("Equations set materials is not associated.",err,error,*999)
2942  ENDIF
2943  CASE DEFAULT
2944  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
2945  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
2946  & " is invalid for an update-materials Galerkin projection."
2947  CALL flagerror(local_error,err,error,*999)
2948  END SELECT
2949 
2950  !-----------------------------------------------------------------
2951  ! s o u r c e t y p e
2952  !-----------------------------------------------------------------
2953  CASE(equations_set_setup_source_type)
2954  SELECT CASE(equations_set%SPECIFICATION(3))
2955  CASE(equations_set_vector_data_fitting_subtype,equations_set_divfree_vector_data_fitting_subtype, &
2956  & equations_set_vector_data_pre_fitting_subtype,equations_set_divfree_vector_data_pre_fitting_subtype)
2957  SELECT CASE(equations_set_setup%ACTION_TYPE)
2958  !Set start action
2959  CASE(equations_set_setup_start_action)
2960  IF(equations_set%SOURCE%SOURCE_FIELD_AUTO_CREATED) THEN
2961  !Create the auto created source field
2962  !start field creation with name 'SOURCE_FIELD'
2963  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
2964  & equations_set%SOURCE%SOURCE_FIELD,err,error,*999)
2965  !start creation of a new field
2966  CALL field_type_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_general_type,err,error,*999)
2967  !label the field
2968  CALL field_label_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,"Source Field",err,error, &
2969  & *999)
2970  !define new created field to be source
2971  CALL field_dependent_type_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
2972  & field_independent_type,err,error,*999)
2973  !look for decomposition rule already defined
2974  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
2975  & err,error,*999)
2976  !apply decomposition rule found on new created field
2977  CALL field_mesh_decomposition_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
2978  & geometric_decomposition,err,error,*999)
2979  !point new field to geometric field
2980  CALL field_geometric_field_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,equations_set% &
2981  & geometry%GEOMETRIC_FIELD,err,error,*999)
2982  CALL field_number_of_variables_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
2983  & 1,err,error,*999)
2984  CALL field_variable_types_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
2985  & (/field_u_variable_type/),err,error,*999)
2986  CALL field_dimension_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
2987  & field_vector_dimension_type,err,error,*999)
2988  CALL field_data_type_set_and_lock(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
2989  & field_dp_type,err,error,*999)
2990  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2991  & number_of_dimensions,err,error,*999)
2992  CALL field_number_of_components_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
2993  & field_u_variable_type,number_of_dimensions,err,error,*999)
2994  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
2995  & 1,geometric_mesh_component,err,error,*999)
2996  !Default to the geometric interpolation setup
2997  CALL field_component_mesh_component_set(equations_set%SOURCE%SOURCE_FIELD, &
2998  & field_u_variable_type,1,geometric_mesh_component,err,error,*999)
2999  SELECT CASE(equations_set%SOLUTION_METHOD)
3000  !Specify fem solution method
3001  CASE(equations_set_fem_solution_method)
3002  CALL field_component_interpolation_set_and_lock(equations_set%SOURCE%SOURCE_FIELD, &
3003  & field_u_variable_type,1,field_node_based_interpolation,err,error,*999)
3004  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
3005  & err,error,*999)
3006  CALL field_scaling_type_set(equations_set%SOURCE%SOURCE_FIELD,geometric_scaling_type, &
3007  & err,error,*999)
3008  !Other solutions not defined yet
3009  CASE DEFAULT
3010  local_error="The solution method of " &
3011  & //trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// " is invalid."
3012  CALL flagerror(local_error,err,error,*999)
3013  END SELECT
3014  ELSE
3015  !Check the user specified field
3016  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
3017  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
3018  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
3019  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type/),err,error,*999)
3020  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
3021  & err,error,*999)
3022  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
3023  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
3024  & number_of_dimensions,err,error,*999)
3025  !calculate number of components with one component for each dimension and one for pressure
3026  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
3027  & number_of_dimensions,err,error,*999)
3028  SELECT CASE(equations_set%SOLUTION_METHOD)
3029  CASE(equations_set_fem_solution_method)
3030  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
3031  & field_node_based_interpolation,err,error,*999)
3032  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_deludeln_variable_type,1, &
3033  & field_node_based_interpolation,err,error,*999)
3034  CASE DEFAULT
3035  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD, &
3036  &"*",err,error))//" is invalid."
3037  CALL flagerror(local_error,err,error,*999)
3038  END SELECT
3039  ENDIF
3040  !Specify finish action
3041  CASE(equations_set_setup_finish_action)
3042  IF(equations_set%SOURCE%SOURCE_FIELD_AUTO_CREATED) THEN
3043  CALL field_create_finish(equations_set%SOURCE%SOURCE_FIELD,err,error,*999)
3044  !These 2 parameter sets will contain the fitted hermite/lagrange velocity field
3045 ! CALL FIELD_PARAMETER_SET_CREATE(EQUATIONS_SET%SOURCE%SOURCE_FIELD,FIELD_U_VARIABLE_TYPE, &
3046 ! & FIELD_INPUT_DATA1_SET_TYPE,ERR,ERROR,*999)
3047 ! CALL FIELD_PARAMETER_SET_CREATE(EQUATIONS_SET%SOURCE%SOURCE_FIELD,FIELD_U_VARIABLE_TYPE, &
3048 ! & FIELD_INPUT_DATA2_SET_TYPE,ERR,ERROR,*999)
3049 
3050 ! CALL FIELD_PARAMETER_SET_CREATE(EQUATIONS_SET%SOURCE%SOURCE_FIELD,FIELD_U_VARIABLE_TYPE, &
3051 ! & FIELD_INPUT_DATA3_SET_TYPE,ERR,ERROR,*999)
3052 ! CALL FIELD_PARAMETER_SET_CREATE(EQUATIONS_SET%SOURCE%SOURCE_FIELD,FIELD_U_VARIABLE_TYPE, &
3053 ! & FIELD_BOUNDARY_SET_TYPE,ERR,ERROR,*999)
3054  ENDIF
3055  CASE DEFAULT
3056  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
3057  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
3058  & " is invalid for a standard PEE problem"
3059  CALL flagerror(local_error,err,error,*999)
3060  END SELECT
3061  CASE DEFAULT
3062  local_error="The equation set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
3063  & " for a setup sub type of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
3064  & " is invalid for a PPE equation."
3065  CALL flagerror(local_error,err,error,*999)
3066  END SELECT
3067 ! ! ! CASE(EQUATIONS_SET_SETUP_ANALYTIC_TYPE)
3068 ! ! ! SELECT CASE(EQUATIONS_SET_SETUP%ACTION_TYPE)
3069 ! ! ! CASE(EQUATIONS_SET_SETUP_START_ACTION)
3070 ! ! ! IF(EQUATIONS_SET%DEPENDENT%DEPENDENT_FINISHED) THEN
3071 ! ! ! DEPENDENT_FIELD=>EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD
3072 ! ! ! IF(ASSOCIATED(DEPENDENT_FIELD)) THEN
3073 ! ! ! GEOMETRIC_FIELD=>EQUATIONS_SET%GEOMETRY%GEOMETRIC_FIELD
3074 ! ! ! IF(ASSOCIATED(GEOMETRIC_FIELD)) THEN
3075 ! ! ! CALL FIELD_NUMBER_OF_COMPONENTS_GET(GEOMETRIC_FIELD,FIELD_U_VARIABLE_TYPE,NUMBER_OF_DIMENSIONS,ERR,ERROR,*999)
3076 ! ! ! SELECT CASE(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE)
3077 ! ! ! CASE(EQUATIONS_SET_FITTING_TWO_DIM_1)
3078 ! ! ! !Check that we are in 2D
3079 ! ! ! IF(NUMBER_OF_DIMENSIONS/=2) THEN
3080 ! ! ! LOCAL_ERROR="The number of geometric dimensions of "// &
3081 ! ! ! & TRIM(NUMBER_TO_VSTRING(NUMBER_OF_DIMENSIONS,"*",ERR,ERROR))// &
3082 ! ! ! & " is invalid. The analytic function type of "// &
3083 ! ! ! & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",ERR,ERROR))// &
3084 ! ! ! & " requires that there be 2 geometric dimensions."
3085 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
3086 ! ! ! ENDIF
3087 ! ! ! !Create analytic field if required
3088 ! ! ! !Set analtyic function type
3089 ! ! ! EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_FITTING_TWO_DIM_1
3090 ! ! ! CASE(EQUATIONS_SET_FITTING_TWO_DIM_2)
3091 ! ! ! !Check that we are in 2D
3092 ! ! ! IF(NUMBER_OF_DIMENSIONS/=2) THEN
3093 ! ! ! LOCAL_ERROR="The number of geometric dimensions of "// &
3094 ! ! ! & TRIM(NUMBER_TO_VSTRING(NUMBER_OF_DIMENSIONS,"*",ERR,ERROR))// &
3095 ! ! ! & " is invalid. The analytic function type of "// &
3096 ! ! ! & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",ERR,ERROR))// &
3097 ! ! ! & " requires that there be 2 geometric dimensions."
3098 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
3099 ! ! ! ENDIF
3100 ! ! ! !Create analytic field if required
3101 ! ! ! !Set analtyic function type
3102 ! ! ! EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_FITTING_TWO_DIM_2
3103 ! ! ! CASE(EQUATIONS_SET_FITTING_THREE_DIM_1)
3104 ! ! ! !Check that we are in 3D
3105 ! ! ! IF(NUMBER_OF_DIMENSIONS/=3) THEN
3106 ! ! ! LOCAL_ERROR="The number of geometric dimensions of "// &
3107 ! ! ! & TRIM(NUMBER_TO_VSTRING(NUMBER_OF_DIMENSIONS,"*",ERR,ERROR))// &
3108 ! ! ! & " is invalid. The analytic function type of "// &
3109 ! ! ! & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",ERR,ERROR))// &
3110 ! ! ! & " requires that there be 3 geometric dimensions."
3111 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
3112 ! ! ! ENDIF
3113 ! ! ! !Create analytic field if required
3114 ! ! ! !Set analtyic function type
3115 ! ! ! EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_FITTING_THREE_DIM_1
3116 ! ! ! CASE(EQUATIONS_SET_FITTING_THREE_DIM_2)
3117 ! ! ! !Check that we are in 3D
3118 ! ! ! IF(NUMBER_OF_DIMENSIONS/=3) THEN
3119 ! ! ! LOCAL_ERROR="The number of geometric dimensions of "// &
3120 ! ! ! & TRIM(NUMBER_TO_VSTRING(NUMBER_OF_DIMENSIONS,"*",ERR,ERROR))// &
3121 ! ! ! & " is invalid. The analytic function type of "// &
3122 ! ! ! & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",ERR,ERROR))// &
3123 ! ! ! & " requires that there be 3 geometric dimensions."
3124 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
3125 ! ! ! ENDIF
3126 ! ! ! !Create analytic field if required
3127 ! ! ! !Set analtyic function type
3128 ! ! ! EQUATIONS_SET%ANALYTIC%ANALYTIC_FUNCTION_TYPE=EQUATIONS_SET_FITTING_THREE_DIM_2
3129 ! ! ! CASE DEFAULT
3130 ! ! ! LOCAL_ERROR="The specified analytic function type of "// &
3131 ! ! ! & TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ANALYTIC_FUNCTION_TYPE,"*",ERR,ERROR))// &
3132 ! ! ! & " is invalid for a standard Galerkin projection."
3133 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
3134 ! ! ! END SELECT
3135 ! ! ! ELSE
3136 ! ! ! CALL FlagError("Equations set geometric field is not associated.",ERR,ERROR,*999)
3137 ! ! ! ENDIF
3138 ! ! ! ELSE
3139 ! ! ! CALL FlagError("Equations set dependent field is not associated.",ERR,ERROR,*999)
3140 ! ! ! ENDIF
3141 ! ! ! ELSE
3142 ! ! ! CALL FlagError("Equations set dependent field has not been finished.",ERR,ERROR,*999)
3143 ! ! ! ENDIF
3144 ! ! ! CASE(EQUATIONS_SET_SETUP_FINISH_ACTION)
3145 ! ! ! IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN
3146 ! ! ! ANALYTIC_FIELD=>EQUATIONS_SET%ANALYTIC%ANALYTIC_FIELD
3147 ! ! ! IF(ASSOCIATED(ANALYTIC_FIELD)) THEN
3148 ! ! ! IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED) THEN
3149 ! ! ! CALL FIELD_CREATE_FINISH(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,ERR,ERROR,*999)
3150 ! ! ! ENDIF
3151 ! ! ! ENDIFstandard
3152 ! ! ! ELSE
3153 ! ! ! CALL FlagError("Equations set analytic is not associated.",ERR,ERROR,*999)
3154 ! ! ! ENDIF
3155 ! ! ! CASE(EQUATIONS_SET_SETUP_GENERATE_ACTION)
3156 ! ! ! IF(EQUATIONS_SET%DEPENDENT%DEPENDENT_FINISHED) THEN
3157 ! ! ! IF(ASSOCIATED(EQUATIONS_SET%ANALYTIC)) THEN
3158 ! ! ! IF(EQUATIONS_SET%ANALYTIC%ANALYTIC_FINISHED) THEN
3159 ! ! ! CALL FITTING_ANALYTIC_CALCULATE(EQUATIONS_SET,ERR,ERROR,*999)
3160 ! ! ! ELSE
3161 ! ! ! CALL FlagError("Equations set analtyic has not been finished.",ERR,ERROR,*999)
3162 ! ! ! ENDIF
3163 ! ! ! ELSE
3164 ! ! ! CALL FlagError("Equations set analtyic is not associated.",ERR,ERROR,*999)
3165 ! ! ! ENDIF
3166 ! ! ! ELSE
3167 ! ! ! CALL FlagError("Equations set dependent has not been finished.",ERR,ERROR,*999)
3168 ! ! ! ENDIF
3169 ! ! ! CASE DEFAULT
3170 ! ! ! LOCAL_ERROR="The action type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%ACTION_TYPE,"*",ERR,ERROR))// &
3171 ! ! ! & " for a setup type of "//TRIM(NUMBER_TO_VSTRING(EQUATIONS_SET_SETUP%SETUP_TYPE,"*",ERR,ERROR))// &
3172 ! ! ! & " is invalid for a standard Galerkin projection."
3173 ! ! ! CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999)
3174 ! ! ! END SELECT
3175 
3176  !-----------------------------------------------------------------
3177  ! e q u a t i o n s t y p e
3178  !-----------------------------------------------------------------
3179  CASE(equations_set_setup_equations_type)
3180  SELECT CASE(equations_set_setup%ACTION_TYPE)
3181  CASE(equations_set_setup_start_action)
3182  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
3183  CALL equations_create_start(equations_set,equations,err,error,*999)
3184  CALL equations_linearity_type_set(equations,equations_linear,err,error,*999)
3185  CALL equations_time_dependence_type_set(equations,equations_quasistatic,err,error,*999)
3186  ELSE
3187  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
3188  ENDIF
3189  CASE(equations_set_setup_finish_action)
3190  SELECT CASE(equations_set%SOLUTION_METHOD)
3191  CASE(equations_set_fem_solution_method)
3192  !Finish the equations creation
3193  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
3194  CALL equations_create_finish(equations,err,error,*999)
3195  !Create the equations mapping.
3196  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
3197  CALL equationsmapping_linearmatricesnumberset(equations_mapping,1,err,error,*999)
3198  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,(/field_u_variable_type/), &
3199  & err,error,*999)
3200  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
3201  CALL equations_mapping_source_variable_type_set(equations_mapping,field_u_variable_type,err,error,*999)
3202  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
3203  !Create the equations matrices
3204  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
3205  SELECT CASE(equations%SPARSITY_TYPE)
3206  CASE(equations_matrices_full_matrices)
3207  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_block_storage_type/), &
3208  & err,error,*999)
3209  CASE(equations_matrices_sparse_matrices)
3210  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_compressed_row_storage_type/), &
3211  & err,error,*999)
3212  CALL equationsmatrices_linearstructuretypeset(equations_matrices,(/equations_matrix_fem_structure/), &
3213  & err,error,*999)
3214  CASE DEFAULT
3215  local_error="The equations matrices sparsity type of "// &
3216  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
3217  CALL flagerror(local_error,err,error,*999)
3218  END SELECT
3219  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
3220  CASE(equations_set_bem_solution_method)
3221  CALL flagerror("Not implemented.",err,error,*999)
3222  CASE(equations_set_fd_solution_method)
3223  CALL flagerror("Not implemented.",err,error,*999)
3224  CASE(equations_set_fv_solution_method)
3225  CALL flagerror("Not implemented.",err,error,*999)
3226  CASE(equations_set_gfem_solution_method)
3227  CALL flagerror("Not implemented.",err,error,*999)
3228  CASE(equations_set_gfv_solution_method)
3229  CALL flagerror("Not implemented.",err,error,*999)
3230  CASE DEFAULT
3231  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
3232  & " is invalid."
3233  CALL flagerror(local_error,err,error,*999)
3234  END SELECT
3235  CASE DEFAULT
3236  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
3237  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
3238  & " is invalid for a vector data Galerkin projection."
3239  CALL flagerror(local_error,err,error,*999)
3240  END SELECT
3241  CASE DEFAULT
3242  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
3243  & " is invalid for a vector data Galerkin projection."
3244  CALL flagerror(local_error,err,error,*999)
3245  END SELECT
3246 
3247  CASE(equationsset_datapointvectorstaticfittingsubtype, &
3248  & equationsset_datapointvectorquasistaticfittingsubtype)
3249  SELECT CASE(equations_set_setup%SETUP_TYPE)
3250  !-----------------------------------------------------------------
3251  ! s o l u t i o n m e t h o d
3252  !-----------------------------------------------------------------
3253  CASE(equations_set_setup_initial_type)
3254  SELECT CASE(equations_set_setup%ACTION_TYPE)
3255  CASE(equations_set_setup_start_action)
3256  CALL fitting_equations_set_solution_method_set(equations_set,equations_set_fem_solution_method, &
3257  & err,error,*999)
3258  CASE(equations_set_setup_finish_action)
3259  !Do nothing
3260  CASE DEFAULT
3261  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
3262  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
3263  & " is invalid for a vector data Galerkin projection."
3264  CALL flagerror(local_error,err,error,*999)
3265  END SELECT
3266  !-----------------------------------------------------------------
3267  ! g e o m e t r y f i e l d
3268  !-----------------------------------------------------------------
3269  CASE(equations_set_setup_geometry_type)
3270  !Do nothing
3271  !-----------------------------------------------------------------
3272  ! S o u r c e f i e l d
3273  !-----------------------------------------------------------------
3274  CASE(equations_set_setup_source_type)
3275  ! Do nothing
3276  !-----------------------------------------------------------------
3277  ! D e p e n d e n t f i e l d
3278  ! (this field will hold the mesh fitted data from the data points field)
3279  !-----------------------------------------------------------------
3280  CASE(equations_set_setup_dependent_type)
3281  SELECT CASE(equations_set_setup%ACTION_TYPE)
3282  !Set start action
3283  CASE(equations_set_setup_start_action)
3284  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
3285  !Create the auto created dependent field
3286  !start field creation with name 'DEPENDENT_FIELD'
3287  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
3288  & equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
3289  !start creation of a new field
3290  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
3291  !define new created field to be dependent
3292  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
3293  & field_dependent_type,err,error,*999)
3294  !look for decomposition rule already defined
3295  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
3296  & err,error,*999)
3297  !apply decomposition rule found on new created field
3298  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
3299  & geometric_decomposition,err,error,*999)
3300  !point new field to geometric field
3301  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set% &
3302  & geometry%GEOMETRIC_FIELD,err,error,*999)
3303  !set number of variables to 2 (U, delUdelN)
3304  dependentfieldnumberofvariables=2
3305  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
3306  & dependentfieldnumberofvariables,err,error,*999)
3307  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
3308  & [field_u_variable_type,field_deludeln_variable_type],err,error,*999)
3309  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,"Phi",err,error,*999)
3310  CALL field_variable_label_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,"del Phi/del n", &
3311  & err,error,*999)
3312  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
3313  & field_vector_dimension_type,err,error,*999)
3314  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
3315  & field_vector_dimension_type,err,error,*999)
3316  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
3317  & field_dp_type,err,error,*999)
3318  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
3319  & field_dp_type,err,error,*999)
3320  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
3321  & number_of_dimensions,err,error,*999)
3322  !calculate number of components with one component for each dimension
3323  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,1, &
3324  & geometric_mesh_component,err,error,*999)
3325  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
3326  & number_of_dimensions,err,error,*999)
3327  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
3328  & number_of_dimensions,err,error,*999)
3329  DO i=1,number_of_dimensions
3330  !Default to the geometric interpolation setup
3331  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,i, &
3332  & geometric_mesh_component,err,error,*999)
3333  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,i, &
3334  & geometric_mesh_component,err,error,*999)
3335  END DO
3336  SELECT CASE(equations_set%SOLUTION_METHOD)
3337  CASE(equations_set_fem_solution_method)
3338  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
3339  & field_u_variable_type,1,field_node_based_interpolation,err,error,*999)
3340  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
3341  & field_deludeln_variable_type,1,field_node_based_interpolation,err,error,*999)
3342  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
3343  & err,error,*999)
3344  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type, &
3345  & err,error,*999)
3346  !Other solutions not defined yet
3347  CASE(equations_set_bem_solution_method)
3348  CALL flagerror("Not implemented.",err,error,*999)
3349  CASE(equations_set_fd_solution_method)
3350  CALL flagerror("Not implemented.",err,error,*999)
3351  CASE(equations_set_fv_solution_method)
3352  CALL flagerror("Not implemented.",err,error,*999)
3353  CASE(equations_set_gfem_solution_method)
3354  CALL flagerror("Not implemented.",err,error,*999)
3355  CASE(equations_set_gfv_solution_method)
3356  CALL flagerror("Not implemented.",err,error,*999)
3357  CASE DEFAULT
3358  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
3359  & " is invalid."
3360  CALL flagerror(local_error,err,error,*999)
3361  END SELECT
3362  ELSE
3363  !Check the user specified field
3364  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
3365  CALL field_dependent_type_check(equations_set_setup%FIELD,field_dependent_type,err,error,*999)
3366  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
3367  & err,error,*999)
3368  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
3369  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
3370  & number_of_dimensions,err,error,*999)
3371  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
3372  & number_of_dimensions,err,error,*999)
3373  SELECT CASE(equations_set%SOLUTION_METHOD)
3374  CASE(equations_set_fem_solution_method)
3375  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
3376  & field_node_based_interpolation,err,error,*999)
3377  CASE(equations_set_bem_solution_method)
3378  CALL flagerror("Not implemented.",err,error,*999)
3379  CASE(equations_set_fd_solution_method)
3380  CALL flagerror("Not implemented.",err,error,*999)
3381  CASE(equations_set_fv_solution_method)
3382  CALL flagerror("Not implemented.",err,error,*999)
3383  CASE(equations_set_gfem_solution_method)
3384  CALL flagerror("Not implemented.",err,error,*999)
3385  CASE(equations_set_gfv_solution_method)
3386  CALL flagerror("Not implemented.",err,error,*999)
3387  CASE DEFAULT
3388  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
3389  & " is invalid."
3390  CALL flagerror(local_error,err,error,*999)
3391  END SELECT
3392  ENDIF
3393  CASE(equations_set_setup_finish_action)
3394  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
3395  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
3396  ENDIF
3397  CASE DEFAULT
3398  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
3399  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
3400  & " is invalid for an update-materials Galerkin projection"
3401  CALL flagerror(local_error,err,error,*999)
3402  END SELECT
3403  !-----------------------------------------------------------------
3404  ! m a t e r i a l f i e l d
3405  !-----------------------------------------------------------------
3406  CASE(equations_set_setup_materials_type)
3407  SELECT CASE(equations_set_setup%ACTION_TYPE)
3408  CASE(equations_set_setup_start_action)
3409  equations_materials=>equations_set%MATERIALS
3410  IF(ASSOCIATED(equations_materials)) THEN
3411  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
3412  !Create the auto created materials field
3413  !start field creation with name 'MATERIAL_FIELD'
3414  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set% &
3415  & materials%MATERIALS_FIELD,err,error,*999)
3416  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
3417  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type, &
3418  & err,error,*999)
3419  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
3420  & err,error,*999)
3421  !apply decomposition rule found on new created field
3422  CALL field_mesh_decomposition_set_and_lock(equations_set%MATERIALS%MATERIALS_FIELD, &
3423  & geometric_decomposition,err,error,*999)
3424  !point new field to geometric field
3425  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
3426  & geometric_field,err,error,*999)
3427  CALL field_number_of_variables_set(equations_materials%MATERIALS_FIELD,1,err,error,*999)
3428  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,[field_u_variable_type], &
3429  & err,error,*999)
3430  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
3431  & field_vector_dimension_type,err,error,*999)
3432  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
3433  & field_dp_type,err,error,*999)
3434  ! Sobelov smoothing material parameters- tau and kappa
3435  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
3436  & 2,err,error,*999)
3437  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
3438  & 1,geometric_component_number,err,error,*999)
3439  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
3440  & 1,geometric_component_number,err,error,*999)
3441  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
3442  & 2,geometric_component_number,err,error,*999)
3443  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
3444  & 1,field_constant_interpolation,err,error,*999)
3445  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
3446  & 2,field_constant_interpolation,err,error,*999)
3447  !Default the field scaling to that of the geometric field
3448  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
3449  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
3450  ELSE
3451  !Check the user specified field
3452  CALL field_type_check(equations_set_setup%FIELD,field_material_type,err,error,*999)
3453  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
3454  CALL field_number_of_variables_check(equations_set_setup%FIELD,1,err,error,*999)
3455  CALL field_variable_types_check(equations_set_setup%FIELD,(/field_u_variable_type/),err,error,*999)
3456  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
3457  & err,error,*999)
3458  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
3459  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
3460  & number_of_dimensions,err,error,*999)
3461  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type,1,err,error,*999)
3462  ENDIF
3463  ELSE
3464  CALL flagerror("Equations set materials is not associated.",err,error,*999)
3465  END IF
3466  CASE(equations_set_setup_finish_action)
3467  equations_materials=>equations_set%MATERIALS
3468  IF(ASSOCIATED(equations_materials)) THEN
3469  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
3470  !Finish creating the materials field
3471  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
3472  !Set the default values for the materials field
3473  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
3474  & field_values_set_type,1,0.0_dp,err,error,*999)
3475  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
3476  & field_values_set_type,2,0.0_dp,err,error,*999)
3477  ENDIF
3478  ELSE
3479  CALL flagerror("Equations set materials is not associated.",err,error,*999)
3480  ENDIF
3481  CASE DEFAULT
3482  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
3483  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
3484  & " is invalid for an update-materials Galerkin projection."
3485  CALL flagerror(local_error,err,error,*999)
3486  END SELECT
3487  !-----------------------------------------------------------------
3488  ! I n d e p e n d e n t t y p e
3489  ! (this field holds the data point based field of vectors to map to the dependent field)
3490  !-----------------------------------------------------------------
3491  CASE(equations_set_setup_independent_type)
3492  SELECT CASE(equations_set_setup%ACTION_TYPE)
3493  !Set start action
3494  CASE(equations_set_setup_start_action)
3495  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
3496  !Create the auto created independent field
3497  !start field creation with name 'INDEPENDENT_FIELD'
3498  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION, &
3499  & equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
3500  !start creation of a new field
3501  CALL field_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
3502  !label the field
3503  CALL field_label_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,"Independent Field",err,error, &
3504  & *999)
3505  !define new created field to be independent
3506  CALL field_dependent_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
3507  & field_independent_type,err,error,*999)
3508  !look for decomposition rule already defined
3509  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition, &
3510  & err,error,*999)
3511  !apply decomposition rule found on new created field
3512  CALL field_mesh_decomposition_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
3513  & geometric_decomposition,err,error,*999)
3514  !point new field to geometric field
3515  CALL field_geometric_field_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,equations_set% &
3516  & geometry%GEOMETRIC_FIELD,err,error,*999)
3517  CALL field_number_of_variables_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
3518  & 2,err,error,*999)
3519  CALL field_variable_types_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
3520  & [field_u_variable_type,field_v_variable_type],err,error,*999)
3521  ! U Variable: data point vectors
3522  CALL field_dimension_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
3523  & field_vector_dimension_type,err,error,*999)
3524  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
3525  & field_dp_type,err,error,*999)
3526  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
3527  & number_of_dimensions,err,error,*999)
3528  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
3529  & field_u_variable_type,number_of_dimensions,err,error,*999)
3530  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
3531  & 1,geometric_mesh_component,err,error,*999)
3532  !Default to the geometric interpolation setup
3533  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
3534  & field_u_variable_type,1,geometric_mesh_component,err,error,*999)
3535  ! V Variable: data point weights
3536  CALL field_dimension_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type, &
3537  & field_scalar_dimension_type,err,error,*999)
3538  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_v_variable_type, &
3539  & field_dp_type,err,error,*999)
3540  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
3541  & field_v_variable_type,1,err,error,*999)
3542  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
3543  & 1,geometric_mesh_component,err,error,*999)
3544  !Default to the geometric interpolation setup
3545  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
3546  & field_v_variable_type,1,geometric_mesh_component,err,error,*999)
3547  SELECT CASE(equations_set%SOLUTION_METHOD)
3548  !Specify fem solution method
3549  CASE(equations_set_fem_solution_method)
3550  DO dimensionidx = 1,number_of_dimensions
3551  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
3552  & field_u_variable_type,dimensionidx,field_data_point_based_interpolation,err,error,*999)
3553  ENDDO
3554  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
3555  & field_v_variable_type,1,field_data_point_based_interpolation,err,error,*999)
3556  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type, &
3557  & err,error,*999)
3558  CALL field_scaling_type_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_scaling_type, &
3559  & err,error,*999)
3560  !Other solutions not defined yet
3561  CASE DEFAULT
3562  local_error="The solution method of " &
3563  & //trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// " is invalid."
3564  CALL flagerror(local_error,err,error,*999)
3565  END SELECT
3566  ELSE
3567  !Check the user specified field
3568  CALL field_type_check(equations_set_setup%FIELD,field_general_type,err,error,*999)
3569  CALL field_dependent_type_check(equations_set_setup%FIELD,field_independent_type,err,error,*999)
3570  ! U (vector) variable
3571  CALL field_dimension_check(equations_set_setup%FIELD,field_u_variable_type,field_vector_dimension_type, &
3572  & err,error,*999)
3573  CALL field_data_type_check(equations_set_setup%FIELD,field_u_variable_type,field_dp_type,err,error,*999)
3574  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
3575  & number_of_dimensions,err,error,*999)
3576  !calculate number of components with one component for each dimension
3577  CALL field_number_of_components_check(equations_set_setup%FIELD,field_u_variable_type, &
3578  & number_of_dimensions,err,error,*999)
3579  ! V (weight) variable
3580  CALL field_dimension_check(equations_set_setup%FIELD,field_v_variable_type,field_scalar_dimension_type, &
3581  & err,error,*999)
3582  CALL field_data_type_check(equations_set_setup%FIELD,field_v_variable_type,field_dp_type,err,error,*999)
3583  SELECT CASE(equations_set%SOLUTION_METHOD)
3584  CASE(equations_set_fem_solution_method)
3585  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_u_variable_type,1, &
3586  & field_data_point_based_interpolation,err,error,*999)
3587  CALL field_component_interpolation_check(equations_set_setup%FIELD,field_v_variable_type,1, &
3588  & field_data_point_based_interpolation,err,error,*999)
3589  CASE DEFAULT
3590  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD, &
3591  &"*",err,error))//" is invalid."
3592  CALL flagerror(local_error,err,error,*999)
3593  END SELECT
3594  ENDIF
3595  !Specify finish action
3596  CASE(equations_set_setup_finish_action)
3597  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
3598  CALL field_create_finish(equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
3599  ENDIF
3600  CASE DEFAULT
3601  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
3602  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
3603  & " is invalid for a standard PEE problem"
3604  CALL flagerror(local_error,err,error,*999)
3605  END SELECT
3606  !-----------------------------------------------------------------
3607  ! e q u a t i o n s t y p e
3608  !-----------------------------------------------------------------
3609  CASE(equations_set_setup_equations_type)
3610  SELECT CASE(equations_set_setup%ACTION_TYPE)
3611  CASE(equations_set_setup_start_action)
3612  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
3613  CALL equations_create_start(equations_set,equations,err,error,*999)
3614  CALL equations_linearity_type_set(equations,equations_linear,err,error,*999)
3615  IF (equations_set%SPECIFICATION(3)==equationsset_datapointvectorstaticfittingsubtype) THEN
3616  CALL equations_time_dependence_type_set(equations,equations_static,err,error,*999)
3617  ELSE IF (equations_set%SPECIFICATION(3)==equationsset_datapointvectorquasistaticfittingsubtype) THEN
3618  CALL equations_time_dependence_type_set(equations,equations_quasistatic,err,error,*999)
3619  ENDIF
3620  ELSE
3621  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
3622  ENDIF
3623  CASE(equations_set_setup_finish_action)
3624  SELECT CASE(equations_set%SOLUTION_METHOD)
3625  CASE(equations_set_fem_solution_method)
3626  !Finish the equations creation
3627  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
3628  CALL equations_create_finish(equations,err,error,*999)
3629  !Create the equations mapping.
3630  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
3631  CALL equationsmapping_linearmatricesnumberset(equations_mapping,1,err,error,*999)
3632  CALL equationsmapping_linearmatricesvariabletypesset(equations_mapping,(/field_u_variable_type/), &
3633  & err,error,*999)
3634  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
3635  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
3636  !Create the equations matrices
3637  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
3638  SELECT CASE(equations%SPARSITY_TYPE)
3639  CASE(equations_matrices_full_matrices)
3640  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_block_storage_type/), &
3641  & err,error,*999)
3642  CASE(equations_matrices_sparse_matrices)
3643  CALL equations_matrices_linear_storage_type_set(equations_matrices,(/matrix_compressed_row_storage_type/), &
3644  & err,error,*999)
3645  CALL equationsmatrices_linearstructuretypeset(equations_matrices,(/equations_matrix_fem_structure/), &
3646  & err,error,*999)
3647  CASE DEFAULT
3648  local_error="The equations matrices sparsity type of "// &
3649  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
3650  CALL flagerror(local_error,err,error,*999)
3651  END SELECT
3652  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
3653  CASE(equations_set_bem_solution_method)
3654  CALL flagerror("Not implemented.",err,error,*999)
3655  CASE(equations_set_fd_solution_method)
3656  CALL flagerror("Not implemented.",err,error,*999)
3657  CASE(equations_set_fv_solution_method)
3658  CALL flagerror("Not implemented.",err,error,*999)
3659  CASE(equations_set_gfem_solution_method)
3660  CALL flagerror("Not implemented.",err,error,*999)
3661  CASE(equations_set_gfv_solution_method)
3662  CALL flagerror("Not implemented.",err,error,*999)
3663  CASE DEFAULT
3664  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
3665  & " is invalid."
3666  CALL flagerror(local_error,err,error,*999)
3667  END SELECT
3668  CASE DEFAULT
3669  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
3670  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
3671  & " is invalid for a vector data Galerkin projection."
3672  CALL flagerror(local_error,err,error,*999)
3673  END SELECT
3674  CASE DEFAULT
3675  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
3676  & " is invalid for a vector data Galerkin projection."
3677  CALL flagerror(local_error,err,error,*999)
3678  END SELECT
3679  CASE DEFAULT
3680  local_error="The equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
3681  & " does not equal a vector data Galerkin projection subtype."
3682  CALL flagerror(local_error,err,error,*999)
3683  END SELECT
3684  ELSE
3685  CALL flagerror("Equations set is not associated.",err,error,*999)
3686  ENDIF
3687 
3688  exits("FITTING_EQUATIONS_SET_VECTORDATA_SETUP")
3689  RETURN
3690 999 errorsexits("FITTING_EQUATIONS_SET_VECTORDATA_SETUP",err,error)
3691  RETURN 1
3692  END SUBROUTINE fitting_equations_set_vectordata_setup
3693 
3694  !
3695  !================================================================================================================================
3696  !
3697 
3699  SUBROUTINE fitting_problem_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
3700 
3701  !Argument variables
3702  TYPE(problem_type), POINTER :: PROBLEM
3703  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
3704  INTEGER(INTG), INTENT(OUT) :: ERR
3705  TYPE(varying_string), INTENT(OUT) :: ERROR
3706  !Local Variables
3707  TYPE(varying_string) :: LOCAL_ERROR
3708 
3709  enters("FITTING_PROBLEM_SETUP",err,error,*999)
3710 
3711  IF(ASSOCIATED(problem)) THEN
3712  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
3713  CALL flagerror("Problem specification is not allocated.",err,error,*999)
3714  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
3715  CALL flagerror("Problem specification must have three entries for a fitting problem.",err,error,*999)
3716  END IF
3717  SELECT CASE(problem%SPECIFICATION(3))
3718  CASE(problem_standard_data_fitting_subtype)
3719  CALL fitting_problem_standard_setup(problem,problem_setup,err,error,*999)
3720  CASE(problem_vector_data_fitting_subtype)
3721  CALL fitting_problem_vectordata_setup(problem,problem_setup,err,error,*999)
3722  CASE(problem_div_free_vector_data_fitting_subtype)
3723  CALL fitting_problem_vectordata_setup(problem,problem_setup,err,error,*999)
3724  CASE(problem_datapointvectorstaticfittingsubtype)
3725  CALL fitting_problem_vectordata_setup(problem,problem_setup,err,error,*999)
3726  CASE(problem_datapointvectorquasistaticfittingsubtype)
3727  CALL fitting_problem_vectordata_setup(problem,problem_setup,err,error,*999)
3728  CASE(problem_generalised_data_fitting_subtype)
3729  CALL flagerror("Not implemented.",err,error,*999)
3730  CASE DEFAULT
3731  local_error="Problem subtype "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
3732  & " is not valid for a Galerkin projection type of a data fitting problem class."
3733  CALL flagerror(local_error,err,error,*999)
3734  END SELECT
3735  ELSE
3736  CALL flagerror("Problem is not associated.",err,error,*999)
3737  ENDIF
3738 
3739  exits("FITTING_PROBLEM_SETUP")
3740  RETURN
3741 999 errorsexits("FITTING_PROBLEM_SETUP",err,error)
3742  RETURN 1
3743  END SUBROUTINE fitting_problem_setup
3744 
3745  !
3746  !================================================================================================================================
3747  !
3748 
3750  SUBROUTINE fitting_problem_standard_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
3751 
3752  !Argument variables
3753  TYPE(problem_type), POINTER :: PROBLEM
3754  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
3755  INTEGER(INTG), INTENT(OUT) :: ERR
3756  TYPE(varying_string), INTENT(OUT) :: ERROR
3757  !Local Variables
3758  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT
3759  TYPE(solver_type), POINTER :: SOLVER
3760  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
3761  TYPE(solvers_type), POINTER :: SOLVERS
3762  TYPE(varying_string) :: LOCAL_ERROR
3763 
3764  enters("FITTING_PROBLEM_STANDARD_SETUP",err,error,*999)
3765 
3766  NULLIFY(control_loop)
3767  NULLIFY(solver)
3768  NULLIFY(solver_equations)
3769  NULLIFY(solvers)
3770  IF(ASSOCIATED(problem)) THEN
3771  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
3772  CALL flagerror("Problem specification is not allocated.",err,error,*999)
3773  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
3774  CALL flagerror("Problem specification must have three entries for a fitting problem.",err,error,*999)
3775  END IF
3776  IF(problem%SPECIFICATION(3)==problem_standard_data_fitting_subtype) THEN
3777  SELECT CASE(problem_setup%SETUP_TYPE)
3778  CASE(problem_setup_initial_type)
3779  SELECT CASE(problem_setup%ACTION_TYPE)
3780  CASE(problem_setup_start_action)
3781  !Do nothing????
3782  CASE(problem_setup_finish_action)
3783  !Do nothing???
3784  CASE DEFAULT
3785  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3786  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3787  & " is invalid for a standard Galerkin projection."
3788  CALL flagerror(local_error,err,error,*999)
3789  END SELECT
3790  CASE(problem_setup_control_type)
3791  SELECT CASE(problem_setup%ACTION_TYPE)
3792  CASE(problem_setup_start_action)
3793  !Set up a simple control loop
3794  CALL control_loop_create_start(problem,control_loop,err,error,*999)
3795  CASE(problem_setup_finish_action)
3796  !Finish the control loops
3797  control_loop_root=>problem%CONTROL_LOOP
3798  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3799  CALL control_loop_create_finish(control_loop,err,error,*999)
3800  CASE DEFAULT
3801  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3802  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3803  & " is invalid for a standard Galerkin projection."
3804  CALL flagerror(local_error,err,error,*999)
3805  END SELECT
3806  CASE(problem_setup_solvers_type)
3807  !Get the control loop
3808  control_loop_root=>problem%CONTROL_LOOP
3809  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3810  SELECT CASE(problem_setup%ACTION_TYPE)
3811  CASE(problem_setup_start_action)
3812  !Start the solvers creation
3813  CALL solvers_create_start(control_loop,solvers,err,error,*999)
3814  CALL solvers_number_set(solvers,1,err,error,*999)
3815  !Set the solver to be a linear solver
3816  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3817  CALL solver_type_set(solver,solver_linear_type,err,error,*999)
3818  !Set solver defaults
3819  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
3820  CASE(problem_setup_finish_action)
3821  !Get the solvers
3822  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3823  !Finish the solvers creation
3824  CALL solvers_create_finish(solvers,err,error,*999)
3825  CASE DEFAULT
3826  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3827  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3828  & " is invalid for a standard Galerkin projection."
3829  CALL flagerror(local_error,err,error,*999)
3830  END SELECT
3831  CASE(problem_setup_solver_equations_type)
3832  SELECT CASE(problem_setup%ACTION_TYPE)
3833  CASE(problem_setup_start_action)
3834  !Get the control loop
3835  control_loop_root=>problem%CONTROL_LOOP
3836  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3837  !Get the solver
3838  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3839  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3840  !Create the solver equations
3841  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3842  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
3843  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
3844  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3845  CASE(problem_setup_finish_action)
3846  !Get the control loop
3847  control_loop_root=>problem%CONTROL_LOOP
3848  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3849  !Get the solver equations
3850  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3851  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3852  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
3853  !Finish the solver equations creation
3854  CALL solver_equations_create_finish(solver_equations,err,error,*999)
3855  CASE DEFAULT
3856  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3857  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3858  & " is invalid for a standard Galerkin projection."
3859  CALL flagerror(local_error,err,error,*999)
3860  END SELECT
3861  CASE DEFAULT
3862  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3863  & " is invalid for a standard Galerkin projection."
3864  CALL flagerror(local_error,err,error,*999)
3865  END SELECT
3866  ELSE
3867  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
3868  & " does not equal a standard Galerkin projection subtype."
3869  CALL flagerror(local_error,err,error,*999)
3870  ENDIF
3871  ELSE
3872  CALL flagerror("Problem is not associated.",err,error,*999)
3873  ENDIF
3874 
3875  exits("FITTING_PROBLEM_STANDARD_SETUP")
3876  RETURN
3877 999 errorsexits("FITTING_PROBLEM_STANDARD_SETUP",err,error)
3878  RETURN 1
3879  END SUBROUTINE fitting_problem_standard_setup
3880 
3881  !
3882  !================================================================================================================================
3883  !
3884 
3886  SUBROUTINE fitting_problem_vectordata_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
3887 
3888  !Argument variables
3889  TYPE(problem_type), POINTER :: PROBLEM
3890  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
3891  INTEGER(INTG), INTENT(OUT) :: ERR
3892  TYPE(varying_string), INTENT(OUT) :: ERROR
3893  !Local Variables
3894  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT
3895  TYPE(solver_type), POINTER :: SOLVER
3896  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
3897  TYPE(solvers_type), POINTER :: SOLVERS
3898  TYPE(varying_string) :: LOCAL_ERROR
3899 
3900  enters("FITTING_PROBLEM_VECTORDATA_SETUP",err,error,*999)
3901 
3902  NULLIFY(control_loop)
3903  NULLIFY(solver)
3904  NULLIFY(solver_equations)
3905  NULLIFY(solvers)
3906  IF(ASSOCIATED(problem)) THEN
3907  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
3908  CALL flagerror("Problem specification is not allocated.",err,error,*999)
3909  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
3910  CALL flagerror("Problem specification must have three entries for a fitting problem.",err,error,*999)
3911  END IF
3912  IF(problem%SPECIFICATION(3)==problem_vector_data_fitting_subtype.OR. &
3913  & problem%SPECIFICATION(3)==problem_datapointvectorstaticfittingsubtype .OR. &
3914  & problem%SPECIFICATION(3)==problem_datapointvectorquasistaticfittingsubtype .OR. &
3915  & problem%SPECIFICATION(3)==problem_div_free_vector_data_fitting_subtype) THEN
3916  SELECT CASE(problem_setup%SETUP_TYPE)
3917  CASE(problem_setup_initial_type)
3918  SELECT CASE(problem_setup%ACTION_TYPE)
3919  CASE(problem_setup_start_action)
3920  !Do nothing????
3921  CASE(problem_setup_finish_action)
3922  !Do nothing???
3923  CASE DEFAULT
3924  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3925  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3926  & " is invalid for a vector data Galerkin projection."
3927  CALL flagerror(local_error,err,error,*999)
3928  END SELECT
3929  CASE(problem_setup_control_type)
3930  SELECT CASE(problem_setup%ACTION_TYPE)
3931  CASE(problem_setup_start_action)
3932  !Set up a simple control loop
3933  CALL control_loop_create_start(problem,control_loop,err,error,*999)
3934  IF(problem%SPECIFICATION(3)==problem_datapointvectorstaticfittingsubtype) THEN
3935  CALL control_loop_type_set(control_loop,problem_control_simple_type,err,error,*999)
3936  ELSE
3937  CALL control_loop_type_set(control_loop,problem_control_time_loop_type,err,error,*999)
3938  ENDIF
3939  CASE(problem_setup_finish_action)
3940  !Finish the control loops
3941  control_loop_root=>problem%CONTROL_LOOP
3942  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3943  CALL control_loop_create_finish(control_loop,err,error,*999)
3944  CASE DEFAULT
3945  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3946  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3947  & " is invalid for a vector data Galerkin projection."
3948  CALL flagerror(local_error,err,error,*999)
3949  END SELECT
3950  CASE(problem_setup_solvers_type)
3951  !Get the control loop
3952  control_loop_root=>problem%CONTROL_LOOP
3953  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3954  SELECT CASE(problem_setup%ACTION_TYPE)
3955  CASE(problem_setup_start_action)
3956  !Start the solvers creation
3957  CALL solvers_create_start(control_loop,solvers,err,error,*999)
3958  CALL solvers_number_set(solvers,1,err,error,*999)
3959  !Set the solver to be a linear solver
3960  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3961  CALL solver_type_set(solver,solver_linear_type,err,error,*999)
3962  !Set solver defaults
3963  CALL solver_library_type_set(solver,solver_petsc_library,err,error,*999)
3964  CASE(problem_setup_finish_action)
3965  !Get the solvers
3966  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3967  !Finish the solvers creation
3968  CALL solvers_create_finish(solvers,err,error,*999)
3969  CASE DEFAULT
3970  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
3971  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
3972  & " is invalid for a vector data Galerkin projection."
3973  CALL flagerror(local_error,err,error,*999)
3974  END SELECT
3975  CASE(problem_setup_solver_equations_type)
3976  SELECT CASE(problem_setup%ACTION_TYPE)
3977  CASE(problem_setup_start_action)
3978  !Get the control loop
3979  control_loop_root=>problem%CONTROL_LOOP
3980  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3981  !Get the solver
3982  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3983  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
3984  !Create the solver equations
3985  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
3986  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
3987  IF(problem%SPECIFICATION(3)==problem_datapointvectorstaticfittingsubtype) THEN
3988  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_static,err,error,*999)
3989  ELSE
3990  CALL solver_equations_time_dependence_type_set(solver_equations,solver_equations_quasistatic,err,error,*999)
3991  ENDIF
3992  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
3993  CASE(problem_setup_finish_action)
3994  !Get the control loop
3995  control_loop_root=>problem%CONTROL_LOOP
3996  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
3997  !Get the solver equations
3998  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
3999  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
4000  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
4001  !Finish the solver equations creation
4002  CALL solver_equations_create_finish(solver_equations,err,error,*999)
4003  CASE DEFAULT
4004  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
4005  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4006  & " is invalid for a vector data Galerkin projection."
4007  CALL flagerror(local_error,err,error,*999)
4008  END SELECT
4009  CASE DEFAULT
4010  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
4011  & " is invalid for a vector data Galerkin projection."
4012  CALL flagerror(local_error,err,error,*999)
4013  END SELECT
4014  ELSE
4015  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
4016  & " does not equal a vector data Galerkin projection subtype."
4017  CALL flagerror(local_error,err,error,*999)
4018  ENDIF
4019  ELSE
4020  CALL flagerror("Problem is not associated.",err,error,*999)
4021  ENDIF
4022 
4023  exits("FITTING_PROBLEM_VECTORDATA_SETUP")
4024  RETURN
4025 999 errorsexits("FITTING_PROBLEM_VECTORDATA_SETUP",err,error)
4026  RETURN 1
4027  END SUBROUTINE fitting_problem_vectordata_setup
4028 
4029  !
4030  !================================================================================================================================
4031  !
4032 
4034  SUBROUTINE fitting_problemspecificationset(problem,problemSpecification,err,error,*)
4035 
4036  !Argument variables
4037  TYPE(problem_type), POINTER :: problem
4038  INTEGER(INTG), INTENT(IN) :: problemSpecification(:)
4039  INTEGER(INTG), INTENT(OUT) :: err
4040  TYPE(varying_string), INTENT(OUT) :: error
4041  !Local Variables
4042  TYPE(varying_string) :: localError
4043  INTEGER(INTG) :: problemType,problemSubtype
4044 
4045  enters("Fitting_ProblemSpecificationSet",err,error,*999)
4046 
4047  IF(ASSOCIATED(problem)) THEN
4048  IF(SIZE(problemspecification,1)==3) THEN
4049  problemtype=problemspecification(2)
4050  problemsubtype=problemspecification(3)
4051  SELECT CASE(problemtype)
4052  CASE(problem_data_fitting_type)
4053  SELECT CASE(problemsubtype)
4054  CASE(problem_standard_data_fitting_subtype, &
4055  & problem_vector_data_fitting_subtype, &
4056  & problem_div_free_vector_data_fitting_subtype, &
4057  & problem_datapointvectorstaticfittingsubtype, &
4058  & problem_datapointvectorquasistaticfittingsubtype)
4059  !ok
4060  CASE(problem_generalised_data_fitting_subtype)
4061  CALL flag_error("Not implemented.",err,error,*999)
4062  CASE DEFAULT
4063  localerror="The third problem specification of "//trim(numbertovstring(problemsubtype,"*",err,error))// &
4064  & " is not valid for a Galerkin projection type of a data fitting problem."
4065  CALL flagerror(localerror,err,error,*999)
4066  END SELECT
4067  CASE DEFAULT
4068  localerror="The second problem specification of "//trim(numbertovstring(problemtype,"*",err,error))// &
4069  & " is not valid for a data fitting problem."
4070  CALL flagerror(localerror,err,error,*999)
4071  END SELECT
4072  IF(ALLOCATED(problem%specification)) THEN
4073  CALL flagerror("Problem specification is already allocated.",err,error,*999)
4074  ELSE
4075  ALLOCATE(problem%specification(3),stat=err)
4076  IF(err/=0) CALL flagerror("Could not allocate problem specification.",err,error,*999)
4077  END IF
4078  problem%specification(1:3)=[problem_fitting_class,problemtype,problemsubtype]
4079  ELSE
4080  CALL flagerror("Fitting problem specification must have three entries.",err,error,*999)
4081  END IF
4082  ELSE
4083  CALL flagerror("Problem is not associated",err,error,*999)
4084  END IF
4085 
4086  exits("Fitting_ProblemSpecificationSet")
4087  RETURN
4088 999 errors("Fitting_ProblemSpecificationSet",err,error)
4089  exits("Fitting_ProblemSpecificationSet")
4090  RETURN 1
4091 
4092  END SUBROUTINE fitting_problemspecificationset
4093  !
4094  !================================================================================================================================
4095  !
4096 
4098  SUBROUTINE fitting_gauss_deformation_gradient_tensor(REFERENCE_GEOMETRIC_INTERPOLATED_POINT, &
4099  & geometric_interpolated_point, dxdy, jxy, err, error, *)
4100 
4101  !Argument variables
4102  TYPE(field_interpolated_point_type), POINTER :: REFERENCE_GEOMETRIC_INTERPOLATED_POINT, GEOMETRIC_INTERPOLATED_POINT
4103  REAL(DP) :: DXDY(3,3) !DXDY - Deformation Gradient Tensor
4104  REAL(DP) :: Jxy
4105  INTEGER(INTG), INTENT(OUT) :: ERR
4106  TYPE(varying_string), INTENT(OUT) :: ERROR
4107  !Local Variables
4108  INTEGER(INTG) :: derivative_idx,component_idx,xi_idx
4109  REAL(DP) :: DXDXI(3,3),DYDXI(3,3),DXIDY(3,3)
4110  REAL(DP) :: Jyxi
4111 
4112  enters("FITTING_GAUSS_DEFORMATION_GRADIENT_TENSOR",err,error,*999)
4113 
4114  !--- ToDo: Needs to be generalized such that it also works for 2D
4115  DO component_idx=1,3 !Always 3 components - 3D
4116  DO xi_idx=1,3 !Thus 3 element coordinates
4117  derivative_idx=partial_derivative_first_derivative_map(xi_idx) !2,4,7
4118  dxdxi(component_idx,xi_idx)=geometric_interpolated_point%VALUES(component_idx,derivative_idx) !dx/dxi
4119  dydxi(component_idx,xi_idx)=reference_geometric_interpolated_point%VALUES(component_idx,derivative_idx) !dy/dxi (y = referential)
4120  ENDDO
4121  ENDDO
4122 
4123 
4124  CALL invert(dydxi,dxidy,jyxi,err,error,*999) !dy/dxi -> dxi/dy
4125 
4126  CALL matrix_product(dxdxi,dxidy,dxdy,err,error,*999) !dx/dxi * dxi/dy = dx/dy (deformation gradient tensor, F)
4127 
4128  jxy=determinant(dxdy,err,error)
4129 
4130 
4131  exits("FITTING_GAUSS_DEFORMATION_GRADIENT_TENSOR")
4132  RETURN
4133 999 errorsexits("FITTING_GAUSS_DEFORMATION_GRADIENT_TENSOR",err,error)
4134  RETURN 1
4135  END SUBROUTINE fitting_gauss_deformation_gradient_tensor
4136 
4137  !
4138  !================================================================================================================================
4139  !
4140 
4141 
4143  SUBROUTINE fitting_pre_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
4144 
4145  !Argument variables
4146  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
4147  TYPE(solver_type), POINTER :: SOLVER
4148  INTEGER(INTG), INTENT(OUT) :: ERR
4149  TYPE(varying_string), INTENT(OUT) :: ERROR
4150  !Local Variables
4151  TYPE(varying_string) :: LOCAL_ERROR
4152 
4153  enters("FITTING_PRE_SOLVE",err,error,*999)
4154 
4155  IF(ASSOCIATED(control_loop)) THEN
4156  IF(ASSOCIATED(solver)) THEN
4157  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
4158  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
4159  CALL flagerror("Problem specification is not allocated.",err,error,*999)
4160  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
4161  CALL flagerror("Problem specification must have three entries for a fitting problem.",err,error,*999)
4162  END IF
4163  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
4164  CASE(problem_standard_data_fitting_subtype)
4165 ! do nothing
4166  CASE(problem_generalised_data_fitting_subtype)
4167 ! do nothing
4168  CASE(problem_mat_properties_data_fitting_subtype)
4169 ! do nothing
4170  CASE(problem_datapointvectorstaticfittingsubtype)
4171 ! do nothing
4172  CASE(problem_datapointvectorquasistaticfittingsubtype)
4173 ! do nothing
4174  CASE(problem_vector_data_fitting_subtype,problem_div_free_vector_data_fitting_subtype)
4175 ! ! IF(CONTROL_LOOP%WHILE_LOOP%ITERATION_NUMBER==1)THEN
4176  CALL write_string(general_output_type,"Read in vector data... ",err,error,*999)
4177  !Update indpendent data fields
4178  CALL fitting_pre_solve_update_input_data(control_loop,solver,err,error,*999)
4179 ! ! CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"While loop... ",ERR,ERROR,*999)
4180 ! ! ELSE
4181 ! ! CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"While loop... ",ERR,ERROR,*999)
4182 ! ! ENDIF
4183  CASE DEFAULT
4184  local_error="The third problem specification of "// &
4185  & trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
4186  & " is not valid for a data fitting problem class."
4187  CALL flagerror(local_error,err,error,*999)
4188  END SELECT
4189  ELSE
4190  CALL flagerror("Problem is not associated.",err,error,*999)
4191  ENDIF
4192  ELSE
4193  CALL flagerror("Solver is not associated.",err,error,*999)
4194  ENDIF
4195  ELSE
4196  CALL flagerror("Control loop is not associated.",err,error,*999)
4197  ENDIF
4198 
4199  exits("FITTING_PRE_SOLVE")
4200  RETURN
4201 999 errorsexits("FITTING_PRE_SOLVE",err,error)
4202  RETURN 1
4203  END SUBROUTINE fitting_pre_solve
4204 
4205  !
4206  !================================================================================================================================
4207  !
4208 
4210  SUBROUTINE fitting_post_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
4211 
4212  !Argument variables
4213  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
4214  TYPE(solver_type), POINTER :: SOLVER
4215  TYPE(solver_type), POINTER :: SOLVER2
4216  INTEGER(INTG), INTENT(OUT) :: ERR
4217  TYPE(varying_string), INTENT(OUT) :: ERROR
4218  !Local Variables
4219  TYPE(varying_string) :: LOCAL_ERROR
4220 
4221  enters("FITTING_POST_SOLVE",err,error,*999)
4222  NULLIFY(solver2)
4223  IF(ASSOCIATED(control_loop)) THEN
4224  IF(ASSOCIATED(solver)) THEN
4225  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
4226  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
4227  CALL flagerror("Problem specification is not allocated.",err,error,*999)
4228  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
4229  CALL flagerror("Problem specification must have three entries for a fitting problem.",err,error,*999)
4230  END IF
4231  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
4232  CASE(problem_standard_data_fitting_subtype,problem_generalised_data_fitting_subtype, &
4233  & problem_mat_properties_data_fitting_subtype)
4234 ! do nothing
4235  CASE(problem_vector_data_fitting_subtype,problem_div_free_vector_data_fitting_subtype, &
4236  & problem_datapointvectorstaticfittingsubtype)
4237  CALL fitting_post_solve_output_data(control_loop,solver,err,error,*999)
4238  CASE(problem_datapointvectorquasistaticfittingsubtype)
4239  ! do nothing
4240  CASE(problem_vector_data_pre_fitting_subtype,problem_div_free_vector_data_pre_fitting_subtype)
4241 ! do nothing
4242  CASE DEFAULT
4243  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
4244  & " is not valid for a fitting type of a classical field problem class."
4245  CALL flagerror(local_error,err,error,*999)
4246  END SELECT
4247  ELSE
4248  CALL flagerror("Problem is not associated.",err,error,*999)
4249  ENDIF
4250  ELSE
4251  CALL flagerror("Problem is not associated.",err,error,*999)
4252  ENDIF
4253  ENDIF
4254  exits("FITTING_POST_SOLVE")
4255  RETURN
4256 999 errorsexits("FITTING_POST_SOLVE",err,error)
4257  RETURN 1
4258  END SUBROUTINE fitting_post_solve
4259 
4260 
4261  !
4262  !================================================================================================================================
4263  !
4264 
4265 
4267  SUBROUTINE fitting_post_solve_output_data(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
4268 
4269  !Argument variables
4270  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
4271  TYPE(solver_type), POINTER :: SOLVER
4272  INTEGER(INTG), INTENT(OUT) :: ERR
4273  TYPE(varying_string), INTENT(OUT) :: ERROR
4274  !Local Variables
4275  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
4276  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
4277  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
4278  TYPE(varying_string) :: LOCAL_ERROR
4279  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT
4280  INTEGER(INTG) :: EQUATIONS_SET_IDX,CURRENT_LOOP_ITERATION,OUTPUT_ITERATION_NUMBER
4281  TYPE(control_loop_type), POINTER :: CONTROL_TIME_LOOP
4282  LOGICAL :: EXPORT_FIELD
4283  TYPE(varying_string) :: METHOD!,FILE
4284  CHARACTER(7) :: FILE
4285  CHARACTER(7) :: OUTPUT_FILE
4286 
4287  enters("FITTING_POST_SOLVE_OUTPUT_DATA",err,error,*999)
4288 
4289  IF(ASSOCIATED(control_loop)) THEN
4290 ! write(*,*)'CURRENT_TIME = ',CURRENT_TIME
4291 ! write(*,*)'TIME_INCREMENT = ',TIME_INCREMENT
4292  IF(ASSOCIATED(solver)) THEN
4293  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
4294  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
4295  CALL flagerror("Problem specification is not allocated.",err,error,*999)
4296  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
4297  CALL flagerror("Problem specification must have three entries for a fitting problem.",err,error,*999)
4298  END IF
4299  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
4300  CASE(problem_standard_data_fitting_subtype,problem_generalised_data_fitting_subtype, &
4301  & problem_mat_properties_data_fitting_subtype, &
4302  & problem_datapointvectorstaticfittingsubtype)
4303 ! do nothing
4304  CASE(problem_vector_data_pre_fitting_subtype,problem_div_free_vector_data_pre_fitting_subtype)
4305 ! do nothing
4306  CASE(problem_vector_data_fitting_subtype,problem_div_free_vector_data_fitting_subtype)
4307  control_time_loop=>control_loop
4308  CALL control_loop_current_times_get(control_time_loop,current_time,time_increment,err,error,*999)
4309  solver_equations=>solver%SOLVER_EQUATIONS
4310  IF(ASSOCIATED(solver_equations)) THEN
4311  solver_mapping=>solver_equations%SOLVER_MAPPING
4312  IF(ASSOCIATED(solver_mapping)) THEN
4313  !Make sure the equations sets are up to date
4314  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
4315  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
4316  current_loop_iteration=control_time_loop%TIME_LOOP%ITERATION_NUMBER
4317  output_iteration_number=control_time_loop%TIME_LOOP%OUTPUT_NUMBER
4318  IF(output_iteration_number/=0) THEN
4319  IF(control_time_loop%TIME_LOOP%CURRENT_TIME<=control_time_loop%TIME_LOOP%STOP_TIME) THEN
4320  IF(current_loop_iteration<10) THEN
4321  WRITE(output_file,'("DATA_0",I0)') current_loop_iteration
4322  ELSE IF(current_loop_iteration<100) THEN
4323  WRITE(output_file,'("DATA_",I0)') current_loop_iteration
4324  END IF
4325  file=output_file
4326 ! FILE="TRANSIENT_OUTPUT"
4327  method="FORTRAN"
4328  export_field=.true.
4329  IF(export_field) THEN
4330  IF(mod(current_loop_iteration,output_iteration_number)==0) THEN
4331  CALL write_string(general_output_type,"...",err,error,*999)
4332  CALL write_string(general_output_type,"Now export fields... ",err,error,*999)
4333  CALL fluid_mechanics_io_write_fitted_field(equations_set%REGION,equations_set%GLOBAL_NUMBER, &
4334  & output_file,err,error,*999)
4335  CALL write_string(general_output_type,output_file,err,error,*999)
4336  CALL write_string(general_output_type,"...",err,error,*999)
4337  ENDIF
4338  ENDIF
4339  ENDIF
4340  ENDIF
4341  ENDDO
4342  ENDIF
4343  ENDIF
4344  CASE DEFAULT
4345  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
4346  & " is not valid for a fitting equation of a classical field problem class."
4347  CALL flagerror(local_error,err,error,*999)
4348  END SELECT
4349  ELSE
4350  CALL flagerror("Problem is not associated.",err,error,*999)
4351  ENDIF
4352  ELSE
4353  CALL flagerror("Solver is not associated.",err,error,*999)
4354  ENDIF
4355  ELSE
4356  CALL flagerror("Control loop is not associated.",err,error,*999)
4357  ENDIF
4358  exits("FITTING_POST_SOLVE_OUTPUT_DATA")
4359  RETURN
4360 999 errorsexits("FITTING_POST_SOLVE_OUTPUT_DATA",err,error)
4361  RETURN 1
4362  END SUBROUTINE fitting_post_solve_output_data
4363 
4364  !
4365  !================================================================================================================================
4366  !
4367 
4369  SUBROUTINE fitting_pre_solve_update_input_data(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
4370 
4371  !Argument variables
4372  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
4373  TYPE(solver_type), POINTER :: SOLVER
4374  INTEGER(INTG), INTENT(OUT) :: ERR
4375  TYPE(varying_string), INTENT(OUT) :: ERROR
4376  !Local Variables
4377  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
4378  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
4379  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
4380  TYPE(equations_type), POINTER :: EQUATIONS
4381  TYPE(varying_string) :: LOCAL_ERROR
4382 ! ! TYPE(BOUNDARY_CONDITIONS_VARIABLE_TYPE), POINTER :: BOUNDARY_CONDITIONS_VARIABLE
4383 ! ! TYPE(BOUNDARY_CONDITIONS_TYPE), POINTER :: BOUNDARY_CONDITIONS
4384 
4385 ! REAL(DP) :: CURRENT_TIME,TIME_INCREMENT
4386 
4387  INTEGER(INTG) :: NUMBER_OF_DIMENSIONS,CURRENT_LOOP_ITERATION
4388  INTEGER(INTG) :: INPUT_TYPE,INPUT_OPTION
4389  REAL(DP), POINTER :: INPUT_VEL_NEW_DATA(:)!,INPUT_VEL_OLD_DATA(:)
4390 ! REAL(DP), POINTER :: INPUT_VEL_LABEL_DATA(:) !,INPUT_VEL_U_DATA(:),INPUT_VEL_V_DATA(:),INPUT_VEL_W_DATA(:)
4391  TYPE(control_loop_type), POINTER :: CONTROL_TIME_LOOP
4392  REAL(DP) :: CURRENT_TIME,TIME_INCREMENT
4393  LOGICAL :: BOUNDARY_UPDATE
4394 
4395  boundary_update=.false.
4396 
4397  enters("FITTING_PRE_SOLVE_UPDATE_INPUT_DATA",err,error,*999)
4398 
4399  NULLIFY(input_vel_new_data)
4400 
4401  IF(ASSOCIATED(control_loop)) THEN
4402  IF(ASSOCIATED(solver)) THEN
4403  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
4404  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
4405  CALL flagerror("Problem specification is not allocated.",err,error,*999)
4406  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
4407  CALL flagerror("Problem specification must have three entries for a fitting problem.",err,error,*999)
4408  END IF
4409  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
4410  CASE(problem_standard_data_fitting_subtype)
4411 ! do nothing
4412  CASE(problem_generalised_data_fitting_subtype)
4413 ! do nothing
4414  CASE(problem_mat_properties_data_fitting_subtype)
4415 ! do nothing
4416  CASE(problem_datapointvectorstaticfittingsubtype)
4417 ! do nothing
4418  CASE(problem_datapointvectorquasistaticfittingsubtype)
4419 ! do nothing
4420  CASE(problem_vector_data_fitting_subtype,problem_div_free_vector_data_fitting_subtype)
4421 ! do nothing
4422  control_time_loop=>control_loop
4423  CALL control_loop_current_times_get(control_time_loop,current_time,time_increment,err,error,*999)
4424  CALL write_string(general_output_type,"Read input data... ",err,error,*999)
4425  solver_equations=>solver%SOLVER_EQUATIONS
4426  IF(ASSOCIATED(solver_equations)) THEN
4427  solver_mapping=>solver_equations%SOLVER_MAPPING
4428  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(1)%EQUATIONS
4429  IF(ASSOCIATED(equations)) THEN
4430  equations_set=>equations%EQUATIONS_SET
4431  IF(ASSOCIATED(equations_set)) THEN
4432  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
4433  & number_of_dimensions,err,error,*999)
4434  current_loop_iteration=control_time_loop%TIME_LOOP%ITERATION_NUMBER
4435  !this is the current time step
4436 !\todo: Provide possibility for user to define input type and option (that's more or less an IO question)
4437  input_type=1
4438  input_option=1
4439  CALL field_parameter_set_data_get(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
4440 ! ! ! & FIELD_INPUT_DATA1_SET_TYPE,INPUT_VEL_NEW_DATA,ERR,ERROR,*999)
4441  & field_values_set_type,input_vel_new_data,err,error,*999)
4442 ! ! ! CALL FLUID_MECHANICS_IO_READ_DATA(SOLVER_LINEAR_TYPE,INPUT_VEL_NEW_DATA, &
4443 ! ! ! & NUMBER_OF_DIMENSIONS,INPUT_TYPE,INPUT_OPTION,CONTROL_TIME_LOOP%TIME_LOOP%ITERATION_NUMBER,1.0_DP)
4444  CALL fluid_mechanics_io_read_data(solver_linear_type,input_vel_new_data, &
4445  & number_of_dimensions,input_type,input_option,current_loop_iteration,1.0_dp)
4446  !this is the previous time step
4447 ! ! ! !\todo: Provide possibility for user to define input type and option (that's more or less an IO question)
4448 ! ! ! INPUT_TYPE=1
4449 ! ! ! INPUT_OPTION=2
4450 ! ! ! CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET%SOURCE%SOURCE_FIELD,FIELD_U_VARIABLE_TYPE, &
4451 ! ! ! & FIELD_INPUT_DATA2_SET_TYPE,INPUT_VEL_OLD_DATA,ERR,ERROR,*999)
4452 ! ! ! CALL FLUID_MECHANICS_IO_READ_DATA(SOLVER_LINEAR_TYPE,INPUT_VEL_OLD_DATA, &
4453 ! ! ! & NUMBER_OF_DIMENSIONS,INPUT_TYPE,INPUT_OPTION,CONTROL_TIME_LOOP%TIME_LOOP%ITERATION_NUMBER,1.0_DP)
4454 ! ! ! !this is the interior flag
4455 ! ! ! INPUT_TYPE=1
4456 ! ! ! INPUT_OPTION=3
4457 ! ! ! CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
4458 ! ! ! & FIELD_INPUT_LABEL_SET_TYPE,INPUT_VEL_LABEL_DATA,ERR,ERROR,*999)
4459 ! ! ! CALL FLUID_MECHANICS_IO_READ_DATA(SOLVER_LINEAR_TYPE,INPUT_VEL_LABEL_DATA, &
4460 ! ! ! & NUMBER_OF_DIMENSIONS,INPUT_TYPE,INPUT_OPTION,CONTROL_TIME_LOOP%TIME_LOOP%ITERATION_NUMBER,1.0_DP)
4461 ! ! ! !this is the reference U velocity
4462 ! ! ! INPUT_TYPE=1
4463 ! ! ! INPUT_OPTION=4
4464 ! ! ! CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
4465 ! ! ! & FIELD_INPUT_VEL1_SET_TYPE,INPUT_VEL_U_DATA,ERR,ERROR,*999)
4466 ! ! ! CALL FLUID_MECHANICS_IO_READ_DATA(SOLVER_LINEAR_TYPE,INPUT_VEL_U_DATA, &
4467 ! ! ! & NUMBER_OF_DIMENSIONS,INPUT_TYPE,INPUT_OPTION,CONTROL_TIME_LOOP%TIME_LOOP%ITERATION_NUMBER,1.0_DP)
4468 ! ! ! !this is the reference V velocity
4469 ! ! ! INPUT_TYPE=1
4470 ! ! ! INPUT_OPTION=5
4471 ! ! ! CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
4472 ! ! ! & FIELD_INPUT_VEL2_SET_TYPE,INPUT_VEL_V_DATA,ERR,ERROR,*999)
4473 ! ! ! CALL FLUID_MECHANICS_IO_READ_DATA(SOLVER_LINEAR_TYPE,INPUT_VEL_V_DATA, &
4474 ! ! ! & NUMBER_OF_DIMENSIONS,INPUT_TYPE,INPUT_OPTION,CONTROL_TIME_LOOP%TIME_LOOP%ITERATION_NUMBER,1.0_DP)
4475 ! ! ! !this is the reference W velocity
4476 ! ! ! INPUT_TYPE=1
4477 ! ! ! INPUT_OPTION=6
4478 ! ! ! CALL FIELD_PARAMETER_SET_DATA_GET(EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD,FIELD_U_VARIABLE_TYPE, &
4479 ! ! ! & FIELD_INPUT_VEL3_SET_TYPE,INPUT_VEL_W_DATA,ERR,ERROR,*999)
4480 ! ! ! CALL FLUID_MECHANICS_IO_READ_DATA(SOLVER_LINEAR_TYPE,INPUT_VEL_W_DATA, &
4481 ! ! ! & NUMBER_OF_DIMENSIONS,INPUT_TYPE,INPUT_OPTION,CONTROL_TIME_LOOP%TIME_LOOP%ITERATION_NUMBER,1.0_DP)
4482  ELSE
4483  CALL flagerror("Equations set is not associated.",err,error,*999)
4484  END IF
4485  ELSE
4486  CALL flagerror("Equations are not associated.",err,error,*999)
4487  END IF
4488  ELSE
4489  CALL flagerror("Solver equations are not associated.",err,error,*999)
4490  END IF
4491  CASE DEFAULT
4492  local_error="Problem subtype "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(3),"*",err,error))// &
4493  & " is not valid for a vector data type of a fitting field problem class."
4494  CALL flagerror(local_error,err,error,*999)
4495  END SELECT
4496  CALL field_parameter_set_update_start(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
4497  & field_values_set_type,err,error,*999)
4498  CALL field_parameter_set_update_finish(equations_set%SOURCE%SOURCE_FIELD,field_u_variable_type, &
4499  & field_values_set_type,err,error,*999)
4500  ELSE
4501  CALL flagerror("Problem is not associated.",err,error,*999)
4502  ENDIF
4503  ELSE
4504  CALL flagerror("Solver is not associated.",err,error,*999)
4505  ENDIF
4506  ELSE
4507  CALL flagerror("Control loop is not associated.",err,error,*999)
4508  ENDIF
4509  exits("FITTING_PRE_SOLVE_UPDATE_INPUT_DATA")
4510  RETURN
4511 999 errorsexits("FITTING_PRE_SOLVE_UPDATE_INPUT_DATA",err,error)
4512  RETURN 1
4513  END SUBROUTINE fitting_pre_solve_update_input_data
4514 
4515  !
4516  !================================================================================================================================
4517  !
4518 
4519 
4520 END MODULE fitting_routines
equations_set_constants::equations_set_setup_dependent_type
integer(intg), parameter equations_set_setup_dependent_type
Dependent variables.
Definition: equations_set_constants.f90:324
equations_set_constants::equations_set_fem_solution_method
integer(intg), parameter equations_set_fem_solution_method
Finite Element Method solution method.
Definition: equations_set_constants.f90:348
basis_routines
This module contains all basis function routines.
Definition: basis_routines.f90:45
equations_set_constants::equations_set_setup_materials_type
integer(intg), parameter equations_set_setup_materials_type
Materials setup.
Definition: equations_set_constants.f90:326
types::boundary_conditions_type
Contains information on the boundary conditions for the solver equations.
Definition: types.f90:1780
base_routines::enters
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Definition: base_routines.f90:363
input_output::write_string_value
Write a string followed by a value to a given output stream.
Definition: input_output.f90:86
solver_routines::solvers_create_finish
subroutine, public solvers_create_finish(SOLVERS, ERR, ERROR,)
Finish the creation of solvers.
Definition: solver_routines.f90:22598
constants::second_part_deriv
integer(intg), parameter second_part_deriv
Second partial derivative i.e., d^2u/ds^2.
Definition: constants.f90:179
types::equations_mapping_type
Contains information on the equations mapping i.e., how field variable DOFS are mapped to the rows an...
Definition: types.f90:1681
types::equations_type
Contains information about the equations in an equations set.
Definition: types.f90:1735
equations_set_constants::equations_set_gfem_solution_method
integer(intg), parameter equations_set_gfem_solution_method
Grid-based Finite Element Method solution method.
Definition: equations_set_constants.f90:352
maths::invert
Returns the inverse of a matrix.
Definition: maths.f90:131
problem_constants::problem_control_time_loop_type
integer(intg), parameter problem_control_time_loop_type
Time control loop.
Definition: problem_constants.f90:283
fitting_routines::fitting_problem_standard_setup
subroutine fitting_problem_standard_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the standard Galerkin projections problem.
Definition: fitting_routines.f90:3751
fluid_mechanics_io_routines::fluid_mechanics_io_write_fitted_field
subroutine, public fluid_mechanics_io_write_fitted_field(REGION, EQUATIONS_SET_GLOBAL_NUMBER, NAME, ERR, ERROR,)
Definition: fluid_mechanics_IO_routines.f90:2102
problem_constants::problem_setup_control_type
integer(intg), parameter problem_setup_control_type
Solver setup for a problem.
Definition: problem_constants.f90:263
problem_constants
This module handles all problem wide constants.
Definition: problem_constants.f90:45
fitting_routines::fitting_problemspecificationset
subroutine, public fitting_problemspecificationset(problem, problemSpecification, err, error,)
Sets the problem specification for a data fitting problem class.
Definition: fitting_routines.f90:4035
control_loop_routines::control_loop_node
integer(intg), parameter, public control_loop_node
The identifier for a each "leaf" node in a control loop.
Definition: control_loop_routines.f90:67
problem_constants::problem_datapointvectorquasistaticfittingsubtype
integer(intg), parameter problem_datapointvectorquasistaticfittingsubtype
Definition: problem_constants.f90:238
strings::number_to_vstring
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
equations_routines::equations_create_start
subroutine, public equations_create_start(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Start the creation of equations for the equation set.
Definition: equations_routines.f90:192
types::decomposition_type
Contains information on the mesh decomposition.
Definition: types.f90:1063
basis_routines::basis_evaluate_xi
Evaluates the appropriate partial derivative index for the specificied basis function at a Xi locatio...
Definition: basis_routines.f90:168
problem_constants::problem_vector_data_fitting_subtype
integer(intg), parameter problem_vector_data_fitting_subtype
Definition: problem_constants.f90:233
fitting_routines::fitting_equations_set_solution_method_set
subroutine, public fitting_equations_set_solution_method_set(EQUATIONS_SET, SOLUTION_METHOD, ERR, ERROR,)
Sets/changes the solution method for a Galerkin projection type of an data fitting equations set clas...
Definition: fitting_routines.f90:1946
equations_matrices_routines::equations_matrices_create_start
subroutine, public equations_matrices_create_start(EQUATIONS, EQUATIONS_MATRICES, ERR, ERROR,)
Starts the creation of the equations matrices and rhs for the the equations.
Definition: equations_matrices_routines.f90:615
types::solver_type
Contains information on the type of solver to be used.
Definition: types.f90:2777
fitting_routines::fitting_post_solve_output_data
subroutine fitting_post_solve_output_data(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Output data post solve.
Definition: fitting_routines.f90:4268
solver_routines::solver_petsc_library
integer(intg), parameter, public solver_petsc_library
PETSc solver library.
Definition: solver_routines.f90:104
solver_routines::solvers_number_set
subroutine, public solvers_number_set(SOLVERS, NUMBER_OF_SOLVERS, ERR, ERROR,)
Sets/changes the number of solvers.
Definition: solver_routines.f90:22805
constants::no_part_deriv
integer(intg), parameter no_part_deriv
No partial derivative i.e., u.
Definition: constants.f90:177
equations_matrices_routines
This module handles all equations matrix and rhs routines.
Definition: equations_matrices_routines.f90:45
solver_routines::solver_type_set
subroutine, public solver_type_set(SOLVER, SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type for a solver.
Definition: solver_routines.f90:21345
equations_set_constants::equations_static
integer(intg), parameter equations_static
The equations are static and have no time dependence.
Definition: equations_set_constants.f90:376
types::equations_set_type
Contains information on an equations set.
Definition: types.f90:1941
equations_routines
This module handles all equations routines.
Definition: equations_routines.f90:45
equations_set_constants::equations_set_setup_source_type
integer(intg), parameter equations_set_setup_source_type
Source setup.
Definition: equations_set_constants.f90:327
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
solver_routines::solvers_create_start
subroutine, public solvers_create_start(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Start the creation of a solvers for the control loop.
Definition: solver_routines.f90:22651
types::solvers_type
Contains information on the solvers to be used in a control loop.
Definition: types.f90:2805
problem_constants::problem_control_simple_type
integer(intg), parameter problem_control_simple_type
Simple, one iteration control loop.
Definition: problem_constants.f90:281
fitting_routines::fitting_pre_solve
subroutine, public fitting_pre_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the output type for a data fitting problem class.
Definition: fitting_routines.f90:4144
fitting_routines::fitting_finite_element_calculate
subroutine, public fitting_finite_element_calculate(EQUATIONS_SET, ELEMENT_NUMBER, ERR, ERROR,)
Calculates the element stiffness matrices and RHS for a Galerkin projection finite element equations ...
Definition: fitting_routines.f90:426
constants::first_part_deriv
integer(intg), parameter first_part_deriv
First partial derivative i.e., du/ds.
Definition: constants.f90:178
timer
This module contains routines for timing the program.
Definition: timer_f.f90:45
control_loop_routines::control_loop_current_times_get
subroutine, public control_loop_current_times_get(CONTROL_LOOP, CURRENT_TIME, TIME_INCREMENT, ERR, ERROR,)
Gets the current time parameters for a time control loop.
Definition: control_loop_routines.f90:231
types::equations_matrices_source_type
Contains information of the source vector for equations matrices.
Definition: types.f90:1510
problem_constants::solver_equations_static
integer(intg), parameter solver_equations_static
Solver equations are static.
Definition: problem_constants.f90:309
constants::part_deriv_s2
integer(intg), parameter part_deriv_s2
First partial derivative in the s2 direction i.e., du/ds2.
Definition: constants.f90:183
fitting_routines::fitting_equations_set_setup
subroutine, public fitting_equations_set_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the Galerkin projection type of a data fitting equations set class.
Definition: fitting_routines.f90:1892
equations_routines::equations_time_dependence_type_set
subroutine, public equations_time_dependence_type_set(EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for equations.
Definition: equations_routines.f90:851
solver_routines::solver_equations_sparsity_type_set
subroutine, public solver_equations_sparsity_type_set(SOLVER_EQUATIONS, SPARSITY_TYPE, ERR, ERROR,)
Sets/changes the sparsity type for solver equations.
Definition: solver_routines.f90:7734
maths
This module contains all mathematics support routines.
Definition: maths.f90:45
solver_routines::solvers_solver_get
subroutine, public solvers_solver_get(SOLVERS, SOLVER_INDEX, SOLVER, ERR, ERROR,)
Returns a pointer to the specified solver in the list of solvers.
Definition: solver_routines.f90:22876
types::field_type
Contains information for a field defined on a region.
Definition: types.f90:1346
equations_matrices_routines::equations_matrices_full_matrices
integer(intg), parameter, public equations_matrices_full_matrices
Use fully populated equation matrices.
Definition: equations_matrices_routines.f90:91
base_routines::diagnostics2
logical, save, public diagnostics2
.TRUE. if level 2 diagnostic output is active in the current routine
Definition: base_routines.f90:154
equations_mapping_routines::equations_mapping_rhs_variable_type_set
subroutine, public equations_mapping_rhs_variable_type_set(EQUATIONS_MAPPING, RHS_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set rhs vector.
Definition: equations_mapping_routines.f90:3170
problem_constants::solver_equations_linear
integer(intg), parameter solver_equations_linear
Solver equations are linear.
Definition: problem_constants.f90:301
types::control_loop_type
Contains information on a control loop.
Definition: types.f90:3185
equations_set_constants::equations_set_mat_properties_inria_model_data_fitting_subtype
integer(intg), parameter equations_set_mat_properties_inria_model_data_fitting_subtype
Definition: equations_set_constants.f90:298
equations_set_constants::equations_set_vector_data_pre_fitting_subtype
integer(intg), parameter equations_set_vector_data_pre_fitting_subtype
Definition: equations_set_constants.f90:301
iso_varying_string
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
Definition: iso_varying_string.f90:62
solver_routines::solver_equations_create_finish
subroutine, public solver_equations_create_finish(SOLVER_EQUATIONS, ERR, ERROR,)
Finishes the process of creating solver equations.
Definition: solver_routines.f90:7166
solver_routines::solver_sparse_matrices
integer(intg), parameter, public solver_sparse_matrices
Use sparse solver matrices.
Definition: solver_routines.f90:360
solver_routines::solver_equations_create_start
subroutine, public solver_equations_create_start(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Starts the process of creating solver equations.
Definition: solver_routines.f90:7209
problem_constants::problem_data_fitting_type
integer(intg), parameter problem_data_fitting_type
Definition: problem_constants.f90:93
basis_routines::basis_default_quadrature_scheme
integer(intg), parameter, public basis_default_quadrature_scheme
Identifier for the default quadrature scheme.
Definition: basis_routines.f90:125
problem_constants::problem_setup_solvers_type
integer(intg), parameter problem_setup_solvers_type
Solver setup for a problem.
Definition: problem_constants.f90:264
equations_set_constants::equations_set_setup_equations_type
integer(intg), parameter equations_set_setup_equations_type
Equations setup.
Definition: equations_set_constants.f90:330
problem_constants::problem_generalised_data_fitting_subtype
integer(intg), parameter problem_generalised_data_fitting_subtype
Definition: problem_constants.f90:231
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
equations_set_constants::equations_set_setup_independent_type
integer(intg), parameter equations_set_setup_independent_type
Independent variables.
Definition: equations_set_constants.f90:325
constants
This module contains all program wide constants.
Definition: constants.f90:45
solver_routines::solver_library_type_set
subroutine, public solver_library_type_set(SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library type to use for the solver.
Definition: solver_routines.f90:9067
problem_constants::problem_div_free_vector_data_fitting_subtype
integer(intg), parameter problem_div_free_vector_data_fitting_subtype
Definition: problem_constants.f90:234
constants::part_deriv_s1
integer(intg), parameter part_deriv_s1
First partial derivative in the s1 direction i.e., du/ds1.
Definition: constants.f90:181
equations_mapping_routines::equationsmapping_linearmatricesnumberset
subroutine, public equationsmapping_linearmatricesnumberset(EQUATIONS_MAPPING, NUMBER_OF_LINEAR_EQUATIONS_MATRICES, ERR, ERROR,)
Sets/changes the number of linear equations matrices.
Definition: equations_mapping_routines.f90:2484
equations_set_constants::equations_set_mat_properties_data_fitting_subtype
integer(intg), parameter equations_set_mat_properties_data_fitting_subtype
Definition: equations_set_constants.f90:297
problem_constants::problem_setup_initial_type
integer(intg), parameter problem_setup_initial_type
Initial setup for a problem.
Definition: problem_constants.f90:262
darcy_equations_routines
This module handles all Darcy equations routines.
Definition: Darcy_equations_routines.f90:46
equations_mapping_routines::equationsmapping_linearmatricesvariabletypesset
subroutine, public equationsmapping_linearmatricesvariabletypesset(EQUATIONS_MAPPING, LINEAR_MATRIX_VARIABLE_TYPES, ERR, ERROR,)
Sets the mapping between the dependent field variable types and the linear equations matrices...
Definition: equations_mapping_routines.f90:2716
types::problem_setup_type
Definition: types.f90:3215
fluid_mechanics_io_routines::fluid_mechanics_io_read_data
subroutine, public fluid_mechanics_io_read_data(SOLVER_TYPE, INPUT_VALUES, NUMBER_OF_DIMENSIONS, INPUT_TYPE, INPUT_OPTION, TIME_STEP, LENGTH_SCALE)
Reads input data from a file.
Definition: fluid_mechanics_IO_routines.f90:4319
types::data_projection_type
Definition: types.f90:289
fitting_routines::fitting_problem_setup
subroutine, public fitting_problem_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the Galerkin projection problem.
Definition: fitting_routines.f90:3700
problem_constants::solver_equations_quasistatic
integer(intg), parameter solver_equations_quasistatic
Solver equations are quasistatic.
Definition: problem_constants.f90:310
solver_routines::solver_equations_linearity_type_set
subroutine, public solver_equations_linearity_type_set(SOLVER_EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for solver equations.
Definition: solver_routines.f90:7577
equations_set_constants::equations_set_setup_start_action
integer(intg), parameter equations_set_setup_start_action
Start setup action.
Definition: equations_set_constants.f90:338
types::decomposition_topology_type
Contains the topology information for a decomposition.
Definition: types.f90:1054
problem_constants::problem_mat_properties_data_fitting_subtype
integer(intg), parameter problem_mat_properties_data_fitting_subtype
Definition: problem_constants.f90:232
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
control_loop_routines::control_loop_solvers_get
recursive subroutine, public control_loop_solvers_get(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Returns a pointer to the solvers for a control loop.
Definition: control_loop_routines.f90:1333
fitting_routines::fitting_equations_set_mat_properties_setup
subroutine fitting_equations_set_mat_properties_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the update-materials Galerkin projection.
Definition: fitting_routines.f90:1308
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
darcy_equations_routines::idebug1
logical idebug1
Definition: Darcy_equations_routines.f90:108
types::equations_matrices_type
Contains information on the equations matrices and vectors.
Definition: types.f90:1520
equations_matrices_routines::equations_matrix_fem_structure
integer(intg), parameter, public equations_matrix_fem_structure
Finite element matrix structure.
Definition: equations_matrices_routines.f90:72
constants::part_deriv_s3
integer(intg), parameter part_deriv_s3
First partial derivative in the s3 direction i.e., du/ds3.
Definition: constants.f90:186
input_output::write_string
Write a string to a given output stream.
Definition: input_output.f90:74
base_routines
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
Definition: base_routines.f90:45
types::equations_matrices_linear_type
Contains information of the linear matrices for equations matrices.
Definition: types.f90:1479
base_routines::general_output_type
integer(intg), parameter, public general_output_type
General output type.
Definition: base_routines.f90:66
problem_constants::problem_standard_data_fitting_subtype
integer(intg), parameter problem_standard_data_fitting_subtype
Definition: problem_constants.f90:230
fitting_routines::fitting_equations_set_vectordata_setup
subroutine, public fitting_equations_set_vectordata_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the vector data Galerkin projection.
Definition: fitting_routines.f90:2539
constants::part_deriv_s1_s1
integer(intg), parameter part_deriv_s1_s1
Second partial derivative in the s1 direction i.e., d^2u/ds1ds1.
Definition: constants.f90:182
iso_varying_string::trim
Definition: iso_varying_string.f90:204
equations_matrices_routines::equations_matrices_linear_storage_type_set
subroutine, public equations_matrices_linear_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the linear equations matrices.
Definition: equations_matrices_routines.f90:3898
problem_constants::problem_vector_data_pre_fitting_subtype
integer(intg), parameter problem_vector_data_pre_fitting_subtype
Definition: problem_constants.f90:235
equations_matrices_routines::equationsmatrices_linearstructuretypeset
subroutine, public equationsmatrices_linearstructuretypeset(EQUATIONS_MATRICES, STRUCTURE_TYPE, ERR, ERROR,)
Sets the structure (sparsity) of the linear equations matrices.
Definition: equations_matrices_routines.f90:4160
equations_mapping_routines::equations_mapping_create_finish
subroutine, public equations_mapping_create_finish(EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping.
Definition: equations_mapping_routines.f90:982
control_loop_routines::control_loop_get
Returns the specified control loop as indexed by the control loop identifier from the control loop ro...
Definition: control_loop_routines.f90:86
fitting_routines::fitting_pre_solve_update_input_data
subroutine, public fitting_pre_solve_update_input_data(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Update input data conditions for field fitting.
Definition: fitting_routines.f90:4370
control_loop_routines::control_loop_type_set
subroutine, public control_loop_type_set(CONTROL_LOOP, LOOP_TYPE, ERR, ERROR,)
Sets/changes the control loop type.
Definition: control_loop_routines.f90:1750
types::decompositiondatapointstype
Contains data point decompostion topology.
Definition: types.f90:1041
constants::part_deriv_s2_s3
integer(intg), parameter part_deriv_s2_s3
Cross derivative in the s2 and s3 direction i.e., d^2u/ds2ds3.
Definition: constants.f90:189
equations_mapping_routines::equations_mapping_source_variable_type_set
subroutine, public equations_mapping_source_variable_type_set(EQUATIONS_MAPPING, SOURCE_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a source field variable and the equations set source vector.
Definition: equations_mapping_routines.f90:3378
constants::part_deriv_s1_s3
integer(intg), parameter part_deriv_s1_s3
Cross derivative in the s1 and s3 direction i.e., d^2u/ds1ds3.
Definition: constants.f90:188
equations_routines::equations_set_equations_get
subroutine, public equations_set_equations_get(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Gets the equations for an equations set.
Definition: equations_routines.f90:897
types::equations_set_materials_type
Definition: types.f90:1881
fitting_routines::fitting_gauss_deformation_gradient_tensor
subroutine fitting_gauss_deformation_gradient_tensor(REFERENCE_GEOMETRIC_INTERPOLATED_POINT, GEOMETRIC_INTERPOLATED_POINT, DXDY, Jxy, ERR, ERROR,)
Evaluates the deformation gradient tensor at a given Gauss point.
Definition: fitting_routines.f90:4100
constants::partial_derivative_first_derivative_map
integer(intg), dimension(4) partial_derivative_first_derivative_map
PARTIAL_DERIVATIVE_FIRST_DERIVATIVE_MAP(nic) gives the partial derivative index for the first derivat...
Definition: constants.f90:254
equations_routines::equations_create_finish
subroutine, public equations_create_finish(EQUATIONS, ERR, ERROR,)
Finish the creation of equations.
Definition: equations_routines.f90:159
fitting_routines::fitting_equations_set_standard_setup
subroutine fitting_equations_set_standard_setup(EQUATIONS_SET, EQUATIONS_SET_SETUP, ERR, ERROR,)
Sets up the standard Galerkin projection.
Definition: fitting_routines.f90:2131
domain_mappings
This module handles all domain mappings routines.
Definition: domain_mappings.f90:45
problem_constants::problem_setup_finish_action
integer(intg), parameter problem_setup_finish_action
Finish setup action.
Definition: problem_constants.f90:274
equations_mapping_routines
This module handles all equations mapping routines.
Definition: equations_mapping_routines.f90:45
types::solver_equations_type
Contains information about the solver equations for a solver.
Definition: types.f90:2452
matrix_vector::matrix_compressed_row_storage_type
integer(intg), parameter, public matrix_compressed_row_storage_type
Matrix compressed row storage type.
Definition: matrix_vector.f90:167
equations_set_constants::equations_set_gfv_solution_method
integer(intg), parameter equations_set_gfv_solution_method
Grid-based Finite Volume solution method.
Definition: equations_set_constants.f90:354
problem_constants::problem_fitting_class
integer(intg), parameter problem_fitting_class
Definition: problem_constants.f90:61
equations_set_constants::equations_set_setup_geometry_type
integer(intg), parameter equations_set_setup_geometry_type
Geometry setup.
Definition: equations_set_constants.f90:323
types::problem_type
Contains information for a problem.
Definition: types.f90:3221
maths::determinant
Returns the determinant of a matrix.
Definition: maths.f90:94
equations_set_constants::equations_linear
integer(intg), parameter equations_linear
The equations are linear.
Definition: equations_set_constants.f90:365
fitting_routines::fitting_equationssetspecificationset
subroutine, public fitting_equationssetspecificationset(equationsSet, specification, err, error,)
Sets the problem specification for a data fitting equation set class.
Definition: fitting_routines.f90:2061
equations_set_constants::equations_set_standard_data_fitting_subtype
integer(intg), parameter equations_set_standard_data_fitting_subtype
Definition: equations_set_constants.f90:295
equations_set_constants::equationsset_datapointvectorstaticfittingsubtype
integer(intg), parameter equationsset_datapointvectorstaticfittingsubtype
Definition: equations_set_constants.f90:303
equations_matrices_routines::equations_matrices_create_finish
subroutine, public equations_matrices_create_finish(EQUATIONS_MATRICES, ERR, ERROR,)
Finishes the creation of the equations matrices and RHS for the the equations.
Definition: equations_matrices_routines.f90:404
distributed_matrix_vector
This module handles all distributed matrix vector routines.
Definition: distributed_matrix_vector.f90:45
boundary_conditions_routines
This module handles all boundary conditions routines.
Definition: boundary_condition_routines.f90:45
solver_routines
This module handles all solver routines.
Definition: solver_routines.f90:45
equations_mapping_routines::equations_mapping_create_start
subroutine, public equations_mapping_create_start(EQUATIONS, EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping for a equations set equations.
Definition: equations_mapping_routines.f90:1112
types::field_interpolated_point_type
Contains the interpolated value (and the derivatives wrt xi) of a field at a point. Old CMISS name XG.
Definition: types.f90:1129
types::equations_matrix_type
Contains information about an equations matrix.
Definition: types.f90:1429
equations_set_constants::equations_set_data_fitting_equation_type
integer(intg), parameter equations_set_data_fitting_equation_type
Definition: equations_set_constants.f90:93
equations_set_constants::equations_set_vector_data_fitting_subtype
integer(intg), parameter equations_set_vector_data_fitting_subtype
Definition: equations_set_constants.f90:299
types::quadrature_scheme_type
Contains information for a particular quadrature scheme.
Definition: types.f90:141
equations_set_constants::equations_set_divfree_vector_data_pre_fitting_subtype
integer(intg), parameter equations_set_divfree_vector_data_pre_fitting_subtype
Definition: equations_set_constants.f90:302
base_routines::diagnostics5
logical, save, public diagnostics5
.TRUE. if level 5 diagnostic output is active in the current routine
Definition: base_routines.f90:157
matrix_vector
This module contains all routines dealing with (non-distributed) matrix and vectors types...
Definition: matrix_vector.f90:129
input_output::write_string_vector
Write a string followed by a vector to a specified output stream.
Definition: input_output.f90:290
fitting_routines::fitting_problem_vectordata_setup
subroutine fitting_problem_vectordata_setup(PROBLEM, PROBLEM_SETUP, ERR, ERROR,)
Sets up the vector data Galerkin projections problem.
Definition: fitting_routines.f90:3887
equations_routines::equations_linearity_type_set
subroutine, public equations_linearity_type_set(EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for equations.
Definition: equations_routines.f90:539
control_loop_routines::control_loop_create_start
subroutine, public control_loop_create_start(PROBLEM, CONTROL_LOOP, ERR, ERROR,)
Start the process of creating a control loop for a problem.
Definition: control_loop_routines.f90:194
problem_constants::problem_setup_solver_equations_type
integer(intg), parameter problem_setup_solver_equations_type
Solver equations setup for a problem.
Definition: problem_constants.f90:265
base_routines::diagnostic_output_type
integer(intg), parameter, public diagnostic_output_type
Diagnostic output type.
Definition: base_routines.f90:67
types::solver_mapping_type
Contains information on the solver mapping between the global equation sets and the solver matrices...
Definition: types.f90:3091
fitting_routines::fitting_post_solve
subroutine, public fitting_post_solve(CONTROL_LOOP, SOLVER, ERR, ERROR,)
Sets up the output type for a data fitting problem class.
Definition: fitting_routines.f90:4211
constants::part_deriv_s1_s2
integer(intg), parameter part_deriv_s1_s2
Cross derivative in the s1 and s2 direction i.e., d^2u/ds1ds2.
Definition: constants.f90:185
constants::part_deriv_s2_s2
integer(intg), parameter part_deriv_s2_s2
Second partial derivative in the s2 direction i.e., d^2u/ds2ds2.
Definition: constants.f90:184
types::field_variable_type
Contains information for a field variable defined on a field.
Definition: types.f90:1289
equations_set_constants::equations_set_fd_solution_method
integer(intg), parameter equations_set_fd_solution_method
Finite Difference solution method.
Definition: equations_set_constants.f90:350
equations_matrices_routines::equations_matrices_sparse_matrices
integer(intg), parameter, public equations_matrices_sparse_matrices
Use sparse equations matrices.
Definition: equations_matrices_routines.f90:90
equations_set_constants::equationsset_datapointvectorquasistaticfittingsubtype
integer(intg), parameter equationsset_datapointvectorquasistaticfittingsubtype
Definition: equations_set_constants.f90:304
constants::part_deriv_s3_s3
integer(intg), parameter part_deriv_s3_s3
Second partial derivative in the s3 direction i.e., d^2u/ds3ds3.
Definition: constants.f90:187
types::equations_set_setup_type
Contains information on the setup information for an equations set.
Definition: types.f90:1866
fitting_routines
This module handles all Galerkin projection routines.
Definition: fitting_routines.f90:45
problem_constants::problem_setup_start_action
integer(intg), parameter problem_setup_start_action
Start setup action.
Definition: problem_constants.f90:273
solver_routines::solver_equations_time_dependence_type_set
subroutine, public solver_equations_time_dependence_type_set(SOLVER_EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for solver equations.
Definition: solver_routines.f90:7788
control_loop_routines
This module handles all control loop routines.
Definition: control_loop_routines.f90:45
equations_set_constants::equations_set_generalised_data_fitting_subtype
integer(intg), parameter equations_set_generalised_data_fitting_subtype
Definition: equations_set_constants.f90:296
maths::matrix_product
Calculates and returns the matrix-product A*B in the matrix C.
Definition: maths.f90:167
base_routines::errors
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
Definition: base_routines.f90:481
equations_set_constants
This module defines all constants shared across equations set routines.
Definition: equations_set_constants.f90:45
equations_set_constants::equations_set_bem_solution_method
integer(intg), parameter equations_set_bem_solution_method
Boundary Element Method solution method.
Definition: equations_set_constants.f90:349
solver_routines::solver_solver_equations_get
subroutine, public solver_solver_equations_get(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Returns a pointer to the solver equations for a solver.
Definition: solver_routines.f90:21230
types::basis_type
Contains all information about a basis .
Definition: types.f90:184
problem_constants::problem_div_free_vector_data_pre_fitting_subtype
integer(intg), parameter problem_div_free_vector_data_pre_fitting_subtype
Definition: problem_constants.f90:236
equations_set_constants::equations_set_fv_solution_method
integer(intg), parameter equations_set_fv_solution_method
Finite Volume solution method.
Definition: equations_set_constants.f90:351
matrix_vector::matrix_block_storage_type
integer(intg), parameter, public matrix_block_storage_type
Matrix block storage type.
Definition: matrix_vector.f90:163
base_routines::flag_error
Flags an error condition.
Definition: base_routines.f90:226
equations_set_constants::equations_set_setup_initial_type
integer(intg), parameter equations_set_setup_initial_type
Initial setup.
Definition: equations_set_constants.f90:322
control_loop_routines::control_loop_create_finish
recursive subroutine, public control_loop_create_finish(CONTROL_LOOP, ERR, ERROR,)
Finish the process of creating a control loop.
Definition: control_loop_routines.f90:153
equations_set_constants::equations_set_divfree_vector_data_fitting_subtype
integer(intg), parameter equations_set_divfree_vector_data_fitting_subtype
Definition: equations_set_constants.f90:300
equations_set_constants::equations_quasistatic
integer(intg), parameter equations_quasistatic
The equations are quasi-static.
Definition: equations_set_constants.f90:377
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
solver_routines::solver_linear_type
integer(intg), parameter, public solver_linear_type
A linear solver.
Definition: solver_routines.f90:88
types::equations_matrices_rhs_type
Contains information of the RHS vector for equations matrices.
Definition: types.f90:1500
types::equations_mapping_linear_type
Contains information for mapping field variables to the linear matrices in the equations set of the m...
Definition: types.f90:1587
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
fluid_mechanics_io_routines
Temporary IO routines for fluid mechanics.
Definition: fluid_mechanics_IO_routines.f90:47
equations_set_constants::equations_set_setup_finish_action
integer(intg), parameter equations_set_setup_finish_action
Finish setup action.
Definition: equations_set_constants.f90:339
equations_set_constants::equations_set_fitting_class
integer(intg), parameter equations_set_fitting_class
Definition: equations_set_constants.f90:61
problem_constants::problem_datapointvectorstaticfittingsubtype
integer(intg), parameter problem_datapointvectorstaticfittingsubtype
Definition: problem_constants.f90:237
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45