OpenCMISS-Iron Internal API Documentation
equations_routines.f90
Go to the documentation of this file.
1 
43 
46 
47  USE base_routines
51  USE field_routines
53  USE kinds
54  USE strings
55  USE types
56 
57 #include "macros.h"
58 
59  IMPLICIT NONE
60 
61  PRIVATE
62 
63 
68  INTEGER(INTG), PARAMETER :: equations_no_output=0
69  INTEGER(INTG), PARAMETER :: equations_timing_output=1
70  INTEGER(INTG), PARAMETER :: equations_matrix_output=2
71  INTEGER(INTG), PARAMETER :: equations_element_matrix_output=3
72  INTEGER(INTG), PARAMETER :: equations_nodal_matrix_output=4
74 
79  INTEGER(INTG), PARAMETER :: equations_sparse_matrices=1
80  INTEGER(INTG), PARAMETER :: equations_full_matrices=2
82 
87  INTEGER(INTG), PARAMETER :: equations_unlumped_matrices=1
88  INTEGER(INTG), PARAMETER :: equations_lumped_matrices=2
90 
91  !Module types
92 
93  !Module variables
94 
95  !Interfaces
96 
98 
100 
102 
104 
106 
107  PUBLIC equations_destroy
108 
110 
112 
114 
116 
118 
120 
122 
124 
126 
128 
130 
132 
134 
136 
138 
140 
142 
144 
146 
148 
150 
151 CONTAINS
152 
153  !
154  !================================================================================================================================
155  !
156 
158  SUBROUTINE equations_create_finish(EQUATIONS,ERR,ERROR,*)
160  !Argument variables
161  TYPE(equations_type), POINTER :: EQUATIONS
162  INTEGER(INTG), INTENT(OUT) :: ERR
163  TYPE(varying_string), INTENT(OUT) :: ERROR
164  !Local Variables
165 
166  enters("EQUATIONS_CREATE_FINISH",err,error,*999)
167 
168  IF(ASSOCIATED(equations)) THEN
169  IF(equations%EQUATIONS_FINISHED) THEN
170  CALL flagerror("Equations have already been finished.",err,error,*999)
171  ELSE
172  !Set the finished flag
173  equations%EQUATIONS_FINISHED=.true.
174  ENDIF
175  ELSE
176  CALL flagerror("Equations is not associated.",err,error,*999)
177  ENDIF
178 
179  exits("EQUATIONS_CREATE_FINISH")
180  RETURN
181 999 errorsexits("EQUATIONS_CREATE_FINISH",err,error)
182  RETURN 1
183 
184  END SUBROUTINE equations_create_finish
185 
186  !
187  !================================================================================================================================
188  !
189 
191  SUBROUTINE equations_create_start(EQUATIONS_SET,EQUATIONS,ERR,ERROR,*)
193  !Argument variables
194  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
195  TYPE(equations_type), POINTER :: EQUATIONS
196  INTEGER(INTG), INTENT(OUT) :: ERR
197  TYPE(varying_string), INTENT(OUT) :: ERROR
198  !Local Variables
199 
200  enters("EQUATIONS_CREATE_START",err,error,*999)
201 
202  IF(ASSOCIATED(equations_set)) THEN
203  IF(ASSOCIATED(equations_set%EQUATIONS)) THEN
204  CALL flagerror("Equations are already associated for the equations set.",err,error,*999)
205  ELSE
206  IF(ASSOCIATED(equations)) THEN
207  CALL flagerror("Equations is already associated.",err,error,*999)
208  ELSE
209  !Initialise the equations
210  CALL equations_initialise(equations_set,err,error,*999)
211  !Return the pointer
212  equations=>equations_set%EQUATIONS
213  ENDIF
214  ENDIF
215  ELSE
216  CALL flagerror("Equations set is not associated.",err,error,*999)
217  ENDIF
218 
219  exits("EQUATIONS_CREATE_START")
220  RETURN
221 999 errorsexits("EQUATIONS_CREATE_START",err,error)
222  RETURN 1
223 
224  END SUBROUTINE equations_create_start
225 
226  !
227  !================================================================================================================================
228  !
229 
231  SUBROUTINE equations_destroy(EQUATIONS,ERR,ERROR,*)
233  !Argument variables
234  TYPE(equations_type), POINTER :: EQUATIONS
235  INTEGER(INTG), INTENT(OUT) :: ERR
236  TYPE(varying_string), INTENT(OUT) :: ERROR
237  !Local Variables
238 
239  enters("EQUATIONS_DESTROY",err,error,*999)
240 
241  IF(ASSOCIATED(equations)) THEN
242  CALL equations_finalise(equations,err,error,*999)
243  ELSE
244  CALL flagerror("Equations is not associated.",err,error,*999)
245  ENDIF
246 
247  exits("EQUATIONS_DESTROY")
248  RETURN
249 999 errorsexits("EQUATIONS_DESTROY",err,error)
250  RETURN 1
251 
252  END SUBROUTINE equations_destroy
253 
254  !
255  !================================================================================================================================
256  !
257 
259  SUBROUTINE equations_finalise(EQUATIONS,ERR,ERROR,*)
261  !Argument variables
262  TYPE(equations_type), POINTER :: EQUATIONS
263  INTEGER(INTG), INTENT(OUT) :: ERR
264  TYPE(varying_string), INTENT(OUT) :: ERROR
265  !Local Variables
266 
267  enters("EQUATIONS_FINALISE",err,error,*999)
268 
269  IF(ASSOCIATED(equations)) THEN
270  CALL equations_interpolation_finalise(equations%INTERPOLATION,err,error,*999)
271  IF(ASSOCIATED(equations%EQUATIONS_MAPPING)) CALL equations_mapping_destroy(equations%EQUATIONS_MAPPING,err,error,*999)
272  IF(ASSOCIATED(equations%EQUATIONS_MATRICES)) CALL equations_matrices_destroy(equations%EQUATIONS_MATRICES,err,error,*999)
273  DEALLOCATE(equations)
274  ENDIF
275 
276  exits("EQUATIONS_FINALISE")
277  RETURN
278 999 errorsexits("EQUATIONS_FINALISE",err,error)
279  RETURN 1
280  END SUBROUTINE equations_finalise
281 
282  !
283  !================================================================================================================================
284  !
285 
287  SUBROUTINE equations_initialise(EQUATIONS_SET,ERR,ERROR,*)
289  !Argument variables
290  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
291  INTEGER(INTG), INTENT(OUT) :: ERR
292  TYPE(varying_string), INTENT(OUT) :: ERROR
293  !Local Variables
294  INTEGER(INTG) :: DUMMY_ERR
295  TYPE(varying_string) :: DUMMY_ERROR
296 
297  enters("EQUATIONS_INITIALISE",err,error,*998)
298 
299  IF(ASSOCIATED(equations_set)) THEN
300  IF(ASSOCIATED(equations_set%EQUATIONS)) THEN
301  CALL flagerror("Equations is already associated for this equations set.",err,error,*998)
302  ELSE
303  ALLOCATE(equations_set%EQUATIONS,stat=err)
304  IF(err/=0) CALL flagerror("Could not allocate equations.",err,error,*999)
305  equations_set%EQUATIONS%EQUATIONS_SET=>equations_set
306  equations_set%EQUATIONS%LINEARITY=equations_linear
307  equations_set%EQUATIONS%TIME_DEPENDENCE=equations_static
308  equations_set%EQUATIONS%OUTPUT_TYPE=equations_no_output
309  equations_set%EQUATIONS%SPARSITY_TYPE=equations_sparse_matrices
310  equations_set%EQUATIONS%LUMPING_TYPE=equations_unlumped_matrices
311  NULLIFY(equations_set%EQUATIONS%INTERPOLATION)
312  NULLIFY(equations_set%EQUATIONS%EQUATIONS_MAPPING)
313  NULLIFY(equations_set%EQUATIONS%EQUATIONS_MATRICES)
314  equations_set%EQUATIONS%EQUATIONS_FINISHED=.false.
315  CALL equations_interpolation_initialise(equations_set%EQUATIONS,err,error,*999)
316  ENDIF
317  ELSE
318  CALL flagerror("Equations set is not associated",err,error,*998)
319  ENDIF
320 
321  exits("EQUATIONS_INITIALISE")
322  RETURN
323 999 CALL equations_finalise(equations_set%EQUATIONS,dummy_err,dummy_error,*998)
324 998 errorsexits("EQUATIONS_INITIALISE",err,error)
325  RETURN 1
326 
327  END SUBROUTINE equations_initialise
328 
329  !
330  !================================================================================================================================
331  !
332 
334  SUBROUTINE equations_interpolation_finalise(EQUATIONS_INTERPOLATION,ERR,ERROR,*)
336  !Argument variables
337  TYPE(equations_interpolation_type), POINTER :: EQUATIONS_INTERPOLATION
338  INTEGER(INTG), INTENT(OUT) :: ERR
339  TYPE(varying_string), INTENT(OUT) :: ERROR
340  !Local Variables
341 
342  enters("EQUATIONS_INTERPOLATION_FINALISE",err,error,*999)
343 
344  IF(ASSOCIATED(equations_interpolation)) THEN
345  CALL field_interpolation_parameters_finalise(equations_interpolation%GEOMETRIC_INTERP_PARAMETERS,err,error,*999)
346  CALL field_interpolation_parameters_finalise(equations_interpolation%FIBRE_INTERP_PARAMETERS,err,error,*999)
347  CALL field_interpolation_parameters_finalise(equations_interpolation%DEPENDENT_INTERP_PARAMETERS,err,error,*999)
348  CALL field_interpolation_parameters_finalise(equations_interpolation%INDEPENDENT_INTERP_PARAMETERS,err,error,*999)
349  CALL field_interpolation_parameters_finalise(equations_interpolation%MATERIALS_INTERP_PARAMETERS,err,error,*999)
350  CALL field_interpolation_parameters_finalise(equations_interpolation%SOURCE_INTERP_PARAMETERS,err,error,*999)
351  CALL field_interpolated_points_finalise(equations_interpolation%GEOMETRIC_INTERP_POINT,err,error,*999)
352  CALL field_interpolated_points_finalise(equations_interpolation%DEPENDENT_INTERP_POINT,err,error,*999)
353  CALL field_interpolated_points_finalise(equations_interpolation%INDEPENDENT_INTERP_POINT,err,error,*999)
354  CALL field_interpolated_points_finalise(equations_interpolation%FIBRE_INTERP_POINT,err,error,*999)
355  CALL field_interpolated_points_finalise(equations_interpolation%MATERIALS_INTERP_POINT,err,error,*999)
356  CALL field_interpolated_points_finalise(equations_interpolation%SOURCE_INTERP_POINT,err,error,*999)
357  CALL field_physical_points_finalise(equations_interpolation%DEPENDENT_PHYSICAL_POINT,err,error,*999)
358  CALL field_interpolatedpointsmetricsfinalise(equations_interpolation%DEPENDENT_INTERP_POINT_METRICS,err,error,*999)
359  CALL field_interpolatedpointsmetricsfinalise(equations_interpolation%INDEPENDENT_INTERP_POINT_METRICS,err,error,*999)
360  CALL field_interpolatedpointsmetricsfinalise(equations_interpolation%GEOMETRIC_INTERP_POINT_METRICS,err,error,*999)
361  CALL field_interpolatedpointsmetricsfinalise(equations_interpolation%FIBRE_INTERP_POINT_METRICS,err,error,*999)
362  DEALLOCATE(equations_interpolation)
363  ENDIF
364 
365  exits("EQUATIONS_INTERPOLATION_FINALISE")
366  RETURN
367 999 errorsexits("EQUATIONS_INTERPOLATION_FINALISE",err,error)
368  RETURN 1
369  END SUBROUTINE equations_interpolation_finalise
370 
371  !
372  !================================================================================================================================
373  !
374 
376  SUBROUTINE equations_interpolation_initialise(EQUATIONS,ERR,ERROR,*)
378  !Argument variables
379  TYPE(equations_type), POINTER :: EQUATIONS
380  INTEGER(INTG), INTENT(OUT) :: ERR
381  TYPE(varying_string), INTENT(OUT) :: ERROR
382  !Local Variables
383  INTEGER(INTG) :: DUMMY_ERR
384  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
385  TYPE(varying_string) :: DUMMY_ERROR
386 
387  enters("EQUATIONS_INTERPOLATION_INITIALISE",err,error,*998)
388 
389  IF(ASSOCIATED(equations)) THEN
390  equations_set=>equations%EQUATIONS_SET
391  IF(ASSOCIATED(equations_set)) THEN
392  IF(ASSOCIATED(equations%INTERPOLATION)) THEN
393  CALL flagerror("Interpolation is already associated for these equations.",err,error,*998)
394  ELSE
395  ALLOCATE(equations%INTERPOLATION,stat=err)
396  IF(err/=0) CALL flagerror("Could not allocate equations interpolation",err,error,*999)
397  equations%INTERPOLATION%EQUATIONS=>equations
398  NULLIFY(equations%INTERPOLATION%GEOMETRIC_INTERP_PARAMETERS)
399  NULLIFY(equations%INTERPOLATION%FIBRE_INTERP_PARAMETERS)
400  NULLIFY(equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS)
401  NULLIFY(equations%INTERPOLATION%INDEPENDENT_INTERP_PARAMETERS)
402  NULLIFY(equations%INTERPOLATION%MATERIALS_INTERP_PARAMETERS)
403  NULLIFY(equations%INTERPOLATION%SOURCE_INTERP_PARAMETERS)
404  NULLIFY(equations%INTERPOLATION%GEOMETRIC_INTERP_POINT)
405  NULLIFY(equations%INTERPOLATION%FIBRE_INTERP_POINT)
406  NULLIFY(equations%INTERPOLATION%DEPENDENT_INTERP_POINT)
407  NULLIFY(equations%INTERPOLATION%INDEPENDENT_INTERP_POINT)
408  NULLIFY(equations%INTERPOLATION%MATERIALS_INTERP_POINT)
409  NULLIFY(equations%INTERPOLATION%SOURCE_INTERP_POINT)
410  NULLIFY(equations%INTERPOLATION%DEPENDENT_PHYSICAL_POINT)
411  NULLIFY(equations%INTERPOLATION%DEPENDENT_INTERP_POINT_METRICS)
412  NULLIFY(equations%INTERPOLATION%INDEPENDENT_INTERP_POINT_METRICS)
413  NULLIFY(equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS)
414  NULLIFY(equations%INTERPOLATION%FIBRE_INTERP_POINT_METRICS)
415 
416  equations%INTERPOLATION%GEOMETRIC_FIELD=>equations_set%GEOMETRY%GEOMETRIC_FIELD
417  equations%INTERPOLATION%FIBRE_FIELD=>equations_set%GEOMETRY%FIBRE_FIELD
418  equations%INTERPOLATION%DEPENDENT_FIELD=>equations_set%DEPENDENT%DEPENDENT_FIELD
419  IF(ASSOCIATED(equations_set%INDEPENDENT)) THEN
420  equations%INTERPOLATION%INDEPENDENT_FIELD=>equations_set%INDEPENDENT%INDEPENDENT_FIELD
421  ELSE
422  NULLIFY(equations%INTERPOLATION%INDEPENDENT_FIELD)
423  ENDIF
424  IF(ASSOCIATED(equations_set%MATERIALS)) THEN
425  equations%INTERPOLATION%MATERIALS_FIELD=>equations_set%MATERIALS%MATERIALS_FIELD
426  ELSE
427  NULLIFY(equations%INTERPOLATION%MATERIALS_FIELD)
428  ENDIF
429  IF(ASSOCIATED(equations_set%SOURCE)) THEN
430  equations%INTERPOLATION%SOURCE_FIELD=>equations_set%SOURCE%SOURCE_FIELD
431  ELSE
432  NULLIFY(equations%INTERPOLATION%SOURCE_FIELD)
433  ENDIF
434 
435  CALL field_interpolation_parameters_initialise(equations%INTERPOLATION%GEOMETRIC_FIELD, &
436  & equations%INTERPOLATION%GEOMETRIC_INTERP_PARAMETERS,err,error,*999)
437  CALL field_interpolated_points_initialise(equations%INTERPOLATION%GEOMETRIC_INTERP_PARAMETERS, &
438  & equations%INTERPOLATION%GEOMETRIC_INTERP_POINT,err,error,*999)
439  CALL field_interpolatedpointsmetricsinitialise(equations%INTERPOLATION%GEOMETRIC_INTERP_POINT, &
440  & equations%INTERPOLATION%GEOMETRIC_INTERP_POINT_METRICS,err,error,*999)
441  CALL field_interpolation_parameters_initialise(equations%INTERPOLATION%DEPENDENT_FIELD, &
442  & equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS,err,error,*999)
443  CALL field_interpolated_points_initialise(equations%INTERPOLATION%DEPENDENT_INTERP_PARAMETERS, &
444  & equations%INTERPOLATION%DEPENDENT_INTERP_POINT,err,error,*999)
445 ! CALL FIELD_PHYSICAL_POINTS_INITIALISE(EQUATIONS%INTERPOLATION%DEPENDENT_INTERP_POINT, &
446 ! & EQUATIONS%INTERPOLATION%GEOMETRIC_INTERP_POINT,EQUATIONS%INTERPOLATION%DEPENDENT_PHYSICAL_POINT, &
447 ! & ERR,ERROR,*999)
448  IF(equations%INTERPOLATION%DEPENDENT_FIELD%TYPE==field_geometric_type.OR. &
449  & equations%INTERPOLATION%DEPENDENT_FIELD%TYPE==field_fibre_type.OR. &
450  & equations%INTERPOLATION%DEPENDENT_FIELD%TYPE==field_geometric_general_type) THEN
451  CALL field_interpolatedpointsmetricsinitialise(equations%INTERPOLATION%DEPENDENT_INTERP_POINT, &
452  & equations%INTERPOLATION%DEPENDENT_INTERP_POINT_METRICS,err,error,*999)
453  ENDIF
454  IF(ASSOCIATED(equations%INTERPOLATION%FIBRE_FIELD)) THEN
455  CALL field_interpolation_parameters_initialise(equations%INTERPOLATION%FIBRE_FIELD, &
456  & equations%INTERPOLATION%FIBRE_INTERP_PARAMETERS,err,error,*999)
457  CALL field_interpolated_points_initialise(equations%INTERPOLATION%FIBRE_INTERP_PARAMETERS, &
458  & equations%INTERPOLATION%FIBRE_INTERP_POINT,err,error,*999)
459  CALL field_interpolatedpointsmetricsinitialise(equations%INTERPOLATION%FIBRE_INTERP_POINT, &
460  & equations%INTERPOLATION%FIBRE_INTERP_POINT_METRICS,err,error,*999)
461  ENDIF
462  IF(ASSOCIATED(equations%INTERPOLATION%INDEPENDENT_FIELD)) THEN
463  CALL field_interpolation_parameters_initialise(equations%INTERPOLATION%INDEPENDENT_FIELD, &
464  & equations%INTERPOLATION%INDEPENDENT_INTERP_PARAMETERS,err,error,*999)
465  CALL field_interpolated_points_initialise(equations%INTERPOLATION%INDEPENDENT_INTERP_PARAMETERS, &
466  & equations%INTERPOLATION%INDEPENDENT_INTERP_POINT,err,error,*999)
467  IF(equations%INTERPOLATION%INDEPENDENT_FIELD%TYPE==field_geometric_type.OR. &
468  & equations%INTERPOLATION%INDEPENDENT_FIELD%TYPE==field_fibre_type) THEN
469  CALL field_interpolatedpointsmetricsinitialise(equations%INTERPOLATION%INDEPENDENT_INTERP_POINT, &
470  & equations%INTERPOLATION%INDEPENDENT_INTERP_POINT_METRICS,err,error,*999)
471  END IF
472  ENDIF
473  IF(ASSOCIATED(equations%INTERPOLATION%MATERIALS_FIELD)) THEN
474  CALL field_interpolation_parameters_initialise(equations%INTERPOLATION%MATERIALS_FIELD, &
475  & equations%INTERPOLATION%MATERIALS_INTERP_PARAMETERS,err,error,*999)
476  CALL field_interpolated_points_initialise(equations%INTERPOLATION%MATERIALS_INTERP_PARAMETERS, &
477  & equations%INTERPOLATION%MATERIALS_INTERP_POINT,err,error,*999)
478  ENDIF
479  IF(ASSOCIATED(equations%INTERPOLATION%SOURCE_FIELD)) THEN
480  CALL field_interpolation_parameters_initialise(equations%INTERPOLATION%SOURCE_FIELD, &
481  & equations%INTERPOLATION%SOURCE_INTERP_PARAMETERS,err,error,*999)
482  CALL field_interpolated_points_initialise(equations%INTERPOLATION%SOURCE_INTERP_PARAMETERS, &
483  & equations%INTERPOLATION%SOURCE_INTERP_POINT,err,error,*999)
484  ENDIF
485 
486  ENDIF
487  ELSE
488  CALL flagerror("Equations equation set is not associated",err,error,*998)
489  ENDIF
490  ELSE
491  CALL flagerror("Equations is not associated",err,error,*998)
492  ENDIF
493 
494  exits("EQUATIONS_INTERPOLATION_INITIALISE")
495  RETURN
496 999 CALL equations_interpolation_finalise(equations%INTERPOLATION,dummy_err,dummy_error,*998)
497 998 errorsexits("EQUATIONS_INTERPOLATION_INITIALISE",err,error)
498  RETURN 1
500 
501  !
502  !================================================================================================================================
503  !
504 
506  SUBROUTINE equations_linearity_type_get(EQUATIONS,LINEARITY_TYPE,ERR,ERROR,*)
508  !Argument variables
509  TYPE(equations_type), POINTER :: EQUATIONS
510  INTEGER(INTG), INTENT(OUT) :: LINEARITY_TYPE
511  INTEGER(INTG), INTENT(OUT) :: ERR
512  TYPE(varying_string), INTENT(OUT) :: ERROR
513  !Local Variables
514 
515  enters("EQUATIONS_LINEARITY_TYPE_GET",err,error,*999)
516 
517  IF(ASSOCIATED(equations)) THEN
518  IF(equations%EQUATIONS_FINISHED) THEN
519  linearity_type=equations%LINEARITY
520  ELSE
521  CALL flagerror("Equations has not been finished.",err,error,*999)
522  ENDIF
523  ELSE
524  CALL flagerror("Equations is not associated.",err,error,*999)
525  ENDIF
526 
527  exits("EQUATIONS_LINEARITY_TYPE_GET")
528  RETURN
529 999 errorsexits("EQUATIONS_LINEARITY_TYPE_GET",err,error)
530  RETURN 1
531  END SUBROUTINE equations_linearity_type_get
532 
533  !
534  !================================================================================================================================
535  !
536 
538  SUBROUTINE equations_linearity_type_set(EQUATIONS,LINEARITY_TYPE,ERR,ERROR,*)
540  !Argument variables
541  TYPE(equations_type), POINTER :: EQUATIONS
542  INTEGER(INTG), INTENT(IN) :: LINEARITY_TYPE
543  INTEGER(INTG), INTENT(OUT) :: ERR
544  TYPE(varying_string), INTENT(OUT) :: ERROR
545  !Local Variables
546  TYPE(varying_string) :: LOCAL_ERROR
547 
548  enters("EQUATIONS_LINEARITY_TYPE_SET",err,error,*999)
549 
550  IF(ASSOCIATED(equations)) THEN
551  IF(equations%EQUATIONS_FINISHED) THEN
552  CALL flagerror("Equations has already been finished.",err,error,*999)
553  ELSE
554  SELECT CASE(linearity_type)
555  CASE(equations_linear)
556  equations%LINEARITY=equations_linear
557  CASE(equations_nonlinear)
558  equations%LINEARITY=equations_nonlinear
560  equations%LINEARITY=equations_nonlinear_bcs
561  CASE DEFAULT
562  local_error="The specified linearity type of "//trim(number_to_vstring(linearity_type,"*",err,error))// &
563  & " is invalid."
564  CALL flagerror(local_error,err,error,*999)
565  END SELECT
566  ENDIF
567  ELSE
568  CALL flagerror("Equations is not associated.",err,error,*999)
569  ENDIF
570 
571  exits("EQUATIONS_LINEARITY_TYPE_SET")
572  RETURN
573 999 errorsexits("EQUATIONS_LINEARITY_TYPE_SET",err,error)
574  RETURN 1
575  END SUBROUTINE equations_linearity_type_set
576 
577  !
578  !================================================================================================================================
579  !
580 
582  SUBROUTINE equations_lumping_type_get(EQUATIONS,LUMPING_TYPE,ERR,ERROR,*)
584  !Argument variables
585  TYPE(equations_type), POINTER :: EQUATIONS
586  INTEGER(INTG), INTENT(OUT) :: LUMPING_TYPE
587  INTEGER(INTG), INTENT(OUT) :: ERR
588  TYPE(varying_string), INTENT(OUT) :: ERROR
589  !Local Variables
590 
591  enters("EQUATIONS_LUMPING_TYPE_GET",err,error,*999)
592 
593  IF(ASSOCIATED(equations)) THEN
594  IF(equations%EQUATIONS_FINISHED) THEN
595  lumping_type=equations%LUMPING_TYPE
596  ELSE
597  CALL flagerror("Equations has not been finished.",err,error,*999)
598  ENDIF
599  ELSE
600  CALL flagerror("Equations is not associated.",err,error,*999)
601  ENDIF
602 
603  exits("EQUATIONS_LUMPING_TYPE_GET")
604  RETURN
605 999 errorsexits("EQUATIONS_LUMPING_TYPE_GET",err,error)
606  RETURN 1
607  END SUBROUTINE equations_lumping_type_get
608 
609  !
610  !================================================================================================================================
611  !
612 
614  SUBROUTINE equations_lumping_type_set(EQUATIONS,LUMPING_TYPE,ERR,ERROR,*)
616  !Argument variables
617  TYPE(equations_type), POINTER :: EQUATIONS
618  INTEGER(INTG), INTENT(IN) :: LUMPING_TYPE
619  INTEGER(INTG), INTENT(OUT) :: ERR
620  TYPE(varying_string), INTENT(OUT) :: ERROR
621  !Local Variables
622  TYPE(varying_string) :: LOCAL_ERROR
623 
624  enters("EQUATIONS_LUMPING_TYPE_SET",err,error,*999)
625 
626  IF(ASSOCIATED(equations)) THEN
627  IF(equations%EQUATIONS_FINISHED) THEN
628  CALL flagerror("Equations has already been finished.",err,error,*999)
629  ELSE
630  IF(equations%TIME_DEPENDENCE==equations_first_order_dynamic.OR. &
631  & equations%TIME_DEPENDENCE==equations_second_order_dynamic) THEN
632  SELECT CASE(lumping_type)
634  equations%LUMPING_TYPE=equations_unlumped_matrices
636  equations%LUMPING_TYPE=equations_lumped_matrices
637  CASE DEFAULT
638  local_error="The specified lumping type of "//trim(number_to_vstring(lumping_type,"*",err,error))// &
639  & " is invalid."
640  CALL flagerror(local_error,err,error,*999)
641  END SELECT
642  ELSE
643  local_error="Invalid equations time dependence. The equations time dependence of "// &
644  & trim(number_to_vstring(equations%TIME_DEPENDENCE,"*",err,error))// &
645  & " does not correspond to dynamic equations. You can only set lumping for dynamic equations."
646  CALL flagerror(local_error,err,error,*999)
647  ENDIF
648  ENDIF
649  ELSE
650  CALL flagerror("Equations is not associated.",err,error,*999)
651  ENDIF
652 
653  exits("EQUATIONS_LUMPING_TYPE_SET")
654  RETURN
655 999 errorsexits("EQUATIONS_LUMPING_TYPE_SET",err,error)
656  RETURN 1
657  END SUBROUTINE equations_lumping_type_set
658 
659  !
660  !================================================================================================================================
661  !
662 
664  SUBROUTINE equations_output_type_get(EQUATIONS,OUTPUT_TYPE,ERR,ERROR,*)
666  !Argument variables
667  TYPE(equations_type), POINTER :: EQUATIONS
668  INTEGER(INTG), INTENT(OUT) :: OUTPUT_TYPE
669  INTEGER(INTG), INTENT(OUT) :: ERR
670  TYPE(varying_string), INTENT(OUT) :: ERROR
671  !Local Variables
672 
673  enters("EQUATIONS_OUTPUT_TYPE_GET",err,error,*999)
674 
675  IF(ASSOCIATED(equations)) THEN
676  IF(equations%EQUATIONS_FINISHED) THEN
677  output_type=equations%OUTPUT_TYPE
678  ELSE
679  CALL flagerror("Equations has not been finished.",err,error,*999)
680  ENDIF
681  ELSE
682  CALL flagerror("Equations is not associated.",err,error,*999)
683  ENDIF
684 
685  exits("EQUATIONS_OUTPUT_TYPE_GET")
686  RETURN
687 999 errorsexits("EQUATIONS_OUTPUT_TYPE_GET",err,error)
688  RETURN 1
689  END SUBROUTINE equations_output_type_get
690 
691  !
692  !================================================================================================================================
693  !
694 
696  SUBROUTINE equations_output_type_set(EQUATIONS,OUTPUT_TYPE,ERR,ERROR,*)
698  !Argument variables
699  TYPE(equations_type), POINTER :: EQUATIONS
700  INTEGER(INTG), INTENT(IN) :: OUTPUT_TYPE
701  INTEGER(INTG), INTENT(OUT) :: ERR
702  TYPE(varying_string), INTENT(OUT) :: ERROR
703  !Local Variables
704  TYPE(varying_string) :: LOCAL_ERROR
705 
706  enters("EQUATIONS_OUTPUT_TYPE_SET",err,error,*999)
707 
708  IF(ASSOCIATED(equations)) THEN
709  IF(equations%EQUATIONS_FINISHED) THEN
710  CALL flagerror("Equations has already been finished.",err,error,*999)
711  ELSE
712  SELECT CASE(output_type)
713  CASE(equations_no_output)
714  equations%OUTPUT_TYPE=equations_no_output
716  equations%OUTPUT_TYPE=equations_timing_output
718  equations%OUTPUT_TYPE=equations_matrix_output
720  equations%OUTPUT_TYPE=equations_element_matrix_output
722  equations%OUTPUT_TYPE=equations_nodal_matrix_output
723  CASE DEFAULT
724  local_error="The specified output type of "//trim(number_to_vstring(output_type,"*",err,error))//" is invalid"
725  CALL flagerror(local_error,err,error,*999)
726  END SELECT
727  ENDIF
728  ELSE
729  CALL flagerror("Equations is not associated.",err,error,*999)
730  ENDIF
731 
732  exits("EQUATIONS_OUTPUT_TYPE_SET")
733  RETURN
734 999 errorsexits("EQUATIONS_OUTPUT_TYPE_SET",err,error)
735  RETURN 1
736 
737  END SUBROUTINE equations_output_type_set
738 
739  !
740  !================================================================================================================================
741  !
742 
744  SUBROUTINE equations_sparsity_type_get(EQUATIONS,SPARSITY_TYPE,ERR,ERROR,*)
746  !Argument variables
747  TYPE(equations_type), POINTER :: EQUATIONS
748  INTEGER(INTG), INTENT(OUT) :: SPARSITY_TYPE
749  INTEGER(INTG), INTENT(OUT) :: ERR
750  TYPE(varying_string), INTENT(OUT) :: ERROR
751  !Local Variables
752 
753  enters("EQUATIONS_SPARSITY_TYPE_GET",err,error,*999)
754 
755  IF(ASSOCIATED(equations)) THEN
756  IF(equations%EQUATIONS_FINISHED) THEN
757  sparsity_type=equations%SPARSITY_TYPE
758  ELSE
759  CALL flagerror("Equations has not been finished.",err,error,*999)
760  ENDIF
761  ELSE
762  CALL flagerror("Equations is not associated.",err,error,*999)
763  ENDIF
764 
765  exits("EQUATIONS_SPARSITY_TYPE_GET")
766  RETURN
767 999 errorsexits("EQUATIONS_SPARSITY_TYPE_GET",err,error)
768  RETURN 1
769  END SUBROUTINE equations_sparsity_type_get
770 
771  !
772  !================================================================================================================================
773  !
774 
776  SUBROUTINE equations_sparsity_type_set(EQUATIONS,SPARSITY_TYPE,ERR,ERROR,*)
778  !Argument variables
779  TYPE(equations_type), POINTER :: EQUATIONS
780  INTEGER(INTG), INTENT(IN) :: SPARSITY_TYPE
781  INTEGER(INTG), INTENT(OUT) :: ERR
782  TYPE(varying_string), INTENT(OUT) :: ERROR
783  !Local Variables
784  TYPE(varying_string) :: LOCAL_ERROR
785 
786  enters("EQUATIONS_SPARSITY_TYPE_SET",err,error,*999)
787 
788  IF(ASSOCIATED(equations)) THEN
789  IF(equations%EQUATIONS_FINISHED) THEN
790  CALL flagerror("Equations has already been finished.",err,error,*999)
791  ELSE
792  SELECT CASE(sparsity_type)
794  equations%SPARSITY_TYPE=equations_sparse_matrices
796  equations%SPARSITY_TYPE=equations_full_matrices
797  CASE DEFAULT
798  local_error="The specified sparsity type of "//trim(number_to_vstring(sparsity_type,"*",err,error))// &
799  & " is invalid."
800  CALL flagerror(local_error,err,error,*999)
801  END SELECT
802  ENDIF
803  ELSE
804  CALL flagerror("Equations is not associated.",err,error,*999)
805  ENDIF
806 
807  exits("EQUATIONS_SPARSITY_TYPE_SET")
808  RETURN
809 999 errorsexits("EQUATIONS_SPARSITY_TYPE_SET",err,error)
810  RETURN 1
811  END SUBROUTINE equations_sparsity_type_set
812 
813  !
814  !================================================================================================================================
815  !
816 
818  SUBROUTINE equations_time_dependence_type_get(EQUATIONS,TIME_DEPENDENCE_TYPE,ERR,ERROR,*)
820  !Argument variables
821  TYPE(equations_type), POINTER :: EQUATIONS
822  INTEGER(INTG), INTENT(OUT) :: TIME_DEPENDENCE_TYPE
823  INTEGER(INTG), INTENT(OUT) :: ERR
824  TYPE(varying_string), INTENT(OUT) :: ERROR
825  !Local Variables
826 
827  enters("EQUATIONS_TIME_DEPENDENCE_TYPE_GET",err,error,*999)
828 
829  IF(ASSOCIATED(equations)) THEN
830  IF(equations%EQUATIONS_FINISHED) THEN
831  time_dependence_type=equations%TIME_DEPENDENCE
832  ELSE
833  CALL flagerror("Equations has not been finished.",err,error,*999)
834  ENDIF
835  ELSE
836  CALL flagerror("Equations is not associated.",err,error,*999)
837  ENDIF
838 
839  exits("EQUATIONS_TIME_DEPENDENCE_TYPE_GET")
840  RETURN
841 999 errorsexits("EQUATIONS_TIME_DEPENDENCE_TYPE_GET",err,error)
842  RETURN 1
844 
845  !
846  !================================================================================================================================
847  !
848 
850  SUBROUTINE equations_time_dependence_type_set(EQUATIONS,TIME_DEPENDENCE_TYPE,ERR,ERROR,*)
852  !Argument variables
853  TYPE(equations_type), POINTER :: EQUATIONS
854  INTEGER(INTG), INTENT(IN) :: TIME_DEPENDENCE_TYPE
855  INTEGER(INTG), INTENT(OUT) :: ERR
856  TYPE(varying_string), INTENT(OUT) :: ERROR
857  !Local Variables
858  TYPE(varying_string) :: LOCAL_ERROR
859 
860  enters("EQUATIONS_TIME_DEPENDENCE_TYPE_SET",err,error,*999)
861 
862  IF(ASSOCIATED(equations)) THEN
863  IF(equations%EQUATIONS_FINISHED) THEN
864  CALL flagerror("Equations has already been finished.",err,error,*999)
865  ELSE
866  SELECT CASE(time_dependence_type)
867  CASE(equations_static)
868  equations%TIME_DEPENDENCE=equations_static
870  equations%TIME_DEPENDENCE=equations_quasistatic
872  equations%TIME_DEPENDENCE=equations_first_order_dynamic
874  equations%TIME_DEPENDENCE=equations_second_order_dynamic
875  CASE DEFAULT
876  local_error="The specified time dependence type of "//trim(number_to_vstring(time_dependence_type,"*",err,error))// &
877  & " is invalid."
878  CALL flagerror(local_error,err,error,*999)
879  END SELECT
880  ENDIF
881  ELSE
882  CALL flagerror("Equations is not associated.",err,error,*999)
883  ENDIF
884 
885  exits("EQUATIONS_TIME_DEPENDENCE_TYPE_SET")
886  RETURN
887 999 errorsexits("EQUATIONS_TIME_DEPENDENCE_TYPE_SET",err,error)
888  RETURN 1
890 
891  !
892  !================================================================================================================================
893  !
894 
896  SUBROUTINE equations_set_equations_get(EQUATIONS_SET,EQUATIONS,ERR,ERROR,*)
898  !Argument variables
899  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
900  TYPE(equations_type), POINTER :: EQUATIONS
901  INTEGER(INTG), INTENT(OUT) :: ERR
902  TYPE(varying_string), INTENT(OUT) :: ERROR
903  !Local Variables
904 
905  enters("EQUATIONS_SET_EQUATIONS_GET",err,error,*999)
906 
907  IF(ASSOCIATED(equations_set)) THEN
908  IF(equations_set%EQUATIONS_SET_FINISHED) THEN
909  IF(ASSOCIATED(equations)) THEN
910  CALL flagerror("Equations is already associated.",err,error,*999)
911  ELSE
912  equations=>equations_set%EQUATIONS
913  IF(.NOT.ASSOCIATED(equations)) CALL flagerror("Equations set equations is not associated.",err,error,*999)
914  ENDIF
915  ELSE
916  CALL flagerror("Equations set has not been finished.",err,error,*999)
917  ENDIF
918  ELSE
919  CALL flagerror("Equations set is not associated.",err,error,*999)
920  ENDIF
921 
922  exits("EQUATIONS_SET_EQUATIONS_GET")
923  RETURN
924 999 errorsexits("EQUATIONS_SET_EQUATIONS_GET",err,error)
925  RETURN 1
926 
927  END SUBROUTINE equations_set_equations_get
928 
929  !
930  !================================================================================================================================
931  !
932 
934  SUBROUTINE equations_derivedvariableget(equations,derivedType,fieldVariable,err,error,*)
936  !Argument variables
937  TYPE(equations_type), POINTER, INTENT(IN) :: equations
938  INTEGER(INTG), INTENT(IN) :: derivedType
939  TYPE(field_variable_type), POINTER, INTENT(INOUT) :: fieldVariable
940  INTEGER(INTG), INTENT(OUT) :: err
941  TYPE(varying_string), INTENT(OUT) :: error
942 
943  !Local variables
944  TYPE(equations_set_type), POINTER :: equationsSet
945  TYPE(field_type), POINTER :: derivedField
946  INTEGER(INTG) :: fieldVariableType
947 
948  enters("Equations_DerivedVariableGet",err,error,*999)
949 
950  NULLIFY(derivedfield)
951 
952  !Check pointers
953  IF(ASSOCIATED(equations)) THEN
954  equationsset=>equations%equations_set
955  IF(ASSOCIATED(equationsset)) THEN
956  IF(.NOT.equationsset%EQUATIONS_SET_FINISHED) THEN
957  CALL flagerror("Equations set has not been finished.",err,error,*999)
958  END IF
959  ELSE
960  CALL flagerror("Equations set is not associated.",err,error,*999)
961  END IF
962  IF(ASSOCIATED(fieldvariable)) THEN
963  CALL flagerror("Derived field variable is already associated.",err,error,*999)
964  END IF
965  ELSE
966  CALL flagerror("Equations are not associated.",err,error,*999)
967  END IF
968 
969  IF(ASSOCIATED(equationsset%derived)) THEN
970  IF(equationsset%derived%derivedFinished) THEN
971  IF(ASSOCIATED(equationsset%derived%derivedField)) THEN
972  IF(derivedtype>0.AND.derivedtype<=equations_set_number_of_derived_types) THEN
973  fieldvariabletype=equationsset%derived%variableTypes(derivedtype)
974  IF(fieldvariabletype/=0) THEN
975  CALL field_variable_get(equationsset%derived%derivedField,fieldvariabletype,fieldvariable,err,error,*999)
976  ELSE
977  CALL flagerror("The field variable type for the derived variable type of "// &
978  & trim(number_to_vstring(derivedtype,"*",err,error))//" has not been set.",err,error,*999)
979  END IF
980  ELSE
981  CALL flagerror("The derived variable type of "//trim(number_to_vstring(derivedtype,"*",err,error))// &
982  & " is invalid. It should be between 1 and "//trim(number_to_vstring(equations_set_number_of_derived_types,"*", &
983  & err,error))//" inclusive.",err,error,*999)
984  END IF
985  ELSE
986  CALL flagerror("Equations set derived field is not associated",err,error,*999)
987  END IF
988  ELSE
989  CALL flagerror("Equations set derived information is not finished",err,error,*999)
990  END IF
991  END IF
992 
993  exits("Equations_DerivedVariableGet")
994  RETURN
995 999 errorsexits("Equations_DerivedVariableGet",err,error)
996  RETURN 1
997  END SUBROUTINE equations_derivedvariableget
998 
999  !
1000  !================================================================================================================================
1001  !
1002 
1004  SUBROUTINE equations_numberoflinearmatricesget(equations,numberOfMatrices,err,error,*)
1006  !Argument variables
1007  TYPE(equations_type), POINTER, INTENT(IN) :: equations
1008  INTEGER(INTG), INTENT(OUT) :: numberOfMatrices
1009  TYPE(varying_string), INTENT(OUT) :: error
1010  INTEGER(INTG), INTENT(OUT) :: err
1011  !Local variables
1012  TYPE(equations_matrices_type), POINTER :: equationsMatrices
1013  TYPE(equations_matrices_linear_type), POINTER :: linearMatrices
1014 
1015  enters("Equations_NumberOfLinearMatricesGet",err,error,*999)
1016 
1017  IF(ASSOCIATED(equations)) THEN
1018  equationsmatrices=>equations%equations_matrices
1019  IF(ASSOCIATED(equationsmatrices)) THEN
1020  linearmatrices=>equationsmatrices%linear_matrices
1021  IF(ASSOCIATED(linearmatrices)) THEN
1022  numberofmatrices=linearmatrices%number_of_linear_matrices
1023  ELSE
1024  numberofmatrices=0
1025  END IF
1026  ELSE
1027  CALL flagerror("The equations matrices are not associated.",err,error,*999)
1028  END IF
1029  ELSE
1030  CALL flagerror("The equations equations are not associated.",err,error,*999)
1031  END IF
1032 
1033  exits("Equations_NumberOfLinearMatricesGet")
1034  RETURN
1035 999 errorsexits("Equations_NumberOfLinearMatricesGet",err,error)
1036  RETURN 1
1037 
1039 
1040  !
1041  !================================================================================================================================
1042  !
1043 
1045  SUBROUTINE equations_numberofjacobianmatricesget(equations,numberOfMatrices,err,error,*)
1047  !Argument variables
1048  TYPE(equations_type), POINTER, INTENT(IN) :: equations
1049  INTEGER(INTG), INTENT(OUT) :: numberOfMatrices
1050  TYPE(varying_string), INTENT(OUT) :: error
1051  INTEGER(INTG), INTENT(OUT) :: err
1052  !Local variables
1053  TYPE(equations_matrices_type), POINTER :: equationsMatrices
1054  TYPE(equations_matrices_nonlinear_type), POINTER :: nonlinearMatrices
1055 
1056  enters("Equations_NumberOfJacobianMatricesGet",err,error,*999)
1057 
1058  IF(ASSOCIATED(equations)) THEN
1059  equationsmatrices=>equations%equations_matrices
1060  IF(ASSOCIATED(equationsmatrices)) THEN
1061  nonlinearmatrices=>equationsmatrices%nonlinear_matrices
1062  IF(ASSOCIATED(nonlinearmatrices)) THEN
1063  numberofmatrices=nonlinearmatrices%number_of_jacobians
1064  ELSE
1065  numberofmatrices=0
1066  END IF
1067  ELSE
1068  CALL flagerror("The equations matrices are not associated.",err,error,*999)
1069  END IF
1070  ELSE
1071  CALL flagerror("The equations are not associated.",err,error,*999)
1072  END IF
1073 
1074  exits("Equations_NumberOfJacobianMatricesGet")
1075  RETURN
1076 999 errorsexits("Equations_NumberOfJacobianMatricesGet",err,error)
1077  RETURN 1
1078 
1080 
1081  !
1082  !================================================================================================================================
1083  !
1084 
1086  SUBROUTINE equations_numberofdynamicmatricesget(equations,numberOfMatrices,err,error,*)
1088  !Argument variables
1089  TYPE(equations_type), POINTER, INTENT(IN) :: equations
1090  INTEGER(INTG), INTENT(OUT) :: numberOfMatrices
1091  TYPE(varying_string), INTENT(OUT) :: error
1092  INTEGER(INTG), INTENT(OUT) :: err
1093  !Local variables
1094  TYPE(equations_matrices_type), POINTER :: equationsMatrices
1095  TYPE(equations_matrices_dynamic_type), POINTER :: dynamicMatrices
1096 
1097  enters("Equations_NumberOfDynamicMatricesGet",err,error,*999)
1098 
1099  IF(ASSOCIATED(equations)) THEN
1100  equationsmatrices=>equations%equations_matrices
1101  IF(ASSOCIATED(equationsmatrices)) THEN
1102  dynamicmatrices=>equationsmatrices%dynamic_matrices
1103  IF(ASSOCIATED(dynamicmatrices)) THEN
1104  numberofmatrices=dynamicmatrices%number_of_dynamic_matrices
1105  ELSE
1106  numberofmatrices=0
1107  END IF
1108  ELSE
1109  CALL flagerror("The equations matrices are not associated.",err,error,*999)
1110  END IF
1111  ELSE
1112  CALL flagerror("The equations are not associated.",err,error,*999)
1113  END IF
1114 
1115  exits("Equations_NumberOfDynamicMatricesGet")
1116  RETURN
1117 999 errorsexits("Equations_NumberOfDynamicMatricesGet",err,error)
1118  RETURN 1
1119 
1121 
1122  !
1123  !================================================================================================================================
1124  !
1125 
1127  SUBROUTINE equations_linearmatrixget(equations,matrixIndex,matrix,err,error,*)
1129  !Argument variables
1130  TYPE(equations_type), POINTER, INTENT(IN) :: equations
1131  INTEGER(INTG), INTENT(IN) :: matrixIndex
1132  TYPE(distributed_matrix_type), POINTER, INTENT(INOUT) :: matrix
1133  TYPE(varying_string), INTENT(OUT) :: error
1134  INTEGER(INTG), INTENT(OUT) :: err
1135  !Local variables
1136  TYPE(equations_matrix_type), POINTER :: equationsMatrix
1137  TYPE(equations_matrices_type), POINTER :: equationsMatrices
1138  TYPE(equations_matrices_linear_type), POINTER :: linearMatrices
1139 
1140  enters("Equations_LinearMatrixGet",err,error,*999)
1141 
1142  IF(ASSOCIATED(equations)) THEN
1143  equationsmatrices=>equations%equations_matrices
1144  IF(ASSOCIATED(equationsmatrices)) THEN
1145  linearmatrices=>equationsmatrices%linear_matrices
1146  IF(ASSOCIATED(linearmatrices)) THEN
1147  IF(matrixindex>0.AND.matrixindex<=linearmatrices%number_of_linear_matrices) THEN
1148  IF(.NOT.ASSOCIATED(matrix)) THEN
1149  equationsmatrix=>linearmatrices%matrices(matrixindex)%ptr
1150  IF(ASSOCIATED(equationsmatrix)) THEN
1151  matrix=>equationsmatrix%matrix
1152  ELSE
1153  CALL flagerror("The equations matrix is not associated.",err,error,*999)
1154  END IF
1155  ELSE
1156  CALL flagerror("The matrix is already associated.",err,error,*999)
1157  END IF
1158  ELSE
1159  CALL flagerror("Invalid matrix index. The matrix index must be greater than zero and less than or equal to "// &
1160  & trim(numbertovstring(linearmatrices%number_of_linear_matrices,"*",err,error))//".",err,error,*999)
1161  END IF
1162  ELSE
1163  CALL flagerror("The equations linear matrices are not associated.",err,error,*999)
1164  END IF
1165  ELSE
1166  CALL flagerror("The equations matrices are not associated.",err,error,*999)
1167  END IF
1168  ELSE
1169  CALL flagerror("The equations are not associated.",err,error,*999)
1170  END IF
1171 
1172  exits("Equations_LinearMatrixGet")
1173  RETURN
1174 999 errorsexits("Equations_LinearMatrixGet",err,error)
1175  RETURN 1
1176 
1177  END SUBROUTINE equations_linearmatrixget
1178 
1179  !
1180  !================================================================================================================================
1181  !
1182 
1184  SUBROUTINE equations_jacobianmatrixget(equations,residualIndex,variableType,matrix,err,error,*)
1186  !Argument variables
1187  TYPE(equations_type), POINTER, INTENT(IN) :: equations
1188  INTEGER(INTG), INTENT(IN) :: residualIndex
1189  INTEGER(INTG), INTENT(IN) :: variableType
1190  TYPE(distributed_matrix_type), POINTER, INTENT(INOUT) :: matrix
1191  TYPE(varying_string), INTENT(OUT) :: error
1192  INTEGER(INTG), INTENT(OUT) :: err
1193  !Local variables
1194  INTEGER(INTG) :: matrixIndex,variableIndex
1195  TYPE(equations_mapping_type), POINTER :: equationsMapping
1196  TYPE(equations_mapping_nonlinear_type), POINTER :: nonlinearMapping
1197  TYPE(equations_jacobian_type), POINTER :: equationsJacobian
1198 
1199  enters("Equations_JacobianMatrixGet",err,error,*999)
1200 
1201  !Check for pointer associations
1202  IF(ASSOCIATED(equations)) THEN
1203  equationsmapping=>equations%equations_mapping
1204  IF(ASSOCIATED(equationsmapping)) THEN
1205  nonlinearmapping=>equationsmapping%nonlinear_mapping
1206  IF(.NOT.ASSOCIATED(nonlinearmapping)) THEN
1207  CALL flagerror("The equations nonlinear mapping is not associated.",err,error,*999)
1208  END IF
1209  ELSE
1210  CALL flagerror("The equations mapping is not associated.",err,error,*999)
1211  END IF
1212  ELSE
1213  CALL flagerror("The equations are not associated.",err,error,*999)
1214  END IF
1215  IF(ASSOCIATED(matrix)) THEN
1216  CALL flagerror("The matrix is already associated.",err,error,*999)
1217  END IF
1218 
1219  IF(residualindex/=1) THEN
1220  CALL flagerror("Multiple residual vectors are not yet implemented.",err,error,*999)
1221  END IF
1222 
1223  !Find Jacobian matrix index using the nonlinear equations mapping
1224  matrixindex=0
1225  DO variableindex=1,nonlinearmapping%number_of_residual_variables
1226  IF(nonlinearmapping%residual_variables(variableindex)%ptr%variable_type==variabletype) THEN
1227  matrixindex=nonlinearmapping%var_to_jacobian_map(variableindex)%jacobian_number
1228  END IF
1229  END DO
1230  IF(matrixindex==0) THEN
1231  CALL flagerror("Equations do not have a Jacobian matrix for residual index "// &
1232  & trim(numbertovstring(residualindex,"*",err,error))//" and variable type "// &
1233  & trim(numbertovstring(variabletype,"*",err,error))//".",err,error,*999)
1234  END IF
1235 
1236  !Now get Jacobian matrix using the matrix index
1237  equationsjacobian=>nonlinearmapping%jacobian_to_var_map(matrixindex)%jacobian
1238  IF(ASSOCIATED(equationsjacobian)) THEN
1239  matrix=>equationsjacobian%jacobian
1240  ELSE
1241  CALL flagerror("The equations Jacobian matrix is not associated.",err,error,*999)
1242  END IF
1243 
1244  exits("Equations_JacobianMatrixGet")
1245  RETURN
1246 999 errorsexits("Equations_JacobianMatrixGet",err,error)
1247  RETURN 1
1248 
1249  END SUBROUTINE equations_jacobianmatrixget
1250 
1251  !
1252  !================================================================================================================================
1253  !
1254 
1256  SUBROUTINE equations_dynamicmatrixget(equations,matrixIndex,matrix,err,error,*)
1258  !Argument variables
1259  TYPE(equations_type), POINTER, INTENT(IN) :: equations
1260  INTEGER(INTG), INTENT(IN) :: matrixIndex
1261  TYPE(distributed_matrix_type), POINTER, INTENT(INOUT) :: matrix
1262  TYPE(varying_string), INTENT(OUT) :: error
1263  INTEGER(INTG), INTENT(OUT) :: err
1264  !Local variables
1265  TYPE(equations_matrix_type), POINTER :: equationsMatrix
1266  TYPE(equations_matrices_type), POINTER :: equationsMatrices
1267  TYPE(equations_matrices_dynamic_type), POINTER :: dynamicMatrices
1268 
1269  enters("Equations_DynamicMatrixGet",err,error,*999)
1270 
1271  IF(ASSOCIATED(equations)) THEN
1272  equationsmatrices=>equations%equations_matrices
1273  IF(ASSOCIATED(equationsmatrices)) THEN
1274  dynamicmatrices=>equationsmatrices%dynamic_matrices
1275  IF(ASSOCIATED(dynamicmatrices)) THEN
1276  IF(matrixindex>0.AND.matrixindex<=dynamicmatrices%number_of_dynamic_matrices) THEN
1277  IF(.NOT.ASSOCIATED(matrix)) THEN
1278  equationsmatrix=>dynamicmatrices%matrices(matrixindex)%ptr
1279  IF(ASSOCIATED(equationsmatrix)) THEN
1280  matrix=>equationsmatrix%matrix
1281  ELSE
1282  CALL flagerror("The equations matrix is not associated.",err,error,*999)
1283  END IF
1284  ELSE
1285  CALL flagerror("The matrix is already associated.",err,error,*999)
1286  END IF
1287  ELSE
1288  CALL flagerror("Invalid matrix index. The matrix index must be greater than zero and less than or equal to "// &
1289  & trim(numbertovstring(dynamicmatrices%number_of_dynamic_matrices,"*",err,error))//".",err,error,*999)
1290  END IF
1291  ELSE
1292  CALL flagerror("The equations dynamic matrices are not associated.",err,error,*999)
1293  END IF
1294  ELSE
1295  CALL flagerror("The equations matrices are not associated.",err,error,*999)
1296  END IF
1297  ELSE
1298  CALL flagerror("The equations are not associated.",err,error,*999)
1299  END IF
1300 
1301  exits("Equations_DynamicMatrixGet")
1302  RETURN
1303 999 errorsexits("Equations_DynamicMatrixGet",err,error)
1304  RETURN 1
1305 
1306  END SUBROUTINE equations_dynamicmatrixget
1307 
1308  !
1309  !================================================================================================================================
1310  !
1311 
1313  SUBROUTINE equations_dynamicmatrixgetbytype(equations,matrixType,matrix,err,error,*)
1315  !Argument variables
1316  TYPE(equations_type), POINTER, INTENT(IN) :: equations
1317  INTEGER(INTG), INTENT(IN) :: matrixType
1318  TYPE(distributed_matrix_type), POINTER, INTENT(INOUT) :: matrix
1319  TYPE(varying_string), INTENT(OUT) :: error
1320  INTEGER(INTG), INTENT(OUT) :: err
1321  !Local variables
1322  INTEGER(INTG) :: matrixIndex
1323  TYPE(equations_matrix_type), POINTER :: equationsMatrix
1324  TYPE(equations_matrices_type), POINTER :: equationsMatrices
1325  TYPE(equations_matrices_dynamic_type), POINTER :: dynamicMatrices
1326  TYPE(equations_mapping_type), POINTER :: equationsMapping
1327  TYPE(equations_mapping_dynamic_type), POINTER :: dynamicMapping
1328 
1329  enters("Equations_DynamicMatrixGetByType",err,error,*999)
1330 
1331  !Check all pointer associations
1332  IF(ASSOCIATED(equations)) THEN
1333  equationsmatrices=>equations%equations_matrices
1334  IF(ASSOCIATED(equationsmatrices)) THEN
1335  dynamicmatrices=>equationsmatrices%dynamic_matrices
1336  IF(.NOT.ASSOCIATED(dynamicmatrices)) THEN
1337  CALL flagerror("The equations dynamic matrices are not associated.",err,error,*999)
1338  END IF
1339  ELSE
1340  CALL flagerror("The equations matrices are not associated.",err,error,*999)
1341  END IF
1342  equationsmapping=>equations%equations_mapping
1343  IF(ASSOCIATED(equationsmapping)) THEN
1344  dynamicmapping=>equationsmapping%DYNAMIC_MAPPING
1345  IF(.NOT.ASSOCIATED(dynamicmapping)) THEN
1346  CALL flagerror("The equations dynamic mapping is not associated.",err,error,*999)
1347  END IF
1348  ELSE
1349  CALL flagerror("The equations mapping is not associated.",err,error,*999)
1350  END IF
1351  ELSE
1352  CALL flagerror("The equations are not associated.",err,error,*999)
1353  END IF
1354  IF(ASSOCIATED(matrix)) THEN
1355  CALL flagerror("The matrix is already associated.",err,error,*999)
1356  END IF
1357 
1358  !Now get the dynamic matrix
1359  !Find matrix index using the equations mapping
1360  SELECT CASE(matrixtype)
1362  matrixindex=dynamicmapping%stiffness_matrix_number
1364  matrixindex=dynamicmapping%damping_matrix_number
1365  CASE(equations_matrix_mass)
1366  matrixindex=dynamicmapping%mass_matrix_number
1367  CASE DEFAULT
1368  CALL flagerror("Invalid dynamic matrix type "//trim(numbertovstring(matrixtype,"*",err,error))// &
1369  & " specified.",err,error,*999)
1370  END SELECT
1371  IF(matrixindex==0) THEN
1372  CALL flagerror("The equations dynamic matrices do not have a matrix with the specified type of "// &
1373  & trim(numbertovstring(matrixtype,"*",err,error))//".",err,error,*999)
1374  ELSE
1375  equationsmatrix=>dynamicmatrices%matrices(matrixindex)%ptr
1376  IF(ASSOCIATED(equationsmatrix)) THEN
1377  matrix=>equationsmatrix%matrix
1378  ELSE
1379  CALL flagerror("The equations dynamic matrix for index "// &
1380  & trim(numbertovstring(matrixindex,"*",err,error))//" is not associated.",err,error,*999)
1381  END IF
1382  END IF
1383 
1384  exits("Equations_DynamicMatrixGetByType")
1385  RETURN
1386 999 errorsexits("Equations_DynamicMatrixGetByType",err,error)
1387  RETURN 1
1388 
1389  END SUBROUTINE equations_dynamicmatrixgetbytype
1390 
1391  !
1392  !================================================================================================================================
1393  !
1394 
1396  SUBROUTINE equations_dynamicmatrixtypeget(equations,matrixIndex,matrixType,err,error,*)
1398  !Argument variables
1399  TYPE(equations_type), POINTER, INTENT(IN) :: equations
1400  INTEGER(INTG), INTENT(IN) :: matrixIndex
1401  INTEGER(INTG), INTENT(INOUT) :: matrixType
1402  TYPE(varying_string), INTENT(OUT) :: error
1403  INTEGER(INTG), INTENT(OUT) :: err
1404  !Local variables
1405  TYPE(equations_mapping_type), POINTER :: equationsMapping
1406  TYPE(equations_mapping_dynamic_type), POINTER :: dynamicMapping
1407 
1408  enters("Equations_DynamicMatrixTypeGet",err,error,*999)
1409 
1410  IF(ASSOCIATED(equations)) THEN
1411  equationsmapping=>equations%equations_mapping
1412  IF(ASSOCIATED(equationsmapping)) THEN
1413  dynamicmapping=>equationsmapping%DYNAMIC_MAPPING
1414  IF(ASSOCIATED(dynamicmapping)) THEN
1415  IF(matrixindex>0.AND.matrixindex<=dynamicmapping%number_of_dynamic_equations_matrices) THEN
1416  IF(matrixindex==dynamicmapping%stiffness_matrix_number) THEN
1417  matrixtype=equations_matrix_stiffness
1418  ELSE IF(matrixindex==dynamicmapping%damping_matrix_number) THEN
1419  matrixtype=equations_matrix_damping
1420  ELSE IF(matrixindex==dynamicmapping%mass_matrix_number) THEN
1421  matrixtype=equations_matrix_mass
1422  ELSE
1423  CALL flagerror("Could not find dynamic matrix type.",err,error,*999)
1424  END IF
1425  ELSE
1426  CALL flagerror("Invalid matrix index. The matrix index must be greater than zero and less than or equal to "// &
1427  & trim(numbertovstring(dynamicmapping%number_of_dynamic_equations_matrices,"*",err,error))//".",err,error,*999)
1428  END IF
1429  ELSE
1430  CALL flagerror("The equations dynamic mapping is not associated.",err,error,*999)
1431  END IF
1432  ELSE
1433  CALL flagerror("The equations mapping is not associated.",err,error,*999)
1434  END IF
1435  ELSE
1436  CALL flagerror("The equations are not associated.",err,error,*999)
1437  END IF
1438 
1439  exits("Equations_DynamicMatrixTypeGet")
1440  RETURN
1441 999 errorsexits("Equations_DynamicMatrixTypeGet",err,error)
1442  RETURN 1
1443 
1444  END SUBROUTINE equations_dynamicmatrixtypeget
1445 
1446  !
1447  !================================================================================================================================
1448  !
1449 
1451  SUBROUTINE equations_rhsvectorget(equations,vector,err,error,*)
1453  !Argument variables
1454  TYPE(equations_type), POINTER, INTENT(IN) :: equations
1455  TYPE(distributed_vector_type), POINTER, INTENT(INOUT) :: vector
1456  TYPE(varying_string), INTENT(OUT) :: error
1457  INTEGER(INTG), INTENT(OUT) :: err
1458  !Local variables
1459  TYPE(equations_matrices_rhs_type), POINTER :: rhsVector
1460  TYPE(equations_matrices_type), POINTER :: equationsMatrices
1461 
1462  enters("Equations_RhsVectorGet",err,error,*999)
1463 
1464  IF(ASSOCIATED(equations)) THEN
1465  equationsmatrices=>equations%equations_matrices
1466  IF(ASSOCIATED(equationsmatrices)) THEN
1467  rhsvector=>equationsmatrices%rhs_vector
1468  IF(ASSOCIATED(rhsvector)) THEN
1469  IF(.NOT.ASSOCIATED(vector)) THEN
1470  vector=>rhsvector%vector
1471  ELSE
1472  CALL flagerror("The vector is already associated.",err,error,*999)
1473  END IF
1474  ELSE
1475  CALL flagerror("The equations matrices right hand side vector is not associated.",err,error,*999)
1476  END IF
1477  ELSE
1478  CALL flagerror("The equations matrices are not associated.",err,error,*999)
1479  END IF
1480  ELSE
1481  CALL flagerror("The equations are not associated.",err,error,*999)
1482  END IF
1483 
1484  exits("Equations_RhsVectorGet")
1485  RETURN
1486 999 errorsexits("Equations_RhsVectorGet",err,error)
1487  RETURN 1
1488 
1489  END SUBROUTINE equations_rhsvectorget
1490 
1491  !
1492  !================================================================================================================================
1493  !
1494 
1496  SUBROUTINE equations_residualvectorget(equations,residualIndex,vector,err,error,*)
1498  !Argument variables
1499  TYPE(equations_type), POINTER, INTENT(IN) :: equations
1500  INTEGER(INTG), INTENT(IN) :: residualIndex
1501  TYPE(distributed_vector_type), POINTER, INTENT(INOUT) :: vector
1502  TYPE(varying_string), INTENT(OUT) :: error
1503  INTEGER(INTG), INTENT(OUT) :: err
1504  !Local variables
1505  TYPE(equations_matrices_nonlinear_type), POINTER :: nonlinearMatrices
1506  TYPE(equations_matrices_type), POINTER :: equationsMatrices
1507 
1508  enters("Equations_ResidualVectorGet",err,error,*999)
1509 
1510  IF(ASSOCIATED(equations)) THEN
1511  equationsmatrices=>equations%equations_matrices
1512  IF(ASSOCIATED(equationsmatrices)) THEN
1513  nonlinearmatrices=>equationsmatrices%nonlinear_matrices
1514  IF(ASSOCIATED(nonlinearmatrices)) THEN
1515  IF(.NOT.ASSOCIATED(vector)) THEN
1516  IF(residualindex==1) THEN
1517  vector=>nonlinearmatrices%residual
1518  ELSE
1519  CALL flagerror("Multiple residual vectors are not yet implemented.",err,error,*999)
1520  END IF
1521  ELSE
1522  CALL flagerror("The vector is already associated.",err,error,*999)
1523  END IF
1524  ELSE
1525  CALL flagerror("The equations matrices nonlinear matrices are not associated.",err,error,*999)
1526  END IF
1527  ELSE
1528  CALL flagerror("The equations matrices are not associated.",err,error,*999)
1529  END IF
1530  ELSE
1531  CALL flagerror("The equations are not associated.",err,error,*999)
1532  END IF
1533 
1534  exits("Equations_ResidualVectorGet")
1535  RETURN
1536 999 errorsexits("Equations_ResidualVectorGet",err,error)
1537  RETURN 1
1538 
1539  END SUBROUTINE equations_residualvectorget
1540 
1541  !
1542  !================================================================================================================================
1543  !
1544 
1546  SUBROUTINE equations_residualnumberofvariablesget(equations,residualIndex,numberOfVariables,err,error,*)
1548  !Argument variables
1549  TYPE(equations_type), POINTER, INTENT(IN) :: equations
1550  INTEGER(INTG), INTENT(IN) :: residualIndex
1551  INTEGER(INTG), INTENT(OUT) :: numberOfVariables
1552  TYPE(varying_string), INTENT(OUT) :: error
1553  INTEGER(INTG), INTENT(OUT) :: err
1554  !Local variables
1555  TYPE(equations_mapping_type), POINTER :: equationsMapping
1556  TYPE(equations_mapping_nonlinear_type), POINTER :: nonlinearMapping
1557 
1558  enters("Equations_ResidualNumberOfVariablesGet",err,error,*999)
1559 
1560  !Check for pointer associations
1561  IF(ASSOCIATED(equations)) THEN
1562  equationsmapping=>equations%equations_mapping
1563  IF(ASSOCIATED(equationsmapping)) THEN
1564  nonlinearmapping=>equationsmapping%nonlinear_mapping
1565  IF(.NOT.ASSOCIATED(nonlinearmapping)) THEN
1566  CALL flagerror("The equations nonlinear mapping is not associated.",err,error,*999)
1567  END IF
1568  ELSE
1569  CALL flagerror("The equations mapping is not associated.",err,error,*999)
1570  END IF
1571  ELSE
1572  CALL flagerror("The equations are not associated.",err,error,*999)
1573  END IF
1574 
1575  IF(residualindex==1) THEN
1576  numberofvariables=nonlinearmapping%number_of_residual_variables
1577  ELSE
1578  CALL flagerror("Multiple residual vectors are not yet implemented.",err,error,*999)
1579  END IF
1580 
1581  exits("Equations_ResidualNumberOfVariablesGet")
1582  RETURN
1583 999 errorsexits("Equations_ResidualNumberOfVariablesGet",err,error)
1584  RETURN 1
1585 
1587 
1588  !
1589  !================================================================================================================================
1590  !
1591 
1593  SUBROUTINE equations_residualvariablesget(equations,residualIndex,residualVariables,err,error,*)
1595  !Argument variables
1596  TYPE(equations_type), POINTER, INTENT(IN) :: equations
1597  INTEGER(INTG), INTENT(IN) :: residualIndex
1598  INTEGER(INTG), INTENT(OUT) :: residualVariables(:)
1599  TYPE(varying_string), INTENT(OUT) :: error
1600  INTEGER(INTG), INTENT(OUT) :: err
1601  !Local variables
1602  INTEGER(INTG) :: numberOfVariables,variableIdx
1603  TYPE(equations_mapping_type), POINTER :: equationsMapping
1604  TYPE(equations_mapping_nonlinear_type), POINTER :: nonlinearMapping
1605 
1606  enters("Equations_ResidualVariablesGet",err,error,*999)
1607 
1608  !Check for pointer associations
1609  IF(ASSOCIATED(equations)) THEN
1610  equationsmapping=>equations%equations_mapping
1611  IF(ASSOCIATED(equationsmapping)) THEN
1612  nonlinearmapping=>equationsmapping%nonlinear_mapping
1613  IF(.NOT.ASSOCIATED(nonlinearmapping)) THEN
1614  CALL flagerror("The equations nonlinear mapping is not associated.",err,error,*999)
1615  END IF
1616  ELSE
1617  CALL flagerror("The equations mapping is not associated.",err,error,*999)
1618  END IF
1619  ELSE
1620  CALL flagerror("The equations are not associated.",err,error,*999)
1621  END IF
1622 
1623  IF(residualindex==1) THEN
1624  numberofvariables=nonlinearmapping%number_of_residual_variables
1625  IF(SIZE(residualvariables,1)>=numberofvariables) THEN
1626  DO variableidx=1,numberofvariables
1627  residualvariables(variableidx)=nonlinearmapping%residual_variables(variableidx)%ptr%variable_type
1628  END DO
1629  ELSE
1630  CALL flagerror("residualVariables array must have size of at least "// &
1631  & trim(numbertovstring(numberofvariables,"*",err,error))//".",err,error,*999)
1632  END IF
1633  ELSE
1634  CALL flagerror("Multiple residual vectors are not yet implemented.",err,error,*999)
1635  END IF
1636 
1637  exits("Equations_ResidualVariablesGet")
1638  RETURN
1639 999 errorsexits("Equations_ResidualVariablesGet",err,error)
1640  RETURN 1
1641 
1642  END SUBROUTINE equations_residualvariablesget
1643 
1644  !
1645  !================================================================================================================================
1646  !
1647 
1649  SUBROUTINE equations_sourcevectorget(equations,vector,err,error,*)
1651  !Argument variables
1652  TYPE(equations_type), POINTER, INTENT(IN) :: equations
1653  TYPE(distributed_vector_type), POINTER, INTENT(INOUT) :: vector
1654  TYPE(varying_string), INTENT(OUT) :: error
1655  INTEGER(INTG), INTENT(OUT) :: err
1656  !Local variables
1657  TYPE(equations_matrices_source_type), POINTER :: matricesSource
1658  TYPE(equations_matrices_type), POINTER :: equationsMatrices
1659 
1660  enters("Equations_SourceVectorGet",err,error,*999)
1661 
1662  IF(ASSOCIATED(equations)) THEN
1663  equationsmatrices=>equations%equations_matrices
1664  IF(ASSOCIATED(equationsmatrices)) THEN
1665  matricessource=>equationsmatrices%source_vector
1666  IF(ASSOCIATED(matricessource)) THEN
1667  IF(.NOT.ASSOCIATED(vector)) THEN
1668  vector=>matricessource%vector
1669  ELSE
1670  CALL flagerror("The vector is already associated.",err,error,*999)
1671  END IF
1672  ELSE
1673  CALL flagerror("The equations matrices source vector is not associated.",err,error,*999)
1674  END IF
1675  ELSE
1676  CALL flagerror("The equations matrices are not associated.",err,error,*999)
1677  END IF
1678  ELSE
1679  CALL flagerror("The equations are not associated.",err,error,*999)
1680  END IF
1681 
1682  exits("Equations_SourceVectorGet")
1683  RETURN
1684 999 errorsexits("Equations_SourceVectorGet",err,error)
1685  RETURN 1
1686 
1687  END SUBROUTINE equations_sourcevectorget
1688 
1689  !
1690  !================================================================================================================================
1691  !
1692 
1693 END MODULE equations_routines
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Contains information on the Jacobian matrix for nonlinear problems.
Definition: types.f90:1451
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, public equations_full_matrices
Use fully populated matrices for the equations.
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.
subroutine, public equations_destroy(EQUATIONS, ERR, ERROR,)
Destroys equations.
subroutine equations_interpolation_initialise(EQUATIONS, ERR, ERROR,)
Initialises the interpolation information for equations.
This module handles all equations matrix and rhs routines.
subroutine, public equations_finalise(EQUATIONS, ERR, ERROR,)
Finalise the equations and deallocate all memory.
subroutine, public equations_initialise(EQUATIONS_SET, ERR, ERROR,)
Initialises the equations for an equations set.
subroutine, public equations_sparsity_type_get(EQUATIONS, SPARSITY_TYPE, ERR, ERROR,)
Gets the sparsity type for equations.
integer(intg), parameter equations_static
The equations are static and have no time dependence.
Contains information on an equations set.
Definition: types.f90:1941
subroutine, public equations_sourcevectorget(equations, vector, err, error,)
Get the source vector for equations.
This module handles all equations routines.
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
subroutine, public equations_derivedvariableget(equations, derivedType, fieldVariable, err, error,)
Gets the field variable for the derived variable type.
Contains information of the source vector for equations matrices.
Definition: types.f90:1510
subroutine, public equations_time_dependence_type_set(EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for equations.
integer(intg), parameter, public equations_timing_output
Timing information output.
Contains information for a field defined on a region.
Definition: types.f90:1346
integer(intg), parameter, public equations_sparse_matrices
Use sparse matrices for the equations.
subroutine, public equations_numberoflinearmatricesget(equations, numberOfMatrices, err, error,)
Get the number of linear matrices in the equations.
subroutine, public equations_linearmatrixget(equations, matrixIndex, matrix, err, error,)
Get a linear equations matrix from equations.
subroutine, public equations_residualnumberofvariablesget(equations, residualIndex, numberOfVariables, err, error,)
Get the number of field variables that contribute to the residual vector.
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
subroutine, public equations_lumping_type_get(EQUATIONS, LUMPING_TYPE, ERR, ERROR,)
Gets the lumping type for equations.
integer(intg), parameter, public equations_matrix_output
All below and equation matrices output.
Contains information for mapping field variables to the dynamic matrices in the equations set of the ...
Definition: types.f90:1571
integer(intg), parameter, public equations_element_matrix_output
All below and element matrices output.
integer(intg), parameter equations_set_number_of_derived_types
integer(intg), parameter, public equations_lumped_matrices
The equations matrices are "mass" lumped.
subroutine, public equations_dynamicmatrixgetbytype(equations, matrixType, matrix, err, error,)
Get a dynamic equations matrix from equations using the dynamic matrix type.
subroutine, public equations_output_type_get(EQUATIONS, OUTPUT_TYPE, ERR, ERROR,)
Gets the output type for equations.
integer(intg), parameter equations_second_order_dynamic
The equations are a second order dynamic.
integer(intg), parameter equations_first_order_dynamic
The equations are first order dynamic.
Contains information on the interpolation for the equations.
Definition: types.f90:1707
subroutine, public exits(NAME)
Records the exit out of the named procedure.
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
Contains information on the equations mapping for nonlinear matrices i.e., how a field variable is ma...
Definition: types.f90:1623
Contains information on the equations matrices and vectors.
Definition: types.f90:1520
subroutine, public equations_linearity_type_get(EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Gets the linearity type for equations.
subroutine, public equations_dynamicmatrixget(equations, matrixIndex, matrix, err, error,)
Get a dynamic equations matrix from equations using the dynamic matrix index.
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
Contains information of the linear matrices for equations matrices.
Definition: types.f90:1479
integer(intg), parameter equations_matrix_stiffness
A stiffness matrix (multiplies displacement values)
subroutine, public equations_mapping_destroy(EQUATIONS_MAPPING, ERR, ERROR,)
Destroy an equations mapping.
subroutine, public equations_output_type_set(EQUATIONS, OUTPUT_TYPE, ERR, ERROR,)
Sets/changes the output type for the equations.
integer(intg), parameter, public equations_unlumped_matrices
The equations matrices are not lumped.
subroutine, public equations_set_equations_get(EQUATIONS_SET, EQUATIONS, ERR, ERROR,)
Gets the equations for an equations set.
subroutine, public equations_rhsvectorget(equations, vector, err, error,)
Get the right hand side vector for equations.
subroutine, public equations_create_finish(EQUATIONS, ERR, ERROR,)
Finish the creation of equations.
This module handles all equations mapping routines.
integer(intg), parameter equations_matrix_mass
A mass matrix (multiplies acceleration values)
subroutine, public equations_time_dependence_type_get(EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Gets the time dependence type for equations.
subroutine, public equations_lumping_type_set(EQUATIONS, LUMPING_TYPE, ERR, ERROR,)
Sets/changes the matrix lumping for the equations.
integer(intg), parameter equations_linear
The equations are linear.
Contains the information for a vector that is distributed across a number of domains.
Definition: types.f90:786
subroutine, public equations_dynamicmatrixtypeget(equations, matrixIndex, matrixType, err, error,)
Get the type of a dynamic matrix, eg. stiffness, damping or mass.
integer(intg), parameter, public equations_nodal_matrix_output
All below and nodal matrices output.
Contains information about an equations matrix.
Definition: types.f90:1429
integer(intg), parameter equations_matrix_damping
A damping matrix (multiplies velocity values)
subroutine, public equations_linearity_type_set(EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for equations.
subroutine, public equations_jacobianmatrixget(equations, residualIndex, variableType, matrix, err, error,)
Get a Jacobian matrix from equations.
integer(intg), parameter, public equations_no_output
No output.
subroutine equations_interpolation_finalise(EQUATIONS_INTERPOLATION, ERR, ERROR,)
Finalises the interpolation information for equations and deallocates all memory. ...
Contains information for a field variable defined on a field.
Definition: types.f90:1289
integer(intg), parameter equations_nonlinear_bcs
The equations have non-linear boundary conditions.
subroutine, public equations_numberofjacobianmatricesget(equations, numberOfMatrices, err, error,)
Get the number of Jacobian matrices in the equations.
Contains information of the nolinear matrices and vectors for equations matrices. ...
Definition: types.f90:1486
This module defines all constants shared across equations set routines.
Contains the information for a matrix that is distributed across a number of domains.
Definition: types.f90:828
subroutine, public equations_matrices_destroy(EQUATIONS_MATRICES, ERR, ERROR,)
Destroy the equations matrices.
subroutine, public equations_numberofdynamicmatricesget(equations, numberOfMatrices, err, error,)
Get the number of dynamic matrices in the equations.
integer(intg), parameter equations_quasistatic
The equations are quasi-static.
Flags an error condition.
Contains information of the RHS vector for equations matrices.
Definition: types.f90:1500
integer(intg), parameter equations_nonlinear
The equations are non-linear.
subroutine, public equations_sparsity_type_set(EQUATIONS, SPARSITY_TYPE, ERR, ERROR,)
Sets/changes the sparsity type for the equations.
subroutine, public equations_residualvectorget(equations, residualIndex, vector, err, error,)
Get a residual vector for nonlinear equations.
subroutine, public equations_residualvariablesget(equations, residualIndex, residualVariables, err, error,)
Get the field variables that contribute to the residual vector.
This module contains all kind definitions.
Definition: kinds.f90:45
Contains information of the dynamic matrices for equations matrices.
Definition: types.f90:1471