OpenCMISS-Iron Internal API Documentation
monodomain_equations_routines.f90
Go to the documentation of this file.
1 
43 
46 
47  USE base_routines
48  USE basis_routines
50  USE constants
53  USE domain_mappings
60  USE field_routines
62  USE input_output
64  USE kinds
65  USE matrix_vector
66  USE node_routines
68  USE strings
69  USE solver_routines
70  USE timer
71  USE types
72 
73 #include "macros.h"
74 
75 
76  IMPLICIT NONE
77 
78  PRIVATE
79 
80  !Module parameters
81 
82  !Module types
83 
84  !Module variables
85 
86  !Interfaces
87 
88  PUBLIC monodomain_control_loop_post_loop
89 
90  PUBLIC monodomain_equation_equations_set_setup
91 
92  PUBLIC monodomain_finiteelementcalculate
93 
94  PUBLIC monodomain_equationssetsolutionmethodset
95 
96  PUBLIC monodomain_equationssetspecificationset
97 
98  PUBLIC monodomain_problemspecificationset
99 
100  PUBLIC monodomain_equation_problem_setup
101 
102  PUBLIC monodomain_pre_solve,monodomain_post_solve
103 
104 CONTAINS
105 
106  !
107  !================================================================================================================================
108  !
109 
111  SUBROUTINE monodomain_control_loop_post_loop(CONTROL_LOOP,ERR,ERROR,*)
113  !Argument variables
114  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
115  INTEGER(INTG), INTENT(OUT) :: ERR
116  TYPE(varying_string), INTENT(OUT) :: ERROR
117  !Local Variables
118  INTEGER(INTG) :: equations_set_idx
119  TYPE(control_loop_time_type), POINTER :: TIME_LOOP,TIME_LOOP_PARENT
120  TYPE(control_loop_type), POINTER :: PARENT_LOOP
121  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
122  TYPE(field_type), POINTER :: DEPENDENT_FIELD
123  TYPE(problem_type), POINTER :: PROBLEM
124  TYPE(region_type), POINTER :: DEPENDENT_REGION
125  TYPE(solver_type), POINTER :: SOLVER
126  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
127  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
128  TYPE(solvers_type), POINTER :: SOLVERS
129  TYPE(varying_string) :: FILENAME,LOCAL_ERROR,METHOD
130  INTEGER(INTG) :: OUTPUT_ITERATION_NUMBER,CURRENT_LOOP_ITERATION
131 
132  enters("MONODOMAIN_CONTROL_LOOP_POST_LOOP",err,error,*999)
133 
134  IF(ASSOCIATED(control_loop)) THEN
135  IF(control_loop%OUTPUT_TYPE>=control_loop_progress_output) THEN
136  SELECT CASE(control_loop%LOOP_TYPE)
138  !do nothing
140  !do nothing
142  !Export the dependent field for this time step
143  time_loop=>control_loop%TIME_LOOP
144  IF(ASSOCIATED(time_loop)) THEN
145  problem=>control_loop%PROBLEM
146  IF(ASSOCIATED(problem)) THEN
147  NULLIFY(solvers)
148  NULLIFY(solver)
149  !Get the solver.
150  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
151  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
152  !Loop over the equations sets associated with the solver
153  solver_equations=>solver%SOLVER_EQUATIONS
154  IF(ASSOCIATED(solver_equations)) THEN
155  solver_mapping=>solver_equations%SOLVER_MAPPING
156  IF(ASSOCIATED(solver_mapping)) THEN
157  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
158  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
159  IF(ASSOCIATED(equations_set)) THEN
160  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
161  NULLIFY(dependent_region)
162  CALL field_region_get(dependent_field,dependent_region,err,error,*999)
163  NULLIFY(parent_loop)
164  parent_loop=>control_loop%PARENT_LOOP
165  IF(ASSOCIATED(parent_loop)) THEN
166  !add the iteration number of the parent loop to the filename
167  NULLIFY(time_loop_parent)
168  time_loop_parent=>parent_loop%TIME_LOOP
169  IF(ASSOCIATED(time_loop_parent)) THEN
170  output_iteration_number=time_loop_parent%OUTPUT_NUMBER
171  current_loop_iteration=time_loop_parent%GLOBAL_ITERATION_NUMBER
172  filename="Time_"//trim(number_to_vstring(dependent_region%USER_NUMBER,"*",err,error))// &
173  & "_"//trim(number_to_vstring(time_loop_parent%GLOBAL_ITERATION_NUMBER,"*",err,error))// &
174  & "_"//trim(number_to_vstring(time_loop%ITERATION_NUMBER,"*",err,error))
175  ELSE
176  output_iteration_number=time_loop%OUTPUT_NUMBER
177  current_loop_iteration=time_loop%GLOBAL_ITERATION_NUMBER
178  filename="Time_"//trim(number_to_vstring(dependent_region%USER_NUMBER,"*",err,error))// &
179  & "_"//trim(number_to_vstring(time_loop%GLOBAL_ITERATION_NUMBER,"*",err,error))
180  ENDIF
181  ELSE
182  output_iteration_number=time_loop%OUTPUT_NUMBER
183  current_loop_iteration=time_loop%GLOBAL_ITERATION_NUMBER
184  filename="Time_"//trim(number_to_vstring(dependent_region%USER_NUMBER,"*",err,error))// &
185  & "_"//trim(number_to_vstring(time_loop%GLOBAL_ITERATION_NUMBER,"*",err,error))
186  ENDIF
187  method="FORTRAN"
188  IF(output_iteration_number/=0.AND.mod(current_loop_iteration,output_iteration_number)==0) THEN
189  CALL field_io_nodes_export(dependent_region%FIELDS,filename,method,err,error,*999)
190  ENDIF
191  ELSE
192  local_error="Equations set is not associated for equations set index "// &
193  & trim(number_to_vstring(equations_set_idx,"*",err,error))// &
194  & " in the solver mapping."
195  CALL flagerror(local_error,err,error,*999)
196  ENDIF
197  ENDDO !equations_set_idx
198  ELSE
199  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
200  ENDIF
201  ELSE
202  CALL flagerror("Solver solver equations are not associated.",err,error,*999)
203  ENDIF
204  ELSE
205  CALL flagerror("Control loop problem is not associated.",err,error,*999)
206  ENDIF
207  ELSE
208  CALL flagerror("Time loop is not associated.",err,error,*999)
209  ENDIF
211  !do nothing
213  !do nothing
214  CASE DEFAULT
215  local_error="The control loop type of "//trim(number_to_vstring(control_loop%LOOP_TYPE,"*",err,error))// &
216  & " is invalid."
217  CALL flagerror(local_error,err,error,*999)
218  END SELECT
219  ENDIF
220  ELSE
221  CALL flagerror("Control loop is not associated.",err,error,*999)
222  ENDIF
223 
224  exits("MONODOMAIN_CONTROL_LOOP_POST_LOOP")
225  RETURN
226 999 errorsexits("MONODOMAIN_CONTROL_LOOP_POST_LOOP",err,error)
227  RETURN 1
228 
229  END SUBROUTINE monodomain_control_loop_post_loop
230  !
231  !================================================================================================================================
232  !
233  !
234 
236  SUBROUTINE monodomain_equationssetspecificationset(equationsSet,specification,err,error,*)
238  !Argument variables
239  TYPE(equations_set_type), POINTER :: equationsSet
240  INTEGER(INTG), INTENT(IN) :: specification(:)
241  INTEGER(INTG), INTENT(OUT) :: err
242  TYPE(varying_string), INTENT(OUT) :: error
243  !Local Variables
244  INTEGER(INTG) :: subtype
245  TYPE(varying_string) :: localError
246 
247  enters("Monodomain_EquationsSetSpecificationSet",err,error,*999)
248 
249  IF(ASSOCIATED(equationsset)) THEN
250  IF(SIZE(specification,1)<3) THEN
251  CALL flagerror("Equations set specification must have at least three entries for a monodomain class equations set.", &
252  & err,error,*999)
253  END IF
254  SELECT CASE(specification(2))
256  subtype=specification(3)
257  SELECT CASE(subtype)
260  !ok
261  CASE DEFAULT
262  localerror="Equations set subtype "//trim(numbertovstring(subtype,"*",err,error))// &
263  & " is not valid for a Monodomain equation type of a Strang splitting equations set class."
264  CALL flagerror(localerror,err,error,*999)
265  END SELECT
266  !Set full specification
267  IF(ALLOCATED(equationsset%specification)) THEN
268  CALL flagerror("Equations set specification is already allocated.",err,error,*999)
269  ELSE
270  ALLOCATE(equationsset%specification(3),stat=err)
271  IF(err/=0) CALL flagerror("Could not allocate equations set specification.",err,error,*999)
272  END IF
273  equationsset%specification(1:3)=[equations_set_bioelectrics_class, &
275  CASE DEFAULT
276  localerror="Equations set equation type "//trim(numbertovstring(specification(2),"*",err,error))// &
277  & " is not valid for a monodomain equations set class."
278  END SELECT
279  ELSE
280  CALL flagerror("Equations set is not associated",err,error,*999)
281  END IF
282 
283  CALL exits("Monodomain_EquationsSetSpecificationSet")
284  RETURN
285 999 CALL errors("Monodomain_EquationsSetSpecificationSet",err,error)
286  CALL exits("Monodomain_EquationsSetSpecificationSet")
287  RETURN 1
288 
289  END SUBROUTINE monodomain_equationssetspecificationset
290 
291  !
292  !================================================================================================================================
293  !
294 
296  SUBROUTINE monodomain_problemspecificationset(problem,problemSpecification,err,error,*)
298  !Argument variables
299  TYPE(problem_type), POINTER :: problem
300  INTEGER(INTG), INTENT(IN) :: problemSpecification(:)
301  INTEGER(INTG), INTENT(OUT) :: err
302  TYPE(varying_string), INTENT(OUT) :: error
303  !Local Variables
304  TYPE(varying_string) :: localError
305  INTEGER(INTG) :: problemType,problemSubtype
306 
307  CALL enters("Monodomain_ProblemSpecificationSet",err,error,*999)
308 
309  IF(ASSOCIATED(problem)) THEN
310  IF(SIZE(problemspecification,1)>=3) THEN
311  problemtype=problemspecification(2)
312  SELECT CASE(problemtype)
314  problemsubtype=problemspecification(3)
315  SELECT CASE(problemsubtype)
318  !ok
319  CASE DEFAULT
320  localerror="Problem subtype "//trim(numbertovstring(problemsubtype,"*",err,error))// &
321  & " is not valid for a Monodomain equation type of a Strang splitting problem class."
322  CALL flagerror(localerror,err,error,*999)
323  END SELECT
324  IF(ALLOCATED(problem%specification)) THEN
325  CALL flagerror("Problem specification is already allocated.",err,error,*999)
326  ELSE
327  ALLOCATE(problem%specification(3),stat=err)
328  IF(err/=0) CALL flagerror("Could not allocate problem specification.",err,error,*999)
329  END IF
330  problem%specification(1:3)=[problem_bioelectrics_class,problem_monodomain_strang_splitting_equation_type,problemsubtype]
331  CASE DEFAULT
332  localerror="Problem equation type "//trim(numbertovstring(problemtype,"*",err,error))// &
333  & " is not valid for a monodomain problem class."
334  CALL flagerror(localerror,err,error,*999)
335  END SELECT
336  ELSE
337  CALL flagerror("Monodomain problem specification must have a type.",err,error,*999)
338  END IF
339  ELSE
340  CALL flagerror("Problem is not associated",err,error,*999)
341  END IF
342 
343  CALL exits("Monodomain_ProblemSpecificationSet")
344  RETURN
345 999 CALL errors("Monodomain_ProblemSpecificationSet",err,error)
346  CALL exits("Monodomain_ProblemSpecificationSet")
347  RETURN 1
348 
349  END SUBROUTINE monodomain_problemspecificationset
350 
351  !
352  !================================================================================================================================
353  !
354 
356  SUBROUTINE monodomain_finiteelementcalculate(EQUATIONS_SET,ELEMENT_NUMBER,ERR,ERROR,*)
358  !Argument variables
359  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
360  INTEGER(INTG), INTENT(IN) :: ELEMENT_NUMBER
361  INTEGER(INTG), INTENT(OUT) :: ERR
362  TYPE(varying_string), INTENT(OUT) :: ERROR
363  !Local Variables
364  INTEGER(INTG) FIELD_VAR_TYPE,ng,mh,mhs,ms,nh,nhs,ni,ns,nj
365  REAL(DP) :: RWG,SUM,Df, Dt, D(3,3), f(3), fnorm
366  REAL(DP) :: DPHIDX(3,8) ! assumes <= 8 basis functions / DEPENDENT_BASIS%NUMBER_OF_ELEMENT_PARAMETERS <= 8
367  TYPE(basis_type), POINTER :: DEPENDENT_BASIS,GEOMETRIC_BASIS
368  TYPE(equations_type), POINTER :: EQUATIONS
369  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
370  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
371  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
372  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
373  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
374  TYPE(equations_matrix_type), POINTER :: DAMPING_MATRIX,STIFFNESS_MATRIX
375  TYPE(field_type), POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD
376  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE,GEOMETRIC_VARIABLE
377  TYPE(quadrature_scheme_type), POINTER :: QUADRATURE_SCHEME
378  TYPE(varying_string) :: LOCAL_ERROR
379 
380  enters("Monodomain_FiniteElementCalculate",err,error,*999)
381 
382  IF(ASSOCIATED(equations_set)) THEN
383  equations=>equations_set%EQUATIONS
384  IF(ASSOCIATED(equations)) THEN
385  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
386  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
387  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
388  CALL flagerror("Equations set specification must have three entries for a monodomain type equations set.", &
389  & err,error,*999)
390  END IF
391  SELECT CASE(equations_set%SPECIFICATION(3))
393 
394  dependent_field=>equations%INTERPOLATION%DEPENDENT_FIELD
395  geometric_field=>equations%INTERPOLATION%GEOMETRIC_FIELD
396  materials_field=>equations%INTERPOLATION%MATERIALS_FIELD
397  equations_matrices=>equations%EQUATIONS_MATRICES
398  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
399  stiffness_matrix=>dynamic_matrices%MATRICES(1)%PTR
400  damping_matrix=>dynamic_matrices%MATRICES(2)%PTR
401  rhs_vector=>equations_matrices%RHS_VECTOR
402 
403  IF(.NOT.(stiffness_matrix%UPDATE_MATRIX.OR.damping_matrix%UPDATE_MATRIX.OR.rhs_vector%UPDATE_VECTOR)) RETURN ! no updates -> return immediately
404 
405  ! set up opencmiss interpolation and basis
406  equations_mapping=>equations%EQUATIONS_MAPPING
407  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
408  field_variable=>dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(1)%VARIABLE
409  field_var_type=field_variable%VARIABLE_TYPE
410  geometric_variable=>geometric_field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
411  dependent_basis=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
412  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
413  geometric_basis=>geometric_field%DECOMPOSITION%DOMAIN(geometric_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
414  & topology%ELEMENTS%ELEMENTS(element_number)%BASIS
415  quadrature_scheme=>dependent_basis%QUADRATURE%QUADRATURE_SCHEME_MAP(basis_default_quadrature_scheme)%PTR
416 
417  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
418  & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
419  CALL field_interpolation_parameters_element_get(field_values_set_type,element_number,equations%INTERPOLATION% &
420  & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
421 
422 
423  DO ng=1,quadrature_scheme%NUMBER_OF_GAUSS
424  ! get interpolated geometric and material interpolated point
425  CALL field_interpolate_gauss(first_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
426 
427  & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
428  CALL field_interpolated_point_metrics_calculate(geometric_basis%NUMBER_OF_XI,equations%INTERPOLATION% &
429  & geometric_interp_point_metrics(field_u_variable_type)%PTR,err,error,*999)
430  CALL field_interpolate_gauss(no_part_deriv,basis_default_quadrature_scheme,ng,equations%INTERPOLATION% &
431  & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
432 
433  ! calculate weight = det J * gauss pt weight
434  rwg=equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%JACOBIAN* &
435  & quadrature_scheme%GAUSS_WEIGHTS(ng)
436 
437  ! basis function chain rule taken out of the inner loop.
438  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
439  DO nj=1,geometric_variable%NUMBER_OF_COMPONENTS
440  dphidx(nj,ms)=0.0_dp
441  DO ni=1,dependent_basis%NUMBER_OF_XI
442  dphidx(nj,ms)=dphidx(nj,ms) + &
443  & quadrature_scheme%GAUSS_BASIS_FNS(ms,partial_derivative_first_derivative_map(ni),ng)* &
444  & equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS(field_u_variable_type)%PTR%DXI_DX(ni,nj)
445  ENDDO !ni
446  ENDDO !nj
447  ENDDO !ms
448 
449  ! Diffusion tensor D = Dt I + (Df - Dt) f f^T where Dt and Df are diffusivity/conductivity in fiber/transverse directions
450  df = equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(2,no_part_deriv) ! 2 = Df
451  dt = equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3,no_part_deriv) ! 3 = Dt
452  fnorm = 0.0
453  DO nj=1,geometric_variable%NUMBER_OF_COMPONENTS
454  f(nj) = equations%INTERPOLATION%MATERIALS_INTERP_POINT(field_u_variable_type)%PTR%VALUES(3+nj,no_part_deriv) ! 4,5[,6] = f
455  fnorm = fnorm + f(nj)*f(nj)
456  ENDDO
457  ! normalize f, and fill in default for 0,0,0 -> 1,0,0
458  fnorm = sqrt(fnorm)
459  IF(fnorm < 1e-6) THEN
460  f = (/ 1.0, 0.0, 0.0 /) ! default
461  ELSE
462  f = f / fnorm
463  ENDIF
464  DO ni=1,geometric_variable%NUMBER_OF_COMPONENTS
465  d(ni,:) = 0.0
466  d(ni,ni) = dt
467  DO nj=1,geometric_variable%NUMBER_OF_COMPONENTS
468  d(ni,nj) = d(ni,nj) + (df - dt) * f(ni) * f(nj)
469  ENDDO
470  ENDDO
471 
472  !Loop over field components
473  mhs=0
474  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
475  !Loop over element rows
476  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
477  mhs=mhs+1
478  nhs=0
479  IF(stiffness_matrix%UPDATE_MATRIX.OR.damping_matrix%UPDATE_MATRIX) THEN
480  !Loop over element columns. TODO: use symmetry?
481  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
482  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
483  nhs=nhs+1
484  IF(stiffness_matrix%UPDATE_MATRIX) THEN
485  sum=0.0_dp
486  DO ni=1,geometric_variable%NUMBER_OF_COMPONENTS
487  DO nj=1,geometric_variable%NUMBER_OF_COMPONENTS
488  sum=sum + d(ni,nj) * dphidx(ni,ms) * dphidx(nj,ns)
489  ENDDO !nj
490  ENDDO !ni
491  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+sum*rwg ! Aij = int D_ij * dphi_m/dx_i * dphi_n/dx_j
492  ENDIF
493 
494  IF(damping_matrix%UPDATE_MATRIX) THEN ! non mass lumped version
495  damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)+ &
496  & quadrature_scheme%GAUSS_BASIS_FNS(ms,no_part_deriv,ng)* &
497  & quadrature_scheme%GAUSS_BASIS_FNS(ns,no_part_deriv,ng)*rwg ! int phi_m phi_n
498  ENDIF
499 
500  ENDDO !ns
501  ENDDO !nh
502  ENDIF
503  IF(rhs_vector%UPDATE_VECTOR) rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=0.0_dp
504 ! IF(DAMPING_MATRIX%UPDATE_MATRIX) THEN ! mass lumnped version
505 ! DAMPING_MATRIX%ELEMENT_MATRIX%MATRIX(mhs,mhs)=DAMPING_MATRIX%ELEMENT_MATRIX%MATRIX(mhs,mhs)+ &
506 ! & QUADRATURE_SCHEME%GAUSS_BASIS_FNS(ms,NO_PART_DERIV,ng)*RWG ! // int phi_m
507 ! ENDIF
508  ENDDO !ms
509  ENDDO !mh
510  IF(rhs_vector%UPDATE_VECTOR) rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=0.0_dp
511  ENDDO !ng
512  IF(dependent_field%SCALINGS%SCALING_TYPE/=field_no_scaling) THEN
513  CALL field_interpolationparametersscalefactorselementget(element_number,equations%INTERPOLATION% &
514  & dependent_interp_parameters(field_var_type)%PTR,err,error,*999)
515  mhs=0
516  DO mh=1,field_variable%NUMBER_OF_COMPONENTS
517  !Loop over element rows
518  DO ms=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
519  mhs=mhs+1
520  nhs=0
521  IF(stiffness_matrix%UPDATE_MATRIX.OR.damping_matrix%UPDATE_MATRIX) THEN
522  !Loop over element columns
523  DO nh=1,field_variable%NUMBER_OF_COMPONENTS
524  DO ns=1,dependent_basis%NUMBER_OF_ELEMENT_PARAMETERS
525  nhs=nhs+1
526  IF(stiffness_matrix%UPDATE_MATRIX) THEN
527  stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=stiffness_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)* &
528  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)* &
529  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
530  ENDIF
531  IF(damping_matrix%UPDATE_MATRIX) THEN ! non mass lumped version
532  damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)=damping_matrix%ELEMENT_MATRIX%MATRIX(mhs,nhs)* &
533  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)* &
534  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ns,nh)
535  ENDIF
536  ENDDO !ns
537  ENDDO !nh
538  ENDIF
539 
540  IF(rhs_vector%UPDATE_VECTOR) rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)=rhs_vector%ELEMENT_VECTOR%VECTOR(mhs)* &
541  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(field_var_type)%PTR%SCALE_FACTORS(ms,mh)
542  ! IF(DAMPING_MATRIX%UPDATE_MATRIX) THEN ! mass lumped version
543  ! DAMPING_MATRIX%ELEMENT_MATRIX%MATRIX(mhs,nhs)=DAMPING_MATRIX%ELEMENT_MATRIX%MATRIX(mhs,nhs)* &
544  ! & EQUATIONS%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS(FIELD_VAR_TYPE)%PTR%SCALE_FACTORS(ms,mh)
545  ! ENDIF
546  ENDDO !ms
547  ENDDO !mh
548  ENDIF
549  CASE DEFAULT
550  local_error="Equations set subtype "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
551  & " is not valid for a Monodomain equation type of a Strang splitting equations set class."
552  CALL flagerror(local_error,err,error,*999)
553  END SELECT
554  ELSE
555  CALL flagerror("Equations set equations is not associated.",err,error,*999)
556  ENDIF
557  ELSE
558  CALL flagerror("Equations set is not associated.",err,error,*999)
559  ENDIF
560 
561  exits("Monodomain_FiniteElementCalculate")
562  RETURN
563 999 errorsexits("Monodomain_FiniteElementCalculate",err,error)
564  RETURN 1
565 
566  END SUBROUTINE monodomain_finiteelementcalculate
567 
568  !
569  !================================================================================================================================
570  !
571 
573  SUBROUTINE monodomain_equation_equations_set_setup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
575  !Argument variables
576  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
577  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
578  INTEGER(INTG), INTENT(OUT) :: ERR
579  TYPE(varying_string), INTENT(OUT) :: ERROR
580  !Local Variables
581  TYPE(varying_string) :: LOCAL_ERROR
582 
583  enters("MONODOMAIN_EQUATION_EQUATIONS_SET_SETUP",err,error,*999)
584 
585  IF(ASSOCIATED(equations_set)) THEN
586  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
587  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
588  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
589  CALL flagerror("Equations set specification must have three entries for a monodomain type equations set.", &
590  & err,error,*999)
591  END IF
592  SELECT CASE(equations_set%SPECIFICATION(3))
594  CALL monodomain_equationssetsubtypesetup(equations_set,equations_set_setup,err,error,*999)
595  CASE DEFAULT
596  local_error="Equations set subtype "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
597  & " is not valid for a Monodomain equation type of a Strang splitting equation set class."
598  CALL flagerror(local_error,err,error,*999)
599  END SELECT
600  ELSE
601  CALL flagerror("Equations set is not associated.",err,error,*999)
602  ENDIF
603 
604  exits("MONODOMAIN_EQUATION_EQUATIONS_SET_SETUP")
605  RETURN
606 999 errorsexits("MONODOMAIN_EQUATION_EQUATIONS_SET_SETUP",err,error)
607  RETURN 1
608  END SUBROUTINE monodomain_equation_equations_set_setup
609 
610  !
611  !================================================================================================================================
612  !
613 
615  SUBROUTINE monodomain_equationssetsolutionmethodset(EQUATIONS_SET,SOLUTION_METHOD,ERR,ERROR,*)
617  !Argument variables
618  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
619  INTEGER(INTG), INTENT(IN) :: SOLUTION_METHOD
620  INTEGER(INTG), INTENT(OUT) :: ERR
621  TYPE(varying_string), INTENT(OUT) :: ERROR
622  !Local Variables
623  TYPE(varying_string) :: LOCAL_ERROR
624 
625  enters("MONODOMAIN_EQUATIONS_SET_SOLUTION_METHOD_SET",err,error,*999)
626 
627  IF(ASSOCIATED(equations_set)) THEN
628  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
629  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
630  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
631  CALL flagerror("Equations set specification must have three entries for a monodomain type equations set.", &
632  & err,error,*999)
633  END IF
634  SELECT CASE(equations_set%SPECIFICATION(3))
636  SELECT CASE(solution_method)
638  equations_set%SOLUTION_METHOD=equations_set_fem_solution_method
640  CALL flagerror("Not implemented.",err,error,*999)
642  CALL flagerror("Not implemented.",err,error,*999)
644  CALL flagerror("Not implemented.",err,error,*999)
646  CALL flagerror("Not implemented.",err,error,*999)
648  CALL flagerror("Not implemented.",err,error,*999)
649  CASE DEFAULT
650  local_error="The specified solution method of "//trim(number_to_vstring(solution_method,"*",err,error))//" is invalid."
651  CALL flagerror(local_error,err,error,*999)
652  END SELECT
653  CASE DEFAULT
654  local_error="Equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
655  & " is not valid for a Monodomain equation type of monodomain Strang splitting equations set class."
656  CALL flagerror(local_error,err,error,*999)
657  END SELECT
658  ELSE
659  CALL flagerror("Equations set is not associated.",err,error,*999)
660  ENDIF
661 
662  exits("Monodomain_EquationsSetSolutionMethodSet")
663  RETURN
664 999 errors("Monodomain_EquationsSetSolutionMethodSet",err,error)
665  exits("Monodomain_EquationsSetSolutionMethodSet")
666  RETURN 1
667 
668  END SUBROUTINE monodomain_equationssetsolutionmethodset
669 
670  !
671  !================================================================================================================================
672  !
673 
675  SUBROUTINE monodomain_equationssetsubtypesetup(EQUATIONS_SET,EQUATIONS_SET_SETUP,ERR,ERROR,*)
677  !Argument variables
678  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
679  TYPE(equations_set_setup_type), INTENT(INOUT) :: EQUATIONS_SET_SETUP
680  INTEGER(INTG), INTENT(OUT) :: ERR
681  TYPE(varying_string), INTENT(OUT) :: ERROR
682  !Local Variables
683  INTEGER(INTG) :: component_idx,GEOMETRIC_MESH_COMPONENT,GEOMETRIC_SCALING_TYPE,NUMBER_OF_DIMENSIONS, &
684  & NUMBER_OF_MATERIALS_COMPONENTS, NUM_COMP
685  TYPE(decomposition_type), POINTER :: GEOMETRIC_DECOMPOSITION
686  TYPE(equations_type), POINTER :: EQUATIONS
687  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
688  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
689  TYPE(equations_set_materials_type), POINTER :: EQUATIONS_MATERIALS
690  TYPE(varying_string) :: LOCAL_ERROR
691 
692  enters("MONODOMAIN_EQUATION_EQUATION_SET_SUBTYPE_SETUP",err,error,*999)
693 
694  NULLIFY(equations)
695  NULLIFY(equations_mapping)
696  NULLIFY(equations_matrices)
697  NULLIFY(geometric_decomposition)
698 
699 
700  IF(ASSOCIATED(equations_set)) THEN
701  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
702  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
703  ELSE IF(SIZE(equations_set%SPECIFICATION,1)/=3) THEN
704  CALL flagerror("Equations set specification must have three entries for a monodomain type equations set.", &
705  & err,error,*999)
706  END IF
707  IF(equations_set%SPECIFICATION(3)==equations_set_monodomain_buenoorovio_subtype .OR. &
708  & equations_set%SPECIFICATION(3)==equations_set_monodomain_tentusscher06_subtype) THEN
709  SELECT CASE(equations_set_setup%SETUP_TYPE)
711  SELECT CASE(equations_set_setup%ACTION_TYPE)
713  CALL monodomain_equationssetsolutionmethodset(equations_set,equations_set_fem_solution_method, &
714  & err,error,*999)
716  !Do nothing
717  CASE DEFAULT
718  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
719  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
720  & " is invalid for a Monodomain equation."
721  CALL flagerror(local_error,err,error,*999)
722  END SELECT
724  !Do nothing
726  SELECT CASE(equations_set_setup%ACTION_TYPE)
728  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
729  !Create the auto created dependent field
730  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%DEPENDENT% &
731  & dependent_field,err,error,*999)
732  CALL field_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_general_type,err,error,*999)
733  CALL field_dependent_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_dependent_type,err,error,*999)
734  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
735  CALL field_mesh_decomposition_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_decomposition, &
736  & err,error,*999)
737  CALL field_geometric_field_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,equations_set%GEOMETRY% &
738  & geometric_field,err,error,*999)
739  CALL field_number_of_variables_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,2,err,error,*999)
740  CALL field_variable_types_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,(/field_u_variable_type, &
741  & field_deludeln_variable_type/),err,error,*999)
742  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
743  & field_scalar_dimension_type,err,error,*999)
744  CALL field_dimension_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
745  & field_scalar_dimension_type,err,error,*999)
746  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type, &
747  & field_dp_type,err,error,*999)
748  CALL field_data_type_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type, &
749  & field_dp_type,err,error,*999)
750 
751 
752 
753  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1,&
754  & err,error,*999)
755  CALL field_number_of_components_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,&
756  & 1 ,err,error,*999)
757 
758  !Default to the geometric interpolation setup
759  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,1, &
760  & geometric_mesh_component,err,error,*999)
761  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_u_variable_type,1, &
762  & geometric_mesh_component,err,error,*999)
763  CALL field_component_mesh_component_set(equations_set%DEPENDENT%DEPENDENT_FIELD,field_deludeln_variable_type,1, &
764  & geometric_mesh_component,err,error,*999)
765  SELECT CASE(equations_set%SOLUTION_METHOD)
767  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
768  & field_u_variable_type,1,field_node_based_interpolation,err,error,*999)
769  CALL field_component_interpolation_set_and_lock(equations_set%DEPENDENT%DEPENDENT_FIELD, &
770  & field_deludeln_variable_type,1,field_node_based_interpolation,err,error,*999)
771  !Default the scaling to the geometric field scaling
772  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
773  CALL field_scaling_type_set(equations_set%DEPENDENT%DEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
774  CASE DEFAULT
775  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
776  & " is invalid or not implemented"
777  CALL flagerror(local_error,err,error,*999)
778  END SELECT
779  ELSE
780  ! user specified field
781  CALL flagerror("No user specified field supported!",err,error,*999)
782  ENDIF
784  IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED) THEN
785  CALL field_create_finish(equations_set%DEPENDENT%DEPENDENT_FIELD,err,error,*999)
786  ENDIF
787  CASE DEFAULT
788  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
789  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
790  & " is invalid for a Monodomain equation"
791  CALL flagerror(local_error,err,error,*999)
792  END SELECT
793 
795  SELECT CASE(equations_set_setup%ACTION_TYPE)
797  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
798  SELECT CASE(equations_set%SPECIFICATION(3))
800  num_comp = 4
802  num_comp = 19
803  CASE DEFAULT
804  CALL flagerror("Invalid cell model equations set subtype",err,error,*999)
805  END SELECT
806 
807  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_set%INDEPENDENT% &
808  & independent_field,err,error,*999)
809  CALL field_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_general_type,err,error,*999)
810  CALL field_dependent_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,&
811  & field_independent_type,err,error,*999)
812  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
813  CALL field_mesh_decomposition_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_decomposition, &
814  & err,error,*999)
815  CALL field_geometric_field_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,equations_set%GEOMETRY% &
816  & geometric_field,err,error,*999)
817  CALL field_number_of_variables_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,1,err,error,*999)
818  CALL field_variable_types_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,&
819  &(/field_u_variable_type/),err,error,*999)
820  CALL field_dimension_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
821  & field_vector_dimension_type,err,error,*999)
822  CALL field_data_type_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type, &
823  & field_dp_type,err,error,*999)
824 
825  CALL field_number_of_components_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type,&
826  &num_comp,err,error,*999)
827  CALL field_dof_order_type_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type,&
828  & field_contiguous_component_dof_order,err,error,*999) ! dofs continuous, so first + (x-1) is x'th component index
829 
830  !Default to the geometric interpolation setup
831  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type,1, &
832  & geometric_mesh_component,err,error,*999)
833  CALL field_component_mesh_component_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,field_u_variable_type,1, &
834  & geometric_mesh_component,err,error,*999)
835 
836  SELECT CASE(equations_set%SOLUTION_METHOD)
838  CALL field_component_interpolation_set_and_lock(equations_set%INDEPENDENT%INDEPENDENT_FIELD, &
839  & field_u_variable_type,1,field_node_based_interpolation,err,error,*999)
840  !Default the scaling to the geometric field scaling
841  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
842  CALL field_scaling_type_set(equations_set%INDEPENDENT%INDEPENDENT_FIELD,geometric_scaling_type,err,error,*999)
843  END SELECT
844  ELSE
845  ! user specified field
846  CALL flagerror("No user specified field supported!",err,error,*999)
847  ENDIF
848 
850  IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED) THEN
851  CALL field_create_finish(equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999)
852  SELECT CASE(equations_set%SPECIFICATION(3))
854  CALL bueno_orovio_initialize(equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999) ! initialize to y0
856  CALL tentusscher06_initialize(equations_set%INDEPENDENT%INDEPENDENT_FIELD,err,error,*999) ! initialize to y0
857  CASE DEFAULT
858  CALL flagerror("Invalid cell model equations set subtype",err,error,*999)
859  END SELECT
860  ENDIF
861  CASE DEFAULT
862  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
863  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
864  & " is invalid for a Monodomain equation"
865  CALL flagerror(local_error,err,error,*999)
866  END SELECT
867 
869  SELECT CASE(equations_set_setup%ACTION_TYPE)
871  equations_materials=>equations_set%MATERIALS
872  IF(ASSOCIATED(equations_materials)) THEN
873  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
874  !Create the auto created materials field
875  CALL field_create_start(equations_set_setup%FIELD_USER_NUMBER,equations_set%REGION,equations_materials% &
876  & materials_field,err,error,*999)
877  CALL field_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_material_type,err,error,*999)
878  CALL field_dependent_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_independent_type,err,error,*999)
879  CALL field_mesh_decomposition_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_decomposition,err,error,*999)
880  CALL field_mesh_decomposition_set_and_lock(equations_materials%MATERIALS_FIELD,geometric_decomposition, &
881  & err,error,*999)
882  CALL field_geometric_field_set_and_lock(equations_materials%MATERIALS_FIELD,equations_set%GEOMETRY% &
883  & geometric_field,err,error,*999)
884  CALL field_number_of_variables_set_and_lock(equations_materials%MATERIALS_FIELD,1,err,error,*999)
885  CALL field_variable_types_set_and_lock(equations_materials%MATERIALS_FIELD,(/field_u_variable_type/), &
886  & err,error,*999)
887  CALL field_dimension_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
888  & field_vector_dimension_type,err,error,*999)
889  CALL field_data_type_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
890  & field_dp_type,err,error,*999)
891  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
892  & number_of_dimensions,err,error,*999)
893  !Materials field components are
894  ! 1. activation factor (usually 0.0 or 1.0)
895  ! 2,3 for fiber/transverse conductivity . defaults to constant interpolation
896  ! 4,5[,6] : fiber unit vector in dimension
897  ! 7: out - activation times
898  number_of_materials_components= 7 !NUMBER_OF_DIMENSIONS + 3
899  !Set the number of materials components
900  CALL field_number_of_components_set_and_lock(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
901  & number_of_materials_components,err,error,*999)
902 
903  ! 1st = activation = node based, 2 3 diffusion constants
904  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
905  & 1,field_node_based_interpolation,err,error,*999)
906  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
907  & 2,field_constant_interpolation,err,error,*999)
908  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
909  & 3,field_constant_interpolation,err,error,*999)
910  ! 4 5 (6) fiber unit vector
911  DO component_idx=1,3 !NUMBER_OF_DIMENSIONS
912  CALL field_component_mesh_component_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
913  & component_idx,geometric_mesh_component,err,error,*999)
914  CALL field_component_mesh_component_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
915  & component_idx+3,geometric_mesh_component,err,error,*999)
916  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
917  & component_idx+3,field_node_based_interpolation,err,error,*999)
918  ENDDO !component_idx
919 
920  CALL field_component_interpolation_set(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
921  & number_of_materials_components,field_node_based_interpolation,err,error,*999)
922 
923  !Default the field scaling to that of the geometric field
924  CALL field_scaling_type_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,geometric_scaling_type,err,error,*999)
925  CALL field_scaling_type_set(equations_materials%MATERIALS_FIELD,geometric_scaling_type,err,error,*999)
926  ELSE
927  ! user specified field
928  CALL flagerror("No user specified field supported!",err,error,*999)
929  ENDIF
930  ELSE
931 
932  CALL flagerror("Equations set materials is not associated.",err,error,*999)
933  ENDIF
935  equations_materials=>equations_set%MATERIALS
936  IF(ASSOCIATED(equations_materials)) THEN
937  IF(equations_materials%MATERIALS_FIELD_AUTO_CREATED) THEN
938  !Finish creating the materials field
939  CALL field_create_finish(equations_materials%MATERIALS_FIELD,err,error,*999)
940  !Set the default values for the materials field
941  CALL field_number_of_components_get(equations_set%GEOMETRY%GEOMETRIC_FIELD,field_u_variable_type, &
942  & number_of_dimensions,err,error,*999)
943  !Materials field components are 1 for each dimension
944  !i.e., k in div(k.grad(u(x)))
945  number_of_materials_components=number_of_dimensions
946  !First set the k values to 1.0
947  DO component_idx=1,number_of_dimensions
948  CALL field_component_values_initialise(equations_materials%MATERIALS_FIELD,field_u_variable_type, &
949  & field_values_set_type,component_idx,1.0_dp,err,error,*999)
950  ENDDO !component_idx
951  ENDIF
952  ELSE
953  CALL flagerror("Equations set materials is not associated.",err,error,*999)
954  ENDIF
955 ! ! ! Upto here
956  CASE DEFAULT
957  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
958  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
959  & " is invalid for a Monodomain equation."
960  CALL flagerror(local_error,err,error,*999)
961  END SELECT
963  SELECT CASE(equations_set_setup%ACTION_TYPE)
965  !Do nothing
967  !Do nothing
968  CASE DEFAULT
969  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
970  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
971  & " is invalid for a monodomain equation."
972  CALL flagerror(local_error,err,error,*999)
973  END SELECT
975  SELECT CASE(equations_set_setup%ACTION_TYPE)
977  IF(equations_set%DEPENDENT%DEPENDENT_FINISHED) THEN
978  CALL equations_create_start(equations_set,equations,err,error,*999)
979  CALL equations_linearity_type_set(equations,equations_linear,err,error,*999)
981  ELSE
982  CALL flagerror("Equations set dependent field has not been finished.",err,error,*999)
983  ENDIF
985  SELECT CASE(equations_set%SOLUTION_METHOD)
987  !Finish the equations creation
988  CALL equations_set_equations_get(equations_set,equations,err,error,*999)
989  CALL equations_create_finish(equations,err,error,*999)
990  !Create the equations mapping.
991  CALL equations_mapping_create_start(equations,equations_mapping,err,error,*999)
992  !!! Check this
993  !CALL EQUATIONS_MAPPING_LINEAR_MATRICES_NUMBER_SET(EQUATIONS_MAPPING,1,ERR,ERROR,*999)
994  CALL equations_mapping_dynamic_matrices_set(equations_mapping,.true.,.true.,err,error,*999)
995  !CALL EQUATIONS_MAPPING_LINEAR_MATRICES_VARIABLE_TYPES_SET(EQUATIONS_MAPPING,(/FIELD_U_VARIABLE_TYPE/), &
996  ! & ERR,ERROR,*999)
997  CALL equations_mapping_dynamic_variable_type_set(equations_mapping,field_u_variable_type,err,error,*999)
998  !!!! Check the above two lines
999  CALL equations_mapping_rhs_variable_type_set(equations_mapping,field_deludeln_variable_type,err,error,*999)
1000  CALL equations_mapping_create_finish(equations_mapping,err,error,*999)
1001  !Create the equations matrices
1002  CALL equations_matrices_create_start(equations,equations_matrices,err,error,*999)
1003  SELECT CASE(equations%SPARSITY_TYPE)
1006  & err,error,*999)
1008  !CALL EQUATIONS_MATRICES_DYNAMIC_STORAGE_TYPE_SET(EQUATIONS_MATRICES,(/MATRIX_COMPRESSED_ROW_STORAGE_TYPE/), &
1009  ! & ERR,ERROR,*999)
1010  !CALL EquationsMatrices_DynamicStructureTypeSet(EQUATIONS_MATRICES,(/EQUATIONS_MATRIX_FEM_STRUCTURE/), &
1011  ! & ERR,ERROR,*999)
1012  CALL equations_matrices_dynamic_storage_type_set(equations_matrices, &
1014  & err,error,*999)
1015  CALL equationsmatrices_dynamicstructuretypeset(equations_matrices, &
1017  CASE DEFAULT
1018  local_error="The equations matrices sparsity type of "// &
1019  & trim(number_to_vstring(equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
1020  CALL flagerror(local_error,err,error,*999)
1021  END SELECT
1022  CALL equations_matrices_create_finish(equations_matrices,err,error,*999)
1023  CASE DEFAULT
1024  local_error="The solution method of "//trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1025  & " is invalid or not implemented."
1026  CALL flagerror(local_error,err,error,*999)
1027  END SELECT
1028  CASE DEFAULT
1029  local_error="The action type of "//trim(number_to_vstring(equations_set_setup%ACTION_TYPE,"*",err,error))// &
1030  & " for a setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1031  & " is invalid for a Monodomain equation."
1032  CALL flagerror(local_error,err,error,*999)
1033  END SELECT
1034  CASE DEFAULT
1035  local_error="The setup type of "//trim(number_to_vstring(equations_set_setup%SETUP_TYPE,"*",err,error))// &
1036  & " is invalid for a Monodomain equation."
1037  CALL flagerror(local_error,err,error,*999)
1038  END SELECT
1039  ELSE
1040  local_error="The equations set subtype of "//trim(number_to_vstring(equations_set%SPECIFICATION(3),"*",err,error))// &
1041  & " does not equal a Monodomain equation subtype."
1042  CALL flagerror(local_error,err,error,*999)
1043  ENDIF
1044  ELSE
1045  CALL flagerror("Equations set is not associated.",err,error,*999)
1046  ENDIF
1047 
1048  exits("Monodomain_EquationsSetSubtypeSetup")
1049  RETURN
1050 999 errorsexits("Monodomain_EquationsSetSubtypeSetup",err,error)
1051  RETURN 1
1052 
1053  END SUBROUTINE monodomain_equationssetsubtypesetup
1054 
1055  !
1056  !================================================================================================================================
1057  !
1058 
1060  SUBROUTINE monodomain_equation_problem_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
1062  !Argument variables
1063  TYPE(problem_type), POINTER :: PROBLEM
1064  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
1065  INTEGER(INTG), INTENT(OUT) :: ERR
1066  TYPE(varying_string), INTENT(OUT) :: ERROR
1067  !Local Variables
1068  TYPE(varying_string) :: LOCAL_ERROR
1069 
1070  enters("MONODOMAIN_EQUATION_PROBLEM_SETUP",err,error,*999)
1071 
1072  IF(ASSOCIATED(problem)) THEN
1073  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
1074  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1075  ELSE IF(SIZE(problem%SPECIFICATION,1)<2) THEN
1076  CALL flagerror("Problem specification must have at least two entries for a monodomain equation problem.",err,error,*999)
1077  END IF
1078  SELECT CASE(problem%SPECIFICATION(2))
1080  CALL monodomain_problemstrangsplittingsetup(problem,problem_setup,err,error,*999)
1081  CASE DEFAULT
1082  local_error="Problem type "//trim(number_to_vstring(problem%SPECIFICATION(2),"*",err,error))// &
1083  & " is not valid for a Monodomain equation Strang splitting problem class."
1084  CALL flagerror(local_error,err,error,*999)
1085  END SELECT
1086  ELSE
1087  CALL flagerror("Problem is not associated.",err,error,*999)
1088  ENDIF
1089 
1090  exits("MONODOMAIN_EQUATION_PROBLEM_SETUP")
1091  RETURN
1092 999 errorsexits("MONODOMAIN_EQUATION_PROBLEM_SETUP",err,error)
1093  RETURN 1
1094  END SUBROUTINE monodomain_equation_problem_setup
1095 
1096 !
1097  !================================================================================================================================
1098  !
1099 
1101  SUBROUTINE monodomain_problemstrangsplittingsetup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
1103  !Argument variables
1104  TYPE(problem_type), POINTER :: PROBLEM
1105  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
1106  INTEGER(INTG), INTENT(OUT) :: ERR
1107  TYPE(varying_string), INTENT(OUT) :: ERROR
1108  !Local Variables
1109  TYPE(varying_string) :: LOCAL_ERROR
1110 
1111  enters("Monodomain_ProblemStrangSplittingSetup",err,error,*999)
1112 
1113  IF(ASSOCIATED(problem)) THEN
1114  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
1115  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1116  ELSE IF(SIZE(problem%SPECIFICATION,1)<3) THEN
1117  CALL flagerror("Problem specification must have three entries for a monodomain Strang splitting problem.",err,error,*999)
1118  END IF
1119  SELECT CASE(problem%SPECIFICATION(3))
1121  CALL monodomain_equation_problem_subtype_setup(problem,problem_setup,err,error,*999)
1122  CASE DEFAULT
1123  local_error="Problem subtype "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
1124  & " is not valid for a Monodomain equation type of a Strang splitting problem class."
1125  CALL flagerror(local_error,err,error,*999)
1126  END SELECT
1127  ELSE
1128  CALL flagerror("Problem is not associated.",err,error,*999)
1129  ENDIF
1130 
1131  exits("Monodomain_ProblemStrangSplittingSetup")
1132  RETURN
1133 999 errors("Monodomain_ProblemStrangSplittingSetup",err,error)
1134  exits("Monodomain_ProblemStrangSplittingSetup")
1135  RETURN 1
1136 
1137  END SUBROUTINE monodomain_problemstrangsplittingsetup
1138 
1139  !
1140  !================================================================================================================================
1141  !
1142 
1144  SUBROUTINE monodomain_equation_problem_subtype_setup(PROBLEM,PROBLEM_SETUP,ERR,ERROR,*)
1146  !Argument variables
1147  TYPE(problem_type), POINTER :: PROBLEM
1148  TYPE(problem_setup_type), INTENT(INOUT) :: PROBLEM_SETUP
1149  INTEGER(INTG), INTENT(OUT) :: ERR
1150  TYPE(varying_string), INTENT(OUT) :: ERROR
1151  !Local Variables
1152  TYPE(control_loop_type), POINTER :: CONTROL_LOOP,CONTROL_LOOP_ROOT
1153  TYPE(solver_type), POINTER :: SOLVER
1154  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
1155  TYPE(solvers_type), POINTER :: SOLVERS
1156  TYPE(varying_string) :: LOCAL_ERROR
1157 
1158  enters("MONODOMAIN_EQUATION_PROBLEM_SUBTYPE_SETUP",err,error,*999)
1159 
1160  NULLIFY(control_loop)
1161  NULLIFY(solver)
1162  NULLIFY(solver_equations)
1163  NULLIFY(solvers)
1164 
1165  IF(ASSOCIATED(problem)) THEN
1166  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
1167  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1168  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
1169  CALL flagerror("Problem specification must have three entries for a monodomain equation problem.",err,error,*999)
1170  END IF
1171  IF(problem%SPECIFICATION(3)==problem_monodomain_buenoorovio_subtype.OR. &
1172  & problem%SPECIFICATION(3)==problem_monodomain_tentusscher06_subtype)THEN
1173  SELECT CASE(problem_setup%SETUP_TYPE)
1175  SELECT CASE(problem_setup%ACTION_TYPE)
1177  !Do nothing????
1179  !Do nothing???
1180  CASE DEFAULT
1181  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1182  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1183  & " is invalid for a monodomain equation."
1184  CALL flagerror(local_error,err,error,*999)
1185  END SELECT
1187  SELECT CASE(problem_setup%ACTION_TYPE)
1189  !Set up a simple control loop
1190  CALL control_loop_create_start(problem,control_loop,err,error,*999)
1191  CALL control_loop_type_set(control_loop,problem_control_time_loop_type,err,error,*999)
1193  !Finish the control loops
1194  control_loop_root=>problem%CONTROL_LOOP
1195  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1196  CALL control_loop_create_finish(control_loop,err,error,*999)
1197  CASE DEFAULT
1198  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1199  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1200  & " is invalid for a monodomain equation."
1201  CALL flagerror(local_error,err,error,*999)
1202  END SELECT
1204  !Get the control loop
1205  control_loop_root=>problem%CONTROL_LOOP
1206  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1207  SELECT CASE(problem_setup%ACTION_TYPE)
1209  !Start the solvers creation
1210  CALL solvers_create_start(control_loop,solvers,err,error,*999)
1211  CALL solvers_number_set(solvers,1,err,error,*999)
1212  !Set the solver to be a first order dynamic solver
1213  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1214  CALL solver_type_set(solver,solver_dynamic_type,err,error,*999)
1215  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
1216  !Set solver defaults
1217  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
1219  CALL solver_library_type_set(solver,solver_cmiss_library,err,error,*999)
1221  !Get the solvers
1222  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
1223  !Finish the solvers creation
1224  CALL solvers_create_finish(solvers,err,error,*999)
1225  CASE DEFAULT
1226  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1227  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1228  & " is invalid for a monodomain equation."
1229  CALL flagerror(local_error,err,error,*999)
1230  END SELECT
1232  SELECT CASE(problem_setup%ACTION_TYPE)
1234  !Get the control loop
1235  control_loop_root=>problem%CONTROL_LOOP
1236  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1237  !Get the solver
1238  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
1239  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1240  !Create the solver equations
1241  CALL solver_equations_create_start(solver,solver_equations,err,error,*999)
1242  CALL solver_equations_linearity_type_set(solver_equations,solver_equations_linear,err,error,*999)
1244  CALL solver_equations_sparsity_type_set(solver_equations,solver_sparse_matrices,err,error,*999)
1246  !Get the control loop
1247  control_loop_root=>problem%CONTROL_LOOP
1248  CALL control_loop_get(control_loop_root,control_loop_node,control_loop,err,error,*999)
1249  !Get the solver equations
1250  CALL control_loop_solvers_get(control_loop,solvers,err,error,*999)
1251  CALL solvers_solver_get(solvers,1,solver,err,error,*999)
1252  CALL solver_solver_equations_get(solver,solver_equations,err,error,*999)
1253  !Finish the solver equations creation
1254  CALL solver_equations_create_finish(solver_equations,err,error,*999)
1255  CASE DEFAULT
1256  local_error="The action type of "//trim(number_to_vstring(problem_setup%ACTION_TYPE,"*",err,error))// &
1257  & " for a setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1258  & " is invalid for a monodomain equation."
1259  CALL flagerror(local_error,err,error,*999)
1260  END SELECT
1261  CASE DEFAULT
1262  local_error="The setup type of "//trim(number_to_vstring(problem_setup%SETUP_TYPE,"*",err,error))// &
1263  & " is invalid for a Monodomain equation."
1264  CALL flagerror(local_error,err,error,*999)
1265  END SELECT
1266  ELSE
1267  local_error="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))// &
1268  & " does not equal a Monodomain equation subtype."
1269  CALL flagerror(local_error,err,error,*999)
1270  ENDIF
1271  ELSE
1272  CALL flagerror("Problem is not associated.",err,error,*999)
1273  ENDIF
1274 
1275  exits("MONODOMAIN_EQUATION_PROBLEM_SUBTYPE_SETUP")
1276  RETURN
1277 999 errorsexits("MONODOMAIN_EQUATION_PROBLEM_SUBTYPE_SETUP",err,error)
1278  RETURN 1
1279  END SUBROUTINE monodomain_equation_problem_subtype_setup
1280 
1281  !
1282  !================================================================================================================================
1283  !
1284 
1286  SUBROUTINE monodomain_pre_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
1288  !Argument variables
1289  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1290  TYPE(solver_type), POINTER :: SOLVER
1291  INTEGER(INTG), INTENT(OUT) :: ERR
1292  TYPE(varying_string), INTENT(OUT) :: ERROR
1293  !Local Variables
1294  TYPE(varying_string) :: LOCAL_ERROR
1295  TYPE(field_type), POINTER :: DEPENDENT_FIELD, INDEPENDENT_FIELD
1296 
1297  enters("MONODOMAIN_PRE_SOLVE",err,error,*999)
1298 
1299  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
1300  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
1301  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1302  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<2) THEN
1303  CALL flagerror("Problem specification must at least two entries for a monodomain equation problem.",err,error,*999)
1304  END IF
1305  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(2))
1307  dependent_field=>solver%SOLVERS%SOLVERS(1)%PTR%SOLVER_EQUATIONS%SOLVER_MAPPING% &
1308  & equations_sets(1)%PTR%DEPENDENT%DEPENDENT_FIELD
1309  independent_field=>solver%SOLVERS%SOLVERS(1)%PTR%SOLVER_EQUATIONS%SOLVER_MAPPING% &
1310  & equations_sets(1)%PTR%INDEPENDENT%INDEPENDENT_FIELD
1311 
1312  CALL field_parameterstofieldparameterscopy(independent_field,field_u_variable_type,field_values_set_type, &
1313  & 1,dependent_field,field_u_variable_type,field_values_set_type,1,err,error,*999)
1314  CALL field_parameterstofieldparameterscopy(independent_field,field_u_variable_type,field_values_set_type, &
1315  & 1,dependent_field,field_u_variable_type,field_previous_values_set_type,1,err,error,*999) ! also to prev.
1316 
1317  CASE DEFAULT
1318  local_error="Problem type "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(2),"*",err,error))// &
1319  & " is not valid for a monodomain problem class."
1320  CALL flagerror(local_error,err,error,*999)
1321  END SELECT
1322  ELSE
1323  CALL flagerror("Problem is not associated.",err,error,*999)
1324  ENDIF
1325 
1326  exits("MONODOMAIN_PRE_SOLVE")
1327  RETURN
1328 999 errorsexits("MONODOMAIN_PRE_SOLVE",err,error)
1329  RETURN 1
1330  END SUBROUTINE monodomain_pre_solve
1331 
1332  !
1333  !================================================================================================================================
1334  !
1335 
1337  SUBROUTINE monodomain_post_solve(CONTROL_LOOP,SOLVER,ERR,ERROR,*)
1339  !Argument variables
1340  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
1341  TYPE(solver_type), POINTER :: SOLVER
1342  INTEGER(INTG), INTENT(OUT) :: ERR
1343  TYPE(varying_string), INTENT(OUT) :: ERROR
1344  !Local Variables
1345  TYPE(varying_string) :: LOCAL_ERROR
1346  REAL(DP) :: TMPV, TMPA
1347  INTEGER(INTG) :: I
1348  TYPE(field_type), POINTER :: DEPENDENT_FIELD, MATERIAL_FIELD, INDEPENDENT_FIELD, GEOMETRIC_FIELD
1349 
1350  TYPE(equations_type), POINTER :: EQUATIONS
1351  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
1352  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
1353  TYPE(equations_matrix_type), POINTER :: DAMPING_MATRIX,STIFFNESS_MATRIX
1354  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
1355 
1356  enters("MONODOMAIN_POST_SOLVE",err,error,*999)
1357 
1358  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
1359  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
1360  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1361  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<3) THEN
1362  CALL flagerror("Problem specification must have three entries for a monodomain equation problem.",err,error,*999)
1363  END IF
1364  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(2))
1365  CASE(problem_monodomain_strang_splitting_equation_type) ! CAN NOT GET EQN TYPE?!
1366 
1367 
1368  ! Don't update in next step
1369  equations=>solver%SOLVERS%SOLVERS(1)%PTR%SOLVER_EQUATIONS%SOLVER_MAPPING%EQUATIONS_SETS(1)%PTR%EQUATIONS
1370  equations_matrices=>equations%EQUATIONS_MATRICES
1371  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
1372  stiffness_matrix=>dynamic_matrices%MATRICES(1)%PTR
1373  damping_matrix=>dynamic_matrices%MATRICES(2)%PTR
1374  rhs_vector=>equations_matrices%RHS_VECTOR
1375  stiffness_matrix%UPDATE_MATRIX = .false.
1376  damping_matrix%UPDATE_MATRIX = .false.
1377  rhs_vector%UPDATE_VECTOR = .false.
1378 
1379  ! integrate cell models
1380  geometric_field => solver%SOLVERS%SOLVERS(1)%PTR%SOLVER_EQUATIONS%SOLVER_MAPPING% &
1381  & equations_sets(1)%PTR%GEOMETRY%GEOMETRIC_FIELD
1382  dependent_field => solver%SOLVERS%SOLVERS(1)%PTR%SOLVER_EQUATIONS%SOLVER_MAPPING% &
1383  & equations_sets(1)%PTR%DEPENDENT%DEPENDENT_FIELD
1384  material_field => solver%SOLVERS%SOLVERS(1)%PTR%SOLVER_EQUATIONS%SOLVER_MAPPING% &
1385  & equations_sets(1)%PTR%MATERIALS%MATERIALS_FIELD
1386  independent_field => solver%SOLVERS%SOLVERS(1)%PTR%SOLVER_EQUATIONS%SOLVER_MAPPING% &
1387  & equations_sets(1)%PTR%INDEPENDENT%INDEPENDENT_FIELD
1388 
1389  CALL field_parameterstofieldparameterscopy(dependent_field,field_u_variable_type,field_values_set_type, &
1390  & 1, independent_field,field_u_variable_type,field_values_set_type, 1,err,error,*999) ! dependent -> independent
1391 
1392  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(3))
1394  CALL bueno_orovio_integrate(independent_field,material_field,&
1395  & control_loop%TIME_LOOP%CURRENT_TIME-control_loop%TIME_LOOP%TIME_INCREMENT, control_loop%TIME_LOOP%CURRENT_TIME& ! from t-dt to t
1396  & ,err,error,*999)
1398  CALL tentusscher06_integrate(independent_field,material_field,&
1399  & control_loop%TIME_LOOP%CURRENT_TIME-control_loop%TIME_LOOP%TIME_INCREMENT, control_loop%TIME_LOOP%CURRENT_TIME& ! from t-dt to t
1400  & ,err,error,*999)
1401  CASE DEFAULT
1402  CALL flagerror("Invalid cell model subtype",err,error,*999)
1403  END SELECT
1404 
1405  DO i=1,independent_field%DECOMPOSITION%DOMAIN(1)%PTR%TOPOLOGY%NODES%NUMBER_OF_NODES
1406  !Default to version 1 of each derivative
1407  CALL field_parameter_set_get_node(independent_field,field_u_variable_type,field_values_set_type,1,1,i,1,tmpv,& ! get local node?
1408  & err,error,*999)
1409  IF (tmpv > 0) THEN
1410  !Default to version 1 of each derivative
1411  CALL field_parameter_set_get_node(material_field,field_u_variable_type,field_values_set_type,1,1,i,7,tmpa,&
1412  & err,error,*999)
1413  IF(abs(tmpa)<zero_tolerance) THEN
1414  !Default to version 1 of each derivative
1415  CALL field_parameter_set_update_node(material_field,field_u_variable_type,field_values_set_type,1,1,i,7,&
1416  &control_loop%TIME_LOOP%CURRENT_TIME, err,error,*999)
1417  ENDIF
1418  ENDIF
1419  ENDDO
1420 
1421  IF(mod(control_loop%TIME_LOOP%CURRENT_TIME+1e-6,5.0)<1e-3) THEN
1422  WRITE(*,*) 'T=',control_loop%TIME_LOOP%CURRENT_TIME
1423  ENDIF
1424 
1425  CASE DEFAULT
1426  local_error="Problem type "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(2),"*",err,error))// &
1427  & " is not valid for a monodomain problem class."
1428  CALL flagerror(local_error,err,error,*999)
1429  END SELECT
1430  ELSE
1431  CALL flagerror("Problem is not associated.",err,error,*999)
1432  ENDIF
1433 
1434  exits("MONODOMAIN_POST_SOLVE")
1435  RETURN
1436 999 errorsexits("MONODOMAIN_POST_SOLVE",err,error)
1437  RETURN 1
1438  END SUBROUTINE monodomain_post_solve
1439 
1440  !
1441  !================================================================================================================================
1442  !
1443 
integer(intg), parameter equations_set_setup_dependent_type
Dependent variables.
integer(intg), parameter equations_set_fem_solution_method
Finite Element Method solution method.
This module contains all basis function routines.
integer(intg), parameter equations_set_setup_materials_type
Materials setup.
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
subroutine, public solvers_create_finish(SOLVERS, ERR, ERROR,)
Finish the creation of solvers.
integer(intg), parameter, public control_loop_progress_output
Progress output from control loop.
subroutine, public equations_mapping_dynamic_variable_type_set(EQUATIONS_MAPPING, DYNAMIC_VARIABLE_TYPE, ERR, ERROR,)
Sets the mapping between a dependent field variable and the equations set dynamic matrices...
Contains information on the equations mapping i.e., how field variable DOFS are mapped to the rows an...
Definition: types.f90:1681
Contains information about the equations in an equations set.
Definition: types.f90:1735
integer(intg), parameter equations_set_gfem_solution_method
Grid-based Finite Element Method solution method.
subroutine, public bueno_orovio_integrate(cells, materials, t0, t1, err, error,)
Contains information for a region.
Definition: types.f90:3252
integer(intg), parameter problem_control_time_loop_type
Time control loop.
Contains information on a time iteration control loop.
Definition: types.f90:3148
integer(intg), parameter equations_set_monodomain_tentusscher06_subtype
integer(intg), parameter problem_setup_control_type
Solver setup for a problem.
This module handles all problem wide constants.
integer(intg), parameter solver_equations_first_order_dynamic
Solver equations are first order dynamic.
integer(intg), parameter, public control_loop_node
The identifier for a each "leaf" node in a control loop.
subroutine, public solver_dynamic_order_set(SOLVER, ORDER, ERR, ERROR,)
Sets/changes the order for a dynamic solver.
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
subroutine, public equations_create_start(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Start the creation of equations for the equation set.
Contains information on the mesh decomposition.
Definition: types.f90:1063
integer(intg), parameter problem_monodomain_buenoorovio_subtype
subroutine, public equations_matrices_create_start(EQUATIONS, EQUATIONS_MATRICES, ERR, ERROR,)
Starts the creation of the equations matrices and rhs for the the equations.
Contains information on the type of solver to be used.
Definition: types.f90:2777
subroutine, public solvers_number_set(SOLVERS, NUMBER_OF_SOLVERS, ERR, ERROR,)
Sets/changes the number of solvers.
integer(intg), parameter no_part_deriv
No partial derivative i.e., u.
Definition: constants.f90:177
integer(intg), parameter, public solver_dynamic_crank_nicolson_scheme
Crank-Nicolson dynamic solver.
subroutine, public solver_dynamic_degree_set(SOLVER, DEGREE, ERR, ERROR,)
Sets/changes the degree of the polynomial used to interpolate time for a dynamic solver.
This module handles all equations matrix and rhs routines.
integer(intg), parameter, public solver_dynamic_first_order
Dynamic solver has first order terms.
subroutine, public solver_type_set(SOLVER, SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type for a solver.
integer(intg), parameter equations_set_bioelectrics_class
Contains information on an equations set.
Definition: types.f90:1941
This module handles all equations routines.
integer(intg), parameter equations_set_setup_source_type
Source setup.
integer(intg), parameter problem_control_fixed_loop_type
Fixed iteration control loop.
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
subroutine, public solvers_create_start(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Start the creation of a solvers for the control loop.
Contains information on the solvers to be used in a control loop.
Definition: types.f90:2805
integer(intg), parameter problem_control_simple_type
Simple, one iteration control loop.
integer(intg), parameter first_part_deriv
First partial derivative i.e., du/ds.
Definition: constants.f90:178
This module contains routines for timing the program.
Definition: timer_f.f90:45
subroutine, public equations_time_dependence_type_set(EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for equations.
subroutine, public solver_equations_sparsity_type_set(SOLVER_EQUATIONS, SPARSITY_TYPE, ERR, ERROR,)
Sets/changes the sparsity type for solver equations.
subroutine, public solvers_solver_get(SOLVERS, SOLVER_INDEX, SOLVER, ERR, ERROR,)
Returns a pointer to the specified solver in the list of solvers.
Contains information for a field defined on a region.
Definition: types.f90:1346
integer(intg), parameter, public equations_matrices_full_matrices
Use fully populated equation matrices.
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.
integer(intg), parameter solver_equations_linear
Solver equations are linear.
Contains information on a control loop.
Definition: types.f90:3185
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
subroutine, public solver_equations_create_finish(SOLVER_EQUATIONS, ERR, ERROR,)
Finishes the process of creating solver equations.
integer(intg), parameter, public solver_sparse_matrices
Use sparse solver matrices.
integer(intg), parameter problem_bioelectrics_class
integer(intg), parameter equations_set_monodomain_buenoorovio_subtype
subroutine, public tentusscher06_integrate(cells, materials, t0, t1, err, error,)
subroutine, public solver_equations_create_start(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Starts the process of creating solver equations.
integer(intg), parameter, public solver_dynamic_type
A dynamic solver.
integer(intg), parameter, public basis_default_quadrature_scheme
Identifier for the default quadrature scheme.
integer(intg), parameter problem_setup_solvers_type
Solver setup for a problem.
integer(intg), parameter equations_set_setup_equations_type
Equations setup.
Contains information for mapping field variables to the dynamic matrices in the equations set of the ...
Definition: types.f90:1571
integer(intg), parameter equations_set_setup_independent_type
Independent variables.
This module contains all program wide constants.
Definition: constants.f90:45
subroutine, public solver_library_type_set(SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library type to use for the solver.
integer(intg), parameter problem_setup_initial_type
Initial setup for a problem.
integer(intg), parameter equations_set_monodomain_strang_splitting_equation_type
integer(intg), parameter equations_first_order_dynamic
The equations are first order dynamic.
integer(intg), parameter problem_monodomain_strang_splitting_equation_type
subroutine, public solver_equations_linearity_type_set(SOLVER_EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for solver equations.
integer(intg), parameter equations_set_setup_start_action
Start setup action.
subroutine, public exits(NAME)
Records the exit out of the named procedure.
recursive subroutine, public control_loop_solvers_get(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Returns a pointer to the solvers for a control loop.
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
Contains information on the equations matrices and vectors.
Definition: types.f90:1520
integer(intg), parameter, public equations_matrix_fem_structure
Finite element matrix structure.
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
subroutine, public equationsmatrices_dynamicstructuretypeset(EQUATIONS_MATRICES, STRUCTURE_TYPE, ERR, ERROR,)
Sets the structure (sparsity) of the dynamic equations matrices.
subroutine, public equations_matrices_linear_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the linear equations matrices.
subroutine, public equations_mapping_create_finish(EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping.
Returns the specified control loop as indexed by the control loop identifier from the control loop ro...
subroutine, public control_loop_type_set(CONTROL_LOOP, LOOP_TYPE, ERR, ERROR,)
Sets/changes the control loop type.
subroutine, public equations_set_equations_get(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Gets the equations for an equations set.
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
subroutine, public equations_create_finish(EQUATIONS, ERR, ERROR,)
Finish the creation of equations.
This module handles all domain mappings routines.
integer(intg), parameter problem_setup_finish_action
Finish setup action.
This module handles all equations mapping routines.
Contains information about the solver equations for a solver.
Definition: types.f90:2452
subroutine, public equations_matrices_dynamic_storage_type_set(EQUATIONS_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the dynamic equations matrices.
integer(intg), parameter equations_set_gfv_solution_method
Grid-based Finite Volume solution method.
integer(intg), parameter equations_set_setup_geometry_type
Geometry setup.
Contains information for a problem.
Definition: types.f90:3221
integer(intg), parameter equations_linear
The equations are linear.
subroutine, public equations_matrices_create_finish(EQUATIONS_MATRICES, ERR, ERROR,)
Finishes the creation of the equations matrices and RHS for the the equations.
This module handles all distributed matrix vector routines.
This module handles all boundary conditions routines.
This module handles all solver routines.
subroutine, public equations_mapping_create_start(EQUATIONS, EQUATIONS_MAPPING, ERR, ERROR,)
Finishes the process of creating an equations mapping for a equations set equations.
Contains information about an equations matrix.
Definition: types.f90:1429
Contains information for a particular quadrature scheme.
Definition: types.f90:141
Implements lists of Field IO operation.
This module contains all routines dealing with (non-distributed) matrix and vectors types...
subroutine, public equations_linearity_type_set(EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for equations.
subroutine, public control_loop_create_start(PROBLEM, CONTROL_LOOP, ERR, ERROR,)
Start the process of creating a control loop for a problem.
integer(intg), parameter problem_setup_solver_equations_type
Solver equations setup for a problem.
Contains information on the solver mapping between the global equation sets and the solver matrices...
Definition: types.f90:3091
subroutine, public solver_dynamic_scheme_set(SOLVER, SCHEME, ERR, ERROR,)
Sets/changes the scheme for a dynamic solver.
Contains information for a field variable defined on a field.
Definition: types.f90:1289
integer(intg), parameter equations_set_fd_solution_method
Finite Difference solution method.
integer(intg), parameter, public equations_matrices_sparse_matrices
Use sparse equations matrices.
integer(intg), parameter problem_control_load_increment_loop_type
Load increment control loop.
Contains information on the setup information for an equations set.
Definition: types.f90:1866
This module handles all Galerkin projection routines.
integer(intg), parameter problem_setup_start_action
Start setup action.
subroutine, public solver_equations_time_dependence_type_set(SOLVER_EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for solver equations.
This module handles all control loop routines.
integer(intg), parameter, public solver_cmiss_library
CMISS (internal) solver library.
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
This module defines all constants shared across equations set routines.
integer(intg), parameter equations_set_bem_solution_method
Boundary Element Method solution method.
subroutine, public solver_solver_equations_get(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Returns a pointer to the solver equations for a solver.
Contains all information about a basis .
Definition: types.f90:184
integer(intg), parameter equations_set_fv_solution_method
Finite Volume solution method.
integer(intg), parameter, public matrix_block_storage_type
Matrix block storage type.
subroutine, public bueno_orovio_initialize(field, err, error,)
integer(intg), parameter, public solver_dynamic_first_degree
Dynamic solver uses a first degree polynomial for time interpolation.
integer(intg), parameter equations_set_setup_initial_type
Initial setup.
recursive subroutine, public control_loop_create_finish(CONTROL_LOOP, ERR, ERROR,)
Finish the process of creating a control loop.
Flags an error condition.
integer(intg), parameter problem_monodomain_tentusscher06_subtype
This module handles all Monodomain equations routines.
integer(intg), parameter problem_control_while_loop_type
While control loop.
Contains information of the RHS vector for equations matrices.
Definition: types.f90:1500
real(dp), parameter zero_tolerance
Definition: constants.f90:70
This module contains all kind definitions.
Definition: kinds.f90:45
subroutine, public field_io_nodes_export(FIELDS, FILE_NAME, METHOD, ERR, ERROR,)
Export nodal information.
subroutine, public tentusscher06_initialize(field, err, error,)
integer(intg), parameter equations_set_setup_finish_action
Finish setup action.
integer(intg), parameter, public distributed_matrix_compressed_row_storage_type
Distributed matrix compressed row storage type.
Contains information of the dynamic matrices for equations matrices.
Definition: types.f90:1471
This module handles all formating and input and output.