OpenCMISS-Iron Internal API Documentation
solver_routines.f90
Go to the documentation of this file.
1 
43 
45 MODULE solver_routines
46 
47  USE base_routines
48  USE boundary_conditions_routines
49 #ifdef WITH_CELLML
50  USE cellml_model_definition
51 #endif
52  USE cmiss_cellml
53  USE cmisspetsc
54  USE cmisspetsctypes
55  USE comp_environment
56  USE constants
57  USE distributed_matrix_vector
58  USE equations_set_constants
59  USE field_routines
60  USE kinds
61  USE input_output
62  USE interface_conditions_constants
63  USE interface_matrices_constants
64  USE iso_varying_string
65  USE maths
66  USE problem_constants
67  USE solver_mapping_routines
68  USE solver_matrices_routines
69  USE strings
70  USE timer
71  USE types
72 
73 #include "macros.h"
74 
75  IMPLICIT NONE
76 
77  PRIVATE
78 
79 #include "petscversion.h"
80 
81  !Module parameters
82 
87  INTEGER(INTG), PARAMETER :: solver_number_of_solver_types=9
88  INTEGER(INTG), PARAMETER :: solver_linear_type=1
89  INTEGER(INTG), PARAMETER :: solver_nonlinear_type=2
90  INTEGER(INTG), PARAMETER :: solver_dynamic_type=3
91  INTEGER(INTG), PARAMETER :: solver_dae_type=4
92  INTEGER(INTG), PARAMETER :: solver_eigenproblem_type=5
93  INTEGER(INTG), PARAMETER :: solver_optimiser_type=6
94  INTEGER(INTG), PARAMETER :: solver_cellml_evaluator_type=7
95  INTEGER(INTG), PARAMETER :: solver_state_iteration_type=8
96  INTEGER(INTG), PARAMETER :: solver_geometric_transformation_type=9
98 
103  INTEGER(INTG), PARAMETER :: solver_cmiss_library=library_cmiss_type
104  INTEGER(INTG), PARAMETER :: solver_petsc_library=library_petsc_type
105  INTEGER(INTG), PARAMETER :: solver_mumps_library=library_mumps_type
106  INTEGER(INTG), PARAMETER :: solver_superlu_library=library_superlu_type
107  INTEGER(INTG), PARAMETER :: solver_spooles_library=library_spooles_type
108  INTEGER(INTG), PARAMETER :: solver_umfpack_library=library_umfpack_type
109  INTEGER(INTG), PARAMETER :: solver_lusol_library=library_lusol_type
110  INTEGER(INTG), PARAMETER :: solver_essl_library=library_essl_type
111  INTEGER(INTG), PARAMETER :: solver_lapack_library=library_lapack_type
112  INTEGER(INTG), PARAMETER :: solver_tao_library=library_tao_type
113  INTEGER(INTG), PARAMETER :: solver_hypre_library=library_hypre_type
114  INTEGER(INTG), PARAMETER :: solver_pastix_library=library_pastix_type
116 
121  INTEGER(INTG), PARAMETER :: solver_linear_direct_solve_type=1
122  INTEGER(INTG), PARAMETER :: solver_linear_iterative_solve_type=2
124 
129  INTEGER(INTG), PARAMETER :: solver_direct_lu=1
130  INTEGER(INTG), PARAMETER :: solver_direct_cholesky=2
131  INTEGER(INTG), PARAMETER :: solver_direct_svd=3
133 
138  INTEGER(INTG), PARAMETER :: solver_iterative_richardson=1
139  INTEGER(INTG), PARAMETER :: solver_iterative_chebyshev=2
140  INTEGER(INTG), PARAMETER :: solver_iterative_conjugate_gradient=3
141  INTEGER(INTG), PARAMETER :: solver_iterative_biconjugate_gradient=4
142  INTEGER(INTG), PARAMETER :: solver_iterative_gmres=5
143  INTEGER(INTG), PARAMETER :: solver_iterative_bicgstab=6
144  INTEGER(INTG), PARAMETER :: solver_iterative_conjgrad_squared=7
146 
151  INTEGER(INTG), PARAMETER :: solver_iterative_no_preconditioner=0
152  INTEGER(INTG), PARAMETER :: solver_iterative_jacobi_preconditioner=1
153  INTEGER(INTG), PARAMETER :: solver_iterative_block_jacobi_preconditioner=2
154  INTEGER(INTG), PARAMETER :: solver_iterative_sor_preconditioner=3
155  INTEGER(INTG), PARAMETER :: solver_iterative_incomplete_cholesky_preconditioner=4
156  INTEGER(INTG), PARAMETER :: solver_iterative_incomplete_lu_preconditioner=5
157  INTEGER(INTG), PARAMETER :: solver_iterative_additive_schwarz_preconditioner=6
159 
164  INTEGER(INTG), PARAMETER :: solver_nonlinear_newton=1
165  INTEGER(INTG), PARAMETER :: solver_nonlinear_bfgs_inverse=2
166  INTEGER(INTG), PARAMETER :: solver_nonlinear_sqp=3
167  INTEGER(INTG), PARAMETER :: solver_nonlinear_quasi_newton=4
169 
174  INTEGER(INTG), PARAMETER :: solver_quasi_newton_linesearch=1
175  INTEGER(INTG), PARAMETER :: solver_quasi_newton_trustregion=2
177 
182  INTEGER(INTG), PARAMETER :: solver_quasi_newton_lbfgs=1
183  INTEGER(INTG), PARAMETER :: solver_quasi_newton_goodbroyden=2
184  INTEGER(INTG), PARAMETER :: solver_quasi_newton_badbroyden=3
186 
191  INTEGER(INTG), PARAMETER :: solver_quasi_newton_linesearch_basic=1
192  INTEGER(INTG), PARAMETER :: solver_quasi_newton_linesearch_l2=2
193  INTEGER(INTG), PARAMETER :: solver_quasi_newton_linesearch_cp=3
195 
200  INTEGER(INTG), PARAMETER :: solver_quasi_newton_restart_none=1
201  INTEGER(INTG), PARAMETER :: solver_quasi_newton_restart_powell=2
202  INTEGER(INTG), PARAMETER :: solver_quasi_newton_restart_periodic=3
204 
209  INTEGER(INTG), PARAMETER :: solver_quasi_newton_scale_none=1
210  INTEGER(INTG), PARAMETER :: solver_quasi_newton_scale_shanno=2
211  INTEGER(INTG), PARAMETER :: solver_quasi_newton_scale_linesearch=3
212  INTEGER(INTG), PARAMETER :: solver_quasi_newton_scale_jacobian=4
214 
219  INTEGER(INTG), PARAMETER :: solver_newton_linesearch=1
220  INTEGER(INTG), PARAMETER :: solver_newton_trustregion=2
222 
227  INTEGER(INTG), PARAMETER :: solver_newton_linesearch_nonorms=1
228  INTEGER(INTG), PARAMETER :: solver_newton_linesearch_linear=2
229  INTEGER(INTG), PARAMETER :: solver_newton_linesearch_quadratic=3
230  INTEGER(INTG), PARAMETER :: solver_newton_linesearch_cubic=4
232 
237  INTEGER(INTG), PARAMETER :: solver_newton_jacobian_not_calculated=1
238  INTEGER(INTG), PARAMETER :: solver_newton_jacobian_equations_calculated=2
239  INTEGER(INTG), PARAMETER :: solver_newton_jacobian_fd_calculated=3
241 
246  INTEGER(INTG), PARAMETER :: solver_newton_convergence_petsc_default=1
247  INTEGER(INTG), PARAMETER :: solver_newton_convergence_energy_norm=2
248  INTEGER(INTG), PARAMETER :: solver_newton_convergence_differentiated_ratio=3
250 
255  INTEGER(INTG), PARAMETER :: solver_dynamic_first_order=1
256  INTEGER(INTG), PARAMETER :: solver_dynamic_second_order=2
258 
263  INTEGER(INTG), PARAMETER :: solver_dynamic_linear=1
264  INTEGER(INTG), PARAMETER :: solver_dynamic_nonlinear=2
266 
271  INTEGER(INTG), PARAMETER :: solver_dynamic_first_degree=1
272  INTEGER(INTG), PARAMETER :: solver_dynamic_second_degree=2
273  INTEGER(INTG), PARAMETER :: solver_dynamic_third_degree=3
275 
280  INTEGER(INTG), PARAMETER :: solver_dynamic_euler_scheme=1
281  INTEGER(INTG), PARAMETER :: solver_dynamic_backward_euler_scheme=2
282  INTEGER(INTG), PARAMETER :: solver_dynamic_crank_nicolson_scheme=3
283  INTEGER(INTG), PARAMETER :: solver_dynamic_galerkin_scheme=4
284  INTEGER(INTG), PARAMETER :: solver_dynamic_zlamal_scheme=5
285  INTEGER(INTG), PARAMETER :: solver_dynamic_second_degree_gear_scheme=6
286  INTEGER(INTG), PARAMETER :: solver_dynamic_second_degree_liniger1_scheme=7
287  INTEGER(INTG), PARAMETER :: solver_dynamic_second_degree_liniger2_scheme=8
288  INTEGER(INTG), PARAMETER :: solver_dynamic_newmark1_scheme=9
289  INTEGER(INTG), PARAMETER :: solver_dynamic_newmark2_scheme=10
290  INTEGER(INTG), PARAMETER :: solver_dynamic_newmark3_scheme=11
291  INTEGER(INTG), PARAMETER :: solver_dynamic_third_degree_gear_scheme=12
292  INTEGER(INTG), PARAMETER :: solver_dynamic_third_degree_liniger1_scheme=13
293  INTEGER(INTG), PARAMETER :: solver_dynamic_third_degree_liniger2_scheme=14
294  INTEGER(INTG), PARAMETER :: solver_dynamic_houbolt_scheme=15
295  INTEGER(INTG), PARAMETER :: solver_dynamic_wilson_scheme=16
296  INTEGER(INTG), PARAMETER :: solver_dynamic_bossak_newmark1_scheme=17
297  INTEGER(INTG), PARAMETER :: solver_dynamic_bossak_newmark2_scheme=18
298  INTEGER(INTG), PARAMETER :: solver_dynamic_hilbert_hughes_taylor1_scheme=19
299  INTEGER(INTG), PARAMETER :: solver_dynamic_hilbert_hughes_taylor2_scheme=20
300  INTEGER(INTG), PARAMETER :: solver_dynamic_user_defined_scheme=21
302 
307  INTEGER(INTG), PARAMETER :: solver_dae_differential_only=0
308  INTEGER(INTG), PARAMETER :: solver_dae_index_1=1
309  INTEGER(INTG), PARAMETER :: solver_dae_index_2=2
310  INTEGER(INTG), PARAMETER :: solver_dae_index_3=3
312 
317  INTEGER(INTG), PARAMETER :: solver_dae_euler=1
318  INTEGER(INTG), PARAMETER :: solver_dae_crank_nicolson=2
319  INTEGER(INTG), PARAMETER :: solver_dae_runge_kutta=3
320  INTEGER(INTG), PARAMETER :: solver_dae_adams_moulton=4
321  INTEGER(INTG), PARAMETER :: solver_dae_bdf=5
322  INTEGER(INTG), PARAMETER :: solver_dae_rush_larson=6
323  INTEGER(INTG), PARAMETER :: solver_dae_external=7
324 
326 
331  INTEGER(INTG), PARAMETER :: solver_dae_euler_forward=1
332  INTEGER(INTG), PARAMETER :: solver_dae_euler_backward=2
333  INTEGER(INTG), PARAMETER :: solver_dae_euler_improved=3
335 
340  INTEGER(INTG), PARAMETER :: solver_solution_initialise_zero=0
341  INTEGER(INTG), PARAMETER :: solver_solution_initialise_current_field=1
342  INTEGER(INTG), PARAMETER :: solver_solution_initialise_no_change=2
344 
349  INTEGER(INTG), PARAMETER :: solver_no_output=0
350  INTEGER(INTG), PARAMETER :: solver_progress_output=1
351  INTEGER(INTG), PARAMETER :: solver_timing_output=2
352  INTEGER(INTG), PARAMETER :: solver_solver_output=3
353  INTEGER(INTG), PARAMETER :: solver_matrix_output=4
355 
360  INTEGER(INTG), PARAMETER :: solver_sparse_matrices=1
361  INTEGER(INTG), PARAMETER :: solver_full_matrices=2
363  !Module types
364 
365  !Module variables
366 
367  !Interfaces
368 
369  INTERFACE
370 
371  SUBROUTINE solver_dae_external_integrate(NUMBER_OF_DOFS,START_TIME,END_TIME,INITIAL_STEP, &
372  & only_one_model_index,models_data,number_of_state,state_data,number_of_parameters, &
373  & parameters_data,number_of_intermediate,intermediate_data,err) bind(c, name="SolverDAEExternalIntegrate")
374 
375  USE iso_c_binding
376 
377  INTEGER(C_INT), VALUE, INTENT(IN) :: NUMBER_OF_DOFS
378  REAL(C_DOUBLE), VALUE, INTENT(IN) :: START_TIME
379  REAL(C_DOUBLE), VALUE, INTENT(IN) :: END_TIME
380  REAL(C_DOUBLE), INTENT(INOUT) :: INITIAL_STEP
381  INTEGER(C_INT), VALUE, INTENT(IN) :: ONLY_ONE_MODEL_INDEX
382  INTEGER(C_INT), INTENT(IN) :: MODELS_DATA(*)
383  INTEGER(C_INT), VALUE, INTENT(IN) :: NUMBER_OF_STATE
384  REAL(C_DOUBLE), INTENT(INOUT) :: STATE_DATA(*)
385  INTEGER(C_INT), VALUE, INTENT(IN) :: NUMBER_OF_PARAMETERS
386  REAL(C_DOUBLE), INTENT(IN) :: PARAMETERS_DATA(*)
387  INTEGER(C_INT), VALUE, INTENT(IN) :: NUMBER_OF_INTERMEDIATE
388  REAL(C_DOUBLE), INTENT(OUT) :: INTERMEDIATE_DATA(*)
389  INTEGER(C_INT), INTENT(OUT) :: ERR
390 
391  END SUBROUTINE solver_dae_external_integrate
392 
393  END INTERFACE
394 
395  INTERFACE solver_dynamic_theta_set
396  MODULE PROCEDURE solver_dynamic_theta_set_dp1
397  MODULE PROCEDURE solver_dynamic_theta_set_dp
398  END INTERFACE solver_dynamic_theta_set
399 
400  INTERFACE solver_label_get
401  MODULE PROCEDURE solver_label_get_c
402  MODULE PROCEDURE solver_label_get_vs
403  END INTERFACE solver_label_get
404 
405  INTERFACE solver_label_set
406  MODULE PROCEDURE solver_label_set_c
407  MODULE PROCEDURE solver_label_set_vs
408  END INTERFACE solver_label_set
409 
410  PUBLIC solver_number_of_solver_types
411 
412  PUBLIC solver_linear_type,solver_nonlinear_type,solver_dynamic_type,solver_dae_type,solver_eigenproblem_type, &
413  & solver_optimiser_type,solver_cellml_evaluator_type,solver_geometric_transformation_type
414 
415  PUBLIC solver_cmiss_library,solver_petsc_library,solver_mumps_library,solver_superlu_library,solver_spooles_library, &
416  & solver_umfpack_library,solver_lusol_library,solver_essl_library,solver_lapack_library,solver_tao_library, &
417  & solver_hypre_library,solver_pastix_library
418 
419  PUBLIC solver_linear_direct_solve_type,solver_linear_iterative_solve_type
420 
421  PUBLIC solver_direct_lu,solver_direct_cholesky,solver_direct_svd
422 
423  PUBLIC solver_iterative_richardson,solver_iterative_conjugate_gradient,solver_iterative_chebyshev, &
424  & solver_iterative_biconjugate_gradient,solver_iterative_gmres,solver_iterative_bicgstab,solver_iterative_conjgrad_squared
425 
426  PUBLIC solver_iterative_no_preconditioner,solver_iterative_jacobi_preconditioner,solver_iterative_block_jacobi_preconditioner, &
427  & solver_iterative_sor_preconditioner,solver_iterative_incomplete_cholesky_preconditioner, &
428  & solver_iterative_incomplete_lu_preconditioner,solver_iterative_additive_schwarz_preconditioner
429 
430  PUBLIC solver_nonlinear_newton,solver_nonlinear_bfgs_inverse,solver_nonlinear_sqp,solver_nonlinear_quasi_newton
431 
432  PUBLIC solver_newton_linesearch,solver_newton_trustregion
433 
434  PUBLIC solver_quasi_newton_lbfgs,solver_quasi_newton_goodbroyden, &
435  solver_quasi_newton_badbroyden
436 
437  PUBLIC solver_quasi_newton_linesearch,solver_quasi_newton_trustregion
438 
439  PUBLIC solver_quasi_newton_linesearch_basic,solver_quasi_newton_linesearch_l2, &
440  & solver_quasi_newton_linesearch_cp
441 
442  PUBLIC solver_quasi_newton_restart_none,solver_quasi_newton_restart_powell, &
443  & solver_quasi_newton_restart_periodic
444 
445  PUBLIC solver_quasi_newton_scale_none,solver_quasi_newton_scale_shanno, &
446  & solver_quasi_newton_scale_linesearch,solver_quasi_newton_scale_jacobian
447 
448  PUBLIC solver_newton_linesearch_nonorms,solver_newton_linesearch_linear,solver_newton_linesearch_quadratic, &
449  & solver_newton_linesearch_cubic
450 
451  PUBLIC solver_newton_jacobian_not_calculated,solver_newton_jacobian_equations_calculated, &
452  & solver_newton_jacobian_fd_calculated
453 
454  PUBLIC solver_newton_convergence_petsc_default,solver_newton_convergence_energy_norm, &
455  & solver_newton_convergence_differentiated_ratio
456 
457  PUBLIC solver_dynamic_linear,solver_dynamic_nonlinear,solver_dynamic_linearity_type_set
458 
459  PUBLIC solver_dynamic_first_order,solver_dynamic_second_order
460 
461  PUBLIC solver_dynamic_first_degree,solver_dynamic_second_degree,solver_dynamic_third_degree
462 
463  PUBLIC solver_dynamic_euler_scheme,solver_dynamic_backward_euler_scheme,solver_dynamic_crank_nicolson_scheme, &
464  & solver_dynamic_galerkin_scheme,solver_dynamic_zlamal_scheme,solver_dynamic_second_degree_gear_scheme, &
465  & solver_dynamic_second_degree_liniger1_scheme,solver_dynamic_second_degree_liniger2_scheme, &
466  & solver_dynamic_newmark1_scheme,solver_dynamic_newmark2_scheme,solver_dynamic_newmark3_scheme, &
467  & solver_dynamic_third_degree_gear_scheme,solver_dynamic_third_degree_liniger1_scheme, &
468  & solver_dynamic_third_degree_liniger2_scheme,solver_dynamic_houbolt_scheme,solver_dynamic_wilson_scheme, &
469  & solver_dynamic_bossak_newmark1_scheme,solver_dynamic_bossak_newmark2_scheme, &
470  & solver_dynamic_hilbert_hughes_taylor1_scheme,solver_dynamic_hilbert_hughes_taylor2_scheme, &
471  & solver_dynamic_user_defined_scheme
472 
473  PUBLIC solver_dae_differential_only,solver_dae_index_1,solver_dae_index_2,solver_dae_index_3
474 
475  PUBLIC solver_dae_euler,solver_dae_crank_nicolson,solver_dae_runge_kutta,solver_dae_adams_moulton,solver_dae_bdf, &
476  & solver_dae_rush_larson,solver_dae_external
477 
478  PUBLIC solver_dae_euler_forward,solver_dae_euler_backward,solver_dae_euler_improved
479 
480  PUBLIC solver_solution_initialise_zero,solver_solution_initialise_current_field,solver_solution_initialise_no_change
481 
482  PUBLIC solver_no_output,solver_progress_output,solver_timing_output,solver_solver_output,solver_matrix_output
483 
484  PUBLIC solver_sparse_matrices,solver_full_matrices
485 
486  PUBLIC solver_equations_linear,solver_equations_nonlinear
487 
488  PUBLIC solver_equations_static,solver_equations_quasistatic,solver_equations_first_order_dynamic, &
489  & solver_equations_second_order_dynamic
490 
491  PUBLIC cellml_equations_cellml_add
492 
493  PUBLIC cellml_equations_create_finish,cellml_equations_create_start
494 
495  PUBLIC cellml_equations_destroy
496 
497  PUBLIC solver_cellml_equations_get
498 
499  PUBLIC solver_dae_solver_type_get,solver_dae_solver_type_set
500 
501  PUBLIC solver_dae_times_set,solver_dae_time_step_set
502 
503  PUBLIC solver_dae_euler_solver_type_get,solver_dae_euler_solver_type_set
504 
505  PUBLIC solver_daecellmlrhsevaluate
506 
507  PUBLIC solver_destroy
508 
509  PUBLIC solver_dynamic_degree_get,solver_dynamic_degree_set
510 
511  PUBLIC solver_dynamic_linear_solver_get,solver_dynamic_nonlinear_solver_get
512 
513  PUBLIC solver_dynamic_linearity_type_get
514 
515  PUBLIC solver_dynamic_order_set
516 
517  PUBLIC solver_dynamic_scheme_set
518 
519  PUBLIC solver_dynamic_restart_get,solver_dynamic_restart_set
520 
521  PUBLIC solver_dynamic_theta_set
522 
523  PUBLIC solver_dynamic_ale_set
524 
525  PUBLIC solver_dynamic_update_bc_set
526 
527  PUBLIC solver_dynamic_times_set
528 
529  PUBLIC solver_equations_boundary_conditions_get
530 
531  PUBLIC solver_equations_create_finish,solver_equations_create_start
532 
533  PUBLIC solver_equations_destroy
534 
535  PUBLIC solver_equations_equations_set_add
536 
537  PUBLIC solver_equations_interface_condition_add
538 
539  PUBLIC solver_equations_linearity_type_set
540 
541  PUBLIC solver_equations_sparsity_type_set
542 
543  PUBLIC solverequations_boundaryconditionscreatefinish,solverequations_boundaryconditionscreatestart
544 
545  PUBLIC solver_equations_time_dependence_type_set
546 
547  PUBLIC solverequations_numberofmatricesget
548 
549  PUBLIC solverequations_matrixget
550 
551  PUBLIC solverequations_jacobianmatrixget
552 
553  PUBLIC solverequations_vectorget
554 
555  PUBLIC solverequations_residualvectorget
556 
557  PUBLIC solverequations_rhsvectorget
558 
559  PUBLIC solver_label_get,solver_label_set
560 
561  PUBLIC solver_library_type_get,solver_library_type_set
562 
563  PUBLIC solver_linear_type_set
564 
565  PUBLIC solver_linear_direct_type_set
566 
567  PUBLIC solver_mumpsseticntl,solver_mumpssetcntl
568 
569  PUBLIC solver_lineariterativeabsolutetoleranceset
570 
571  PUBLIC solver_lineariterativedivergencetoleranceset
572 
573  PUBLIC solver_linear_iterative_gmres_restart_set
574 
575  PUBLIC solver_lineariterativemaximumiterationsset
576 
577  PUBLIC solver_lineariterativepreconditionertypeset
578 
579  PUBLIC solver_lineariterativerelativetoleranceset
580 
581  PUBLIC solver_lineariterativesolutioninittypeset
582 
583  PUBLIC solver_linear_iterative_type_set
584 
585  PUBLIC solver_geometrictransformationarbitrarypathset,solver_geometrictransformationclear
586 
587  PUBLIC solver_geometrictransformationnumberofloadincrementsset
588 
589  PUBLIC solver_geometrictransformationscalingsset
590 
591  PUBLIC solver_geometrictransformationfieldset
592 
593  PUBLIC solver_geometrictransformationmatrixset
594 
595  PUBLIC solver_geometrictransformationrotationset,solver_geometrictransformationtranslationset
596 
597  PUBLIC solver_matrices_dynamic_assemble,solver_matrices_static_assemble
598 
599  PUBLIC solver_quasi_newton_absolute_tolerance_set
600 
601  PUBLIC solver_quasinewtonlinesearchmonitoroutputset
602 
603  PUBLIC solver_quasi_newton_linesearch_type_set
604 
605  PUBLIC solver_quasinewtonjacobiancalculationtypeset
606 
607  PUBLIC solver_quasi_newton_linear_solver_get
608 
609  PUBLIC solver_quasi_newton_cellml_solver_get
610 
611  PUBLIC solver_quasinewtonconvergencetesttypeset
612 
613  PUBLIC solver_quasi_newton_linesearch_maxstep_set
614 
615  PUBLIC solver_quasi_newton_linesearch_steptol_set
616 
617  PUBLIC solver_quasi_newton_maximum_iterations_set
618 
619  PUBLIC solver_quasinewtonmaximumfunctionevaluationsset
620 
621  PUBLIC solver_quasi_newton_solution_init_type_set
622 
623  PUBLIC solver_quasi_newton_solution_tolerance_set
624 
625  PUBLIC solver_quasi_newton_relative_tolerance_set
626 
627  PUBLIC solver_quasi_newton_trustregion_delta0_set
628 
629  PUBLIC solver_quasinewtontrustregiontoleranceset
630 
631  PUBLIC solver_quasi_newton_type_set
632 
633  PUBLIC solver_quasi_newton_restart_set
634 
635  PUBLIC solver_quasi_newton_restart_type_set
636 
637  PUBLIC solver_quasi_newton_scale_type_set
638 
639  PUBLIC solver_quasi_newton_solve_type_set
640 
641  PUBLIC solver_newton_absolute_tolerance_set
642 
643  PUBLIC solver_newtonlinesearchmonitoroutputset
644 
645  PUBLIC solver_newton_linesearch_alpha_set
646 
647  PUBLIC solver_newton_linesearch_type_set
648 
649  PUBLIC solver_newton_jacobian_calculation_type_set
650 
651  PUBLIC solver_newton_linear_solver_get
652 
653  PUBLIC solver_newton_cellml_solver_get
654 
655  PUBLIC solver_newtonconvergencetesttypeset
656 
657  PUBLIC solver_newton_linesearch_maxstep_set
658 
659  PUBLIC solver_newton_linesearch_steptol_set
660 
661  PUBLIC solver_newton_maximum_iterations_set
662 
663  PUBLIC solver_newtonmaximumfunctionevaluationsset
664 
665  PUBLIC solver_newton_solution_init_type_set
666 
667  PUBLIC solver_newton_solution_tolerance_set
668 
669  PUBLIC solver_newton_relative_tolerance_set
670 
671  PUBLIC solver_newton_trustregion_delta0_set
672 
673  PUBLIC solver_newton_trustregion_tolerance_set
674 
675  PUBLIC solver_newton_type_set
676 
677  PUBLIC solver_nonlinear_divergence_exit,solver_nonlinear_monitor
678 
679  PUBLIC solver_nonlinear_type_set
680 
681  PUBLIC solver_output_type_set
682 
683  PUBLIC solver_solve
684 
685  PUBLIC solver_solver_equations_get
686 
687  PUBLIC solver_time_stepping_monitor
688 
689  PUBLIC solver_type_set
690 
691  PUBLIC solver_variables_dynamic_field_update
692 
693  PUBLIC solver_variablesdynamicfieldpreviousvaluesupdate
694 
695  PUBLIC solver_variables_dynamic_nonlinear_update
696 
697  PUBLIC solver_variables_field_update
698 
699  PUBLIC solvers_create_finish,solvers_create_start
700 
701  PUBLIC solvers_destroy
702 
703  PUBLIC solvers_number_set
704 
705  PUBLIC solvers_solver_get
706 
707  PUBLIC solver_newton_cellml_evaluator_create,solver_cellml_evaluator_finalise
708 
709  PUBLIC solver_linked_solver_add,solver_linked_solver_remove
710 
711  PUBLIC solver_solution_update
712 
713 CONTAINS
714 
715  !
716  !================================================================================================================================
717  !
718 
720  SUBROUTINE cellml_equations_cellml_add(CELLML_EQUATIONS,CELLML,CELLML_INDEX,ERR,ERROR,*)
721 
722  !Argument variables
723  TYPE(cellml_equations_type), POINTER :: CELLML_EQUATIONS
724  TYPE(cellml_type), POINTER :: CELLML
725  INTEGER(INTG), INTENT(OUT) :: CELLML_INDEX
726  INTEGER(INTG), INTENT(OUT) :: ERR
727  TYPE(varying_string), INTENT(OUT) :: ERROR
728  !Local Variables
729  INTEGER(INTG) :: cellml_idx
730  TYPE(cellml_ptr_type), ALLOCATABLE :: NEW_CELLML_ENVIRONMENTS(:)
731  TYPE(solver_type), POINTER :: SOLVER
732 
733  enters("CELLML_EQUATIONS_CELLML_ADD",err,error,*999)
734 
735  IF(ASSOCIATED(cellml_equations)) THEN
736  IF(cellml_equations%CELLML_EQUATIONS_FINISHED) THEN
737  CALL flagerror("CellML equations has already been finished.",err,error,*999)
738  ELSE
739  solver=>cellml_equations%SOLVER
740  IF(ASSOCIATED(solver)) THEN
741  IF(ASSOCIATED(cellml)) THEN
742  IF(cellml%CELLML_FINISHED) THEN
743  ALLOCATE(new_cellml_environments(cellml_equations%NUMBER_OF_CELLML_ENVIRONMENTS+1),stat=err)
744  IF(err/=0) CALL flagerror("Could not allocate new CellML environments.",err,error,*999)
745  DO cellml_idx=1,cellml_equations%NUMBER_OF_CELLML_ENVIRONMENTS
746  new_cellml_environments(cellml_idx)%PTR=>cellml_equations%CELLML_ENVIRONMENTS(cellml_idx)%PTR
747  ENDDO !cellml_idx
748  new_cellml_environments(cellml_equations%NUMBER_OF_CELLML_ENVIRONMENTS+1)%PTR=>cellml
749  CALL move_alloc(new_cellml_environments,cellml_equations%CELLML_ENVIRONMENTS)
750  cellml_equations%NUMBER_OF_CELLML_ENVIRONMENTS=cellml_equations%NUMBER_OF_CELLML_ENVIRONMENTS+1
751  cellml_index=cellml_equations%NUMBER_OF_CELLML_ENVIRONMENTS
752  ELSE
753  CALL flagerror("CellML environment has not been finished.",err,error,*999)
754  ENDIF
755  ELSE
756  CALL flagerror("CellML environment is not associated.",err,error,*999)
757  ENDIF
758  ELSE
759  CALL flagerror("CellML equations solver is not associated.",err,error,*999)
760  ENDIF
761  ENDIF
762  ELSE
763  CALL flagerror("CellML equations is not associated.",err,error,*999)
764  ENDIF
765 
766  exits("CELLML_EQUATIONS_CELLML_ADD")
767  RETURN
768 999 IF(ALLOCATED(new_cellml_environments)) DEALLOCATE(new_cellml_environments)
769  errorsexits("CELLML_EQUATIONS_CELLML_ADD",err,error)
770  RETURN 1
771 
772  END SUBROUTINE cellml_equations_cellml_add
773 
774  !
775  !================================================================================================================================
776  !
777 
779  SUBROUTINE cellml_equations_create_finish(CELLML_EQUATIONS,ERR,ERROR,*)
780 
781  !Argument variables
782  TYPE(cellml_equations_type), POINTER :: CELLML_EQUATIONS
783  INTEGER(INTG), INTENT(OUT) :: ERR
784  TYPE(varying_string), INTENT(OUT) :: ERROR
785  !Local Variables
786  TYPE(solver_type), POINTER :: SOLVER
787 
788  enters("CELLML_EQUATIONS_CREATE_FINISH",err,error,*999)
789 
790  IF(ASSOCIATED(cellml_equations)) THEN
791  IF(cellml_equations%CELLML_EQUATIONS_FINISHED) THEN
792  CALL flagerror("CellML equations has already been finished.",err,error,*999)
793  ELSE
794  solver=>cellml_equations%SOLVER
795  IF(ASSOCIATED(solver)) THEN
796  cellml_equations%CELLML_EQUATIONS_FINISHED=.true.
797  ELSE
798  CALL flagerror("CellML equations solver is not associated.",err,error,*999)
799  ENDIF
800  ENDIF
801  ELSE
802  CALL flagerror("CellML equations is not associated.",err,error,*999)
803  ENDIF
804 
805  exits("CELLML_EQUATIONS_CREATE_FINISH")
806  RETURN
807 999 errorsexits("CELLML_EQUATIONS_CREATE_FINISH",err,error)
808  RETURN 1
809 
810  END SUBROUTINE cellml_equations_create_finish
811 
812  !
813  !================================================================================================================================
814  !
815 
817  SUBROUTINE cellml_equations_create_start(SOLVER,CELLML_EQUATIONS,ERR,ERROR,*)
818 
819  !Argument variables
820  TYPE(solver_type), POINTER :: SOLVER
821  TYPE(cellml_equations_type), POINTER :: CELLML_EQUATIONS
822  INTEGER(INTG), INTENT(OUT) :: ERR
823  TYPE(varying_string), INTENT(OUT) :: ERROR
824  !Local Variables
825 
826  enters("CELLML_EQUATIONS_CREATE_START",err,error,*999)
827 
828  IF(ASSOCIATED(solver)) THEN
829  IF(ASSOCIATED(cellml_equations)) THEN
830  CALL flagerror("CellML equations is already associated.",err,error,*999)
831  ELSE
832  NULLIFY(cellml_equations)
833  CALL cellml_equations_initialise(solver,err,error,*999)
834  cellml_equations=>solver%CELLML_EQUATIONS
835  ENDIF
836  ELSE
837  CALL flagerror("Solver is not associated.",err,error,*999)
838  ENDIF
839 
840  exits("CELLML_EQUATIONS_CREATE_START")
841  RETURN
842 999 errorsexits("CELLML_EQUATIONS_CREATE_START",err,error)
843  RETURN 1
844 
845  END SUBROUTINE cellml_equations_create_start
846 
847  !
848  !================================================================================================================================
849  !
850 
852  SUBROUTINE cellml_equations_destroy(CELLML_EQUATIONS,ERR,ERROR,*)
853 
854  !Argument variables
855  TYPE(cellml_equations_type), POINTER :: CELLML_EQUATIONS
856  INTEGER(INTG), INTENT(OUT) :: ERR
857  TYPE(varying_string), INTENT(OUT) :: ERROR
858  !Local Variables
859 
860  enters("CELLML_EQUATIONS_DESTROY",err,error,*999)
861 
862  IF(ASSOCIATED(cellml_equations)) THEN
863  CALL cellml_equations_finalise(cellml_equations,err,error,*999)
864  ELSE
865  CALL flagerror("CellML equations is not associated.",err,error,*999)
866  ENDIF
867 
868  exits("CELLML_EQUATIONS_DESTROY")
869  RETURN
870 999 errorsexits("CELLML_EQUATIONS_DESTROY",err,error)
871  RETURN 1
872 
873  END SUBROUTINE cellml_equations_destroy
874 
875  !
876  !================================================================================================================================
877  !
878 
880  SUBROUTINE cellml_equations_finalise(CELLML_EQUATIONS,ERR,ERROR,*)
881 
882  !Argument variables
883  TYPE(cellml_equations_type), POINTER :: CELLML_EQUATIONS
884  INTEGER(INTG), INTENT(OUT) :: ERR
885  TYPE(varying_string), INTENT(OUT) :: ERROR
886  !Local Variables
887 
888  enters("CELLML_EQUATIONS_FINALISE",err,error,*999)
889 
890  IF(ASSOCIATED(cellml_equations)) THEN
891  IF(ALLOCATED(cellml_equations%CELLML_ENVIRONMENTS)) DEALLOCATE(cellml_equations%CELLML_ENVIRONMENTS)
892  DEALLOCATE(cellml_equations)
893  ENDIF
894 
895  exits("CELLML_EQUATIONS_FINALISE")
896  RETURN
897 999 errorsexits("CELLML_EQUATIONS_FINALISE",err,error)
898  RETURN 1
899 
900  END SUBROUTINE cellml_equations_finalise
901 
902  !
903  !================================================================================================================================
904  !
905 
907  SUBROUTINE cellml_equations_initialise(SOLVER,ERR,ERROR,*)
908 
909  !Argument variables
910  TYPE(solver_type), POINTER :: SOLVER
911  INTEGER(INTG), INTENT(OUT) :: ERR
912  TYPE(varying_string), INTENT(OUT) :: ERROR
913  !Local Variables
914  INTEGER(INTG) :: DUMMY_ERR
915  TYPE(varying_string) :: DUMMY_ERROR
916 
917  enters("CELLML_EQUATIONS_INITIALISE",err,error,*998)
918 
919  IF(ASSOCIATED(solver)) THEN
920  IF(ASSOCIATED(solver%CELLML_EQUATIONS)) THEN
921  CALL flagerror("CellML equations is already associated for this solver.",err,error,*998)
922  ELSE
923  ALLOCATE(solver%CELLML_EQUATIONS,stat=err)
924  IF(err/=0) CALL flagerror("Could not allocate CellML equations.",err,error,*999)
925  solver%CELLML_EQUATIONS%SOLVER=>solver
926  solver%CELLML_EQUATIONS%CELLML_EQUATIONS_FINISHED=.false.
927  solver%CELLML_EQUATIONS%NUMBER_OF_CELLML_ENVIRONMENTS=0
928  ENDIF
929  ELSE
930  CALL flagerror("Solver is not associated.",err,error,*998)
931  ENDIF
932 
933  exits("CELLML_EQUATIONS_INITIALISE")
934  RETURN
935 999 CALL cellml_equations_finalise(solver%CELLML_EQUATIONS,dummy_err,dummy_error,*998)
936 998 errorsexits("CELLML_EQUATIONS_INITIALISE",err,error)
937  RETURN 1
938 
939  END SUBROUTINE cellml_equations_initialise
940 
941  !
942  !================================================================================================================================
943  !
944 
946  SUBROUTINE solver_cellml_equations_get(SOLVER,CELLML_EQUATIONS,ERR,ERROR,*)
947 
948  !Argument variables
949  TYPE(solver_type), POINTER :: SOLVER
950  TYPE(cellml_equations_type), POINTER :: CELLML_EQUATIONS
951  INTEGER(INTG), INTENT(OUT) :: ERR
952  TYPE(varying_string), INTENT(OUT) :: ERROR
953  !Local Variables
954 
955  enters("SOLVER_CELLML_EQUATIONS_GET",err,error,*998)
956 
957  IF(ASSOCIATED(solver)) THEN
958  IF(ASSOCIATED(cellml_equations)) THEN
959  CALL flagerror("CellML equations is already associated.",err,error,*998)
960  ELSE
961  cellml_equations=>solver%CELLML_EQUATIONS
962  IF(.NOT.ASSOCIATED(cellml_equations)) CALL flagerror("CellML equations is not associated.",err,error,*999)
963  ENDIF
964  !ELSE
965  !CALL FlagError("Solver has not been finished.",ERR,ERROR,*998)
966  !ENDIF
967  ELSE
968  CALL flagerror("Solver is not associated.",err,error,*998)
969  ENDIF
970 
971  exits("SOLVER_CELLML_EQUATIONS_GET")
972  RETURN
973 999 NULLIFY(cellml_equations)
974 998 errorsexits("SOLVER_CELLML_EQUATIONS_GET",err,error)
975  RETURN 1
976 
977  END SUBROUTINE solver_cellml_equations_get
978 
979  !
980  !================================================================================================================================
981  !
982 
984  SUBROUTINE solver_cellml_evaluator_create_finish(CELLML_EVALUATOR_SOLVER,ERR,ERROR,*)
985 
986  !Argument variables
987  TYPE(cellml_evaluator_solver_type), POINTER :: CELLML_EVALUATOR_SOLVER
988  INTEGER(INTG), INTENT(OUT) :: ERR
989  TYPE(varying_string), INTENT(OUT) :: ERROR
990  !Local Variables
991 
992  enters("SOLVER_CELLML_EVALUATOR_CREATE_FINISH",err,error,*999)
993 
994  IF(ASSOCIATED(cellml_evaluator_solver)) THEN
995  CALL flagerror("Not implemented.",err,error,*999)
996  ELSE
997  CALL flagerror("CellML evaluastor solver is not associated.",err,error,*999)
998  ENDIF
999 
1000  exits("SOLVER_CELLML_EVALUATOR_CREATE_FINISH")
1001  RETURN
1002 999 errorsexits("SOLVER_CELLML_EVALUATOR_CREATE_FINISH",err,error)
1003  RETURN 1
1004 
1005  END SUBROUTINE solver_cellml_evaluator_create_finish
1006 
1007  !
1008  !================================================================================================================================
1009  !
1010 
1012  SUBROUTINE solver_cellml_evaluator_finalise(CELLML_EVALUATOR_SOLVER,ERR,ERROR,*)
1013 
1014  !Argument variables
1015  TYPE(cellml_evaluator_solver_type), POINTER :: CELLML_EVALUATOR_SOLVER
1016  INTEGER(INTG), INTENT(OUT) :: ERR
1017  TYPE(varying_string), INTENT(OUT) :: ERROR
1018  !Local Variables
1019 
1020  enters("SOLVER_CELLML_EVALUATOR_FINALISE",err,error,*999)
1021 
1022  IF(ASSOCIATED(cellml_evaluator_solver)) THEN
1023  DEALLOCATE(cellml_evaluator_solver)
1024  ENDIF
1025 
1026  exits("SOLVER_CELLML_EVALUATOR_FINALISE")
1027  RETURN
1028 999 errorsexits("SOLVER_CELLML_EVALUATOR_FINALISE",err,error)
1029  RETURN 1
1030 
1031  END SUBROUTINE solver_cellml_evaluator_finalise
1032 
1033  !
1034  !================================================================================================================================
1035  !
1036 
1038  SUBROUTINE solver_cellml_evaluator_initialise(SOLVER,ERR,ERROR,*)
1039 
1040  !Argument variables
1041  TYPE(solver_type), POINTER :: SOLVER
1042  INTEGER(INTG), INTENT(OUT) :: ERR
1043  TYPE(varying_string), INTENT(OUT) :: ERROR
1044  !Local Variables
1045  INTEGER(INTG) :: DUMMY_ERR
1046  TYPE(varying_string) :: DUMMY_ERROR
1047 
1048  enters("SOLVER_CELLML_EVALUATOR_INITIALISE",err,error,*998)
1049 
1050  IF(ASSOCIATED(solver)) THEN
1051  IF(ASSOCIATED(solver%CELLML_EVALUATOR_SOLVER)) THEN
1052  CALL flagerror("CellML evaluator solver is already associated for this solver.",err,error,*998)
1053  ELSE
1054  ALLOCATE(solver%CELLML_EVALUATOR_SOLVER,stat=err)
1055  IF(err/=0) CALL flagerror("Could not allocate solver CellML evaluator solver.",err,error,*999)
1056  solver%CELLML_EVALUATOR_SOLVER%SOLVER=>solver
1057  solver%CELLML_EVALUATOR_SOLVER%SOLVER_LIBRARY=solver_cmiss_library
1058  solver%CELLML_EVALUATOR_SOLVER%CURRENT_TIME=0.0_dp
1059  ENDIF
1060  ELSE
1061  CALL flagerror("Solver is not associated.",err,error,*998)
1062  ENDIF
1063 
1064  exits("SOLVER_CELLML_EVALUATOR_INITIALISE")
1065  RETURN
1066 999 CALL solver_cellml_evaluator_finalise(solver%CELLML_EVALUATOR_SOLVER,dummy_err,dummy_error,*998)
1067 998 errorsexits("SOLVER_CELLML_EVALUATOR_INITIALISE",err,error)
1068  RETURN 1
1069 
1070  END SUBROUTINE solver_cellml_evaluator_initialise
1071 
1072  !
1073  !================================================================================================================================
1074  !
1075 
1077  SUBROUTINE solver_cellml_evaluator_library_type_get(CELLML_EVALUATOR_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
1078 
1079  !Argument variables
1080  TYPE(cellml_evaluator_solver_type), POINTER :: CELLML_EVALUATOR_SOLVER
1081  INTEGER(INTG), INTENT(OUT) :: SOLVER_LIBRARY_TYPE
1082  INTEGER(INTG), INTENT(OUT) :: ERR
1083  TYPE(varying_string), INTENT(OUT) :: ERROR
1084  !Local Variables
1085 
1086  enters("SOLVER_CELLML_EVALUATOR_LIBRARY_TYPE_GET",err,error,*999)
1087 
1088  IF(ASSOCIATED(cellml_evaluator_solver)) THEN
1089  solver_library_type=cellml_evaluator_solver%SOLVER_LIBRARY
1090  ELSE
1091  CALL flagerror("CellML evaluator solver is not associated.",err,error,*999)
1092  ENDIF
1093 
1094  exits("SOLVER_CELLML_EVALUATOR_LIBRARY_TYPE_GET")
1095  RETURN
1096 999 errorsexits("SOLVER_CELLML_EVALUATOR_LIBRARY_TYPE_GET",err,error)
1097  RETURN 1
1098 
1099  END SUBROUTINE solver_cellml_evaluator_library_type_get
1100 
1101  !
1102  !================================================================================================================================
1103  !
1104 
1106  SUBROUTINE solver_cellml_evaluator_library_type_set(CELLML_EVALUATOR_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
1107 
1108  !Argument variables
1109  TYPE(cellml_evaluator_solver_type), POINTER :: CELLML_EVALUATOR_SOLVER
1110  INTEGER(INTG), INTENT(IN) :: SOLVER_LIBRARY_TYPE
1111  INTEGER(INTG), INTENT(OUT) :: ERR
1112  TYPE(varying_string), INTENT(OUT) :: ERROR
1113  !Local Variables
1114  TYPE(varying_string) :: LOCAL_ERROR
1115 
1116  enters("SOLVER_CELLML_EVALUATOR_LIBRARY_TYPE_SET",err,error,*999)
1117 
1118  IF(ASSOCIATED(cellml_evaluator_solver)) THEN
1119  SELECT CASE(solver_library_type)
1120  CASE(solver_cmiss_library)
1121  CALL flagerror("Not implemented.",err,error,*999)
1122  CASE DEFAULT
1123  local_error="The specified solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
1124  & " is invalid for a CellML evaluator solver."
1125  CALL flagerror(local_error,err,error,*999)
1126  END SELECT
1127  ELSE
1128  CALL flagerror("CellML evaluator solver is not associated.",err,error,*999)
1129  ENDIF
1130 
1131  exits("SOLVER_CELLML_EVALUATOR_LIBRARY_TYPE_SET")
1132  RETURN
1133 999 errorsexits("SOLVER_CELLML_EVALUATOR_LIBRARY_TYPE_SET",err,error)
1134  RETURN 1
1135 
1136  END SUBROUTINE solver_cellml_evaluator_library_type_set
1137 
1138  !
1139  !================================================================================================================================
1140  !
1141 
1143  SUBROUTINE solver_cellml_evaluator_time_get(CELLML_EVALUATOR_SOLVER,TIME,ERR,ERROR,*)
1144 
1145  !Argument variables
1146  TYPE(cellml_evaluator_solver_type), POINTER :: CELLML_EVALUATOR_SOLVER
1147  REAL(DP), INTENT(OUT) :: TIME
1148  INTEGER(INTG), INTENT(OUT) :: ERR
1149  TYPE(varying_string), INTENT(OUT) :: ERROR
1150  !Local Variables
1151 
1152  enters("SOLVER_CELLML_EVALUATOR_TIME_GET",err,error,*999)
1153 
1154  IF(ASSOCIATED(cellml_evaluator_solver)) THEN
1155  time=cellml_evaluator_solver%CURRENT_TIME
1156  ELSE
1157  CALL flagerror("CellML evaluator solver is not associated.",err,error,*999)
1158  ENDIF
1159 
1160  exits("SOLVER_CELLML_EVALUATOR_TIME_GET")
1161  RETURN
1162 999 errorsexits("SOLVER_CELLML_EVALUATOR_TIME_GET",err,error)
1163  RETURN 1
1164 
1165  END SUBROUTINE solver_cellml_evaluator_time_get
1166 
1167  !
1168  !================================================================================================================================
1169  !
1170 
1172  SUBROUTINE solver_cellml_evaluator_time_set(CELLML_EVALUATOR_SOLVER,TIME,ERR,ERROR,*)
1173 
1174  !Argument variables
1175  TYPE(cellml_evaluator_solver_type), POINTER :: CELLML_EVALUATOR_SOLVER
1176  REAL(DP), INTENT(IN) :: TIME
1177  INTEGER(INTG), INTENT(OUT) :: ERR
1178  TYPE(varying_string), INTENT(OUT) :: ERROR
1179 
1180  enters("SOLVER_CELLML_EVALUATOR_TIME_SET",err,error,*999)
1181 
1182  IF(ASSOCIATED(cellml_evaluator_solver)) THEN
1183  cellml_evaluator_solver%CURRENT_TIME=time
1184  ELSE
1185  CALL flagerror("CellML evaluator solver is not associated.",err,error,*999)
1186  ENDIF
1187 
1188  exits("SOLVER_CELLML_EVALUATOR_TIME_SET")
1189  RETURN
1190 999 errorsexits("SOLVER_CELLML_EVALUATOR_TIME_SET",err,error)
1191  RETURN 1
1192 
1193  END SUBROUTINE solver_cellml_evaluator_time_set
1194 
1195  !
1196  !================================================================================================================================
1197  !
1198 
1200  SUBROUTINE solver_cellml_evaluator_solve(CELLML_EVALUATOR_SOLVER,ERR,ERROR,*)
1201 
1202  !Argument variables
1203  TYPE(cellml_evaluator_solver_type), POINTER :: CELLML_EVALUATOR_SOLVER
1204  INTEGER(INTG), INTENT(OUT) :: ERR
1205  TYPE(varying_string), INTENT(OUT) :: ERROR
1206  !Local Variables
1207  INTEGER(INTG) :: cellml_idx
1208  INTEGER(INTG), POINTER :: MODELS_DATA(:)
1209  REAL(DP), POINTER :: INTERMEDIATE_DATA(:),PARAMETERS_DATA(:),STATE_DATA(:)
1210  TYPE(cellml_type), POINTER :: CELLML_ENVIRONMENT
1211  TYPE(cellml_equations_type), POINTER :: CELLML_EQUATIONS
1212  TYPE(cellml_models_field_type), POINTER :: CELLML_MODELS_FIELD
1213  TYPE(field_variable_type), POINTER :: MODELS_VARIABLE
1214  TYPE(field_type), POINTER :: MODELS_FIELD,STATE_FIELD,PARAMETERS_FIELD,INTERMEDIATE_FIELD
1215  TYPE(solver_type), POINTER :: SOLVER
1216  TYPE(varying_string) :: LOCAL_ERROR
1217 
1218  enters("SOLVER_CELLML_EVALUATOR_SOLVE",err,error,*999)
1219 
1220  NULLIFY(models_data)
1221  NULLIFY(intermediate_data)
1222  NULLIFY(parameters_data)
1223  NULLIFY(state_data)
1224 
1225  NULLIFY(models_variable)
1226  NULLIFY(state_field)
1227  NULLIFY(parameters_field)
1228  NULLIFY(intermediate_field)
1229 
1230  IF(ASSOCIATED(cellml_evaluator_solver)) THEN
1231  solver=>cellml_evaluator_solver%SOLVER
1232  IF(ASSOCIATED(solver)) THEN
1233  cellml_equations=>solver%CELLML_EQUATIONS
1234  IF(ASSOCIATED(cellml_equations)) THEN
1235  DO cellml_idx=1,cellml_equations%NUMBER_OF_CELLML_ENVIRONMENTS
1236  cellml_environment=>cellml_equations%CELLML_ENVIRONMENTS(cellml_idx)%PTR
1237  IF(ASSOCIATED(cellml_environment)) THEN
1238  cellml_models_field=>cellml_environment%MODELS_FIELD
1239  IF(ASSOCIATED(cellml_models_field)) THEN
1240  models_field=>cellml_models_field%MODELS_FIELD
1241  IF(ASSOCIATED(models_field)) THEN
1242 
1243 !!TODO: Maybe move this getting of fields earlier up the DAE solver chain? For now keep here.
1244 
1245  !Make sure CellML fields have been updated to the current value of any mapped fields
1246  CALL cellml_field_to_cellml_update(cellml_environment,err,error,*999)
1247 
1248  CALL field_variable_get(models_field,field_u_variable_type,models_variable,err,error,*999)
1249  CALL field_parameter_set_data_get(models_field,field_u_variable_type,field_values_set_type, &
1250  & models_data,err,error,*999)
1251 
1252  !Get the state information if this environment has any.
1253  IF(ASSOCIATED(cellml_environment%STATE_FIELD)) THEN
1254  state_field=>cellml_environment%STATE_FIELD%STATE_FIELD
1255  IF(ASSOCIATED(state_field)) THEN
1256  CALL field_parameter_set_data_get(state_field,field_u_variable_type,field_values_set_type, &
1257  & state_data,err,error,*999)
1258  ENDIF
1259  ENDIF
1260 
1261  !Get the parameters information if this environment has any.
1262  IF(ASSOCIATED(cellml_environment%PARAMETERS_FIELD)) THEN
1263  parameters_field=>cellml_environment%PARAMETERS_FIELD%PARAMETERS_FIELD
1264  IF(ASSOCIATED(parameters_field)) THEN
1265  CALL field_parameter_set_data_get(parameters_field,field_u_variable_type,field_values_set_type, &
1266  & parameters_data,err,error,*999)
1267  ENDIF
1268  ENDIF
1269 
1270  !Get the intermediate information if this environment has any.
1271  IF(ASSOCIATED(cellml_environment%INTERMEDIATE_FIELD)) THEN
1272  intermediate_field=>cellml_environment%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD
1273  IF(ASSOCIATED(intermediate_field)) THEN
1274  CALL field_parameter_set_data_get(intermediate_field,field_u_variable_type,field_values_set_type, &
1275  & intermediate_data,err,error,*999)
1276  ENDIF
1277  ENDIF
1278 
1279  !Solve these CellML equations
1280  SELECT CASE(cellml_evaluator_solver%SOLVER_LIBRARY)
1281  CASE(solver_cmiss_library)
1282  CALL solver_cellml_evaluate(cellml_evaluator_solver,cellml_environment,models_variable%TOTAL_NUMBER_OF_DOFS, &
1283  & cellml_environment%MODELS_FIELD%ONLY_ONE_MODEL_INDEX,models_data,cellml_environment% &
1284  & maximum_number_of_state,state_data,cellml_environment%MAXIMUM_NUMBER_OF_PARAMETERS, &
1285  & parameters_data,cellml_environment%MAXIMUM_NUMBER_OF_INTERMEDIATE,intermediate_data,err,error,*999)
1286  CASE DEFAULT
1287  CALL flagerror("Solver library not implemented.",err,error,*999)
1288  END SELECT
1289 
1290  !Restore field data
1291  CALL field_parameter_set_data_restore(models_field,field_u_variable_type,field_values_set_type, &
1292  & models_data,err,error,*999)
1293  IF(ASSOCIATED(state_field)) CALL field_parameter_set_data_restore(state_field,field_u_variable_type, &
1294  & field_values_set_type,state_data,err,error,*999)
1295  IF(ASSOCIATED(parameters_field)) CALL field_parameter_set_data_restore(parameters_field, &
1296  & field_u_variable_type,field_values_set_type,parameters_data,err,error,*999)
1297  IF(ASSOCIATED(intermediate_field)) CALL field_parameter_set_data_restore(intermediate_field, &
1298  & field_u_variable_type,field_values_set_type,intermediate_data,err,error,*999)
1299 
1300  !Make sure fields have been updated to the current value of any mapped CellML fields
1301  CALL cellml_cellml_to_field_update(cellml_environment,err,error,*999)
1302 
1303  ELSE
1304  local_error="The CellML models field is not associated for CellML index "// &
1305  & trim(numbertovstring(cellml_idx,"*",err,error))//"."
1306  CALL flagerror(local_error,err,error,*999)
1307  ENDIF
1308  ELSE
1309  local_error="The CellML models field is not associated for CellML index "// &
1310  & trim(numbertovstring(cellml_idx,"*",err,error))//"."
1311  CALL flagerror(local_error,err,error,*999)
1312  ENDIF
1313  ELSE
1314  local_error="The CellML enviroment is not associated for for CellML index "// &
1315  & trim(numbertovstring(cellml_idx,"*",err,error))//"."
1316  CALL flagerror(local_error,err,error,*999)
1317  ENDIF
1318  ENDDO !cellml_idx
1319  ELSE
1320  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
1321  ENDIF
1322  ELSE
1323  CALL flagerror("Solver is not associated.",err,error,*999)
1324  ENDIF
1325  ELSE
1326  CALL flagerror("CellML evaluator solver is not associated.",err,error,*999)
1327  ENDIF
1328 
1329  exits("SOLVER_CELLML_EVALUATOR_SOLVE")
1330  RETURN
1331 999 errorsexits("SOLVER_CELLML_EVALUATOR_SOLVE",err,error)
1332  RETURN 1
1333 
1334  END SUBROUTINE solver_cellml_evaluator_solve
1335 
1336  !
1337  !================================================================================================================================
1338  !
1339 
1341  SUBROUTINE solver_cellml_evaluate(CELLML_EVALUATOR_SOLVER,CELLML,N, ONLY_ONE_MODEL_INDEX,MODELS_DATA,MAX_NUMBER_STATES, &
1342  & state_data,max_number_parameters,parameters_data,max_number_intermediates,intermediate_data,err,error,*)
1343 
1344  !Argument variables
1345  TYPE(cellml_evaluator_solver_type), POINTER :: CELLML_EVALUATOR_SOLVER
1346  TYPE(cellml_type), POINTER :: CELLML
1347  INTEGER(INTG), INTENT(IN) :: N
1348  INTEGER(INTG), INTENT(IN) :: ONLY_ONE_MODEL_INDEX
1349  INTEGER(INTG), POINTER :: MODELS_DATA(:)
1350  INTEGER(INTG), INTENT(IN) :: MAX_NUMBER_STATES
1351  REAL(DP), POINTER :: STATE_DATA(:)
1352  INTEGER(INTG), INTENT(IN) :: MAX_NUMBER_PARAMETERS
1353  REAL(DP), POINTER :: PARAMETERS_DATA(:)
1354  INTEGER(INTG), INTENT(IN) :: MAX_NUMBER_INTERMEDIATES
1355  REAL(DP), POINTER :: INTERMEDIATE_DATA(:)
1356  INTEGER(INTG), INTENT(OUT) :: ERR
1357  TYPE(varying_string), INTENT(OUT) :: ERROR
1358  !Local Variables
1359  INTEGER(INTG) :: dof_idx,DOF_ORDER_TYPE,INTERMEDIATE_END_DOF,intermediate_idx,INTERMEDIATE_START_DOF,model_idx, &
1360  & NUMBER_INTERMEDIATES,NUMBER_PARAMETERS,NUMBER_STATES,PARAMETER_END_DOF,parameter_idx,PARAMETER_START_DOF, &
1361  & STATE_END_DOF,state_idx,STATE_START_DOF
1362  REAL(DP) :: INTERMEDIATES(max(1,max_number_intermediates)),PARAMETERS(max(1,max_number_parameters)), &
1363  & RATES(MAX(1,MAX_NUMBER_STATES)),STATES(MAX(1,MAX_NUMBER_STATES))
1364  TYPE(cellml_model_type), POINTER :: MODEL
1365  TYPE(varying_string) :: LOCAL_ERROR
1366 
1367  enters("SOLVER_CELLML_EVALUATE",err,error,*999)
1368 
1369  IF(ASSOCIATED(cellml_evaluator_solver)) THEN
1370  IF(ASSOCIATED(cellml)) THEN
1371  IF(ASSOCIATED(cellml%MODELS_FIELD)) THEN
1372  CALL field_dof_order_type_get(cellml%MODELS_FIELD%MODELS_FIELD,field_u_variable_type,dof_order_type,err,error,*999)
1373  IF(dof_order_type==field_separated_component_dof_order) THEN
1374  !Dof components are separated. Will need to copy data to temporary arrays.
1375  IF(only_one_model_index==cellml_models_field_not_constant) THEN
1376  !Mulitple models
1377  DO dof_idx=1,n
1378  model_idx=models_data(dof_idx)
1379  IF(model_idx.GT.0) THEN
1380  model=>cellml%MODELS(model_idx)%PTR
1381  IF(ASSOCIATED(model)) THEN
1382  number_states=model%NUMBER_OF_STATE
1383  number_intermediates=model%NUMBER_OF_INTERMEDIATE
1384  number_parameters=model%NUMBER_OF_PARAMETERS
1385 
1386  !Copy CellML data to temporary arrays
1387  DO state_idx=1,number_states
1388  states(state_idx)=state_data((dof_idx-1)*n+state_idx)
1389  ENDDO !state_idx
1390  DO parameter_idx=1,number_parameters
1391  parameters(parameter_idx)=parameters_data((dof_idx-1)*n+parameter_idx)
1392  ENDDO !parameter_idx
1393 
1394 #ifdef WITH_CELLML
1395  CALL cellml_model_definition_call_rhs_routine(model%PTR,0.0_dp,states,rates,intermediates, &
1396  & parameters)
1397 #else
1398  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
1399 #endif
1400 
1401  !Copy temporary data back to CellML arrays
1402  DO intermediate_idx=1,number_intermediates
1403  intermediate_data((dof_idx-1)*n+intermediate_idx)=intermediates(intermediate_idx)
1404  ENDDO !intermediate_idx
1405  DO state_idx=1,number_states
1406  state_data((dof_idx-1)*n+state_idx)=states(state_idx)
1407  ENDDO !state_idx
1408 
1409  ELSE
1410  local_error="CellML environment model is not associated for model index "// &
1411  & trim(numbertovstring(only_one_model_index,"*",err,error))//" belonging to dof index "// &
1412  & trim(numbertovstring(dof_idx,"*",err,error))//"."
1413  CALL flagerror(local_error,err,error,*999)
1414  ENDIF
1415  ENDIF !model_idx
1416  ENDDO !dof_idx
1417  ELSE
1418  !One one model is used.
1419  model=>cellml%MODELS(only_one_model_index)%PTR
1420  IF(ASSOCIATED(model)) THEN
1421  number_states=model%NUMBER_OF_STATE
1422  number_intermediates=model%NUMBER_OF_INTERMEDIATE
1423  number_parameters=model%NUMBER_OF_PARAMETERS
1424  DO dof_idx=1,n
1425  model_idx=models_data(dof_idx)
1426  IF(model_idx.GT.0) THEN
1427 
1428  !Copy CellML data to temporary arrays
1429  DO state_idx=1,number_states
1430  states(state_idx)=state_data((dof_idx-1)*n+state_idx)
1431  ENDDO !state_idx
1432  DO parameter_idx=1,number_parameters
1433  parameters(parameter_idx)=parameters_data((dof_idx-1)*n+parameter_idx)
1434  ENDDO !parameter_idx
1435 
1436 #ifdef WITH_CELLML
1437  CALL cellml_model_definition_call_rhs_routine(model%PTR,0.0_dp,states,rates,intermediates, &
1438  & parameters)
1439 #else
1440  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
1441 #endif
1442 
1443  !Copy temporary data back to CellML arrays
1444  DO intermediate_idx=1,number_intermediates
1445  intermediate_data((dof_idx-1)*n+intermediate_idx)=intermediates(intermediate_idx)
1446  ENDDO !intermediate_idx
1447  DO state_idx=1,number_states
1448  state_data((dof_idx-1)*n+state_idx)=states(state_idx)
1449  ENDDO !state_idx
1450  ENDIF !model_idx
1451  ENDDO !dof_idx
1452  ELSE
1453  local_error="CellML environment model is not associated for model index "// &
1454  & trim(numbertovstring(only_one_model_index,"*",err,error))//"."
1455  CALL flagerror(local_error,err,error,*999)
1456  ENDIF
1457  ENDIF
1458  ELSE
1459  !Dof components are continguous. Can pass data directly.
1460  IF(only_one_model_index==cellml_models_field_not_constant) THEN
1461  !Mulitple models
1462 
1463 #ifdef WITH_CELLML
1464 
1465  DO dof_idx=1,n
1466  model_idx=models_data(dof_idx)
1467  IF(model_idx.GT.0) THEN
1468  model=>cellml%MODELS(model_idx)%PTR
1469  IF(ASSOCIATED(model)) THEN
1470  number_states=model%NUMBER_OF_STATE
1471  number_intermediates=model%NUMBER_OF_INTERMEDIATE
1472  number_parameters=model%NUMBER_OF_PARAMETERS
1473  !Call RHS. Note some models might not have state, rates, intermediate or parameter data so call accordingly
1474  !to avoid indexing in to null pointers
1475  IF(number_states>0) THEN
1476  IF(number_intermediates>0) THEN
1477  IF(number_parameters>0) THEN
1478  !We have state, intermediate and parameters in the model
1479  state_start_dof=(dof_idx-1)*max_number_states+1
1480  state_end_dof=state_start_dof+number_states-1
1481  intermediate_start_dof=(dof_idx-1)*max_number_intermediates+1
1482  intermediate_end_dof=intermediate_start_dof+number_intermediates-1
1483  parameter_start_dof=(dof_idx-1)*max_number_parameters+1
1484  parameter_end_dof=parameter_start_dof+number_parameters-1
1485 
1486  CALL cellml_model_definition_call_rhs_routine(model%PTR,0.0_dp, &
1487  & state_data(state_start_dof:state_end_dof), &
1488  & rates,intermediate_data(intermediate_start_dof:intermediate_end_dof),parameters_data( &
1489  & parameter_start_dof:parameter_end_dof))
1490 
1491  ELSE
1492  !We do not have parameters in the model
1493  state_start_dof=(dof_idx-1)*max_number_states+1
1494  state_end_dof=state_start_dof+number_states-1
1495  intermediate_start_dof=(dof_idx-1)*max_number_intermediates+1
1496  intermediate_end_dof=intermediate_start_dof+number_intermediates-1
1497 
1498  CALL cellml_model_definition_call_rhs_routine(model%PTR,0.0_dp, &
1499  & state_data(state_start_dof:state_end_dof), &
1500  & rates,intermediate_data(intermediate_start_dof:intermediate_end_dof),parameters)
1501 
1502  ENDIF
1503  ELSE
1504  IF(number_parameters>0) THEN
1505  !We do not have intermediates in the model
1506  state_start_dof=(dof_idx-1)*max_number_states+1
1507  state_end_dof=state_start_dof+number_states-1
1508  parameter_start_dof=(dof_idx-1)*max_number_parameters+1
1509  parameter_end_dof=parameter_start_dof+number_parameters-1
1510 
1511  CALL cellml_model_definition_call_rhs_routine(model%PTR,0.0_dp, &
1512  & state_data(state_start_dof:state_end_dof), &
1513  & rates,intermediates,parameters_data(parameter_start_dof:parameter_end_dof))
1514 
1515  ELSE
1516  !We do not have intermediates or parameters in the model
1517  state_start_dof=(dof_idx-1)*max_number_states+1
1518  state_end_dof=state_start_dof+number_states-1
1519 
1520  CALL cellml_model_definition_call_rhs_routine(model%PTR,0.0_dp, &
1521  & state_data(state_start_dof:state_end_dof), &
1522  & rates,intermediates,parameters)
1523 
1524  ENDIF
1525  ENDIF
1526  ELSE
1527  IF(number_intermediates>0) THEN
1528  IF(number_parameters>0) THEN
1529  !We do not have any states in the model
1530  intermediate_start_dof=(dof_idx-1)*max_number_intermediates+1
1531  intermediate_end_dof=intermediate_start_dof+number_intermediates-1
1532  parameter_start_dof=(dof_idx-1)*max_number_parameters+1
1533  parameter_end_dof=parameter_start_dof+number_parameters-1
1534 
1535  CALL cellml_model_definition_call_rhs_routine(model%PTR,0.0_dp,states,rates, &
1536  & intermediate_data(intermediate_start_dof:intermediate_end_dof),parameters_data( &
1537  & parameter_start_dof:parameter_end_dof))
1538  ELSE
1539  !We do not have any states or parameters in the model
1540  intermediate_start_dof=(dof_idx-1)*max_number_intermediates+1
1541  intermediate_end_dof=intermediate_start_dof+number_intermediates-1
1542 
1543  CALL cellml_model_definition_call_rhs_routine(model%PTR,0.0_dp,states,rates, &
1544  & intermediate_data(intermediate_start_dof:intermediate_end_dof),parameters)
1545 
1546  ENDIF
1547  ELSE
1548  CALL flagerror("Invalid CellML model - there are no states or intermediates.",err,error,*999)
1549  ENDIF
1550  ENDIF
1551 
1552 
1553  ELSE
1554  local_error="CellML environment model is not associated for model index "// &
1555  & trim(numbertovstring(only_one_model_index,"*",err,error))//" belonging to dof index "// &
1556  & trim(numbertovstring(dof_idx,"*",err,error))//"."
1557  CALL flagerror(local_error,err,error,*999)
1558  ENDIF
1559  ENDIF !model_idx
1560  ENDDO !dof_idx
1561 #else
1562  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
1563 #endif
1564 
1565  ELSE
1566  !One model is used.
1567  model=>cellml%MODELS(only_one_model_index)%PTR
1568  IF(ASSOCIATED(model)) THEN
1569  number_states=model%NUMBER_OF_STATE
1570  number_intermediates=model%NUMBER_OF_INTERMEDIATE
1571  number_parameters=model%NUMBER_OF_PARAMETERS
1572 #ifdef WITH_CELLML
1573  !Call RHS. Note some models might not have state, rates, intermediate or parameter data so call accordingly
1574  !to avoid referencing null pointers
1575  IF(number_states>0) THEN
1576  IF(number_intermediates>0) THEN
1577  IF(number_parameters>0) THEN
1578  !We have states, intermediate and parameters for the model
1579  DO dof_idx=1,n
1580  model_idx=models_data(dof_idx)
1581  IF(model_idx.GT.0) THEN
1582  state_start_dof=(dof_idx-1)*max_number_states+1
1583  state_end_dof=state_start_dof+number_states-1
1584  intermediate_start_dof=(dof_idx-1)*max_number_intermediates+1
1585  intermediate_end_dof=intermediate_start_dof+number_intermediates-1
1586  parameter_start_dof=(dof_idx-1)*max_number_parameters+1
1587  parameter_end_dof=parameter_start_dof+number_parameters-1
1588 
1589  CALL cellml_model_definition_call_rhs_routine(model%PTR,0.0_dp, &
1590  & state_data(state_start_dof:state_end_dof), &
1591  & rates,intermediate_data(intermediate_start_dof:intermediate_end_dof),parameters_data( &
1592  & parameter_start_dof:parameter_end_dof))
1593  ENDIF !model_idx
1594  ENDDO !dof_idx
1595  ELSE
1596  !We do not have parameters in the model
1597  DO dof_idx=1,n
1598  model_idx=models_data(dof_idx)
1599  IF(model_idx.GT.0) THEN
1600  state_start_dof=(dof_idx-1)*max_number_states+1
1601  state_end_dof=state_start_dof+number_states-1
1602  intermediate_start_dof=(dof_idx-1)*max_number_intermediates+1
1603  intermediate_end_dof=intermediate_start_dof+number_intermediates-1
1604 
1605  CALL cellml_model_definition_call_rhs_routine(model%PTR,0.0_dp, &
1606  & state_data(state_start_dof:state_end_dof), &
1607  & rates,intermediate_data(intermediate_start_dof:intermediate_end_dof),parameters)
1608  ENDIF !model_idx
1609  ENDDO !dof_idx
1610 
1611  ENDIF
1612  ELSE
1613  IF(number_parameters>0) THEN
1614  !We do not have any intermediates in the model
1615  DO dof_idx=1,n
1616  model_idx=models_data(dof_idx)
1617  IF(model_idx.GT.0) THEN
1618 
1619  state_start_dof=(dof_idx-1)*max_number_states+1
1620  state_end_dof=state_start_dof+number_states-1
1621  parameter_start_dof=(dof_idx-1)*max_number_parameters+1
1622  parameter_end_dof=parameter_start_dof+number_parameters-1
1623 
1624  CALL cellml_model_definition_call_rhs_routine(model%PTR,0.0_dp, &
1625  & state_data(state_start_dof:state_end_dof), &
1626  & rates,intermediates,parameters_data(parameter_start_dof:parameter_end_dof))
1627  ENDIF !model_idx
1628  ENDDO !dof_idx
1629  ELSE
1630  !We do not have any intermediates or parameters in the model
1631  DO dof_idx=1,n
1632  model_idx=models_data(dof_idx)
1633  IF(model_idx.GT.0) THEN
1634 
1635  state_start_dof=(dof_idx-1)*max_number_states+1
1636  state_end_dof=state_start_dof+number_states-1
1637 
1638  CALL cellml_model_definition_call_rhs_routine(model%PTR,0.0_dp,&
1639  & state_data(state_start_dof:state_end_dof), &
1640  & rates,intermediates,parameters)
1641  ENDIF !model_idx
1642  ENDDO !dof_idx
1643  ENDIF
1644  ENDIF
1645  ELSE
1646  IF(number_intermediates>0) THEN
1647  IF(number_parameters>0) THEN
1648  !We do not have any states in the model
1649  DO dof_idx=1,n
1650  model_idx=models_data(dof_idx)
1651  IF(model_idx.GT.0) THEN
1652 
1653  intermediate_start_dof=(dof_idx-1)*max_number_intermediates+1
1654  intermediate_end_dof=intermediate_start_dof+number_intermediates-1
1655  parameter_start_dof=(dof_idx-1)*max_number_parameters+1
1656  parameter_end_dof=parameter_start_dof+number_parameters-1
1657 
1658  CALL cellml_model_definition_call_rhs_routine(model%PTR,0.0_dp,states,rates, &
1659  & intermediate_data(intermediate_start_dof:intermediate_end_dof),parameters_data( &
1660  & parameter_start_dof:parameter_end_dof))
1661  ENDIF !model_idx
1662  ENDDO !dof_idx
1663  ELSE
1664  !We do not have any states or parameters the model
1665  DO dof_idx=1,n
1666  model_idx=models_data(dof_idx)
1667  IF(model_idx.GT.0) THEN
1668 
1669  intermediate_start_dof=(dof_idx-1)*max_number_intermediates+1
1670  intermediate_end_dof=intermediate_start_dof+number_intermediates-1
1671 
1672  CALL cellml_model_definition_call_rhs_routine(model%PTR,0.0_dp,states,rates, &
1673  & intermediate_data(intermediate_start_dof:intermediate_end_dof),parameters)
1674  ENDIF !model_idx
1675  ENDDO !dof_idx
1676  ENDIF
1677  ELSE
1678  CALL flagerror("Invalid CellML model - there are no states or intermediates.",err,error,*999)
1679  ENDIF
1680  ENDIF
1681 #else
1682  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
1683 #endif
1684  ELSE
1685  local_error="CellML environment model is not associated for model index "// &
1686  & trim(numbertovstring(only_one_model_index,"*",err,error))//"."
1687  CALL flagerror(local_error,err,error,*999)
1688  ENDIF
1689  ENDIF
1690  ENDIF
1691  ELSE
1692  CALL flagerror("CellML environment models field is not associated.",err,error,*999)
1693  ENDIF
1694  ELSE
1695  CALL flagerror("CellML environment is not associated.",err,error,*999)
1696  ENDIF
1697  ELSE
1698  CALL flagerror("CellML evaluator solver is not associated.",err,error,*999)
1699  ENDIF
1700 
1701  exits("SOLVER_CELLML_EVALUATE")
1702  RETURN
1703 999 errorsexits("SOLVER_CELLML_EVALUATE",err,error)
1704  RETURN 1
1705 
1706  END SUBROUTINE solver_cellml_evaluate
1707 
1708  !
1709  !================================================================================================================================
1710  !
1711 
1713  SUBROUTINE solver_create_finish(SOLVER,ERR,ERROR,*)
1714 
1715  !Argument variables
1716  TYPE(solver_type), POINTER :: SOLVER
1717  INTEGER(INTG), INTENT(OUT) :: ERR
1718  TYPE(varying_string), INTENT(OUT) :: ERROR
1719  !Local Variables
1720  INTEGER(INTG) :: solver_idx
1721 
1722  enters("SOLVER_CREATE_FINISH",err,error,*999)
1723 
1724  IF(ASSOCIATED(solver)) THEN
1725  IF(solver%SOLVER_FINISHED) THEN
1726  CALL flagerror("Solver has already been finished.",err,error,*999)
1727  ELSE
1728  !Set the finished flag. The final solver finish will be done once the solver equations have been finished.
1729  DO solver_idx=1,solver%NUMBER_OF_LINKED_SOLVERS
1730  solver%LINKED_SOLVERS(solver_idx)%PTR%SOLVER_FINISHED=.true.
1731  ENDDO !solver_idx
1732 
1733  solver%SOLVER_FINISHED=.true.
1734  ENDIF
1735  ELSE
1736  CALL flagerror("Solver is not associated.",err,error,*999)
1737  ENDIF
1738 
1739  exits("SOLVER_CREATE_FINISH")
1740  RETURN
1741 999 errorsexits("SOLVER_CREATE_FINISH",err,error)
1742  RETURN 1
1743 
1744  END SUBROUTINE solver_create_finish
1745 
1746  !
1747  !================================================================================================================================
1748  !
1749 
1751  SUBROUTINE solver_dae_adams_moulton_finalise(ADAMS_MOULTON_SOLVER,ERR,ERROR,*)
1752 
1753  !Argument variables
1754  TYPE(adams_moulton_dae_solver_type), POINTER :: ADAMS_MOULTON_SOLVER
1755  INTEGER(INTG), INTENT(OUT) :: ERR
1756  TYPE(varying_string), INTENT(OUT) :: ERROR
1757  !Local Variables
1758 
1759  enters("SOLVER_DAE_ADAMS_MOULTON_FINALISE",err,error,*999)
1760 
1761  IF(ASSOCIATED(adams_moulton_solver)) THEN
1762  DEALLOCATE(adams_moulton_solver)
1763  ENDIF
1764 
1765  exits("SOLVER_DAE_ADAMS_MOULTON_FINALISE")
1766  RETURN
1767 999 errorsexits("SOLVER_DAE_ADAMS_MOULTON_FINALISE",err,error)
1768  RETURN 1
1769 
1770  END SUBROUTINE solver_dae_adams_moulton_finalise
1771 
1772  !
1773  !================================================================================================================================
1774  !
1775 
1777  SUBROUTINE solver_dae_adams_moulton_initialise(DAE_SOLVER,ERR,ERROR,*)
1778 
1779  !Argument variables
1780  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
1781  INTEGER(INTG), INTENT(OUT) :: ERR
1782  TYPE(varying_string), INTENT(OUT) :: ERROR
1783  !Local Variables
1784  INTEGER(INTG) :: DUMMY_ERR
1785  TYPE(varying_string) :: DUMMY_ERROR
1786 
1787  enters("SOLVER_DAE_ADAMS_MOULTON_INITIALISE",err,error,*998)
1788 
1789  IF(ASSOCIATED(dae_solver)) THEN
1790  IF(ASSOCIATED(dae_solver%ADAMS_MOULTON_SOLVER)) THEN
1791  CALL flagerror("Adams-Moulton solver is already associated for this differential-algebraic equation solver.", &
1792  & err,error,*998)
1793  ELSE
1794  !Allocate the Adams-Moulton solver
1795  ALLOCATE(dae_solver%ADAMS_MOULTON_SOLVER,stat=err)
1796  IF(err/=0) CALL flagerror("Could not allocate Adams-Moulton solver.",err,error,*999)
1797  !Initialise
1798  dae_solver%ADAMS_MOULTON_SOLVER%DAE_SOLVER=>dae_solver
1799  dae_solver%ADAMS_MOULTON_SOLVER%SOLVER_LIBRARY=0
1800  !Defaults
1801  ENDIF
1802  ELSE
1803  CALL flagerror("Differential-algebraic equation solver is not associated.",err,error,*998)
1804  ENDIF
1805 
1806  exits("SOLVER_DAE_ADAMS_MOULTON_INITIALISE")
1807  RETURN
1808 999 CALL solver_dae_adams_moulton_finalise(dae_solver%ADAMS_MOULTON_SOLVER,dummy_err,dummy_error,*998)
1809 998 errorsexits("SOLVER_DAE_ADAMS_MOULTON_INITIALISE",err,error)
1810  RETURN 1
1811 
1812  END SUBROUTINE solver_dae_adams_moulton_initialise
1813 
1814  !
1815  !================================================================================================================================
1816  !
1817 
1819  SUBROUTINE solver_dae_adams_moulton_solve(ADAMS_MOULTON_SOLVER,ERR,ERROR,*)
1820 
1821  !Argument variables
1822  TYPE(adams_moulton_dae_solver_type), POINTER :: ADAMS_MOULTON_SOLVER
1823  INTEGER(INTG), INTENT(OUT) :: ERR
1824  TYPE(varying_string), INTENT(OUT) :: ERROR
1825  !Local Variables
1826 
1827  enters("SOLVER_DAE_ADAMS_MOULTON_SOLVE",err,error,*999)
1828 
1829  IF(ASSOCIATED(adams_moulton_solver)) THEN
1830  CALL flagerror("Not implemented.",err,error,*999)
1831  ELSE
1832  CALL flagerror("Adams-Moulton differential-algebraic equation solver is not associated.",err,error,*999)
1833  ENDIF
1834 
1835  exits("SOLVER_DAE_ADAMS_MOULTON_SOLVE")
1836  RETURN
1837 999 errorsexits("SOLVER_DAE_ADAMS_MOULTON_SOLVE",err,error)
1838  RETURN 1
1839 
1840  END SUBROUTINE solver_dae_adams_moulton_solve
1841 
1842  !
1843  !================================================================================================================================
1844  !
1845 
1847  SUBROUTINE solver_dae_create_finish(DAE_SOLVER,ERR,ERROR,*)
1848 
1849  !Argument variables
1850  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
1851  INTEGER(INTG), INTENT(OUT) :: ERR
1852  TYPE(varying_string), INTENT(OUT) :: ERROR
1853  !Local Variables
1854 
1855  enters("SOLVER_DAE_CREATE_FINISH",err,error,*999)
1856 
1857  IF(ASSOCIATED(dae_solver)) THEN
1858  CALL flagerror("Not implemented.",err,error,*999)
1859  ELSE
1860  CALL flagerror("Differential-algebraic equation solver is not associated.",err,error,*999)
1861  ENDIF
1862 
1863  exits("SOLVER_DAE_CREATE_FINISH")
1864  RETURN
1865 999 errorsexits("SOLVER_DAE_CREATE_FINISH",err,error)
1866  RETURN 1
1867 
1868  END SUBROUTINE solver_dae_create_finish
1869 
1870  !
1871  !================================================================================================================================
1872  !
1873 
1875  SUBROUTINE solver_dae_euler_backward_finalise(BACKWARD_EULER_SOLVER,ERR,ERROR,*)
1876 
1877  !Argument variables
1878  TYPE(backward_euler_dae_solver_type), POINTER :: BACKWARD_EULER_SOLVER
1879  INTEGER(INTG), INTENT(OUT) :: ERR
1880  TYPE(varying_string), INTENT(OUT) :: ERROR
1881  !Local Variables
1882 
1883  enters("SOLVER_DAE_EULER_BACKWARD_FINALISE",err,error,*999)
1884 
1885  IF(ASSOCIATED(backward_euler_solver)) THEN
1886  DEALLOCATE(backward_euler_solver)
1887  ENDIF
1888 
1889  exits("SOLVER_DAE_EULER_BACKWARD_FINALISE")
1890  RETURN
1891 999 errorsexits("SOLVER_DAE_EULER_BACKWARD_FINALISE",err,error)
1892  RETURN 1
1893 
1894  END SUBROUTINE solver_dae_euler_backward_finalise
1895 
1896  !
1897  !================================================================================================================================
1898  !
1899 
1901  SUBROUTINE solver_dae_euler_backward_initialise(EULER_DAE_SOLVER,ERR,ERROR,*)
1902 
1903  !Argument variables
1904  TYPE(euler_dae_solver_type), POINTER :: EULER_DAE_SOLVER
1905  INTEGER(INTG), INTENT(OUT) :: ERR
1906  TYPE(varying_string), INTENT(OUT) :: ERROR
1907  !Local Variables
1908  INTEGER(INTG) :: DUMMY_ERR
1909  TYPE(varying_string) :: DUMMY_ERROR
1910 
1911  enters("SOLVER_DAE_EULER_BACKWARD_INITIALISE",err,error,*998)
1912 
1913  IF(ASSOCIATED(euler_dae_solver)) THEN
1914  IF(ASSOCIATED(euler_dae_solver%BACKWARD_EULER_SOLVER)) THEN
1915  CALL flagerror("Backward Euler solver is already associated for this Euler differential-algebraic equation solver.", &
1916  & err,error,*998)
1917  ELSE
1918  !Allocate the backward Euler solver
1919  ALLOCATE(euler_dae_solver%BACKWARD_EULER_SOLVER,stat=err)
1920  IF(err/=0) CALL flagerror("Could not allocate backward Euler solver.",err,error,*999)
1921  !Initialise
1922  euler_dae_solver%BACKWARD_EULER_SOLVER%EULER_DAE_SOLVER=>euler_dae_solver
1923  euler_dae_solver%BACKWARD_EULER_SOLVER%SOLVER_LIBRARY=0
1924  !Defaults
1925  ENDIF
1926  ELSE
1927  CALL flagerror("Euler differential-algebraic equation solver is not associated.",err,error,*998)
1928  ENDIF
1929 
1930  exits("SOLVER_DAE_EULER_BACKWARD_INITIALISE")
1931  RETURN
1932 999 CALL solver_dae_euler_backward_finalise(euler_dae_solver%BACKWARD_EULER_SOLVER,dummy_err,dummy_error,*998)
1933 998 errorsexits("SOLVER_DAE_EULER_BACKWARD_INITIALISE",err,error)
1934  RETURN 1
1935 
1936  END SUBROUTINE solver_dae_euler_backward_initialise
1937 
1938  !
1939  !================================================================================================================================
1940  !
1941 
1943  SUBROUTINE solver_dae_euler_backward_solve(BACKWARD_EULER_SOLVER,ERR,ERROR,*)
1944 
1945  !Argument variables
1946  TYPE(backward_euler_dae_solver_type), POINTER :: BACKWARD_EULER_SOLVER
1947  INTEGER(INTG), INTENT(OUT) :: ERR
1948  TYPE(varying_string), INTENT(OUT) :: ERROR
1949  !Local Variables
1950 
1951  enters("SOLVER_DAE_EULER_BACKWARD_SOLVE",err,error,*999)
1952 
1953  IF(ASSOCIATED(backward_euler_solver)) THEN
1954  CALL flagerror("Not implemented.",err,error,*999)
1955  ELSE
1956  CALL flagerror("Backward Euler differential-algebraic equation solver is not associated.",err,error,*999)
1957  ENDIF
1958 
1959  exits("SOLVER_DAE_EULER_BACKWARD_SOLVE")
1960  RETURN
1961 999 errorsexits("SOLVER_DAE_EULER_BACKWARD_SOLVE",err,error)
1962  RETURN 1
1963 
1964  END SUBROUTINE solver_dae_euler_backward_solve
1965 
1966  !
1967  !================================================================================================================================
1968  !
1969 
1971  SUBROUTINE solver_dae_euler_finalise(EULER_SOLVER,ERR,ERROR,*)
1972 
1973  !Argument variables
1974  TYPE(euler_dae_solver_type), POINTER :: EULER_SOLVER
1975  INTEGER(INTG), INTENT(OUT) :: ERR
1976  TYPE(varying_string), INTENT(OUT) :: ERROR
1977  !Local Variables
1978 
1979  enters("SOLVER_DAE_EULER_FINALISE",err,error,*999)
1980 
1981  IF(ASSOCIATED(euler_solver)) THEN
1982  CALL solver_dae_euler_forward_finalise(euler_solver%FORWARD_EULER_SOLVER,err,error,*999)
1983  CALL solver_dae_euler_backward_finalise(euler_solver%BACKWARD_EULER_SOLVER,err,error,*999)
1984  CALL solver_dae_euler_improved_finalise(euler_solver%IMPROVED_EULER_SOLVER,err,error,*999)
1985  DEALLOCATE(euler_solver)
1986  ENDIF
1987 
1988  exits("SOLVER_DAE_EULER_FINALISE")
1989  RETURN
1990 999 errorsexits("SOLVER_DAE_EULER_FINALISE",err,error)
1991  RETURN 1
1992 
1993  END SUBROUTINE solver_dae_euler_finalise
1994 
1995  !
1996  !================================================================================================================================
1997  !
1998 
2000  SUBROUTINE solver_dae_euler_forward_finalise(FORWARD_EULER_SOLVER,ERR,ERROR,*)
2001 
2002  !Argument variables
2003  TYPE(forward_euler_dae_solver_type), POINTER :: FORWARD_EULER_SOLVER
2004  INTEGER(INTG), INTENT(OUT) :: ERR
2005  TYPE(varying_string), INTENT(OUT) :: ERROR
2006  !Local Variables
2007 
2008  enters("SOLVER_DAE_EULER_FORWARD_FINALISE",err,error,*999)
2009 
2010  IF(ASSOCIATED(forward_euler_solver)) THEN
2011  DEALLOCATE(forward_euler_solver)
2012  ENDIF
2013 
2014  exits("SOLVER_DAE_EULER_FORWARD_FINALISE")
2015  RETURN
2016 999 errorsexits("SOLVER_DAE_EULER_FORWARD_FINALISE",err,error)
2017  RETURN 1
2018 
2019  END SUBROUTINE solver_dae_euler_forward_finalise
2020 
2021  !
2022  !================================================================================================================================
2023  !
2024 
2026  SUBROUTINE solver_dae_euler_forward_initialise(EULER_DAE_SOLVER,ERR,ERROR,*)
2027 
2028  !Argument variables
2029  TYPE(euler_dae_solver_type), POINTER :: EULER_DAE_SOLVER
2030  INTEGER(INTG), INTENT(OUT) :: ERR
2031  TYPE(varying_string), INTENT(OUT) :: ERROR
2032  !Local Variables
2033  INTEGER(INTG) :: DUMMY_ERR
2034  TYPE(varying_string) :: DUMMY_ERROR
2035 
2036  enters("SOLVER_DAE_EULER_FORWARD_INITIALISE",err,error,*998)
2037 
2038  IF(ASSOCIATED(euler_dae_solver)) THEN
2039  IF(ASSOCIATED(euler_dae_solver%FORWARD_EULER_SOLVER)) THEN
2040  CALL flagerror("Forward Euler solver is already associated for this Euler differential-algebraic equation solver.", &
2041  & err,error,*998)
2042  ELSE
2043  !Allocate the forward Euler solver
2044  ALLOCATE(euler_dae_solver%FORWARD_EULER_SOLVER,stat=err)
2045  IF(err/=0) CALL flagerror("Could not allocate forward Euler solver.",err,error,*999)
2046  !Initialise
2047  euler_dae_solver%FORWARD_EULER_SOLVER%EULER_DAE_SOLVER=>euler_dae_solver
2048  euler_dae_solver%FORWARD_EULER_SOLVER%SOLVER_LIBRARY=solver_cmiss_library
2049  !Defaults
2050  ENDIF
2051  ELSE
2052  CALL flagerror("Euler differential-algebraic equation solver is not associated.",err,error,*998)
2053  ENDIF
2054 
2055  exits("SOLVER_DAE_EULER_FORWARD_INITIALISE")
2056  RETURN
2057 999 CALL solver_dae_euler_forward_finalise(euler_dae_solver%FORWARD_EULER_SOLVER,dummy_err,dummy_error,*998)
2058 998 errorsexits("SOLVER_DAE_EULER_FORWARD_INITIALISE",err,error)
2059  RETURN 1
2060 
2061  END SUBROUTINE solver_dae_euler_forward_initialise
2062 
2063  !
2064  !================================================================================================================================
2065  !
2066 
2068  SUBROUTINE solver_dae_euler_forward_integrate(FORWARD_EULER_SOLVER,CELLML,N,START_TIME,END_TIME,TIME_INCREMENT, &
2069  & only_one_model_index,models_data,max_number_states,state_data,max_number_parameters,parameters_data, &
2070  & max_number_intermediates,intermediate_data,err,error,*)
2071 
2072  !Argument variables
2073  TYPE(forward_euler_dae_solver_type), POINTER :: FORWARD_EULER_SOLVER
2074  TYPE(cellml_type), POINTER :: CELLML
2075  INTEGER(INTG), INTENT(IN) :: N
2076  REAL(DP), INTENT(IN) :: START_TIME
2077  REAL(DP), INTENT(IN) :: END_TIME
2078  REAL(DP), INTENT(INOUT) :: TIME_INCREMENT
2079  INTEGER(INTG), INTENT(IN) :: ONLY_ONE_MODEL_INDEX
2080  INTEGER(INTG), POINTER :: MODELS_DATA(:)
2081  INTEGER(INTG), INTENT(IN) :: MAX_NUMBER_STATES
2082  REAL(DP), POINTER :: STATE_DATA(:)
2083  INTEGER(INTG), INTENT(IN) :: MAX_NUMBER_PARAMETERS
2084  REAL(DP), POINTER :: PARAMETERS_DATA(:)
2085  INTEGER(INTG), INTENT(IN) :: MAX_NUMBER_INTERMEDIATES
2086  REAL(DP), POINTER :: INTERMEDIATE_DATA(:)
2087  INTEGER(INTG), INTENT(OUT) :: ERR
2088  TYPE(varying_string), INTENT(OUT) :: ERROR
2089  !Local Variables
2090  INTEGER(INTG) :: dof_idx,DOF_ORDER_TYPE,INTERMEDIATE_END_DOF,intermediate_idx,INTERMEDIATE_START_DOF,model_idx, &
2091  & NUMBER_INTERMEDIATES,NUMBER_PARAMETERS,NUMBER_STATES,PARAMETER_END_DOF,parameter_idx,PARAMETER_START_DOF, &
2092  & STATE_END_DOF,state_idx,STATE_START_DOF
2093  REAL(DP) :: INTERMEDIATES(max(1,max_number_intermediates)),PARAMETERS(max(1,max_number_parameters)), &
2094  & RATES(MAX(1,MAX_NUMBER_STATES)),STATES(MAX(1,MAX_NUMBER_STATES)),TIME
2095  TYPE(cellml_model_type), POINTER :: MODEL
2096  TYPE(varying_string) :: LOCAL_ERROR
2097 
2098  enters("SOLVER_DAE_EULER_FORWARD_INTEGRATE",err,error,*999)
2099 
2100  IF(ASSOCIATED(forward_euler_solver)) THEN
2101  IF(ASSOCIATED(cellml)) THEN
2102  IF(ASSOCIATED(cellml%MODELS_FIELD)) THEN
2103  CALL field_dof_order_type_get(cellml%MODELS_FIELD%MODELS_FIELD,field_u_variable_type,dof_order_type,err,error,*999)
2104  IF(dof_order_type==field_separated_component_dof_order) THEN
2105  !Dof components are separated. Will need to copy data to temporary arrays.
2106  IF(only_one_model_index==cellml_models_field_not_constant) THEN
2107  !Mulitple models
2108  DO WHILE(time<=end_time)
2109  DO dof_idx=1,n
2110  model_idx=models_data(dof_idx)
2111  IF(model_idx.GT.0) THEN
2112  model=>cellml%MODELS(model_idx)%PTR
2113  IF(ASSOCIATED(model)) THEN
2114  number_states=model%NUMBER_OF_STATE
2115  number_intermediates=model%NUMBER_OF_INTERMEDIATE
2116  number_parameters=model%NUMBER_OF_PARAMETERS
2117 
2118  !Copy CellML data to temporary arrays
2119  DO state_idx=1,number_states
2120  states(state_idx)=state_data((dof_idx-1)*n+state_idx)
2121  ENDDO !state_idx
2122  DO parameter_idx=1,number_parameters
2123  parameters(parameter_idx)=parameters_data((dof_idx-1)*n+parameter_idx)
2124  ENDDO !parameter_idx
2125 
2126 #ifdef WITH_CELLML
2127  CALL cellml_model_definition_call_rhs_routine(model%PTR,time,states,rates,intermediates, &
2128  & parameters)
2129 #else
2130  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
2131 #endif
2132 
2133  !Copy temporary data back to CellML arrays
2134  DO intermediate_idx=1,number_intermediates
2135  intermediate_data((dof_idx-1)*n+intermediate_idx)=intermediates(intermediate_idx)
2136  ENDDO !intermediate_idx
2137  DO state_idx=1,number_states
2138  state_data((dof_idx-1)*n+state_idx)=states(state_idx)+time_increment*rates(state_idx)
2139  ENDDO !state_idx
2140 
2141  ELSE
2142  local_error="CellML environment model is not associated for model index "// &
2143  & trim(numbertovstring(only_one_model_index,"*",err,error))//" belonging to dof index "// &
2144  & trim(numbertovstring(dof_idx,"*",err,error))//"."
2145  CALL flagerror(local_error,err,error,*999)
2146  ENDIF
2147  ENDIF !model_idx
2148  ENDDO !dof_idx
2149  time=time+time_increment
2150  ENDDO !time
2151  ELSE
2152  !One one model is used.
2153  model=>cellml%MODELS(only_one_model_index)%PTR
2154  IF(ASSOCIATED(model)) THEN
2155  number_states=model%NUMBER_OF_STATE
2156  number_intermediates=model%NUMBER_OF_INTERMEDIATE
2157  number_parameters=model%NUMBER_OF_PARAMETERS
2158  time=start_time
2159  DO WHILE(time<=end_time)
2160  DO dof_idx=1,n
2161 
2162  model_idx=models_data(dof_idx)
2163  IF(model_idx.GT.0) THEN
2164  !Copy CellML data to temporary arrays
2165  DO state_idx=1,number_states
2166  states(state_idx)=state_data((dof_idx-1)*n+state_idx)
2167  ENDDO !state_idx
2168  DO parameter_idx=1,number_parameters
2169  parameters(parameter_idx)=parameters_data((dof_idx-1)*n+parameter_idx)
2170  ENDDO !parameter_idx
2171 
2172 #ifdef WITH_CELLML
2173  CALL cellml_model_definition_call_rhs_routine(model%PTR,time,states,rates,intermediates, &
2174  & parameters)
2175 #else
2176  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
2177 #endif
2178 
2179  !Copy temporary data back to CellML arrays
2180  DO intermediate_idx=1,number_intermediates
2181  intermediate_data((dof_idx-1)*n+intermediate_idx)=intermediates(intermediate_idx)
2182  ENDDO !intermediate_idx
2183  DO state_idx=1,number_states
2184  state_data((dof_idx-1)*n+state_idx)=states(state_idx)+time_increment*rates(state_idx)
2185  ENDDO !state_idx
2186  ENDIF !model_idx
2187  ENDDO !dof_idx
2188  time=time+time_increment
2189  ENDDO !time
2190  ELSE
2191  local_error="CellML environment model is not associated for model index "// &
2192  & trim(numbertovstring(only_one_model_index,"*",err,error))//"."
2193  CALL flagerror(local_error,err,error,*999)
2194  ENDIF
2195  ENDIF
2196  ELSE
2197  !Dof components are continguous. Can pass data directly.
2198  IF(only_one_model_index==cellml_models_field_not_constant) THEN
2199  !Mulitple models
2200  time=start_time
2201  DO WHILE(time<=end_time)
2202  DO dof_idx=1,n
2203  model_idx=models_data(dof_idx)
2204  IF(model_idx==0) THEN
2205  ! Do nothing- empty model index specified
2206  ELSE IF(model_idx > 0 .AND. model_idx <= cellml%NUMBER_OF_MODELS) THEN
2207  model=>cellml%MODELS(model_idx)%PTR
2208  IF(ASSOCIATED(model)) THEN
2209  number_states=model%NUMBER_OF_STATE
2210  number_intermediates=model%NUMBER_OF_INTERMEDIATE
2211  number_parameters=model%NUMBER_OF_PARAMETERS
2212 
2213 #ifdef WITH_CELLML
2214  !Call RHS. Note some models might not have state, rates, intermediate or parameter data so call accordingly
2215  !to avoid referencing null pointers
2216  IF(number_states>0) THEN
2217  IF(number_intermediates>0) THEN
2218  IF(number_parameters>0) THEN
2219  !We have states, intermediate and parameters for the model
2220 
2221  state_start_dof=(dof_idx-1)*max_number_states+1
2222  state_end_dof=state_start_dof+number_states-1
2223  intermediate_start_dof=(dof_idx-1)*max_number_intermediates+1
2224  intermediate_end_dof=intermediate_start_dof+number_intermediates-1
2225  parameter_start_dof=(dof_idx-1)*max_number_parameters+1
2226  parameter_end_dof=parameter_start_dof+number_parameters-1
2227 
2228  CALL cellml_model_definition_call_rhs_routine(model%PTR,time,state_data(state_start_dof: &
2229  & state_end_dof),rates,intermediate_data(intermediate_start_dof:intermediate_end_dof), &
2230  & parameters_data(parameter_start_dof:parameter_end_dof))
2231 
2232  ELSE
2233  !We do not have parameters in the model
2234 
2235  state_start_dof=(dof_idx-1)*max_number_states+1
2236  state_end_dof=state_start_dof+number_states-1
2237  intermediate_start_dof=(dof_idx-1)*max_number_intermediates+1
2238  intermediate_end_dof=intermediate_start_dof+number_intermediates-1
2239 
2240  CALL cellml_model_definition_call_rhs_routine(model%PTR,time,state_data(state_start_dof: &
2241  & state_end_dof),rates,intermediate_data(intermediate_start_dof:intermediate_end_dof), &
2242  & parameters)
2243 
2244  ENDIF
2245  ELSE
2246  IF(number_parameters>0) THEN
2247  !We do not have intermediates in the model
2248  state_start_dof=(dof_idx-1)*max_number_states+1
2249  state_end_dof=state_start_dof+number_states-1
2250  parameter_start_dof=(dof_idx-1)*max_number_parameters+1
2251  parameter_end_dof=parameter_start_dof+number_parameters-1
2252 
2253  CALL cellml_model_definition_call_rhs_routine(model%PTR,time,state_data(state_start_dof: &
2254  & state_end_dof),rates,intermediates,parameters_data(parameter_start_dof:parameter_end_dof))
2255 
2256  ELSE
2257  !We do not have intermediates or parameters in the model
2258  state_start_dof=(dof_idx-1)*max_number_states+1
2259  state_end_dof=state_start_dof+number_states-1
2260 
2261  CALL cellml_model_definition_call_rhs_routine(model%PTR,time,state_data(state_start_dof: &
2262  & state_end_dof),rates,intermediates,parameters)
2263 
2264  ENDIF
2265  ENDIF
2266  ELSE
2267  CALL flagerror("Invalid CellML model for integration - there are no states.",err,error,*999)
2268  ENDIF
2269 
2270 #else
2271  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
2272 #endif
2273  state_data(state_start_dof:state_end_dof)=state_data(state_start_dof:state_end_dof)+ &
2274  & time_increment*rates(1:number_states)
2275  ELSE
2276  local_error="CellML environment model is not associated for model index "// &
2277  & trim(numbertovstring(only_one_model_index,"*",err,error))//" belonging to dof index "// &
2278  & trim(numbertovstring(dof_idx,"*",err,error))//"."
2279  CALL flagerror(local_error,err,error,*999)
2280  ENDIF
2281  ELSE
2282  local_error="Invalid CellML model index: "// &
2283  & trim(numbertovstring(model_idx,"*",err,error))//". The specified index should be between 1 and "// &
2284  & trim(numbertovstring(cellml%NUMBER_OF_MODELS,"*",err,error))//"."
2285  CALL flagerror(local_error,err,error,*999)
2286  ENDIF
2287  ENDDO !dof_idx
2288  time=time+time_increment
2289  ENDDO !time
2290  ELSE
2291  !One one model is used.
2292  model=>cellml%MODELS(only_one_model_index)%PTR
2293  IF(ASSOCIATED(model)) THEN
2294  number_states=model%NUMBER_OF_STATE
2295  number_intermediates=model%NUMBER_OF_INTERMEDIATE
2296  number_parameters=model%NUMBER_OF_PARAMETERS
2297 #ifdef WITH_CELLML
2298 
2299  !Call RHS. Note some models might not have state, rates, intermediate or parameter data so call accordingly
2300  !to avoid referencing null pointers
2301  IF(number_states>0) THEN
2302  IF(number_intermediates>0) THEN
2303  IF(number_parameters>0) THEN
2304  !We have states, intermediate and parameters for the model
2305 
2306  time=start_time
2307  DO WHILE(time<=end_time)
2308  DO dof_idx=1,n
2309  model_idx=models_data(dof_idx)
2310  IF(model_idx.GT.0) THEN
2311 
2312  state_start_dof=(dof_idx-1)*max_number_states+1
2313  state_end_dof=state_start_dof+number_states-1
2314  intermediate_start_dof=(dof_idx-1)*max_number_intermediates+1
2315  intermediate_end_dof=intermediate_start_dof+number_intermediates-1
2316  parameter_start_dof=(dof_idx-1)*max_number_parameters+1
2317  parameter_end_dof=parameter_start_dof+number_parameters-1
2318 
2319  CALL cellml_model_definition_call_rhs_routine(model%PTR,time, &
2320  & state_data(state_start_dof:state_end_dof), &
2321  & rates,intermediate_data(intermediate_start_dof:intermediate_end_dof),parameters_data( &
2322  & parameter_start_dof:parameter_end_dof))
2323 
2324  state_data(state_start_dof:state_end_dof)=state_data(state_start_dof:state_end_dof)+ &
2325  & time_increment*rates(1:number_states)
2326  ENDIF !model_idx
2327  ENDDO !dof_idx
2328  time=time+time_increment
2329  ENDDO !time
2330  ELSE
2331  !We do not have parameters in the model
2332  time=start_time
2333  DO WHILE(time<=end_time)
2334  DO dof_idx=1,n
2335  model_idx=models_data(dof_idx)
2336  IF(model_idx.GT.0) THEN
2337 
2338  state_start_dof=(dof_idx-1)*max_number_states+1
2339  state_end_dof=state_start_dof+number_states-1
2340  intermediate_start_dof=(dof_idx-1)*max_number_intermediates+1
2341  intermediate_end_dof=intermediate_start_dof+number_intermediates-1
2342 
2343  CALL cellml_model_definition_call_rhs_routine(model%PTR,time, &
2344  & state_data(state_start_dof:state_end_dof), &
2345  & rates,intermediate_data(intermediate_start_dof:intermediate_end_dof),parameters)
2346 
2347  state_data(state_start_dof:state_end_dof)=state_data(state_start_dof:state_end_dof)+ &
2348  & time_increment*rates(1:number_states)
2349  ENDIF !model_idx
2350  ENDDO !dof_idx
2351  time=time+time_increment
2352  ENDDO !time
2353  ENDIF
2354  ELSE
2355  IF(number_parameters>0) THEN
2356  !We do not have intermediates in the model
2357 
2358  time=start_time
2359  DO WHILE(time<=end_time)
2360  DO dof_idx=1,n
2361  model_idx=models_data(dof_idx)
2362  IF(model_idx.GT.0) THEN
2363 
2364  state_start_dof=(dof_idx-1)*max_number_states+1
2365  state_end_dof=state_start_dof+number_states-1
2366  parameter_start_dof=(dof_idx-1)*max_number_parameters+1
2367  parameter_end_dof=parameter_start_dof+number_parameters-1
2368 
2369  CALL cellml_model_definition_call_rhs_routine(model%PTR,time, &
2370  & state_data(state_start_dof:state_end_dof), &
2371  & rates,intermediates,parameters_data(parameter_start_dof:parameter_end_dof))
2372 
2373  state_data(state_start_dof:state_end_dof)=state_data(state_start_dof:state_end_dof)+ &
2374  & time_increment*rates(1:number_states)
2375  ENDIF !model_idx
2376  ENDDO !dof_idx
2377  time=time+time_increment
2378  ENDDO !time
2379  ELSE
2380  !We do not have intermediates or parameters in the model
2381  time=start_time
2382  DO WHILE(time<=end_time)
2383  DO dof_idx=1,n
2384  model_idx=models_data(dof_idx)
2385  IF(model_idx.GT.0) THEN
2386 
2387  state_start_dof=(dof_idx-1)*max_number_states+1
2388  state_end_dof=state_start_dof+number_states-1
2389 
2390  CALL cellml_model_definition_call_rhs_routine(model%PTR,time, &
2391  & state_data(state_start_dof:state_end_dof), &
2392  & rates,intermediates,parameters)
2393 
2394  state_data(state_start_dof:state_end_dof)=state_data(state_start_dof:state_end_dof)+ &
2395  & time_increment*rates(1:number_states)
2396  ENDIF !model_idx
2397  ENDDO !dof_idx
2398  time=time+time_increment
2399  ENDDO !time
2400  ENDIF
2401  ENDIF
2402  ELSE
2403  CALL flagerror("Invalid CellML model for integration - there are no states.",err,error,*999)
2404  ENDIF
2405 
2406 #else
2407  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
2408 #endif
2409 
2410  ELSE
2411  local_error="CellML environment model is not associated for model index "// &
2412  & trim(numbertovstring(only_one_model_index,"*",err,error))//"."
2413  CALL flagerror(local_error,err,error,*999)
2414  ENDIF
2415  ENDIF
2416  ENDIF
2417  ELSE
2418  CALL flagerror("CellML environment models field is not associated.",err,error,*999)
2419  ENDIF
2420  ELSE
2421  CALL flagerror("CellML environment is not associated.",err,error,*999)
2422  ENDIF
2423  ELSE
2424  CALL flagerror("Forward Euler solver is not associated.",err,error,*999)
2425  ENDIF
2426 
2427  exits("SOLVER_DAE_EULER_FORWARD_INTEGRATE")
2428  RETURN
2429 999 errorsexits("SOLVER_DAE_EULER_FORWARD_INTEGRATE",err,error)
2430  RETURN 1
2431 
2432  END SUBROUTINE solver_dae_euler_forward_integrate
2433 
2434  !
2435  !================================================================================================================================
2436  !
2437 
2439  SUBROUTINE solver_dae_euler_forward_solve(FORWARD_EULER_SOLVER,ERR,ERROR,*)
2440 
2441  !Argument variables
2442  TYPE(forward_euler_dae_solver_type), POINTER :: FORWARD_EULER_SOLVER
2443  INTEGER(INTG), INTENT(OUT) :: ERR
2444  TYPE(varying_string), INTENT(OUT) :: ERROR
2445  !Local Variables
2446  INTEGER(INTG) :: cellml_idx
2447  INTEGER(INTG), POINTER :: MODELS_DATA(:)
2448  REAL(DP), POINTER :: INTERMEDIATE_DATA(:),PARAMETERS_DATA(:),STATE_DATA(:)
2449  TYPE(cellml_type), POINTER :: CELLML_ENVIRONMENT
2450  TYPE(cellml_equations_type), POINTER :: CELLML_EQUATIONS
2451  TYPE(cellml_models_field_type), POINTER :: CELLML_MODELS_FIELD
2452  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
2453  TYPE(euler_dae_solver_type), POINTER :: EULER_SOLVER
2454  TYPE(field_variable_type), POINTER :: MODELS_VARIABLE
2455  TYPE(field_type), POINTER :: MODELS_FIELD,STATE_FIELD,PARAMETERS_FIELD,INTERMEDIATE_FIELD
2456  TYPE(solver_type), POINTER :: SOLVER
2457  TYPE(varying_string) :: LOCAL_ERROR
2458 
2459  enters("SOLVER_DAE_EULER_FORWARD_SOLVE",err,error,*999)
2460 
2461  NULLIFY(models_data)
2462  NULLIFY(intermediate_data)
2463  NULLIFY(parameters_data)
2464  NULLIFY(state_data)
2465  NULLIFY(models_variable)
2466  NULLIFY(models_field)
2467  NULLIFY(state_field)
2468  NULLIFY(parameters_field)
2469  NULLIFY(intermediate_field)
2470 
2471  IF(ASSOCIATED(forward_euler_solver)) THEN
2472  euler_solver=>forward_euler_solver%EULER_DAE_SOLVER
2473  IF(ASSOCIATED(euler_solver)) THEN
2474  dae_solver=>euler_solver%DAE_SOLVER
2475  IF(ASSOCIATED(dae_solver)) THEN
2476  solver=>dae_solver%SOLVER
2477  IF(ASSOCIATED(solver)) THEN
2478  cellml_equations=>solver%CELLML_EQUATIONS
2479  IF(ASSOCIATED(cellml_equations)) THEN
2480  DO cellml_idx=1,cellml_equations%NUMBER_OF_CELLML_ENVIRONMENTS
2481  cellml_environment=>cellml_equations%CELLML_ENVIRONMENTS(cellml_idx)%PTR
2482  IF(ASSOCIATED(cellml_environment)) THEN
2483  cellml_models_field=>cellml_environment%MODELS_FIELD
2484  IF(ASSOCIATED(cellml_models_field)) THEN
2485  models_field=>cellml_models_field%MODELS_FIELD
2486  IF(ASSOCIATED(models_field)) THEN
2487 
2488 !!TODO: Maybe move this getting of fields earlier up the DAE solver chain? For now keep here.
2489 
2490  !Make sure CellML fields have been updated to the current value of any mapped fields
2491  CALL cellml_field_to_cellml_update(cellml_environment,err,error,*999)
2492 
2493  CALL field_variable_get(models_field,field_u_variable_type,models_variable,err,error,*999)
2494  CALL field_parameter_set_data_get(models_field,field_u_variable_type,field_values_set_type, &
2495  & models_data,err,error,*999)
2496 
2497  !Get the state information if this environment has any.
2498  IF(ASSOCIATED(cellml_environment%STATE_FIELD)) THEN
2499  state_field=>cellml_environment%STATE_FIELD%STATE_FIELD
2500  IF(ASSOCIATED(state_field)) THEN
2501  CALL field_parameter_set_data_get(state_field,field_u_variable_type,field_values_set_type, &
2502  & state_data,err,error,*999)
2503  ENDIF
2504  ENDIF
2505 
2506  !Get the parameters information if this environment has any.
2507  IF(ASSOCIATED(cellml_environment%PARAMETERS_FIELD)) THEN
2508  parameters_field=>cellml_environment%PARAMETERS_FIELD%PARAMETERS_FIELD
2509  IF(ASSOCIATED(parameters_field)) THEN
2510  CALL field_parameter_set_data_get(parameters_field,field_u_variable_type,field_values_set_type, &
2511  & parameters_data,err,error,*999)
2512  ENDIF
2513  ENDIF
2514 
2515  !Get the intermediate information if this environment has any.
2516  IF(ASSOCIATED(cellml_environment%INTERMEDIATE_FIELD)) THEN
2517  intermediate_field=>cellml_environment%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD
2518  IF(ASSOCIATED(intermediate_field)) THEN
2519  CALL field_parameter_set_data_get(intermediate_field,field_u_variable_type,field_values_set_type, &
2520  & intermediate_data,err,error,*999)
2521  ENDIF
2522  ENDIF
2523 
2524  !Integrate these CellML equations
2525  CALL solver_dae_euler_forward_integrate(forward_euler_solver,cellml_environment,models_variable% &
2526  & total_number_of_dofs,dae_solver%START_TIME,dae_solver%END_TIME,dae_solver%INITIAL_STEP, &
2527  & cellml_environment%MODELS_FIELD%ONLY_ONE_MODEL_INDEX,models_data,cellml_environment% &
2528  & maximum_number_of_state,state_data,cellml_environment%MAXIMUM_NUMBER_OF_PARAMETERS, &
2529  & parameters_data,cellml_environment%MAXIMUM_NUMBER_OF_INTERMEDIATE,intermediate_data,err,error,*999)
2530 
2531  !Restore field data
2532  CALL field_parameter_set_data_restore(models_field,field_u_variable_type,field_values_set_type, &
2533  & models_data,err,error,*999)
2534  IF(ASSOCIATED(state_field)) CALL field_parameter_set_data_restore(state_field,field_u_variable_type, &
2535  & field_values_set_type,state_data,err,error,*999)
2536  IF(ASSOCIATED(parameters_field)) CALL field_parameter_set_data_restore(parameters_field, &
2537  & field_u_variable_type,field_values_set_type,parameters_data,err,error,*999)
2538  IF(ASSOCIATED(intermediate_field)) CALL field_parameter_set_data_restore(intermediate_field, &
2539  & field_u_variable_type,field_values_set_type,intermediate_data,err,error,*999)
2540 
2541  !Make sure fields have been updated to the current value of any mapped CellML fields
2542  CALL cellml_cellml_to_field_update(cellml_environment,err,error,*999)
2543 
2544  ELSE
2545  local_error="The CellML models field is not associated for CellML index "// &
2546  & trim(numbertovstring(cellml_idx,"*",err,error))//"."
2547  CALL flagerror(local_error,err,error,*999)
2548  ENDIF
2549  ELSE
2550  local_error="The CellML models field is not associated for CellML index "// &
2551  & trim(numbertovstring(cellml_idx,"*",err,error))//"."
2552  CALL flagerror(local_error,err,error,*999)
2553  ENDIF
2554  ELSE
2555  local_error="The CellML enviroment is not associated for for CellML index "// &
2556  & trim(numbertovstring(cellml_idx,"*",err,error))//"."
2557  CALL flagerror(local_error,err,error,*999)
2558  ENDIF
2559  ENDDO !cellml_idx
2560  ELSE
2561  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
2562  ENDIF
2563  ELSE
2564  CALL flagerror("Solver is not associated.",err,error,*999)
2565  ENDIF
2566  ELSE
2567  CALL flagerror("Differential-algebraic equation solver is not associated.",err,error,*999)
2568  ENDIF
2569  ELSE
2570  CALL flagerror("Euler differential-algebraic equation solver is not associated.",err,error,*999)
2571  ENDIF
2572  ELSE
2573  CALL flagerror("Forward Euler differential-algebraic equation solver is not associated.",err,error,*999)
2574  ENDIF
2575 
2576  exits("SOLVER_DAE_EULER_FORWARD_SOLVE")
2577  RETURN
2578 999 errorsexits("SOLVER_DAE_EULER_FORWARD_SOLVE",err,error)
2579  RETURN 1
2580 
2581  END SUBROUTINE solver_dae_euler_forward_solve
2582 
2583  !
2584  !================================================================================================================================
2585  !
2586 
2588  SUBROUTINE solver_dae_euler_improved_finalise(IMPROVED_EULER_SOLVER,ERR,ERROR,*)
2589 
2590  !Argument variables
2591  TYPE(improved_euler_dae_solver_type), POINTER :: IMPROVED_EULER_SOLVER
2592  INTEGER(INTG), INTENT(OUT) :: ERR
2593  TYPE(varying_string), INTENT(OUT) :: ERROR
2594  !Local Variables
2595 
2596  enters("SOLVER_DAE_EULER_IMPROVED_FINALISE",err,error,*999)
2597 
2598  IF(ASSOCIATED(improved_euler_solver)) THEN
2599  DEALLOCATE(improved_euler_solver)
2600  ENDIF
2601 
2602  exits("SOLVER_DAE_EULER_IMPROVED_FINALISE")
2603  RETURN
2604 999 errorsexits("SOLVER_DAE_EULER_IMPROVED_FINALISE",err,error)
2605  RETURN 1
2606 
2607  END SUBROUTINE solver_dae_euler_improved_finalise
2608 
2609  !
2610  !================================================================================================================================
2611  !
2612 
2614  SUBROUTINE solver_dae_euler_improved_initialise(EULER_DAE_SOLVER,ERR,ERROR,*)
2615 
2616  !Argument variables
2617  TYPE(euler_dae_solver_type), POINTER :: EULER_DAE_SOLVER
2618  INTEGER(INTG), INTENT(OUT) :: ERR
2619  TYPE(varying_string), INTENT(OUT) :: ERROR
2620  !Local Variables
2621  INTEGER(INTG) :: DUMMY_ERR
2622  TYPE(varying_string) :: DUMMY_ERROR
2623 
2624  enters("SOLVER_DAE_EULER_IMPROVED_INITIALISE",err,error,*998)
2625 
2626  IF(ASSOCIATED(euler_dae_solver)) THEN
2627  IF(ASSOCIATED(euler_dae_solver%IMPROVED_EULER_SOLVER)) THEN
2628  CALL flagerror("Improved Euler solver is already associated for this Euler differential-algebraic equation solver.", &
2629  & err,error,*998)
2630  ELSE
2631  !Allocate the improved Euler solver
2632  ALLOCATE(euler_dae_solver%IMPROVED_EULER_SOLVER,stat=err)
2633  IF(err/=0) CALL flagerror("Could not allocate improved Euler solver.",err,error,*999)
2634  !Initialise
2635  euler_dae_solver%IMPROVED_EULER_SOLVER%EULER_DAE_SOLVER=>euler_dae_solver
2636  euler_dae_solver%IMPROVED_EULER_SOLVER%SOLVER_LIBRARY=0
2637  !Defaults
2638  ENDIF
2639  ELSE
2640  CALL flagerror("Euler differential-algebraic equation solver is not associated.",err,error,*998)
2641  ENDIF
2642 
2643  exits("SOLVER_DAE_EULER_IMPROVED_INITIALISE")
2644  RETURN
2645 999 CALL solver_dae_euler_improved_finalise(euler_dae_solver%IMPROVED_EULER_SOLVER,dummy_err,dummy_error,*998)
2646 998 errorsexits("SOLVER_DAE_EULER_IMPROVED_INITIALISE",err,error)
2647  RETURN 1
2648 
2649  END SUBROUTINE solver_dae_euler_improved_initialise
2650 
2651  !
2652  !================================================================================================================================
2653  !
2654 
2656  SUBROUTINE solver_dae_euler_improved_solve(IMPROVED_EULER_SOLVER,ERR,ERROR,*)
2657 
2658  !Argument variables
2659  TYPE(improved_euler_dae_solver_type), POINTER :: IMPROVED_EULER_SOLVER
2660  INTEGER(INTG), INTENT(OUT) :: ERR
2661  TYPE(varying_string), INTENT(OUT) :: ERROR
2662  !Local Variables
2663 
2664  enters("SOLVER_DAE_EULER_IMPROVED_SOLVE",err,error,*999)
2665 
2666  IF(ASSOCIATED(improved_euler_solver)) THEN
2667  CALL flagerror("Not implemented.",err,error,*999)
2668  ELSE
2669  CALL flagerror("Improved Euler differential-algebraic equation solver is not associated.",err,error,*999)
2670  ENDIF
2671 
2672  exits("SOLVER_DAE_EULER_IMPROVED_SOLVE")
2673  RETURN
2674 999 errorsexits("SOLVER_DAE_EULER_IMPROVED_SOLVE",err,error)
2675  RETURN 1
2676 
2677  END SUBROUTINE solver_dae_euler_improved_solve
2678 
2679  !
2680  !================================================================================================================================
2681  !
2682 
2684  SUBROUTINE solver_dae_euler_initialise(DAE_SOLVER,ERR,ERROR,*)
2685 
2686  !Argument variables
2687  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
2688  INTEGER(INTG), INTENT(OUT) :: ERR
2689  TYPE(varying_string), INTENT(OUT) :: ERROR
2690  !Local Variables
2691  INTEGER(INTG) :: DUMMY_ERR
2692  TYPE(varying_string) :: DUMMY_ERROR
2693 
2694  enters("SOLVER_DAE_EULER_INITIALISE",err,error,*998)
2695 
2696  IF(ASSOCIATED(dae_solver)) THEN
2697  IF(ASSOCIATED(dae_solver%EULER_SOLVER)) THEN
2698  CALL flagerror("Euler solver is already associated for this differential-algebraic equation solver.",err,error,*998)
2699  ELSE
2700  !Allocate the Euler solver
2701  ALLOCATE(dae_solver%EULER_SOLVER,stat=err)
2702  IF(err/=0) CALL flagerror("Could not allocate Euler solver.",err,error,*999)
2703  !Initialise
2704  dae_solver%EULER_SOLVER%DAE_SOLVER=>dae_solver
2705  NULLIFY(dae_solver%EULER_SOLVER%FORWARD_EULER_SOLVER)
2706  NULLIFY(dae_solver%EULER_SOLVER%BACKWARD_EULER_SOLVER)
2707  NULLIFY(dae_solver%EULER_SOLVER%IMPROVED_EULER_SOLVER)
2708  !Default to a forward Euler solver
2709  CALL solver_dae_euler_forward_initialise(dae_solver%EULER_SOLVER,err,error,*999)
2710  dae_solver%EULER_SOLVER%EULER_TYPE=solver_dae_euler_forward
2711  ENDIF
2712  ELSE
2713  CALL flagerror("Differential-algebraic equation solver is not associated.",err,error,*998)
2714  ENDIF
2715 
2716  exits("SOLVER_DAE_EULER_INITIALISE")
2717  RETURN
2718 999 CALL solver_dae_euler_finalise(dae_solver%EULER_SOLVER,dummy_err,dummy_error,*998)
2719 998 errorsexits("SOLVER_DAE_EULER_INITIALISE",err,error)
2720  RETURN 1
2721 
2722  END SUBROUTINE solver_dae_euler_initialise
2723 
2724  !
2725  !================================================================================================================================
2726  !
2727 
2729  SUBROUTINE solver_dae_euler_library_type_get(EULER_DAE_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
2730 
2731  !Argument variables
2732  TYPE(euler_dae_solver_type), POINTER :: EULER_DAE_SOLVER
2733  INTEGER(INTG), INTENT(OUT) :: SOLVER_LIBRARY_TYPE
2734  INTEGER(INTG), INTENT(OUT) :: ERR
2735  TYPE(varying_string), INTENT(OUT) :: ERROR
2736  !Local Variables
2737  TYPE(backward_euler_dae_solver_type), POINTER :: BACKWARD_EULER_DAE_SOLVER
2738  TYPE(forward_euler_dae_solver_type), POINTER :: FORWARD_EULER_DAE_SOLVER
2739  TYPE(improved_euler_dae_solver_type), POINTER :: IMPROVED_EULER_DAE_SOLVER
2740  TYPE(varying_string) :: LOCAL_ERROR
2741 
2742  enters("SOLVER_DAE_EULER_LIBRARY_TYPE_GET",err,error,*999)
2743 
2744  IF(ASSOCIATED(euler_dae_solver)) THEN
2745  SELECT CASE(euler_dae_solver%EULER_TYPE)
2746  CASE(solver_dae_euler_forward)
2747  forward_euler_dae_solver=>euler_dae_solver%FORWARD_EULER_SOLVER
2748  IF(ASSOCIATED(forward_euler_dae_solver)) THEN
2749  solver_library_type=forward_euler_dae_solver%SOLVER_LIBRARY
2750  ELSE
2751  CALL flagerror("The forward Euler differntial-algebraic equations solver is not associated.",err,error,*999)
2752  ENDIF
2753  CASE(solver_dae_euler_backward)
2754  backward_euler_dae_solver=>euler_dae_solver%BACKWARD_EULER_SOLVER
2755  IF(ASSOCIATED(backward_euler_dae_solver)) THEN
2756  solver_library_type=backward_euler_dae_solver%SOLVER_LIBRARY
2757  ELSE
2758  CALL flagerror("The backward Euler differntial-algebraic equations solver is not associated.",err,error,*999)
2759  ENDIF
2760  CASE(solver_dae_euler_improved)
2761  improved_euler_dae_solver=>euler_dae_solver%IMPROVED_EULER_SOLVER
2762  IF(ASSOCIATED(improved_euler_dae_solver)) THEN
2763  solver_library_type=improved_euler_dae_solver%SOLVER_LIBRARY
2764  ELSE
2765  CALL flagerror("The improved Euler differntial-algebraic equations solver is not associated.",err,error,*999)
2766  ENDIF
2767  CASE DEFAULT
2768  local_error="The Euler differential-algebraic equations solver type of "// &
2769  & trim(numbertovstring(euler_dae_solver%EULER_TYPE,"*",err,error))//" is invalid."
2770  CALL flagerror(local_error,err,error,*999)
2771  END SELECT
2772  ELSE
2773  CALL flagerror("Euler DAE solver is not associated.",err,error,*999)
2774  ENDIF
2775 
2776  exits("SOLVER_DAE_EULER_LIBRARY_TYPE_GET")
2777  RETURN
2778 999 errorsexits("SOLVER_DAE_EULER_LIBRARY_TYPE_GET",err,error)
2779  RETURN 1
2780 
2781  END SUBROUTINE solver_dae_euler_library_type_get
2782 
2783  !
2784  !================================================================================================================================
2785  !
2786 
2788  SUBROUTINE solver_dae_euler_library_type_set(EULER_DAE_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
2789 
2790  !Argument variables
2791  TYPE(euler_dae_solver_type), POINTER :: EULER_DAE_SOLVER
2792  INTEGER(INTG), INTENT(IN) :: SOLVER_LIBRARY_TYPE
2793  INTEGER(INTG), INTENT(OUT) :: ERR
2794  TYPE(varying_string), INTENT(OUT) :: ERROR
2795  !Local Variables
2796  TYPE(backward_euler_dae_solver_type), POINTER :: BACKWARD_EULER_DAE_SOLVER
2797  TYPE(forward_euler_dae_solver_type), POINTER :: FORWARD_EULER_DAE_SOLVER
2798  TYPE(improved_euler_dae_solver_type), POINTER :: IMPROVED_EULER_DAE_SOLVER
2799  TYPE(varying_string) :: LOCAL_ERROR
2800 
2801  enters("SOLVER_DAE_EULER_LIBRARY_TYPE_SET",err,error,*999)
2802 
2803  IF(ASSOCIATED(euler_dae_solver)) THEN
2804  SELECT CASE(euler_dae_solver%EULER_TYPE)
2805  CASE(solver_dae_euler_forward)
2806  forward_euler_dae_solver=>euler_dae_solver%FORWARD_EULER_SOLVER
2807  IF(ASSOCIATED(forward_euler_dae_solver)) THEN
2808  SELECT CASE(solver_library_type)
2809  CASE(solver_cmiss_library)
2810  CALL flagerror("Not implemented.",err,error,*999)
2811  CASE(solver_petsc_library)
2812  CALL flagerror("Not implemented.",err,error,*999)
2813  CASE DEFAULT
2814  local_error="The solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
2815  & " is invalid for a forward Euler DAE solver."
2816  CALL flagerror(local_error,err,error,*999)
2817  END SELECT
2818  ELSE
2819  CALL flagerror("The forward Euler differential-algebraic equation solver is not associated.",err,error,*999)
2820  ENDIF
2821  CASE(solver_dae_euler_backward)
2822  backward_euler_dae_solver=>euler_dae_solver%BACKWARD_EULER_SOLVER
2823  IF(ASSOCIATED(backward_euler_dae_solver)) THEN
2824  SELECT CASE(solver_library_type)
2825  CASE(solver_cmiss_library)
2826  CALL flagerror("Not implemented.",err,error,*999)
2827  CASE(solver_petsc_library)
2828  CALL flagerror("Not implemented.",err,error,*999)
2829  CASE DEFAULT
2830  local_error="The solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
2831  & " is invalid for a backward Euler DAE solver."
2832  CALL flagerror(local_error,err,error,*999)
2833  END SELECT
2834  ELSE
2835  CALL flagerror("The backward Euler differential-algebraic equation solver is not associated.",err,error,*999)
2836  ENDIF
2837  CASE(solver_dae_euler_improved)
2838  improved_euler_dae_solver=>euler_dae_solver%IMPROVED_EULER_SOLVER
2839  IF(ASSOCIATED(improved_euler_dae_solver)) THEN
2840  SELECT CASE(solver_library_type)
2841  CASE(solver_cmiss_library)
2842  CALL flagerror("Not implemented.",err,error,*999)
2843  CASE(solver_petsc_library)
2844  CALL flagerror("Not implemented.",err,error,*999)
2845  CASE DEFAULT
2846  local_error="The solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
2847  & " is invalid for an improved Euler DAE solver."
2848  CALL flagerror(local_error,err,error,*999)
2849  END SELECT
2850  ELSE
2851  CALL flagerror("The improved Euler differential-algebraic equation solver is not associated.",err,error,*999)
2852  ENDIF
2853  CASE DEFAULT
2854  local_error="The Euler differential-algebraic equations solver type of "// &
2855  & trim(numbertovstring(euler_dae_solver%EULER_TYPE,"*",err,error))//" is invalid."
2856  CALL flagerror(local_error,err,error,*999)
2857  END SELECT
2858  ELSE
2859  CALL flagerror("The Euler differential-algebraic equation solver is not associated.",err,error,*999)
2860  ENDIF
2861 
2862  exits("SOLVER_DAE_EULER_LIBRARY_TYPE_SET")
2863  RETURN
2864 999 errorsexits("SOLVER_DAE_EULER_LIBRARY_TYPE_SET",err,error)
2865  RETURN 1
2866 
2867  END SUBROUTINE solver_dae_euler_library_type_set
2868 
2869  !
2870  !================================================================================================================================
2871  !
2872 
2874  SUBROUTINE solver_dae_euler_solve(EULER_SOLVER,ERR,ERROR,*)
2875 
2876  !Argument variables
2877  TYPE(euler_dae_solver_type), POINTER :: EULER_SOLVER
2878  INTEGER(INTG), INTENT(OUT) :: ERR
2879  TYPE(varying_string), INTENT(OUT) :: ERROR
2880  !Local Variables
2881  TYPE(varying_string) :: LOCAL_ERROR
2882 
2883  enters("SOLVER_DAE_EULER_SOLVE",err,error,*999)
2884 
2885  IF(ASSOCIATED(euler_solver)) THEN
2886  SELECT CASE(euler_solver%EULER_TYPE)
2887  CASE(solver_dae_euler_forward)
2888  CALL solver_dae_euler_forward_solve(euler_solver%FORWARD_EULER_SOLVER,err,error,*999)
2889  CASE(solver_dae_euler_backward)
2890  CALL solver_dae_euler_backward_solve(euler_solver%BACKWARD_EULER_SOLVER,err,error,*999)
2891  CASE(solver_dae_euler_improved)
2892  CALL solver_dae_euler_improved_solve(euler_solver%IMPROVED_EULER_SOLVER,err,error,*999)
2893  CASE DEFAULT
2894  local_error="The Euler differential-algebraic equation solver type of "// &
2895  & trim(numbertovstring(euler_solver%EULER_TYPE,"*",err,error))//" is invalid."
2896  CALL flagerror(local_error,err,error,*999)
2897  END SELECT
2898  ELSE
2899  CALL flagerror("Euler differential-algebraic equation solver is not associated.",err,error,*999)
2900  ENDIF
2901 
2902  exits("SOLVER_DAE_EULER_SOLVE")
2903  RETURN
2904 999 errorsexits("SOLVER_DAE_EULER_SOLVE",err,error)
2905  RETURN 1
2906 
2907  END SUBROUTINE solver_dae_euler_solve
2908 
2909  !
2910  !================================================================================================================================
2911  !
2912 
2914  SUBROUTINE solver_dae_euler_solver_type_get(SOLVER,DAE_EULER_TYPE,ERR,ERROR,*)
2915 
2916  !Argument variables
2917  TYPE(solver_type), POINTER :: SOLVER
2918  INTEGER(INTG), INTENT(OUT) :: DAE_EULER_TYPE
2919  INTEGER(INTG), INTENT(OUT) :: ERR
2920  TYPE(varying_string), INTENT(OUT) :: ERROR
2921  !Local Variables
2922  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
2923  TYPE(euler_dae_solver_type), POINTER :: EULER_DAE_SOLVER
2924 
2925  enters("SOLVER_DAE_EULER_SOLVER_TYPE_GET",err,error,*999)
2926 
2927  IF(ASSOCIATED(solver)) THEN
2928  IF(solver%SOLVER_FINISHED) THEN
2929  IF(solver%SOLVE_TYPE==solver_dae_type) THEN
2930  dae_solver=>solver%DAE_SOLVER
2931  IF(ASSOCIATED(dae_solver)) THEN
2932  IF(dae_solver%DAE_SOLVE_TYPE==solver_dae_euler) THEN
2933  euler_dae_solver=>dae_solver%EULER_SOLVER
2934  IF(ASSOCIATED(euler_dae_solver)) THEN
2935  dae_euler_type=euler_dae_solver%EULER_TYPE
2936  ELSE
2937  CALL flagerror("The differential-algebraic equation solver Euler solver is not associated.",err,error,*999)
2938  ENDIF
2939  ELSE
2940  CALL flagerror("The solver differential-algebraic equation solver is not an Euler differential-algebraic "// &
2941  & "equation solver.",err,error,*999)
2942  ENDIF
2943  ELSE
2944  CALL flagerror("The solver differential-algebraic equation solver is not associated.",err,error,*999)
2945  ENDIF
2946  ELSE
2947  CALL flagerror("The solver is not a differential-algebraic equation solver.",err,error,*999)
2948  ENDIF
2949  ELSE
2950  CALL flagerror("Solver has not been finished.",err,error,*999)
2951  ENDIF
2952  ELSE
2953  CALL flagerror("Solver is not associated.",err,error,*999)
2954  ENDIF
2955 
2956  exits("SOLVER_DAE_EULER_SOLVER_TYPE_GET")
2957  RETURN
2958 999 errorsexits("SOLVER_DAE_EULER_SOLVER_TYPE_GET",err,error)
2959  RETURN 1
2960 
2961  END SUBROUTINE solver_dae_euler_solver_type_get
2962 
2963  !
2964  !================================================================================================================================
2965  !
2966 
2968  SUBROUTINE solver_dae_euler_solver_type_set(SOLVER,DAE_EULER_TYPE,ERR,ERROR,*)
2969 
2970  !Argument variables
2971  TYPE(solver_type), POINTER :: SOLVER
2972  INTEGER(INTG), INTENT(IN) :: DAE_EULER_TYPE
2973  INTEGER(INTG), INTENT(OUT) :: ERR
2974  TYPE(varying_string), INTENT(OUT) :: ERROR
2975  !Local Variables
2976  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
2977  TYPE(euler_dae_solver_type), POINTER :: EULER_DAE_SOLVER
2978  TYPE(varying_string) :: LOCAL_ERROR
2979 
2980  enters("SOLVER_DAE_EULER_SOLVER_TYPE_SET",err,error,*999)
2981 
2982  IF(ASSOCIATED(solver)) THEN
2983  IF(solver%SOLVER_FINISHED) THEN
2984  CALL flagerror("Solver has already been finished.",err,error,*999)
2985  ELSE
2986  IF(solver%SOLVE_TYPE==solver_dae_type) THEN
2987  dae_solver=>solver%DAE_SOLVER
2988  IF(ASSOCIATED(dae_solver)) THEN
2989  IF(dae_solver%DAE_SOLVE_TYPE==solver_dae_euler) THEN
2990  euler_dae_solver=>dae_solver%EULER_SOLVER
2991  IF(ASSOCIATED(euler_dae_solver)) THEN
2992  IF(dae_euler_type/=euler_dae_solver%EULER_TYPE) THEN
2993  !Intialise the new Euler differential-algebraic equation solver type
2994  SELECT CASE(dae_euler_type)
2995  CASE(solver_dae_euler_forward)
2996  CALL solver_dae_euler_forward_initialise(euler_dae_solver,err,error,*999)
2997  CASE(solver_dae_euler_backward)
2998  CALL solver_dae_euler_backward_initialise(euler_dae_solver,err,error,*999)
2999  CASE(solver_dae_euler_improved)
3000  CALL solver_dae_euler_improved_initialise(euler_dae_solver,err,error,*999)
3001  CASE DEFAULT
3002  local_error="The specified Euler differential-algebraic equation solver type of "// &
3003  & trim(numbertovstring(dae_euler_type,"*",err,error))//" is invalid."
3004  CALL flagerror(local_error,err,error,*999)
3005  END SELECT
3006  !Finalise the old Euler differential-algebraic equation solver type
3007  SELECT CASE(euler_dae_solver%EULER_TYPE)
3008  CASE(solver_dae_euler_forward)
3009  CALL solver_dae_euler_forward_finalise(euler_dae_solver%FORWARD_EULER_SOLVER,err,error,*999)
3010  CASE(solver_dae_euler_backward)
3011  CALL solver_dae_euler_backward_finalise(euler_dae_solver%BACKWARD_EULER_SOLVER,err,error,*999)
3012  CASE(solver_dae_euler_improved)
3013  CALL solver_dae_euler_improved_finalise(euler_dae_solver%IMPROVED_EULER_SOLVER,err,error,*999)
3014  CASE DEFAULT
3015  local_error="The Euler differential-algebraic equation solver type of "// &
3016  & trim(numbertovstring(euler_dae_solver%EULER_TYPE,"*",err,error))//" is invalid."
3017  CALL flagerror(local_error,err,error,*999)
3018  END SELECT
3019  euler_dae_solver%EULER_TYPE=dae_euler_type
3020  ENDIF
3021  ELSE
3022  CALL flagerror("The differential-algebraic equation solver Euler solver is not associated.",err,error,*999)
3023  ENDIF
3024  ELSE
3025  CALL flagerror("The solver differential-algebraic equation solver is not an Euler differential-algebraic "// &
3026  & "equation solver.",err,error,*999)
3027  ENDIF
3028  ELSE
3029  CALL flagerror("The solver differential-algebraic equation solver is not associated.",err,error,*999)
3030  ENDIF
3031  ELSE
3032  CALL flagerror("The solver is not a differential-algebraic equation solver.",err,error,*999)
3033  ENDIF
3034  ENDIF
3035  ELSE
3036  CALL flagerror("Solver is not associated.",err,error,*999)
3037  ENDIF
3038 
3039  exits("SOLVER_DAE_EULER_SOLVER_TYPE_SET")
3040  RETURN
3041 999 errorsexits("SOLVER_DAE_EULER_SOLVER_TYPE_SET",err,error)
3042  RETURN 1
3043 
3044  END SUBROUTINE solver_dae_euler_solver_type_set
3045 
3046  !
3047  !================================================================================================================================
3048  !
3049 
3051  SUBROUTINE solver_dae_finalise(DAE_SOLVER,ERR,ERROR,*)
3052 
3053  !Argument variables
3054  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
3055  INTEGER(INTG), INTENT(OUT) :: ERR
3056  TYPE(varying_string), INTENT(OUT) :: ERROR
3057  !Local Variables
3058 
3059  enters("SOLVER_DAE_FINALISE",err,error,*999)
3060 
3061  IF(ASSOCIATED(dae_solver)) THEN
3062  CALL solver_dae_euler_finalise(dae_solver%EULER_SOLVER,err,error,*999)
3063  CALL solver_dae_crank_nicolson_finalise(dae_solver%CRANK_NICOLSON_SOLVER,err,error,*999)
3064  CALL solver_dae_runge_kutta_finalise(dae_solver%RUNGE_KUTTA_SOLVER,err,error,*999)
3065  CALL solver_dae_adams_moulton_finalise(dae_solver%ADAMS_MOULTON_SOLVER,err,error,*999)
3066  CALL solver_dae_bdf_finalise(dae_solver%BDF_SOLVER,err,error,*999)
3067  CALL solver_dae_rush_larson_finalise(dae_solver%RUSH_LARSON_SOLVER,err,error,*999)
3068  CALL solver_dae_external_finalise(dae_solver%EXTERNAL_SOLVER,err,error,*999)
3069  DEALLOCATE(dae_solver)
3070  ENDIF
3071 
3072  exits("SOLVER_DAE_FINALISE")
3073  RETURN
3074 999 errorsexits("SOLVER_DAE_FINALISE",err,error)
3075  RETURN 1
3076 
3077  END SUBROUTINE solver_dae_finalise
3078 
3079  !
3080  !================================================================================================================================
3081  !
3082 
3084  SUBROUTINE solver_dae_initialise(SOLVER,ERR,ERROR,*)
3085 
3086  !Argument variables
3087  TYPE(solver_type), POINTER :: SOLVER
3088  INTEGER(INTG), INTENT(OUT) :: ERR
3089  TYPE(varying_string), INTENT(OUT) :: ERROR
3090  !Local Variables
3091  INTEGER(INTG) :: DUMMY_ERR
3092  TYPE(varying_string) :: DUMMY_ERROR
3093 
3094  enters("SOLVER_DAE_INITIALISE",err,error,*998)
3095 
3096  IF(ASSOCIATED(solver)) THEN
3097  IF(ASSOCIATED(solver%DAE_SOLVER)) THEN
3098  CALL flagerror("Differential-algebraic equation solver is already associated for this solver.",err,error,*998)
3099  ELSE
3100  !Allocate the differential-algebraic equation solver
3101  ALLOCATE(solver%DAE_SOLVER,stat=err)
3102  IF(err/=0) CALL flagerror("Could not allocate solver differential-algebraic equation solver.",err,error,*999)
3103  !Initialise
3104  solver%DAE_SOLVER%SOLVER=>solver
3105  solver%DAE_SOLVER%DAE_TYPE=0
3106  solver%DAE_SOLVER%DAE_SOLVE_TYPE=0
3107  solver%DAE_SOLVER%START_TIME=0.0_dp
3108  solver%DAE_SOLVER%END_TIME=0.1_dp
3109  solver%DAE_SOLVER%INITIAL_STEP=0.1_dp
3110  NULLIFY(solver%DAE_SOLVER%EULER_SOLVER)
3111  NULLIFY(solver%DAE_SOLVER%CRANK_NICOLSON_SOLVER)
3112  NULLIFY(solver%DAE_SOLVER%RUNGE_KUTTA_SOLVER)
3113  NULLIFY(solver%DAE_SOLVER%ADAMS_MOULTON_SOLVER)
3114  NULLIFY(solver%DAE_SOLVER%BDF_SOLVER)
3115  NULLIFY(solver%DAE_SOLVER%RUSH_LARSON_SOLVER)
3116  NULLIFY(solver%DAE_SOLVER%EXTERNAL_SOLVER)
3117  !Default to an Euler differential equation solver
3118  CALL solver_dae_euler_initialise(solver%DAE_SOLVER,err,error,*999)
3119  solver%DAE_SOLVER%DAE_SOLVE_TYPE=solver_dae_euler
3120  ENDIF
3121  ELSE
3122  CALL flagerror("Solver is not associated.",err,error,*998)
3123  ENDIF
3124 
3125  exits("SOLVER_DAE_INITIALISE")
3126  RETURN
3127 999 CALL solver_dae_finalise(solver%DAE_SOLVER,dummy_err,dummy_error,*998)
3128 998 errorsexits("SOLVER_DAE_INITIALISE",err,error)
3129  RETURN 1
3130 
3131  END SUBROUTINE solver_dae_initialise
3132 
3133  !
3134  !================================================================================================================================
3135  !
3136 
3138  SUBROUTINE solver_dae_library_type_get(DAE_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
3139 
3140  !Argument variables
3141  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
3142  INTEGER(INTG), INTENT(OUT) :: SOLVER_LIBRARY_TYPE
3143  INTEGER(INTG), INTENT(OUT) :: ERR
3144  TYPE(varying_string), INTENT(OUT) :: ERROR
3145  !Local Variables
3146  TYPE(adams_moulton_dae_solver_type), POINTER :: ADAMS_MOULTON_DAE_SOLVER
3147  TYPE(bdf_dae_solver_type), POINTER :: BDF_DAE_SOLVER
3148  TYPE(crank_nicolson_dae_solver_type), POINTER :: CRANK_NICOLSON_DAE_SOLVER
3149  TYPE(euler_dae_solver_type), POINTER :: EULER_DAE_SOLVER
3150  TYPE(runge_kutta_dae_solver_type), POINTER :: RUNGE_KUTTA_DAE_SOLVER
3151  TYPE(rush_larson_dae_solver_type), POINTER :: RUSH_LARSON_DAE_SOLVER
3152  TYPE(varying_string) :: LOCAL_ERROR
3153 
3154  enters("SOLVER_DAE_LIBRARY_TYPE_GET",err,error,*999)
3155 
3156  IF(ASSOCIATED(dae_solver)) THEN
3157  SELECT CASE(dae_solver%DAE_SOLVE_TYPE)
3158  CASE(solver_dae_euler)
3159  euler_dae_solver=>dae_solver%EULER_SOLVER
3160  IF(ASSOCIATED(euler_dae_solver)) THEN
3161  CALL solver_dae_euler_library_type_get(euler_dae_solver,solver_library_type,err,error,*999)
3162  ELSE
3163  CALL flagerror("Euler differential-algebraic solver is not associated.",err,error,*999)
3164  ENDIF
3165  CASE(solver_dae_crank_nicolson)
3166  crank_nicolson_dae_solver=>dae_solver%CRANK_NICOLSON_SOLVER
3167  IF(ASSOCIATED(crank_nicolson_dae_solver)) THEN
3168  solver_library_type=crank_nicolson_dae_solver%SOLVER_LIBRARY
3169  ELSE
3170  CALL flagerror("The Crank-Nicolson differntial-algebraic equations solver is not associated.",err,error,*999)
3171  ENDIF
3172  CASE(solver_dae_runge_kutta)
3173  runge_kutta_dae_solver=>dae_solver%RUNGE_KUTTA_SOLVER
3174  IF(ASSOCIATED(runge_kutta_dae_solver)) THEN
3175  solver_library_type=runge_kutta_dae_solver%SOLVER_LIBRARY
3176  ELSE
3177  CALL flagerror("The Runge-Kutta differntial-algebraic equations solver is not associated.",err,error,*999)
3178  ENDIF
3179  CASE(solver_dae_adams_moulton)
3180  adams_moulton_dae_solver=>dae_solver%ADAMS_MOULTON_SOLVER
3181  IF(ASSOCIATED(adams_moulton_dae_solver)) THEN
3182  solver_library_type=adams_moulton_dae_solver%SOLVER_LIBRARY
3183  ELSE
3184  CALL flagerror("The Adams-Moulton differntial-algebraic equations solver is not associated.",err,error,*999)
3185  ENDIF
3186  CASE(solver_dae_bdf)
3187  bdf_dae_solver=>dae_solver%BDF_SOLVER
3188  IF(ASSOCIATED(bdf_dae_solver)) THEN
3189  solver_library_type=bdf_dae_solver%SOLVER_LIBRARY
3190  ELSE
3191  CALL flagerror("The BDF differntial-algebraic equations solver is not associated.",err,error,*999)
3192  ENDIF
3193  CASE(solver_dae_rush_larson)
3194  rush_larson_dae_solver=>dae_solver%RUSH_LARSON_SOLVER
3195  IF(ASSOCIATED(rush_larson_dae_solver)) THEN
3196  solver_library_type=rush_larson_dae_solver%SOLVER_LIBRARY
3197  ELSE
3198  CALL flagerror("The Rush-Larson differntial-algebraic equations solver is not associated.",err,error,*999)
3199  ENDIF
3200  CASE(solver_dae_external)
3201  CALL flagerror("Can not get the solver library for an external differntial-algebraic equations solver.",err,error,*999)
3202  CASE DEFAULT
3203  local_error="The differential-algebraic equations solver type of "// &
3204  & trim(numbertovstring(dae_solver%DAE_SOLVE_TYPE,"*",err,error))//" is invalid."
3205  CALL flagerror(local_error,err,error,*999)
3206  END SELECT
3207  ELSE
3208  CALL flagerror("DAE solver is not associated.",err,error,*999)
3209  ENDIF
3210 
3211  exits("SOLVER_DAE_LIBRARY_TYPE_GET")
3212  RETURN
3213 999 errorsexits("SOLVER_DAE_LIBRARY_TYPE_GET",err,error)
3214  RETURN 1
3215 
3216  END SUBROUTINE solver_dae_library_type_get
3217 
3218  !
3219  !================================================================================================================================
3220  !
3221 
3223  SUBROUTINE solver_dae_library_type_set(DAE_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
3224 
3225  !Argument variables
3226  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
3227  INTEGER(INTG), INTENT(IN) :: SOLVER_LIBRARY_TYPE
3228  INTEGER(INTG), INTENT(OUT) :: ERR
3229  TYPE(varying_string), INTENT(OUT) :: ERROR
3230  !Local Variables
3231  TYPE(adams_moulton_dae_solver_type), POINTER :: ADAMS_MOULTON_DAE_SOLVER
3232  TYPE(backward_euler_dae_solver_type), POINTER :: BACKWARD_EULER_DAE_SOLVER
3233  TYPE(bdf_dae_solver_type), POINTER :: BDF_DAE_SOLVER
3234  TYPE(crank_nicolson_dae_solver_type), POINTER :: CRANK_NICOLSON_DAE_SOLVER
3235  TYPE(euler_dae_solver_type), POINTER :: EULER_DAE_SOLVER
3236  TYPE(forward_euler_dae_solver_type), POINTER :: FORWARD_EULER_DAE_SOLVER
3237  TYPE(improved_euler_dae_solver_type), POINTER :: IMPROVED_EULER_DAE_SOLVER
3238  TYPE(runge_kutta_dae_solver_type), POINTER :: RUNGE_KUTTA_DAE_SOLVER
3239  TYPE(rush_larson_dae_solver_type), POINTER :: RUSH_LARSON_DAE_SOLVER
3240  TYPE(varying_string) :: LOCAL_ERROR
3241 
3242  enters("SOLVER_DAE_LIBRARY_TYPE_SET",err,error,*999)
3243 
3244  IF(ASSOCIATED(dae_solver)) THEN
3245  SELECT CASE(dae_solver%DAE_SOLVE_TYPE)
3246  CASE(solver_dae_euler)
3247  euler_dae_solver=>dae_solver%EULER_SOLVER
3248  IF(ASSOCIATED(euler_dae_solver)) THEN
3249  SELECT CASE(euler_dae_solver%EULER_TYPE)
3250  CASE(solver_dae_euler_forward)
3251  forward_euler_dae_solver=>euler_dae_solver%FORWARD_EULER_SOLVER
3252  IF(ASSOCIATED(forward_euler_dae_solver)) THEN
3253  SELECT CASE(solver_library_type)
3254  CASE(solver_cmiss_library)
3255  forward_euler_dae_solver%SOLVER_LIBRARY=solver_cmiss_library
3256  CASE(solver_petsc_library)
3257  CALL flagerror("Not implemented.",err,error,*999)
3258  CASE DEFAULT
3259  local_error="The solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
3260  & " is invalid."
3261  CALL flagerror(local_error,err,error,*999)
3262  END SELECT
3263  ELSE
3264  CALL flagerror("The forward Euler differential-algebraic equation solver is not associated.",err,error,*999)
3265  ENDIF
3266  CASE(solver_dae_euler_backward)
3267  backward_euler_dae_solver=>euler_dae_solver%BACKWARD_EULER_SOLVER
3268  IF(ASSOCIATED(backward_euler_dae_solver)) THEN
3269  SELECT CASE(solver_library_type)
3270  CASE(solver_cmiss_library)
3271  CALL flagerror("Not implemented.",err,error,*999)
3272  CASE(solver_petsc_library)
3273  CALL flagerror("Not implemented.",err,error,*999)
3274  CASE DEFAULT
3275  local_error="The solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
3276  & " is invalid."
3277  CALL flagerror(local_error,err,error,*999)
3278  END SELECT
3279  ELSE
3280  CALL flagerror("The backward Euler differential-algebraic equation solver is not associated.",err,error,*999)
3281  ENDIF
3282  CASE(solver_dae_euler_improved)
3283  improved_euler_dae_solver=>euler_dae_solver%IMPROVED_EULER_SOLVER
3284  IF(ASSOCIATED(improved_euler_dae_solver)) THEN
3285  SELECT CASE(solver_library_type)
3286  CASE(solver_cmiss_library)
3287  CALL flagerror("Not implemented.",err,error,*999)
3288  CASE(solver_petsc_library)
3289  CALL flagerror("Not implemented.",err,error,*999)
3290  CASE DEFAULT
3291  local_error="The solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
3292  & " is invalid."
3293  CALL flagerror(local_error,err,error,*999)
3294  END SELECT
3295  ELSE
3296  CALL flagerror("The improved Euler differential-algebraic equation solver is not associated.",err,error,*999)
3297  ENDIF
3298  CASE DEFAULT
3299  local_error="The Euler differential-algebraic equations solver type of "// &
3300  & trim(numbertovstring(euler_dae_solver%EULER_TYPE,"*",err,error))//" is invalid."
3301  CALL flagerror(local_error,err,error,*999)
3302  END SELECT
3303  ELSE
3304  CALL flagerror("The Euler differential-algebraic equation solver is not associated.",err,error,*999)
3305  ENDIF
3306  CASE(solver_dae_crank_nicolson)
3307  crank_nicolson_dae_solver=>dae_solver%CRANK_NICOLSON_SOLVER
3308  IF(ASSOCIATED(crank_nicolson_dae_solver)) THEN
3309  SELECT CASE(solver_library_type)
3310  CASE(solver_cmiss_library)
3311  CALL flagerror("Not implemented.",err,error,*999)
3312  CASE(solver_petsc_library)
3313  CALL flagerror("Not implemented.",err,error,*999)
3314  CASE DEFAULT
3315  local_error="The solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
3316  & " is invalid."
3317  CALL flagerror(local_error,err,error,*999)
3318  END SELECT
3319  ELSE
3320  CALL flagerror("The Crank-Nicolson differential-algebraic equation solver is not associated.",err,error,*999)
3321  ENDIF
3322  CASE(solver_dae_runge_kutta)
3323  runge_kutta_dae_solver=>dae_solver%RUNGE_KUTTA_SOLVER
3324  IF(ASSOCIATED(runge_kutta_dae_solver)) THEN
3325  SELECT CASE(solver_library_type)
3326  CASE(solver_cmiss_library)
3327  CALL flagerror("Not implemented.",err,error,*999)
3328  CASE(solver_petsc_library)
3329  CALL flagerror("Not implemented.",err,error,*999)
3330  CASE DEFAULT
3331  local_error="The solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
3332  & " is invalid."
3333  CALL flagerror(local_error,err,error,*999)
3334  END SELECT
3335  ELSE
3336  CALL flagerror("The Runge-Kutta differential-algebraic equation solver is not associated.",err,error,*999)
3337  ENDIF
3338  CASE(solver_dae_adams_moulton)
3339  adams_moulton_dae_solver=>dae_solver%ADAMS_MOULTON_SOLVER
3340  IF(ASSOCIATED(adams_moulton_dae_solver)) THEN
3341  SELECT CASE(solver_library_type)
3342  CASE(solver_cmiss_library)
3343  CALL flagerror("Not implemented.",err,error,*999)
3344  CASE(solver_petsc_library)
3345  CALL flagerror("Not implemented.",err,error,*999)
3346  CASE DEFAULT
3347  local_error="The solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
3348  & " is invalid."
3349  CALL flagerror(local_error,err,error,*999)
3350  END SELECT
3351  ELSE
3352  CALL flagerror("The Adams-Moulton differential-algebraic equation solver is not associated.",err,error,*999)
3353  ENDIF
3354  CASE(solver_dae_bdf)
3355  bdf_dae_solver=>dae_solver%BDF_SOLVER
3356  IF(ASSOCIATED(bdf_dae_solver)) THEN
3357  SELECT CASE(solver_library_type)
3358  CASE(solver_cmiss_library)
3359  CALL flagerror("Not implemented.",err,error,*999)
3360  CASE(solver_petsc_library)
3361  bdf_dae_solver%SOLVER_LIBRARY = solver_petsc_library
3362  CASE DEFAULT
3363  local_error="The solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
3364  & " is invalid."
3365  CALL flagerror(local_error,err,error,*999)
3366  END SELECT
3367  ELSE
3368  CALL flagerror("The BDF differential-algebraic equation solver is not associated.",err,error,*999)
3369  ENDIF
3370  CASE(solver_dae_rush_larson)
3371  rush_larson_dae_solver=>dae_solver%RUSH_LARSON_SOLVER
3372  IF(ASSOCIATED(rush_larson_dae_solver)) THEN
3373  SELECT CASE(solver_library_type)
3374  CASE(solver_cmiss_library)
3375  CALL flagerror("Not implemented.",err,error,*999)
3376  CASE(solver_petsc_library)
3377  CALL flagerror("Not implemented.",err,error,*999)
3378  CASE DEFAULT
3379  local_error="The solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
3380  & " is invalid."
3381  CALL flagerror(local_error,err,error,*999)
3382  END SELECT
3383  ELSE
3384  CALL flagerror("The Rush-Larson differential-algebraic equation solver is not associated.",err,error,*999)
3385  ENDIF
3386  CASE(solver_dae_external)
3387  CALL flagerror("Can not set the library type for an external differential-algebraic equation solver is not associated.", &
3388  & err,error,*999)
3389  CASE DEFAULT
3390  local_error="The differential-algebraic equations solver type of "// &
3391  & trim(numbertovstring(dae_solver%DAE_SOLVE_TYPE,"*",err,error))//" is invalid."
3392  CALL flagerror(local_error,err,error,*999)
3393  END SELECT
3394  ELSE
3395  CALL flagerror("DAE solver is not associated.",err,error,*999)
3396  ENDIF
3397 
3398  exits("SOLVER_DAE_LIBRARY_TYPE_SET")
3399  RETURN
3400 999 errorsexits("SOLVER_DAE_LIBRARY_TYPE_SET",err,error)
3401  RETURN 1
3402 
3403  END SUBROUTINE solver_dae_library_type_set
3404 
3405  !
3406  !================================================================================================================================
3407  !
3408 
3410  SUBROUTINE solver_dae_bdf_finalise(BDF_SOLVER,ERR,ERROR,*)
3411 
3412  !Argument variables
3413  TYPE(bdf_dae_solver_type), POINTER :: BDF_SOLVER
3414  INTEGER(INTG), INTENT(OUT) :: ERR
3415  TYPE(varying_string), INTENT(OUT) :: ERROR
3416  !Local Variables
3417 
3418  enters("SOLVER_DAE_BDF_FINALISE",err,error,*999)
3419 
3420  IF(ASSOCIATED(bdf_solver)) THEN
3421  DEALLOCATE(bdf_solver)
3422  ENDIF
3423 
3424  exits("SOLVER_DAE_BDF_FINALISE")
3425  RETURN
3426 999 errorsexits("SOLVER_DAE_BDF_FINALISE",err,error)
3427  RETURN 1
3428 
3429  END SUBROUTINE solver_dae_bdf_finalise
3430 
3431  !
3432  !================================================================================================================================
3433  !
3434 
3436  SUBROUTINE solver_dae_bdf_initialise(DAE_SOLVER,ERR,ERROR,*)
3437 
3438  !Argument variables
3439  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
3440  INTEGER(INTG), INTENT(OUT) :: ERR
3441  TYPE(varying_string), INTENT(OUT) :: ERROR
3442  !Local Variables
3443  INTEGER(INTG) :: DUMMY_ERR
3444  TYPE(varying_string) :: DUMMY_ERROR
3445 
3446  enters("SOLVER_DAE_BDF_INITIALISE",err,error,*998)
3447 
3448  IF(ASSOCIATED(dae_solver)) THEN
3449  IF(ASSOCIATED(dae_solver%BDF_SOLVER)) THEN
3450  CALL flagerror("BDF solver is already associated for this differential-algebraic equation solver.",err,error,*998)
3451  ELSE
3452  !Allocate the BDF solver
3453  ALLOCATE(dae_solver%BDF_SOLVER,stat=err)
3454  IF(err/=0) CALL flagerror("Could not allocate BDF solver.",err,error,*999)
3455  !Initialise
3456  dae_solver%BDF_SOLVER%DAE_SOLVER=>dae_solver
3457  dae_solver%BDF_SOLVER%SOLVER_LIBRARY=solver_petsc_library
3458  !Defaults
3459  ENDIF
3460  ELSE
3461  CALL flagerror("Differential-algebraic equation solver is not associated.",err,error,*998)
3462  ENDIF
3463 
3464  exits("SOLVER_DAE_BDF_INITIALISE")
3465  RETURN
3466 999 CALL solver_dae_bdf_finalise(dae_solver%BDF_SOLVER,dummy_err,dummy_error,*998)
3467 998 errorsexits("SOLVER_DAE_BDF_INITIALISE",err,error)
3468  RETURN 1
3469 
3470  END SUBROUTINE solver_dae_bdf_initialise
3471  !
3472  !================================================================================================================================
3473  !
3474 
3476  SUBROUTINE solver_daecellmlpetsccontextfinalise(ctx,err,error,*)
3477 
3478  !Argument variables
3479  TYPE(cellmlpetsccontexttype), POINTER :: ctx
3480  INTEGER(INTG), INTENT(OUT) :: err
3481  TYPE(varying_string), INTENT(OUT) :: error
3482  !Local Variables
3483 
3484  enters("Solver_DAECellMLPETScContextFinalise",err,error,*999)
3485 
3486  IF(ASSOCIATED(ctx)) THEN
3487  IF(ASSOCIATED(ctx%rates)) DEALLOCATE(ctx%rates)
3488  IF(ALLOCATED(ctx%ratesIndices)) DEALLOCATE(ctx%ratesIndices)
3489  DEALLOCATE(ctx)
3490  ENDIF
3491 
3492  exits("Solver_DAECellMLPETScContextFinalise")
3493  RETURN
3494 999 errorsexits("Solver_DAECellMLPETScContextFinalise",err,error)
3495  RETURN 1
3496 
3497  END SUBROUTINE solver_daecellmlpetsccontextfinalise
3498 
3499 
3500  !
3501  !================================================================================================================================
3502  !
3503 
3505  SUBROUTINE solver_daecellmlpetsccontextinitialise(ctx,err,error,*)
3506 
3507  !Argument variables
3508  TYPE(cellmlpetsccontexttype), INTENT(OUT), POINTER :: ctx
3509  INTEGER(INTG), INTENT(OUT) :: err
3510  TYPE(varying_string), INTENT(OUT) :: error
3511  !Local Variables
3512  INTEGER(INTG) :: dummyErr
3513  TYPE(varying_string) :: dummyError
3514 
3515  enters("Solver_DAECellMLPETScContextInitialise",err,error,*998)
3516 
3517  IF(ASSOCIATED(ctx)) THEN
3518  CALL flagerror("Context is already associated.",err,error,*998)
3519  ELSE
3520  !Allocate the CTX
3521  ALLOCATE(ctx,stat=err)
3522  IF(err/=0) CALL flagerror("Could not allocate context.",err,error,*999)
3523  !Initialise
3524  NULLIFY(ctx%solver)
3525  NULLIFY(ctx%cellml)
3526  NULLIFY(ctx%rates)
3527  ctx%dofIdx=0
3528  ENDIF
3529 
3530  exits("Solver_DAECellMLPETScContextInitialise")
3531  RETURN
3532 999 CALL solver_daecellmlpetsccontextfinalise(ctx,dummyerr,dummyerror,*998)
3533 998 errorsexits("Solver_DAECellMLPETScContextInitialise",err,error)
3534  RETURN 1
3535 
3536  END SUBROUTINE solver_daecellmlpetsccontextinitialise
3537  !
3538  !================================================================================================================================
3539  !
3540 
3542  SUBROUTINE solver_daecellmlpetsccontextset(ctx,solver,cellml,dofIdx,err,error,*)
3543 
3544  !Argument variables
3545  TYPE(cellmlpetsccontexttype), INTENT(IN), POINTER :: ctx
3546  TYPE(solver_type), POINTER, INTENT(IN) :: solver
3547  TYPE(cellml_type), POINTER, INTENT(IN) :: cellml
3548  INTEGER(INTG), INTENT(IN) :: dofIdx
3549  INTEGER(INTG), INTENT(OUT) :: err
3550  TYPE(varying_string), INTENT(OUT) :: error
3551  !Local Variables
3552  INTEGER(INTG) :: arrayIdx,dummyErr
3553  TYPE(varying_string) :: dummyError
3554 
3555  enters("Solver_DAECellMLPETScContextSet",err,error,*998)
3556 
3557  IF(ASSOCIATED(ctx)) THEN
3558  IF(ASSOCIATED(solver)) THEN
3559  IF(ASSOCIATED(cellml)) THEN
3560  !Set
3561  ctx%solver=>solver
3562  ctx%cellml=>cellml
3563  ctx%dofIdx=dofidx
3564  ALLOCATE(ctx%rates(cellml%MAXIMUM_NUMBER_OF_STATE),stat=err)
3565  IF(err/=0) CALL flagerror("Could not allocate context rates.",err,error,*999)
3566  ALLOCATE(ctx%ratesIndices(cellml%MAXIMUM_NUMBER_OF_STATE),stat=err)
3567  IF(err/=0) CALL flagerror("Could not allocate context rates.",err,error,*999)
3568  ctx%ratesIndices=[(arrayidx,arrayidx=0,(cellml%MAXIMUM_NUMBER_OF_STATE-1))]
3569  ELSE
3570  CALL flagerror("CellML environment is not associated.",err,error,*999)
3571  ENDIF
3572  ELSE
3573  CALL flagerror("Solver is not associated.",err,error,*998)
3574  ENDIF
3575  ELSE
3576  CALL flagerror("ctx is not associated.",err,error,*998)
3577  ENDIF
3578 
3579  exits("Solver_DAECellMLPETScContextSet")
3580  RETURN
3581 999 CALL solver_daecellmlpetsccontextfinalise(ctx,dummyerr,dummyerror,*998)
3582 998 errorsexits("Solver_DAECellMLPETScContextSet",err,error)
3583  RETURN 1
3584 
3585  END SUBROUTINE solver_daecellmlpetsccontextset
3586 
3587  !
3588  !================================================================================================================================
3589  !
3591  SUBROUTINE solver_dae_bdf_integrate(BDF_SOLVER,CELLML,N,START_TIME,END_TIME,TIME_INCREMENT, &
3592  & only_one_model_index,models_data,max_number_states,state_data,max_number_parameters,parameters_data, &
3593  & max_number_intermediates,intermediate_data,err,error,*)
3594 
3595  !Argument variables
3596  TYPE(bdf_dae_solver_type), POINTER :: BDF_SOLVER
3597  TYPE(cellml_type), POINTER :: CELLML
3598  INTEGER(INTG), INTENT(IN) :: N
3599  REAL(DP), INTENT(IN) :: START_TIME
3600  REAL(DP), INTENT(IN) :: END_TIME
3601  REAL(DP), INTENT(INOUT) :: TIME_INCREMENT
3602  INTEGER(INTG), INTENT(IN) :: ONLY_ONE_MODEL_INDEX
3603  INTEGER(INTG), POINTER, INTENT(IN) :: MODELS_DATA(:)
3604  INTEGER(INTG), INTENT(IN) :: MAX_NUMBER_STATES
3605  REAL(DP), POINTER, INTENT (INOUT) :: STATE_DATA(:)
3606  INTEGER(INTG), INTENT(IN) :: MAX_NUMBER_PARAMETERS
3607  REAL(DP), POINTER, INTENT(INOUT) :: PARAMETERS_DATA(:)
3608  INTEGER(INTG), INTENT(IN) :: MAX_NUMBER_INTERMEDIATES
3609  REAL(DP), POINTER, INTENT(INOUT) :: INTERMEDIATE_DATA(:)
3610  INTEGER(INTG), INTENT(OUT) :: ERR
3611  TYPE(varying_string), INTENT(OUT) :: ERROR
3612  !Local Variables
3613  TYPE(petsctstype) :: ts
3614  REAL(DP) :: FINALSOLVEDTIME,TIMESTEP
3615  TYPE(petscvectype) :: PETSC_CURRENT_STATES
3616  TYPE(cellmlpetsccontexttype), POINTER :: CTX
3617  INTEGER(INTG) :: dof_idx,DOF_ORDER_TYPE,model_idx, NUMBER_STATES,STATE_END_DOF,state_idx,STATE_START_DOF,array_idx
3618  REAL(DP), ALLOCATABLE :: STATES_TEMP(:),RATES_TEMP(:)
3619  INTEGER(INTG), ALLOCATABLE :: ARRAY_INDICES(:)
3620  TYPE(cellml_model_type), POINTER :: MODEL
3621  TYPE(varying_string) :: LOCAL_ERROR
3622  TYPE(petscvectype) :: PETSC_RATES
3623  EXTERNAL :: problem_solverdaecellmlrhspetsc
3624 
3625 
3626  enters("SOLVER_DAE_BFD_INTEGRATE",err,error,*999)
3627 
3628  NULLIFY(ctx)
3629  timestep=end_time-start_time
3630  IF(ASSOCIATED(bdf_solver)) THEN
3631  IF(ASSOCIATED(cellml)) THEN
3632  IF(ASSOCIATED(cellml%MODELS_FIELD)) THEN
3633  SELECT CASE(bdf_solver%SOLVER_LIBRARY)
3634  CASE(solver_petsc_library)
3635  CALL field_dof_order_type_get(cellml%MODELS_FIELD%MODELS_FIELD, &
3636  & field_u_variable_type,dof_order_type,err,error,*999)
3637  IF(dof_order_type==field_separated_component_dof_order) THEN
3638 
3639  ELSE !dof component order is contiguous
3640  IF(only_one_model_index==cellml_models_field_not_constant) THEN
3641 
3642  ELSE !only one model
3643  model=>cellml%MODELS(only_one_model_index)%PTR
3644  IF(ASSOCIATED(model)) THEN
3645  !determine no. of states in model and allocate necessary arrays
3646  number_states = model%NUMBER_OF_STATE
3647  ALLOCATE(states_temp(0:number_states-1),stat=err)
3648  ALLOCATE(rates_temp(0:number_states-1),stat=err)
3649  ALLOCATE(array_indices(0:number_states-1),stat=err)
3650  array_indices = (/(array_idx,array_idx=0,(number_states-1))/)
3651 
3652 
3653  !initialize context for petsc solving.
3654  CALL solver_daecellmlpetsccontextinitialise(ctx,err,error,*999)
3655  DO dof_idx=1,n
3656  model_idx = models_data(dof_idx)
3657  IF(model_idx>0) THEN !if model is assigned to dof
3658  !access the state field data
3659  state_start_dof=(dof_idx-1)*max_number_states+1
3660  state_end_dof=state_start_dof+number_states-1
3661  DO state_idx=1,number_states
3662  states_temp(state_idx-1) = state_data(state_start_dof+state_idx-1)
3663  ENDDO
3664 
3665  !create PETSC states vector to initialize solver
3666  CALL petsc_veccreateseq(petsc_comm_self, &
3667  & number_states,petsc_current_states,err,error,*999)
3668  !CALL Petsc_VecSetSizes(PETSC_CURRENT_STATES, &
3669  ! & PETSC_DECIDE,(NUMBER_STATES),ERR,ERROR,*999)
3670  !CALL Petsc_VecSetFromOptions(PETSC_CURRENT_STATES,ERR,ERROR,*999)
3671 
3672  !create PETSC rates vector to return values from evaluating rhs routine
3673  CALL petsc_veccreateseq(petsc_comm_self, &
3674  & number_states,petsc_rates,err,error,*999)
3675  !CALL Petsc_VecSetSizes(PETSC_RATES, &
3676  ! & PETSC_DECIDE,(NUMBER_STATES),ERR,ERROR,*999)
3677  !CALL Petsc_VecSetFromOptions(PETSC_RATES,ERR,ERROR,*999)
3678 
3679  !Set up PETSC TS context for sundials BDF solver
3680  CALL petsc_tscreate(petsc_comm_self,ts,err,error,*999)
3681  CALL petsc_tssetproblemtype(ts,petsc_ts_nonlinear,err,error,*999)
3682  CALL petsc_tssettype(ts,petsc_ts_sundials,err,error,*999)
3683  CALL petsc_tssundialssettype(ts,petsc_sundials_bdf,err,error,*999)
3684  CALL petsc_tssundialssettolerance(ts,0.0000001_dp, &
3685  & 0.0000001_dp,err,error,*999)
3686  !set the initial solution to the current state
3687  CALL petsc_vecsetvalues(petsc_current_states,(number_states), &
3688  & array_indices,states_temp, &
3689  & petsc_insert_values,err,error,*999)
3690  CALL petsc_vecassemblybegin(petsc_current_states,err,error,*999)
3691  CALL petsc_vecassemblyend(petsc_current_states,err,error,*999)
3692  CALL petsc_tssetsolution(ts,petsc_current_states,err,error,*999)
3693 
3694  !set up the time data
3695  CALL petsc_tssetinitialtimestep(ts,start_time,time_increment,err,error,*999)
3696  CALL petsc_tssetduration(ts,5000,end_time,err,error,*999)
3697  CALL petsc_tssetexactfinaltime(ts,.true.,err,error,*999)
3698 
3699  IF(diagnostics1) THEN
3700  CALL write_string_value(diagnostic_output_type," DAE START TIME = ",start_time,err,error,*999)
3701  CALL write_string_value(diagnostic_output_type," DAE END TIME = ",end_time,err,error,*999)
3702  ENDIF
3703 
3704  !set rhs function and pass through the cellml model context
3705  CALL solver_daecellmlpetsccontextset(ctx,bdf_solver%DAE_SOLVER%SOLVER,cellml,dof_idx,err,error,*999)
3706  CALL petsc_tssetrhsfunction(ts,petsc_rates,problem_solverdaecellmlrhspetsc,ctx,err,error,*999)
3707 
3708  CALL petsc_tssolve(ts,petsc_current_states,finalsolvedtime,err,error,*999)
3709  IF(diagnostics1) THEN
3710  CALL write_string_value(diagnostic_output_type," FINAL SOLVED TIME = ", &
3711  & finalsolvedtime,err,error,*999)
3712  ENDIF
3713 
3714 
3715  !update the states to new integrated values
3716  CALL petsc_vecassemblybegin(petsc_current_states,err,error,*999)
3717  CALL petsc_vecassemblyend(petsc_current_states,err,error,*999)
3718  CALL petsc_vecgetvalues(petsc_current_states, &
3719  & number_states, array_indices, &
3720  & states_temp, &
3721  & err,error,*999)
3722 
3723  DO state_idx=1,number_states
3724  state_data(state_start_dof+state_idx-1)= &
3725  & states_temp(state_idx-1)
3726  ENDDO
3727  CALL petsc_tsfinalise(ts,err,error,*999)
3728  ENDIF !model_idx
3729  CALL petsc_vecdestroy(petsc_current_states,err,error,*999)
3730  CALL petsc_vecdestroy(petsc_rates,err,error,*999)
3731  ENDDO !dof_idx
3732 
3733  ELSE
3734  CALL flagerror("Cellml model is not associated.",err,error,*999)
3735  ENDIF
3736  ENDIF
3737  ENDIF !dof continguous
3738  CASE DEFAULT
3739  local_error="The BDF solver library type of "// &
3740  & trim(numbertovstring(bdf_solver%SOLVER_LIBRARY,"*",err,error))//" is not implemented."
3741  CALL flagerror(local_error,err,error,*999)
3742  END SELECT
3743  ELSE
3744  CALL flagerror("CELLML models field is not associated.",err,error,*999)
3745  ENDIF
3746  ELSE
3747  CALL flagerror("CELLML environment is not associated.",err,error,*999)
3748  ENDIF
3749  ELSE
3750  CALL flagerror("BDF solver is not associated.",err,error,*999)
3751  ENDIF
3752 
3753  exits("SOLVER_DAE_BDF_INTEGRATE")
3754  RETURN
3755 999 errorsexits("SOLVER_DAE_BDF_INTEGRATE",err,error)
3756  RETURN 1
3757 
3758  END SUBROUTINE solver_dae_bdf_integrate
3759  !
3760  !================================================================================================================================
3761  !
3762 
3764  SUBROUTINE solver_dae_bdf_solve(BDF_SOLVER,ERR,ERROR,*)
3765 
3766  !Argument variables
3767  TYPE(bdf_dae_solver_type), POINTER :: BDF_SOLVER
3768  INTEGER(INTG), INTENT(OUT) :: ERR
3769  TYPE(varying_string), INTENT(OUT) :: ERROR
3770  !Local Variables
3771  INTEGER(INTG) :: cellml_idx
3772  INTEGER(INTG), POINTER :: MODELS_DATA(:)
3773  REAL(DP), POINTER :: INTERMEDIATE_DATA(:),PARAMETERS_DATA(:),STATE_DATA(:)
3774  TYPE(cellml_type), POINTER :: CELLML_ENVIRONMENT
3775  TYPE(cellml_equations_type), POINTER :: CELLML_EQUATIONS
3776  TYPE(cellml_models_field_type), POINTER :: CELLML_MODELS_FIELD
3777  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
3778  TYPE(field_variable_type), POINTER :: MODELS_VARIABLE
3779  TYPE(field_type), POINTER :: MODELS_FIELD,STATE_FIELD,PARAMETERS_FIELD,INTERMEDIATE_FIELD
3780  TYPE(solver_type), POINTER :: SOLVER
3781  TYPE(varying_string) :: LOCAL_ERROR
3782 
3783  enters("SOLVER_DAE_BDF_SOLVE",err,error,*999)
3784 
3785  NULLIFY(models_data)
3786  NULLIFY(intermediate_data)
3787  NULLIFY(parameters_data)
3788  NULLIFY(state_data)
3789  NULLIFY(models_variable)
3790 
3791  IF(ASSOCIATED(bdf_solver)) THEN
3792  dae_solver=>bdf_solver%DAE_SOLVER
3793  IF(ASSOCIATED(dae_solver)) THEN
3794  solver=>dae_solver%SOLVER
3795  IF(ASSOCIATED(solver)) THEN
3796  cellml_equations=>solver%CELLML_EQUATIONS
3797  IF(ASSOCIATED(cellml_equations)) THEN
3798  DO cellml_idx=1,cellml_equations%NUMBER_OF_CELLML_ENVIRONMENTS
3799  cellml_environment=>cellml_equations%CELLML_ENVIRONMENTS(cellml_idx)%PTR
3800  IF(ASSOCIATED(cellml_environment)) THEN
3801  cellml_models_field=>cellml_environment%MODELS_FIELD
3802  IF(ASSOCIATED(cellml_models_field)) THEN
3803  models_field=>cellml_models_field%MODELS_FIELD
3804  IF(ASSOCIATED(models_field)) THEN
3805 
3806 !!TODO: Maybe move this getting of fields earlier up the DAE solver chain? For now keep here.
3807 
3808  !Make sure CellML fields have been updated to the current value of any mapped fields
3809  CALL cellml_field_to_cellml_update(cellml_environment,err,error,*999)
3810 
3811  CALL field_variable_get(models_field,field_u_variable_type,models_variable,err,error,*999)
3812  CALL field_parameter_set_data_get(models_field,field_u_variable_type,field_values_set_type, &
3813  & models_data,err,error,*999)
3814 
3815  !Get the state information if this environment has any.
3816  IF(ASSOCIATED(cellml_environment%STATE_FIELD)) THEN
3817  state_field=>cellml_environment%STATE_FIELD%STATE_FIELD
3818  IF(ASSOCIATED(state_field)) THEN
3819  CALL field_parameter_set_data_get(state_field,field_u_variable_type,field_values_set_type, &
3820  & state_data,err,error,*999)
3821  ENDIF
3822  ENDIF
3823 
3824  !Get the parameters information if this environment has any.
3825  IF(ASSOCIATED(cellml_environment%PARAMETERS_FIELD)) THEN
3826  parameters_field=>cellml_environment%PARAMETERS_FIELD%PARAMETERS_FIELD
3827  IF(ASSOCIATED(parameters_field)) THEN
3828  CALL field_parameter_set_data_get(parameters_field,field_u_variable_type,field_values_set_type, &
3829  & parameters_data,err,error,*999)
3830  ENDIF
3831  ENDIF
3832 
3833  !Get the intermediate information if this environment has any.
3834  IF(ASSOCIATED(cellml_environment%INTERMEDIATE_FIELD)) THEN
3835  intermediate_field=>cellml_environment%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD
3836  IF(ASSOCIATED(intermediate_field)) THEN
3837  CALL field_parameter_set_data_get(intermediate_field,field_u_variable_type,field_values_set_type, &
3838  & intermediate_data,err,error,*999)
3839  ENDIF
3840  ENDIF
3841 
3842  !Integrate these CellML equations
3843 
3844  CALL solver_dae_bdf_integrate(bdf_solver,cellml_environment,models_variable% &
3845  & total_number_of_dofs,dae_solver%START_TIME,dae_solver%END_TIME,dae_solver%INITIAL_STEP, &
3846  & cellml_environment%MODELS_FIELD%ONLY_ONE_MODEL_INDEX,models_data,cellml_environment% &
3847  & maximum_number_of_state,state_data,cellml_environment%MAXIMUM_NUMBER_OF_PARAMETERS, &
3848  & parameters_data,cellml_environment%MAXIMUM_NUMBER_OF_INTERMEDIATE,intermediate_data,err,error,*999)
3849 
3850  !Restore field data
3851  CALL field_parameter_set_data_restore(models_field,field_u_variable_type,field_values_set_type, &
3852  & models_data,err,error,*999)
3853  IF(ASSOCIATED(state_field)) CALL field_parameter_set_data_restore(state_field,field_u_variable_type, &
3854  & field_values_set_type,state_data,err,error,*999)
3855  IF(ASSOCIATED(parameters_field)) CALL field_parameter_set_data_restore(parameters_field, &
3856  & field_u_variable_type,field_values_set_type,parameters_data,err,error,*999)
3857  IF(ASSOCIATED(intermediate_field)) CALL field_parameter_set_data_restore(intermediate_field, &
3858  & field_u_variable_type,field_values_set_type,intermediate_data,err,error,*999)
3859 
3860  !Make sure fields have been updated to the current value of any mapped CellML fields
3861  CALL cellml_cellml_to_field_update(cellml_environment,err,error,*999)
3862 
3863  ELSE
3864  local_error="The CellML models field is not associated for CellML index "// &
3865  & trim(numbertovstring(cellml_idx,"*",err,error))//"."
3866  CALL flagerror(local_error,err,error,*999)
3867  ENDIF
3868  ELSE
3869  local_error="The CellML models field is not associated for CellML index "// &
3870  & trim(numbertovstring(cellml_idx,"*",err,error))//"."
3871  CALL flagerror(local_error,err,error,*999)
3872  ENDIF
3873  ELSE
3874  local_error="The CellML enviroment is not associated for for CellML index "// &
3875  & trim(numbertovstring(cellml_idx,"*",err,error))//"."
3876  CALL flagerror(local_error,err,error,*999)
3877  ENDIF
3878  ENDDO !cellml_idx
3879  ELSE
3880  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
3881  ENDIF
3882  ELSE
3883  CALL flagerror("Solver is not associated.",err,error,*999)
3884  ENDIF
3885  ELSE
3886  CALL flagerror("Differential-algebraic equation solver is not associated.",err,error,*999)
3887  ENDIF
3888  ELSE
3889  CALL flagerror("BDF differential-algebraic equation solver is not associated.",err,error,*999)
3890  ENDIF
3891 
3892  exits("SOLVER_DAE_BDF_SOLVE")
3893  RETURN
3894 999 errorsexits("SOLVER_DAE_BDF_SOLVE",err,error)
3895  RETURN 1
3896 
3897  END SUBROUTINE solver_dae_bdf_solve
3898 
3899  !
3900  !================================================================================================================================
3901  !
3902 
3904  SUBROUTINE solver_dae_crank_nicolson_finalise(CRANK_NICOLSON_SOLVER,ERR,ERROR,*)
3905 
3906  !Argument variables
3907  TYPE(crank_nicolson_dae_solver_type), POINTER :: CRANK_NICOLSON_SOLVER
3908  INTEGER(INTG), INTENT(OUT) :: ERR
3909  TYPE(varying_string), INTENT(OUT) :: ERROR
3910  !Local Variables
3911 
3912  enters("SOLVER_DAE_CRANK_NICOLSON_FINALISE",err,error,*999)
3913 
3914  IF(ASSOCIATED(crank_nicolson_solver)) THEN
3915  DEALLOCATE(crank_nicolson_solver)
3916  ENDIF
3917 
3918  exits("SOLVER_DAE_CRANK_NICOLSON_FINALISE")
3919  RETURN
3920 999 errorsexits("SOLVER_DAE_CRANK_NICOLSON_FINALISE",err,error)
3921  RETURN 1
3922 
3923  END SUBROUTINE solver_dae_crank_nicolson_finalise
3924 
3925  !
3926  !================================================================================================================================
3927  !
3928 
3930  SUBROUTINE solver_dae_crank_nicolson_initialise(DAE_SOLVER,ERR,ERROR,*)
3931 
3932  !Argument variables
3933  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
3934  INTEGER(INTG), INTENT(OUT) :: ERR
3935  TYPE(varying_string), INTENT(OUT) :: ERROR
3936  !Local Variables
3937  INTEGER(INTG) :: DUMMY_ERR
3938  TYPE(varying_string) :: DUMMY_ERROR
3939 
3940  enters("SOLVER_DAE_CRANK_NICOLSON_INITIALISE",err,error,*998)
3941 
3942  IF(ASSOCIATED(dae_solver)) THEN
3943  IF(ASSOCIATED(dae_solver%CRANK_NICOLSON_SOLVER)) THEN
3944  CALL flagerror("Crank-Nicolson solver is already associated for this differential-algebraic equation solver.", &
3945  & err,error,*998)
3946  ELSE
3947  !Allocate the Crank-Nicholson solver
3948  ALLOCATE(dae_solver%CRANK_NICOLSON_SOLVER,stat=err)
3949  IF(err/=0) CALL flagerror("Could not allocate Crank-Nicolson solver.",err,error,*999)
3950  !Initialise
3951  dae_solver%CRANK_NICOLSON_SOLVER%DAE_SOLVER=>dae_solver
3952  dae_solver%CRANK_NICOLSON_SOLVER%SOLVER_LIBRARY=0
3953  !Defaults
3954  ENDIF
3955  ELSE
3956  CALL flagerror("Differential-algebraic equation solver is not associated.",err,error,*998)
3957  ENDIF
3958 
3959  exits("SOLVER_DAE_CRANK_NICOLSON_INITIALISE")
3960  RETURN
3961 999 CALL solver_dae_crank_nicolson_finalise(dae_solver%CRANK_NICOLSON_SOLVER,dummy_err,dummy_error,*998)
3962 998 errorsexits("SOLVER_DAE_CRANK_NICOLSON_INITIALISE",err,error)
3963  RETURN 1
3964 
3965  END SUBROUTINE solver_dae_crank_nicolson_initialise
3966 
3967  !
3968  !================================================================================================================================
3969  !
3970 
3972  SUBROUTINE solver_dae_crank_nicolson_solve(CRANK_NICOLSON_SOLVER,ERR,ERROR,*)
3973 
3974  !Argument variables
3975  TYPE(crank_nicolson_dae_solver_type), POINTER :: CRANK_NICOLSON_SOLVER
3976  INTEGER(INTG), INTENT(OUT) :: ERR
3977  TYPE(varying_string), INTENT(OUT) :: ERROR
3978  !Local Variables
3979 
3980  enters("SOLVER_DAE_CRANK_NICOLSON_SOLVE",err,error,*999)
3981 
3982  IF(ASSOCIATED(crank_nicolson_solver)) THEN
3983  CALL flagerror("Not implemented.",err,error,*999)
3984  ELSE
3985  CALL flagerror("Crank-Nicolson differential-algebraic equation solver is not associated.",err,error,*999)
3986  ENDIF
3987 
3988  exits("SOLVER_DAE_CRANK_NICOLSON_SOLVE")
3989  RETURN
3990 999 errorsexits("SOLVER_DAE_CRANK_NICOLSON_SOLVE",err,error)
3991  RETURN 1
3992 
3993  END SUBROUTINE solver_dae_crank_nicolson_solve
3994 
3995  !
3996  !================================================================================================================================
3997  !
3998 
4000  SUBROUTINE solver_dae_external_finalise(EXTERNAL_SOLVER,ERR,ERROR,*)
4001 
4002  !Argument variables
4003  TYPE(external_dae_solver_type), POINTER :: EXTERNAL_SOLVER
4004  INTEGER(INTG), INTENT(OUT) :: ERR
4005  TYPE(varying_string), INTENT(OUT) :: ERROR
4006  !Local Variables
4007 
4008  enters("SOLVER_DAE_EXTERNAL_FINALISE",err,error,*999)
4009 
4010  IF(ASSOCIATED(external_solver)) THEN
4011  DEALLOCATE(external_solver)
4012  ENDIF
4013 
4014  exits("SOLVER_DAE_CRANK_NICOLSON_FINALISE")
4015  RETURN
4016 999 errorsexits("SOLVER_DAE_CRANK_NICOLSON_FINALISE",err,error)
4017  RETURN 1
4018 
4019  END SUBROUTINE solver_dae_external_finalise
4020 
4021  !
4022  !================================================================================================================================
4023  !
4024 
4026  SUBROUTINE solver_dae_external_initialise(DAE_SOLVER,ERR,ERROR,*)
4027 
4028  !Argument variables
4029  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
4030  INTEGER(INTG), INTENT(OUT) :: ERR
4031  TYPE(varying_string), INTENT(OUT) :: ERROR
4032  !Local Variables
4033  INTEGER(INTG) :: DUMMY_ERR
4034  TYPE(varying_string) :: DUMMY_ERROR
4035 
4036  enters("SOLVER_DAE_EXTERNAL_INITIALISE",err,error,*998)
4037 
4038  IF(ASSOCIATED(dae_solver)) THEN
4039  IF(ASSOCIATED(dae_solver%EXTERNAL_SOLVER)) THEN
4040  CALL flagerror("External solver is already associated for this differential-algebraic equation solver.", &
4041  & err,error,*998)
4042  ELSE
4043  !Allocate the external solver
4044  ALLOCATE(dae_solver%EXTERNAL_SOLVER,stat=err)
4045  IF(err/=0) CALL flagerror("Could not allocate external solver.",err,error,*999)
4046  !Initialise
4047  dae_solver%EXTERNAL_SOLVER%DAE_SOLVER=>dae_solver
4048  !Defaults
4049  ENDIF
4050  ELSE
4051  CALL flagerror("Differential-algebraic equation solver is not associated.",err,error,*998)
4052  ENDIF
4053 
4054  exits("SOLVER_DAE_EXTERNAL_INITIALISE")
4055  RETURN
4056 999 CALL solver_dae_external_finalise(dae_solver%EXTERNAL_SOLVER,dummy_err,dummy_error,*998)
4057 998 errorsexits("SOLVER_DAE_EXTERNAL_INITIALISE",err,error)
4058  RETURN 1
4059 
4060  END SUBROUTINE solver_dae_external_initialise
4061 
4062  !
4063  !================================================================================================================================
4064  !
4065 
4067  SUBROUTINE solver_dae_external_solve(EXTERNAL_SOLVER,ERR,ERROR,*)
4068 
4069  !Argument variables
4070  TYPE(external_dae_solver_type), POINTER :: EXTERNAL_SOLVER
4071  INTEGER(INTG), INTENT(OUT) :: ERR
4072  TYPE(varying_string), INTENT(OUT) :: ERROR
4073  !Local Variables
4074  INTEGER(INTG) :: cellml_idx
4075  INTEGER(INTG), POINTER :: MODELS_DATA(:)
4076  REAL(DP), POINTER :: INTERMEDIATE_DATA(:),PARAMETERS_DATA(:),STATE_DATA(:)
4077  TYPE(cellml_type), POINTER :: CELLML_ENVIRONMENT
4078  TYPE(cellml_equations_type), POINTER :: CELLML_EQUATIONS
4079  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
4080  TYPE(field_variable_type), POINTER :: MODELS_VARIABLE
4081  TYPE(field_type), POINTER :: MODELS_FIELD,STATE_FIELD,PARAMETERS_FIELD,INTERMEDIATE_FIELD
4082  TYPE(solver_type), POINTER :: SOLVER
4083  TYPE(varying_string) :: LOCAL_ERROR
4084 
4085  enters("SOLVER_DAE_EXTERNAL_SOLVE",err,error,*999)
4086 
4087  NULLIFY(models_data)
4088  NULLIFY(intermediate_data)
4089  NULLIFY(parameters_data)
4090  NULLIFY(state_data)
4091 
4092  IF(ASSOCIATED(external_solver)) THEN
4093  dae_solver=>external_solver%DAE_SOLVER
4094  IF(ASSOCIATED(dae_solver)) THEN
4095  solver=>dae_solver%SOLVER
4096  IF(ASSOCIATED(solver)) THEN
4097  cellml_equations=>solver%CELLML_EQUATIONS
4098  IF(ASSOCIATED(cellml_equations)) THEN
4099  DO cellml_idx=1,cellml_equations%NUMBER_OF_CELLML_ENVIRONMENTS
4100  cellml_environment=>cellml_equations%CELLML_ENVIRONMENTS(cellml_idx)%PTR
4101  IF(ASSOCIATED(cellml_environment)) THEN
4102  IF(ASSOCIATED(cellml_environment%MODELS_FIELD)) THEN
4103  models_field=>cellml_environment%MODELS_FIELD%MODELS_FIELD
4104  IF(ASSOCIATED(models_field)) THEN
4105 
4106  !Make sure CellML fields have been updated to the current value of any mapped fields
4107  CALL cellml_field_to_cellml_update(cellml_environment,err,error,*999)
4108 
4109  NULLIFY(models_variable)
4110  CALL field_variable_get(models_field,field_u_variable_type,models_variable,err,error,*999)
4111  CALL field_parameter_set_data_get(models_field,field_u_variable_type,field_values_set_type, &
4112  & models_data,err,error,*999)
4113 
4114  !Get the state information if this environment has any.
4115  IF(ASSOCIATED(cellml_environment%STATE_FIELD)) THEN
4116  state_field=>cellml_environment%STATE_FIELD%STATE_FIELD
4117  IF(ASSOCIATED(state_field)) THEN
4118  CALL field_parameter_set_data_get(state_field,field_u_variable_type,field_values_set_type, &
4119  & state_data,err,error,*999)
4120  ELSE
4121  NULLIFY(state_data)
4122  ENDIF
4123  ELSE
4124  NULLIFY(state_data)
4125  ENDIF
4126 
4127  !Get the parameters information if this environment has any.
4128  IF(ASSOCIATED(cellml_environment%PARAMETERS_FIELD)) THEN
4129  parameters_field=>cellml_environment%PARAMETERS_FIELD%PARAMETERS_FIELD
4130  IF(ASSOCIATED(parameters_field)) THEN
4131  CALL field_parameter_set_data_get(parameters_field,field_u_variable_type,field_values_set_type, &
4132  & parameters_data,err,error,*999)
4133  ELSE
4134  NULLIFY(parameters_data)
4135  ENDIF
4136  ELSE
4137  NULLIFY(parameters_data)
4138  ENDIF
4139 
4140  !Get the intermediate information if this environment has any.
4141  IF(ASSOCIATED(cellml_environment%INTERMEDIATE_FIELD)) THEN
4142  intermediate_field=>cellml_environment%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD
4143  IF(ASSOCIATED(intermediate_field)) THEN
4144  CALL field_parameter_set_data_get(intermediate_field,field_u_variable_type,field_values_set_type, &
4145  & intermediate_data,err,error,*999)
4146  ELSE
4147  NULLIFY(intermediate_data)
4148  ENDIF
4149  ELSE
4150  NULLIFY(intermediate_data)
4151  ENDIF
4152 
4153  !Call the external solver to integrate these CellML equations
4154  CALL solver_dae_external_integrate(models_variable%TOTAL_NUMBER_OF_DOFS,dae_solver%START_TIME, &
4155  & dae_solver%END_TIME,dae_solver%INITIAL_STEP,cellml_environment%MODELS_FIELD% &
4156  & only_one_model_index,models_data,cellml_environment%MAXIMUM_NUMBER_OF_STATE,state_data, &
4157  & cellml_environment%MAXIMUM_NUMBER_OF_PARAMETERS,parameters_data,cellml_environment% &
4158  & maximum_number_of_intermediate,intermediate_data,err)
4159  IF(err/=0) THEN
4160  error="Error from external solver integrate."
4161  GOTO 999
4162  ENDIF
4163 
4164  !Restore field data
4165  CALL field_parameter_set_data_restore(models_field,field_u_variable_type,field_values_set_type, &
4166  & models_data,err,error,*999)
4167  IF(ASSOCIATED(state_field)) CALL field_parameter_set_data_restore(state_field,field_u_variable_type, &
4168  & field_values_set_type,state_data,err,error,*999)
4169  IF(ASSOCIATED(parameters_field)) CALL field_parameter_set_data_restore(parameters_field, &
4170  & field_u_variable_type,field_values_set_type,parameters_data,err,error,*999)
4171  IF(ASSOCIATED(intermediate_field)) CALL field_parameter_set_data_restore(intermediate_field, &
4172  & field_u_variable_type,field_values_set_type,intermediate_data,err,error,*999)
4173 
4174  !Make sure fields have been updated to the current value of any mapped CellML fields
4175  CALL cellml_cellml_to_field_update(cellml_environment,err,error,*999)
4176 
4177  ELSE
4178  local_error="The CellML models field is not associated for CellML index "// &
4179  & trim(numbertovstring(cellml_idx,"*",err,error))//"."
4180  CALL flagerror(local_error,err,error,*999)
4181  ENDIF
4182  ELSE
4183  local_error="The CellML models field is not associated for CellML index "// &
4184  & trim(numbertovstring(cellml_idx,"*",err,error))//"."
4185  CALL flagerror(local_error,err,error,*999)
4186  ENDIF
4187  ELSE
4188  local_error="The CellML enviroment is not associated for for CellML index "// &
4189  & trim(numbertovstring(cellml_idx,"*",err,error))//"."
4190  CALL flagerror(local_error,err,error,*999)
4191  ENDIF
4192  ENDDO !cellml_idx
4193  ELSE
4194  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
4195  ENDIF
4196  ELSE
4197  CALL flagerror("Solver is not associated.",err,error,*999)
4198  ENDIF
4199  ELSE
4200  CALL flagerror("Differential-algebraic equation solver is not associated.",err,error,*999)
4201  ENDIF
4202  ELSE
4203  CALL flagerror("External Euler differential-algebraic equation solver is not associated.",err,error,*999)
4204  ENDIF
4205 
4206  exits("SOLVER_DAE_EXTERNAL_SOLVE")
4207  RETURN
4208 999 errorsexits("SOLVER_DAE_EXTERNAL_SOLVE",err,error)
4209  RETURN 1
4210 
4211  END SUBROUTINE solver_dae_external_solve
4212 
4213  !
4214  !================================================================================================================================
4215  !
4216 
4218  SUBROUTINE solver_daecellmlrhsevaluate(model,time,stateStartIdx,stateDataOffset,stateData,parameterStartIdx,parameterDataOffset, &
4219  & parameterdata,intermediatestartidx,intermediatedataoffset,intermediatedata,ratestartidx,ratedataoffset,ratedata,err,error,*)
4220 
4221  !Argument variables
4222  TYPE(cellml_model_type), POINTER :: model
4223  REAL(DP), INTENT(IN) :: time
4224  INTEGER(INTG), INTENT(IN) :: stateStartIdx
4225  INTEGER(INTG), INTENT(IN) :: stateDataOffset
4226  REAL(DP), POINTER :: stateData(:)
4227  INTEGER(INTG), INTENT(IN) :: parameterStartIdx
4228  INTEGER(INTG), INTENT(IN) :: parameterDataOffset
4229  REAL(DP), POINTER :: parameterData(:)
4230  INTEGER(INTG), INTENT(IN) :: intermediateStartIdx
4231  INTEGER(INTG), INTENT(IN) :: intermediateDataOffset
4232  REAL(DP), POINTER :: intermediateData(:)
4233  INTEGER(INTG), INTENT(IN) :: rateStartIdx
4234  INTEGER(INTG), INTENT(IN) :: rateDataOffset
4235  REAL(DP), POINTER :: rateData(:)
4236  INTEGER(INTG), INTENT(OUT) :: err
4237  TYPE(varying_string), INTENT(OUT) :: error
4238  !Local Variables
4239  INTEGER(INTG) :: intermediateIdx,intermediateEndDOF,intermediateStartDOF,numberOfIntermediates,numberOfParameters, &
4240  & numberOfStates,parameterIdx,parameterEndDOF,parameterStartDOF,rateIdx,rateEndDOF,rateStartDOF,stateIdx,stateEndDOF, &
4241  & stateStartDOF
4242  REAL(DP) :: intermediates(max(1,intermediatedataoffset)),parameters(max(1,parameterdataoffset)),rates(max(1,ratedataoffset)), &
4243  & states(MAX(1,stateDataOffset))
4244 
4245  enters("Solver_DAECellMLRHSEvaluate",err,error,*999)
4246 
4247 #ifdef WITH_CELLML
4248 
4249  IF(ASSOCIATED(model)) THEN
4250  numberofstates=model%NUMBER_OF_STATE
4251  numberofintermediates=model%NUMBER_OF_INTERMEDIATE
4252  numberofparameters=model%NUMBER_OF_PARAMETERS
4253  IF(numberofstates>0) THEN
4254  IF(.NOT.ASSOCIATED(statedata)) CALL flagerror("State data is not associated.",err,error,*999)
4255  IF(.NOT.ASSOCIATED(ratedata)) CALL flagerror("Rate data is not associated.",err,error,*999)
4256  ENDIF
4257  IF(numberofparameters>0) THEN
4258  IF(.NOT.ASSOCIATED(parameterdata)) CALL flagerror("Parameter data is not associated.",err,error,*999)
4259  ENDIF
4260  IF(numberofintermediates>0) THEN
4261  IF(.NOT.ASSOCIATED(intermediatedata)) CALL flagerror("Intermediate data is not associated.",err,error,*999)
4262  ENDIF
4263  IF(statedataoffset>1.OR.numberofstates==0) THEN
4264  !State data is not contiguous or there are no states
4265 
4266  !Copy state data to temporary array
4267  DO stateidx=1,numberofstates
4268  states(stateidx)=statedata((statestartidx-1)*statedataoffset+stateidx)
4269  ENDDO !stateIdx
4270 
4271  IF(parameterdataoffset>1.OR.numberofparameters==0) THEN
4272  !Parameter data is not contiguous or there are no parameters
4273 
4274  !Copy parameter data to temporary array
4275  DO parameteridx=1,numberofparameters
4276  parameters(parameteridx)=parameterdata((parameterstartidx-1)*parameterdataoffset+parameteridx)
4277  ENDDO !parameterIdx
4278 
4279  IF(intermediatedataoffset>1.OR.numberofintermediates==0) THEN
4280  !Intermediate data is not contiguous or there are no intermediates
4281 
4282  IF(ratedataoffset>1.OR.numberofstates==0) THEN
4283  !Rates data is not contiguous or there are no rates
4284 
4285  CALL cellml_model_definition_call_rhs_routine(model%ptr,time,states,rates,intermediates,parameters)
4286 
4287  !Copy intermediate data from temporary array
4288  DO intermediateidx=1,numberofintermediates
4289  intermediatedata((intermediatestartidx-1)*intermediatedataoffset+intermediateidx)=intermediates(intermediateidx)
4290  ENDDO !intermediateIdx
4291 
4292  !Copy rate data from temporary array
4293  DO rateidx=1,numberofstates
4294  ratedata((ratestartidx-1)*ratedataoffset+rateidx)=rates(rateidx)
4295  ENDDO !rateIdx
4296 
4297  ELSE
4298  !Rates data is contiguous
4299 
4300  ratestartdof=(ratestartidx-1)*ratedataoffset+1
4301  rateenddof=ratestartdof+numberofstates-1
4302 
4303  CALL cellml_model_definition_call_rhs_routine(model%ptr,time,states,ratedata(ratestartdof:rateenddof), &
4304  & intermediates,parameters)
4305 
4306  !Copy intermediate data from temporary array
4307  DO intermediateidx=1,numberofintermediates
4308  intermediatedata((intermediatestartidx-1)*intermediatedataoffset+intermediateidx)=intermediates(intermediateidx)
4309  ENDDO !intermediateIdx
4310 
4311  ENDIF
4312 
4313  ELSE
4314  !Intermediate data is contiguous
4315 
4316  intermediatestartdof=(intermediatestartidx-1)*intermediatedataoffset+1
4317  intermediateenddof=intermediatestartdof+numberofintermediates-1
4318 
4319  IF(ratedataoffset>1.OR.numberofstates==0) THEN
4320  !Rates data is not contiguous or there are no rates
4321 
4322  CALL cellml_model_definition_call_rhs_routine(model%ptr,time,states,rates, &
4323  & intermediatedata(intermediatestartdof:intermediateenddof),parameters)
4324 
4325  !Copy rate data from temporary array
4326  DO rateidx=1,numberofstates
4327  ratedata((ratestartidx-1)*ratedataoffset+rateidx)=rates(rateidx)
4328  ENDDO !rateIdx
4329 
4330  ELSE
4331  !Rates data is contiguous
4332 
4333  ratestartdof=(ratestartidx-1)*ratedataoffset+1
4334  rateenddof=ratestartdof+numberofstates-1
4335 
4336  CALL cellml_model_definition_call_rhs_routine(model%ptr,time,states,ratedata(ratestartdof:rateenddof), &
4337  & intermediatedata(intermediatestartdof:intermediateenddof),parameters)
4338 
4339  ENDIF
4340  ENDIF
4341  ELSE
4342  !Parameters data is contiguous
4343 
4344  parameterstartdof=(parameterstartidx-1)*parameterdataoffset+1
4345  parameterenddof=parameterstartdof+numberofparameters-1
4346 
4347  IF(intermediatedataoffset>1.OR.numberofintermediates==0) THEN
4348  !Intermediate data is not contiguous or there are no intermediates
4349 
4350  IF(ratedataoffset>1.OR.numberofstates==0) THEN
4351  !Rates data is not contiguous or there are no rates
4352 
4353  CALL cellml_model_definition_call_rhs_routine(model%ptr,time,states,rates,intermediates, &
4354  & parameters(parameterstartdof:parameterenddof))
4355 
4356  !Copy intermediate data from temporary array
4357  DO intermediateidx=1,numberofintermediates
4358  intermediatedata((intermediatestartidx-1)*intermediatedataoffset+intermediateidx)=intermediates(intermediateidx)
4359  ENDDO !intermediateIdx
4360 
4361  !Copy rate data from temporary array
4362  DO rateidx=1,numberofstates
4363  ratedata((ratestartidx-1)*ratedataoffset+rateidx)=rates(rateidx)
4364  ENDDO !rateIdx
4365 
4366  ELSE
4367  !Rates data is contiguous
4368 
4369  ratestartdof=(ratestartidx-1)*ratedataoffset+1
4370  rateenddof=ratestartdof+numberofstates-1
4371 
4372  CALL cellml_model_definition_call_rhs_routine(model%ptr,time,states,ratedata(ratestartdof:rateenddof), &
4373  & intermediates,parameters(parameterstartdof:parameterenddof))
4374 
4375  !Copy intermediate data from temporary array
4376  DO intermediateidx=1,numberofintermediates
4377  intermediatedata((intermediatestartidx-1)*intermediatedataoffset+intermediateidx)=intermediates(intermediateidx)
4378  ENDDO !intermediateIdx
4379 
4380  ENDIF
4381 
4382  ELSE
4383  !Intermediate data is contiguous
4384 
4385  intermediatestartdof=(intermediatestartidx-1)*intermediatedataoffset+1
4386  intermediateenddof=intermediatestartdof+numberofintermediates-1
4387 
4388  IF(ratedataoffset>1.OR.numberofstates==0) THEN
4389  !Rates data is not contiguous or there are no rates
4390 
4391  CALL cellml_model_definition_call_rhs_routine(model%ptr,time,states,rates, &
4392  & intermediatedata(intermediatestartdof:intermediateenddof), &
4393  & parameters(parameterstartdof:parameterenddof))
4394 
4395  !Copy rate data from temporary array
4396  DO rateidx=1,numberofstates
4397  ratedata((ratestartidx-1)*ratedataoffset+rateidx)=rates(rateidx)
4398  ENDDO !rateIdx
4399 
4400  ELSE
4401  !Rates data is contiguous
4402 
4403  ratestartdof=(ratestartidx-1)*ratedataoffset+1
4404  rateenddof=ratestartdof+numberofstates-1
4405 
4406  CALL cellml_model_definition_call_rhs_routine(model%ptr,time,states,ratedata(ratestartdof:rateenddof), &
4407  & intermediatedata(intermediatestartdof:intermediateenddof), &
4408  & parameters(parameterstartdof:parameterenddof))
4409 
4410  ENDIF
4411  ENDIF
4412  ENDIF
4413  ELSE
4414  !State data is contiguous
4415 
4416  statestartdof=(statestartidx-1)*statedataoffset+1
4417  stateenddof=statestartdof+numberofstates-1
4418 
4419  IF(parameterdataoffset>1.OR.numberofparameters==0) THEN
4420  !Parameter data is not contiguous or there are no parameters
4421 
4422  !Copy parameter data to temporary array
4423  DO parameteridx=1,numberofparameters
4424  parameters(parameteridx)=parameterdata((parameterstartidx-1)*parameterdataoffset+parameteridx)
4425  ENDDO !parameterIdx
4426 
4427  IF(intermediatedataoffset>1.OR.numberofintermediates==0) THEN
4428  !Intermediate data is not contiguous or there are no intermediates
4429 
4430  IF(ratedataoffset>1.OR.numberofstates==0) THEN
4431  !Rates data is not contiguous or there are no rates
4432 
4433  CALL cellml_model_definition_call_rhs_routine(model%ptr,time,states(statestartdof:stateenddof), &
4434  & rates,intermediates,parameters)
4435 
4436  !Copy intermediate data from temporary array
4437  DO intermediateidx=1,numberofintermediates
4438  intermediatedata((intermediatestartidx-1)*intermediatedataoffset+intermediateidx)=intermediates(intermediateidx)
4439  ENDDO !intermediateIdx
4440 
4441  !Copy rate data from temporary array
4442  DO rateidx=1,numberofstates
4443  ratedata((ratestartidx-1)*ratedataoffset+rateidx)=rates(rateidx)
4444  ENDDO !rateIdx
4445 
4446  ELSE
4447  !Rates data is contiguous
4448 
4449  ratestartdof=(ratestartidx-1)*ratedataoffset+1
4450  rateenddof=ratestartdof+numberofstates-1
4451 
4452  CALL cellml_model_definition_call_rhs_routine(model%ptr,time,states(statestartdof:stateenddof), &
4453  & ratedata(ratestartdof:rateenddof),intermediates,parameters)
4454 
4455  !Copy intermediate data from temporary array
4456  DO intermediateidx=1,numberofintermediates
4457  intermediatedata((intermediatestartidx-1)*intermediatedataoffset+intermediateidx)=intermediates(intermediateidx)
4458  ENDDO !intermediateIdx
4459 
4460  ENDIF
4461 
4462  ELSE
4463  !Intermediate data is contiguous
4464 
4465  intermediatestartdof=(intermediatestartidx-1)*intermediatedataoffset+1
4466  intermediateenddof=intermediatestartdof+numberofintermediates-1
4467 
4468  IF(ratedataoffset>1.OR.numberofstates==0) THEN
4469  !Rates data is not contiguous or there are no rates
4470 
4471  CALL cellml_model_definition_call_rhs_routine(model%ptr,time,states(statestartdof:stateenddof),rates, &
4472  & intermediatedata(intermediatestartdof:intermediateenddof),parameters)
4473 
4474  !Copy rate data from temporary array
4475  DO rateidx=1,numberofstates
4476  ratedata((ratestartidx-1)*ratedataoffset+rateidx)=rates(rateidx)
4477  ENDDO !rateIdx
4478 
4479  ELSE
4480  !Rates data is contiguous
4481 
4482  ratestartdof=(ratestartidx-1)*ratedataoffset+1
4483  rateenddof=ratestartdof+numberofstates-1
4484 
4485  CALL cellml_model_definition_call_rhs_routine(model%ptr,time,states(statestartdof:stateenddof), &
4486  & ratedata(ratestartdof:rateenddof),intermediatedata(intermediatestartdof:intermediateenddof), &
4487  & parameters)
4488 
4489  ENDIF
4490  ENDIF
4491  ELSE
4492  !Parameters data is contiguous
4493 
4494  parameterstartdof=(parameterstartidx-1)*parameterdataoffset+1
4495  parameterenddof=parameterstartdof+numberofparameters-1
4496 
4497  IF(intermediatedataoffset>1.OR.numberofintermediates==0) THEN
4498  !Intermediate data is not contiguous or there are no intermediates
4499 
4500  IF(ratedataoffset>1.OR.numberofstates==0) THEN
4501  !Rates data is not contiguous or there are no rates
4502 
4503  CALL cellml_model_definition_call_rhs_routine(model%ptr,time,states(statestartdof:stateenddof), &
4504  & rates,intermediates,parameters(parameterstartdof:parameterenddof))
4505 
4506  !Copy intermediate data from temporary array
4507  DO intermediateidx=1,numberofintermediates
4508  intermediatedata((intermediatestartidx-1)*intermediatedataoffset+intermediateidx)=intermediates(intermediateidx)
4509  ENDDO !intermediateIdx
4510 
4511  !Copy rate data from temporary array
4512  DO rateidx=1,numberofstates
4513  ratedata((ratestartidx-1)*ratedataoffset+rateidx)=rates(rateidx)
4514  ENDDO !rateIdx
4515 
4516  ELSE
4517  !Rates data is contiguous
4518 
4519  ratestartdof=(ratestartidx-1)*ratedataoffset+1
4520  rateenddof=ratestartdof+numberofstates-1
4521 
4522  CALL cellml_model_definition_call_rhs_routine(model%ptr,time,states(statestartdof:stateenddof), &
4523  & ratedata(ratestartdof:rateenddof),intermediates,parameters(parameterstartdof:parameterenddof))
4524 
4525  !Copy intermediate data from temporary array
4526  DO intermediateidx=1,numberofintermediates
4527  intermediatedata((intermediatestartidx-1)*intermediatedataoffset+intermediateidx)=intermediates(intermediateidx)
4528  ENDDO !intermediateIdx
4529 
4530  ENDIF
4531 
4532  ELSE
4533  !Intermediate data is contiguous
4534 
4535  intermediatestartdof=(intermediatestartidx-1)*intermediatedataoffset+1
4536  intermediateenddof=intermediatestartdof+numberofintermediates-1
4537 
4538  IF(ratedataoffset>1.OR.numberofstates==0) THEN
4539  !Rates data is not contiguous or there are no rates
4540 
4541  CALL cellml_model_definition_call_rhs_routine(model%ptr,time,states(statestartdof:stateenddof), &
4542  & rates,intermediatedata(intermediatestartdof:intermediateenddof), &
4543  & parameters(parameterstartdof:parameterenddof))
4544 
4545  !Copy rate data from temporary array
4546  DO rateidx=1,numberofstates
4547  ratedata((ratestartidx-1)*ratedataoffset+rateidx)=rates(rateidx)
4548  ENDDO !rateIdx
4549 
4550  ELSE
4551  !Rates data is contiguous
4552 
4553  ratestartdof=(ratestartidx-1)*ratedataoffset+1
4554  rateenddof=ratestartdof+numberofstates-1
4555 
4556  CALL cellml_model_definition_call_rhs_routine(model%ptr,time,states(statestartdof:stateenddof), &
4557  & ratedata(ratestartdof:rateenddof),intermediatedata(intermediatestartdof:intermediateenddof), &
4558  & parameters(parameterstartdof:parameterenddof))
4559 
4560  ENDIF
4561  ENDIF
4562  ENDIF
4563  ENDIF
4564  ELSE
4565  CALL flagerror("Model is not associated.",err,error,*999)
4566  ENDIF
4567 
4568 #else
4569  CALL flagerror("Must compile with WITH_CELLML ON to use CellML functionality.",err,error,*999)
4570 #endif
4571 
4572  exits("Solver_DAECellMLRHSEvaluate")
4573  RETURN
4574 999 errorsexits("Solver_DAECellMLRHSEvaluate",err,error)
4575  RETURN 1
4576 
4577  END SUBROUTINE solver_daecellmlrhsevaluate
4578 
4579  !
4580  !================================================================================================================================
4581  !
4582 
4584  SUBROUTINE solver_dae_runge_kutta_finalise(RUNGE_KUTTA_SOLVER,ERR,ERROR,*)
4585 
4586  !Argument variables
4587  TYPE(runge_kutta_dae_solver_type), POINTER :: RUNGE_KUTTA_SOLVER
4588  INTEGER(INTG), INTENT(OUT) :: ERR
4589  TYPE(varying_string), INTENT(OUT) :: ERROR
4590  !Local Variables
4591 
4592  enters("SOLVER_DAE_RUNGE_KUTTA_FINALISE",err,error,*999)
4593 
4594  IF(ASSOCIATED(runge_kutta_solver)) THEN
4595  DEALLOCATE(runge_kutta_solver)
4596  ENDIF
4597 
4598  exits("SOLVER_DAE_RUNGE_KUTTA_FINALISE")
4599  RETURN
4600 999 errorsexits("SOLVER_DAE_RUNGE_KUTTA_FINALISE",err,error)
4601  RETURN 1
4602 
4603  END SUBROUTINE solver_dae_runge_kutta_finalise
4604 
4605  !
4606  !================================================================================================================================
4607  !
4608 
4610  SUBROUTINE solver_dae_runge_kutta_initialise(DAE_SOLVER,ERR,ERROR,*)
4611 
4612  !Argument variables
4613  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
4614  INTEGER(INTG), INTENT(OUT) :: ERR
4615  TYPE(varying_string), INTENT(OUT) :: ERROR
4616  !Local Variables
4617  INTEGER(INTG) :: DUMMY_ERR
4618  TYPE(varying_string) :: DUMMY_ERROR
4619 
4620  enters("SOLVER_DAE_RUNGE_KUTTA_INITIALISE",err,error,*998)
4621 
4622  IF(ASSOCIATED(dae_solver)) THEN
4623  IF(ASSOCIATED(dae_solver%RUNGE_KUTTA_SOLVER)) THEN
4624  CALL flagerror("Runge-Kutta solver is already associated for this differential-algebraic equation solver.",err,error,*998)
4625  ELSE
4626  !Allocate the Runge-Kutta solver
4627  ALLOCATE(dae_solver%RUNGE_KUTTA_SOLVER,stat=err)
4628  IF(err/=0) CALL flagerror("Could not allocate Runge-Kutta solver.",err,error,*999)
4629  !Initialise
4630  dae_solver%RUNGE_KUTTA_SOLVER%DAE_SOLVER=>dae_solver
4631  dae_solver%RUNGE_KUTTA_SOLVER%SOLVER_LIBRARY=0
4632  !Defaults
4633  ENDIF
4634  ELSE
4635  CALL flagerror("Differential-algebraic equation solver is not associated.",err,error,*998)
4636  ENDIF
4637 
4638  exits("SOLVER_DAE_RUNGE_KUTTA_INITIALISE")
4639  RETURN
4640 999 CALL solver_dae_runge_kutta_finalise(dae_solver%RUNGE_KUTTA_SOLVER,dummy_err,dummy_error,*998)
4641 998 errorsexits("SOLVER_DAE_RUNGE_KUTTA_INITIALISE",err,error)
4642  RETURN 1
4643 
4644  END SUBROUTINE solver_dae_runge_kutta_initialise
4645 
4646  !
4647  !================================================================================================================================
4648  !
4649 
4651  SUBROUTINE solver_dae_runge_kutta_solve(RUNGE_KUTTA_SOLVER,ERR,ERROR,*)
4652 
4653  !Argument variables
4654  TYPE(runge_kutta_dae_solver_type), POINTER :: RUNGE_KUTTA_SOLVER
4655  INTEGER(INTG), INTENT(OUT) :: ERR
4656  TYPE(varying_string), INTENT(OUT) :: ERROR
4657  !Local Variables
4658 
4659  enters("SOLVER_DAE_RUNGE_KUTTA_SOLVE",err,error,*999)
4660 
4661  IF(ASSOCIATED(runge_kutta_solver)) THEN
4662  CALL flagerror("Not implemented.",err,error,*999)
4663  ELSE
4664  CALL flagerror("Runge-Kutta differential-algebraic equation solver is not associated.",err,error,*999)
4665  ENDIF
4666 
4667  exits("SOLVER_DAE_RUNGE_KUTTA_SOLVE")
4668  RETURN
4669 999 errorsexits("SOLVER_DAE_RUNGE_KUTTA_SOLVE",err,error)
4670  RETURN 1
4671 
4672  END SUBROUTINE solver_dae_runge_kutta_solve
4673 
4674  !
4675  !================================================================================================================================
4676  !
4677 
4679  SUBROUTINE solver_dae_rush_larson_finalise(RUSH_LARSON_SOLVER,ERR,ERROR,*)
4680 
4681  !Argument variables
4682  TYPE(rush_larson_dae_solver_type), POINTER :: RUSH_LARSON_SOLVER
4683  INTEGER(INTG), INTENT(OUT) :: ERR
4684  TYPE(varying_string), INTENT(OUT) :: ERROR
4685  !Local Variables
4686 
4687  enters("SOLVER_DAE_RUSH_LARSON_FINALISE",err,error,*999)
4688 
4689  IF(ASSOCIATED(rush_larson_solver)) THEN
4690  DEALLOCATE(rush_larson_solver)
4691  ENDIF
4692 
4693  exits("SOLVER_DAE_RUSH_LARSON_FINALISE")
4694  RETURN
4695 999 errorsexits("SOLVER_DAE_RUSH_LARSON_FINALISE",err,error)
4696  RETURN 1
4697 
4698  END SUBROUTINE solver_dae_rush_larson_finalise
4699 
4700  !
4701  !================================================================================================================================
4702  !
4703 
4705  SUBROUTINE solver_dae_rush_larson_initialise(DAE_SOLVER,ERR,ERROR,*)
4706 
4707  !Argument variables
4708  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
4709  INTEGER(INTG), INTENT(OUT) :: ERR
4710  TYPE(varying_string), INTENT(OUT) :: ERROR
4711  !Local Variables
4712  INTEGER(INTG) :: DUMMY_ERR
4713  TYPE(varying_string) :: DUMMY_ERROR
4714 
4715  enters("SOLVER_DAE_RUSH_LARSON_INITIALISE",err,error,*998)
4716 
4717  IF(ASSOCIATED(dae_solver)) THEN
4718  IF(ASSOCIATED(dae_solver%RUSH_LARSON_SOLVER)) THEN
4719  CALL flagerror("Rush-Larson solver is already associated for this differential-algebraic equation solver.",err,error,*998)
4720  ELSE
4721  !Allocate the Rush-Larson solver
4722  ALLOCATE(dae_solver%RUSH_LARSON_SOLVER,stat=err)
4723  IF(err/=0) CALL flagerror("Could not allocate Rush-Larson solver.",err,error,*999)
4724  !Initialise
4725  dae_solver%RUSH_LARSON_SOLVER%DAE_SOLVER=>dae_solver
4726  dae_solver%RUSH_LARSON_SOLVER%SOLVER_LIBRARY=0
4727  !Defaults
4728  ENDIF
4729  ELSE
4730  CALL flagerror("Differential-algebraic equation solver is not associated.",err,error,*998)
4731  ENDIF
4732 
4733  exits("SOLVER_DAE_RUSH_LARSON_INITIALISE")
4734  RETURN
4735 999 CALL solver_dae_rush_larson_finalise(dae_solver%RUSH_LARSON_SOLVER,dummy_err,dummy_error,*998)
4736 998 errorsexits("SOLVER_DAE_RUSH_LARSON_INITIALISE",err,error)
4737  RETURN 1
4738 
4739  END SUBROUTINE solver_dae_rush_larson_initialise
4740 
4741  !
4742  !================================================================================================================================
4743  !
4744 
4746  SUBROUTINE solver_dae_rush_larson_solve(RUSH_LARSON_SOLVER,ERR,ERROR,*)
4747 
4748  !Argument variables
4749  TYPE(rush_larson_dae_solver_type), POINTER :: RUSH_LARSON_SOLVER
4750  INTEGER(INTG), INTENT(OUT) :: ERR
4751  TYPE(varying_string), INTENT(OUT) :: ERROR
4752  !Local Variables
4753 
4754  enters("SOLVER_DAE_RUSH_LARSON_SOLVE",err,error,*999)
4755 
4756  IF(ASSOCIATED(rush_larson_solver)) THEN
4757  CALL flagerror("Not implemented.",err,error,*999)
4758  ELSE
4759  CALL flagerror("Rush-Larson differential-algebraic equation solver is not associated.",err,error,*999)
4760  ENDIF
4761 
4762  exits("SOLVER_DAE_RUSH_LARSON_SOLVE")
4763  RETURN
4764 999 errorsexits("SOLVER_DAE_RUSH_LARSON_SOLVE",err,error)
4765  RETURN 1
4766 
4767  END SUBROUTINE solver_dae_rush_larson_solve
4768 
4769  !
4770  !================================================================================================================================
4771  !
4772 
4774  SUBROUTINE solver_dae_solve(DAE_SOLVER,ERR,ERROR,*)
4775 
4776  !Argument variables
4777  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
4778  INTEGER(INTG), INTENT(OUT) :: ERR
4779  TYPE(varying_string), INTENT(OUT) :: ERROR
4780  !Local Variables
4781  INTEGER(INTG) :: cellml_idx
4782  TYPE(cellml_type), POINTER :: CELLML
4783  TYPE(cellml_equations_type), POINTER :: CELLML_EQUATIONS
4784  TYPE(cellml_state_field_type), POINTER :: CELLML_STATE_FIELD
4785  TYPE(solver_type), POINTER :: SOLVER
4786  TYPE(varying_string) :: LOCAL_ERROR
4787 
4788  enters("SOLVER_DAE_SOLVE",err,error,*999)
4789 
4790  IF(ASSOCIATED(dae_solver)) THEN
4791  solver=>dae_solver%SOLVER
4792  IF(ASSOCIATED(solver)) THEN
4793  SELECT CASE(dae_solver%DAE_SOLVE_TYPE)
4794  CASE(solver_dae_euler)
4795  CALL solver_dae_euler_solve(dae_solver%EULER_SOLVER,err,error,*999)
4796  CASE(solver_dae_crank_nicolson)
4797  CALL solver_dae_crank_nicolson_solve(dae_solver%CRANK_NICOLSON_SOLVER,err,error,*999)
4798  CASE(solver_dae_runge_kutta)
4799  CALL solver_dae_runge_kutta_solve(dae_solver%RUNGE_KUTTA_SOLVER,err,error,*999)
4800  CASE(solver_dae_adams_moulton)
4801  CALL solver_dae_adams_moulton_solve(dae_solver%ADAMS_MOULTON_SOLVER,err,error,*999)
4802  CASE(solver_dae_bdf)
4803  CALL solver_dae_bdf_solve(dae_solver%BDF_SOLVER,err,error,*999)
4804  CASE(solver_dae_rush_larson)
4805  CALL solver_dae_rush_larson_solve(dae_solver%RUSH_LARSON_SOLVER,err,error,*999)
4806  CASE(solver_dae_external)
4807  CALL solver_dae_external_solve(dae_solver%EXTERNAL_SOLVER,err,error,*999)
4808  CASE DEFAULT
4809  local_error="The differential-algebraic equation solver solve type of "// &
4810  & trim(numbertovstring(dae_solver%DAE_SOLVE_TYPE,"*",err,error))//" is invalid."
4811  CALL flagerror(local_error,err,error,*999)
4812  END SELECT
4813  IF(solver%OUTPUT_TYPE>solver_solver_output) THEN
4814 #ifdef TAUPROF
4815  CALL tau_static_phase_start("Solution Output Phase")
4816 #endif
4817  cellml_equations=>solver%CELLML_EQUATIONS
4818  IF(ASSOCIATED(cellml_equations)) THEN
4819  CALL write_string(general_output_type,"",err,error,*999)
4820  CALL write_string(general_output_type,"Solver State vectors:",err,error,*999)
4821  CALL write_string_value(general_output_type,"Number of CellML environments = ",cellml_equations% &
4822  & number_of_cellml_environments,err,error,*999)
4823  DO cellml_idx=1,cellml_equations%NUMBER_OF_CELLML_ENVIRONMENTS
4824  cellml=>cellml_equations%CELLML_ENVIRONMENTS(cellml_idx)%PTR
4825  IF(ASSOCIATED(cellml)) THEN
4826  cellml_state_field=>cellml%STATE_FIELD
4827  IF(ASSOCIATED(cellml_state_field)) THEN
4828  CALL write_string_value(general_output_type,"CellML index : ",cellml_idx,err,error,*999)
4829  CALL field_parameter_set_output(general_output_type,cellml_state_field%STATE_FIELD,field_u_variable_type, &
4830  & field_values_set_type,err,error,*999)
4831  ELSE
4832  CALL flagerror("CellML environment state field is not associated.",err,error,*999)
4833  ENDIF
4834  ELSE
4835  local_error="CellML environment is not associated for CellML index "// &
4836  & trim(numbertovstring(cellml_idx,"*",err,error))//"."
4837  CALL flagerror(local_error,err,error,*999)
4838  ENDIF
4839  ENDDO !cellml_idx
4840 
4841  ELSE
4842  CALL flagerror("Solver CellML equations is not associated.",err,error,*999)
4843  ENDIF
4844 #ifdef TAUPROF
4845  CALL tau_static_phase_stop("Solution Output Phase")
4846 #endif
4847  ENDIF
4848  ELSE
4849  CALL flagerror("Differential-algebraic solver solver is not associated.",err,error,*999)
4850  ENDIF
4851  ELSE
4852  CALL flagerror("Differential-algebraic equation solver is not associated.",err,error,*999)
4853  ENDIF
4854 
4855  exits("SOLVER_DAE_SOLVE")
4856  RETURN
4857 999 errorsexits("SOLVER_DAE_SOLVE",err,error)
4858  RETURN 1
4859 
4860  END SUBROUTINE solver_dae_solve
4861 
4862  !
4863  !================================================================================================================================
4864  !
4865 
4867  SUBROUTINE solver_dae_solver_type_get(SOLVER,DAE_SOLVE_TYPE,ERR,ERROR,*)
4868 
4869  !Argument variables
4870  TYPE(solver_type), POINTER :: SOLVER
4871  INTEGER(INTG), INTENT(OUT) :: DAE_SOLVE_TYPE
4872  INTEGER(INTG), INTENT(OUT) :: ERR
4873  TYPE(varying_string), INTENT(OUT) :: ERROR
4874  !Local Variables
4875  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
4876 
4877  enters("SOLVER_DAE_SOLVER_TYPE_GET",err,error,*999)
4878 
4879  IF(ASSOCIATED(solver)) THEN
4880  IF(solver%SOLVER_FINISHED) THEN
4881  IF(solver%SOLVE_TYPE==solver_dae_type) THEN
4882  dae_solver=>solver%DAE_SOLVER
4883  IF(ASSOCIATED(dae_solver)) THEN
4884  dae_solve_type=dae_solver%DAE_SOLVE_TYPE
4885  ELSE
4886  CALL flagerror("The solver differential-algebraic equation solver is not associated.",err,error,*999)
4887  ENDIF
4888  ELSE
4889  CALL flagerror("The solver is not a differential-algebraic equation solver.",err,error,*999)
4890  ENDIF
4891  ELSE
4892  CALL flagerror("Solver has not been finished.",err,error,*999)
4893  ENDIF
4894  ELSE
4895  CALL flagerror("Solver is not associated.",err,error,*999)
4896  ENDIF
4897 
4898  exits("SOLVER_DAE_SOLVER_TYPE_GET")
4899  RETURN
4900 999 errorsexits("SOLVER_DAE_SOLVER_TYPE_GET",err,error)
4901  RETURN 1
4902 
4903  END SUBROUTINE solver_dae_solver_type_get
4904 
4905  !
4906  !================================================================================================================================
4907  !
4908 
4910  SUBROUTINE solver_dae_solver_type_set(SOLVER,DAE_SOLVE_TYPE,ERR,ERROR,*)
4911 
4912  !Argument variables
4913  TYPE(solver_type), POINTER :: SOLVER
4914  INTEGER(INTG), INTENT(IN) :: DAE_SOLVE_TYPE
4915  INTEGER(INTG), INTENT(OUT) :: ERR
4916  TYPE(varying_string), INTENT(OUT) :: ERROR
4917  !Local Variables
4918  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
4919  TYPE(varying_string) :: LOCAL_ERROR
4920 
4921  enters("SOLVER_DAE_SOLVER_TYPE_SET",err,error,*999)
4922 
4923  IF(ASSOCIATED(solver)) THEN
4924  IF(solver%SOLVER_FINISHED) THEN
4925  CALL flagerror("Solver has already been finished.",err,error,*999)
4926  ELSE
4927  IF(solver%SOLVE_TYPE==solver_dae_type) THEN
4928  dae_solver=>solver%DAE_SOLVER
4929  IF(ASSOCIATED(dae_solver)) THEN
4930  IF(dae_solve_type/=dae_solver%DAE_SOLVE_TYPE) THEN
4931  !Intialise the new differential-algebraic equation solver type
4932  SELECT CASE(dae_solve_type)
4933  CASE(solver_dae_euler)
4934  CALL solver_dae_euler_initialise(dae_solver,err,error,*999)
4935  CASE(solver_dae_crank_nicolson)
4936  CALL solver_dae_crank_nicolson_initialise(dae_solver,err,error,*999)
4937  CASE(solver_dae_runge_kutta)
4938  CALL solver_dae_runge_kutta_initialise(dae_solver,err,error,*999)
4939  CASE(solver_dae_adams_moulton)
4940  CALL solver_dae_adams_moulton_initialise(dae_solver,err,error,*999)
4941  CASE(solver_dae_bdf)
4942  CALL solver_dae_bdf_initialise(dae_solver,err,error,*999)
4943  CASE(solver_dae_rush_larson)
4944  CALL solver_dae_rush_larson_initialise(dae_solver,err,error,*999)
4945  CASE(solver_dae_external)
4946  CALL solver_dae_external_initialise(dae_solver,err,error,*999)
4947  CASE DEFAULT
4948  local_error="The specified differential-algebraic equation solver type of "// &
4949  & trim(numbertovstring(dae_solve_type,"*",err,error))//" is invalid."
4950  CALL flagerror(local_error,err,error,*999)
4951  END SELECT
4952  !Finalise the old differential-algebraic equation solver type
4953  SELECT CASE(dae_solver%DAE_SOLVE_TYPE)
4954  CASE(solver_dae_euler)
4955  CALL solver_dae_euler_finalise(dae_solver%EULER_SOLVER,err,error,*999)
4956  CASE(solver_dae_crank_nicolson)
4957  CALL solver_dae_crank_nicolson_finalise(dae_solver%CRANK_NICOLSON_SOLVER,err,error,*999)
4958  CASE(solver_dae_runge_kutta)
4959  CALL solver_dae_runge_kutta_finalise(dae_solver%RUNGE_KUTTA_SOLVER,err,error,*999)
4960  CASE(solver_dae_adams_moulton)
4961  CALL solver_dae_adams_moulton_finalise(dae_solver%ADAMS_MOULTON_SOLVER,err,error,*999)
4962  CASE(solver_dae_bdf)
4963  CALL solver_dae_bdf_finalise(dae_solver%BDF_SOLVER,err,error,*999)
4964  CASE(solver_dae_rush_larson)
4965  CALL solver_dae_rush_larson_finalise(dae_solver%RUSH_LARSON_SOLVER,err,error,*999)
4966  CASE(solver_dae_external)
4967  CALL solver_dae_external_finalise(dae_solver%EXTERNAL_SOLVER,err,error,*999)
4968  CASE DEFAULT
4969  local_error="The differential-algebraic equation solve type of "// &
4970  & trim(numbertovstring(dae_solver%DAE_SOLVE_TYPE,"*",err,error))//" is invalid."
4971  CALL flagerror(local_error,err,error,*999)
4972  END SELECT
4973  dae_solver%DAE_SOLVE_TYPE=dae_solve_type
4974  ENDIF
4975  ELSE
4976  CALL flagerror("The solver differential-algebraic equation solver is not associated.",err,error,*999)
4977  ENDIF
4978  ELSE
4979  CALL flagerror("The solver is not a differential-algebraic equation solver.",err,error,*999)
4980  ENDIF
4981  ENDIF
4982  ELSE
4983  CALL flagerror("Solver is not associated.",err,error,*999)
4984  ENDIF
4985 
4986  exits("SOLVER_DAE_SOLVER_TYPE_SET")
4987  RETURN
4988 999 errorsexits("SOLVER_DAE_SOLVER_TYPE_SET",err,error)
4989  RETURN 1
4990 
4991  END SUBROUTINE solver_dae_solver_type_set
4992 
4993  !
4994  !================================================================================================================================
4995  !
4996 
4998  SUBROUTINE solver_dae_times_set(SOLVER,START_TIME,END_TIME,ERR,ERROR,*)
4999 
5000  !Argument variables
5001  TYPE(solver_type), POINTER :: SOLVER
5002  REAL(DP), INTENT(IN) :: START_TIME
5003  REAL(DP), INTENT(IN) :: END_TIME
5004  INTEGER(INTG), INTENT(OUT) :: ERR
5005  TYPE(varying_string), INTENT(OUT) :: ERROR
5006  !Local Variables
5007  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
5008  TYPE(varying_string) :: LOCAL_ERROR
5009 
5010  enters("SOLVER_DAE_TIMES_SET",err,error,*999)
5011 
5012  IF(ASSOCIATED(solver)) THEN
5013  IF(solver%SOLVE_TYPE==solver_dae_type) THEN
5014  dae_solver=>solver%DAE_SOLVER
5015  IF(ASSOCIATED(dae_solver)) THEN
5016  IF(end_time>start_time) THEN
5017  dae_solver%START_TIME=start_time
5018  dae_solver%END_TIME=end_time
5019  ELSE
5020  local_error="The specified end time of "//trim(numbertovstring(end_time,"*",err,error))// &
5021  & " is not > than the specified start time of "//trim(numbertovstring(start_time,"*",err,error))//"."
5022  CALL flagerror(local_error,err,error,*999)
5023  ENDIF
5024  ELSE
5025  CALL flagerror("Differential-algebraic equation solver is not associated.",err,error,*999)
5026  ENDIF
5027  ELSE
5028  CALL flagerror("The solver is not a differential-algebraic equation solver.",err,error,*999)
5029  ENDIF
5030  ELSE
5031  CALL flagerror("Solver is not associated.",err,error,*999)
5032  ENDIF
5033 
5034  exits("SOLVER_DAE_TIMES_SET")
5035  RETURN
5036 999 errorsexits("SOLVER_DAE_TIMES_SET",err,error)
5037  RETURN 1
5038 
5039  END SUBROUTINE solver_dae_times_set
5040 
5041  !
5042  !================================================================================================================================
5043  !
5044 
5046  SUBROUTINE solver_dae_time_step_set(SOLVER,TIME_STEP,ERR,ERROR,*)
5047 
5048  !Argument variables
5049  TYPE(solver_type), POINTER :: SOLVER
5050  REAL(DP), INTENT(IN) :: TIME_STEP
5051  INTEGER(INTG), INTENT(OUT) :: ERR
5052  TYPE(varying_string), INTENT(OUT) :: ERROR
5053  !Local Variables
5054  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
5055  TYPE(varying_string) :: LOCAL_ERROR
5056 
5057  enters("SOLVER_DAE_TIME_STEP_SET",err,error,*999)
5058 
5059  IF(ASSOCIATED(solver)) THEN
5060  IF(solver%SOLVE_TYPE==solver_dae_type) THEN
5061  dae_solver=>solver%DAE_SOLVER
5062  IF(ASSOCIATED(dae_solver)) THEN
5063  IF(abs(time_step)<=zero_tolerance) THEN
5064  local_error="The specified time step of "//trim(numbertovstring(time_step,"*",err,error))// &
5065  & " is invalid. The time step must not be zero."
5066  CALL flagerror(local_error,err,error,*999)
5067  ELSE
5068  dae_solver%INITIAL_STEP=time_step
5069  ENDIF
5070  ELSE
5071  CALL flagerror("Differential-algebraic equation solver is not associated.",err,error,*999)
5072  ENDIF
5073  ELSE
5074  CALL flagerror("The solver is not a differential-algebraic equation solver.",err,error,*999)
5075  ENDIF
5076  ELSE
5077  CALL flagerror("Solver is not associated.",err,error,*999)
5078  ENDIF
5079 
5080  exits("SOLVER_DAE_TIME_STEP_SET")
5081  RETURN
5082 999 errorsexits("SOLVER_DAE_TIME_STEP_SET",err,error)
5083  RETURN 1
5084 
5085  END SUBROUTINE solver_dae_time_step_set
5086 
5087  !
5088  !================================================================================================================================
5089  !
5090 
5092  SUBROUTINE solver_destroy(SOLVER,ERR,ERROR,*)
5093 
5094  !Argument variables
5095  TYPE(solver_type), POINTER :: SOLVER
5096  INTEGER(INTG), INTENT(OUT) :: ERR
5097  TYPE(varying_string), INTENT(OUT) :: ERROR
5098  !Local Variables
5099 
5100  enters("SOLVER_DESTROY",err,error,*999)
5101 
5102  IF(ASSOCIATED(solver)) THEN
5103  CALL flagerror("Not implemented.",err,error,*999)
5104  ELSE
5105  CALL flagerror("Solver is not associated.",err,error,*999)
5106  ENDIF
5107 
5108  exits("SOLVER_DESTROY")
5109  RETURN
5110 999 errorsexits("SOLVER_DESTROY",err,error)
5111  RETURN 1
5112 
5113  END SUBROUTINE solver_destroy
5114 
5115  !
5116  !================================================================================================================================
5117  !
5118 
5120  SUBROUTINE solver_dynamic_create_finish(DYNAMIC_SOLVER,ERR,ERROR,*)
5121 
5122  !Argument variables
5123  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
5124  INTEGER(INTG), INTENT(OUT) :: ERR
5125  TYPE(varying_string), INTENT(OUT) :: ERROR
5126  !Local Variables
5127  INTEGER(INTG) :: DYNAMIC_VARIABLE_TYPE,equations_matrix_idx,equations_set_idx,LINEAR_LIBRARY_TYPE,NONLINEAR_LIBRARY_TYPE
5128  INTEGER(INTG) :: VariableType=0
5129  TYPE(equations_type), POINTER :: EQUATIONS
5130  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
5131  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
5132  TYPE(equations_mapping_nonlinear_type), POINTER :: NonlinearMapping
5133  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
5134  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
5135  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
5136  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
5137  TYPE(equations_matrix_type), POINTER :: DAMPING_MATRIX,EQUATIONS_MATRIX,MASS_MATRIX
5138  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
5139  TYPE(field_type), POINTER :: DEPENDENT_FIELD !, INDEPENDENT_FIELD
5140  TYPE(field_variable_type), POINTER :: DYNAMIC_VARIABLE,LINEAR_VARIABLE,ResidualVariable
5141  TYPE(solver_type), POINTER :: SOLVER,LINEAR_SOLVER,NONLINEAR_SOLVER
5142  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
5143  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
5144  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
5145  TYPE(varying_string) :: LOCAL_ERROR
5146 
5147  enters("SOLVER_DYNAMIC_CREATE_FINISH",err,error,*999)
5148 
5149  IF(ASSOCIATED(dynamic_solver)) THEN
5150  solver=>dynamic_solver%SOLVER
5151  IF(ASSOCIATED(solver)) THEN
5152  solver_equations=>solver%SOLVER_EQUATIONS
5153  IF(ASSOCIATED(solver_equations)) THEN
5154  SELECT CASE(dynamic_solver%SOLVER_LIBRARY)
5155  CASE(solver_cmiss_library)
5156  !Create the parameter sets required for the solver
5157  solver_equations=>solver%SOLVER_EQUATIONS
5158  IF(ASSOCIATED(solver_equations)) THEN
5159  solver_mapping=>solver_equations%SOLVER_MAPPING
5160  IF(ASSOCIATED(solver_mapping)) THEN
5161  !Initialise for explicit solve
5162  dynamic_solver%EXPLICIT=abs(dynamic_solver%THETA(dynamic_solver%DEGREE))<zero_tolerance
5163  !Loop over the equations set in the solver equations
5164  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
5165  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)%EQUATIONS
5166  IF(ASSOCIATED(equations)) THEN
5167  equations_set=>equations%EQUATIONS_SET
5168  IF(ASSOCIATED(equations_set)) THEN
5169  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
5170  IF(ASSOCIATED(dependent_field)) THEN
5171  equations_mapping=>equations%EQUATIONS_MAPPING
5172  IF(ASSOCIATED(equations_mapping)) THEN
5173  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
5174  IF(ASSOCIATED(dynamic_mapping)) THEN
5175  dynamic_variable=>dynamic_mapping%DYNAMIC_VARIABLE
5176  dynamic_variable_type=dynamic_mapping%DYNAMIC_VARIABLE_TYPE
5177  IF(ASSOCIATED(dynamic_variable)) THEN
5178  !Set up the parameter sets to hold the required solver parameters
5179  !1st degree or higher so set up displacement parameter sets
5180 
5181 
5182 
5183  IF(dynamic_solver%DEGREE>=solver_dynamic_second_degree) THEN
5184  !2nd degree or higher so set up velocity parameter sets
5185  CALL field_parametersetensurecreated(dependent_field,dynamic_variable_type, &
5186  & field_velocity_values_set_type,err,error,*999)
5187  CALL field_parametersetensurecreated(dependent_field,dynamic_variable_type, &
5188  & field_previous_velocity_set_type,err,error,*999)
5189  CALL field_parametersetensurecreated(dependent_field, &
5190  & dynamic_variable_type,field_mean_predicted_velocity_set_type,err,error,*999)
5191  IF(dynamic_solver%DEGREE>=solver_dynamic_third_degree) THEN
5192  !3rd degree or higher so set up acceleration parameter sets
5193  CALL field_parametersetensurecreated(dependent_field,dynamic_variable_type, &
5194  & field_acceleration_values_set_type,err,error,*999)
5195  CALL field_parametersetensurecreated(dependent_field,dynamic_variable_type, &
5196  & field_previous_acceleration_set_type,err,error,*999)
5197  CALL field_parametersetensurecreated( &
5198  & dependent_field,dynamic_variable_type,field_mean_predicted_acceleration_set_type, &
5199  & err,error,*999)
5200  ENDIF
5201  ENDIF
5202 
5203 
5204 
5205  !Create the dynamic matrices temporary vector for matrix-vector products
5206  equations_matrices=>equations%EQUATIONS_MATRICES
5207  IF(ASSOCIATED(equations_matrices)) THEN
5208  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
5209  IF(ASSOCIATED(dynamic_matrices)) THEN
5210  IF(.NOT.ASSOCIATED(dynamic_matrices%TEMP_VECTOR)) THEN
5211  CALL distributed_vector_create_start(dynamic_variable%DOMAIN_MAPPING, &
5212  & dynamic_matrices%TEMP_VECTOR,err,error,*999)
5213  CALL distributed_vector_data_type_set(dynamic_matrices%TEMP_VECTOR, &
5214  & distributed_matrix_vector_dp_type,err,error,*999)
5215  CALL distributed_vector_create_finish(dynamic_matrices%TEMP_VECTOR,err,error,*999)
5216  ENDIF
5217  !Check to see if we have an explicit solve
5218  IF(abs(dynamic_solver%THETA(dynamic_solver%DEGREE))<zero_tolerance) THEN
5219  IF(dynamic_mapping%DAMPING_MATRIX_NUMBER/=0) THEN
5220  damping_matrix=>dynamic_matrices%MATRICES(dynamic_mapping%DAMPING_MATRIX_NUMBER)%PTR
5221  IF(ASSOCIATED(damping_matrix)) THEN
5222  dynamic_solver%EXPLICIT=dynamic_solver%EXPLICIT.AND.damping_matrix%LUMPED
5223  ELSE
5224  CALL flagerror("Damping matrix is not associated.",err,error,*999)
5225  ENDIF
5226  ENDIF
5227  IF(dynamic_mapping%MASS_MATRIX_NUMBER/=0) THEN
5228  mass_matrix=>dynamic_matrices%MATRICES(dynamic_mapping%MASS_MATRIX_NUMBER)%PTR
5229  IF(ASSOCIATED(mass_matrix)) THEN
5230  dynamic_solver%EXPLICIT=dynamic_solver%EXPLICIT.AND.mass_matrix%LUMPED
5231  ELSE
5232  CALL flagerror("Mass matrix is not associated.",err,error,*999)
5233  ENDIF
5234  ENDIF
5235  ENDIF
5236  ELSE
5237  CALL flagerror("Equations matrices dynamic matrices are not associated.",err,error,*999)
5238  ENDIF
5239  ELSE
5240  CALL flagerror("Equations equations matrices is not associated.",err,error,*999)
5241  ENDIF
5242  variabletype=dynamic_variable_type
5243  ELSE
5244  CALL flagerror("Dynamic mapping dynamic variable is not associated.",err,error,*999)
5245  ENDIF
5246  ENDIF
5247 
5248 
5249  IF(variabletype==0) THEN
5250  !We now allow for static equation sets for dynamic solvers to be able to couple static eqs - dynamic eqs
5251  nonlinearmapping=>equations_mapping%NONLINEAR_MAPPING
5252  IF(ASSOCIATED(nonlinearmapping)) THEN
5253  IF(dynamic_solver%LINEARITY==solver_dynamic_nonlinear) THEN
5254  !Default to first variable type for now
5255  residualvariable=>nonlinearmapping%RESIDUAL_VARIABLES(1)%PTR
5256  IF(ASSOCIATED(residualvariable)) THEN
5257  variabletype=residualvariable%VARIABLE_TYPE
5258  ELSE
5259  CALL flagerror("Residual variable is not associated.",err,error,*999)
5260  ENDIF
5261  ELSE
5262  local_error="The specified dynamic solver linearity type of "// &
5263  & trim(numbertovstring(dynamic_solver%LINEARITY,"*",err,error))// &
5264  & " is invalid for a nonlinear equations mapping."
5265  CALL flagerror(local_error,err,error,*999)
5266  ENDIF
5267  ENDIF
5268  ENDIF
5269  CALL field_parametersetensurecreated(dependent_field,variabletype, &
5270  & field_previous_values_set_type,err,error,*999)
5271  CALL field_parametersetensurecreated(dependent_field,variabletype, &
5272  & field_mean_predicted_displacement_set_type,err,error,*999)
5273 
5274  CALL field_parametersetensurecreated(dependent_field,variabletype, &
5275  & field_incremental_values_set_type,err,error,*999)
5276  CALL field_parametersetensurecreated(dependent_field,variabletype, &
5277  & field_predicted_displacement_set_type,err,error,*999)
5278  CALL field_parametersetensurecreated(dependent_field,variabletype, &
5279  & field_residual_set_type,err,error,*999)
5280  CALL field_parametersetensurecreated(dependent_field,variabletype, &
5281  & field_previous_residual_set_type,err,error,*999)
5282 
5283 
5284  !Check if there are any linear mappings
5285  linear_mapping=>equations_mapping%LINEAR_MAPPING
5286  IF(ASSOCIATED(linear_mapping)) THEN
5287  !If there are any linear matrices create temporary vector for matrix-vector products
5288  equations_matrices=>equations%EQUATIONS_MATRICES
5289  IF(ASSOCIATED(equations_matrices)) THEN
5290  linear_matrices=>equations_matrices%LINEAR_MATRICES
5291  IF(ASSOCIATED(linear_matrices)) THEN
5292  DO equations_matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
5293  equations_matrix=>linear_matrices%MATRICES(equations_matrix_idx)%PTR
5294  IF(ASSOCIATED(equations_matrix)) THEN
5295  IF(.NOT.ASSOCIATED(equations_matrix%TEMP_VECTOR)) THEN
5296  linear_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(equations_matrix_idx)%VARIABLE
5297  IF(ASSOCIATED(linear_variable)) THEN
5298  CALL distributed_vector_create_start(linear_variable%DOMAIN_MAPPING, &
5299  & equations_matrix%TEMP_VECTOR,err,error,*999)
5300  CALL distributed_vector_data_type_set(equations_matrix%TEMP_VECTOR, &
5301  & distributed_matrix_vector_dp_type,err,error,*999)
5302  CALL distributed_vector_create_finish(equations_matrix%TEMP_VECTOR,err,error,*999)
5303  ELSE
5304  CALL flagerror("Linear mapping linear variable is not associated.",err,error,*999)
5305  ENDIF
5306  ENDIF
5307  ELSE
5308  CALL flagerror("Equations matrix is not associated.",err,error,*999)
5309  ENDIF
5310  ENDDO !equations_matrix_idx
5311  ELSE
5312  CALL flagerror("Equations matrices linear matrices is not associated.",err,error,*999)
5313  ENDIF
5314  ELSE
5315  CALL flagerror("Equations equations matrices is not associated.",err,error,*999)
5316  ENDIF
5317  ENDIF
5318  ELSE
5319  CALL flagerror("Equations equations mapping is not associated.",err,error,*999)
5320  ENDIF
5321  ELSE
5322  local_error="Equations set dependent field is not associated for equations set index "// &
5323  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
5324  CALL flagerror(local_error,err,error,*999)
5325  ENDIF
5326  ELSE
5327  local_error="Equations equations set is not associated for equations set index "// &
5328  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
5329  CALL flagerror(local_error,err,error,*999)
5330  ENDIF
5331  ELSE
5332  local_error="Equations is not associated for equations set index "// &
5333  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
5334  CALL flagerror(local_error,err,error,*999)
5335  ENDIF
5336  ENDDO !equations_set_idx
5337  !Create the solver matrices and vectors
5338  IF(dynamic_solver%LINEARITY==solver_dynamic_linear) THEN
5339  linear_solver=>dynamic_solver%LINEAR_SOLVER
5340  IF(ASSOCIATED(linear_solver)) THEN
5341  NULLIFY(solver_matrices)
5342  CALL solver_matrices_create_start(solver_equations,solver_matrices,err,error,*999)
5343  CALL solver_matrices_library_type_get(linear_solver,linear_library_type,err,error,*999)
5344  CALL solver_matrices_library_type_set(solver_matrices,linear_library_type,err,error,*999)
5345  IF(dynamic_solver%EXPLICIT) THEN
5346  CALL solver_matrices_storage_type_set(solver_matrices,[distributed_matrix_diagonal_storage_type], &
5347  & err,error,*999)
5348  ELSE
5349  SELECT CASE(solver_equations%SPARSITY_TYPE)
5350  CASE(solver_sparse_matrices)
5351  CALL solver_matrices_storage_type_set(solver_matrices,[distributed_matrix_compressed_row_storage_type], &
5352  & err,error,*999)
5353  CASE(solver_full_matrices)
5354  CALL solver_matrices_storage_type_set(solver_matrices,[distributed_matrix_block_storage_type], &
5355  & err,error,*999)
5356  CASE DEFAULT
5357  local_error="The specified solver equations sparsity type of "// &
5358  & trim(numbertovstring(solver_equations%SPARSITY_TYPE,"*",err,error))// &
5359  & " is invalid."
5360  CALL flagerror(local_error,err,error,*999)
5361  END SELECT
5362  ENDIF
5363  CALL solver_matrices_create_finish(solver_matrices,err,error,*999)
5364  !Link linear solver
5365  linear_solver%SOLVER_EQUATIONS=>solver%SOLVER_EQUATIONS
5366  !Finish the creation of the linear solver
5367  CALL solver_linear_create_finish(linear_solver%LINEAR_SOLVER,err,error,*999)
5368  ELSE
5369  CALL flagerror("Dynamic solver linear solver is not associated.",err,error,*999)
5370  ENDIF
5371  ELSE IF(dynamic_solver%LINEARITY==solver_dynamic_nonlinear) THEN
5372  nonlinear_solver=>dynamic_solver%NONLINEAR_SOLVER
5373  IF(ASSOCIATED(nonlinear_solver)) THEN
5374  NULLIFY(solver_matrices)
5375  CALL solver_matrices_create_start(solver_equations,solver_matrices,err,error,*999)
5376  CALL solver_matrices_library_type_get(nonlinear_solver,nonlinear_library_type,err,error,*999)
5377  CALL solver_matrices_library_type_set(solver_matrices,nonlinear_library_type,err,error,*999)
5378  IF(dynamic_solver%EXPLICIT) THEN
5379  CALL solver_matrices_storage_type_set(solver_matrices,[distributed_matrix_diagonal_storage_type], &
5380  & err,error,*999)
5381  ELSE
5382  SELECT CASE(solver_equations%SPARSITY_TYPE)
5383  CASE(solver_sparse_matrices)
5384  CALL solver_matrices_storage_type_set(solver_matrices,[distributed_matrix_compressed_row_storage_type], &
5385  & err,error,*999)
5386  CASE(solver_full_matrices)
5387  CALL solver_matrices_storage_type_set(solver_matrices,[distributed_matrix_block_storage_type], &
5388  & err,error,*999)
5389  CASE DEFAULT
5390  local_error="The specified solver equations sparsity type of "// &
5391  & trim(numbertovstring(solver_equations%SPARSITY_TYPE,"*",err,error))// &
5392  & " is invalid."
5393  CALL flagerror(local_error,err,error,*999)
5394  END SELECT
5395  ENDIF
5396  CALL solver_matrices_create_finish(solver_matrices,err,error,*999)
5397  !Link nonlinear solver
5398  nonlinear_solver%SOLVER_EQUATIONS=>solver%SOLVER_EQUATIONS
5399  !Finish the creation of the nonlinear solver
5400  CALL solver_nonlinear_create_finish(nonlinear_solver%NONLINEAR_SOLVER,err,error,*999)
5401  ELSE
5402  CALL flagerror("Dynamic solver linear solver is not associated.",err,error,*999)
5403  ENDIF
5404  ENDIF
5405  ELSE
5406  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
5407  ENDIF
5408  ELSE
5409  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
5410  ENDIF
5411  CASE(solver_petsc_library)
5412  CALL flagerror("Not implemented.",err,error,*999)
5413  CASE DEFAULT
5414  local_error="The solver library type of "// &
5415  & trim(numbertovstring(dynamic_solver%SOLVER_LIBRARY,"*",err,error))//" is invalid."
5416  CALL flagerror(local_error,err,error,*999)
5417  END SELECT
5418  ELSE
5419  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
5420  ENDIF
5421  ELSE
5422  CALL flagerror("Dynamic solver solver is not associated.",err,error,*999)
5423  ENDIF
5424  ELSE
5425  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
5426  ENDIF
5427 
5428  exits("SOLVER_DYNAMIC_CREATE_FINISH")
5429  RETURN
5430 999 errorsexits("SOLVER_DYNAMIC_CREATE_FINISH",err,error)
5431  RETURN 1
5432 
5433  END SUBROUTINE solver_dynamic_create_finish
5434 
5435  !
5436  !================================================================================================================================
5437  !
5438 
5440  SUBROUTINE solver_dynamic_degree_get(SOLVER,DEGREE,ERR,ERROR,*)
5441 
5442  !Argument variables
5443  TYPE(solver_type), POINTER :: SOLVER
5444  INTEGER(INTG), INTENT(OUT) :: DEGREE
5445  INTEGER(INTG), INTENT(OUT) :: ERR
5446  TYPE(varying_string), INTENT(OUT) :: ERROR
5447  !Local Variables
5448  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
5449 
5450  enters("SOLVER_DYNAMIC_DEGREE_GET",err,error,*999)
5451 
5452  IF(ASSOCIATED(solver)) THEN
5453  IF(solver%SOLVER_FINISHED) THEN
5454  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
5455  dynamic_solver=>solver%DYNAMIC_SOLVER
5456  IF(ASSOCIATED(dynamic_solver)) THEN
5457  degree=dynamic_solver%DEGREE
5458  ELSE
5459  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
5460  ENDIF
5461  ELSE
5462  CALL flagerror("The specified solver is not a dynamic solver.",err,error,*999)
5463  ENDIF
5464  ELSE
5465  CALL flagerror("The solver has not been finished.",err,error,*999)
5466  ENDIF
5467  ELSE
5468  CALL flagerror("Solver is not associated.",err,error,*999)
5469  ENDIF
5470 
5471  exits("SOLVER_DYNAMIC_DEGREE_GET")
5472  RETURN
5473 999 errorsexits("SOLVER_DYNAMIC_DEGREE_GET",err,error)
5474  RETURN 1
5475 
5476  END SUBROUTINE solver_dynamic_degree_get
5477 
5478  !
5479  !================================================================================================================================
5480  !
5481 
5483  SUBROUTINE solver_dynamic_degree_set(SOLVER,DEGREE,ERR,ERROR,*)
5484 
5485  !Argument variables
5486  TYPE(solver_type), POINTER :: SOLVER
5487  INTEGER(INTG), INTENT(IN) :: DEGREE
5488  INTEGER(INTG), INTENT(OUT) :: ERR
5489  TYPE(varying_string), INTENT(OUT) :: ERROR
5490  !Local Variables
5491  INTEGER(INTG) :: degree_idx
5492  REAL(DP), ALLOCATABLE :: OLD_THETA(:)
5493  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
5494  TYPE(varying_string) :: LOCAL_ERROR
5495 
5496  enters("SOLVER_DYNAMIC_DEGREE_SET",err,error,*999)
5497 
5498  IF(ASSOCIATED(solver)) THEN
5499  IF(solver%SOLVER_FINISHED) THEN
5500  CALL flagerror("The solver has already been finished.",err,error,*999)
5501  ELSE
5502  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
5503  dynamic_solver=>solver%DYNAMIC_SOLVER
5504  IF(ASSOCIATED(dynamic_solver)) THEN
5505  IF(degree/=dynamic_solver%DEGREE) THEN
5506  IF(degree>=dynamic_solver%ORDER) THEN
5507  SELECT CASE(degree)
5508  CASE(solver_dynamic_first_degree,solver_dynamic_second_degree,solver_dynamic_third_degree)
5509  ALLOCATE(old_theta(dynamic_solver%DEGREE),stat=err)
5510  IF(err/=0) CALL flagerror("Could not allocate old theta.",err,error,*999)
5511  old_theta(1:dynamic_solver%DEGREE)=dynamic_solver%THETA(1:dynamic_solver%DEGREE)
5512  IF(ALLOCATED(dynamic_solver%THETA)) DEALLOCATE(dynamic_solver%THETA)
5513  ALLOCATE(dynamic_solver%THETA(degree),stat=err)
5514  IF(err/=0) CALL flagerror("Could not allocate theta.",err,error,*999)
5515  IF(degree>dynamic_solver%DEGREE) THEN
5516  DO degree_idx=1,dynamic_solver%DEGREE
5517  dynamic_solver%THETA(degree_idx)=old_theta(degree_idx)
5518  ENDDO !degree_idx
5519  DO degree_idx=dynamic_solver%DEGREE+1,degree
5520  dynamic_solver%THETA(degree_idx)=1.0_dp
5521  ENDDO !degree_idx
5522  ELSE
5523  DO degree_idx=1,degree
5524  dynamic_solver%THETA(degree_idx)=old_theta(degree_idx)
5525  ENDDO !degree_idx
5526  ENDIF
5527  IF(ALLOCATED(old_theta)) DEALLOCATE(old_theta)
5528  dynamic_solver%DEGREE=degree
5529  CASE DEFAULT
5530  local_error="The specified degree of "//trim(numbertovstring(degree,"*",err,error))//" is invalid."
5531  CALL flagerror(local_error,err,error,*999)
5532  END SELECT
5533  ELSE
5534  local_error="Invalid dynamic solver setup. The specfied degree of "// &
5535  & trim(numbertovstring(degree,"*",err,error))//" must be >= the current dynamic order of "// &
5536  & trim(numbertovstring(dynamic_solver%ORDER,"*",err,error))//"."
5537  CALL flagerror(local_error,err,error,*999)
5538  ENDIF
5539  ENDIF
5540  ELSE
5541  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
5542  ENDIF
5543  ELSE
5544  CALL flagerror("The specified solver is not a dynamic solver.",err,error,*999)
5545  ENDIF
5546  ENDIF
5547  ELSE
5548  CALL flagerror("Solver is not associated.",err,error,*999)
5549  ENDIF
5550 
5551  exits("SOLVER_DYNAMIC_DEGREE_SET")
5552  RETURN
5553 999 IF(ALLOCATED(old_theta)) DEALLOCATE(old_theta)
5554  errorsexits("SOLVER_DYNAMIC_DEGREE_SET",err,error)
5555  RETURN 1
5556  END SUBROUTINE solver_dynamic_degree_set
5557 
5558  !
5559  !================================================================================================================================
5560  !
5561 
5563  RECURSIVE SUBROUTINE solver_dynamic_finalise(DYNAMIC_SOLVER,ERR,ERROR,*)
5564 
5565  !Argument variables
5566  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
5567  INTEGER(INTG), INTENT(OUT) :: ERR
5568  TYPE(varying_string), INTENT(OUT) :: ERROR
5569  !Local Variables
5570 
5571  enters("SOLVER_DYNAMIC_FINALISE",err,error,*999)
5572  IF(ASSOCIATED(dynamic_solver)) THEN
5573  IF(ALLOCATED(dynamic_solver%THETA)) THEN
5574 ! CALL WRITE_STRING_VALUE(GENERAL_OUTPUT_TYPE," Dynamic solver - theta = ",DYNAMIC_SOLVER%THETA(1), &
5575 ! & ERR,ERROR,*999)
5576  DEALLOCATE(dynamic_solver%THETA)
5577  ENDIF
5578  CALL solver_finalise(dynamic_solver%LINEAR_SOLVER,err,error,*999)
5579  CALL solver_finalise(dynamic_solver%NONLINEAR_SOLVER,err,error,*999)
5580  DEALLOCATE(dynamic_solver)
5581  ENDIF
5582 
5583  exits("SOLVER_DYNAMIC_FINALISE")
5584  RETURN
5585 999 errorsexits("SOLVER_DYNAMIC_FINALISE",err,error)
5586  RETURN 1
5587 
5588  END SUBROUTINE solver_dynamic_finalise
5589 
5590  !
5591  !================================================================================================================================
5592  !
5593 
5595  SUBROUTINE solver_dynamic_initialise(SOLVER,ERR,ERROR,*)
5596 
5597  !Argument variables
5598  TYPE(solver_type), POINTER :: SOLVER
5599  INTEGER(INTG), INTENT(OUT) :: ERR
5600  TYPE(varying_string), INTENT(OUT) :: ERROR
5601  !Local Variables
5602  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
5603 
5604 
5605  enters("SOLVER_DYNAMIC_INITIALISE",err,error,*999)
5606 
5607  IF(ASSOCIATED(solver)) THEN
5608  IF(ASSOCIATED(solver%DYNAMIC_SOLVER)) THEN
5609  CALL flagerror("Dynamic solver is already associated for this solver.",err,error,*999)
5610  ELSE
5611  !Allocate memory for dynamic solver and set default values (link solver later on)
5612  ALLOCATE(solver%DYNAMIC_SOLVER,stat=err)
5613  IF(err/=0) CALL flagerror("Could not allocate solver dynamic solver.",err,error,*999)
5614  dynamic_solver=>solver%DYNAMIC_SOLVER
5615  dynamic_solver%SOLVER=>solver
5616  dynamic_solver%SOLVER_LIBRARY=solver_cmiss_library
5617  dynamic_solver%SOLVER_INITIALISED=.false.
5618  dynamic_solver%ORDER=solver_dynamic_first_order
5619  dynamic_solver%DEGREE=solver_dynamic_first_degree
5620  dynamic_solver%SCHEME=solver_dynamic_crank_nicolson_scheme
5621  ALLOCATE(solver%DYNAMIC_SOLVER%THETA(1),stat=err)
5622  IF(err/=0) CALL flagerror("Could not allocate theta.",err,error,*999)
5623  dynamic_solver%THETA(1)=1.0_dp/2.0_dp
5624  dynamic_solver%EXPLICIT=.false.
5625  dynamic_solver%RESTART=.false.
5626  dynamic_solver%ALE=.true. !this should be .FALSE. eventually and set by the user
5627  dynamic_solver%FSI=.false. !set by the user
5628  dynamic_solver%UPDATE_BC=.true. !this should be .FALSE. eventually and set by the user
5629  dynamic_solver%CURRENT_TIME=0.0_dp
5630  dynamic_solver%TIME_INCREMENT=0.01_dp
5631  NULLIFY(dynamic_solver%LINEAR_SOLVER)
5632  NULLIFY(dynamic_solver%NONLINEAR_SOLVER)
5633  !Make a linear solver by default, and allocate solver%linear_solver
5634  CALL solver_dynamic_linearity_type_set(solver,solver_dynamic_linear,err,error,*999)
5635  ENDIF
5636  ELSE
5637  CALL flagerror("Solver is not associated.",err,error,*999)
5638  ENDIF
5639 
5640  exits("SOLVER_DYNAMIC_INITIALISE")
5641  RETURN
5642 999 errorsexits("SOLVER_DYNAMIC_INITIALISE",err,error)
5643  RETURN 1
5644 
5645  END SUBROUTINE solver_dynamic_initialise
5646 
5647  !
5648  !================================================================================================================================
5649  !
5650 
5652  SUBROUTINE solver_dynamic_library_type_get(DYNAMIC_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
5653 
5654  !Argument variables
5655  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
5656  INTEGER(INTG), INTENT(OUT) :: SOLVER_LIBRARY_TYPE
5657  INTEGER(INTG), INTENT(OUT) :: ERR
5658  TYPE(varying_string), INTENT(OUT) :: ERROR
5659  !Local Variables
5660 
5661  enters("SOLVER_DYNAMIC_LIBRARY_TYPE_GET",err,error,*999)
5662 
5663  IF(ASSOCIATED(dynamic_solver)) THEN
5664  solver_library_type=dynamic_solver%SOLVER_LIBRARY
5665  ELSE
5666  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
5667  ENDIF
5668 
5669  exits("SOLVER_DYNAMIC_LIBRARY_TYPE_GET")
5670  RETURN
5671 999 errorsexits("SOLVER_DYNAMIC_LIBRARY_TYPE_GET",err,error)
5672  RETURN 1
5673 
5674  END SUBROUTINE solver_dynamic_library_type_get
5675 
5676  !
5677  !================================================================================================================================
5678  !
5679 
5681  SUBROUTINE solver_dynamic_library_type_set(DYNAMIC_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
5682 
5683  !Argument variables
5684  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
5685  INTEGER(INTG), INTENT(IN) :: SOLVER_LIBRARY_TYPE
5686  INTEGER(INTG), INTENT(OUT) :: ERR
5687  TYPE(varying_string), INTENT(OUT) :: ERROR
5688  !Local Variables
5689  TYPE(varying_string) :: LOCAL_ERROR
5690 
5691  enters("SOLVER_DYNAMIC_LIBRARY_TYPE_SET",err,error,*999)
5692 
5693  IF(ASSOCIATED(dynamic_solver)) THEN
5694  SELECT CASE(solver_library_type)
5695  CASE(solver_cmiss_library)
5696  dynamic_solver%SOLVER_LIBRARY=solver_cmiss_library
5697  CASE DEFAULT
5698  local_error="The solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
5699  & " is invalid for a dynamic solver."
5700  CALL flagerror(local_error,err,error,*999)
5701  END SELECT
5702  ELSE
5703  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
5704  ENDIF
5705 
5706  exits("SOLVER_DYNAMIC_LIBRARY_TYPE_SET")
5707  RETURN
5708 999 errorsexits("SOLVER_DYNAMIC_LIBRARY_TYPE_SET",err,error)
5709  RETURN 1
5710 
5711  END SUBROUTINE solver_dynamic_library_type_set
5712 
5713  !
5714  !================================================================================================================================
5715  !
5716 
5718  SUBROUTINE solver_dynamic_linearity_type_get(SOLVER,LINEARITY_TYPE,ERR,ERROR,*)
5719 
5720  !Argument variables
5721  TYPE(solver_type), POINTER :: SOLVER
5722  INTEGER(INTG), INTENT(OUT) :: LINEARITY_TYPE
5723  INTEGER(INTG), INTENT(OUT) :: ERR
5724  TYPE(varying_string), INTENT(OUT) :: ERROR
5725  !Local Variables
5726  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
5727 
5728  enters("SOLVER_DYNAMIC_LINEARITY_TYPE_GET",err,error,*999)
5729 
5730  IF(ASSOCIATED(solver)) THEN
5731  IF(solver%SOLVER_FINISHED) THEN
5732  dynamic_solver=>solver%DYNAMIC_SOLVER
5733  IF(ASSOCIATED(dynamic_solver)) THEN
5734  linearity_type=dynamic_solver%LINEARITY
5735  ELSE
5736  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
5737  ENDIF
5738  ELSE
5739  CALL flagerror("Solver has not been finished.",err,error,*999)
5740  ENDIF
5741  ELSE
5742  CALL flagerror("Solver is not associated.",err,error,*999)
5743  END IF
5744 
5745  exits("SOLVER_DYNAMIC_LINEARITY_TYPE_GET")
5746  RETURN
5747 999 errorsexits("SOLVER_DYNAMIC_LINEARITY_TYPE_GET",err,error)
5748  RETURN 1
5749 
5750  END SUBROUTINE solver_dynamic_linearity_type_get
5751 
5752  !
5753  !================================================================================================================================
5754  !
5755 
5757  SUBROUTINE solver_dynamic_linearity_type_set(SOLVER,LINEARITY_TYPE,ERR,ERROR,*)
5758 
5759  !Argument variables
5760  TYPE(solver_type), POINTER :: SOLVER
5761  INTEGER(INTG), INTENT(IN) :: LINEARITY_TYPE
5762  INTEGER(INTG), INTENT(OUT) :: ERR
5763  TYPE(varying_string), INTENT(OUT) :: ERROR
5764  !Local Variables
5765  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
5766  TYPE(varying_string) :: LOCAL_ERROR
5767 
5768  enters("SOLVER_DYNAMIC_LINEARITY_TYPE_SET",err,error,*999)
5769 
5770  IF(ASSOCIATED(solver)) THEN
5771  IF(solver%SOLVER_FINISHED) THEN
5772  CALL flagerror("Solver has already been finished.",err,error,*999)
5773  ELSE
5774  dynamic_solver=>solver%DYNAMIC_SOLVER
5775  IF(ASSOCIATED(dynamic_solver)) THEN
5776 
5777  CALL solver_linked_solver_remove(solver,solver_linear_type,err,error,*999)
5778  CALL solver_finalise(dynamic_solver%LINEAR_SOLVER,err,error,*999)
5779  CALL solver_finalise(dynamic_solver%NONLINEAR_SOLVER,err,error,*999)
5780 
5781  SELECT CASE(linearity_type)
5782  CASE(solver_dynamic_linear)
5783  ALLOCATE(dynamic_solver%LINEAR_SOLVER,stat=err)
5784  IF(err/=0) CALL flagerror("Could not allocate solver linear solver.",err,error,*999)
5785  NULLIFY(dynamic_solver%LINEAR_SOLVER%SOLVERS)
5786  dynamic_solver%LINEARITY=solver_dynamic_linear
5787  CALL solver_initialise_ptr(dynamic_solver%LINEAR_SOLVER,err,error,*999)
5788  CALL solver_linear_initialise(dynamic_solver%LINEAR_SOLVER,err,error,*999)
5789  CALL solver_linked_solver_add(solver,dynamic_solver%LINEAR_SOLVER,solver_linear_type,err,error,*999)
5790  IF(dynamic_solver%LINEAR_SOLVER%LINEAR_SOLVER%LINEAR_SOLVE_TYPE==solver_linear_iterative_solve_type) THEN
5791  CALL solver_lineariterativesolutioninittypeset(dynamic_solver%LINEAR_SOLVER,solver_solution_initialise_zero, &
5792  & err,error,*999)
5793  ENDIF
5794 
5795  CASE(solver_dynamic_nonlinear)
5796  ALLOCATE(dynamic_solver%NONLINEAR_SOLVER,stat=err)
5797  IF(err/=0) CALL flagerror("Could not allocate solver nonlinear solver.",err,error,*999)
5798  NULLIFY(dynamic_solver%NONLINEAR_SOLVER%SOLVERS)
5799  dynamic_solver%LINEARITY=solver_dynamic_nonlinear
5800  CALL solver_initialise_ptr(dynamic_solver%NONLINEAR_SOLVER,err,error,*999)
5801  CALL solver_nonlinear_initialise(dynamic_solver%NONLINEAR_SOLVER,err,error,*999)
5802  CALL solver_linked_solver_add(solver,dynamic_solver%NONLINEAR_SOLVER,solver_nonlinear_type,err,error,*999)
5803  IF(dynamic_solver%NONLINEAR_SOLVER%NONLINEAR_SOLVER%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
5804  CALL solver_newton_solution_init_type_set(dynamic_solver%NONLINEAR_SOLVER,solver_solution_initialise_zero, &
5805  & err,error,*999)
5806  ENDIF
5807  IF(dynamic_solver%NONLINEAR_SOLVER%NONLINEAR_SOLVER%NEWTON_SOLVER%LINEAR_SOLVER%LINEAR_SOLVER%LINEAR_SOLVE_TYPE== &
5808  & solver_linear_iterative_solve_type) THEN
5809  CALL solver_lineariterativesolutioninittypeset(dynamic_solver%NONLINEAR_SOLVER%NONLINEAR_SOLVER%NEWTON_SOLVER% &
5810  & linear_solver,solver_solution_initialise_zero,err,error,*999)
5811  ENDIF
5812 
5813  CASE DEFAULT
5814  local_error="The specified solver equations linearity type of "// &
5815  & trim(numbertovstring(linearity_type,"*",err,error))//" is invalid."
5816  CALL flagerror(local_error,err,error,*999)
5817  END SELECT
5818  ELSE
5819  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
5820  ENDIF
5821  ENDIF
5822  ELSE
5823  CALL flagerror("Solver is not associated.",err,error,*999)
5824  END IF
5825 
5826  exits("SOLVER_DYNAMIC_LINEARITY_TYPE_SET")
5827  RETURN
5828 999 errorsexits("SOLVER_DYNAMIC_LINEARITY_TYPE_SET",err,error)
5829  RETURN 1
5830 
5831  END SUBROUTINE solver_dynamic_linearity_type_set
5832 
5833  !
5834  !================================================================================================================================
5835  !
5836 
5838  SUBROUTINE solver_dynamic_nonlinear_solver_get(SOLVER,NONLINEAR_SOLVER,ERR,ERROR,*)
5839 
5840  !Argument variables
5841  TYPE(solver_type), POINTER :: SOLVER
5842  TYPE(solver_type), POINTER :: NONLINEAR_SOLVER
5843  INTEGER(INTG), INTENT(OUT) :: ERR
5844  TYPE(varying_string), INTENT(OUT) :: ERROR
5845  !Local Variables
5846  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
5847 
5848  enters("SOLVER_DYNAMIC_NONLINEAR_SOLVER_GET",err,error,*999)
5849 
5850  IF(ASSOCIATED(solver)) THEN
5851  IF(ASSOCIATED(nonlinear_solver)) THEN
5852  CALL flagerror("Nonlinear solver is already associated.",err,error,*999)
5853  ELSE
5854  NULLIFY(nonlinear_solver)
5855  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
5856  dynamic_solver=>solver%DYNAMIC_SOLVER
5857  IF(ASSOCIATED(dynamic_solver)) THEN
5858  nonlinear_solver=>dynamic_solver%NONLINEAR_SOLVER
5859  IF(.NOT.ASSOCIATED(nonlinear_solver)) CALL flagerror("Dynamic solver nonlinear solver is not associated.", &
5860  & err,error,*999)
5861  ELSE
5862  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
5863  ENDIF
5864  ELSE
5865  CALL flagerror("The specified solver is not a dynamic solver.",err,error,*999)
5866  ENDIF
5867  ENDIF
5868  ELSE
5869  CALL flagerror("Solver is not associated.",err,error,*999)
5870  ENDIF
5871 
5872  exits("SOLVER_DYNAMIC_NONLINEAR_SOLVER_GET")
5873  RETURN
5874 999 errorsexits("SOLVER_DYNAMIC_NONLINEAR_SOLVER_GET",err,error)
5875  RETURN 1
5876 
5877  END SUBROUTINE solver_dynamic_nonlinear_solver_get
5878 
5879  !
5880  !================================================================================================================================
5881  !
5882 
5884  SUBROUTINE solver_dynamic_linear_solver_get(SOLVER,LINEAR_SOLVER,ERR,ERROR,*)
5885 
5886  !Argument variables
5887  TYPE(solver_type), POINTER :: SOLVER
5888  TYPE(solver_type), POINTER :: LINEAR_SOLVER
5889  INTEGER(INTG), INTENT(OUT) :: ERR
5890  TYPE(varying_string), INTENT(OUT) :: ERROR
5891  !Local Variables
5892  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
5893 
5894  enters("SOLVER_DYNAMIC_LINEAR_SOLVER_GET",err,error,*999)
5895 
5896  IF(ASSOCIATED(solver)) THEN
5897  IF(ASSOCIATED(linear_solver)) THEN
5898  CALL flagerror("Linear solver is already associated.",err,error,*999)
5899  ELSE
5900  NULLIFY(linear_solver)
5901  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
5902  dynamic_solver=>solver%DYNAMIC_SOLVER
5903  IF(ASSOCIATED(dynamic_solver)) THEN
5904  linear_solver=>dynamic_solver%LINEAR_SOLVER
5905  IF(.NOT.ASSOCIATED(linear_solver)) CALL flagerror("Dynamic solver linear solver is not associated.",err,error,*999)
5906  ELSE
5907  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
5908  ENDIF
5909  ELSE
5910  CALL flagerror("The specified solver is not a dynamic solver.",err,error,*999)
5911  ENDIF
5912  ENDIF
5913  ELSE
5914  CALL flagerror("Solver is not associated.",err,error,*999)
5915  ENDIF
5916 
5917  exits("SOLVER_DYNAMIC_LINEAR_SOLVER_GET")
5918  RETURN
5919 999 errorsexits("SOLVER_DYNAMIC_LINEAR_SOLVER_GET",err,error)
5920  RETURN 1
5921 
5922  END SUBROUTINE solver_dynamic_linear_solver_get
5923 
5924  !
5925  !================================================================================================================================
5926  !
5927 
5929  SUBROUTINE solver_dynamic_mean_predicted_calculate(SOLVER,ERR,ERROR,*)
5930 
5931  !Argument variableg
5932  TYPE(solver_type), POINTER :: SOLVER
5933  INTEGER(INTG), INTENT(OUT) :: ERR
5934  TYPE(varying_string), INTENT(OUT) :: ERROR
5935  !Local Variables
5936  INTEGER(INTG) :: DYNAMIC_VARIABLE_TYPE,equations_set_idx
5937  REAL(DP) :: DELTA_T,FIRST_MEAN_PREDICTION_FACTOR, SECOND_MEAN_PREDICTION_FACTOR,THIRD_MEAN_PREDICTION_FACTOR
5938  REAL(DP) :: FIRST_PREDICTION_FACTOR, SECOND_PREDICTION_FACTOR,THIRD_PREDICTION_FACTOR
5939  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
5940  TYPE(equations_type), POINTER :: EQUATIONS
5941  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
5942  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
5943  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
5944  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
5945  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
5946  TYPE(field_type), POINTER :: DEPENDENT_FIELD
5947  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
5948  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
5949  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
5950  TYPE(varying_string) :: LOCAL_ERROR
5951 
5952  enters("SOLVER_DYNAMIC_MEAN_PREDICTED_CALCULATE",err,error,*999)
5953 
5954  IF(ASSOCIATED(solver)) THEN
5955  dynamic_solver=>solver%DYNAMIC_SOLVER
5956  IF(ASSOCIATED(dynamic_solver)) THEN
5957  IF(dynamic_solver%SOLVER_INITIALISED) THEN
5958  delta_t=dynamic_solver%TIME_INCREMENT
5959  SELECT CASE(dynamic_solver%DEGREE)
5960  CASE(solver_dynamic_first_degree)
5961  first_mean_prediction_factor=1.0_dp
5962  first_prediction_factor=1.0_dp
5963  CASE(solver_dynamic_second_degree)
5964  first_mean_prediction_factor=1.0_dp
5965  second_mean_prediction_factor=dynamic_solver%THETA(1)*delta_t
5966  first_prediction_factor=1.0_dp
5967  second_prediction_factor=delta_t
5968  CASE(solver_dynamic_third_degree)
5969  first_mean_prediction_factor=1.0_dp
5970  second_mean_prediction_factor=dynamic_solver%THETA(1)*delta_t
5971  third_mean_prediction_factor=dynamic_solver%THETA(2)*delta_t*delta_t
5972  first_prediction_factor=1.0_dp
5973  second_prediction_factor=delta_t
5974  third_prediction_factor=delta_t*delta_t
5975  CASE DEFAULT
5976  local_error="The dynamic solver degree of "//trim(numbertovstring(dynamic_solver%DEGREE,"*",err,error))// &
5977  & " is invalid."
5978  CALL flagerror(local_error,err,error,*999)
5979  END SELECT
5980  ENDIF
5981  solver_equations=>solver%SOLVER_EQUATIONS
5982  IF(ASSOCIATED(solver_equations)) THEN
5983  solver_mapping=>solver_equations%SOLVER_MAPPING
5984  IF(ASSOCIATED(solver_mapping)) THEN
5985  solver_matrices=>solver_equations%SOLVER_MATRICES
5986  IF(ASSOCIATED(solver_matrices)) THEN
5987  IF(dynamic_solver%SOLVER_INITIALISED.OR.(.NOT.dynamic_solver%SOLVER_INITIALISED.AND. &
5988  & ((dynamic_solver%ORDER==solver_dynamic_first_order.AND.dynamic_solver%DEGREE>solver_dynamic_first_degree).OR. &
5989  & (dynamic_solver%ORDER==solver_dynamic_second_order.AND.dynamic_solver%DEGREE>solver_dynamic_second_degree)))) &
5990  & THEN
5991  !Loop over the equations sets
5992  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
5993  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
5994  IF(ASSOCIATED(equations_set)) THEN
5995  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
5996  equations=>equations_set%EQUATIONS
5997  IF(ASSOCIATED(equations)) THEN
5998  equations_matrices=>equations%EQUATIONS_MATRICES
5999  IF(ASSOCIATED(equations_matrices)) THEN
6000  equations_mapping=>equations%EQUATIONS_MAPPING
6001  IF(ASSOCIATED(equations_mapping)) THEN
6002  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
6003  IF(ASSOCIATED(dynamic_mapping)) THEN
6004  dynamic_variable_type=dynamic_mapping%DYNAMIC_VARIABLE_TYPE
6005  IF(dynamic_solver%SOLVER_INITIALISED) THEN
6006  !As the dynamic solver may be part of a workflow of solvers within a control loop it is possible
6007  !that the current dependent field values are not equal to the current previous values that were set
6008  !at the beginning of the control loop.
6009  !Copy the current field values to the previous values
6010  CALL field_parameter_sets_copy(dependent_field,dynamic_variable_type,field_values_set_type, &
6011  & field_previous_values_set_type,1.0_dp,err,error,*999)
6012  IF(dynamic_solver%LINEARITY==solver_dynamic_nonlinear) THEN
6013  CALL field_parameter_sets_copy(dependent_field,dynamic_variable_type, &
6014  & field_residual_set_type,field_previous_residual_set_type,1.0_dp, &
6015  & err,error,*999)
6016  ENDIF
6017  !Calculate the mean predicted and predicted values for this dependent field.
6018  SELECT CASE(dynamic_solver%DEGREE)
6019  CASE(solver_dynamic_first_degree)
6020  !The mean predicited displacement is the current displacement
6021  CALL field_parameter_sets_copy(dependent_field,dynamic_variable_type, &
6022  & field_previous_values_set_type,field_mean_predicted_displacement_set_type,1.0_dp, &
6023  & err,error,*999)
6024  IF(dynamic_solver%LINEARITY==solver_dynamic_nonlinear) THEN
6025  !The predicted displacement is just the current displacement
6026  CALL field_parameter_sets_copy(dependent_field,dynamic_variable_type, &
6027  & field_previous_values_set_type,field_predicted_displacement_set_type,1.0_dp, &
6028  & err,error,*999)
6029  ENDIF
6030  CASE(solver_dynamic_second_degree)
6031  !The mean predicted displacement comes from the previous displacement and the previous velocity
6032  CALL field_parameter_sets_add(dependent_field,dynamic_variable_type, &
6033  & [first_mean_prediction_factor,second_mean_prediction_factor], &
6034  & [field_previous_values_set_type,field_previous_velocity_set_type], &
6035  & field_mean_predicted_displacement_set_type,err,error,*999)
6036  !The mean predicted velocity is the current velocity
6037  CALL field_parameter_sets_copy(dependent_field,dynamic_variable_type, &
6038  & field_previous_velocity_set_type,field_mean_predicted_velocity_set_type,1.0_dp,err,error,*999)
6039  IF(dynamic_solver%LINEARITY==solver_dynamic_nonlinear) THEN
6040  !The predicted displacement comes from the previous displacement and the previous velocity
6041  CALL field_parameter_sets_add(dependent_field,dynamic_variable_type, &
6042  & [first_prediction_factor,second_prediction_factor], &
6043  & [field_previous_values_set_type,field_previous_velocity_set_type], &
6044  & field_predicted_displacement_set_type,err,error,*999)
6045  END IF
6046  CASE(solver_dynamic_third_degree)
6047  !The mean predicted displacement comes from the previous displacement and the previous
6048  !velocity and acceleration
6049  CALL field_parameter_sets_add(dependent_field,dynamic_variable_type, &
6050  & [first_mean_prediction_factor,second_mean_prediction_factor, &
6051  & third_mean_prediction_factor],[field_previous_values_set_type, &
6052  & field_previous_velocity_set_type,field_previous_acceleration_set_type], &
6053  & field_mean_predicted_displacement_set_type,err,error,*999)
6054  !The mean predicted velocity comes from the previous velocity and acceleration
6055  CALL field_parameter_sets_add(dependent_field,dynamic_variable_type, &
6056  & [first_mean_prediction_factor,second_mean_prediction_factor], &
6057  & [field_previous_velocity_set_type,field_previous_acceleration_set_type], &
6058  & field_mean_predicted_velocity_set_type,err,error,*999)
6059  !The mean predicted acceleration is the current acceleration
6060  CALL field_parameter_sets_copy(dependent_field,dynamic_variable_type, &
6061  & field_previous_acceleration_set_type,field_mean_predicted_acceleration_set_type,1.0_dp, &
6062  & err,error,*999)
6063  IF(dynamic_solver%LINEARITY==solver_dynamic_nonlinear) THEN
6064  !The predicted displacement comes from the previous displacement and the previous
6065  !velocity and acceleration
6066  CALL field_parameter_sets_add(dependent_field,dynamic_variable_type, &
6067  & [first_prediction_factor,second_prediction_factor, &
6068  & third_prediction_factor],[field_previous_values_set_type, &
6069  & field_previous_velocity_set_type,field_previous_acceleration_set_type], &
6070  & field_predicted_displacement_set_type,err,error,*999)
6071  END IF
6072  CASE DEFAULT
6073  local_error="The dynamic solver degree of "// &
6074  & trim(numbertovstring(dynamic_solver%DEGREE,"*",err,error))//" is invalid."
6075  CALL flagerror(local_error,err,error,*999)
6076  END SELECT
6077  ENDIF
6078  ELSE
6079 
6080  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
6081  IF(ASSOCIATED(nonlinear_mapping)) THEN
6082  dynamic_variable_type=field_u_variable_type
6083  IF(dynamic_solver%SOLVER_INITIALISED) THEN
6084  !As the dynamic solver may be part of a workflow of solvers within a control loop it is possible
6085  !that the current dependent field values are not equal to the current previous values that were set
6086  !at the beginning of the control loop.
6087  !Copy the current field values to the previous values
6088  CALL field_parameter_sets_copy(dependent_field,dynamic_variable_type,field_values_set_type, &
6089  & field_previous_values_set_type,1.0_dp,err,error,*999)
6090  IF(dynamic_solver%LINEARITY==solver_dynamic_nonlinear) THEN
6091  CALL field_parameter_sets_copy(dependent_field,dynamic_variable_type, &
6092  & field_residual_set_type,field_previous_residual_set_type,1.0_dp, &
6093  & err,error,*999)
6094  ENDIF
6095  !Calculate the mean predicted and predicted values for this dependent field.
6096  SELECT CASE(dynamic_solver%DEGREE)
6097  CASE(solver_dynamic_first_degree)
6098  !The mean predicited displacement is the current displacement
6099  CALL field_parameter_sets_copy(dependent_field,dynamic_variable_type, &
6100  & field_previous_values_set_type,field_mean_predicted_displacement_set_type,1.0_dp, &
6101  & err,error,*999)
6102  IF(dynamic_solver%LINEARITY==solver_dynamic_nonlinear) THEN
6103  !The predicted displacement is just the current displacement
6104  CALL field_parameter_sets_copy(dependent_field,dynamic_variable_type, &
6105  & field_previous_values_set_type,field_predicted_displacement_set_type,1.0_dp, &
6106  & err,error,*999)
6107  ENDIF
6108  CASE(solver_dynamic_second_degree)
6109  !The mean predicted displacement comes from the previous displacement and the previous velocity
6110  CALL field_parameter_sets_add(dependent_field,dynamic_variable_type, &
6111  & [first_mean_prediction_factor,second_mean_prediction_factor], &
6112  & [field_previous_values_set_type,field_previous_velocity_set_type], &
6113  & field_mean_predicted_displacement_set_type,err,error,*999)
6114  !The mean predicted velocity is the current velocity
6115  CALL field_parameter_sets_copy(dependent_field,dynamic_variable_type, &
6116  & field_previous_velocity_set_type,field_mean_predicted_velocity_set_type,1.0_dp,err,error,*999)
6117  IF(dynamic_solver%LINEARITY==solver_dynamic_nonlinear) THEN
6118  !The predicted displacement comes from the previous displacement and the previous velocity
6119  CALL field_parameter_sets_add(dependent_field,dynamic_variable_type, &
6120  & [first_prediction_factor,second_prediction_factor], &
6121  & [field_previous_values_set_type,field_previous_velocity_set_type], &
6122  & field_predicted_displacement_set_type,err,error,*999)
6123  END IF
6124  CASE(solver_dynamic_third_degree)
6125  !The mean predicted displacement comes from the previous displacement and the previous
6126  !velocity and acceleration
6127  CALL field_parameter_sets_add(dependent_field,dynamic_variable_type, &
6128  & [first_mean_prediction_factor,second_mean_prediction_factor, &
6129  & third_mean_prediction_factor],[field_previous_values_set_type, &
6130  & field_previous_velocity_set_type,field_previous_acceleration_set_type], &
6131  & field_mean_predicted_displacement_set_type,err,error,*999)
6132  !The mean predicted velocity comes from the previous velocity and acceleration
6133  CALL field_parameter_sets_add(dependent_field,dynamic_variable_type, &
6134  & [first_mean_prediction_factor,second_mean_prediction_factor], &
6135  & [field_previous_velocity_set_type,field_previous_acceleration_set_type], &
6136  & field_mean_predicted_velocity_set_type,err,error,*999)
6137  !The mean predicted acceleration is the current acceleration
6138  CALL field_parameter_sets_copy(dependent_field,dynamic_variable_type, &
6139  & field_previous_acceleration_set_type,field_mean_predicted_acceleration_set_type,1.0_dp, &
6140  & err,error,*999)
6141  IF(dynamic_solver%LINEARITY==solver_dynamic_nonlinear) THEN
6142  !The predicted displacement comes from the previous displacement and the previous
6143  !velocity and acceleration
6144  CALL field_parameter_sets_add(dependent_field,dynamic_variable_type, &
6145  & [first_prediction_factor,second_prediction_factor, &
6146  & third_prediction_factor],[field_previous_values_set_type, &
6147  & field_previous_velocity_set_type,field_previous_acceleration_set_type], &
6148  & field_predicted_displacement_set_type,err,error,*999)
6149  END IF
6150  CASE DEFAULT
6151  local_error="The dynamic solver degree of "// &
6152  & trim(numbertovstring(dynamic_solver%DEGREE,"*",err,error))//" is invalid."
6153  CALL flagerror(local_error,err,error,*999)
6154  END SELECT
6155  ENDif!initialised
6156  NULLIFY(nonlinear_mapping)
6157  ELSE
6158  local_error="Neither equations mapping dynamic mapping nor equations mapping nonlinear "// &
6159  & "mapping is associated for equations set index number "// &
6160  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
6161  CALL flagerror(local_error,err,error,*999)
6162  ENDif!nonlinear mapping
6163  ENDif!dynamic mapping
6164  ELSE
6165  CALL flagerror("Equations equations mapping is not associated.",err,error,*999)
6166  ENDIF
6167  ELSE
6168  CALL flagerror("Equations equations matrices is not associated.",err,error,*999)
6169  ENDIF
6170  ELSE
6171  CALL flagerror("Equations set equations is not associated.",err,error,*999)
6172  ENDIF
6173  ELSE
6174  CALL flagerror("Equations set is not associated.",err,error,*999)
6175  ENDIF
6176  ENDDO !equations_set_idx
6177  ENDIF
6178  ELSE
6179  CALL flagerror("Solver solver matrices is not associated.",err,error,*999)
6180  ENDIF
6181  ELSE
6182  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
6183  ENDIF
6184  ELSE
6185  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
6186  ENDIF
6187  ELSE
6188  CALL flagerror("Solver dynamic solver is not associated.",err,error,*999)
6189  ENDIF
6190  ELSE
6191  CALL flagerror("Solver is not associated.",err,error,*999)
6192  ENDIF
6193 
6194  exits("SOLVER_DYNAMIC_MEAN_PREDICTED_CALCULATE")
6195  RETURN
6196 999 errorsexits("SOLVER_DYNAMIC_MEAN_PREDICTED_CALCULATE",err,error)
6197  RETURN 1
6198  END SUBROUTINE solver_dynamic_mean_predicted_calculate
6199 
6200  !
6201  !================================================================================================================================
6202  !
6203 
6205  SUBROUTINE solver_dynamic_restart_get(SOLVER,RESTART,ERR,ERROR,*)
6206 
6207  !Argument variables
6208  TYPE(solver_type), POINTER :: SOLVER
6209  LOGICAL, INTENT(OUT) :: RESTART
6210  INTEGER(INTG), INTENT(OUT) :: ERR
6211  TYPE(varying_string), INTENT(OUT) :: ERROR
6212  !Local Variables
6213  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
6214 
6215  enters("SOLVER_DYNAMIC_RESTART_GET",err,error,*999)
6216 
6217  IF(ASSOCIATED(solver)) THEN
6218  IF(solver%SOLVER_FINISHED) THEN
6219  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
6220  dynamic_solver=>solver%DYNAMIC_SOLVER
6221  IF(ASSOCIATED(dynamic_solver)) THEN
6222  restart=dynamic_solver%RESTART
6223  ELSE
6224  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
6225  ENDIF
6226  ELSE
6227  CALL flagerror("The specified solver is not a dynamic solver.",err,error,*999)
6228  ENDIF
6229  ELSE
6230  CALL flagerror("The solver has not been finished.",err,error,*999)
6231  ENDIF
6232  ELSE
6233  CALL flagerror("Solver is not associated.",err,error,*999)
6234  ENDIF
6235 
6236  exits("SOLVER_DYNAMIC_RESTART_GET")
6237  RETURN
6238 999 errorsexits("SOLVER_DYNAMIC_RESTART_GET",err,error)
6239  RETURN 1
6240 
6241  END SUBROUTINE solver_dynamic_restart_get
6242 
6243  !
6244  !================================================================================================================================
6245  !
6246 
6248  SUBROUTINE solver_dynamic_restart_set(SOLVER,RESTART,ERR,ERROR,*)
6249 
6250  !Argument variables
6251  TYPE(solver_type), POINTER :: SOLVER
6252  LOGICAL, INTENT(IN) :: RESTART
6253  INTEGER(INTG), INTENT(OUT) :: ERR
6254  TYPE(varying_string), INTENT(OUT) :: ERROR
6255  !Local Variables
6256  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
6257 
6258  enters("SOLVER_DYNAMIC_RESTART_SET",err,error,*999)
6259 
6260  IF(ASSOCIATED(solver)) THEN
6261  IF(solver%SOLVER_FINISHED) THEN
6262  CALL flagerror("The solver has already been finished.",err,error,*999)
6263  ELSE
6264  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
6265  dynamic_solver=>solver%DYNAMIC_SOLVER
6266  IF(ASSOCIATED(dynamic_solver)) THEN
6267  dynamic_solver%RESTART=restart
6268  ELSE
6269  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
6270  ENDIF
6271  ELSE
6272  CALL flagerror("The specified solver is not a dynamic solver.",err,error,*999)
6273  ENDIF
6274  ENDIF
6275  ELSE
6276  CALL flagerror("Solver is not associated.",err,error,*999)
6277  ENDIF
6278 
6279  exits("SOLVER_DYNAMIC_RESTART_SET")
6280  RETURN
6281 999 errorsexits("SOLVER_DYNAMIC_RESTART_SET",err,error)
6282  RETURN 1
6283 
6284  END SUBROUTINE solver_dynamic_restart_set
6285 
6286  !
6287  !================================================================================================================================
6288  !
6289 
6291  SUBROUTINE solver_time_stepping_monitor(DAE_SOLVER,STEPS,TIME,ERR,ERROR,*)
6292 
6293  !Argument variables
6294  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
6295  INTEGER(INTG), INTENT(IN) :: STEPS
6296  REAL(DP), INTENT(IN) :: TIME
6297  INTEGER(INTG), INTENT(OUT) :: ERR
6298  TYPE(varying_string), INTENT(OUT) :: ERROR
6299  !Local Variables
6300 
6301  enters("SOLVER_TIME_STEPPING_MONITOR",err,error,*999)
6302 
6303  IF(ASSOCIATED(dae_solver)) THEN
6304 
6305  CALL write_string(general_output_type,"",err,error,*999)
6306  CALL write_string(general_output_type,"Differential-algebraic equations solve monitor: ",err,error,*999)
6307  CALL write_string(general_output_type,"",err,error,*999)
6308  CALL write_string_value(general_output_type," Number of steps = ",steps,err,error,*999)
6309  CALL write_string_value(general_output_type," Current time = ",time,err,error,*999)
6310 
6311  ELSE
6312  CALL flagerror("Differential-algebraic equations solver is not associated.",err,error,*999)
6313  ENDIF
6314 
6315  exits("SOLVER_TIME_STEPPING_MONITOR")
6316  RETURN
6317 999 errorsexits("SOLVER_TIME_STEPPING_MONITOR",err,error)
6318  RETURN 1
6319  END SUBROUTINE solver_time_stepping_monitor
6320 
6321  !
6322  !================================================================================================================================
6323  !
6324 
6326  SUBROUTINE solver_dynamic_order_set(SOLVER,ORDER,ERR,ERROR,*)
6327 
6328  !Argument variables
6329  TYPE(solver_type), POINTER :: SOLVER
6330  INTEGER(INTG), INTENT(IN) :: ORDER
6331  INTEGER(INTG), INTENT(OUT) :: ERR
6332  TYPE(varying_string), INTENT(OUT) :: ERROR
6333  !Local Variables
6334  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
6335  TYPE(varying_string) :: LOCAL_ERROR
6336 
6337  enters("SOLVER_DYNAMIC_ORDER_SET",err,error,*999)
6338 
6339  IF(ASSOCIATED(solver)) THEN
6340  IF(solver%SOLVER_FINISHED) THEN
6341  CALL flagerror("The solver has already been finished.",err,error,*999)
6342  ELSE
6343  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
6344  dynamic_solver=>solver%DYNAMIC_SOLVER
6345  IF(ASSOCIATED(dynamic_solver)) THEN
6346  IF(order==solver_dynamic_second_order.AND.dynamic_solver%DEGREE==solver_dynamic_first_degree) THEN
6347  local_error="Invalid dynamic solver degree. You must have at least a second degree polynomial "// &
6348  & "interpolation for a second order dynamic solver."
6349  CALL flagerror(local_error,err,error,*999)
6350  ELSE
6351  SELECT CASE(order)
6352  CASE(solver_dynamic_first_order)
6353  dynamic_solver%ORDER=solver_dynamic_first_order
6354  CASE(solver_dynamic_second_order)
6355  dynamic_solver%ORDER=solver_dynamic_second_order
6356  CASE DEFAULT
6357  local_error="The specified order of "//trim(numbertovstring(order,"*",err,error))//" is invalid."
6358  CALL flagerror(local_error,err,error,*999)
6359  END SELECT
6360  ENDIF
6361  ELSE
6362  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
6363  ENDIF
6364  ELSE
6365  CALL flagerror("The specified solver is not a dynamic solver.",err,error,*999)
6366  ENDIF
6367  ENDIF
6368  ELSE
6369  CALL flagerror("Solver is not associated.",err,error,*999)
6370  ENDIF
6371 
6372  exits("SOLVER_DYNAMIC_ORDER_SET")
6373  RETURN
6374 999 errorsexits("SOLVER_DYNAMIC_ORDER_SET",err,error)
6375  RETURN 1
6376  END SUBROUTINE solver_dynamic_order_set
6377 
6378  !
6379  !================================================================================================================================
6380  !
6381 
6383  SUBROUTINE solver_dynamic_scheme_set(SOLVER,SCHEME,ERR,ERROR,*)
6384 
6385  !Argument variables
6386  TYPE(solver_type), POINTER :: SOLVER
6387  INTEGER(INTG), INTENT(IN) :: SCHEME
6388  INTEGER(INTG), INTENT(OUT) :: ERR
6389  TYPE(varying_string), INTENT(OUT) :: ERROR
6390  !Local Variables
6391  REAL(DP) :: ALPHA,BETA,GAMMA,THETA
6392  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
6393  TYPE(varying_string) :: LOCAL_ERROR
6394 
6395  enters("SOLVER_DYNAMIC_SCHEME_SET",err,error,*999)
6396 
6397  IF(ASSOCIATED(solver)) THEN
6398  IF(solver%SOLVER_FINISHED) THEN
6399  CALL flagerror("The solver has already been finished.",err,error,*999)
6400  ELSE
6401  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
6402  dynamic_solver=>solver%DYNAMIC_SOLVER
6403  IF(ASSOCIATED(dynamic_solver)) THEN
6404  SELECT CASE(scheme)
6405  CASE(solver_dynamic_euler_scheme)
6406  dynamic_solver%SCHEME=solver_dynamic_euler_scheme
6407  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
6408  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
6409  CALL solver_dynamic_theta_set(solver,0.0_dp,err,error,*999)
6410  CASE(solver_dynamic_backward_euler_scheme)
6411  dynamic_solver%SCHEME=solver_dynamic_backward_euler_scheme
6412  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
6413  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
6414  CALL solver_dynamic_theta_set(solver,1.0_dp,err,error,*999)
6415  CASE(solver_dynamic_crank_nicolson_scheme)
6416  dynamic_solver%SCHEME=solver_dynamic_crank_nicolson_scheme
6417  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
6418  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
6419  CALL solver_dynamic_theta_set(solver,1.0_dp/2.0_dp,err,error,*999)
6420  CASE(solver_dynamic_galerkin_scheme)
6421  dynamic_solver%SCHEME=solver_dynamic_galerkin_scheme
6422  CALL solver_dynamic_degree_set(solver,solver_dynamic_first_degree,err,error,*999)
6423  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
6424  CALL solver_dynamic_theta_set(solver,2.0_dp/3.0_dp,err,error,*999)
6425  CASE(solver_dynamic_zlamal_scheme)
6426  dynamic_solver%SCHEME=solver_dynamic_zlamal_scheme
6427  CALL solver_dynamic_degree_set(solver,solver_dynamic_second_degree,err,error,*999)
6428  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
6429  CALL solver_dynamic_theta_set(solver,[5.0_dp/6.0_dp,2.0_dp],err,error,*999)
6430  CASE(solver_dynamic_second_degree_gear_scheme)
6431  dynamic_solver%SCHEME=solver_dynamic_second_degree_gear_scheme
6432  CALL solver_dynamic_degree_set(solver,solver_dynamic_second_degree,err,error,*999)
6433  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
6434  CALL solver_dynamic_theta_set(solver,[3.0_dp/2.0_dp,2.0_dp],err,error,*999)
6435  CASE(solver_dynamic_second_degree_liniger1_scheme)
6436  dynamic_solver%SCHEME=solver_dynamic_second_degree_liniger1_scheme
6437  CALL solver_dynamic_degree_set(solver,solver_dynamic_second_degree,err,error,*999)
6438  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
6439  CALL solver_dynamic_theta_set(solver,[1.0848_dp,1.0_dp],err,error,*999)
6440  CASE(solver_dynamic_second_degree_liniger2_scheme)
6441  dynamic_solver%SCHEME=solver_dynamic_second_degree_liniger2_scheme
6442  CALL solver_dynamic_degree_set(solver,solver_dynamic_second_degree,err,error,*999)
6443  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
6444  CALL solver_dynamic_theta_set(solver,[1.2184_dp,1.292_dp],err,error,*999)
6445  CASE(solver_dynamic_newmark1_scheme)
6446  dynamic_solver%SCHEME=solver_dynamic_newmark1_scheme
6447  CALL solver_dynamic_degree_set(solver,solver_dynamic_second_degree,err,error,*999)
6448  CALL solver_dynamic_order_set(solver,solver_dynamic_second_order,err,error,*999)
6449  beta=0.5_dp
6450  gamma=2.0_dp
6451  CALL solver_dynamic_theta_set(solver,[gamma,2.0_dp*beta],err,error,*999)
6452  CASE(solver_dynamic_newmark2_scheme)
6453  dynamic_solver%SCHEME=solver_dynamic_newmark2_scheme
6454  CALL solver_dynamic_degree_set(solver,solver_dynamic_second_degree,err,error,*999)
6455  CALL solver_dynamic_order_set(solver,solver_dynamic_second_order,err,error,*999)
6456  beta=0.3025_dp
6457  gamma=0.6_dp
6458  CALL solver_dynamic_theta_set(solver,[gamma,2.0_dp*beta],err,error,*999)
6459  CASE(solver_dynamic_newmark3_scheme)
6460  dynamic_solver%SCHEME=solver_dynamic_newmark3_scheme
6461  CALL solver_dynamic_degree_set(solver,solver_dynamic_second_degree,err,error,*999)
6462  CALL solver_dynamic_order_set(solver,solver_dynamic_second_order,err,error,*999)
6463  beta=0.25_dp
6464  gamma=0.5_dp
6465  CALL solver_dynamic_theta_set(solver,[gamma,2.0_dp*beta],err,error,*999)
6466  CASE(solver_dynamic_third_degree_gear_scheme)
6467  dynamic_solver%SCHEME=solver_dynamic_third_degree_gear_scheme
6468  CALL solver_dynamic_degree_set(solver,solver_dynamic_third_degree,err,error,*999)
6469  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
6470  CALL solver_dynamic_theta_set(solver,[2.0_dp,11.0_dp/3.0_dp,6.0_dp],err,error,*999)
6471  CASE(solver_dynamic_third_degree_liniger1_scheme)
6472  dynamic_solver%SCHEME=solver_dynamic_third_degree_liniger1_scheme
6473  CALL solver_dynamic_degree_set(solver,solver_dynamic_third_degree,err,error,*999)
6474  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
6475  CALL solver_dynamic_theta_set(solver,[1.84_dp,3.07_dp,4.5_dp],err,error,*999)
6476  CASE(solver_dynamic_third_degree_liniger2_scheme)
6477  dynamic_solver%SCHEME=solver_dynamic_third_degree_liniger2_scheme
6478  CALL solver_dynamic_degree_set(solver,solver_dynamic_third_degree,err,error,*999)
6479  CALL solver_dynamic_order_set(solver,solver_dynamic_first_order,err,error,*999)
6480  CALL solver_dynamic_theta_set(solver,[0.80_dp,1.03_dp,1.29_dp],err,error,*999)
6481  CASE(solver_dynamic_houbolt_scheme)
6482  dynamic_solver%SCHEME=solver_dynamic_houbolt_scheme
6483  CALL solver_dynamic_degree_set(solver,solver_dynamic_third_degree,err,error,*999)
6484  CALL solver_dynamic_order_set(solver,solver_dynamic_second_order,err,error,*999)
6485  CALL solver_dynamic_theta_set(solver,[2.0_dp,11.0_dp/3.0_dp,6.0_dp],err,error,*999)
6486  CASE(solver_dynamic_wilson_scheme)
6487  dynamic_solver%SCHEME=solver_dynamic_wilson_scheme
6488  CALL solver_dynamic_degree_set(solver,solver_dynamic_third_degree,err,error,*999)
6489  CALL solver_dynamic_order_set(solver,solver_dynamic_second_order,err,error,*999)
6490  theta=1.4_dp
6491  CALL solver_dynamic_theta_set(solver,[theta,theta**2,theta**3],err,error,*999)
6492  CASE(solver_dynamic_bossak_newmark1_scheme)
6493  dynamic_solver%SCHEME=solver_dynamic_bossak_newmark1_scheme
6494  CALL solver_dynamic_degree_set(solver,solver_dynamic_third_degree,err,error,*999)
6495  CALL solver_dynamic_order_set(solver,solver_dynamic_second_order,err,error,*999)
6496  alpha=-0.1_dp
6497  beta=0.3025_dp
6498  gamma=0.5_dp-alpha
6499  CALL solver_dynamic_theta_set(solver,[1.0_dp-alpha,2.0_dp/3.0_dp-alpha+2.0_dp*beta,6.0_dp*beta],err,error,*999)
6500  CASE(solver_dynamic_bossak_newmark2_scheme)
6501  dynamic_solver%SCHEME=solver_dynamic_bossak_newmark2_scheme
6502  CALL solver_dynamic_degree_set(solver,solver_dynamic_third_degree,err,error,*999)
6503  CALL solver_dynamic_order_set(solver,solver_dynamic_second_order,err,error,*999)
6504  alpha=-0.1_dp
6505  beta=1.0_dp/6.0_dp-1.0_dp/2.0_dp*alpha
6506  gamma=1.0_dp/2.0_dp-alpha
6507  CALL solver_dynamic_theta_set(solver,[1.0_dp-alpha,1.0_dp-2.0_dp*alpha,1.0_dp-3.0_dp*alpha],err,error,*999)
6508  CASE(solver_dynamic_hilbert_hughes_taylor1_scheme)
6509  dynamic_solver%SCHEME=solver_dynamic_hilbert_hughes_taylor1_scheme
6510  CALL solver_dynamic_degree_set(solver,solver_dynamic_third_degree,err,error,*999)
6511  CALL solver_dynamic_order_set(solver,solver_dynamic_second_order,err,error,*999)
6512  alpha=-0.1_dp
6513  beta=0.3025_dp
6514  gamma=0.5_dp-alpha
6515  CALL solver_dynamic_theta_set(solver,[1.0_dp,2.0_dp/3.0_dp+2.0_dp*beta-2.0_dp*alpha**2, &
6516  & 6.0_dp*beta*(1.0_dp+alpha)],err,error,*999)
6517  CASE(solver_dynamic_hilbert_hughes_taylor2_scheme)
6518  dynamic_solver%SCHEME=solver_dynamic_hilbert_hughes_taylor2_scheme
6519  CALL solver_dynamic_degree_set(solver,solver_dynamic_third_degree,err,error,*999)
6520  CALL solver_dynamic_order_set(solver,solver_dynamic_second_order,err,error,*999)
6521  alpha=-0.3_dp
6522  beta=0.3025_dp
6523  gamma=0.5_dp-alpha
6524  CALL solver_dynamic_theta_set(solver,[1.0_dp,2.0_dp/3.0_dp+2.0_dp*beta-2.0_dp*alpha**2, &
6525  & 6.0_dp*beta*(1.0_dp+alpha)],err,error,*999)
6526  CASE(solver_dynamic_user_defined_scheme)
6527  dynamic_solver%SCHEME=solver_dynamic_user_defined_scheme
6528  CASE DEFAULT
6529  local_error="The specified scheme of "//trim(numbertovstring(scheme,"*",err,error))//" is invalid."
6530  CALL flagerror(local_error,err,error,*999)
6531  END SELECT
6532  ELSE
6533  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
6534  ENDIF
6535  ELSE
6536  CALL flagerror("The specified solver is not a dynamic solver.",err,error,*999)
6537  ENDIF
6538  ENDIF
6539  ELSE
6540  CALL flagerror("Solver is not associated.",err,error,*999)
6541  ENDIF
6542 
6543  exits("SOLVER_DYNAMIC_SCHEME_SET")
6544  RETURN
6545 999 errorsexits("SOLVER_DYNAMIC_SCHEME_SET",err,error)
6546  RETURN 1
6547  END SUBROUTINE solver_dynamic_scheme_set
6548 
6549  !
6550  !================================================================================================================================
6551  !
6552 
6554  SUBROUTINE solver_dynamic_solve(DYNAMIC_SOLVER,ERR,ERROR,*)
6555 
6556  !Argument variables
6557  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
6558  INTEGER(INTG), INTENT(OUT) :: ERR
6559  TYPE(varying_string), INTENT(OUT) :: ERROR
6560  !Local Variables
6561  INTEGER(INTG) :: solver_matrix_idx
6562  TYPE(solver_type), POINTER :: LINEAR_SOLVER,SOLVER,NONLINEAR_SOLVER
6563  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
6564  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
6565  TYPE(varying_string) :: LOCAL_ERROR
6566 
6567  enters("SOLVER_DYNAMIC_SOLVE",err,error,*999)
6568 
6569  IF(ASSOCIATED(dynamic_solver)) THEN
6570  SELECT CASE(dynamic_solver%SOLVER_LIBRARY)
6571  CASE(solver_cmiss_library)
6572  solver=>dynamic_solver%SOLVER
6573  IF(ASSOCIATED(solver)) THEN
6574  SELECT CASE(dynamic_solver%LINEARITY)
6575  CASE(solver_dynamic_linear)
6576  !Solve the linear dynamic problem
6577  linear_solver=>dynamic_solver%LINEAR_SOLVER
6578  IF(ASSOCIATED(linear_solver)) THEN
6579  IF(dynamic_solver%SOLVER_INITIALISED) THEN
6580  !Assemble the solver equations
6581  CALL solver_dynamic_mean_predicted_calculate(solver,err,error,*999)
6582  CALL solver_matrices_dynamic_assemble(solver,solver_matrices_linear_only,err,error,*999)
6583  !Solve the linear system
6584  CALL solver_solve(linear_solver,err,error,*999)
6585  !Update dependent field with solution
6586  CALL solver_variables_dynamic_field_update(solver,err,error,*999)
6587  ELSE
6588  !If we need to initialise the solver
6589  IF((dynamic_solver%ORDER==solver_dynamic_first_order.AND.dynamic_solver%DEGREE>solver_dynamic_first_degree).OR. &
6590  & (dynamic_solver%ORDER==solver_dynamic_second_order.AND.dynamic_solver%DEGREE>solver_dynamic_second_degree)) THEN
6591  !Assemble the solver equations
6592  CALL solver_dynamic_mean_predicted_calculate(solver,err,error,*999)
6593  CALL solver_matrices_dynamic_assemble(solver,solver_matrices_linear_only,err,error,*999)
6594  !Solve the linear system
6595  CALL solver_solve(linear_solver,err,error,*999)
6596  !Update dependent field with solution
6597  CALL solver_variables_dynamic_field_update(solver,err,error,*999)
6598  ENDIF
6599  !Set initialised flag
6600  dynamic_solver%SOLVER_INITIALISED=.true.
6601  ENDIF
6602  ELSE
6603  CALL flagerror("Dynamic solver linear solver is not associated.",err,error,*999)
6604  ENDIF
6605  CASE(solver_dynamic_nonlinear)
6606  !Solve the nonlinear dynamic problem
6607  nonlinear_solver=>dynamic_solver%NONLINEAR_SOLVER
6608  IF(ASSOCIATED(nonlinear_solver)) THEN
6609  IF(dynamic_solver%SOLVER_INITIALISED) THEN
6610  !Calculate predicted values
6611  CALL solver_dynamic_mean_predicted_calculate(solver,err,error,*999)
6612  !Solve the nonlinear system
6613  CALL solver_solve(nonlinear_solver,err,error,*999)
6614  !Update dependent field with solution
6615  CALL solver_variables_dynamic_field_update(solver,err,error,*999)
6616  ELSE
6617  !If we need to initialise the solver
6618  !No solver for the first (starting) time step.
6619 !!TODO: still need to calculate starting velocities and accelerations etc.
6620  !Update dependent field with solution
6621  CALL solver_variables_dynamic_field_update(solver,err,error,*999)
6622  !Set initialised flag
6623  dynamic_solver%SOLVER_INITIALISED=.true.
6624  ENDIF
6625  ELSE
6626  CALL flagerror("Dynamic solver nonlinear solver is not associated.",err,error,*999)
6627  ENDIF
6628  CASE DEFAULT
6629  local_error="The dynamic solver linearity type of "// &
6630  & trim(numbertovstring(dynamic_solver%LINEARITY,"*",err,error))//" is invalid."
6631  CALL flagerror(local_error,err,error,*999)
6632  END SELECT
6633 
6634  IF(solver%OUTPUT_TYPE>=solver_solver_output) THEN
6635 
6636 #ifdef TAUPROF
6637  CALL tau_static_phase_start("Solution Output Phase")
6638 #endif
6639  solver_equations=>solver%SOLVER_EQUATIONS
6640  IF(ASSOCIATED(solver_equations)) THEN
6641  solver_matrices=>solver_equations%SOLVER_MATRICES
6642  IF(ASSOCIATED(solver_matrices)) THEN
6643  CALL write_string(general_output_type,"",err,error,*999)
6644  CALL write_string(general_output_type,"Solver solution vectors:",err,error,*999)
6645  CALL write_string_value(general_output_type,"Number of solution vectors = ",solver_matrices%NUMBER_OF_MATRICES, &
6646  & err,error,*999)
6647  DO solver_matrix_idx=1,solver_matrices%NUMBER_OF_MATRICES
6648  CALL write_string_value(general_output_type,"Solution vector for solver matrix : ",solver_matrix_idx, &
6649  & err,error,*999)
6650  CALL distributed_vector_output(general_output_type,solver_matrices%MATRICES(solver_matrix_idx)%PTR% &
6651  & solver_vector,err,error,*999)
6652  ENDDO !solver_matrix_idx
6653  ELSE
6654  CALL flagerror("Solver equations solver matrices is not associated.",err,error,*999)
6655  ENDIF
6656  ELSE
6657  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
6658  ENDIF
6659 
6660 #ifdef TAUPROF
6661  CALL tau_static_phase_stop("Solution Output Phase")
6662 #endif
6663  ENDIF
6664  ELSE
6665  CALL flagerror("Dynamic solver solver is not associated.",err,error,*999)
6666  ENDIF
6667  CASE(solver_petsc_library)
6668  CALL flagerror("Not implemented.",err,error,*999)
6669  CASE DEFAULT
6670  local_error="The solver library type of "// &
6671  & trim(numbertovstring(dynamic_solver%SOLVER_LIBRARY,"*",err,error))//" is invalid."
6672  CALL flagerror(local_error,err,error,*999)
6673  END SELECT
6674  ELSE
6675  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
6676  ENDIF
6677 
6678  exits("SOLVER_DYNAMIC_SOLVE")
6679  RETURN
6680 999 errorsexits("SOLVER_DYNAMIC_SOLVE",err,error)
6681  RETURN 1
6682 
6683  END SUBROUTINE solver_dynamic_solve
6684 
6685  !
6686  !================================================================================================================================
6687  !
6688 
6690  SUBROUTINE solver_dynamic_theta_set_dp1(SOLVER,THETA,ERR,ERROR,*)
6691 
6692  !Argument variables
6693  TYPE(solver_type), POINTER :: SOLVER
6694  REAL(DP), INTENT(IN) :: THETA
6695  INTEGER(INTG), INTENT(OUT) :: ERR
6696  TYPE(varying_string), INTENT(OUT) :: ERROR
6697  !Local Variables
6698 
6699  enters("SOLVER_DYNAMIC_THETA_SET_DP1",err,error,*999)
6700 
6701  CALL solver_dynamic_theta_set_dp(solver,[theta],err,error,*999)
6702 
6703  exits("SOLVER_DYNAMIC_THETA_SET_DP1")
6704  RETURN
6705 999 errorsexits("SOLVER_DYNAMIC_THETA_SET_DP1",err,error)
6706  RETURN 1
6707  END SUBROUTINE solver_dynamic_theta_set_dp1
6708 
6709  !
6710  !================================================================================================================================
6711  !
6712 
6714  SUBROUTINE solver_dynamic_theta_set_dp(SOLVER,THETA,ERR,ERROR,*)
6715 
6716  !Argument variables
6717  TYPE(solver_type), POINTER :: SOLVER
6718  REAL(DP), INTENT(IN) :: THETA(:)
6719  INTEGER(INTG), INTENT(OUT) :: ERR
6720  TYPE(varying_string), INTENT(OUT) :: ERROR
6721  !Local Variables
6722  INTEGER(INTG) :: degree_idx
6723  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
6724  TYPE(varying_string) :: LOCAL_ERROR
6725 
6726  enters("SOLVER_DYNAMIC_THETA_SET_DP",err,error,*999)
6727 
6728  IF(ASSOCIATED(solver)) THEN
6729  IF(solver%SOLVER_FINISHED) THEN
6730  CALL flagerror("The solver has already been finished.",err,error,*999)
6731  ELSE
6732  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
6733  dynamic_solver=>solver%DYNAMIC_SOLVER
6734  IF(ASSOCIATED(dynamic_solver)) THEN
6735  IF(SIZE(theta,1)>=dynamic_solver%DEGREE) THEN
6736  DO degree_idx=1,dynamic_solver%DEGREE
6737  IF(theta(degree_idx)>=0.0_dp) THEN
6738  dynamic_solver%THETA(degree_idx)=theta(degree_idx)
6739  ELSE
6740  local_error="The specified theta "//trim(numbertovstring(degree_idx,"*",err,error))// &
6741  & " value of "//trim(numbertovstring(theta(degree_idx),"*",err,error))// &
6742  & " is invalid. The theta value must be >= 0.0."
6743  CALL flagerror(local_error,err,error,*999)
6744  ENDIF
6745  ENDDO !degree_idx
6746  ELSE
6747  local_error="Invalid number of the thetas. The supplied number of thetas ("// &
6748  & trim(numbertovstring(SIZE(theta,1),"*",err,error))//") must be equal to the interpolation degree ("// &
6749  & trim(numbertovstring(dynamic_solver%DEGREE,"*",err,error))//")."
6750  CALL flagerror(local_error,err,error,*999)
6751  ENDIF
6752  ELSE
6753  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
6754  ENDIF
6755  ELSE
6756  CALL flagerror("The specified solver is not a dynamic solver.",err,error,*999)
6757  ENDIF
6758  ENDIF
6759  ELSE
6760  CALL flagerror("Solver is not associated.",err,error,*999)
6761  ENDIF
6762 
6763  exits("SOLVER_DYNAMIC_THETA_SET_DP")
6764  RETURN
6765 999 errorsexits("SOLVER_DYNAMIC_THETA_SET_DP",err,error)
6766  RETURN 1
6767  END SUBROUTINE solver_dynamic_theta_set_dp
6768 
6769  !
6770  !================================================================================================================================
6771  !
6772 
6774  SUBROUTINE solver_dynamic_ale_set(SOLVER,ALE,ERR,ERROR,*)
6775 
6776  !Argument variables
6777  TYPE(solver_type), POINTER :: SOLVER
6778  LOGICAL :: ALE
6779  INTEGER(INTG), INTENT(OUT) :: ERR
6780  TYPE(varying_string), INTENT(OUT) :: ERROR
6781  !Local Variables
6782 ! INTEGER(INTG) :: degree_idx
6783  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
6784 ! TYPE(VARYING_STRING) :: LOCAL_ERROR
6785 
6786  enters("SOLVER_DYNAMIC_ALE_SET",err,error,*999)
6787 
6788  IF(ASSOCIATED(solver)) THEN
6789  IF(solver%SOLVER_FINISHED) THEN
6790  CALL flagerror("The solver has already been finished.",err,error,*999)
6791  ELSE
6792  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
6793  dynamic_solver=>solver%DYNAMIC_SOLVER
6794  IF(ASSOCIATED(dynamic_solver)) THEN
6795  dynamic_solver%ALE=ale
6796  ELSE
6797  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
6798  ENDIF
6799  ELSE
6800  CALL flagerror("The specified solver is not a dynamic solver.",err,error,*999)
6801  ENDIF
6802  ENDIF
6803  ELSE
6804  CALL flagerror("Solver is not associated.",err,error,*999)
6805  ENDIF
6806 
6807  exits("SOLVER_DYNAMIC_ALE_SET")
6808  RETURN
6809 999 errorsexits("SOLVER_DYNAMIC_ALE_SET",err,error)
6810  RETURN 1
6811  END SUBROUTINE solver_dynamic_ale_set
6812 
6813  !
6814  !================================================================================================================================
6815  !
6816 
6818  SUBROUTINE solver_dynamic_update_bc_set(SOLVER,UPDATE_BC,ERR,ERROR,*)
6819 
6820  !Argument variables
6821  TYPE(solver_type), POINTER :: SOLVER
6822  LOGICAL :: UPDATE_BC
6823  INTEGER(INTG), INTENT(OUT) :: ERR
6824  TYPE(varying_string), INTENT(OUT) :: ERROR
6825  !Local Variables
6826 ! INTEGER(INTG) :: degree_idx
6827  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
6828 ! TYPE(VARYING_STRING) :: LOCAL_ERROR
6829 
6830  enters("SOLVER_DYNAMIC_UPDATE_BC_SET",err,error,*999)
6831 
6832  IF(ASSOCIATED(solver)) THEN
6833  IF(solver%SOLVER_FINISHED) THEN
6834  CALL flagerror("The solver has already been finished.",err,error,*999)
6835  ELSE
6836  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
6837  dynamic_solver=>solver%DYNAMIC_SOLVER
6838  IF(ASSOCIATED(dynamic_solver)) THEN
6839  dynamic_solver%UPDATE_BC=update_bc
6840  ELSE
6841  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
6842  ENDIF
6843  ELSE
6844  CALL flagerror("The specified solver is not a dynamic solver.",err,error,*999)
6845  ENDIF
6846  ENDIF
6847  ELSE
6848  CALL flagerror("Solver is not associated.",err,error,*999)
6849  ENDIF
6850 
6851  exits("SOLVER_DYNAMIC_UPDATE_BC_SET")
6852  RETURN
6853 999 errorsexits("SOLVER_DYNAMIC_UPDATE_BC_SET",err,error)
6854  RETURN 1
6855  END SUBROUTINE solver_dynamic_update_bc_set
6856 
6857  !
6858  !================================================================================================================================
6859  !
6860 
6862  SUBROUTINE solver_dynamic_times_set(SOLVER,CURRENT_TIME,TIME_INCREMENT,ERR,ERROR,*)
6863 
6864  !Argument variables
6865  TYPE(solver_type), POINTER :: SOLVER
6866  REAL(DP), INTENT(IN) :: CURRENT_TIME
6867  REAL(DP), INTENT(IN) :: TIME_INCREMENT
6868  INTEGER(INTG), INTENT(OUT) :: ERR
6869  TYPE(varying_string), INTENT(OUT) :: ERROR
6870  !Local Variables
6871  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
6872  TYPE(varying_string) :: LOCAL_ERROR
6873 
6874  enters("SOLVER_DYNAMIC_TIMES_SET",err,error,*999)
6875 
6876  IF(ASSOCIATED(solver)) THEN
6877  !Note: do not check for finished here as we may wish to modify this for multiple solves.
6878  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
6879  dynamic_solver=>solver%DYNAMIC_SOLVER
6880  IF(ASSOCIATED(dynamic_solver)) THEN
6881  IF(abs(time_increment)<=zero_tolerance) THEN
6882  local_error="The specified time increment of "//trim(numbertovstring(time_increment,"*",err,error))// &
6883  & " is invalid. The time increment must not be zero."
6884  CALL flagerror(local_error,err,error,*999)
6885  ELSE
6886  dynamic_solver%CURRENT_TIME=current_time
6887  dynamic_solver%TIME_INCREMENT=time_increment
6888  ENDIF
6889  ELSE
6890  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
6891  ENDIF
6892  ELSE
6893  CALL flagerror("The specified solver is not a dynamic solver.",err,error,*999)
6894  ENDIF
6895  ELSE
6896  CALL flagerror("Solver is not associated.",err,error,*999)
6897  ENDIF
6898 
6899  exits("SOLVER_DYNAMIC_TIMES_SET")
6900  RETURN
6901 999 errorsexits("SOLVER_DYNAMIC_TIMES_SET",err,error)
6902  RETURN 1
6903  END SUBROUTINE solver_dynamic_times_set
6904 
6905  !
6906  !================================================================================================================================
6907  !
6908 
6910  SUBROUTINE solver_eigenproblem_create_finish(EIGENPROBLEM_SOLVER,ERR,ERROR,*)
6911 
6912  !Argument variables
6913  TYPE(eigenproblem_solver_type), POINTER :: EIGENPROBLEM_SOLVER
6914  INTEGER(INTG), INTENT(OUT) :: ERR
6915  TYPE(varying_string), INTENT(OUT) :: ERROR
6916  !Local Variables
6917 
6918  enters("SOLVER_EIGENPROBLEM_CREATE_FINISH",err,error,*999)
6919 
6920  IF(ASSOCIATED(eigenproblem_solver)) THEN
6921  CALL flagerror("Not implemented.",err,error,*999)
6922  ELSE
6923  CALL flagerror("Eigenproblem solver is not associated.",err,error,*999)
6924  ENDIF
6925 
6926  exits("SOLVER_EIGENPROBLEM_CREATE_FINISH")
6927  RETURN
6928 999 errorsexits("SOLVER_EIGENPROBLEM_CREATE_FINISH",err,error)
6929  RETURN 1
6930 
6931  END SUBROUTINE solver_eigenproblem_create_finish
6932 
6933  !
6934  !================================================================================================================================
6935  !
6936 
6938  SUBROUTINE solver_eigenproblem_finalise(EIGENPROBLEM_SOLVER,ERR,ERROR,*)
6939 
6940  !Argument variables
6941  TYPE(eigenproblem_solver_type), POINTER :: EIGENPROBLEM_SOLVER
6942  INTEGER(INTG), INTENT(OUT) :: ERR
6943  TYPE(varying_string), INTENT(OUT) :: ERROR
6944  !Local Variables
6945 
6946  enters("SOLVER_EIGENPROBLEM_FINALISE",err,error,*999)
6947 
6948  IF(ASSOCIATED(eigenproblem_solver)) THEN
6949  DEALLOCATE(eigenproblem_solver)
6950  ENDIF
6951 
6952  exits("SOLVER_EIGENPROBLEM_FINALISE")
6953  RETURN
6954 999 errorsexits("SOLVER_EIGENPROBLEM_FINALISE",err,error)
6955  RETURN 1
6956 
6957  END SUBROUTINE solver_eigenproblem_finalise
6958 
6959  !
6960  !================================================================================================================================
6961  !
6962 
6964  SUBROUTINE solver_eigenproblem_initialise(SOLVER,ERR,ERROR,*)
6965 
6966  !Argument variables
6967  TYPE(solver_type), POINTER :: SOLVER
6968  INTEGER(INTG), INTENT(OUT) :: ERR
6969  TYPE(varying_string), INTENT(OUT) :: ERROR
6970  !Local Variables
6971  INTEGER(INTG) :: DUMMY_ERR
6972  TYPE(varying_string) :: DUMMY_ERROR
6973 
6974  enters("SOLVER_EIGENPROBLEM_INITIALISE",err,error,*998)
6975 
6976  IF(ASSOCIATED(solver)) THEN
6977  IF(ASSOCIATED(solver%EIGENPROBLEM_SOLVER)) THEN
6978  CALL flagerror("Eigenproblem solver is already associated for this solver.",err,error,*998)
6979  ELSE
6980  ALLOCATE(solver%EIGENPROBLEM_SOLVER,stat=err)
6981  IF(err/=0) CALL flagerror("Could not allocate solver eigenproblem solver.",err,error,*999)
6982  solver%EIGENPROBLEM_SOLVER%SOLVER=>solver
6983  solver%EIGENPROBLEM_SOLVER%SOLVER_LIBRARY=solver_petsc_library
6984  solver%EIGENPROBLEM_SOLVER%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
6985  ENDIF
6986  ELSE
6987  CALL flagerror("Solver is not associated.",err,error,*998)
6988  ENDIF
6989 
6990  exits("SOLVER_EIGENPROBLEM_INITIALISE")
6991  RETURN
6992 999 CALL solver_eigenproblem_finalise(solver%EIGENPROBLEM_SOLVER,dummy_err,dummy_error,*998)
6993 998 errorsexits("SOLVER_EIGENPROBLEM_INITIALISE",err,error)
6994  RETURN 1
6995 
6996  END SUBROUTINE solver_eigenproblem_initialise
6997 
6998  !
6999  !================================================================================================================================
7000  !
7001 
7003  SUBROUTINE solver_eigenproblem_library_type_get(EIGENPROBLEM_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
7004 
7005  !Argument variables
7006  TYPE(eigenproblem_solver_type), POINTER :: EIGENPROBLEM_SOLVER
7007  INTEGER(INTG), INTENT(OUT) :: SOLVER_LIBRARY_TYPE
7008  INTEGER(INTG), INTENT(OUT) :: ERR
7009  TYPE(varying_string), INTENT(OUT) :: ERROR
7010  !Local Variables
7011 
7012  enters("SOLVER_EIGENPROBLEM_LIBRARY_TYPE_GET",err,error,*999)
7013 
7014  IF(ASSOCIATED(eigenproblem_solver)) THEN
7015  solver_library_type=eigenproblem_solver%SOLVER_LIBRARY
7016  ELSE
7017  CALL flagerror("Eigenproblem solver is not associated.",err,error,*999)
7018  ENDIF
7019 
7020  exits("SOLVER_EIGENPROBLEM_LIBRARY_TYPE_GET")
7021  RETURN
7022 999 errorsexits("SOLVER_EIGENPROBLEM_LIBRARY_TYPE_GET",err,error)
7023  RETURN 1
7024 
7025  END SUBROUTINE solver_eigenproblem_library_type_get
7026 
7027  !
7028  !================================================================================================================================
7029  !
7030 
7032  SUBROUTINE solver_eigenproblem_library_type_set(EIGENPROBLEM_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
7033 
7034  !Argument variables
7035  TYPE(eigenproblem_solver_type), POINTER :: EIGENPROBLEM_SOLVER
7036  INTEGER(INTG), INTENT(IN) :: SOLVER_LIBRARY_TYPE
7037  INTEGER(INTG), INTENT(OUT) :: ERR
7038  TYPE(varying_string), INTENT(OUT) :: ERROR
7039  !Local Variables
7040  TYPE(varying_string) :: LOCAL_ERROR
7041 
7042  enters("SOLVER_EIGENPROBLEM_LIBRARY_TYPE_SET",err,error,*999)
7043 
7044  IF(ASSOCIATED(eigenproblem_solver)) THEN
7045  SELECT CASE(solver_library_type)
7046  CASE(solver_cmiss_library)
7047  CALL flagerror("Not implemented.",err,error,*999)
7048  CASE DEFAULT
7049  local_error="The specified solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
7050  & " is invalid for an eigenproblem solver."
7051  CALL flagerror(local_error,err,error,*999)
7052  END SELECT
7053  ELSE
7054  CALL flagerror("Dynamic solver is not associated.",err,error,*999)
7055  ENDIF
7056 
7057  exits("SOLVER_EIGENPROBLEM_LIBRARY_TYPE_SET")
7058  RETURN
7059 999 errorsexits("SOLVER_EIGENPROBLEM_LIBRARY_TYPE_SET",err,error)
7060  RETURN 1
7061 
7062  END SUBROUTINE solver_eigenproblem_library_type_set
7063 
7064  !
7065  !================================================================================================================================
7066  !
7067 
7069  SUBROUTINE solver_eigenproblemmatriceslibrarytypeget(EIGENPROBLEM_SOLVER,MATRICES_LIBRARY_TYPE,ERR,ERROR,*)
7070 
7071  !Argument variables
7072  TYPE(eigenproblem_solver_type), POINTER :: EIGENPROBLEM_SOLVER
7073  INTEGER(INTG), INTENT(OUT) :: MATRICES_LIBRARY_TYPE
7074  INTEGER(INTG), INTENT(OUT) :: ERR
7075  TYPE(varying_string), INTENT(OUT) :: ERROR
7076  !Local Variables
7077 
7078  enters("Solver_EigenproblemMatricesLibraryTypeGet",err,error,*999)
7079 
7080  IF(ASSOCIATED(eigenproblem_solver)) THEN
7081  matrices_library_type=eigenproblem_solver%SOLVER_MATRICES_LIBRARY
7082  ELSE
7083  CALL flagerror("Eigenproblem solver is not associated.",err,error,*999)
7084  ENDIF
7085 
7086  exits("Solver_EigenproblemMatricesLibraryTypeGet")
7087  RETURN
7088 999 errorsexits("Solver_EigenproblemMatricesLibraryTypeGet",err,error)
7089  RETURN 1
7090 
7091  END SUBROUTINE solver_eigenproblemmatriceslibrarytypeget
7092 
7093  !
7094  !================================================================================================================================
7095  !
7096 
7098  SUBROUTINE solver_eigenproblem_solve(EIGENPROBLEM_SOLVER,ERR,ERROR,*)
7099 
7100  !Argument variables
7101  TYPE(eigenproblem_solver_type), POINTER :: EIGENPROBLEM_SOLVER
7102  INTEGER(INTG), INTENT(OUT) :: ERR
7103  TYPE(varying_string), INTENT(OUT) :: ERROR
7104  !Local Variables
7105 
7106  enters("SOLVER_EIGENPROBLEM_SOLVE",err,error,*999)
7107 
7108  IF(ASSOCIATED(eigenproblem_solver)) THEN
7109  CALL flagerror("Not implemented.",err,error,*999)
7110  ELSE
7111  CALL flagerror("Eigenproblem solver is not associated.",err,error,*999)
7112  ENDIF
7113 
7114  exits("SOLVER_EIGENPROBLEM_SOLVE")
7115  RETURN
7116 999 errorsexits("SOLVER_EIGENPROBLEM_SOLVE",err,error)
7117  RETURN 1
7118 
7119  END SUBROUTINE solver_eigenproblem_solve
7120 
7121  !
7122  !================================================================================================================================
7123  !
7124 
7126  SUBROUTINE solver_equations_boundary_conditions_get(SOLVER_EQUATIONS,BOUNDARY_CONDITIONS,ERR,ERROR,*)
7127 
7128  !Argument variables
7129  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
7130  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
7131  INTEGER(INTG), INTENT(OUT) :: ERR
7132  TYPE(varying_string), INTENT(OUT) :: ERROR
7133  !Local Variables
7134 
7135  enters("SOLVER_EQUATIONS_BOUNDARY_CONDITIONS_GET",err,error,*999)
7136 
7137  IF(ASSOCIATED(solver_equations)) THEN
7138  IF(solver_equations%SOLVER_EQUATIONS_FINISHED) THEN
7139  IF(ASSOCIATED(boundary_conditions)) THEN
7140  CALL flagerror("Boundary conditions is already associated.",err,error,*999)
7141  ELSE
7142  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
7143  IF(.NOT.ASSOCIATED(boundary_conditions)) CALL flagerror("Solver equations boundary conditions is not associated.", &
7144  & err,error,*999)
7145  ENDIF
7146  ELSE
7147  CALL flagerror("Solver equations has not been finished.",err,error,*999)
7148  ENDIF
7149  ELSE
7150  CALL flagerror("Solver equations is not associated.",err,error,*999)
7151  ENDIF
7152 
7153  exits("SOLVER_EQUATIONS_BOUNDARY_CONDITIONS_GET")
7154  RETURN
7155 999 errorsexits("SOLVER_EQUATIONS_BOUNDARY_CONDITIONS_GET",err,error)
7156  RETURN 1
7157 
7158  END SUBROUTINE solver_equations_boundary_conditions_get
7159 
7160  !
7161  !================================================================================================================================
7162  !
7163 
7165  SUBROUTINE solver_equations_create_finish(SOLVER_EQUATIONS,ERR,ERROR,*)
7166 
7167  !Argument variables
7168  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
7169  INTEGER(INTG), INTENT(OUT) :: ERR
7170  TYPE(varying_string), INTENT(OUT) :: ERROR
7171  !Local Variables
7172  TYPE(solver_type), POINTER :: SOLVER
7173 
7174  enters("SOLVER_EQUATIONS_CREATE_FINISH",err,error,*998)
7175 
7176  IF(ASSOCIATED(solver_equations)) THEN
7177  IF(solver_equations%SOLVER_EQUATIONS_FINISHED) THEN
7178  CALL flagerror("Solver equations has already been finished.",err,error,*998)
7179  ELSE
7180  solver=>solver_equations%SOLVER
7181  IF(ASSOCIATED(solver)) THEN
7182  IF(ASSOCIATED(solver%LINKING_SOLVER)) THEN
7183  CALL flagerror("Can not finish solver equations creation for a solver that has been linked.",err,error,*999)
7184  ELSE
7185  solver_equations%SOLVER_EQUATIONS_FINISHED=.true.
7186  ENDIF
7187  ELSE
7188  CALL flagerror("Solver equations solver is not associated.",err,error,*999)
7189  ENDIF
7190  ENDIF
7191  ELSE
7192  CALL flagerror("Solver equations is not associated.",err,error,*998)
7193  ENDIF
7194 
7195  exits("SOLVER_EQUATIONS_CREATE_FINISH")
7196  RETURN
7197 999 CONTINUE
7198 998 errorsexits("SOLVER_EQUATIONS_CREATE_FINISH",err,error)
7199  RETURN 1
7200 
7201  END SUBROUTINE solver_equations_create_finish
7202 
7203  !
7204  !================================================================================================================================
7205  !
7206 
7208  SUBROUTINE solver_equations_create_start(SOLVER,SOLVER_EQUATIONS,ERR,ERROR,*)
7209 
7210  !Argument variables
7211  TYPE(solver_type), POINTER :: SOLVER
7212  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
7213  INTEGER(INTG), INTENT(OUT) :: ERR
7214  TYPE(varying_string), INTENT(OUT) :: ERROR
7215  !Local Variables
7216  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
7217  TYPE(varying_string) :: LOCAL_ERROR
7218 
7219  enters("SOLVER_EQUATIONS_CREATE_START",err,error,*999)
7220 
7221  IF(ASSOCIATED(solver)) THEN
7222  IF(solver%SOLVER_FINISHED) THEN
7223  IF(ASSOCIATED(solver%LINKING_SOLVER)) THEN
7224  CALL flagerror("Can not start solver equations creation for a solver that has been linked.",err,error,*999)
7225  ELSE
7226  IF(ASSOCIATED(solver_equations)) THEN
7227  CALL flagerror("Solver equations is already associated.",err,error,*999)
7228  ELSE
7229  NULLIFY(solver_equations)
7230  CALL solver_equations_initialise(solver,err,error,*999)
7231  NULLIFY(solver_mapping)
7232  CALL solver_mapping_create_start(solver%SOLVER_EQUATIONS,solver_mapping,err,error,*999)
7233  SELECT CASE(solver%SOLVE_TYPE)
7234  CASE(solver_linear_type)
7235  CALL solver_mapping_solver_matrices_number_set(solver_mapping,1,err,error,*999)
7236  CASE(solver_nonlinear_type)
7237  CALL solver_mapping_solver_matrices_number_set(solver_mapping,1,err,error,*999)
7238  CASE(solver_dynamic_type)
7239  CALL solver_mapping_solver_matrices_number_set(solver_mapping,1,err,error,*999)
7240  CASE(solver_dae_type)
7241  CALL solver_mapping_solver_matrices_number_set(solver_mapping,0,err,error,*999)
7242  CASE(solver_eigenproblem_type)
7243  CALL solver_mapping_solver_matrices_number_set(solver_mapping,2,err,error,*999)
7244  CASE DEFAULT
7245  local_error="The solver type of "//trim(numbertovstring(solver%SOLVE_TYPE,"*",err,error))//" is invalid."
7246  CALL flagerror(local_error,err,error,*999)
7247  END SELECT
7248  solver_equations=>solver%SOLVER_EQUATIONS
7249  ENDIF
7250  ENDIF
7251  ELSE
7252  CALL flagerror("Solver has not been finished.",err,error,*999)
7253  ENDIF
7254  ELSE
7255  CALL flagerror("Solver is not associated.",err,error,*999)
7256  ENDIF
7257 
7258  exits("SOLVER_EQUATIONS_CREATE_START")
7259  RETURN
7260 999 errorsexits("SOLVER_EQUATIONS_CREATE_START",err,error)
7261  RETURN 1
7262 
7263  END SUBROUTINE solver_equations_create_start
7264 
7265  !
7266  !================================================================================================================================
7267  !
7268 
7270  SUBROUTINE solver_equations_destroy(SOLVER_EQUATIONS,ERR,ERROR,*)
7271 
7272  !Argument variables
7273  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
7274  INTEGER(INTG), INTENT(OUT) :: ERR
7275  TYPE(varying_string), INTENT(OUT) :: ERROR
7276  !Local Variables
7277 
7278  enters("SOLVER_EQUATIONS_DESTROY",err,error,*999)
7279 
7280  IF(ASSOCIATED(solver_equations)) THEN
7281  CALL solver_equations_finalise(solver_equations,err,error,*999)
7282  ELSE
7283  CALL flagerror("Solver equations is not associated.",err,error,*999)
7284  ENDIF
7285 
7286  exits("SOLVER_EQUATIONS_DESTROY")
7287  RETURN
7288 999 errorsexits("SOLVER_EQUATIONS_DESTROY",err,error)
7289  RETURN 1
7290 
7291  END SUBROUTINE solver_equations_destroy
7292 
7293  !
7294  !================================================================================================================================
7295  !
7296 
7298  SUBROUTINE solver_equations_equations_set_add(SOLVER_EQUATIONS,EQUATIONS_SET,EQUATIONS_SET_INDEX,ERR,ERROR,*)
7299 
7300  !Argument variables
7301  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
7302  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
7303  INTEGER(INTG), INTENT(OUT) :: EQUATIONS_SET_INDEX
7304  INTEGER(INTG), INTENT(OUT) :: ERR
7305  TYPE(varying_string), INTENT(OUT) :: ERROR
7306  !Local Variables
7307  TYPE(equations_type), POINTER :: EQUATIONS
7308  TYPE(solver_type), POINTER :: SOLVER
7309  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
7310  TYPE(varying_string) :: LOCAL_ERROR
7311  LOGICAL :: TIME_COMPATIBLE,LINEARITY_COMPATIBLE
7312 
7313  enters("SOLVER_EQUATIONS_EQUATIONS_SET_ADD",err,error,*999)
7314 
7315  IF(ASSOCIATED(solver_equations)) THEN
7316  IF(solver_equations%SOLVER_EQUATIONS_FINISHED) THEN
7317  CALL flagerror("Solver equations has already been finished.",err,error,*999)
7318  ELSE
7319  solver=>solver_equations%SOLVER
7320  IF(ASSOCIATED(solver)) THEN
7321  IF(ASSOCIATED(solver%LINKING_SOLVER)) THEN
7322  CALL flagerror("Can not add an equations set for a solver that has been linked.",err,error,*999)
7323  ELSE
7324  solver_mapping=>solver_equations%SOLVER_MAPPING
7325  IF(ASSOCIATED(solver_mapping)) THEN
7326  IF(ASSOCIATED(equations_set)) THEN
7327  equations=>equations_set%EQUATIONS
7328  IF(ASSOCIATED(equations)) THEN
7329  time_compatible=.true.
7330  linearity_compatible=.true.
7331  !Check solver equations and equations set time dependence is compatible
7332  SELECT CASE(solver_equations%TIME_DEPENDENCE)
7333  CASE(solver_equations_static,solver_equations_quasistatic)
7334  SELECT CASE(equations%TIME_DEPENDENCE)
7335  CASE(equations_static,equations_quasistatic)
7336  !OK
7337  CASE DEFAULT
7338  time_compatible=.false.
7339  END SELECT
7340  CASE(solver_equations_first_order_dynamic)
7341  SELECT CASE(equations%TIME_DEPENDENCE)
7342 !
7343  CASE(equations_static)
7344  !OK for now, just to test!!!
7345 ! CASE(EQUATIONS_STATIC,EQUATIONS_QUASISTATIC)
7346  CASE(equations_quasistatic)
7347  !Not yet implemented, this needs to be checked to see that it works
7348  time_compatible=.false.
7349  local_error="Static equations set equations with dynamic solver equations is not yet implemented."
7350  CALL flagerror(local_error,err,error,*999)
7351  CASE(equations_first_order_dynamic)
7352  !OK
7353  CASE DEFAULT
7354  time_compatible=.false.
7355  END SELECT
7356  CASE(solver_equations_second_order_dynamic)
7357  SELECT CASE(equations%TIME_DEPENDENCE)
7358  CASE(equations_static,equations_quasistatic,equations_first_order_dynamic)
7359  !Not implemented, this needs to be checked to see that it works
7360  time_compatible=.false.
7361  local_error="Static or first order dynamic equations set equations with a second order dynamic "// &
7362  & "solver equations is not yet implemented."
7363  CALL flagerror(local_error,err,error,*999)
7364  CASE(equations_second_order_dynamic)
7365  !OK
7366  CASE DEFAULT
7367  time_compatible=.false.
7368  END SELECT
7369  CASE DEFAULT
7370  time_compatible=.false.
7371  local_error="Invalid time dependence for solver equations, "// &
7372  & trim(numbertovstring(solver_equations%TIME_DEPENDENCE,"*",err,error))//"."
7373  CALL flagerror(local_error,err,error,*999)
7374  END SELECT
7375  IF (.NOT. time_compatible) THEN
7376  local_error="Invalid equations set up. The time dependence of the equations set to add ("// &
7377  & trim(numbertovstring(equations%TIME_DEPENDENCE,"*",err,error))// &
7378  & ") is not compatible with the solver equations time dependence ("// &
7379  & trim(numbertovstring(solver_equations%TIME_DEPENDENCE,"*",err,error))//")."
7380  CALL flagerror(local_error,err,error,*999)
7381  ENDIF
7382  !Check solver equations and equations set linearity is compatible
7383  SELECT CASE(solver_equations%LINEARITY)
7384  CASE(solver_equations_linear)
7385  SELECT CASE(equations%LINEARITY)
7386  CASE(equations_linear)
7387  !OK
7388  CASE DEFAULT
7389  linearity_compatible=.false.
7390  END SELECT
7391  CASE(solver_equations_nonlinear)
7392  SELECT CASE(equations%LINEARITY)
7393  CASE(equations_linear,equations_nonlinear)
7394  !OK
7395  CASE DEFAULT
7396  linearity_compatible=.false.
7397  END SELECT
7398  CASE DEFAULT
7399  linearity_compatible=.false.
7400  local_error="Invalid linearity for solver equations, "// &
7401  & trim(numbertovstring(solver_equations%LINEARITY,"*",err,error))//"."
7402  CALL flagerror(local_error,err,error,*999)
7403  END SELECT
7404  IF (.NOT. linearity_compatible) THEN
7405  local_error="Invalid equations set up. The linearity of the equations set to add ("// &
7406  & trim(numbertovstring(equations%TIME_DEPENDENCE,"*",err,error))// &
7407  & ") is not compatible with the solver equations linearity ("// &
7408  & trim(numbertovstring(solver_equations%TIME_DEPENDENCE,"*",err,error))//")."
7409  CALL flagerror(local_error,err,error,*999)
7410  ENDIF
7411  IF (time_compatible .AND. linearity_compatible) THEN
7412  CALL solver_mapping_equations_set_add(solver_mapping,equations_set,equations_set_index,err,error,*999)
7413  ENDIF
7414  ELSE
7415  CALL flagerror("Equations set equations is not associated.",err,error,*999)
7416  ENDIF
7417  ELSE
7418  CALL flagerror("Equations set is not associated.",err,error,*999)
7419  ENDIF
7420  ELSE
7421  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
7422  ENDIF
7423  ENDIF
7424  ELSE
7425  CALL flagerror("Solver equations solver is not associated.",err,error,*999)
7426  ENDIF
7427  ENDIF
7428  ELSE
7429  CALL flagerror("Solver equations is not associated.",err,error,*999)
7430  ENDIF
7431 
7432  exits("SOLVER_EQUATIONS_EQUATIONS_SET_ADD")
7433  RETURN
7434 999 errorsexits("SOLVER_EQUATIONS_EQUATIONS_SET_ADD",err,error)
7435  RETURN 1
7436 
7437  END SUBROUTINE solver_equations_equations_set_add
7438 
7439  !
7440  !================================================================================================================================
7441  !
7442 
7444  SUBROUTINE solver_equations_finalise(SOLVER_EQUATIONS,ERR,ERROR,*)
7445 
7446  !Argument variables
7447  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
7448  INTEGER(INTG), INTENT(OUT) :: ERR
7449  TYPE(varying_string), INTENT(OUT) :: ERROR
7450  !Local Variables
7451 
7452  enters("SOLVER_EQUATIONS_FINALISE",err,error,*999)
7453 
7454  IF(ASSOCIATED(solver_equations)) THEN
7455  IF(ASSOCIATED(solver_equations%SOLVER_MAPPING)) CALL solver_mapping_destroy(solver_equations%SOLVER_MAPPING,err,error,*999)
7456  IF(ASSOCIATED(solver_equations%SOLVER_MATRICES)) CALL solver_matrices_destroy(solver_equations%SOLVER_MATRICES,err,error,*999)
7457  IF(ASSOCIATED(solver_equations%BOUNDARY_CONDITIONS)) CALL boundary_conditions_destroy( &
7458  & solver_equations%BOUNDARY_CONDITIONS,err,error,*999)
7459  ENDIF
7460 
7461  exits("SOLVER_EQUATIONS_FINALISE")
7462  RETURN
7463 999 errorsexits("SOLVER_EQUATIONS_FINALISE",err,error)
7464  RETURN 1
7465 
7466  END SUBROUTINE solver_equations_finalise
7467 
7468  !
7469  !================================================================================================================================
7470  !
7471 
7473  SUBROUTINE solver_equations_initialise(SOLVER,ERR,ERROR,*)
7474 
7475  !Argument variables
7476  TYPE(solver_type), POINTER :: SOLVER
7477  INTEGER(INTG), INTENT(OUT) :: ERR
7478  TYPE(varying_string), INTENT(OUT) :: ERROR
7479  !Local Variables
7480  INTEGER(INTG) :: DUMMY_ERR
7481  TYPE(varying_string) :: DUMMY_ERROR
7482 
7483  enters("SOLVER_EQUATIONS_INITIALISE",err,error,*998)
7484 
7485  IF(ASSOCIATED(solver)) THEN
7486  IF(ASSOCIATED(solver%SOLVER_EQUATIONS)) THEN
7487  CALL flagerror("Solver equations is already associated for this solver.",err,error,*998)
7488  ELSE
7489  ALLOCATE(solver%SOLVER_EQUATIONS,stat=err)
7490  IF(err/=0) CALL flagerror("Could not allocate solver equations.",err,error,*999)
7491  solver%SOLVER_EQUATIONS%SOLVER=>solver
7492  solver%SOLVER_EQUATIONS%SOLVER_EQUATIONS_FINISHED=.false.
7493  solver%SOLVER_EQUATIONS%SPARSITY_TYPE=solver_sparse_matrices
7494  NULLIFY(solver%SOLVER_EQUATIONS%SOLVER_MAPPING)
7495  NULLIFY(solver%SOLVER_EQUATIONS%SOLVER_MATRICES)
7496  NULLIFY(solver%SOLVER_EQUATIONS%BOUNDARY_CONDITIONS)
7497  ENDIF
7498  ELSE
7499  CALL flagerror("Solver is not associated.",err,error,*998)
7500  ENDIF
7501 
7502  exits("SOLVER_EQUATIONS_INITIALISE")
7503  RETURN
7504 999 CALL solver_equations_finalise(solver%SOLVER_EQUATIONS,dummy_err,dummy_error,*998)
7505 998 errorsexits("SOLVER_EQUATIONS_INITIALISE",err,error)
7506  RETURN 1
7507 
7508  END SUBROUTINE solver_equations_initialise
7509 
7510  !
7511  !================================================================================================================================
7512  !
7513 
7515  SUBROUTINE solver_equations_interface_condition_add(SOLVER_EQUATIONS,INTERFACE_CONDITION,INTERFACE_CONDITION_INDEX,ERR,ERROR,*)
7516 
7517  !Argument variables
7518  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
7519  TYPE(interface_condition_type), POINTER :: INTERFACE_CONDITION
7520  INTEGER(INTG), INTENT(OUT) :: INTERFACE_CONDITION_INDEX
7521  INTEGER(INTG), INTENT(OUT) :: ERR
7522  TYPE(varying_string), INTENT(OUT) :: ERROR
7523  !Local Variables
7524  TYPE(interface_equations_type), POINTER :: INTERFACE_EQUATIONS
7525  TYPE(solver_type), POINTER :: SOLVER
7526  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
7527 
7528  enters("SOLVER_EQUATIONS_INTERFACE_CONDITION_ADD",err,error,*999)
7529 
7530  IF(ASSOCIATED(solver_equations)) THEN
7531  IF(solver_equations%SOLVER_EQUATIONS_FINISHED) THEN
7532  CALL flagerror("Solver equations has already been finished.",err,error,*999)
7533  ELSE
7534  solver=>solver_equations%SOLVER
7535  IF(ASSOCIATED(solver)) THEN
7536  IF(ASSOCIATED(solver%LINKING_SOLVER)) THEN
7537  CALL flagerror("Can not add an equations set for a solver that has been linked.",err,error,*999)
7538  ELSE
7539  solver_mapping=>solver_equations%SOLVER_MAPPING
7540  IF(ASSOCIATED(solver_mapping)) THEN
7541  IF(ASSOCIATED(interface_condition)) THEN
7542  interface_equations=>interface_condition%INTERFACE_EQUATIONS
7543  IF(ASSOCIATED(interface_equations)) THEN
7544  CALL solver_mapping_interface_condition_add(solver_mapping,interface_condition,interface_condition_index, &
7545  & err,error,*999)
7546  ELSE
7547  CALL flagerror("Interface condition interface equations is not associated.",err,error,*999)
7548  ENDIF
7549  ELSE
7550  CALL flagerror("Interface condition is not associated.",err,error,*999)
7551  ENDIF
7552  ELSE
7553  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
7554  ENDIF
7555  ENDIF
7556  ELSE
7557  CALL flagerror("Solver equations solver is not associated.",err,error,*999)
7558  ENDIF
7559  ENDIF
7560  ELSE
7561  CALL flagerror("Solver equations is not associated.",err,error,*999)
7562  ENDIF
7563 
7564  exits("SOLVER_EQUATIONS_INTERFACE_CONDITION_ADD")
7565  RETURN
7566 999 errorsexits("SOLVER_EQUATIONS_INTERFACE_CONDITION_ADD",err,error)
7567  RETURN 1
7568 
7569  END SUBROUTINE solver_equations_interface_condition_add
7570 
7571  !
7572  !================================================================================================================================
7573  !
7574 
7576  SUBROUTINE solver_equations_linearity_type_set(SOLVER_EQUATIONS,LINEARITY_TYPE,ERR,ERROR,*)
7577 
7578  !Argument variables
7579  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
7580  INTEGER(INTG), INTENT(IN) :: LINEARITY_TYPE
7581  INTEGER(INTG), INTENT(OUT) :: ERR
7582  TYPE(varying_string), INTENT(OUT) :: ERROR
7583  !Local Variables
7584  TYPE(solver_type), POINTER :: SOLVER
7585  TYPE(varying_string) :: LOCAL_ERROR
7586 
7587  enters("SOLVER_EQUATIONS_LINEARITY_TYPE_SET",err,error,*999)
7588 
7589  IF(ASSOCIATED(solver_equations)) THEN
7590  IF(solver_equations%SOLVER_EQUATIONS_FINISHED) THEN
7591  CALL flagerror("Solver equations has already been finished.",err,error,*999)
7592  ELSE
7593  solver=>solver_equations%SOLVER
7594  IF(ASSOCIATED(solver)) THEN
7595  IF(ASSOCIATED(solver%LINKING_SOLVER)) THEN
7596  CALL flagerror("Can not set equations linearity for a solver that has been linked.",err,error,*999)
7597  ELSE
7598  SELECT CASE(linearity_type)
7599  CASE(solver_equations_linear)
7600  solver_equations%LINEARITY=solver_equations_linear
7601  CASE(solver_equations_nonlinear)
7602  solver_equations%LINEARITY=solver_equations_nonlinear
7603  CASE DEFAULT
7604  local_error="The specified solver equations linearity type of "// &
7605  & trim(numbertovstring(linearity_type,"*",err,error))//" is invalid."
7606  CALL flagerror(local_error,err,error,*999)
7607  END SELECT
7608  ENDIF
7609  ELSE
7610  CALL flagerror("Solver equations solver is not associated.",err,error,*999)
7611  ENDIF
7612  ENDIF
7613  ELSE
7614  CALL flagerror("Solver equations is not associated.",err,error,*999)
7615  ENDIF
7616 
7617  exits("SOLVER_EQUATIONS_LINEARITY_TYPE_SET")
7618  RETURN
7619 999 errorsexits("SOLVER_EQUATIONS_LINEARITY_TYPE_SET",err,error)
7620  RETURN 1
7621 
7622  END SUBROUTINE solver_equations_linearity_type_set
7623 
7624  !
7625  !================================================================================================================================
7626  !
7627 
7629  SUBROUTINE solverequations_boundaryconditionscreatefinish(SOLVER_EQUATIONS,ERR,ERROR,*)
7630 
7631  !Argument variables
7632  TYPE(solver_equations_type), POINTER, INTENT(IN) :: SOLVER_EQUATIONS
7633  INTEGER(INTG), INTENT(OUT) :: ERR
7634  TYPE(varying_string), INTENT(OUT) :: ERROR
7635  !Local Variables
7636  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
7637  TYPE(solver_type), POINTER :: SOLVER
7638  TYPE(varying_string) :: LOCAL_ERROR
7639 
7640  enters("SolverEquations_BoundaryConditionsCreateFinish",err,error,*999)
7641 
7642  IF(ASSOCIATED(solver_equations)) THEN
7643  IF(solver_equations%SOLVER_EQUATIONS_FINISHED) THEN
7644  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
7645  IF(ASSOCIATED(boundary_conditions)) THEN
7646  CALL boundary_conditions_create_finish(boundary_conditions,err,error,*999)
7647  solver=>solver_equations%SOLVER
7648  IF(ASSOCIATED(solver)) THEN
7649  IF(ASSOCIATED(solver%LINKING_SOLVER)) THEN
7650  CALL flagerror("Can not finish solver equations creation for a solver that has been linked.",err,error,*999)
7651  ELSE
7652  !Finish of the solver mapping
7653  CALL solver_mapping_create_finish(solver_equations%SOLVER_MAPPING,err,error,*999)
7654  !Now finish off with the solver specific actions
7655  SELECT CASE(solver%SOLVE_TYPE)
7656  CASE(solver_linear_type)
7657  CALL solver_linear_create_finish(solver%LINEAR_SOLVER,err,error,*999)
7658  CASE(solver_nonlinear_type)
7659  CALL solver_nonlinear_create_finish(solver%NONLINEAR_SOLVER,err,error,*999)
7660  CASE(solver_dynamic_type)
7661  CALL solver_dynamic_create_finish(solver%DYNAMIC_SOLVER,err,error,*999)
7662  CASE(solver_dae_type)
7663  CALL solver_dae_create_finish(solver%DAE_SOLVER,err,error,*999)
7664  CASE(solver_eigenproblem_type)
7665  CALL solver_eigenproblem_create_finish(solver%EIGENPROBLEM_SOLVER,err,error,*999)
7666  CASE DEFAULT
7667  local_error="The solver type of "//trim(numbertovstring(solver%SOLVE_TYPE,"*",err,error))//" is invalid."
7668  CALL flagerror(local_error,err,error,*999)
7669  END SELECT
7670  ENDIF
7671  ENDIF
7672  ELSE
7673  CALL flagerror("Solver equations boundary conditions is not associated.",err,error,*999)
7674  ENDIF
7675  ELSE
7676  CALL flagerror("Solver equations are not finished.",err,error,*999)
7677  ENDIF
7678  ELSE
7679  CALL flagerror("Solver equations is not associated.",err,error,*999)
7680  ENDIF
7681 
7682  exits("SolverEquations_BoundaryConditionsCreateFinish")
7683  RETURN
7684 999 errors("SolverEquations_BoundaryConditionsCreateFinish",err,error)
7685  exits("SolverEquations_BoundaryConditionsCreateFinish")
7686  RETURN 1
7687 
7688  END SUBROUTINE solverequations_boundaryconditionscreatefinish
7689 
7690  !
7691  !================================================================================================================================
7692  !
7693 
7695  SUBROUTINE solverequations_boundaryconditionscreatestart(SOLVER_EQUATIONS,BOUNDARY_CONDITIONS,ERR,ERROR,*)
7696 
7697  !Argument variables
7698  TYPE(solver_equations_type), POINTER, INTENT(IN) :: SOLVER_EQUATIONS
7699  TYPE(boundary_conditions_type), POINTER, INTENT(OUT) :: BOUNDARY_CONDITIONS
7700  INTEGER(INTG), INTENT(OUT) :: ERR
7701  TYPE(varying_string), INTENT(OUT) :: ERROR
7702  !Local Variables
7703 
7704  enters("SolverEquations_BoundaryConditionsCreateStart",err,error,*999)
7705 
7706  IF(ASSOCIATED(solver_equations)) THEN
7707  IF(solver_equations%SOLVER_EQUATIONS_FINISHED) THEN
7708  IF(.NOT.ASSOCIATED(solver_equations%BOUNDARY_CONDITIONS)) THEN
7709  CALL boundary_conditions_create_start(solver_equations,boundary_conditions,err,error,*999)
7710  ELSE
7711  CALL flagerror("Solver equations boundary conditions is already associated.",err,error,*999)
7712  ENDIF
7713  ELSE
7714  CALL flagerror("Solver equations are not finished.",err,error,*999)
7715  ENDIF
7716  ELSE
7717  CALL flagerror("Solver equations is not associated.",err,error,*999)
7718  ENDIF
7719 
7720  exits("SolverEquations_BoundaryConditionsCreateStart")
7721  RETURN
7722 999 errors("SolverEquations_BoundaryConditionsCreateStart",err,error)
7723  exits("SolverEquations_BoundaryConditionsCreateStart")
7724  RETURN 1
7725 
7726  END SUBROUTINE solverequations_boundaryconditionscreatestart
7727 
7728  !
7729  !================================================================================================================================
7730  !
7731 
7733  SUBROUTINE solver_equations_sparsity_type_set(SOLVER_EQUATIONS,SPARSITY_TYPE,ERR,ERROR,*)
7734 
7735  !Argument variables
7736  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
7737  INTEGER(INTG), INTENT(IN) :: SPARSITY_TYPE
7738  INTEGER(INTG), INTENT(OUT) :: ERR
7739  TYPE(varying_string), INTENT(OUT) :: ERROR
7740  !Local Variables
7741  TYPE(solver_type), POINTER :: SOLVER
7742  TYPE(varying_string) :: LOCAL_ERROR
7743 
7744  enters("SOLVER_EQUATIONS_SPARSITY_TYPE_SET",err,error,*999)
7745 
7746  IF(ASSOCIATED(solver_equations)) THEN
7747  IF(solver_equations%SOLVER_EQUATIONS_FINISHED) THEN
7748  CALL flagerror("Solver equations has already been finished.",err,error,*999)
7749  ELSE
7750  solver=>solver_equations%SOLVER
7751  IF(ASSOCIATED(solver)) THEN
7752  IF(ASSOCIATED(solver%LINKING_SOLVER)) THEN
7753  CALL flagerror("Can not set equations sparsity for a solver that has been linked.",err,error,*999)
7754  ELSE
7755 !!TODO: Maybe set the sparsity in the different types of solvers. e.g., a sparse integrator doesn't mean much.
7756  SELECT CASE(sparsity_type)
7757  CASE(solver_sparse_matrices)
7758  solver_equations%SPARSITY_TYPE=solver_sparse_matrices
7759  CASE(solver_full_matrices)
7760  solver_equations%SPARSITY_TYPE=solver_full_matrices
7761  CASE DEFAULT
7762  local_error="The specified solver equations sparsity type of "// &
7763  & trim(numbertovstring(sparsity_type,"*",err,error))//" is invalid."
7764  CALL flagerror(local_error,err,error,*999)
7765  END SELECT
7766  ENDIF
7767  ELSE
7768  CALL flagerror("Solver equations solver is not associated.",err,error,*999)
7769  ENDIF
7770  ENDIF
7771  ELSE
7772  CALL flagerror("Solver equations is not associated.",err,error,*999)
7773  ENDIF
7774 
7775  exits("SOLVER_EQUATIONS_SPARSITY_TYPE_SET")
7776  RETURN
7777 999 errorsexits("SOLVER_EQUATIONS_SPARSITY_TYPE_SET",err,error)
7778  RETURN 1
7779 
7780  END SUBROUTINE solver_equations_sparsity_type_set
7781 
7782  !
7783  !================================================================================================================================
7784  !
7785 
7787  SUBROUTINE solver_equations_time_dependence_type_set(SOLVER_EQUATIONS,TIME_DEPENDENCE_TYPE,ERR,ERROR,*)
7788 
7789  !Argument variables
7790  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
7791  INTEGER(INTG), INTENT(IN) :: TIME_DEPENDENCE_TYPE
7792  INTEGER(INTG), INTENT(OUT) :: ERR
7793  TYPE(varying_string), INTENT(OUT) :: ERROR
7794  !Local Variables
7795  TYPE(solver_type), POINTER :: SOLVER
7796  TYPE(varying_string) :: LOCAL_ERROR
7797 
7798  enters("SOLVER_EQUATIONS_TIME_DEPENDENCE_TYPE_SET",err,error,*999)
7799 
7800  IF(ASSOCIATED(solver_equations)) THEN
7801  IF(solver_equations%SOLVER_EQUATIONS_FINISHED) THEN
7802  CALL flagerror("Solver equations has already been finished.",err,error,*999)
7803  ELSE
7804  solver=>solver_equations%SOLVER
7805  IF(ASSOCIATED(solver)) THEN
7806  IF(ASSOCIATED(solver%LINKING_SOLVER)) THEN
7807  CALL flagerror("Can not set equations time dependence for a solver that has been linked.",err,error,*999)
7808  ELSE
7809  SELECT CASE(time_dependence_type)
7810  CASE(solver_equations_static)
7811  solver_equations%TIME_DEPENDENCE=solver_equations_static
7812  CASE(solver_equations_quasistatic)
7813  solver_equations%TIME_DEPENDENCE=solver_equations_quasistatic
7814  CASE(solver_equations_first_order_dynamic)
7815  solver_equations%TIME_DEPENDENCE=solver_equations_first_order_dynamic
7816  CASE(solver_equations_second_order_dynamic)
7817  solver_equations%TIME_DEPENDENCE=solver_equations_second_order_dynamic
7818  CASE DEFAULT
7819  local_error="The specified solver equations time dependence type of "// &
7820  & trim(numbertovstring(time_dependence_type,"*",err,error))//" is invalid."
7821  CALL flagerror(local_error,err,error,*999)
7822  END SELECT
7823  ENDIF
7824  ELSE
7825  CALL flagerror("Solver equations solver is not associated.",err,error,*999)
7826  ENDIF
7827  ENDIF
7828  ELSE
7829  CALL flagerror("Solver equations is not associated.",err,error,*999)
7830  ENDIF
7831 
7832  exits("SOLVER_EQUATIONS_TIME_DEPENDENCE_TYPE_SET")
7833  RETURN
7834 999 errorsexits("SOLVER_EQUATIONS_TIME_DEPENDENCE_TYPE_SET",err,error)
7835  RETURN 1
7836 
7837  END SUBROUTINE solver_equations_time_dependence_type_set
7838 
7839  !
7840  !================================================================================================================================
7841  !
7842 
7844  SUBROUTINE solverequations_numberofmatricesget(solverEquations,numberOfMatrices,err,error,*)
7845 
7846  !Argument variables
7847  TYPE(solver_equations_type), POINTER, INTENT(IN) :: solverEquations
7848  INTEGER(INTG), INTENT(OUT) :: numberOfMatrices
7849  INTEGER(INTG), INTENT(OUT) :: err
7850  TYPE(varying_string), INTENT(OUT) :: error
7851  !Local variables
7852  TYPE(solver_matrices_type), POINTER :: solverMatrices
7853 
7854  enters("SolverEquations_NumberOfMatricesGet",err,error,*999)
7855 
7856  IF(ASSOCIATED(solverequations)) THEN
7857  solvermatrices=>solverequations%solver_matrices
7858  IF(ASSOCIATED(solvermatrices)) THEN
7859  numberofmatrices=solvermatrices%number_of_matrices
7860  ELSE
7861  CALL flagerror("Solver equations solver matrices are not associated.",err,error,*999)
7862  END IF
7863  ELSE
7864  CALL flagerror("Solver equations are not associated.",err,error,*999)
7865  END IF
7866 
7867  exits("SolverEquations_NumberOfMatricesGet")
7868  RETURN
7869 999 errorsexits("SolverEquations_NumberOfMatricesGet",err,error)
7870  RETURN
7871 
7872  END SUBROUTINE solverequations_numberofmatricesget
7873 
7874  !
7875  !================================================================================================================================
7876  !
7877 
7879  SUBROUTINE solverequations_matrixget(solverEquations,matrixIndex,matrix,err,error,*)
7880 
7881  !Argument variables
7882  TYPE(solver_equations_type), POINTER, INTENT(IN) :: solverEquations
7883  INTEGER(INTG), INTENT(IN) :: matrixIndex
7884  TYPE(distributed_matrix_type), POINTER, INTENT(INOUT) :: matrix
7885  INTEGER(INTG), INTENT(OUT) :: err
7886  TYPE(varying_string), INTENT(OUT) :: error
7887  !Local variables
7888  INTEGER(INTG) :: numberOfMatrices
7889  TYPE(solver_matrices_type), POINTER :: solverMatrices
7890  TYPE(solver_matrix_type), POINTER :: solverMatrix
7891 
7892  enters("SolverEquations_MatrixGet",err,error,*999)
7893 
7894  IF(ASSOCIATED(solverequations)) THEN
7895  solvermatrices=>solverequations%solver_matrices
7896  IF(ASSOCIATED(solvermatrices)) THEN
7897  IF(.NOT.ASSOCIATED(matrix)) THEN
7898  numberofmatrices=solvermatrices%number_of_matrices
7899  IF(matrixindex>0.AND.matrixindex<=numberofmatrices) THEN
7900  solvermatrix=>solvermatrices%matrices(matrixindex)%ptr
7901  IF(ASSOCIATED(solvermatrix)) THEN
7902  matrix=>solvermatrix%matrix
7903  ELSE
7904  CALL flagerror("Solver matrices solver matrix is not associated",err,error,*999)
7905  END IF
7906  ELSE
7907  CALL flagerror("Invalid matrix index. The matrix index must be greater than zero and less than or equal to "// &
7908  & trim(numbertovstring(numberofmatrices,"*",err,error))//".",err,error,*999)
7909  END IF
7910  ELSE
7911  CALL flagerror("The matrix is already associated.",err,error,*999)
7912  END IF
7913  ELSE
7914  CALL flagerror("Solver equations solver matrices are not associated.",err,error,*999)
7915  END IF
7916  ELSE
7917  CALL flagerror("Solver equations are not associated.",err,error,*999)
7918  END IF
7919 
7920  exits("SolverEquations_MatrixGet")
7921  RETURN
7922 999 errorsexits("SolverEquations_MatrixGet",err,error)
7923  RETURN
7924 
7925  END SUBROUTINE solverequations_matrixget
7926 
7927  !
7928  !================================================================================================================================
7929  !
7930 
7932  SUBROUTINE solverequations_jacobianmatrixget(solverEquations,matrix,err,error,*)
7933 
7934  !Argument variables
7935  TYPE(solver_equations_type), POINTER, INTENT(IN) :: solverEquations
7936  TYPE(distributed_matrix_type), POINTER, INTENT(INOUT) :: matrix
7937  INTEGER(INTG), INTENT(OUT) :: err
7938  TYPE(varying_string), INTENT(OUT) :: error
7939 
7940  enters("SolverEquations_JacobianMatrixGet",err,error,*999)
7941 
7942  IF(ASSOCIATED(solverequations)) THEN
7943  IF(solverequations%linearity==solver_equations_nonlinear) THEN
7944  CALL solverequations_matrixget(solverequations,1,matrix,err,error,*999)
7945  ELSE
7946  CALL flagerror("Solver equations linearity is not nonlinear.",err,error,*999)
7947  END IF
7948  ELSE
7949  CALL flagerror("Solver equations are not associated.",err,error,*999)
7950  END IF
7951 
7952  exits("SolverEquations_JacobianMatrixGet")
7953  RETURN
7954 999 errorsexits("SolverEquations_JacobianMatrixGet",err,error)
7955  RETURN
7956 
7957  END SUBROUTINE solverequations_jacobianmatrixget
7958 
7959  !
7960  !================================================================================================================================
7961  !
7962 
7964  SUBROUTINE solverequations_vectorget(solverEquations,matrixIndex,vector,err,error,*)
7965 
7966  !Argument variables
7967  TYPE(solver_equations_type), POINTER, INTENT(IN) :: solverEquations
7968  INTEGER(INTG), INTENT(IN) :: matrixIndex
7969  TYPE(distributed_vector_type), POINTER, INTENT(INOUT) :: vector
7970  INTEGER(INTG), INTENT(OUT) :: err
7971  TYPE(varying_string), INTENT(OUT) :: error
7972  !Local variables
7973  INTEGER(INTG) :: numberOfMatrices
7974  TYPE(solver_matrices_type), POINTER :: solverMatrices
7975  TYPE(solver_matrix_type), POINTER :: solverMatrix
7976 
7977  enters("SolverEquations_VectorGet",err,error,*999)
7978 
7979  IF(ASSOCIATED(solverequations)) THEN
7980  solvermatrices=>solverequations%solver_matrices
7981  IF(ASSOCIATED(solvermatrices)) THEN
7982  IF(.NOT.ASSOCIATED(vector)) THEN
7983  numberofmatrices=solvermatrices%number_of_matrices
7984  IF(matrixindex>0.AND.matrixindex<=numberofmatrices) THEN
7985  solvermatrix=>solvermatrices%matrices(matrixindex)%ptr
7986  IF(ASSOCIATED(solvermatrix)) THEN
7987  IF(ASSOCIATED(solvermatrix%solver_vector)) THEN
7988  vector=>solvermatrix%solver_vector
7989  ELSE
7990  CALL flagerror("There is no vector associated with this solve matrix.",err,error,*999)
7991  END IF
7992  ELSE
7993  CALL flagerror("Solver matrices solver matrix is not associated",err,error,*999)
7994  END IF
7995  ELSE
7996  CALL flagerror("Invalid matrix index. The matrix index must be greater than zero and less than or equal to "// &
7997  & trim(numbertovstring(numberofmatrices,"*",err,error))//".",err,error,*999)
7998  END IF
7999  ELSE
8000  CALL flagerror("The vector is already associated.",err,error,*999)
8001  END IF
8002  ELSE
8003  CALL flagerror("Solver equations solver matrices are not associated.",err,error,*999)
8004  END IF
8005  ELSE
8006  CALL flagerror("Solver equations are not associated.",err,error,*999)
8007  END IF
8008 
8009  exits("SolverEquations_VectorGet")
8010  RETURN
8011 999 errorsexits("SolverEquations_VectorGet",err,error)
8012  RETURN
8013 
8014  END SUBROUTINE solverequations_vectorget
8015 
8016  !
8017  !================================================================================================================================
8018  !
8019 
8021  SUBROUTINE solverequations_residualvectorget(solverEquations,residualVector,err,error,*)
8022 
8023  !Argument variables
8024  TYPE(solver_equations_type), POINTER, INTENT(IN) :: solverEquations
8025  TYPE(distributed_vector_type), POINTER, INTENT(INOUT) :: residualVector
8026  INTEGER(INTG), INTENT(OUT) :: err
8027  TYPE(varying_string), INTENT(OUT) :: error
8028  !Local variables
8029  TYPE(solver_matrices_type), POINTER :: solverMatrices
8030 
8031  enters("SolverEquations_ResidualVectorGet",err,error,*999)
8032 
8033  IF(ASSOCIATED(solverequations)) THEN
8034  solvermatrices=>solverequations%solver_matrices
8035  IF(ASSOCIATED(solvermatrices)) THEN
8036  IF(.NOT.ASSOCIATED(residualvector)) THEN
8037  IF(ASSOCIATED(solvermatrices%residual)) THEN
8038  residualvector=>solvermatrices%residual
8039  ELSE
8040  CALL flagerror("The solver matrices residual vector is not associated.",err,error,*999)
8041  END IF
8042  ELSE
8043  CALL flagerror("The residual vector is already associated.",err,error,*999)
8044  END IF
8045  ELSE
8046  CALL flagerror("Solver equations solver matrices are not associated.",err,error,*999)
8047  END IF
8048  ELSE
8049  CALL flagerror("Solver equations are not associated.",err,error,*999)
8050  END IF
8051 
8052  exits("SolverEquations_ResidualVectorGet")
8053  RETURN
8054 999 errorsexits("SolverEquations_ResidualVectorGet",err,error)
8055  RETURN
8056 
8057  END SUBROUTINE solverequations_residualvectorget
8058 
8059  !
8060  !================================================================================================================================
8061  !
8062 
8064  SUBROUTINE solverequations_rhsvectorget(solverEquations,rhsVector,err,error,*)
8065 
8066  !Argument variables
8067  TYPE(solver_equations_type), POINTER, INTENT(IN) :: solverEquations
8068  TYPE(distributed_vector_type), POINTER, INTENT(INOUT) :: rhsVector
8069  INTEGER(INTG), INTENT(OUT) :: err
8070  TYPE(varying_string), INTENT(OUT) :: error
8071  !Local variables
8072  TYPE(solver_matrices_type), POINTER :: solverMatrices
8073 
8074  enters("SolverEquations_RhsVectorGet",err,error,*999)
8075 
8076  IF(ASSOCIATED(solverequations)) THEN
8077  solvermatrices=>solverequations%solver_matrices
8078  IF(ASSOCIATED(solvermatrices)) THEN
8079  IF(.NOT.ASSOCIATED(rhsvector)) THEN
8080  IF(ASSOCIATED(solvermatrices%rhs_vector)) THEN
8081  rhsvector=>solvermatrices%rhs_vector
8082  ELSE
8083  CALL flagerror("The solver matrices right hand side vector is not associated.",err,error,*999)
8084  END IF
8085  ELSE
8086  CALL flagerror("The right hand side vector is already associated.",err,error,*999)
8087  END IF
8088  ELSE
8089  CALL flagerror("Solver equations solver matrices are not associated.",err,error,*999)
8090  END IF
8091  ELSE
8092  CALL flagerror("Solver equations are not associated.",err,error,*999)
8093  END IF
8094 
8095  exits("SolverEquations_RhsVectorGet")
8096  RETURN
8097 999 errorsexits("SolverEquations_RhsVectorGet",err,error)
8098  RETURN
8099 
8100  END SUBROUTINE solverequations_rhsvectorget
8101 
8102  !
8103  !================================================================================================================================
8104  !
8105 
8107  RECURSIVE SUBROUTINE solver_finalise(SOLVER,ERR,ERROR,*)
8108 
8109  !Argument variables
8110  TYPE(solver_type), POINTER :: SOLVER
8111  INTEGER(INTG), INTENT(OUT) :: ERR
8112  TYPE(varying_string), INTENT(OUT) :: ERROR
8113  !Local Variables
8114 
8115  enters("SOLVER_FINALISE",err,error,*999)
8116 
8117  IF(ASSOCIATED(solver)) THEN
8118  solver%LABEL=""
8119  CALL solver_linear_finalise(solver%LINEAR_SOLVER,err,error,*999)
8120  CALL solver_nonlinear_finalise(solver%NONLINEAR_SOLVER,err,error,*999)
8121  CALL solver_dynamic_finalise(solver%DYNAMIC_SOLVER,err,error,*999)
8122  CALL solver_dae_finalise(solver%DAE_SOLVER,err,error,*999)
8123  CALL solver_eigenproblem_finalise(solver%EIGENPROBLEM_SOLVER,err,error,*999)
8124  CALL solver_optimiser_finalise(solver%OPTIMISER_SOLVER,err,error,*999)
8125  CALL solver_cellml_evaluator_finalise(solver%CELLML_EVALUATOR_SOLVER,err,error,*999)
8126  CALL solver_geometrictransformationfinalise(solver%geometricTransformationSolver,err,error,*999)
8127  IF(.NOT.ASSOCIATED(solver%LINKING_SOLVER)) &
8128  & CALL solver_equations_finalise(solver%SOLVER_EQUATIONS,err,error,*999)
8129  IF(ALLOCATED(solver%LINKED_SOLVER_TYPE_MAP)) DEALLOCATE(solver%LINKED_SOLVER_TYPE_MAP)
8130  IF(ALLOCATED(solver%LINKED_SOLVERS)) DEALLOCATE(solver%LINKED_SOLVERS)
8131  DEALLOCATE(solver)
8132  ENDIF
8133 
8134  exits("SOLVER_FINALISE")
8135  RETURN
8136 999 errorsexits("SOLVER_FINALISE",err,error)
8137  RETURN 1
8138 
8139  END SUBROUTINE solver_finalise
8140 
8141  !
8142  !================================================================================================================================
8143  !
8144 
8146  SUBROUTINE solver_geometrictransformationarbitrarypathset(solver,arbitraryPath,err,error,*)
8147 
8148  !Argument variables
8149  TYPE(solver_type), POINTER :: solver
8150  LOGICAL, INTENT(IN) :: arbitraryPath
8151  INTEGER(INTG), INTENT(OUT) :: err
8152  TYPE(varying_string), INTENT(OUT) :: error
8153  !Local Variables
8154 
8155  enters("Solver_GeometricTransformationArbitraryPathSet",err,error,*999)
8156 
8157  IF(ASSOCIATED(solver)) THEN
8158  IF(ASSOCIATED(solver%geometricTransformationSolver)) THEN
8159  solver%geometricTransformationSolver%arbitraryPath=arbitrarypath
8160  ELSE
8161  CALL flagerror("Geometric transformation solver is not associated for this solver.",err,error,*999)
8162  ENDIF
8163  ELSE
8164  CALL flagerror("Solver is not associated.",err,error,*999)
8165  ENDIF
8166 
8167  exits("Solver_GeometricTransformationArbitraryPathSet")
8168  RETURN
8169 999 errors("Solver_GeometricTransformationArbitraryPathSet",err,error)
8170  exits("Solver_GeometricTransformationArbitraryPathSet")
8171  RETURN 1
8172 
8173  END SUBROUTINE solver_geometrictransformationarbitrarypathset
8174 
8175  !
8176  !================================================================================================================================
8177  !
8178 
8180  SUBROUTINE solver_geometrictransformationclear(solver,err,error,*)
8181 
8182  !Argument variables
8183  TYPE(solver_type), POINTER :: solver
8184  INTEGER(INTG), INTENT(OUT) :: err
8185  TYPE(varying_string), INTENT(OUT) :: error
8186  !Local Variables
8187  INTEGER(INTG) :: incrementIdx,i
8188 
8189  enters("Solver_GeometricTransformationClear",err,error,*999)
8190 
8191  IF(ASSOCIATED(solver)) THEN
8192  IF(ASSOCIATED(solver%geometricTransformationSolver)) THEN
8193  solver%geometricTransformationSolver%transformationMatrices=0.0_dp
8194  DO incrementidx=1,solver%geometricTransformationSolver%numberOfIncrements
8195  DO i=1,SIZE(solver%geometricTransformationSolver%transformationMatrices,1)
8196  solver%geometricTransformationSolver%transformationMatrices(i,i,incrementidx)=1.0_dp
8197  ENDDO
8198  ENDDO !incrementIdx
8199  IF(ALLOCATED(solver%geometricTransformationSolver%scalings)) DEALLOCATE(solver%geometricTransformationSolver%scalings)
8200  ELSE
8201  CALL flagerror("Geometric transformation solver is not associated for this solver.",err,error,*999)
8202  ENDIF
8203  ELSE
8204  CALL flagerror("Solver is not associated.",err,error,*999)
8205  ENDIF
8206 
8207  exits("Solver_GeometricTransformationClear")
8208  RETURN
8209 
8210 999 errorsexits("Solver_GeometricTransformationClear",err,error)
8211  RETURN 1
8212 
8213  END SUBROUTINE solver_geometrictransformationclear
8214 
8215  !
8216  !================================================================================================================================
8217  !
8218 
8220  SUBROUTINE solver_geometrictransformationfieldset(solver,field,variableType,err,error,*)
8221 
8222  !Argument variables
8223  TYPE(solver_type), POINTER :: solver
8224  TYPE(field_type), POINTER :: field
8225  INTEGER(INTG), INTENT(IN) :: variableType
8226  INTEGER(INTG), INTENT(OUT) :: err
8227  TYPE(varying_string), INTENT(OUT) :: error
8228  !Local Variables
8229  TYPE(field_variable_type), POINTER :: fieldVariable,geometricFieldVariable
8230  INTEGER(INTG) :: numberOfGeoemtricComponents,i,j
8231 
8232  enters("Solver_GeometricTransformationFieldSet",err,error,*999)
8233 
8234  IF(ASSOCIATED(solver)) THEN
8235  IF(ASSOCIATED(solver%geometricTransformationSolver)) THEN
8236  IF(ASSOCIATED(field)) THEN
8237  fieldvariable=>field%VARIABLE_TYPE_MAP(variabletype)%PTR
8238  IF(ASSOCIATED(fieldvariable)) THEN
8239  IF(ASSOCIATED(field%GEOMETRIC_FIELD)) THEN
8240  geometricfieldvariable=>field%GEOMETRIC_FIELD%VARIABLE_TYPE_MAP(1)%PTR !only 1 variable for geometric field
8241  IF(ASSOCIATED(geometricfieldvariable)) THEN
8242  numberofgeoemtriccomponents=geometricfieldvariable%NUMBER_OF_COMPONENTS
8243  IF(solver%geometricTransformationSolver%arbitraryPath) THEN !Allocate memory for transformation matrix at each load increment if the transformation is arbitrary at each step
8244  ALLOCATE(solver%geometricTransformationSolver%transformationMatrices(numberofgeoemtriccomponents+1, &
8245  & numberofgeoemtriccomponents+1,solver%geometricTransformationSolver%numberOfIncrements),stat=err)
8246  IF(err/=0) CALL flagerror("Could not allocate transform matrices for geometric transformation sovler", &
8247  & err,error,*999)
8248  ELSE !Only allocate 1 matrix if the transformation is uni-directional.
8249  ALLOCATE(solver%geometricTransformationSolver%transformationMatrices(numberofgeoemtriccomponents+1, &
8250  & numberofgeoemtriccomponents+1,1),stat=err)
8251  IF(err/=0) CALL flagerror("Could not allocate transform matrices for geometric transformation sovler", &
8252  & err,error,*999)
8253  ENDIF
8254  solver%geometricTransformationSolver%transformationMatrices=0.0_dp
8255  ! Set all transformation matrices to be identity matrices
8256  DO i=1,SIZE(solver%geometricTransformationSolver%transformationMatrices,3)
8257  DO j=1,numberofgeoemtriccomponents+1
8258  solver%geometricTransformationSolver%transformationMatrices(j,j,i)=1.0_dp
8259  ENDDO
8260  ENDDO
8261  solver%geometricTransformationSolver%field=>field
8262  solver%geometricTransformationSolver%fieldVariableType=variabletype
8263  ELSE
8264  CALL flagerror("Field's geometric field variable is not associated.",err,error,*999)
8265  ENDIF
8266  ELSE
8267  CALL flagerror("Field's geometric field is not associated.",err,error,*999)
8268  ENDIF
8269  ELSE
8270  CALL flagerror("Field variable to be transformed is not associated.",err,error,*999)
8271  ENDIF
8272  ELSE
8273  CALL flagerror("Field is not associated.",err,error,*999)
8274  ENDIF
8275  ELSE
8276  CALL flagerror("Geometric transformation solver is not associated for this solver.",err,error,*999)
8277  ENDIF
8278  ELSE
8279  CALL flagerror("Solver is not associated.",err,error,*999)
8280  ENDIF
8281 
8282  exits("Solver_GeometricTransformationFieldSet")
8283  RETURN
8284 
8285 999 errorsexits("Solver_GeometricTransformationFieldSet",err,error)
8286  RETURN 1
8287 
8288  END SUBROUTINE solver_geometrictransformationfieldset
8289 
8290  !
8291  !================================================================================================================================
8292  !
8293 
8295  SUBROUTINE solver_geometrictransformationmatrixset(solver,matrix,incrementIdx,err,error,*)
8296 
8297  !Argument variables
8298  TYPE(solver_type), POINTER :: solver
8299  REAL(DP), INTENT(IN) :: matrix(:,:)
8300  INTEGER(INTG), INTENT(IN) :: incrementIdx
8301  INTEGER(INTG), INTENT(OUT) :: err
8302  TYPE(varying_string), INTENT(OUT) :: error
8303  !Local Variables
8304 
8305  enters("Solver_GeometricTransformationMatrixSet",err,error,*999)
8306 
8307  IF(ASSOCIATED(solver)) THEN
8308  IF(ASSOCIATED(solver%geometricTransformationSolver)) THEN
8309  IF(ASSOCIATED(solver%geometricTransformationSolver%field)) THEN
8310  IF(incrementidx>0 .AND. incrementidx<=solver%geometricTransformationSolver%numberOfIncrements) THEN
8311  IF(SIZE(matrix)==SIZE(solver%geometricTransformationSolver%transformationMatrices(:,:,incrementidx))) THEN
8312  solver%geometricTransformationSolver%transformationMatrices(:,:,incrementidx)=matrix
8313  ELSE
8314  CALL flagerror("Size of matrix input does not match the transformation matrix size.", &
8315  & err,error,*999)
8316  ENDIF
8317  ELSE
8318  CALL flagerror("Load increment number out of range.",err,error,*999)
8319  ENDIF
8320  ELSE
8321  CALL flagerror("Field is not associated for this geometric transformation solver.",err,error,*999)
8322  ENDIF
8323  ELSE
8324  CALL flagerror("Geometric transformation solver is not associated for this solver.",err,error,*999)
8325  ENDIF
8326  ELSE
8327  CALL flagerror("Solver is not associated.",err,error,*999)
8328  ENDIF
8329 
8330  exits("Solver_GeometricTransformationMatrixSet")
8331  RETURN
8332 
8333 999 errorsexits("Solver_GeometricTransformationMatrixSet",err,error)
8334  RETURN 1
8335 
8336  END SUBROUTINE solver_geometrictransformationmatrixset
8337 
8338  !
8339  !================================================================================================================================
8340  !
8341 
8343  SUBROUTINE solver_geometrictransformationnumberofloadincrementsset(solver,numberOfIncrements,err,error,*)
8344 
8345  !Argument variables
8346  TYPE(solver_type), POINTER :: solver
8347  INTEGER(INTG), INTENT(IN) :: numberOfIncrements
8348  INTEGER(INTG), INTENT(OUT) :: err
8349  TYPE(varying_string), INTENT(OUT) :: error
8350  !Local Variables
8351 
8352  enters("Solver_GeometricTransformationFieldSet",err,error,*999)
8353 
8354  IF(ASSOCIATED(solver)) THEN
8355  IF(ASSOCIATED(solver%geometricTransformationSolver)) THEN
8356  solver%geometricTransformationSolver%numberOfIncrements=numberofincrements
8357  ELSE
8358  CALL flagerror("Geometric transformation solver is not associated for this solver.",err,error,*999)
8359  ENDIF
8360  ELSE
8361  CALL flagerror("Solver is not associated.",err,error,*999)
8362  ENDIF
8363 
8364  exits("Solver_GeometricTransformationNumberOfLoadIncrementsSet")
8365  RETURN
8366 
8367 999 errors("Solver_GeometricTransformationNumberOfLoadIncrementsSet",err,error)
8368  exits("Solver_GeometricTransformationNumberOfLoadIncrementsSet")
8369  RETURN 1
8370 
8371  END SUBROUTINE solver_geometrictransformationnumberofloadincrementsset
8372 
8373  !
8374  !================================================================================================================================
8375  !
8376 
8378  SUBROUTINE solver_geometrictransformationrotationset(solver,pt,axis,theta,incrementIdx,err,error,*)
8379 
8380  !Argument variables
8381  TYPE(solver_type), POINTER :: solver
8382  REAL(DP), INTENT(IN) :: pt(:)
8383  REAL(DP), INTENT(IN) :: axis(:)
8384  REAL(DP), INTENT(IN) :: theta
8385  INTEGER(INTG), INTENT(IN) :: incrementIdx
8386  INTEGER(INTG), INTENT(OUT) :: err
8387  TYPE(varying_string), INTENT(OUT) :: error
8388  !Local Variables
8389  INTEGER(INTG) :: numberOfGeomComp
8390  REAL(DP) :: u,v,w,vectorLength,rotationMatrix(4,4),transformationMatrix(4,4)
8391 
8392  enters("Solver_GeometricTransformationRotationSet",err,error,*999)
8393 
8394  IF(ASSOCIATED(solver)) THEN
8395  IF(ASSOCIATED(solver%geometricTransformationSolver)) THEN
8396  IF(ASSOCIATED(solver%geometricTransformationSolver%field)) THEN
8397  IF(incrementidx>0 .AND. incrementidx<=solver%geometricTransformationSolver%numberOfIncrements) THEN
8398  IF(incrementidx>1 .AND. .NOT.solver%geometricTransformationSolver%arbitraryPath) &
8399  & CALL flagerror("Rotating a field through multiple load increments must be specified through arbitrary path.", &
8400  & err,error,*999) ! Due to difficulty to scale rotation
8401  numberofgeomcomp=SIZE(solver%geometricTransformationSolver%transformationMatrices,1)-1
8402  !Add rotation to matrix at a specific step
8403  IF(SIZE(pt,1)==numberofgeomcomp) THEN
8404  IF(SIZE(axis,1)==numberofgeomcomp) THEN
8405  SELECT CASE(numberofgeomcomp)
8406  CASE(2)
8407  !2D rotation
8408  CASE(3)
8409  !3D rotation
8410  vectorlength=sqrt(axis(1)**2+axis(2)**2+axis(3)**2)
8411  u=axis(1)/vectorlength
8412  v=axis(2)/vectorlength
8413  w=axis(3)/vectorlength
8414  rotationmatrix=0.0_dp
8415  rotationmatrix(1,1)=u**2+(v**2+w**2)*cos(theta)
8416  rotationmatrix(1,2)=u*v*(1.0_dp-cos(theta))-w*sin(theta)
8417  rotationmatrix(1,3)=u*w*(1-cos(theta))+v*sin(theta)
8418  rotationmatrix(2,1)=u*v*(1-cos(theta))+w*sin(theta)
8419  rotationmatrix(2,2)=v**2+(u**2+w**2)*cos(theta)
8420  rotationmatrix(2,3)=v*w*(1-cos(theta))-u*sin(theta)
8421  rotationmatrix(3,1)=u*w*(1-cos(theta))-v*sin(theta)
8422  rotationmatrix(3,2)=v*w*(1-cos(theta))+u*sin(theta)
8423  rotationmatrix(3,3)=w**2+(u**2+v**2)*cos(theta)
8424  rotationmatrix(1,4)=(pt(1)*(v**2+w**2)-u*(pt(2)*v+pt(3)*w))*(1-cos(theta))+(pt(2)*w-pt(3)*v)*sin(theta)
8425  rotationmatrix(2,4)=(pt(2)*(u**2+w**2)-v*(pt(1)*u+pt(3)*w))*(1-cos(theta))+(pt(3)*u-pt(1)*w)*sin(theta)
8426  rotationmatrix(3,4)=(pt(3)*(u**2+v**2)-w*(pt(1)*u+pt(2)*v))*(1-cos(theta))+(pt(1)*v-pt(2)*u)*sin(theta)
8427  rotationmatrix(4,4)=1.0_dp
8428  CASE DEFAULT
8429  CALL flagerror("Number of geometric components out of range.",err,error,*999)
8430  END SELECT
8431  ! Calculate new transformation matrix by multiplying the old matrix stored with the new rotation matrix
8432  transformationmatrix(1:numberofgeomcomp+1,1:numberofgeomcomp+1)=matmul(solver%geometricTransformationSolver% &
8433  & transformationmatrices(:,:,incrementidx),rotationmatrix(1:numberofgeomcomp+1,1:numberofgeomcomp+1))
8434  ! Store the new transformation matrix
8435  solver%geometricTransformationSolver%transformationMatrices(:,:,incrementidx)= &
8436  & transformationmatrix(1:numberofgeomcomp+1,1:numberofgeomcomp+1)
8437  ELSE
8438  CALL flagerror("Dimension of the rotation axis does not match no. field geometric components.", &
8439  & err,error,*999)
8440  ENDIF
8441  ELSE
8442  CALL flagerror("Dimension of the pivot point does not match no. field geometric components.", &
8443  & err,error,*999)
8444  ENDIF
8445  ELSE
8446  CALL flagerror("Load increment number out of range.",err,error,*999)
8447  ENDIF
8448  ELSE
8449  CALL flagerror("Field is not associated for this geometric transformation solver.",err,error,*999)
8450  ENDIF
8451  ELSE
8452  CALL flagerror("Geometric transformation solver is not associated for this solver.",err,error,*999)
8453  ENDIF
8454  ELSE
8455  CALL flagerror("Solver is not associated.",err,error,*999)
8456  ENDIF
8457 
8458  exits("Solver_GeometricTransformationRotationSet")
8459  RETURN
8460 
8461 999 errorsexits("Solver_GeometricTransformationRotationSet",err,error)
8462  RETURN 1
8463 
8464  END SUBROUTINE solver_geometrictransformationrotationset
8465 
8466  !
8467  !================================================================================================================================
8468  !
8469 
8471  SUBROUTINE solver_geometrictransformationscalingsset(solver,scalings,err,error,*)
8472 
8473  !Argument variables
8474  TYPE(solver_type), POINTER :: solver
8475  REAL(DP), INTENT(IN) :: scalings(:)
8476  INTEGER(INTG), INTENT(OUT) :: err
8477  TYPE(varying_string), INTENT(OUT) :: error
8478  !Local Variables
8479 
8480  enters("Solver_GeometricTransformationScalingsSet",err,error,*999)
8481 
8482  IF(ASSOCIATED(solver)) THEN
8483  IF(ASSOCIATED(solver%geometricTransformationSolver)) THEN
8484  IF(solver%geometricTransformationSolver%arbitraryPath) THEN
8485  CALL flagerror("Transformation with arbitrary path does not have uni-directional scalings.",err,error,*999)
8486  ELSE
8487  IF(solver%geometricTransformationSolver%numberOfIncrements==SIZE(scalings)) THEN
8488  IF(ALLOCATED(solver%geometricTransformationSolver%scalings)) &
8489  & DEALLOCATE(solver%geometricTransformationSolver%scalings)
8490  ALLOCATE(solver%geometricTransformationSolver%scalings(SIZE(scalings)),stat=err)
8491  IF(err/=0) CALL flagerror("Could not allocate scalings for geometric transformation sovler",err,error,*999)
8492  solver%geometricTransformationSolver%scalings(1:SIZE(scalings))=scalings(1:SIZE(scalings))
8493  ELSE
8494  CALL flagerror("Number of scalings does not match the number of increments.",err,error,*999)
8495  ENDIF
8496  ENDIF
8497  ELSE
8498  CALL flagerror("Geometric transformation solver is not associated for this solver.",err,error,*999)
8499  ENDIF
8500  ELSE
8501  CALL flagerror("Solver is not associated.",err,error,*999)
8502  ENDIF
8503 
8504  exits("Solver_GeometricTransformationScalingsSet")
8505  RETURN
8506 
8507 999 errorsexits("Solver_GeometricTransformationScalingsSet",err,error)
8508  RETURN 1
8509 
8510  END SUBROUTINE solver_geometrictransformationscalingsset
8511 
8512  !
8513  !================================================================================================================================
8514  !
8515 
8517  SUBROUTINE solver_geometrictransformationtranslationset(solver,translation,incrementIdx,err,error,*)
8518 
8519  !Argument variables
8520  TYPE(solver_type), POINTER :: solver
8521  REAL(DP), INTENT(IN) :: translation(:)
8522  INTEGER(INTG), INTENT(IN) :: incrementIdx
8523  INTEGER(INTG), INTENT(OUT) :: err
8524  TYPE(varying_string), INTENT(OUT) :: error
8525  !Local Variables
8526  INTEGER(INTG) :: numberOfGeomComp,i
8527  REAL(DP) :: transformationMatrix(4,4),translationMatrix(4,4)
8528 
8529  enters("Solver_GeometricTransformationTranslationSet",err,error,*999)
8530 
8531  IF(ASSOCIATED(solver)) THEN
8532  IF(ASSOCIATED(solver%geometricTransformationSolver)) THEN
8533  IF(ASSOCIATED(solver%geometricTransformationSolver%field)) THEN
8534  IF(incrementidx>0 .AND. incrementidx<=solver%geometricTransformationSolver%numberOfIncrements) THEN
8535  numberofgeomcomp=SIZE(solver%geometricTransformationSolver%transformationMatrices,incrementidx)-1
8536  !Add translation to matrix at a specific step
8537  translationmatrix=0.0_dp
8538  transformationmatrix=0.0_dp
8539  DO i=1,4
8540  translationmatrix(i,i)=1.0_dp
8541  ENDDO
8542  IF(SIZE(translation,1)==numberofgeomcomp) THEN
8543  translationmatrix(1:numberofgeomcomp,numberofgeomcomp+1)=translation
8544  ! Calculate the new transformation matrix by multiplying the old matrix with the new translation matrix
8545  transformationmatrix=matmul(solver%geometricTransformationSolver%transformationMatrices(:,:,incrementidx), &
8546  & translationmatrix(1:1+numberofgeomcomp,1:1+numberofgeomcomp))
8547  ! Store the new transformation matrix
8548  solver%geometricTransformationSolver%transformationMatrices(:,:,incrementidx)= &
8549  & transformationmatrix(1:1+numberofgeomcomp,1:1+numberofgeomcomp)
8550  ELSE
8551  CALL flagerror("Number of components for translation vector does not match no. field geometric components.", &
8552  & err,error,*999)
8553  ENDIF
8554  ELSE
8555  CALL flagerror("Load increment number out of range.",err,error,*999)
8556  ENDIF
8557  ELSE
8558  CALL flagerror("Field is not associated for this geometric transformation solver.",err,error,*999)
8559  ENDIF
8560  ELSE
8561  CALL flagerror("Geometric transformation solver is not associated for this solver.",err,error,*999)
8562  ENDIF
8563  ELSE
8564  CALL flagerror("Solver is not associated.",err,error,*999)
8565  ENDIF
8566 
8567  exits("Solver_GeometricTransformationTranslationSet")
8568  RETURN
8569 999 errors("Solver_GeometricTransformationTranslationSet",err,error)
8570  exits("Solver_GeometricTransformationTranslationSet")
8571  RETURN 1
8572 
8573  END SUBROUTINE solver_geometrictransformationtranslationset
8574 
8575  !
8576  !================================================================================================================================
8577  !
8578 
8580  SUBROUTINE solver_geometrictransformationfinalise(geometricTransformationSolver,err,error,*)
8581 
8582  !Argument variables
8583  TYPE(geometrictransformationsolvertype), POINTER :: geometricTransformationSolver
8584  INTEGER(INTG), INTENT(OUT) :: err
8585  TYPE(varying_string), INTENT(OUT) :: error
8586  !Local Variables
8587 
8588  enters("Solver_GeometricTransformationFinalise",err,error,*999)
8589 
8590  IF(ASSOCIATED(geometrictransformationsolver)) THEN
8591  NULLIFY(geometrictransformationsolver%solver)
8592  IF(ASSOCIATED(geometrictransformationsolver%field)) NULLIFY(geometrictransformationsolver%field)
8593  geometrictransformationsolver%arbitraryPath=.false.
8594  IF(ALLOCATED(geometrictransformationsolver%scalings)) DEALLOCATE(geometrictransformationsolver%scalings)
8595  IF(ALLOCATED(geometrictransformationsolver%transformationMatrices)) &
8596  & DEALLOCATE(geometrictransformationsolver%transformationMatrices)
8597  geometrictransformationsolver%numberOfIncrements=0
8598  geometrictransformationsolver%fieldVariableType=0
8599  DEALLOCATE(geometrictransformationsolver)
8600  ENDIF
8601 
8602  exits("Solver_GeometricTransformationFinalise")
8603  RETURN
8604 999 errorsexits("Solver_GeometricTransformationFinalise",err,error)
8605  RETURN 1
8606 
8607  END SUBROUTINE solver_geometrictransformationfinalise
8608 
8609  !
8610  !================================================================================================================================
8611  !
8612 
8614  SUBROUTINE solver_geometrictransformationinitialise(solver,err,error,*)
8615 
8616  !Argument variables
8617  TYPE(solver_type), POINTER :: solver
8618  INTEGER(INTG), INTENT(OUT) :: err
8619  TYPE(varying_string), INTENT(OUT) :: error
8620  !Local Variables
8621  TYPE(solvers_type), POINTER :: solvers
8622  TYPE(control_loop_type), POINTER :: controlLoop
8623  TYPE(control_loop_while_type), POINTER :: whileLoop
8624  TYPE(control_loop_load_increment_type), POINTER :: loadIncrementLoop
8625  INTEGER(INTG) :: dummyErr
8626  TYPE(varying_string) :: dummyError
8627 
8628  enters("Solver_GeometricTransformationInitialise",err,error,*998)
8629 
8630  IF(ASSOCIATED(solver)) THEN
8631  IF(ASSOCIATED(solver%geometricTransformationSolver)) THEN
8632  CALL flagerror("Geometric transformation solver is already associated for this solver.",err,error,*998)
8633  ELSE
8634  !Allocate and initialise a geometric transformation solver
8635  ALLOCATE(solver%geometricTransformationSolver,stat=err)
8636  IF(err/=0) CALL flagerror("Could not allocate solver geometric transformation solver.",err,error,*999)
8637  solver%geometricTransformationSolver%solver=>solver
8638  solver%geometricTransformationSolver%arbitraryPath=.false.
8639  ! Set default number of load increment
8640  solvers=>solver%SOLVERS
8641  IF(ASSOCIATED(solvers)) THEN
8642  controlloop=>solvers%CONTROL_LOOP
8643  IF(ASSOCIATED(controlloop)) THEN
8644  IF(controlloop%LOOP_TYPE==problem_control_while_loop_type) THEN
8645  whileloop=>controlloop%WHILE_LOOP
8646  IF(ASSOCIATED(whileloop)) THEN
8647  solver%geometricTransformationSolver%numberOfIncrements=whileloop%MAXIMUM_NUMBER_OF_ITERATIONS
8648  ELSE
8649  CALL flagerror("Control loop while loop is not associated.",err,error,*999)
8650  ENDIF
8651  ELSEIF(controlloop%LOOP_TYPE==problem_control_load_increment_loop_type) THEN
8652  loadincrementloop=>controlloop%LOAD_INCREMENT_LOOP
8653  IF(ASSOCIATED(loadincrementloop)) THEN
8654  solver%geometricTransformationSolver%numberOfIncrements=loadincrementloop%MAXIMUM_NUMBER_OF_ITERATIONS
8655  ELSE
8656  CALL flagerror("Control loop load increment loop is not associated.",err,error,*999)
8657  ENDIF
8658  ELSE ! For other loop types set number of increment to be 1
8659  solver%geometricTransformationSolver%numberOfIncrements=1
8660  ENDIF
8661  ELSE
8662  CALL flagerror("control loop is not associated.",err,error,*998)
8663  ENDIF
8664  ELSE
8665  CALL flagerror("Solvers is not associated.",err,error,*998)
8666  ENDIF
8667  ! nullify field
8668  NULLIFY(solver%geometricTransformationSolver%field)
8669  solver%geometricTransformationSolver%fieldVariableType=0
8670  ENDIF
8671  ELSE
8672  CALL flagerror("Solver is not associated.",err,error,*998)
8673  ENDIF
8674 
8675  exits("Solver_GeometricTransformationInitialise")
8676  RETURN
8677 999 CALL solver_geometrictransformationfinalise(solver%geometricTransformationSolver,dummyerr,dummyerror,*998)
8678 998 errorsexits("Solver_GeometricTransformationInitialise",err,error)
8679  RETURN 1
8680 
8681  END SUBROUTINE solver_geometrictransformationinitialise
8682 
8683  !
8684  !================================================================================================================================
8685  !
8686 
8688  SUBROUTINE solver_newton_cellml_evaluator_create(SOLVER,CELLML_SOLVER,ERR,ERROR,*)
8689 
8690  !Argument variables
8691  TYPE(solver_type), POINTER :: SOLVER
8692  TYPE(solver_type), POINTER :: CELLML_SOLVER
8693  INTEGER(INTG), INTENT(OUT) :: ERR
8694  TYPE(varying_string), INTENT(OUT) :: ERROR
8695  !Local Variables
8696  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
8697  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
8698 
8699  NULLIFY(cellml_solver)
8700 
8701  enters("SOLVER_NEWTON_CELLML_EVALUATOR_CREATE",err,error,*999)
8702 
8703  IF(ASSOCIATED(solver)) THEN
8704  NULLIFY(nonlinear_solver)
8705  IF(ASSOCIATED(solver%DYNAMIC_SOLVER)) THEN
8706  nonlinear_solver=>solver%DYNAMIC_SOLVER%NONLINEAR_SOLVER%NONLINEAR_SOLVER
8707  ELSE
8708  nonlinear_solver=>solver%NONLINEAR_SOLVER
8709  ENDIF
8710  IF(ASSOCIATED(nonlinear_solver)) THEN
8711  newton_solver=>nonlinear_solver%NEWTON_SOLVER
8712  IF(ASSOCIATED(newton_solver)) THEN
8713  !Create the CellML evaluator solver
8714  ALLOCATE(newton_solver%CELLML_EVALUATOR_SOLVER,stat=err)
8715  IF(err/=0) CALL flagerror("Cannot allocate CellML evaluator solver.",err,error,*999)
8716  cellml_solver=>newton_solver%CELLML_EVALUATOR_SOLVER
8717  NULLIFY(cellml_solver%SOLVERS)
8718  CALL solver_initialise_ptr(cellml_solver,err,error,*999)
8719  CALL solver_cellml_evaluator_initialise(cellml_solver,err,error,*999)
8720  ELSE
8721  CALL flagerror("Newton solver is not associated.",err,error,*999)
8722  ENDIF
8723  ELSE
8724  CALL flagerror("Nonlinear solver is not associated.",err,error,*999)
8725  ENDIF
8726  ELSE
8727  CALL flagerror("Solver is not associated.",err,error,*999)
8728  ENDIF
8729 
8730  exits("SOLVER_NEWTON_CELLML_EVALUATOR_CREATE")
8731  RETURN
8732 999 errorsexits("SOLVER_NEWTON_CELLML_EVALUATOR_CREATE",err,error)
8733  RETURN 1
8734 
8735  END SUBROUTINE solver_newton_cellml_evaluator_create
8736 
8737  !
8738  !================================================================================================================================
8739  !
8740 
8742  SUBROUTINE solver_initialise(SOLVERS,SOLVER_INDEX,ERR,ERROR,*)
8743 
8744  !Argument variables
8745  TYPE(solvers_type), POINTER :: SOLVERS
8746  INTEGER(INTG), INTENT(IN) :: SOLVER_INDEX
8747  INTEGER(INTG), INTENT(OUT) :: ERR
8748  TYPE(varying_string), INTENT(OUT) :: ERROR
8749  !Local Variables
8750  INTEGER(INTG) :: DUMMY_ERR
8751  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
8752 
8753  enters("SOLVER_INITIALISE",err,error,*998)
8754 
8755  IF(ASSOCIATED(solvers)) THEN
8756  IF(solver_index>0.AND.solver_index<=solvers%NUMBER_OF_SOLVERS) THEN
8757  IF(ALLOCATED(solvers%SOLVERS)) THEN
8758  IF(ASSOCIATED(solvers%SOLVERS(solver_index)%PTR)) THEN
8759  CALL flagerror("Solver pointer is already associated for this solver index.",err,error,*998)
8760  ELSE
8761  ALLOCATE(solvers%SOLVERS(solver_index)%PTR,stat=err)
8762  IF(err/=0) CALL flagerror("Could not allocate solver.",err,error,*999)
8763  solvers%SOLVERS(solver_index)%PTR%SOLVERS=>solvers
8764  CALL solver_initialise_ptr(solvers%SOLVERS(solver_index)%PTR,err,error,*999)
8765  solvers%SOLVERS(solver_index)%PTR%GLOBAL_NUMBER=solver_index
8766  !Default to a linear solver and initialise
8767  solvers%SOLVERS(solver_index)%PTR%SOLVE_TYPE=solver_linear_type
8768  CALL solver_linear_initialise(solvers%SOLVERS(solver_index)%PTR,err,error,*999)
8769  ENDIF
8770  ELSE
8771  CALL flagerror("Solvers solvers is not allocated.",err,error,*998)
8772  ENDIF
8773  ELSE
8774  local_error="The solver index of "//trim(numbertovstring(solver_index,"*",err,error))// &
8775  & " is invalid. The solver index must be > 0 and <= "// &
8776  & trim(numbertovstring(solvers%NUMBER_OF_SOLVERS,"*",err,error))//"."
8777  CALL flagerror(local_error,err,error,*998)
8778  ENDIF
8779  ELSE
8780  CALL flagerror("Solvers is not associated.",err,error,*998)
8781  ENDIF
8782 
8783  exits("SOLVER_INITIALISE")
8784  RETURN
8785 999 CALL solver_finalise(solvers%SOLVERS(solver_index)%PTR,dummy_err,dummy_error,*998)
8786 998 errorsexits("SOLVER_INITIALISE",err,error)
8787  RETURN 1
8788 
8789  END SUBROUTINE solver_initialise
8790 
8791  !
8792  !================================================================================================================================
8793  !
8794 
8796  SUBROUTINE solver_initialise_ptr(SOLVER,ERR,ERROR,*)
8797 
8798  !Argument variables
8799  TYPE(solver_type), POINTER :: SOLVER
8800  INTEGER(INTG), INTENT(OUT) :: ERR
8801  TYPE(varying_string), INTENT(OUT) :: ERROR
8802  !Local Variables
8803  INTEGER(INTG) :: solver_idx
8804 
8805  enters("SOLVER_INITIALISE_PTR",err,error,*999)
8806 
8807  IF(ASSOCIATED(solver)) THEN
8808  NULLIFY(solver%LINKING_SOLVER)
8809  ALLOCATE(solver%LINKED_SOLVER_TYPE_MAP(solver_number_of_solver_types),stat=err)
8810  IF(err/=0) CALL flagerror("Could not allocate linked solver type map.",err,error,*999)
8811  DO solver_idx=1,solver_number_of_solver_types
8812  NULLIFY(solver%LINKED_SOLVER_TYPE_MAP(solver_idx)%PTR)
8813  ENDDO !solver_idx
8814  solver%NUMBER_OF_LINKED_SOLVERS=0
8815  solver%SOLVER_FINISHED=.false.
8816  solver%LABEL=""
8817  solver%OUTPUT_TYPE=solver_no_output
8818  NULLIFY(solver%LINEAR_SOLVER)
8819  NULLIFY(solver%NONLINEAR_SOLVER)
8820  NULLIFY(solver%DYNAMIC_SOLVER)
8821  NULLIFY(solver%DAE_SOLVER)
8822  NULLIFY(solver%EIGENPROBLEM_SOLVER)
8823  NULLIFY(solver%OPTIMISER_SOLVER)
8824  NULLIFY(solver%CELLML_EVALUATOR_SOLVER)
8825  NULLIFY(solver%SOLVER_EQUATIONS)
8826  NULLIFY(solver%CELLML_EQUATIONS)
8827  NULLIFY(solver%geometricTransformationSolver)
8828  ELSE
8829  CALL flagerror("Solver is not associated.",err,error,*999)
8830  ENDIF
8831 
8832  exits("SOLVER_INITIALISE_PTR")
8833  RETURN
8834 999 errorsexits("SOLVER_INITIALISE_PTR",err,error)
8835  RETURN 1
8836 
8837  END SUBROUTINE solver_initialise_ptr
8838 
8839  !
8840  !================================================================================================================================
8841  !
8842 
8844  SUBROUTINE solver_label_get_c(SOLVER,LABEL,ERR,ERROR,*)
8845 
8846  !Argument variables
8847  TYPE(solver_type), POINTER :: SOLVER
8848  CHARACTER(LEN=*), INTENT(OUT) :: LABEL
8849  INTEGER(INTG), INTENT(OUT) :: ERR
8850  TYPE(varying_string), INTENT(OUT) :: ERROR
8851  !Local Variables
8852  INTEGER(INTG) :: C_LENGTH,VS_LENGTH
8853 
8854  enters("SOLVER_LABEL_GET_C",err,error,*999)
8855 
8856  IF(ASSOCIATED(solver)) THEN
8857  c_length=len(label)
8858  vs_length=len_trim(solver%LABEL)
8859  IF(c_length>vs_length) THEN
8860  label=char(solver%LABEL,vs_length)
8861  ELSE
8862  label=char(solver%LABEL,c_length)
8863  ENDIF
8864  ELSE
8865  CALL flagerror("Solver is not associated.",err,error,*999)
8866  ENDIF
8867 
8868  exits("SOLVER_LABEL_GET_C")
8869  RETURN
8870 999 errorsexits("SOLVER_LABEL_GET_C",err,error)
8871  RETURN 1
8872 
8873  END SUBROUTINE solver_label_get_c
8874 
8875  !
8876  !================================================================================================================================
8877  !
8878 
8880  SUBROUTINE solver_label_get_vs(SOLVER,LABEL,ERR,ERROR,*)
8881 
8882  !Argument variables
8883  TYPE(solver_type), POINTER :: SOLVER
8884  TYPE(varying_string), INTENT(OUT) :: LABEL
8885  INTEGER(INTG), INTENT(OUT) :: ERR
8886  TYPE(varying_string), INTENT(OUT) :: ERROR
8887  !Local Variables
8888 
8889  enters("SOLVER_LABEL_GET_VS",err,error,*999)
8890 
8891  IF(ASSOCIATED(solver)) THEN
8892  label=var_str(char(solver%LABEL))
8893  ELSE
8894  CALL flagerror("Solver is not associated.",err,error,*999)
8895  ENDIF
8896 
8897  exits("SOLVER_LABEL_GET_VS")
8898  RETURN
8899 999 errorsexits("SOLVER_LABEL_GET_VS",err,error)
8900  RETURN 1
8901 
8902  END SUBROUTINE solver_label_get_vs
8903 
8904  !
8905  !================================================================================================================================
8906  !
8907 
8909  SUBROUTINE solver_label_set_c(SOLVER,LABEL,ERR,ERROR,*)
8910 
8911  !Argument variables
8912  TYPE(solver_type), POINTER :: SOLVER
8913  CHARACTER(LEN=*), INTENT(IN) :: LABEL
8914  INTEGER(INTG), INTENT(OUT) :: ERR
8915  TYPE(varying_string), INTENT(OUT) :: ERROR
8916  !Local Variables
8917 
8918  enters("SOLVER_LABEL_SET_C",err,error,*999)
8919 
8920  IF(ASSOCIATED(solver)) THEN
8921  IF(solver%SOLVER_FINISHED) THEN
8922  CALL flagerror("Solver has been finished.",err,error,*999)
8923  ELSE
8924  solver%LABEL=label
8925  ENDIF
8926  ELSE
8927  CALL flagerror("Solver is not associated.",err,error,*999)
8928  ENDIF
8929 
8930  exits("SOLVER_LABEL_SET_C")
8931  RETURN
8932 999 errorsexits("SOLVER_LABEL_SET_C",err,error)
8933  RETURN 1
8934 
8935  END SUBROUTINE solver_label_set_c
8936 
8937  !
8938  !================================================================================================================================
8939  !
8940 
8942  SUBROUTINE solver_label_set_vs(SOLVER,LABEL,ERR,ERROR,*)
8943 
8944  !Argument variables
8945  TYPE(solver_type), POINTER :: SOLVER
8946  TYPE(varying_string), INTENT(IN) :: LABEL
8947  INTEGER(INTG), INTENT(OUT) :: ERR
8948  TYPE(varying_string), INTENT(OUT) :: ERROR
8949  !Local Variables
8950 
8951  enters("SOLVER_LABEL_SET_VS",err,error,*999)
8952 
8953  IF(ASSOCIATED(solver)) THEN
8954  IF(solver%SOLVER_FINISHED) THEN
8955  CALL flagerror("Solver has been finished.",err,error,*999)
8956  ELSE
8957  solver%LABEL=label
8958  ENDIF
8959  ELSE
8960  CALL flagerror("Solver is not associated.",err,error,*999)
8961  ENDIF
8962 
8963  exits("SOLVER_LABEL_SET_VS")
8964  RETURN
8965 999 errorsexits("SOLVER_LABEL_SET_VS",err,error)
8966  RETURN 1
8967  END SUBROUTINE solver_label_set_vs
8968 
8969  !
8970  !================================================================================================================================
8971  !
8972 
8974  SUBROUTINE solver_library_type_get(SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
8975 
8976  !Argument variables
8977  TYPE(solver_type), POINTER :: SOLVER
8978  INTEGER(INTG), INTENT(OUT) :: SOLVER_LIBRARY_TYPE
8979  INTEGER(INTG), INTENT(OUT) :: ERR
8980  TYPE(varying_string), INTENT(OUT) :: ERROR
8981  !Local Variables
8982  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
8983  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
8984  TYPE(eigenproblem_solver_type), POINTER :: EIGENPROBLEM_SOLVER
8985  TYPE(linear_solver_type), POINTER :: LINEAR_SOLVER
8986  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
8987  TYPE(optimiser_solver_type), POINTER :: OPTIMISER_SOLVER
8988  TYPE(cellml_evaluator_solver_type), POINTER :: CELLML_EVALUATOR_SOLVER
8989  TYPE(varying_string) :: LOCAL_ERROR
8990 
8991  enters("SOLVER_LIBRARY_TYPE_GET",err,error,*999)
8992 
8993  IF(ASSOCIATED(solver)) THEN
8994  SELECT CASE(solver%SOLVE_TYPE)
8995  CASE(solver_linear_type)
8996  linear_solver=>solver%LINEAR_SOLVER
8997  IF(ASSOCIATED(linear_solver)) THEN
8998  CALL solver_linear_library_type_get(linear_solver,solver_library_type,err,error,*999)
8999  ELSE
9000  CALL flagerror("Solver linear solver is not associated.",err,error,*999)
9001  ENDIF
9002  CASE(solver_nonlinear_type)
9003  nonlinear_solver=>solver%NONLINEAR_SOLVER
9004  IF(ASSOCIATED(nonlinear_solver)) THEN
9005  CALL solver_nonlinear_library_type_get(nonlinear_solver,solver_library_type,err,error,*999)
9006  ELSE
9007  CALL flagerror("Solver nonlinear solver is not associated.",err,error,*999)
9008  ENDIF
9009  CASE(solver_dynamic_type)
9010  dynamic_solver=>solver%DYNAMIC_SOLVER
9011  IF(ASSOCIATED(dynamic_solver)) THEN
9012  CALL solver_dynamic_library_type_get(dynamic_solver,solver_library_type,err,error,*999)
9013  solver_library_type=dynamic_solver%SOLVER_LIBRARY
9014  ELSE
9015  CALL flagerror("Solver dynamic solver is not associated.",err,error,*999)
9016  ENDIF
9017  CASE(solver_dae_type)
9018  dae_solver=>solver%DAE_SOLVER
9019  IF(ASSOCIATED(dae_solver)) THEN
9020  CALL solver_dae_library_type_get(dae_solver,solver_library_type,err,error,*999)
9021  ELSE
9022  CALL flagerror("Solver differential-algebraic solver is not associated.",err,error,*999)
9023  ENDIF
9024  CASE(solver_eigenproblem_type)
9025  eigenproblem_solver=>solver%EIGENPROBLEM_SOLVER
9026  IF(ASSOCIATED(eigenproblem_solver)) THEN
9027  CALL solver_eigenproblem_library_type_get(eigenproblem_solver,solver_library_type,err,error,*999)
9028  CALL flagerror("Not implemented.",err,error,*999)
9029  ELSE
9030  CALL flagerror("Solver eigenproblem solver is not associated.",err,error,*999)
9031  ENDIF
9032  CASE(solver_optimiser_type)
9033  optimiser_solver=>solver%OPTIMISER_SOLVER
9034  IF(ASSOCIATED(optimiser_solver)) THEN
9035  CALL solver_optimiser_library_type_get(optimiser_solver,solver_library_type,err,error,*999)
9036  ELSE
9037  CALL flagerror("Solver optimiser solver is not associated.",err,error,*999)
9038  ENDIF
9039  CASE(solver_cellml_evaluator_type)
9040  cellml_evaluator_solver=>solver%CELLML_EVALUATOR_SOLVER
9041  IF(ASSOCIATED(cellml_evaluator_solver)) THEN
9042  CALL solver_cellml_evaluator_library_type_get(cellml_evaluator_solver,solver_library_type,err,error,*999)
9043  ELSE
9044  CALL flagerror("Solver CellML evaluator solver is not associated.",err,error,*999)
9045  ENDIF
9046  CASE DEFAULT
9047  local_error="The solver type of "//trim(numbertovstring(solver%SOLVE_TYPE,"*",err,error))//" is invalid."
9048  CALL flagerror(local_error,err,error,*999)
9049  END SELECT
9050  ELSE
9051  CALL flagerror("Solver is not associated.",err,error,*999)
9052  ENDIF
9053 
9054  exits("SOLVER_LIBRARY_TYPE_GET")
9055  RETURN
9056 999 errorsexits("SOLVER_LIBRARY_TYPE_GET",err,error)
9057  RETURN 1
9058 
9059  END SUBROUTINE solver_library_type_get
9060 
9061  !
9062  !================================================================================================================================
9063  !
9064 
9066  SUBROUTINE solver_library_type_set(SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
9067 
9068  !Argument variables
9069  TYPE(solver_type), POINTER :: SOLVER
9070  INTEGER(INTG), INTENT(IN) :: SOLVER_LIBRARY_TYPE
9071  INTEGER(INTG), INTENT(OUT) :: ERR
9072  TYPE(varying_string), INTENT(OUT) :: ERROR
9073  !Local Variables
9074  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
9075  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
9076  TYPE(eigenproblem_solver_type), POINTER :: EIGENPROBLEM_SOLVER
9077  TYPE(linear_solver_type), POINTER :: LINEAR_SOLVER
9078  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
9079  TYPE(optimiser_solver_type), POINTER :: OPTIMISER_SOLVER
9080  TYPE(cellml_evaluator_solver_type), POINTER :: CELLML_EVALUATOR_SOLVER
9081  TYPE(varying_string) :: LOCAL_ERROR
9082 
9083  enters("SOLVER_LIBRARY_TYPE_SET",err,error,*999)
9084 
9085  IF(ASSOCIATED(solver)) THEN
9086  IF(solver%SOLVER_FINISHED) THEN
9087  CALL flagerror("Solver has alredy been finished.",err,error,*999)
9088  ELSE
9089  SELECT CASE(solver%SOLVE_TYPE)
9090  CASE(solver_linear_type)
9091  linear_solver=>solver%LINEAR_SOLVER
9092  IF(ASSOCIATED(linear_solver)) THEN
9093  CALL solver_linear_library_type_set(linear_solver,solver_library_type,err,error,*999)
9094  ELSE
9095  CALL flagerror("Solver linear solver is not associated.",err,error,*999)
9096  ENDIF
9097  CASE(solver_nonlinear_type)
9098  nonlinear_solver=>solver%NONLINEAR_SOLVER
9099  IF(ASSOCIATED(nonlinear_solver)) THEN
9100  CALL solver_nonlinear_library_type_set(nonlinear_solver,solver_library_type,err,error,*999)
9101  ELSE
9102  CALL flagerror("Solver nonlinear solver is not associated.",err,error,*999)
9103  ENDIF
9104  CASE(solver_dynamic_type)
9105  dynamic_solver=>solver%DYNAMIC_SOLVER
9106  IF(ASSOCIATED(dynamic_solver)) THEN
9107  CALL solver_dynamic_library_type_set(dynamic_solver,solver_library_type,err,error,*999)
9108  ELSE
9109  CALL flagerror("Solver dynamic solver is not associated.",err,error,*999)
9110  ENDIF
9111  CASE(solver_dae_type)
9112  dae_solver=>solver%DAE_SOLVER
9113  IF(ASSOCIATED(dae_solver)) THEN
9114  CALL solver_dae_library_type_set(dae_solver,solver_library_type,err,error,*999)
9115  ELSE
9116  CALL flagerror("Solver differential-algebraic equation solver is not associated.",err,error,*999)
9117  ENDIF
9118  CASE(solver_eigenproblem_type)
9119  eigenproblem_solver=>solver%EIGENPROBLEM_SOLVER
9120  IF(ASSOCIATED(eigenproblem_solver)) THEN
9121  CALL solver_eigenproblem_library_type_set(eigenproblem_solver,solver_library_type,err,error,*999)
9122  SELECT CASE(solver_library_type)
9123  CASE(solver_cmiss_library)
9124  CALL flagerror("Not implemented.",err,error,*999)
9125  CASE(solver_petsc_library)
9126  CALL flagerror("Not implemented.",err,error,*999)
9127  CASE DEFAULT
9128  local_error="The solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))//" is invalid."
9129  CALL flagerror(local_error,err,error,*999)
9130  END SELECT
9131  ELSE
9132  CALL flagerror("Solver eigenproblem solver is not associated.",err,error,*999)
9133  ENDIF
9134  CASE(solver_optimiser_type)
9135  optimiser_solver=>solver%OPTIMISER_SOLVER
9136  IF(ASSOCIATED(optimiser_solver)) THEN
9137  CALL solver_optimiser_library_type_set(optimiser_solver,solver_library_type,err,error,*999)
9138  ELSE
9139  CALL flagerror("Solver optimiser solver is not associated.",err,error,*999)
9140  ENDIF
9141  CASE(solver_cellml_evaluator_type)
9142  cellml_evaluator_solver=>solver%CELLML_EVALUATOR_SOLVER
9143  IF(ASSOCIATED(cellml_evaluator_solver)) THEN
9144  CALL solver_cellml_evaluator_library_type_set(cellml_evaluator_solver,solver_library_type,err,error,*999)
9145  ELSE
9146  CALL flagerror("Solver CellML evaluator solver is not associated.",err,error,*999)
9147  ENDIF
9148  CASE DEFAULT
9149  local_error="The solver type of "//trim(numbertovstring(solver%SOLVE_TYPE,"*",err,error))//" is invalid."
9150  CALL flagerror(local_error,err,error,*999)
9151  END SELECT
9152  ENDIF
9153  ELSE
9154  CALL flagerror("Solver is not associated.",err,error,*999)
9155  ENDIF
9156 
9157  exits("SOLVER_LIBRARY_TYPE_SET")
9158  RETURN
9159 999 errorsexits("SOLVER_LIBRARY_TYPE_SET",err,error)
9160  RETURN 1
9161 
9162  END SUBROUTINE solver_library_type_set
9163 
9164  !
9165  !================================================================================================================================
9166  !
9167 
9169  SUBROUTINE solver_linear_create_finish(LINEAR_SOLVER,ERR,ERROR,*)
9170 
9171  !Argument variables
9172  TYPE(linear_solver_type), POINTER :: LINEAR_SOLVER
9173  INTEGER(INTG), INTENT(OUT) :: ERR
9174  TYPE(varying_string), INTENT(OUT) :: ERROR
9175  !Local Variables
9176  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
9177  TYPE(newton_linesearch_solver_type), POINTER :: NEWTON_LINESEARCH_SOLVER
9178  TYPE(newton_trustregion_solver_type), POINTER :: NEWTON_TRUSTREGION_SOLVER
9179  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
9180  TYPE(quasi_newton_linesearch_solver_type), POINTER :: QUASI_NEWTON_LINESEARCH_SOLVER
9181  TYPE(quasi_newton_trustregion_solver_type), POINTER :: QUASI_NEWTON_TRUSTREGION_SOLVER
9182  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
9183  TYPE(solver_type), POINTER :: LINKING_SOLVER,SOLVER
9184  TYPE(varying_string) :: LOCAL_ERROR
9185 
9186  enters("SOLVER_LINEAR_CREATE_FINISH",err,error,*999)
9187 
9188  IF(ASSOCIATED(linear_solver)) THEN
9189  solver=>linear_solver%SOLVER
9190  IF(ASSOCIATED(solver)) THEN
9191  linking_solver=>solver%LINKING_SOLVER
9192  IF(ASSOCIATED(linking_solver)) THEN
9193  IF(linking_solver%SOLVE_TYPE==solver_nonlinear_type) THEN
9194  nonlinear_solver=>linking_solver%NONLINEAR_SOLVER
9195  IF(ASSOCIATED(nonlinear_solver)) THEN
9196  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
9197  newton_solver=>nonlinear_solver%NEWTON_SOLVER
9198  IF(ASSOCIATED(newton_solver)) THEN
9199  SELECT CASE(newton_solver%NEWTON_SOLVE_TYPE)
9200  CASE(solver_newton_linesearch)
9201  newton_linesearch_solver=>newton_solver%LINESEARCH_SOLVER
9202  IF(ASSOCIATED(newton_linesearch_solver)) THEN
9203  linear_solver%LINKED_NEWTON_PETSC_SOLVER=newton_linesearch_solver%SOLVER_LIBRARY==solver_petsc_library
9204  ELSE
9205  CALL flagerror("Newton solver linesearch solver is not associated.",err,error,*999)
9206  ENDIF
9207  CASE(solver_newton_trustregion)
9208  newton_trustregion_solver=>newton_solver%TRUSTREGION_SOLVER
9209  IF(ASSOCIATED(newton_trustregion_solver)) THEN
9210  linear_solver%LINKED_NEWTON_PETSC_SOLVER= &
9211  & newton_trustregion_solver%SOLVER_LIBRARY==solver_petsc_library
9212  ELSE
9213  CALL flagerror("Newton solver linesearch solver is not associated.",err,error,*999)
9214  ENDIF
9215  CASE DEFAULT
9216  local_error="The Newton solve type of "// &
9217  & trim(numbertovstring(newton_solver%NEWTON_SOLVE_TYPE,"*",err,error))//"is invalid."
9218  CALL flagerror(local_error,err,error,*999)
9219  END SELECT
9220  ELSE
9221  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
9222  ENDIF
9223  ELSEIF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
9224  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
9225  IF(ASSOCIATED(quasi_newton_solver)) THEN
9226  SELECT CASE(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE)
9227  CASE(solver_quasi_newton_linesearch)
9228  quasi_newton_linesearch_solver=>quasi_newton_solver%LINESEARCH_SOLVER
9229  IF(ASSOCIATED(quasi_newton_linesearch_solver)) THEN
9230  linear_solver%LINKED_NEWTON_PETSC_SOLVER= &
9231  & quasi_newton_linesearch_solver%SOLVER_LIBRARY==solver_petsc_library
9232  ELSE
9233  CALL flagerror("Quasi-Newton solver linesearch solver is not associated.",err,error,*999)
9234  ENDIF
9235  CASE(solver_quasi_newton_trustregion)
9236  quasi_newton_trustregion_solver=>quasi_newton_solver%TRUSTREGION_SOLVER
9237  IF(ASSOCIATED(quasi_newton_trustregion_solver)) THEN
9238  linear_solver%LINKED_NEWTON_PETSC_SOLVER= &
9239  & quasi_newton_trustregion_solver%SOLVER_LIBRARY==solver_petsc_library
9240  ELSE
9241  CALL flagerror("Quasi-Newton solver linesearch solver is not associated.",err,error,*999)
9242  ENDIF
9243  CASE DEFAULT
9244  local_error="The Quasi-Newton solve type of "// &
9245  & trim(numbertovstring(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE,"*",err,error))//"is invalid."
9246  CALL flagerror(local_error,err,error,*999)
9247  END SELECT
9248  ELSE
9249  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
9250  ENDIF
9251  ENDIF
9252  ELSE
9253  CALL flagerror("Linking solver nonlinear solver is not associated.",err,error,*999)
9254  ENDIF
9255  ENDIF
9256  ENDIF
9257  SELECT CASE(linear_solver%LINEAR_SOLVE_TYPE)
9258  CASE(solver_linear_direct_solve_type)
9259  CALL solver_linear_direct_create_finish(linear_solver%DIRECT_SOLVER,err,error,*999)
9260  CASE(solver_linear_iterative_solve_type)
9261  CALL solver_linear_iterative_create_finish(linear_solver%ITERATIVE_SOLVER,err,error,*999)
9262  CASE DEFAULT
9263  local_error="The linear solver type of "//trim(numbertovstring(linear_solver%LINEAR_SOLVE_TYPE,"*",err,error))// &
9264  & " is invalid."
9265  CALL flagerror(local_error,err,error,*999)
9266  END SELECT
9267  ELSE
9268  CALL flagerror("Linear solver solver is not associated.",err,error,*999)
9269  ENDIF
9270  ELSE
9271  CALL flagerror("Linear solver is not associated.",err,error,*999)
9272  ENDIF
9273 
9274  exits("SOLVER_LINEAR_CREATE_FINISH")
9275  RETURN
9276 999 errorsexits("SOLVER_LINEAR_CREATE_FINISH",err,error)
9277  RETURN 1
9278 
9279  END SUBROUTINE solver_linear_create_finish
9280 
9281  !
9282  !================================================================================================================================
9283  !
9284 
9286  SUBROUTINE solver_linear_direct_cholesky_finalise(DIRECT_SOLVER,ERR,ERROR,*)
9287 
9288  !Argument variables
9289  TYPE(linear_direct_solver_type), POINTER :: DIRECT_SOLVER
9290  INTEGER(INTG), INTENT(OUT) :: ERR
9291  TYPE(varying_string), INTENT(OUT) :: ERROR
9292  !Local Variables
9293 
9294  enters("SOLVER_LINEAR_DIRECT_CHOLESKY_FINALISE",err,error,*999)
9295 
9296  IF(ASSOCIATED(direct_solver)) THEN
9297  CALL flagerror("Not implemented.",err,error,*999)
9298  ENDIF
9299 
9300  exits("SOLVER_LINEAR_DIRECT_CHOLESKY_FINALISE")
9301  RETURN
9302 999 errorsexits("SOLVER_LINEAR_DIRECT_CHOLESKY_FINALISE",err,error)
9303  RETURN 1
9304 
9305  END SUBROUTINE solver_linear_direct_cholesky_finalise
9306 
9307  !
9308  !================================================================================================================================
9309  !
9310 
9312  SUBROUTINE solver_linear_direct_cholesky_initialise(DIRECT_SOLVER,ERR,ERROR,*)
9313 
9314  !Argument variables
9315  TYPE(linear_direct_solver_type), POINTER :: DIRECT_SOLVER
9316  INTEGER(INTG), INTENT(OUT) :: ERR
9317  TYPE(varying_string), INTENT(OUT) :: ERROR
9318  !Local Variables
9319 
9320  enters("SOLVER_LINEAR_DIRECT_CHOLESKY_INITIALISE",err,error,*999)
9321 
9322  IF(ASSOCIATED(direct_solver)) THEN
9323  CALL flagerror("Not implemented.",err,error,*999)
9324  ELSE
9325  CALL flagerror("Direct linear solver is not associated.",err,error,*999)
9326  ENDIF
9327 
9328  exits("SOLVER_LINEAR_DIRECT_CHOLESKY_INITIALISE")
9329  RETURN
9330 999 errorsexits("SOLVER_LINEAR_DIRECT_CHOLESKY_INITIALISE",err,error)
9331  RETURN 1
9332 
9333  END SUBROUTINE solver_linear_direct_cholesky_initialise
9334 
9335  !
9336  !================================================================================================================================
9337  !
9338 
9340  SUBROUTINE solver_linear_direct_create_finish(LINEAR_DIRECT_SOLVER,ERR,ERROR,*)
9341 
9342  !Argument variables
9343  TYPE(linear_direct_solver_type), POINTER :: LINEAR_DIRECT_SOLVER
9344  INTEGER(INTG), INTENT(OUT) :: ERR
9345  TYPE(varying_string), INTENT(OUT) :: ERROR
9346  !Local Variables
9347  TYPE(linear_solver_type), POINTER :: LINEAR_SOLVER
9348  TYPE(distributed_matrix_type), POINTER :: SOLVER_MATRIX
9349  TYPE(solver_type), POINTER :: SOLVER
9350  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
9351  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
9352  TYPE(varying_string) :: LOCAL_ERROR
9353 
9354  enters("SOLVER_LINEAR_DIRECT_CREATE_FINISH",err,error,*999)
9355 
9356  IF(ASSOCIATED(linear_direct_solver)) THEN
9357  linear_solver=>linear_direct_solver%LINEAR_SOLVER
9358  IF(ASSOCIATED(linear_solver)) THEN
9359  solver=>linear_solver%SOLVER
9360  IF(ASSOCIATED(solver)) THEN
9361  SELECT CASE(linear_direct_solver%DIRECT_SOLVER_TYPE)
9362  CASE(solver_direct_lu)
9363  IF(ASSOCIATED(solver%LINKING_SOLVER)) THEN
9364  !Matrices have already been set up by linking solver
9365  SELECT CASE(linear_direct_solver%SOLVER_LIBRARY)
9366  CASE(solver_cmiss_library) !All non-PETSc libraries
9367  CALL flagerror("Non-PETSc linear solver cannot be linked to PETSc nonlinear solver.",err,error,*999)
9368  END SELECT
9369  solver_equations=>solver%LINKING_SOLVER%SOLVER_EQUATIONS
9370  IF(ASSOCIATED(solver_equations)) THEN
9371  solver_matrices=>solver_equations%SOLVER_MATRICES
9372  IF(.NOT.ASSOCIATED(solver_matrices)) &
9373  & CALL flagerror("Linked solver equation solver matrices is not associated.",err,error,*999)
9374  ELSE
9375  CALL flagerror("Linked solver solver equations is not associated.",err,error,*999)
9376  ENDIF
9377  ELSE
9378  !Set up solver matrices
9379  solver_equations=>solver%SOLVER_EQUATIONS
9380  IF(ASSOCIATED(solver_equations)) THEN
9381  !Create the solver matrices
9382  NULLIFY(solver_matrices)
9383  CALL solver_matrices_create_start(solver_equations,solver_matrices,err,error,*999)
9384 
9385  !Set up solver matrices for solver library
9386  SELECT CASE(linear_direct_solver%SOLVER_LIBRARY)
9387  CASE(solver_cmiss_library)
9388  CALL solver_matrices_library_type_set(solver_matrices,solver_cmiss_library,err,error,*999)
9389  CASE(solver_mumps_library,solver_superlu_library,solver_pastix_library,solver_lapack_library)
9390  !Call solver through PETSc
9391  CALL solver_matrices_library_type_set(solver_matrices,solver_petsc_library,err,error,*999)
9392  CASE(solver_spooles_library,solver_umfpack_library, &
9393  & solver_lusol_library,solver_essl_library)
9394  CALL flagerror("Not implemented.",err,error,*999)
9395  CASE DEFAULT
9396  local_error="The solver library type of "// &
9397  & trim(numbertovstring(linear_direct_solver%SOLVER_LIBRARY,"*",err,error))//" is invalid."
9398  CALL flagerror(local_error,err,error,*999)
9399  END SELECT
9400 
9401  SELECT CASE(solver_equations%SPARSITY_TYPE)
9402  CASE(solver_sparse_matrices)
9403  CALL solver_matrices_storage_type_set(solver_matrices,[distributed_matrix_compressed_row_storage_type], &
9404  & err,error,*999)
9405  CASE(solver_full_matrices)
9406  CALL solver_matrices_storage_type_set(solver_matrices,[distributed_matrix_block_storage_type], &
9407  & err,error,*999)
9408  CASE DEFAULT
9409  local_error="The specified solver equations sparsity type of "// &
9410  & trim(numbertovstring(solver_equations%SPARSITY_TYPE,"*",err,error))// &
9411  & " is invalid."
9412  CALL flagerror(local_error,err,error,*999)
9413  END SELECT
9414  CALL solver_matrices_create_finish(solver_matrices,err,error,*999)
9415  ELSE
9416  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
9417  ENDIF
9418  ENDIF
9419 
9420  !Set up direct solver
9421  SELECT CASE(linear_direct_solver%SOLVER_LIBRARY)
9422  CASE(solver_cmiss_library)
9423  !Nothing else to do
9424  CASE(solver_mumps_library,solver_superlu_library,solver_pastix_library,solver_lapack_library)
9425  !Set up solver through PETSc
9426  CALL petsc_kspcreate(computational_environment%MPI_COMM,linear_direct_solver%KSP,err,error,*999)
9427 
9428  !Set any further KSP options from the command line options
9429  CALL petsc_kspsetfromoptions(linear_direct_solver%KSP,err,error,*999)
9430  !Set the solver matrix to be the KSP matrix
9431  IF(solver_matrices%NUMBER_OF_MATRICES==1) THEN
9432  solver_matrix=>solver_matrices%MATRICES(1)%PTR%MATRIX
9433  IF(ASSOCIATED(solver_matrix)) THEN
9434  IF(ASSOCIATED(solver_matrix%PETSC)) THEN
9435  CALL petsc_kspsetoperators(linear_direct_solver%KSP,solver_matrix%PETSC%MATRIX,solver_matrix%PETSC%MATRIX, &
9436  & err,error,*999)
9437  !Check that the solver supports the matrix sparsity type
9438  SELECT CASE(solver_equations%SPARSITY_TYPE)
9439  CASE(solver_full_matrices)
9440  SELECT CASE(linear_direct_solver%SOLVER_LIBRARY)
9441  CASE(solver_mumps_library,solver_superlu_library,solver_pastix_library)
9442  CALL flagerror("Solver library does not support full matrices. Please use sparse matrices "// &
9443  & "or select the LAPACK library type for the linear direct solver.",err,error,*999)
9444  END SELECT
9445  CASE(solver_sparse_matrices)
9446  SELECT CASE(linear_direct_solver%SOLVER_LIBRARY)
9447  CASE(solver_lapack_library)
9448  CALL flagerror("Solver library does not support sparse matrices. Please use full matrices "// &
9449  & "or select another solver library type for the linear direct solver.",err,error,*999)
9450  END SELECT
9451  END SELECT
9452  !Set the KSP type to preonly
9453  CALL petsc_kspsettype(linear_direct_solver%KSP,petsc_ksppreonly,err,error,*999)
9454  !Get the pre-conditioner
9455  CALL petsc_kspgetpc(linear_direct_solver%KSP,linear_direct_solver%PC,err,error,*999)
9456  !Set the PC type to LU
9457  CALL petsc_pcsettype(linear_direct_solver%PC,petsc_pclu,err,error,*999)
9458  SELECT CASE(linear_direct_solver%SOLVER_LIBRARY)
9459  CASE(solver_mumps_library)
9460  !Set the PC factorisation package to MUMPS
9461  CALL petsc_pcfactorsetmatsolverpackage(linear_direct_solver%PC,petsc_mat_solver_mumps,err,error,*999)
9462  CASE(solver_superlu_library)
9463  !Set the PC factorisation package to SuperLU_DIST
9464  CALL petsc_pcfactorsetmatsolverpackage(linear_direct_solver%PC,petsc_mat_solver_superlu_dist, &
9465  & err,error,*999)
9466  CASE(solver_lapack_library)
9467  CALL flagerror("LAPACK not available in this version of PETSc.",err,error,*999)
9468  CASE(solver_pastix_library)
9469  !Set the PC factorisation package to PaStiX
9470  CALL petsc_pcfactorsetmatsolverpackage(linear_direct_solver%PC,petsc_mat_solver_pastix,err,error,*999)
9471  END SELECT
9472  ELSE
9473  CALL flagerror("Solver matrix PETSc is not associated.",err,error,*999)
9474  ENDIF
9475  ELSE
9476  CALL flagerror("Solver matrices distributed matrix is not associated.",err,error,*999)
9477  ENDIF
9478  ELSE
9479  local_error="The given number of solver matrices of "// &
9480  & trim(numbertovstring(solver_matrices%NUMBER_OF_MATRICES,"*",err,error))// &
9481  & " is invalid. There should only be one solver matrix for a linear direct solver."
9482  CALL flagerror(local_error,err,error,*999)
9483  ENDIF
9484  CASE(solver_spooles_library)
9485  CALL flagerror("Not implemented.",err,error,*999)
9486  CASE(solver_umfpack_library)
9487  CALL flagerror("Not implemented.",err,error,*999)
9488  CASE(solver_lusol_library)
9489  CALL flagerror("Not implemented.",err,error,*999)
9490  CASE(solver_essl_library)
9491  CALL flagerror("Not implemented.",err,error,*999)
9492  CASE DEFAULT
9493  local_error="The solver library type of "// &
9494  & trim(numbertovstring(linear_direct_solver%SOLVER_LIBRARY,"*",err,error))//" is invalid."
9495  CALL flagerror(local_error,err,error,*999)
9496  END SELECT
9497  CASE(solver_direct_cholesky)
9498  CALL flagerror("Not implemented.",err,error,*999)
9499  CASE(solver_direct_svd)
9500  CALL flagerror("Not implemented.",err,error,*999)
9501  CASE DEFAULT
9502  local_error="The direct solver type of "// &
9503  & trim(numbertovstring(linear_direct_solver%DIRECT_SOLVER_TYPE,"*",err,error))// &
9504  & " is invalid."
9505  CALL flagerror(local_error,err,error,*999)
9506  END SELECT
9507  ELSE
9508  CALL flagerror("Linear solver solver is not associated.",err,error,*999)
9509  ENDIF
9510  ELSE
9511  CALL flagerror("Linear direct solver linear solver is not associated.",err,error,*999)
9512  ENDIF
9513  ELSE
9514  CALL flagerror("Linear direct solver is not associated.",err,error,*999)
9515  ENDIF
9516 
9517  exits("SOLVER_LINEAR_DIRECT_CREATE_FINISH")
9518  RETURN
9519 999 errorsexits("SOLVER_LINEAR_DIRECT_CREATE_FINISH",err,error)
9520  RETURN 1
9521 
9522  END SUBROUTINE solver_linear_direct_create_finish
9523 
9524  !
9525  !================================================================================================================================
9526  !
9527 
9529  SUBROUTINE solver_linear_direct_finalise(LINEAR_DIRECT_SOLVER,ERR,ERROR,*)
9530 
9531  !Argument variables
9532  TYPE(linear_direct_solver_type), POINTER :: LINEAR_DIRECT_SOLVER
9533  TYPE(linear_solver_type), POINTER :: LINEAR_SOLVER
9534  INTEGER(INTG), INTENT(OUT) :: ERR
9535  TYPE(varying_string), INTENT(OUT) :: ERROR
9536  !Local Variables
9537 
9538  enters("SOLVER_LINEAR_DIRECT_FINALISE",err,error,*999)
9539 
9540  IF(ASSOCIATED(linear_direct_solver)) THEN
9541  linear_solver=>linear_direct_solver%LINEAR_SOLVER
9542  IF(ASSOCIATED(linear_solver)) THEN
9543  IF(.NOT.linear_solver%LINKED_NEWTON_PETSC_SOLVER) THEN
9544  CALL solver_linear_direct_lu_finalise(linear_direct_solver,err,error,*999)
9545  ENDIF
9546  ENDIF
9547  DEALLOCATE(linear_direct_solver)
9548  ENDIF
9549 
9550  exits("SOLVER_LINEAR_DIRECT_FINALISE")
9551  RETURN
9552 999 errorsexits("SOLVER_LINEAR_DIRECT_FINALISE",err,error)
9553  RETURN 1
9554 
9555  END SUBROUTINE solver_linear_direct_finalise
9556 
9557  !
9558  !================================================================================================================================
9559  !
9560 
9562  SUBROUTINE solver_linear_direct_initialise(LINEAR_SOLVER,ERR,ERROR,*)
9563 
9564  !Argument variables
9565  TYPE(linear_solver_type), POINTER :: LINEAR_SOLVER
9566  INTEGER(INTG), INTENT(OUT) :: ERR
9567  TYPE(varying_string), INTENT(OUT) :: ERROR
9568  !Local Variables
9569  INTEGER(INTG) :: DUMMY_ERR
9570  TYPE(varying_string) :: DUMMY_ERROR
9571 
9572  enters("SOLVER_LINEAR_DIRECT_INITIALISE",err,error,*998)
9573 
9574  IF(ASSOCIATED(linear_solver)) THEN
9575  IF(ASSOCIATED(linear_solver%DIRECT_SOLVER)) THEN
9576  CALL flagerror("Direct solver is already associated for this linear solver.",err,error,*998)
9577  ELSE
9578  ALLOCATE(linear_solver%DIRECT_SOLVER,stat=err)
9579  IF(err/=0) CALL flagerror("Could not allocate linear solver direct solver.",err,error,*999)
9580  linear_solver%DIRECT_SOLVER%LINEAR_SOLVER=>linear_solver
9581  !Default to an LU direct linear solver
9582  linear_solver%DIRECT_SOLVER%DIRECT_SOLVER_TYPE=solver_direct_lu
9583  CALL solver_linear_direct_lu_initialise(linear_solver%DIRECT_SOLVER,err,error,*999)
9584  ENDIF
9585  ELSE
9586  CALL flagerror("Linear solver is not associated.",err,error,*998)
9587  ENDIF
9588 
9589  exits("SOLVER_LINEAR_DIRECT_INITIALISE")
9590  RETURN
9591 999 CALL solver_linear_direct_finalise(linear_solver%DIRECT_SOLVER,dummy_err,dummy_error,*998)
9592 998 errorsexits("SOLVER_LINEAR_DIRECT_INITIALISE",err,error)
9593  RETURN 1
9594 
9595  END SUBROUTINE solver_linear_direct_initialise
9596 
9597  !
9598  !================================================================================================================================
9599  !
9600 
9602  SUBROUTINE solver_linear_direct_library_type_get(DIRECT_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
9603 
9604  !Argument variables
9605  TYPE(linear_direct_solver_type), POINTER :: DIRECT_SOLVER
9606  INTEGER(INTG), INTENT(OUT) :: SOLVER_LIBRARY_TYPE
9607  INTEGER(INTG), INTENT(OUT) :: ERR
9608  TYPE(varying_string), INTENT(OUT) :: ERROR
9609  !Local Variables
9610  TYPE(varying_string) :: LOCAL_ERROR
9611 
9612  enters("SOLVER_LINEAR_DIRECT_LIBRARY_TYPE_GET",err,error,*999)
9613 
9614  IF(ASSOCIATED(direct_solver)) THEN
9615  SELECT CASE(direct_solver%DIRECT_SOLVER_TYPE)
9616  CASE(solver_direct_lu)
9617  solver_library_type=direct_solver%SOLVER_LIBRARY
9618  CASE(solver_direct_cholesky)
9619  solver_library_type=direct_solver%SOLVER_LIBRARY
9620  CASE(solver_direct_svd)
9621  solver_library_type=direct_solver%SOLVER_LIBRARY
9622  CASE DEFAULT
9623  local_error="The direct linear solver type of "// &
9624  & trim(numbertovstring(direct_solver%DIRECT_SOLVER_TYPE,"*",err,error))//" is invalid."
9625  CALL flagerror(local_error,err,error,*999)
9626  END SELECT
9627  ELSE
9628  CALL flagerror("Direct linear solver is not associated.",err,error,*999)
9629  ENDIF
9630 
9631  exits("SOLVER_LINEAR_DIRECT_LIBRARY_TYPE_GET")
9632  RETURN
9633 999 errorsexits("SOLVER_LINEAR_DIRECT_LIBRARY_TYPE_GET",err,error)
9634  RETURN 1
9635 
9636  END SUBROUTINE solver_linear_direct_library_type_get
9637 
9638  !
9639  !================================================================================================================================
9640  !
9641 
9643  SUBROUTINE solver_linear_direct_library_type_set(DIRECT_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
9644 
9645  !Argument variables
9646  TYPE(linear_direct_solver_type), POINTER :: DIRECT_SOLVER
9647  INTEGER(INTG), INTENT(IN) :: SOLVER_LIBRARY_TYPE
9648  INTEGER(INTG), INTENT(OUT) :: ERR
9649  TYPE(varying_string), INTENT(OUT) :: ERROR
9650  !Local Variables
9651  TYPE(varying_string) :: LOCAL_ERROR
9652 
9653  enters("SOLVER_LINEAR_DIRECT_LIBRARY_TYPE_SET",err,error,*999)
9654 
9655  IF(ASSOCIATED(direct_solver)) THEN
9656  SELECT CASE(direct_solver%DIRECT_SOLVER_TYPE)
9657  CASE(solver_direct_lu)
9658  SELECT CASE(solver_library_type)
9659  CASE(solver_cmiss_library)
9660  CALL flagerror("Not implemeted.",err,error,*999)
9661  CASE(solver_mumps_library)
9662  direct_solver%SOLVER_LIBRARY=solver_mumps_library
9663  direct_solver%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
9664  CASE(solver_superlu_library)
9665  direct_solver%SOLVER_LIBRARY=solver_superlu_library
9666  direct_solver%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
9667  CASE(solver_spooles_library)
9668  CALL flagerror("Not implemeted.",err,error,*999)
9669  CASE(solver_lusol_library)
9670  CALL flagerror("Not implemeted.",err,error,*999)
9671  CASE(solver_essl_library)
9672  CALL flagerror("Not implemeted.",err,error,*999)
9673  CASE(solver_lapack_library)
9674  direct_solver%SOLVER_LIBRARY=solver_lapack_library
9675  direct_solver%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
9676  CASE(solver_pastix_library)
9677  direct_solver%SOLVER_LIBRARY=solver_pastix_library
9678  direct_solver%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
9679  CASE DEFAULT
9680  local_error="The specified solver library type of "// &
9681  & trim(numbertovstring(solver_library_type,"*",err,error))// &
9682  & " is invalid for a LU direct linear solver."
9683  CALL flagerror(local_error,err,error,*999)
9684  END SELECT
9685  CASE(solver_direct_cholesky)
9686  CALL flagerror("Not implemented.",err,error,*999)
9687  CASE(solver_direct_svd)
9688  CALL flagerror("Not implemented.",err,error,*999)
9689  CASE DEFAULT
9690  local_error="The direct linear solver type of "// &
9691  & trim(numbertovstring(direct_solver%DIRECT_SOLVER_TYPE,"*",err,error))//" is invalid."
9692  CALL flagerror(local_error,err,error,*999)
9693  END SELECT
9694  ELSE
9695  CALL flagerror("Direct linear solver is not associated.",err,error,*999)
9696  ENDIF
9697 
9698  exits("SOLVER_LINEAR_DIRECT_LIBRARY_TYPE_SET")
9699  RETURN
9700 999 errorsexits("SOLVER_LINEAR_DIRECT_LIBRARY_TYPE_SET",err,error)
9701  RETURN 1
9702 
9703  END SUBROUTINE solver_linear_direct_library_type_set
9704 
9705  !
9706  !================================================================================================================================
9707  !
9708 
9710  SUBROUTINE solver_linear_direct_lu_finalise(DIRECT_SOLVER,ERR,ERROR,*)
9711 
9712  !Argument variables
9713  TYPE(linear_direct_solver_type), POINTER :: DIRECT_SOLVER
9714  INTEGER(INTG), INTENT(OUT) :: ERR
9715  TYPE(varying_string), INTENT(OUT) :: ERROR
9716  !Local Variables
9717  TYPE(varying_string) :: LOCAL_ERROR
9718 
9719  enters("SOLVER_LINEAR_DIRECT_LU_FINALISE",err,error,*999)
9720 
9721  IF(ASSOCIATED(direct_solver)) THEN
9722  SELECT CASE(direct_solver%SOLVER_LIBRARY)
9723  CASE(solver_cmiss_library)
9724  CALL flagerror("Not implemented.",err,error,*999)
9725  CASE(solver_mumps_library)
9726  !Call MUMPS through PETSc
9727  CALL petsc_pcfinalise(direct_solver%PC,err,error,*999)
9728  CALL petsc_kspfinalise(direct_solver%KSP,err,error,*999)
9729  CASE(solver_superlu_library)
9730  !Call SuperLU through PETSc
9731  CALL petsc_pcfinalise(direct_solver%PC,err,error,*999)
9732  CALL petsc_kspfinalise(direct_solver%KSP,err,error,*999)
9733  CASE(solver_spooles_library)
9734  CALL flagerror("Not implemented.",err,error,*999)
9735  CASE(solver_umfpack_library)
9736  CALL flagerror("Not implemented.",err,error,*999)
9737  CASE(solver_lusol_library)
9738  CALL flagerror("Not implemented.",err,error,*999)
9739  CASE(solver_essl_library)
9740  CALL flagerror("Not implemented.",err,error,*999)
9741  CASE(solver_lapack_library)
9742  !Call SuperLU through PETSc
9743  CALL petsc_pcfinalise(direct_solver%PC,err,error,*999)
9744  CALL petsc_kspfinalise(direct_solver%KSP,err,error,*999)
9745  CASE(solver_pastix_library)
9746  !Call PaStiX through PETSc
9747  CALL petsc_pcfinalise(direct_solver%PC,err,error,*999)
9748  CALL petsc_kspfinalise(direct_solver%KSP,err,error,*999)
9749  CASE DEFAULT
9750  local_error="The solver library type of "// &
9751  & trim(numbertovstring(direct_solver%SOLVER_LIBRARY,"*",err,error))// &
9752  & " is invalid for a LU direct linear solver."
9753  CALL flagerror(local_error,err,error,*999)
9754  END SELECT
9755  ENDIF
9756 
9757  exits("SOLVER_LINEAR_DIRECT_LU_FINALISE")
9758  RETURN
9759 999 errorsexits("SOLVER_LINEAR_DIRECT_LU_FINALISE",err,error)
9760  RETURN 1
9761 
9762  END SUBROUTINE solver_linear_direct_lu_finalise
9763 
9764  !
9765  !================================================================================================================================
9766  !
9767 
9769  SUBROUTINE solver_linear_direct_lu_initialise(DIRECT_SOLVER,ERR,ERROR,*)
9770 
9771  !Argument variables
9772  TYPE(linear_direct_solver_type), POINTER :: DIRECT_SOLVER
9773  INTEGER(INTG), INTENT(OUT) :: ERR
9774  TYPE(varying_string), INTENT(OUT) :: ERROR
9775  !Local Variables
9776  INTEGER(INTG) :: DUMMY_ERR
9777  TYPE(varying_string) :: DUMMY_ERROR
9778 
9779  enters("SOLVER_LINEAR_DIRECT_LU_INITIALISE",err,error,*998)
9780 
9781  IF(ASSOCIATED(direct_solver)) THEN
9782  !Default to MUMPS library
9783  direct_solver%SOLVER_LIBRARY=solver_mumps_library
9784  !Call MUMPS through PETSc
9785  direct_solver%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
9786  CALL petsc_pcinitialise(direct_solver%PC,err,error,*999)
9787  CALL petsc_kspinitialise(direct_solver%KSP,err,error,*999)
9788  ELSE
9789  CALL flagerror("Direct linear solver is not associated.",err,error,*998)
9790  ENDIF
9791 
9792  exits("SOLVER_LINEAR_DIRECT_LU_INITIALISE")
9793  RETURN
9794 999 CALL solver_linear_direct_lu_finalise(direct_solver,dummy_err,dummy_error,*998)
9795 998 errorsexits("SOLVER_LINEAR_DIRECT_LU_INITIALISE",err,error)
9796  RETURN 1
9797 
9798  END SUBROUTINE solver_linear_direct_lu_initialise
9799 
9800  !
9801  !================================================================================================================================
9802  !
9803 
9805  SUBROUTINE solver_lineardirectmatriceslibrarytypeget(DIRECT_SOLVER,MATRICES_LIBRARY_TYPE,ERR,ERROR,*)
9806 
9807  !Argument variables
9808  TYPE(linear_direct_solver_type), POINTER :: DIRECT_SOLVER
9809  INTEGER(INTG), INTENT(OUT) :: MATRICES_LIBRARY_TYPE
9810  INTEGER(INTG), INTENT(OUT) :: ERR
9811  TYPE(varying_string), INTENT(OUT) :: ERROR
9812  !Local Variables
9813 
9814  enters("Solver_LinearDirectMatricesLibraryTypeGet",err,error,*999)
9815 
9816  IF(ASSOCIATED(direct_solver)) THEN
9817  matrices_library_type=direct_solver%SOLVER_MATRICES_LIBRARY
9818  ELSE
9819  CALL flagerror("Direct linear solver is not associated.",err,error,*999)
9820  ENDIF
9821 
9822  exits("Solver_LinearDirectMatricesLibraryTypeGet")
9823  RETURN
9824 999 errorsexits("Solver_LinearDirectMatricesLibraryTypeGet",err,error)
9825  RETURN 1
9826 
9827  END SUBROUTINE solver_lineardirectmatriceslibrarytypeget
9828 
9829  !
9830  !================================================================================================================================
9831  !
9832 
9833 !!\todo Allow for the mumps parameters to be set during the solver creation (i.e., cache and defer setting until we have PETSc matrix)
9834 
9836  SUBROUTINE solver_mumpsseticntl(solver,icntl,ivalue,err,error,*)
9837 
9838  !Argument variables
9839  TYPE(solver_type), POINTER :: solver
9840  INTEGER(INTG), INTENT(IN) :: icntl
9841  INTEGER(INTG), INTENT(IN) :: ivalue
9842  INTEGER(INTG), INTENT(OUT) :: err
9843  TYPE(varying_string), INTENT(OUT) :: error
9844  !Local Variables
9845  TYPE(linear_solver_type), POINTER :: linearSolver
9846  TYPE(distributed_matrix_type), POINTER :: solverMatrix
9847  TYPE(linear_direct_solver_type), POINTER :: linearDirectSolver
9848  TYPE(solver_type), POINTER :: linkingSolver
9849  TYPE(solver_equations_type), POINTER :: linkingSolverEquations,solverEquations
9850  TYPE(solver_matrices_type), POINTER :: solverMatrices
9851  TYPE(petscmattype) :: petscFactoredMatrix
9852  TYPE(varying_string) :: localError
9853 
9854  enters("Solver_MumpsSetIcntl",err,error,*999)
9855 
9856  IF(ASSOCIATED(solver)) THEN
9857  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
9858  linearsolver=>solver%LINEAR_SOLVER
9859  IF(ASSOCIATED(linearsolver)) THEN
9860  IF(linearsolver%LINEAR_SOLVE_TYPE==solver_linear_direct_solve_type) THEN
9861  lineardirectsolver=>linearsolver%DIRECT_SOLVER
9862  IF(ASSOCIATED(lineardirectsolver)) THEN
9863  SELECT CASE(lineardirectsolver%DIRECT_SOLVER_TYPE)
9864  CASE(solver_direct_lu)
9865  SELECT CASE(lineardirectsolver%SOLVER_LIBRARY)
9866  CASE(solver_mumps_library)
9867  solverequations=>solver%SOLVER_EQUATIONS
9868  NULLIFY(solvermatrices)
9869  IF(ASSOCIATED(solverequations)) THEN
9870  !Solver equations for this solver.
9871  solvermatrices=>solverequations%SOLVER_MATRICES
9872  ELSE
9873  !No solver equations. See if there are solver equations in the linking solver.
9874  linkingsolver=>solver%LINKING_SOLVER
9875  IF(ASSOCIATED(linkingsolver)) THEN
9876  linkingsolverequations=>linkingsolver%SOLVER_EQUATIONS
9877  IF(ASSOCIATED(linkingsolverequations)) THEN
9878  solvermatrices=>linkingsolverequations%SOLVER_MATRICES
9879  ELSE
9880  CALL flagerror("Solver equations is not associated for the linking solver.",err,error,*999)
9881  ENDIF
9882  ENDIF
9883  ENDIF
9884  IF(ASSOCIATED(solvermatrices)) THEN
9885  IF(solvermatrices%NUMBER_OF_MATRICES==1) THEN
9886  solvermatrix=>solvermatrices%MATRICES(1)%PTR%MATRIX
9887  IF(ASSOCIATED(solvermatrix)) THEN
9888  IF(ASSOCIATED(solvermatrix%PETSC)) THEN
9889  !Call MatGetFactor to create matrix petscFactoredMatrix from preconditioner context
9890  CALL petsc_pcfactorsetupmatsolverpackage(lineardirectsolver%pc,err,error,*999)
9891  CALL petsc_pcfactorgetmatrix(lineardirectsolver%pc,petscfactoredmatrix,err,error,*999)
9892  !Set ICNTL(icntl)=ivalue
9893  CALL petsc_matmumpsseticntl(petscfactoredmatrix,icntl,ivalue,err,error,*999)
9894  ELSE
9895  CALL flagerror("Solver matrix PETSc is not associated.",err,error,*999)
9896  ENDIF
9897  ELSE
9898  CALL flagerror("Solver matrices distributed matrix is not associated.",err,error,*999)
9899  ENDIF
9900  ELSE
9901  localerror="The given number of solver matrices of "// &
9902  & trim(numbertovstring(solvermatrices%NUMBER_OF_MATRICES,"*",err,error))// &
9903  & " is invalid. There should only be one solver matrix for a linear direct solver."
9904  CALL flagerror(localerror,err,error,*999)
9905  ENDIF
9906  ELSE
9907  CALL flagerror("Solver matrices not associated.",err,error,*999)
9908  ENDIF
9909  CASE DEFAULT
9910  localerror="The solver library type of "// &
9911  & trim(numbertovstring(lineardirectsolver%SOLVER_LIBRARY,"*",err,error))//" is invalid. "// &
9912  & "Use MUMPS library when calling Solver_MumpsSetIcntl"
9913  CALL flagerror(localerror,err,error,*999)
9914  END SELECT
9915  CASE(solver_direct_cholesky)
9916  CALL flagerror("Not implemented.",err,error,*999)
9917  CASE(solver_direct_svd)
9918  CALL flagerror("Not implemented.",err,error,*999)
9919  CASE DEFAULT
9920  localerror="The direct solver type of "// &
9921  & trim(numbertovstring(lineardirectsolver%DIRECT_SOLVER_TYPE,"*",err,error))// &
9922  & " is invalid."
9923  CALL flagerror(localerror,err,error,*999)
9924  END SELECT
9925  ELSE
9926  CALL flagerror("Linear solver direct solver is not associated.",err,error,*999)
9927  ENDIF
9928  ELSE
9929  CALL flagerror("Solver is not a direct linear solver.",err,error,*999)
9930  ENDIF
9931  ELSE
9932  CALL flagerror("Solver linear solver is not associated.",err,error,*999)
9933  ENDIF
9934  ELSE
9935  CALL flagerror("Solver is not a linear solver.",err,error,*999)
9936  ENDIF
9937  ELSE
9938  CALL flagerror("Solver is not associated.",err,error,*999)
9939  ENDIF
9940 
9941  exits("Solver_MumpsSetIcntl")
9942  RETURN
9943 999 errorsexits("Solver_MumpsSetIcntl",err,error)
9944  RETURN 1
9945 
9946  END SUBROUTINE solver_mumpsseticntl
9947 
9948  !
9949  !================================================================================================================================
9950  !
9951 
9952 !!\todo Allow for the mumps parameters to be set during the solver creation (i.e., cache and defer setting until we have PETSc matrix)
9953 
9955  SUBROUTINE solver_mumpssetcntl(solver,icntl,val,err,error,*)
9956 
9957  !Argument variables
9958  TYPE(solver_type), POINTER :: solver
9959  INTEGER(INTG), INTENT(IN) :: icntl
9960  REAL(DP), INTENT(IN) :: val
9961  INTEGER(INTG), INTENT(OUT) :: err
9962  TYPE(varying_string), INTENT(OUT) :: error
9963  !Local Variables
9964  TYPE(linear_solver_type), POINTER :: linearSolver
9965  TYPE(distributed_matrix_type), POINTER :: solverMatrix
9966  TYPE(linear_direct_solver_type), POINTER :: linearDirectSolver
9967  TYPE(solver_type), POINTER :: linkingSolver
9968  TYPE(solver_equations_type), POINTER :: linkingSolverEquations,solverEquations
9969  TYPE(solver_matrices_type), POINTER :: solverMatrices
9970  TYPE(petscmattype) :: petscFactoredMatrix
9971  TYPE(varying_string) :: localError
9972 
9973  enters("Solver_MumpsSetCntl",err,error,*999)
9974 
9975  IF(ASSOCIATED(solver)) THEN
9976  linearsolver=>solver%LINEAR_SOLVER
9977  IF(ASSOCIATED(linearsolver)) THEN
9978  lineardirectsolver=>linearsolver%DIRECT_SOLVER
9979  IF(ASSOCIATED(lineardirectsolver)) THEN
9980  SELECT CASE(lineardirectsolver%DIRECT_SOLVER_TYPE)
9981  CASE(solver_direct_lu)
9982  SELECT CASE(lineardirectsolver%SOLVER_LIBRARY)
9983  CASE(solver_mumps_library)
9984  solverequations=>solver%SOLVER_EQUATIONS
9985  NULLIFY(solvermatrices)
9986  IF(ASSOCIATED(solverequations)) THEN
9987  !Solver equations for this solver.
9988  solvermatrices=>solverequations%SOLVER_MATRICES
9989  ELSE
9990  !No solver equations. See if there are solver equations in the linking solver.
9991  linkingsolver=>solver%LINKING_SOLVER
9992  IF(ASSOCIATED(linkingsolver)) THEN
9993  linkingsolverequations=>linkingsolver%SOLVER_EQUATIONS
9994  IF(ASSOCIATED(linkingsolverequations)) THEN
9995  solvermatrices=>linkingsolverequations%SOLVER_MATRICES
9996  ELSE
9997  CALL flagerror("Solver equations is not associated for the linking solver.",err,error,*999)
9998  ENDIF
9999  ENDIF
10000  ENDIF
10001  IF(ASSOCIATED(solvermatrices)) THEN
10002  IF(solvermatrices%NUMBER_OF_MATRICES==1) THEN
10003  solvermatrix=>solvermatrices%MATRICES(1)%PTR%MATRIX
10004  IF(ASSOCIATED(solvermatrix)) THEN
10005  IF(ASSOCIATED(solvermatrix%PETSC)) THEN
10006  !Call MatGetFactor to create matrix petscFactoredMatrix from preconditioner context
10007  CALL petsc_pcfactorsetupmatsolverpackage(lineardirectsolver%PC,err,error,*999)
10008  CALL petsc_pcfactorgetmatrix(lineardirectsolver%PC,petscfactoredmatrix,err,error,*999)
10009  !Set CNTL(icntl)=val
10010  CALL petsc_matmumpssetcntl(petscfactoredmatrix,icntl,val,err,error,*999)
10011  ELSE
10012  CALL flagerror("Solver matrix PETSc is not associated.",err,error,*999)
10013  ENDIF
10014  ELSE
10015  CALL flagerror("Solver matrices distributed matrix is not associated.",err,error,*999)
10016  ENDIF
10017  ELSE
10018  localerror="The given number of solver matrices of "// &
10019  & trim(numbertovstring(solvermatrices%NUMBER_OF_MATRICES,"*",err,error))// &
10020  & " is invalid. There should only be one solver matrix for a linear direct solver."
10021  CALL flagerror(localerror,err,error,*999)
10022  ENDIF
10023  ELSE
10024  CALL flagerror("Solver matrices not associated.",err,error,*999)
10025  ENDIF
10026  CASE DEFAULT
10027  localerror="The solver library type of "// &
10028  & trim(numbertovstring(lineardirectsolver%SOLVER_LIBRARY,"*",err,error))//" is invalid. "// &
10029  & "Use MUMPS library when calling Solver_MumpsSetCntl"
10030  CALL flagerror(localerror,err,error,*999)
10031  END SELECT
10032  CASE(solver_direct_cholesky)
10033  CALL flagerror("Not implemented.",err,error,*999)
10034  CASE(solver_direct_svd)
10035  CALL flagerror("Not implemented.",err,error,*999)
10036  CASE DEFAULT
10037  localerror="The direct solver type of "// &
10038  & trim(numbertovstring(lineardirectsolver%DIRECT_SOLVER_TYPE,"*",err,error))// &
10039  & " is invalid."
10040  CALL flagerror(localerror,err,error,*999)
10041  END SELECT
10042  ELSE
10043  CALL flagerror("Linear solver solver is not associated.",err,error,*999)
10044  ENDIF
10045  ELSE
10046  CALL flagerror("Linear direct solver linear solver is not associated.",err,error,*999)
10047  ENDIF
10048  ELSE
10049  CALL flagerror("Linear direct solver is not associated.",err,error,*999)
10050  ENDIF
10051 
10052  exits("Solver_MumpsSetCntl")
10053  RETURN
10054 999 errorsexits("Solver_MumpsSetCntl",err,error)
10055  RETURN 1
10056 
10057  END SUBROUTINE solver_mumpssetcntl
10058 
10059  !
10060  !================================================================================================================================
10061  !
10062 
10064  SUBROUTINE solver_linear_direct_solve(LINEAR_DIRECT_SOLVER,ERR,ERROR,*)
10065 
10066  !Argument variables
10067  TYPE(linear_direct_solver_type), POINTER :: LINEAR_DIRECT_SOLVER
10068  INTEGER(INTG), INTENT(OUT) :: ERR
10069  TYPE(varying_string), INTENT(OUT) :: ERROR
10070  !Local Variables
10071  INTEGER(INTG) :: global_row,local_row,STORAGE_TYPE
10072  REAL(DP) :: SOLVER_VALUE,VALUE
10073  REAL(DP), POINTER :: RHS_DATA(:)
10074  TYPE(distributed_vector_type), POINTER :: RHS_VECTOR,SOLVER_VECTOR
10075  TYPE(domain_mapping_type), POINTER :: ROW_DOFS_MAPPING
10076  TYPE(linear_solver_type), POINTER :: LINEAR_SOLVER
10077  TYPE(solver_type), POINTER :: SOLVER
10078  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
10079  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
10080  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
10081  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
10082  TYPE(varying_string) :: LOCAL_ERROR
10083 
10084  enters("SOLVER_LINEAR_DIRECT_SOLVE",err,error,*999)
10085 
10086  IF(ASSOCIATED(linear_direct_solver)) THEN
10087  linear_solver=>linear_direct_solver%LINEAR_SOLVER
10088  IF(ASSOCIATED(linear_solver)) THEN
10089  solver=>linear_solver%SOLVER
10090  IF(ASSOCIATED(solver)) THEN
10091  solver_equations=>solver%SOLVER_EQUATIONS
10092  IF(ASSOCIATED(solver_equations)) THEN
10093  solver_matrices=>solver_equations%SOLVER_MATRICES
10094  IF(ASSOCIATED(solver_matrices)) THEN
10095  IF(solver_matrices%NUMBER_OF_MATRICES==1) THEN
10096  solver_matrix=>solver_matrices%MATRICES(1)%PTR
10097  IF(ASSOCIATED(solver_matrix)) THEN
10098  rhs_vector=>solver_matrices%RHS_VECTOR
10099  IF(ASSOCIATED(rhs_vector)) THEN
10100  solver_vector=>solver_matrices%MATRICES(1)%PTR%SOLVER_VECTOR
10101  IF(ASSOCIATED(solver_vector)) THEN
10102  CALL distributed_matrix_storage_type_get(solver_matrix%MATRIX,storage_type,err,error,*999)
10103  IF(storage_type==distributed_matrix_diagonal_storage_type) THEN
10104  solver_mapping=>solver_equations%SOLVER_MAPPING
10105  IF(ASSOCIATED(solver_mapping)) THEN
10106  row_dofs_mapping=>solver_mapping%ROW_DOFS_MAPPING
10107  IF(ASSOCIATED(row_dofs_mapping)) THEN
10108  CALL distributed_vector_data_get(rhs_vector,rhs_data,err,error,*999)
10109  DO local_row=1,solver_mapping%NUMBER_OF_ROWS
10110  global_row=row_dofs_mapping%LOCAL_TO_GLOBAL_MAP(local_row)
10111  CALL distributed_matrix_values_get(solver_matrix%MATRIX,local_row,global_row,VALUE,err,error,*999)
10112  IF(abs(VALUE)>zero_tolerance) THEN
10113  solver_value=rhs_data(local_row)/VALUE
10114  CALL distributed_vector_values_set(solver_vector,local_row,solver_value,err,error,*999)
10115  ELSE
10116  local_error="The linear solver matrix has a zero pivot on row "// &
10117  & trim(numbertovstring(local_row,"*",err,error))//"."
10118  CALL flagerror(local_error,err,error,*999)
10119  ENDIF
10120  ENDDO !matrix_idx
10121  CALL distributed_vector_data_restore(rhs_vector,rhs_data,err,error,*999)
10122  ELSE
10123  CALL flagerror("Solver mapping row dofs mapping is not associated.",err,error,*999)
10124  ENDIF
10125  ELSE
10126  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
10127  ENDIF
10128  ELSE
10129  SELECT CASE(linear_direct_solver%DIRECT_SOLVER_TYPE)
10130  CASE(solver_direct_lu)
10131  SELECT CASE(linear_direct_solver%SOLVER_LIBRARY)
10132  CASE(solver_cmiss_library)
10133  CALL flagerror("Not implemented.",err,error,*999)
10134  CASE(solver_mumps_library)
10135  !Call MUMPS through PETSc
10136  IF(ASSOCIATED(rhs_vector%PETSC)) THEN
10137  IF(ASSOCIATED(solver_vector%PETSC)) THEN
10138  IF(ASSOCIATED(solver_matrix%MATRIX)) THEN
10139  IF(ASSOCIATED(solver_matrix%MATRIX%PETSC)) THEN
10140  IF(solver_matrix%UPDATE_MATRIX) THEN
10141  CALL petsc_kspsetoperators(linear_direct_solver%KSP,solver_matrix%MATRIX%PETSC%MATRIX, &
10142  & solver_matrix%MATRIX%PETSC%MATRIX,err,error,*999)
10143  ELSE
10144  CALL petsc_pcsetreusepreconditioner(linear_direct_solver%PC,.true.,err,error,*999)
10145  ENDIF
10146  !Solve the linear system
10147  CALL petsc_kspsolve(linear_direct_solver%KSP,rhs_vector%PETSC%VECTOR, &
10148  & solver_vector%PETSC%VECTOR,err,error,*999)
10149  ELSE
10150  CALL flagerror("Solver matrix PETSc is not associated.",err,error,*999)
10151  ENDIF
10152  ELSE
10153  CALL flagerror("Solver matrix distributed matrix is not associated.",err,error,*999)
10154  ENDIF
10155  ELSE
10156  CALL flagerror("Solver vector PETSc vector is not associated.",err,error,*999)
10157  ENDIF
10158  ELSE
10159  CALL flagerror("RHS vector petsc PETSc is not associated.",err,error,*999)
10160  ENDIF
10161  CASE(solver_superlu_library)
10162  !Call SuperLU through PETSc
10163  IF(ASSOCIATED(rhs_vector%PETSC)) THEN
10164  IF(ASSOCIATED(solver_vector%PETSC)) THEN
10165  IF(ASSOCIATED(solver_matrix%MATRIX)) THEN
10166  IF(ASSOCIATED(solver_matrix%MATRIX%PETSC)) THEN
10167  IF(solver_matrix%UPDATE_MATRIX) THEN
10168  CALL petsc_kspsetoperators(linear_direct_solver%KSP,solver_matrix%MATRIX%PETSC%MATRIX, &
10169  & solver_matrix%MATRIX%PETSC%MATRIX,err,error,*999)
10170  ELSE
10171  CALL petsc_pcsetreusepreconditioner(linear_direct_solver%PC,petsc_true,err,error,*999)
10172  ENDIF
10173  !Solve the linear system
10174  CALL petsc_kspsolve(linear_direct_solver%KSP,rhs_vector%PETSC%VECTOR, &
10175  & solver_vector%PETSC%VECTOR,err,error,*999)
10176  ELSE
10177  CALL flagerror("Solver matrix PETSc is not associated.",err,error,*999)
10178  ENDIF
10179  ELSE
10180  CALL flagerror("Solver matrix distributed matrix is not associated.",err,error,*999)
10181  ENDIF
10182  ELSE
10183  CALL flagerror("Solver vector PETSc vector is not associated.",err,error,*999)
10184  ENDIF
10185  ELSE
10186  CALL flagerror("RHS vector petsc PETSc is not associated.",err,error,*999)
10187  ENDIF
10188  CASE(solver_spooles_library)
10189  CALL flagerror("Not implemented.",err,error,*999)
10190  CASE(solver_umfpack_library)
10191  CALL flagerror("Not implemented.",err,error,*999)
10192  CASE(solver_lusol_library)
10193  CALL flagerror("Not implemented.",err,error,*999)
10194  CASE(solver_essl_library)
10195  CALL flagerror("Not implemented.",err,error,*999)
10196  CASE(solver_lapack_library)
10197  !Call LAPACK through PETSc
10198  IF(ASSOCIATED(rhs_vector%PETSC)) THEN
10199  IF(ASSOCIATED(solver_vector%PETSC)) THEN
10200  IF(ASSOCIATED(solver_matrix%MATRIX)) THEN
10201  IF(ASSOCIATED(solver_matrix%MATRIX%PETSC)) THEN
10202  IF(solver_matrix%UPDATE_MATRIX) THEN
10203  CALL petsc_kspsetoperators(linear_direct_solver%KSP,solver_matrix%MATRIX%PETSC%MATRIX, &
10204  & solver_matrix%MATRIX%PETSC%MATRIX,err,error,*999)
10205  ELSE
10206  CALL petsc_pcsetreusepreconditioner(linear_direct_solver%PC,.true.,err,error,*999)
10207  ENDIF
10208  !Solve the linear system
10209  CALL petsc_kspsolve(linear_direct_solver%KSP,rhs_vector%PETSC%VECTOR, &
10210  & solver_vector%PETSC%VECTOR,err,error,*999)
10211  ELSE
10212  CALL flagerror("Solver matrix PETSc is not associated.",err,error,*999)
10213  ENDIF
10214  ELSE
10215  CALL flagerror("Solver matrix distributed matrix is not associated.",err,error,*999)
10216  ENDIF
10217  ELSE
10218  CALL flagerror("Solver vector PETSc vector is not associated.",err,error,*999)
10219  ENDIF
10220  ELSE
10221  CALL flagerror("RHS vector petsc PETSc is not associated.",err,error,*999)
10222  ENDIF
10223  CASE(solver_pastix_library)
10224  !Call PASTIX through PETSc
10225  IF(ASSOCIATED(rhs_vector%PETSC)) THEN
10226  IF(ASSOCIATED(solver_vector%PETSC)) THEN
10227  IF(ASSOCIATED(solver_matrix%MATRIX)) THEN
10228  IF(ASSOCIATED(solver_matrix%MATRIX%PETSC)) THEN
10229  IF(solver_matrix%UPDATE_MATRIX) THEN
10230  CALL petsc_kspsetoperators(linear_direct_solver%KSP,solver_matrix%MATRIX%PETSC%MATRIX, &
10231  & solver_matrix%MATRIX%PETSC%MATRIX,err,error,*999)
10232  ELSE
10233  CALL petsc_pcsetreusepreconditioner(linear_direct_solver%PC,.true.,err,error,*999)
10234  ENDIF
10235  !Solve the linear system
10236  CALL petsc_kspsolve(linear_direct_solver%KSP,rhs_vector%PETSC%VECTOR, &
10237  & solver_vector%PETSC%VECTOR,err,error,*999)
10238  ELSE
10239  CALL flagerror("Solver matrix PETSc is not associated.",err,error,*999)
10240  ENDIF
10241  ELSE
10242  CALL flagerror("Solver matrix distributed matrix is not associated.",err,error,*999)
10243  ENDIF
10244  ELSE
10245  CALL flagerror("Solver vector PETSc vector is not associated.",err,error,*999)
10246  ENDIF
10247  ELSE
10248  CALL flagerror("RHS vector petsc PETSc is not associated.",err,error,*999)
10249  ENDIF
10250  CASE DEFAULT
10251  local_error="The solver library type of "// &
10252  & trim(numbertovstring(linear_direct_solver%SOLVER_LIBRARY,"*",err,error))// &
10253  & " is invalid for a LU direct linear solver."
10254  CALL flagerror(local_error,err,error,*999)
10255  END SELECT
10256  CASE(solver_direct_cholesky)
10257  CALL flagerror("Not implemented.",err,error,*999)
10258  CASE(solver_direct_svd)
10259  CALL flagerror("Not implemented.",err,error,*999)
10260  CASE DEFAULT
10261  local_error="The direct linear solver type of "// &
10262  & trim(numbertovstring(linear_direct_solver%DIRECT_SOLVER_TYPE,"*",err,error))// &
10263  & " is invalid."
10264  CALL flagerror(local_error,err,error,*999)
10265  END SELECT
10266  ENDIF
10267  ELSE
10268  CALL flagerror("Solver vector is not associated.",err,error,*999)
10269  ENDIF
10270  ELSE
10271  CALL flagerror("RHS vector is not associated.",err,error,*999)
10272  ENDIF
10273  ELSE
10274  CALL flagerror("Solver matrix is not associated.",err,error,*999)
10275  ENDIF
10276  ELSE
10277  local_error="The number of solver matrices of "// &
10278  & trim(numbertovstring(solver_matrices%NUMBER_OF_MATRICES,"*",err,error))// &
10279  & " is invalid. There should only be one solver matrix for a linear direct solver."
10280  CALL flagerror(local_error,err,error,*999)
10281  ENDIF
10282  ELSE
10283  CALL flagerror("Solver equations solver matrices is not associated.",err,error,*999)
10284  ENDIF
10285  ELSE
10286  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
10287  ENDIF
10288  ELSE
10289  CALL flagerror("Linear solver solver is not associated.",err,error,*999)
10290  ENDIF
10291  ELSE
10292  CALL flagerror("Linear direct solver linear solver is not associated.",err,error,*999)
10293  ENDIF
10294  ELSE
10295  CALL flagerror("Linear direct solver is not associated.",err,error,*999)
10296  ENDIF
10297 
10298  exits("SOLVER_LINEAR_DIRECT_SOLVE")
10299  RETURN
10300 999 errorsexits("SOLVER_LINEAR_DIRECT_SOLVE",err,error)
10301  RETURN 1
10302 
10303  END SUBROUTINE solver_linear_direct_solve
10304 
10305  !
10306  !================================================================================================================================
10307  !
10308 
10310  SUBROUTINE solver_linear_direct_svd_finalise(LINEAR_DIRECT_SOLVER,ERR,ERROR,*)
10311 
10312  !Argument variables
10313  TYPE(linear_direct_solver_type), POINTER :: LINEAR_DIRECT_SOLVER
10314  INTEGER(INTG), INTENT(OUT) :: ERR
10315  TYPE(varying_string), INTENT(OUT) :: ERROR
10316  !Local Variables
10317 
10318  enters("SOLVER_LINEAR_DIRECT_SVD_FINALISE",err,error,*999)
10319 
10320  IF(ASSOCIATED(linear_direct_solver)) THEN
10321  CALL flagerror("Not implemented.",err,error,*999)
10322  ENDIF
10323 
10324  exits("SOLVER_LINEAR_DIRECT_SVD_FINALISE")
10325  RETURN
10326 999 errorsexits("SOLVER_LINEAR_DIRECT_SVD_FINALISE",err,error)
10327  RETURN 1
10328 
10329  END SUBROUTINE solver_linear_direct_svd_finalise
10330 
10331  !
10332  !================================================================================================================================
10333  !
10334 
10336  SUBROUTINE solver_linear_direct_svd_initialise(DIRECT_SOLVER,ERR,ERROR,*)
10337 
10338  !Argument variables
10339  TYPE(linear_direct_solver_type), POINTER :: DIRECT_SOLVER
10340  INTEGER(INTG), INTENT(OUT) :: ERR
10341  TYPE(varying_string), INTENT(OUT) :: ERROR
10342  !Local Variables
10343 
10344  enters("SOLVER_LINEAR_DIRECT_SVD_INITIALISE",err,error,*999)
10345 
10346  IF(ASSOCIATED(direct_solver)) THEN
10347  CALL flagerror("Not implemented.",err,error,*999)
10348  ELSE
10349  CALL flagerror("Direct linear solver is not associated.",err,error,*999)
10350  ENDIF
10351 
10352  exits("SOLVER_LINEAR_DIRECT_SVD_INITIALISE")
10353  RETURN
10354 999 errorsexits("SOLVER_LINEAR_DIRECT_SVD_INITIALISE",err,error)
10355  RETURN 1
10356 
10357  END SUBROUTINE solver_linear_direct_svd_initialise
10358 
10359  !
10360  !================================================================================================================================
10361  !
10362 
10364  SUBROUTINE solver_linear_direct_type_set(SOLVER,DIRECT_SOLVER_TYPE,ERR,ERROR,*)
10365 
10366  !Argument variables
10367  TYPE(solver_type), POINTER :: SOLVER
10368  INTEGER(INTG), INTENT(IN) :: DIRECT_SOLVER_TYPE
10369  INTEGER(INTG), INTENT(OUT) :: ERR
10370  TYPE(varying_string), INTENT(OUT) :: ERROR
10371  !Local Variables
10372  TYPE(varying_string) :: LOCAL_ERROR
10373 
10374  enters("SOLVER_LINEAR_DIRECT_TYPE_SET",err,error,*999)
10375 
10376  IF(ASSOCIATED(solver)) THEN
10377  IF(solver%SOLVER_FINISHED) THEN
10378  CALL flagerror("Solver has already been finished.",err,error,*999)
10379  ELSE
10380  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
10381  IF(ASSOCIATED(solver%LINEAR_SOLVER)) THEN
10382  IF(solver%LINEAR_SOLVER%LINEAR_SOLVE_TYPE==solver_linear_direct_solve_type) THEN
10383  IF(ASSOCIATED(solver%LINEAR_SOLVER%DIRECT_SOLVER)) THEN
10384  IF(direct_solver_type/=solver%LINEAR_SOLVER%DIRECT_SOLVER%DIRECT_SOLVER_TYPE) THEN
10385  !Finalise the old direct solver
10386  SELECT CASE(solver%LINEAR_SOLVER%DIRECT_SOLVER%SOLVER_LIBRARY)
10387  CASE(solver_direct_lu)
10388  CALL solver_linear_direct_lu_finalise(solver%LINEAR_SOLVER%DIRECT_SOLVER,err,error,*999)
10389  CASE(solver_direct_cholesky)
10390  CALL solver_linear_direct_cholesky_finalise(solver%LINEAR_SOLVER%DIRECT_SOLVER,err,error,*999)
10391  CASE(solver_direct_svd)
10392  CALL solver_linear_direct_svd_finalise(solver%LINEAR_SOLVER%DIRECT_SOLVER,err,error,*999)
10393  CASE DEFAULT
10394  local_error="The direct solver type of "//trim(numbertovstring(direct_solver_type,"*",err,error))// &
10395  & " is invalid."
10396  CALL flagerror(local_error,err,error,*999)
10397  END SELECT
10398  !Initialise the new library
10399  SELECT CASE(direct_solver_type)
10400  CASE(solver_direct_lu)
10401  CALL solver_linear_direct_lu_initialise(solver%LINEAR_SOLVER%DIRECT_SOLVER,err,error,*999)
10402  CASE(solver_direct_cholesky)
10403  CALL solver_linear_direct_cholesky_initialise(solver%LINEAR_SOLVER%DIRECT_SOLVER,err,error,*999)
10404  CASE(solver_direct_svd)
10405  CALL solver_linear_direct_svd_initialise(solver%LINEAR_SOLVER%DIRECT_SOLVER,err,error,*999)
10406  CASE DEFAULT
10407  local_error="The direct solver type of "//trim(numbertovstring(direct_solver_type,"*",err,error))// &
10408  & " is invalid."
10409  CALL flagerror(local_error,err,error,*999)
10410  END SELECT
10411  ENDIF
10412  ELSE
10413  CALL flagerror("The solver linear solver direct solver is not associated.",err,error,*999)
10414  ENDIF
10415  ELSE
10416  CALL flagerror("The solver is not a linear direct solver.",err,error,*999)
10417  ENDIF
10418  ELSE
10419  CALL flagerror("The solver linear solver is not associated.",err,error,*999)
10420  ENDIF
10421  ELSE
10422  CALL flagerror("The solver is not a linear solver.",err,error,*999)
10423  ENDIF
10424  ENDIF
10425  ELSE
10426  CALL flagerror("Solver is not associated.",err,error,*999)
10427  ENDIF
10428 
10429  exits("SOLVER_LINEAR_DIRECT_TYPE_SET")
10430  RETURN
10431 999 errorsexits("SOLVER_LINEAR_DIRECT_TYPE_SET",err,error)
10432  RETURN 1
10433 
10434  END SUBROUTINE solver_linear_direct_type_set
10435 
10436  !
10437  !================================================================================================================================
10438  !
10439 
10441  SUBROUTINE solver_linear_finalise(LINEAR_SOLVER,ERR,ERROR,*)
10442 
10443  !Argument variables
10444  TYPE(linear_solver_type), POINTER :: LINEAR_SOLVER
10445  INTEGER(INTG), INTENT(OUT) :: ERR
10446  TYPE(varying_string), INTENT(OUT) :: ERROR
10447  !Local Variables
10448 
10449  enters("SOLVER_LINEAR_FINALISE",err,error,*999)
10450 
10451  IF(ASSOCIATED(linear_solver)) THEN
10452  CALL solver_linear_direct_finalise(linear_solver%DIRECT_SOLVER,err,error,*999)
10453  CALL solver_linear_iterative_finalise(linear_solver%ITERATIVE_SOLVER,err,error,*999)
10454  DEALLOCATE(linear_solver)
10455  ENDIF
10456 
10457  exits("SOLVER_LINEAR_FINALISE")
10458  RETURN
10459 999 errorsexits("SOLVER_LINEAR_FINALISE",err,error)
10460  RETURN 1
10461 
10462  END SUBROUTINE solver_linear_finalise
10463 
10464  !
10465  !================================================================================================================================
10466  !
10467 
10469  SUBROUTINE solver_linear_initialise(SOLVER,ERR,ERROR,*)
10470 
10471  !Argument variables
10472  TYPE(solver_type), POINTER :: SOLVER
10473  INTEGER(INTG), INTENT(OUT) :: ERR
10474  TYPE(varying_string), INTENT(OUT) :: ERROR
10475  !Local Variables
10476  INTEGER(INTG) :: DUMMY_ERR
10477  TYPE(varying_string) :: DUMMY_ERROR
10478 
10479  enters("SOLVER_LINEAR_INITIALISE",err,error,*998)
10480 
10481  IF(ASSOCIATED(solver)) THEN
10482  IF(ASSOCIATED(solver%LINEAR_SOLVER)) THEN
10483  CALL flagerror("Linear solver is already associated for this solver.",err,error,*998)
10484  ELSE
10485  !Allocate and initialise a linear solver
10486  ALLOCATE(solver%LINEAR_SOLVER,stat=err)
10487  IF(err/=0) CALL flagerror("Could not allocate solver linear solver.",err,error,*999)
10488  solver%LINEAR_SOLVER%SOLVER=>solver
10489  solver%LINEAR_SOLVER%LINKED_NEWTON_PETSC_SOLVER=.false.
10490  NULLIFY(solver%LINEAR_SOLVER%DIRECT_SOLVER)
10491  NULLIFY(solver%LINEAR_SOLVER%ITERATIVE_SOLVER)
10492  !Default to an iterative solver
10493  solver%LINEAR_SOLVER%LINEAR_SOLVE_TYPE=solver_linear_iterative_solve_type
10494  CALL solver_linear_iterative_initialise(solver%LINEAR_SOLVER,err,error,*999)
10495  ENDIF
10496  ELSE
10497  CALL flagerror("Solver is not associated.",err,error,*998)
10498  ENDIF
10499 
10500  exits("SOLVER_LINEAR_INITIALISE")
10501  RETURN
10502 999 CALL solver_linear_finalise(solver%LINEAR_SOLVER,dummy_err,dummy_error,*998)
10503 998 errorsexits("SOLVER_LINEAR_INITIALISE",err,error)
10504  RETURN 1
10505 
10506  END SUBROUTINE solver_linear_initialise
10507 
10508  !
10509  !================================================================================================================================
10510  !
10511 
10513  SUBROUTINE solver_lineariterativeabsolutetoleranceset(SOLVER,ABSOLUTE_TOLERANCE,ERR,ERROR,*)
10514 
10515  !Argument variables
10516  TYPE(solver_type), POINTER :: SOLVER
10517  REAL(DP), INTENT(IN) :: ABSOLUTE_TOLERANCE
10518  INTEGER(INTG), INTENT(OUT) :: ERR
10519  TYPE(varying_string), INTENT(OUT) :: ERROR
10520  !Local Variables
10521  TYPE(varying_string) :: LOCAL_ERROR
10522 
10523  enters("Solver_LinearIterativeAbsoluteToleranceSet",err,error,*999)
10524 
10525  IF(ASSOCIATED(solver)) THEN
10526  IF(solver%SOLVER_FINISHED) THEN
10527  CALL flagerror("Solver has already been finished.",err,error,*999)
10528  ELSE
10529  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
10530  IF(ASSOCIATED(solver%LINEAR_SOLVER)) THEN
10531  IF(solver%LINEAR_SOLVER%LINEAR_SOLVE_TYPE==solver_linear_iterative_solve_type) THEN
10532  IF(ASSOCIATED(solver%LINEAR_SOLVER%ITERATIVE_SOLVER)) THEN
10533  IF(absolute_tolerance>zero_tolerance) THEN
10534  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%ABSOLUTE_TOLERANCE=absolute_tolerance
10535  ELSE
10536  local_error="The specified absolute tolerance of "//trim(numbertovstring(absolute_tolerance,"*",err,error))// &
10537  & " is invalid. The absolute tolerance must be > 0."
10538  CALL flagerror(local_error,err,error,*999)
10539  ENDIF
10540  ELSE
10541  CALL flagerror("The solver linear solver iterative solver is not associated.",err,error,*999)
10542  ENDIF
10543  ELSE
10544  CALL flagerror("The solver is not a linear iterative solver.",err,error,*999)
10545  ENDIF
10546  ELSE
10547  CALL flagerror("The solver linear solver is not associated.",err,error,*999)
10548  ENDIF
10549  ELSE
10550  CALL flagerror("The solver is not a linear solver.",err,error,*999)
10551  ENDIF
10552  ENDIF
10553  ELSE
10554  CALL flagerror("Solver is not associated.",err,error,*999)
10555  ENDIF
10556 
10557  exits("Solver_LinearIterativeAbsoluteToleranceSet")
10558  RETURN
10559 999 errorsexits("Solver_LinearIterativeAbsoluteToleranceSet",err,error)
10560  RETURN 1
10561 
10562  END SUBROUTINE solver_lineariterativeabsolutetoleranceset
10563 
10564  !
10565  !================================================================================================================================
10566  !
10567 
10569  SUBROUTINE solver_linear_iterative_create_finish(LINEAR_ITERATIVE_SOLVER,ERR,ERROR,*)
10570 
10571  !Argument variables
10572  TYPE(linear_iterative_solver_type), POINTER :: LINEAR_ITERATIVE_SOLVER
10573  INTEGER(INTG), INTENT(OUT) :: ERR
10574  TYPE(varying_string), INTENT(OUT) :: ERROR
10575  !Local Variables
10576  TYPE(distributed_matrix_type), POINTER :: SOLVER_MATRIX
10577  TYPE(linear_solver_type), POINTER :: LINEAR_SOLVER
10578  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
10579  TYPE(newton_linesearch_solver_type), POINTER :: NEWTON_LINESEARCH_SOLVER
10580  TYPE(newton_trustregion_solver_type), POINTER :: NEWTON_TRUSTREGION_SOLVER
10581  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
10582  TYPE(quasi_newton_linesearch_solver_type), POINTER :: QUASI_NEWTON_LINESEARCH_SOLVER
10583  TYPE(quasi_newton_trustregion_solver_type), POINTER :: QUASI_NEWTON_TRUSTREGION_SOLVER
10584  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
10585  TYPE(solver_type), POINTER :: LINKING_SOLVER,SOLVER
10586  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
10587  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
10588  TYPE(varying_string) :: LOCAL_ERROR
10589 
10590  enters("SOLVER_LINEAR_ITERATIVE_CREATE_FINISH",err,error,*999)
10591 
10592  IF(ASSOCIATED(linear_iterative_solver)) THEN
10593  linear_solver=>linear_iterative_solver%LINEAR_SOLVER
10594  IF(ASSOCIATED(linear_solver)) THEN
10595  solver=>linear_solver%SOLVER
10596  IF(ASSOCIATED(solver)) THEN
10597  !Should really check iterative types here and then the solver library but as they are all PETSc for now hold off.
10598  SELECT CASE(linear_iterative_solver%SOLVER_LIBRARY)
10599  CASE(solver_cmiss_library)
10600  CALL flagerror("Not implemented.",err,error,*999)
10601  CASE(solver_petsc_library)
10602  IF(ASSOCIATED(solver%LINKING_SOLVER)) THEN
10603  solver_equations=>solver%LINKING_SOLVER%SOLVER_EQUATIONS
10604  IF(ASSOCIATED(solver_equations)) THEN
10605  solver_matrices=>solver_equations%SOLVER_MATRICES
10606  IF(.NOT.ASSOCIATED(solver_matrices)) &
10607  & CALL flagerror("Linked solver equation solver matrices is not associated.",err,error,*999)
10608  ELSE
10609  CALL flagerror("Linked solver solver equations is not associated.",err,error,*999)
10610  ENDIF
10611  ELSE
10612  solver_equations=>solver%SOLVER_EQUATIONS
10613  IF(ASSOCIATED(solver_equations)) THEN
10614  !Create the solver matrices and vectors
10615  NULLIFY(solver_matrices)
10616  CALL solver_matrices_create_start(solver_equations,solver_matrices,err,error,*999)
10617  CALL solver_matrices_library_type_set(solver_matrices,solver_petsc_library,err,error,*999)
10618  SELECT CASE(solver_equations%SPARSITY_TYPE)
10619  CASE(solver_sparse_matrices)
10620  CALL solver_matrices_storage_type_set(solver_matrices,[distributed_matrix_compressed_row_storage_type], &
10621  & err,error,*999)
10622  CASE(solver_full_matrices)
10623  CALL solver_matrices_storage_type_set(solver_matrices,[distributed_matrix_block_storage_type], &
10624  & err,error,*999)
10625  CASE DEFAULT
10626  local_error="The specified solver equations sparsity type of "// &
10627  & trim(numbertovstring(solver_equations%SPARSITY_TYPE,"*",err,error))// &
10628  & " is invalid."
10629  CALL flagerror(local_error,err,error,*999)
10630  END SELECT
10631  CALL solver_matrices_create_finish(solver_matrices,err,error,*999)
10632  ELSE
10633  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
10634  ENDIF
10635  ENDIF
10636  !Create the PETSc KSP solver
10637  IF(linear_solver%LINKED_NEWTON_PETSC_SOLVER) THEN
10638  linking_solver=>solver%LINKING_SOLVER
10639  IF(ASSOCIATED(linking_solver)) THEN
10640  nonlinear_solver=>linking_solver%NONLINEAR_SOLVER
10641  IF(ASSOCIATED(nonlinear_solver)) THEN
10642  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
10643  newton_solver=>nonlinear_solver%NEWTON_SOLVER
10644  IF(ASSOCIATED(newton_solver)) THEN
10645  SELECT CASE(newton_solver%NEWTON_SOLVE_TYPE)
10646  CASE(solver_newton_linesearch)
10647  newton_linesearch_solver=>newton_solver%LINESEARCH_SOLVER
10648  IF(ASSOCIATED(newton_linesearch_solver)) THEN
10649  CALL petsc_snesgetksp(newton_linesearch_solver%snes,linear_iterative_solver%KSP,err,error,*999)
10650  ELSE
10651  CALL flagerror("Newton solver linesearch solver is not associated.",err,error,*999)
10652  ENDIF
10653  CASE(solver_newton_trustregion)
10654  newton_trustregion_solver=>newton_solver%TRUSTREGION_SOLVER
10655  IF(ASSOCIATED(newton_trustregion_solver)) THEN
10656  CALL petsc_snesgetksp(newton_trustregion_solver%snes,linear_iterative_solver%KSP,err,error,*999)
10657  ELSE
10658  CALL flagerror("Newton solver linesearch solver is not associated.",err,error,*999)
10659  ENDIF
10660  CASE DEFAULT
10661  local_error="The Newton solve type of "// &
10662  & trim(numbertovstring(newton_solver%NEWTON_SOLVE_TYPE,"*",err,error))//"is invalid."
10663  CALL flagerror(local_error,err,error,*999)
10664  END SELECT
10665  ELSE
10666  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
10667  ENDIF
10668  ELSEIF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
10669  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
10670  IF(ASSOCIATED(quasi_newton_solver)) THEN
10671  SELECT CASE(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE)
10672  CASE(solver_quasi_newton_linesearch)
10673  quasi_newton_linesearch_solver=>quasi_newton_solver%LINESEARCH_SOLVER
10674  IF(ASSOCIATED(quasi_newton_linesearch_solver)) THEN
10675  CALL petsc_snesgetksp(quasi_newton_linesearch_solver%snes,linear_iterative_solver%KSP,err,error,*999)
10676  ELSE
10677  CALL flagerror("Quasi-Newton solver linesearch solver is not associated.",err,error,*999)
10678  ENDIF
10679  CASE(solver_quasi_newton_trustregion)
10680  quasi_newton_trustregion_solver=>quasi_newton_solver%TRUSTREGION_SOLVER
10681  IF(ASSOCIATED(quasi_newton_trustregion_solver)) THEN
10682  CALL petsc_snesgetksp(quasi_newton_trustregion_solver%snes,linear_iterative_solver%KSP,err,error,*999)
10683  ELSE
10684  CALL flagerror("Quasi-Newton solver linesearch solver is not associated.",err,error,*999)
10685  ENDIF
10686  CASE DEFAULT
10687  local_error="The Quasi-Newton solve type of "// &
10688  & trim(numbertovstring(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE,"*",err,error))//"is invalid."
10689  CALL flagerror(local_error,err,error,*999)
10690  END SELECT
10691  ELSE
10692  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
10693  ENDIF
10694  ENDIF
10695  ELSE
10696  CALL flagerror("Linking solver nonlinear solver is not associated.",err,error,*999)
10697  ENDIF
10698  ELSE
10699  CALL flagerror("Solver linking solve is not associated.",err,error,*999)
10700  ENDIF
10701  ELSE
10702  CALL petsc_kspcreate(computational_environment%MPI_COMM,linear_iterative_solver%KSP,err,error,*999)
10703  ENDIF
10704  !Set the iterative solver type
10705  SELECT CASE(linear_iterative_solver%ITERATIVE_SOLVER_TYPE)
10706  CASE(solver_iterative_richardson)
10707  CALL petsc_kspsettype(linear_iterative_solver%KSP,petsc_ksprichardson,err,error,*999)
10708  CASE(solver_iterative_chebyshev)
10709  CALL petsc_kspsettype(linear_iterative_solver%KSP,petsc_kspchebyshev,err,error,*999)
10710  CASE(solver_iterative_conjugate_gradient)
10711  CALL petsc_kspsettype(linear_iterative_solver%KSP,petsc_kspcg,err,error,*999)
10712  CASE(solver_iterative_biconjugate_gradient)
10713  CALL petsc_kspsettype(linear_iterative_solver%KSP,petsc_kspbicg,err,error,*999)
10714  CASE(solver_iterative_gmres)
10715  CALL petsc_kspsettype(linear_iterative_solver%KSP,petsc_kspgmres,err,error,*999)
10716  CALL petsc_kspgmressetrestart(linear_iterative_solver%KSP,linear_iterative_solver%GMRES_RESTART,err,error,*999)
10717  CASE(solver_iterative_bicgstab)
10718  CALL petsc_kspsettype(linear_iterative_solver%KSP,petsc_kspbcgs,err,error,*999)
10719  CASE(solver_iterative_conjgrad_squared)
10720  CALL petsc_kspsettype(linear_iterative_solver%KSP,petsc_kspcgs,err,error,*999)
10721  CASE DEFAULT
10722  local_error="The iterative solver type of "// &
10723  & trim(numbertovstring(linear_iterative_solver%ITERATIVE_SOLVER_TYPE,"*",err,error))//" is invalid."
10724  CALL flagerror(local_error,err,error,*999)
10725  END SELECT
10726  !Get the pre-conditioner
10727  CALL petsc_kspgetpc(linear_iterative_solver%KSP,linear_iterative_solver%PC,err,error,*999)
10728  !Set the pre-conditioner type
10729  SELECT CASE(linear_iterative_solver%ITERATIVE_PRECONDITIONER_TYPE)
10730  CASE(solver_iterative_no_preconditioner)
10731  CALL petsc_pcsettype(linear_iterative_solver%PC,petsc_pcnone,err,error,*999)
10732  CASE(solver_iterative_jacobi_preconditioner)
10733  CALL petsc_pcsettype(linear_iterative_solver%PC,petsc_pcjacobi,err,error,*999)
10734  CASE(solver_iterative_block_jacobi_preconditioner)
10735  CALL petsc_pcsettype(linear_iterative_solver%PC,petsc_pcbjacobi,err,error,*999)
10736  CASE(solver_iterative_sor_preconditioner)
10737  CALL petsc_pcsettype(linear_iterative_solver%PC,petsc_pcsor,err,error,*999)
10738  CASE(solver_iterative_incomplete_cholesky_preconditioner)
10739  CALL petsc_pcsettype(linear_iterative_solver%PC,petsc_pcicc,err,error,*999)
10740  CASE(solver_iterative_incomplete_lu_preconditioner)
10741  CALL petsc_pcsettype(linear_iterative_solver%PC,petsc_pcilu,err,error,*999)
10742  CASE(solver_iterative_additive_schwarz_preconditioner)
10743  CALL petsc_pcsettype(linear_iterative_solver%PC,petsc_pcasm,err,error,*999)
10744  CASE DEFAULT
10745  local_error="The iterative preconditioner type of "// &
10746  & trim(numbertovstring(linear_iterative_solver%ITERATIVE_PRECONDITIONER_TYPE,"*",err,error))//" is invalid."
10747  CALL flagerror(local_error,err,error,*999)
10748  END SELECT
10749  !Set the tolerances for the KSP solver
10750  CALL petsc_kspsettolerances(linear_iterative_solver%KSP,linear_iterative_solver%RELATIVE_TOLERANCE, &
10751  & linear_iterative_solver%ABSOLUTE_TOLERANCE,linear_iterative_solver%DIVERGENCE_TOLERANCE, &
10752  & linear_iterative_solver%MAXIMUM_NUMBER_OF_ITERATIONS,err,error,*999)
10753  !Set any further KSP options from the command line options
10754  CALL petsc_kspsetfromoptions(linear_iterative_solver%KSP,err,error,*999)
10755  !Set the solver matrix to be the KSP matrix
10756  IF(solver_matrices%NUMBER_OF_MATRICES==1) THEN
10757  solver_matrix=>solver_matrices%MATRICES(1)%PTR%MATRIX
10758  IF(ASSOCIATED(solver_matrix)) THEN
10759  IF(ASSOCIATED(solver_matrix%PETSC)) THEN
10760  CALL petsc_kspsetoperators(linear_iterative_solver%KSP,solver_matrix%PETSC%MATRIX,solver_matrix%PETSC%MATRIX, &
10761  & err,error,*999)
10762  ELSE
10763  CALL flagerror("Solver matrix PETSc is not associated.",err,error,*999)
10764  ENDIF
10765  ELSE
10766  CALL flagerror("Solver matrices distributed matrix is not associated.",err,error,*999)
10767  ENDIF
10768  ELSE
10769  local_error="The given number of solver matrices of "// &
10770  & trim(numbertovstring(solver_matrices%NUMBER_OF_MATRICES,"*",err,error))// &
10771  & " is invalid. There should only be one solver matrix for a linear iterative solver."
10772  CALL flagerror(local_error,err,error,*999)
10773  ENDIF
10774  CASE DEFAULT
10775  local_error="The solver library type of "// &
10776  & trim(numbertovstring(linear_iterative_solver%SOLVER_LIBRARY,"*",err,error))//" is invalid."
10777  CALL flagerror(local_error,err,error,*999)
10778  END SELECT
10779  ELSE
10780  CALL flagerror("Linear solver solver is not associated.",err,error,*999)
10781  ENDIF
10782  ELSE
10783  CALL flagerror("Linear iterative solver linear solver is not associated.",err,error,*999)
10784  ENDIF
10785  ELSE
10786  CALL flagerror("Linear iterative solver is not associated.",err,error,*999)
10787  ENDIF
10788 
10789  exits("SOLVER_LINEAR_ITERATIVE_CREATE_FINISH")
10790  RETURN
10791 999 errorsexits("SOLVER_LINEAR_ITERATIVE_CREATE_FINISH",err,error)
10792  RETURN 1
10793 
10794  END SUBROUTINE solver_linear_iterative_create_finish
10795 
10796  !
10797  !================================================================================================================================
10798  !
10799 
10801  SUBROUTINE solver_lineariterativedivergencetoleranceset(SOLVER,DIVERGENCE_TOLERANCE,ERR,ERROR,*)
10802 
10803  !Argument variables
10804  TYPE(solver_type), POINTER :: SOLVER
10805  REAL(DP), INTENT(IN) :: DIVERGENCE_TOLERANCE
10806  INTEGER(INTG), INTENT(OUT) :: ERR
10807  TYPE(varying_string), INTENT(OUT) :: ERROR
10808  !Local Variables
10809  TYPE(varying_string) :: LOCAL_ERROR
10810 
10811  enters("Solver_LinearIterativeDivergenceToleranceSet",err,error,*999)
10812 
10813  IF(ASSOCIATED(solver)) THEN
10814  IF(solver%SOLVER_FINISHED) THEN
10815  CALL flagerror("Solver has already been finished.",err,error,*999)
10816  ELSE
10817  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
10818  IF(ASSOCIATED(solver%LINEAR_SOLVER)) THEN
10819  IF(solver%LINEAR_SOLVER%LINEAR_SOLVE_TYPE==solver_linear_iterative_solve_type) THEN
10820  IF(ASSOCIATED(solver%LINEAR_SOLVER%ITERATIVE_SOLVER)) THEN
10821  IF(divergence_tolerance>zero_tolerance) THEN
10822  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%DIVERGENCE_TOLERANCE=divergence_tolerance
10823  ELSE
10824  local_error="The specified divergence tolerance of "// &
10825  & trim(numbertovstring(divergence_tolerance,"*",err,error))// &
10826  & " is invalid. The divergence tolerance must be > 0."
10827  CALL flagerror(local_error,err,error,*999)
10828  ENDIF
10829  ELSE
10830  CALL flagerror("The solver linear solver iterative solver is not associated.",err,error,*999)
10831  ENDIF
10832  ELSE
10833  CALL flagerror("The solver is not a linear iterative solver.",err,error,*999)
10834  ENDIF
10835  ELSE
10836  CALL flagerror("The solver linear solver is not associated.",err,error,*999)
10837  ENDIF
10838  ELSE
10839  CALL flagerror("The solver is not a linear solver.",err,error,*999)
10840  ENDIF
10841  ENDIF
10842  ELSE
10843  CALL flagerror("Solver is not associated.",err,error,*999)
10844  ENDIF
10845 
10846  exits("Solver_LinearIterativeDivergenceToleranceSet")
10847  RETURN
10848 999 errors("Solver_LinearIterativeDivergenceToleranceSet",err,error)
10849  exits("Solver_LinearIterativeDivergenceToleranceSet")
10850  RETURN 1
10851 
10852  END SUBROUTINE solver_lineariterativedivergencetoleranceset
10853 
10854  !
10855  !================================================================================================================================
10856  !
10857 
10859  SUBROUTINE solver_linear_iterative_finalise(LINEAR_ITERATIVE_SOLVER,ERR,ERROR,*)
10860 
10861  !Argument variables
10862  TYPE(linear_iterative_solver_type), POINTER :: LINEAR_ITERATIVE_SOLVER
10863  INTEGER(INTG), INTENT(OUT) :: ERR
10864  TYPE(varying_string), INTENT(OUT) :: ERROR
10865  !Local Variables
10866  TYPE(linear_solver_type), POINTER :: LINEAR_SOLVER
10867 
10868  enters("SOLVER_LINEAR_ITERATIVE_FINALISE",err,error,*999)
10869 
10870  IF(ASSOCIATED(linear_iterative_solver)) THEN
10871  linear_solver=>linear_iterative_solver%LINEAR_SOLVER
10872  IF(ASSOCIATED(linear_solver)) THEN
10873  IF(.NOT.linear_solver%LINKED_NEWTON_PETSC_SOLVER) THEN
10874  CALL petsc_pcfinalise(linear_iterative_solver%PC,err,error,*999)
10875  CALL petsc_kspfinalise(linear_iterative_solver%KSP,err,error,*999)
10876  ENDIF
10877  ENDIF
10878  DEALLOCATE(linear_iterative_solver)
10879  ENDIF
10880 
10881  exits("SOLVER_LINEAR_ITERATIVE_FINALISE")
10882  RETURN
10883 999 errorsexits("SOLVER_LINEAR_ITERATIVE_FINALISE",err,error)
10884  RETURN 1
10885 
10886  END SUBROUTINE solver_linear_iterative_finalise
10887 
10888  !
10889  !================================================================================================================================
10890  !
10891 
10893  SUBROUTINE solver_linear_iterative_gmres_restart_set(SOLVER,GMRES_RESTART,ERR,ERROR,*)
10894 
10895  !Argument variables
10896  TYPE(solver_type), POINTER :: SOLVER
10897  INTEGER(INTG), INTENT(IN) :: GMRES_RESTART
10898  INTEGER(INTG), INTENT(OUT) :: ERR
10899  TYPE(varying_string), INTENT(OUT) :: ERROR
10900  !Local Variables
10901  TYPE(linear_solver_type), POINTER :: LINEAR_SOLVER
10902  TYPE(linear_iterative_solver_type), POINTER :: ITERATIVE_SOLVER
10903  TYPE(varying_string) :: LOCAL_ERROR
10904 
10905  enters("SOLVER_LINEAR_ITERATIVE_GMRES_RESTART_SET",err,error,*999)
10906 
10907  IF(ASSOCIATED(solver)) THEN
10908  IF(solver%SOLVER_FINISHED) THEN
10909  CALL flagerror("Solver has already been finished.",err,error,*999)
10910  ELSE
10911  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
10912  linear_solver=>solver%LINEAR_SOLVER
10913  IF(ASSOCIATED(linear_solver)) THEN
10914  IF(linear_solver%LINEAR_SOLVE_TYPE==solver_linear_iterative_solve_type) THEN
10915  iterative_solver=>linear_solver%ITERATIVE_SOLVER
10916  IF(ASSOCIATED(iterative_solver)) THEN
10917  IF(iterative_solver%ITERATIVE_SOLVER_TYPE==solver_iterative_gmres) THEN
10918  IF(gmres_restart>0) THEN
10919  iterative_solver%GMRES_RESTART=gmres_restart
10920  ELSE
10921  local_error="The specified GMRES restart value of "//trim(numbertovstring(gmres_restart,"*",err,error))// &
10922  & " is invalid. The GMRES restart value must be > 0."
10923  CALL flagerror(local_error,err,error,*999)
10924  ENDIF
10925  ELSE
10926  CALL flagerror("The linear iterative solver is not a GMRES linear iterative solver.",err,error,*999)
10927  ENDIF
10928  ELSE
10929  CALL flagerror("The solver linear solver iterative solver is not associated.",err,error,*999)
10930  ENDIF
10931  ELSE
10932  CALL flagerror("The solver is not a linear iterative solver.",err,error,*999)
10933  ENDIF
10934  ELSE
10935  CALL flagerror("The solver linear solver is not associated.",err,error,*999)
10936  ENDIF
10937  ELSE
10938  CALL flagerror("The solver is not a linear solver.",err,error,*999)
10939  ENDIF
10940  ENDIF
10941  ELSE
10942  CALL flagerror("Solver is not associated.",err,error,*999)
10943  ENDIF
10944 
10945  exits("SOLVER_LINEAR_ITERATIVE_GMRES_RESTART_SET")
10946  RETURN
10947 999 errorsexits("SOLVER_LINEAR_ITERATIVE_GMRES_RESTART_SET",err,error)
10948  RETURN 1
10949 
10950  END SUBROUTINE solver_linear_iterative_gmres_restart_set
10951 
10952  !
10953  !================================================================================================================================
10954  !
10955 
10957  SUBROUTINE solver_linear_iterative_initialise(LINEAR_SOLVER,ERR,ERROR,*)
10958 
10959  !Argument variables
10960  TYPE(linear_solver_type), POINTER :: LINEAR_SOLVER
10961  INTEGER(INTG), INTENT(OUT) :: ERR
10962  TYPE(varying_string), INTENT(OUT) :: ERROR
10963  !Local Variables
10964  INTEGER(INTG) :: DUMMY_ERR
10965  TYPE(varying_string) :: DUMMY_ERROR
10966 
10967  enters("SOLVER_LINEAR_ITERATIVE_INITIALISE",err,error,*998)
10968 
10969  IF(ASSOCIATED(linear_solver)) THEN
10970  IF(ASSOCIATED(linear_solver%ITERATIVE_SOLVER)) THEN
10971  CALL flagerror("Iterative solver is already associated for this linear solver.",err,error,*998)
10972  ELSE
10973  !Allocate and initialise an iterative solver
10974  ALLOCATE(linear_solver%ITERATIVE_SOLVER,stat=err)
10975  IF(err/=0) CALL flagerror("Could not allocate linear solver iterative solver.",err,error,*999)
10976  linear_solver%ITERATIVE_SOLVER%LINEAR_SOLVER=>linear_solver
10977  linear_solver%ITERATIVE_SOLVER%SOLVER_LIBRARY=solver_petsc_library
10978  linear_solver%ITERATIVE_SOLVER%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
10979  linear_solver%ITERATIVE_SOLVER%ITERATIVE_SOLVER_TYPE=solver_iterative_gmres
10980  linear_solver%ITERATIVE_SOLVER%ITERATIVE_PRECONDITIONER_TYPE=solver_iterative_jacobi_preconditioner
10981  linear_solver%ITERATIVE_SOLVER%SOLUTION_INITIALISE_TYPE=solver_solution_initialise_current_field
10982  linear_solver%ITERATIVE_SOLVER%MAXIMUM_NUMBER_OF_ITERATIONS=100000
10983  linear_solver%ITERATIVE_SOLVER%RELATIVE_TOLERANCE=1.0e-05_dp
10984  linear_solver%ITERATIVE_SOLVER%ABSOLUTE_TOLERANCE=1.0e-10_dp
10985  linear_solver%ITERATIVE_SOLVER%DIVERGENCE_TOLERANCE=1.0e5_dp
10986  linear_solver%ITERATIVE_SOLVER%GMRES_RESTART=30
10987  CALL petsc_pcinitialise(linear_solver%ITERATIVE_SOLVER%PC,err,error,*999)
10988  CALL petsc_kspinitialise(linear_solver%ITERATIVE_SOLVER%KSP,err,error,*999)
10989  ENDIF
10990  ELSE
10991  CALL flagerror("Linear solver is not associated.",err,error,*998)
10992  ENDIF
10993 
10994  exits("SOLVER_LINEAR_ITERATIVE_INITIALISE")
10995  RETURN
10996 999 CALL solver_linear_iterative_finalise(linear_solver%ITERATIVE_SOLVER,dummy_err,dummy_error,*998)
10997 998 errorsexits("SOLVER_LINEAR_ITERATIVE_INITIALISE",err,error)
10998  RETURN 1
10999 
11000  END SUBROUTINE solver_linear_iterative_initialise
11001 
11002  !
11003  !================================================================================================================================
11004  !
11005 
11007  SUBROUTINE solver_linear_iterative_library_type_get(ITERATIVE_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
11008 
11009  !Argument variables
11010  TYPE(linear_iterative_solver_type), POINTER :: ITERATIVE_SOLVER
11011  INTEGER(INTG), INTENT(OUT) :: SOLVER_LIBRARY_TYPE
11012  INTEGER(INTG), INTENT(OUT) :: ERR
11013  TYPE(varying_string), INTENT(OUT) :: ERROR
11014  !Local Variables
11015  TYPE(varying_string) :: LOCAL_ERROR
11016 
11017  enters("SOLVER_LINEAR_ITERATIVE_LIBRARY_TYPE_GET",err,error,*999)
11018 
11019  IF(ASSOCIATED(iterative_solver)) THEN
11020  SELECT CASE(iterative_solver%ITERATIVE_SOLVER_TYPE)
11021  CASE(solver_iterative_richardson)
11022  solver_library_type=iterative_solver%SOLVER_LIBRARY
11023  CASE(solver_iterative_chebyshev)
11024  solver_library_type=iterative_solver%SOLVER_LIBRARY
11025  CASE(solver_iterative_conjugate_gradient)
11026  solver_library_type=iterative_solver%SOLVER_LIBRARY
11027  CASE(solver_iterative_gmres)
11028  solver_library_type=iterative_solver%SOLVER_LIBRARY
11029  CASE(solver_iterative_bicgstab)
11030  solver_library_type=iterative_solver%SOLVER_LIBRARY
11031  CASE(solver_iterative_conjgrad_squared)
11032  solver_library_type=iterative_solver%SOLVER_LIBRARY
11033  CASE DEFAULT
11034  local_error="The iterative linear solver type of "// &
11035  & trim(numbertovstring(iterative_solver%ITERATIVE_SOLVER_TYPE,"*",err,error))//" is invalid."
11036  CALL flagerror(local_error,err,error,*999)
11037  END SELECT
11038  ELSE
11039  CALL flagerror("Iterative linear solver is not associated.",err,error,*999)
11040  ENDIF
11041 
11042  exits("SOLVER_LINEAR_ITERATIVE_LIBRARY_TYPE_GET")
11043  RETURN
11044 999 errorsexits("SOLVER_LINEAR_ITERATIVE_LIBRARY_TYPE_GET",err,error)
11045  RETURN 1
11046 
11047  END SUBROUTINE solver_linear_iterative_library_type_get
11048 
11049  !
11050  !================================================================================================================================
11051  !
11052 
11054  SUBROUTINE solver_linear_iterative_library_type_set(ITERATIVE_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
11055 
11056  !Argument variables
11057  TYPE(linear_iterative_solver_type), POINTER :: ITERATIVE_SOLVER
11058  INTEGER(INTG), INTENT(IN) :: SOLVER_LIBRARY_TYPE
11059  INTEGER(INTG), INTENT(OUT) :: ERR
11060  TYPE(varying_string), INTENT(OUT) :: ERROR
11061  !Local Variables
11062  TYPE(varying_string) :: LOCAL_ERROR
11063 
11064  enters("SOLVER_LINEAR_ITERATIVE_LIBRARY_TYPE_SET",err,error,*999)
11065 
11066  IF(ASSOCIATED(iterative_solver)) THEN
11067  SELECT CASE(iterative_solver%ITERATIVE_SOLVER_TYPE)
11068  CASE(solver_iterative_richardson)
11069  SELECT CASE(solver_library_type)
11070  CASE(solver_cmiss_library)
11071  CALL flagerror("Not implemented.",err,error,*999)
11072  CASE(solver_petsc_library)
11073  iterative_solver%SOLVER_LIBRARY=solver_petsc_library
11074  iterative_solver%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
11075  CASE DEFAULT
11076  local_error="The specified solver library type of "// &
11077  & trim(numbertovstring(solver_library_type,"*",err,error))// &
11078  & " is invalid for a Richardson iterative linear solver."
11079  END SELECT
11080  CASE(solver_iterative_chebyshev)
11081  SELECT CASE(solver_library_type)
11082  CASE(solver_cmiss_library)
11083  CALL flagerror("Not implemented.",err,error,*999)
11084  CASE(solver_petsc_library)
11085  iterative_solver%SOLVER_LIBRARY=solver_petsc_library
11086  iterative_solver%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
11087  CASE DEFAULT
11088  local_error="The specified solver library type of "// &
11089  & trim(numbertovstring(solver_library_type,"*",err,error))// &
11090  & " is invalid for a Chebychev iterative linear solver."
11091  END SELECT
11092  CASE(solver_iterative_conjugate_gradient)
11093  SELECT CASE(solver_library_type)
11094  CASE(solver_cmiss_library)
11095  CALL flagerror("Not implemented.",err,error,*999)
11096  CASE(solver_petsc_library)
11097  iterative_solver%SOLVER_LIBRARY=solver_petsc_library
11098  iterative_solver%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
11099  CASE DEFAULT
11100  local_error="The specified solver library type of "// &
11101  & trim(numbertovstring(solver_library_type,"*",err,error))// &
11102  & " is invalid for a Conjugate gradient iterative linear solver."
11103  END SELECT
11104  CASE(solver_iterative_gmres)
11105  SELECT CASE(solver_library_type)
11106  CASE(solver_cmiss_library)
11107  CALL flagerror("Not implemented.",err,error,*999)
11108  CASE(solver_petsc_library)
11109  iterative_solver%SOLVER_LIBRARY=solver_petsc_library
11110  iterative_solver%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
11111  CASE DEFAULT
11112  local_error="The specified solver library type of "// &
11113  & trim(numbertovstring(solver_library_type,"*",err,error))// &
11114  & " is invalid for a GMRES iterative linear solver."
11115  END SELECT
11116  CASE(solver_iterative_bicgstab)
11117  SELECT CASE(solver_library_type)
11118  CASE(solver_cmiss_library)
11119  CALL flagerror("Not implemented.",err,error,*999)
11120  CASE(solver_petsc_library)
11121  iterative_solver%SOLVER_LIBRARY=solver_petsc_library
11122  iterative_solver%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
11123  CASE DEFAULT
11124  local_error="The specified solver library type of "// &
11125  & trim(numbertovstring(solver_library_type,"*",err,error))// &
11126  & " is invalid for a BiCGSTAB iterative linear solver."
11127  END SELECT
11128  CASE(solver_iterative_conjgrad_squared)
11129  SELECT CASE(solver_library_type)
11130  CASE(solver_cmiss_library)
11131  CALL flagerror("Not implemented.",err,error,*999)
11132  CASE(solver_petsc_library)
11133  iterative_solver%SOLVER_LIBRARY=solver_petsc_library
11134  iterative_solver%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
11135  CASE DEFAULT
11136  local_error="The specified solver library type of "// &
11137  & trim(numbertovstring(solver_library_type,"*",err,error))// &
11138  & " is invalid for a Conjugate gradient squared iterative linear solver."
11139  END SELECT
11140  CASE DEFAULT
11141  local_error="The iterative linear solver type of "// &
11142  & trim(numbertovstring(iterative_solver%ITERATIVE_SOLVER_TYPE,"*",err,error))//" is invalid."
11143  CALL flagerror(local_error,err,error,*999)
11144  END SELECT
11145  ELSE
11146  CALL flagerror("Iterative linear solver is not associated.",err,error,*999)
11147  ENDIF
11148 
11149  exits("SOLVER_LINEAR_ITERATIVE_LIBRARY_TYPE_SET")
11150  RETURN
11151 999 errorsexits("SOLVER_LINEAR_ITERATIVE_LIBRARY_TYPE_SET",err,error)
11152  RETURN 1
11153 
11154  END SUBROUTINE solver_linear_iterative_library_type_set
11155 
11156  !
11157  !================================================================================================================================
11158  !
11159 
11161  SUBROUTINE solver_lineariterativematriceslibrarytypeget(ITERATIVE_SOLVER,MATRICES_LIBRARY_TYPE,ERR,ERROR,*)
11162 
11163  !Argument variables
11164  TYPE(linear_iterative_solver_type), POINTER :: ITERATIVE_SOLVER
11165  INTEGER(INTG), INTENT(OUT) :: MATRICES_LIBRARY_TYPE
11166  INTEGER(INTG), INTENT(OUT) :: ERR
11167  TYPE(varying_string), INTENT(OUT) :: ERROR
11168  !Local Variables
11169 
11170  enters("Solver_LinearIterativeMatricesLibraryTypeGet",err,error,*999)
11171 
11172  IF(ASSOCIATED(iterative_solver)) THEN
11173  matrices_library_type=iterative_solver%SOLVER_MATRICES_LIBRARY
11174  ELSE
11175  CALL flagerror("Iterative linear solver is not associated.",err,error,*999)
11176  ENDIF
11177 
11178  exits("Solver_LinearIterativeMatricesLibraryTypeGet")
11179  RETURN
11180 999 errors("Solver_LinearIterativeMatricesLibraryTypeGet",err,error)
11181  exits("Solver_LinearIterativeMatricesLibraryTypeGet")
11182  RETURN 1
11183 
11184  END SUBROUTINE solver_lineariterativematriceslibrarytypeget
11185 
11186  !
11187  !================================================================================================================================
11188  !
11189 
11191  SUBROUTINE solver_lineariterativemaximumiterationsset(SOLVER,MAXIMUM_ITERATIONS,ERR,ERROR,*)
11192 
11193  !Argument variables
11194  TYPE(solver_type), POINTER :: SOLVER
11195  INTEGER(INTG), INTENT(IN) :: MAXIMUM_ITERATIONS
11196  INTEGER(INTG), INTENT(OUT) :: ERR
11197  TYPE(varying_string), INTENT(OUT) :: ERROR
11198  !Local Variables
11199  TYPE(varying_string) :: LOCAL_ERROR
11200 
11201  enters("Solver_LinearIterativeMaximumIterationsSet",err,error,*999)
11202 
11203  IF(ASSOCIATED(solver)) THEN
11204  IF(solver%SOLVER_FINISHED) THEN
11205  CALL flagerror("Solver has already been finished.",err,error,*999)
11206  ELSE
11207  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
11208  IF(ASSOCIATED(solver%LINEAR_SOLVER)) THEN
11209  IF(solver%LINEAR_SOLVER%LINEAR_SOLVE_TYPE==solver_linear_iterative_solve_type) THEN
11210  IF(ASSOCIATED(solver%LINEAR_SOLVER%ITERATIVE_SOLVER)) THEN
11211  IF(maximum_iterations>0) THEN
11212  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%MAXIMUM_NUMBER_OF_ITERATIONS=maximum_iterations
11213  ELSE
11214  local_error="The specified maximum iterations of "//trim(numbertovstring(maximum_iterations,"*",err,error))// &
11215  & " is invalid. The maximum number of iterations must be > 0."
11216  CALL flagerror(local_error,err,error,*999)
11217  ENDIF
11218  ELSE
11219  CALL flagerror("The solver linear solver iterative solver is not associated.",err,error,*999)
11220  ENDIF
11221  ELSE
11222  CALL flagerror("The solver is not a linear iterative solver.",err,error,*999)
11223  ENDIF
11224  ELSE
11225  CALL flagerror("The solver linear solver is not associated.",err,error,*999)
11226  ENDIF
11227  ELSE
11228  CALL flagerror("The solver is not a linear solver.",err,error,*999)
11229  ENDIF
11230  ENDIF
11231  ELSE
11232  CALL flagerror("Solver is not associated.",err,error,*999)
11233  ENDIF
11234 
11235  exits("Solver_LinearIterativeMaximumIterationsSet")
11236  RETURN
11237 999 errorsexits("Solver_LinearIterativeMaximumIterationsSet",err,error)
11238  RETURN 1
11239 
11240  END SUBROUTINE solver_lineariterativemaximumiterationsset
11241 
11242  !
11243  !================================================================================================================================
11244  !
11245 
11247  SUBROUTINE solver_lineariterativepreconditionertypeset(SOLVER,ITERATIVE_PRECONDITIONER_TYPE,ERR,ERROR,*)
11248 
11249  !Argument variables
11250  TYPE(solver_type), POINTER :: SOLVER
11251  INTEGER(INTG), INTENT(IN) :: ITERATIVE_PRECONDITIONER_TYPE
11252  INTEGER(INTG), INTENT(OUT) :: ERR
11253  TYPE(varying_string), INTENT(OUT) :: ERROR
11254  !Local Variables
11255  TYPE(varying_string) :: LOCAL_ERROR
11256 
11257  enters("Solver_LinearIterativePreconditionerTypeSet",err,error,*999)
11258 
11259  IF(ASSOCIATED(solver)) THEN
11260  IF(solver%SOLVER_FINISHED) THEN
11261  CALL flagerror("Solver has already been finished.",err,error,*999)
11262  ELSE
11263  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
11264  IF(ASSOCIATED(solver%LINEAR_SOLVER)) THEN
11265  IF(solver%LINEAR_SOLVER%LINEAR_SOLVE_TYPE==solver_linear_iterative_solve_type) THEN
11266  IF(ASSOCIATED(solver%LINEAR_SOLVER%ITERATIVE_SOLVER)) THEN
11267  IF(iterative_preconditioner_type/=solver%LINEAR_SOLVER%ITERATIVE_SOLVER%ITERATIVE_PRECONDITIONER_TYPE) THEN
11268  !Intialise the new preconditioner type
11269  SELECT CASE(solver%LINEAR_SOLVER%ITERATIVE_SOLVER%SOLVER_LIBRARY)
11270  CASE(solver_petsc_library)
11271  SELECT CASE(iterative_preconditioner_type)
11272  CASE(solver_iterative_no_preconditioner)
11273  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%ITERATIVE_PRECONDITIONER_TYPE=solver_iterative_no_preconditioner
11274  CASE(solver_iterative_jacobi_preconditioner)
11275  CALL flagerror("Iterative Jacobi preconditioning is not implemented for a PETSc library.",err,error,*999)
11276  CASE(solver_iterative_block_jacobi_preconditioner)
11277  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%ITERATIVE_PRECONDITIONER_TYPE= &
11278  & solver_iterative_block_jacobi_preconditioner
11279  CASE(solver_iterative_sor_preconditioner)
11280  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%ITERATIVE_PRECONDITIONER_TYPE= &
11281  & solver_iterative_sor_preconditioner
11282  CASE(solver_iterative_incomplete_cholesky_preconditioner)
11283  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%ITERATIVE_PRECONDITIONER_TYPE= &
11284  & solver_iterative_incomplete_cholesky_preconditioner
11285  CASE(solver_iterative_incomplete_lu_preconditioner)
11286  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%ITERATIVE_PRECONDITIONER_TYPE= &
11287  & solver_iterative_incomplete_lu_preconditioner
11288  CASE(solver_iterative_additive_schwarz_preconditioner)
11289  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%ITERATIVE_PRECONDITIONER_TYPE= &
11290  & solver_iterative_additive_schwarz_preconditioner
11291  CASE DEFAULT
11292  local_error="The iterative preconditioner type of "// &
11293  & trim(numbertovstring(iterative_preconditioner_type,"*",err,error))//" is invalid."
11294  CALL flagerror(local_error,err,error,*999)
11295  END SELECT
11296  CASE DEFAULT
11297  local_error="The solver library type of "// &
11298  & trim(numbertovstring(solver%LINEAR_SOLVER%ITERATIVE_SOLVER%SOLVER_LIBRARY,"*",err,error))// &
11299  & " is invalid."
11300  CALL flagerror(local_error,err,error,*999)
11301  END SELECT
11302  ENDIF
11303  ELSE
11304  CALL flagerror("The solver linear solver iterative solver is not associated.",err,error,*999)
11305  ENDIF
11306  ELSE
11307  CALL flagerror("The solver is not a linear iterative solver.",err,error,*999)
11308  ENDIF
11309  ELSE
11310  CALL flagerror("The solver linear solver is not associated.",err,error,*999)
11311  ENDIF
11312  ELSE
11313  CALL flagerror("The solver is not a linear solver.",err,error,*999)
11314  ENDIF
11315  ENDIF
11316  ELSE
11317  CALL flagerror("Solver is not associated.",err,error,*999)
11318  ENDIF
11319 
11320  exits("Solver_LinearIterativePreconditionerTypeSet")
11321  RETURN
11322 999 errorsexits("Solver_LinearIterativePreconditionerTypeSet",err,error)
11323  RETURN 1
11324 
11325  END SUBROUTINE solver_lineariterativepreconditionertypeset
11326 
11327  !
11328  !================================================================================================================================
11329  !
11330 
11332  SUBROUTINE solver_lineariterativerelativetoleranceset(SOLVER,RELATIVE_TOLERANCE,ERR,ERROR,*)
11333 
11334  !Argument variables
11335  TYPE(solver_type), POINTER :: SOLVER
11336  REAL(DP), INTENT(IN) :: RELATIVE_TOLERANCE
11337  INTEGER(INTG), INTENT(OUT) :: ERR
11338  TYPE(varying_string), INTENT(OUT) :: ERROR
11339  !Local Variables
11340  TYPE(varying_string) :: LOCAL_ERROR
11341 
11342  enters("Solver_LinearIterativeRelativeToleranceSet",err,error,*999)
11343 
11344  IF(ASSOCIATED(solver)) THEN
11345  IF(solver%SOLVER_FINISHED) THEN
11346  CALL flagerror("Solver has already been finished.",err,error,*999)
11347  ELSE
11348  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
11349  IF(ASSOCIATED(solver%LINEAR_SOLVER)) THEN
11350  IF(solver%LINEAR_SOLVER%LINEAR_SOLVE_TYPE==solver_linear_iterative_solve_type) THEN
11351  IF(ASSOCIATED(solver%LINEAR_SOLVER%ITERATIVE_SOLVER)) THEN
11352  IF(relative_tolerance>zero_tolerance) THEN
11353  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%RELATIVE_TOLERANCE=relative_tolerance
11354  ELSE
11355  local_error="The specified relative tolerance of "//trim(numbertovstring(relative_tolerance,"*",err,error))// &
11356  & " is invalid. The relative tolerance must be > 0."
11357  CALL flagerror(local_error,err,error,*999)
11358  ENDIF
11359  ELSE
11360  CALL flagerror("The solver linear solver iterative solver is not associated.",err,error,*999)
11361  ENDIF
11362  ELSE
11363  CALL flagerror("The solver is not a linear iterative solver.",err,error,*999)
11364  ENDIF
11365  ELSE
11366  CALL flagerror("The solver linear solver is not associated.",err,error,*999)
11367  ENDIF
11368  ELSE
11369  CALL flagerror("The solver is not a linear solver.",err,error,*999)
11370  ENDIF
11371  ENDIF
11372  ELSE
11373  CALL flagerror("Solver is not associated.",err,error,*999)
11374  ENDIF
11375 
11376  exits("Solver_LinearIterativeRelativeToleranceSet")
11377  RETURN
11378 999 errorsexits("Solver_LinearIterativeRelativeToleranceSet",err,error)
11379  RETURN 1
11380 
11381  END SUBROUTINE solver_lineariterativerelativetoleranceset
11382 
11383  !
11384  !================================================================================================================================
11385  !
11386 
11388  SUBROUTINE solver_lineariterativesolutioninittypeset(SOLVER,SOLUTION_INITIALISE_TYPE,ERR,ERROR,*)
11389 
11390  !Argument variables
11391  TYPE(solver_type), POINTER :: SOLVER
11392  INTEGER(INTG), INTENT(IN) :: SOLUTION_INITIALISE_TYPE
11393  INTEGER(INTG), INTENT(OUT) :: ERR
11394  TYPE(varying_string), INTENT(OUT) :: ERROR
11395  !Local Variables
11396  TYPE(varying_string) :: LOCAL_ERROR
11397 
11398  enters("Solver_LinearIterativeSolutionInitTypeSet",err,error,*999)
11399 
11400  IF(ASSOCIATED(solver)) THEN
11401  IF(solver%SOLVER_FINISHED) THEN
11402  CALL flagerror("Solver has already been finished.",err,error,*999)
11403  ELSE
11404  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
11405  IF(ASSOCIATED(solver%LINEAR_SOLVER)) THEN
11406  IF(solver%LINEAR_SOLVER%LINEAR_SOLVE_TYPE==solver_linear_iterative_solve_type) THEN
11407  IF(ASSOCIATED(solver%LINEAR_SOLVER%ITERATIVE_SOLVER)) THEN
11408  SELECT CASE(solution_initialise_type)
11409  CASE(solver_solution_initialise_zero)
11410  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%SOLUTION_INITIALISE_TYPE=solver_solution_initialise_zero
11411  CASE(solver_solution_initialise_current_field)
11412  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%SOLUTION_INITIALISE_TYPE=solver_solution_initialise_current_field
11413  CASE(solver_solution_initialise_no_change)
11414  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%SOLUTION_INITIALISE_TYPE=solver_solution_initialise_no_change
11415  CASE DEFAULT
11416  local_error="The specified solution initialise type of "// &
11417  & trim(numbertovstring(solution_initialise_type,"*",err,error))//" is invalid."
11418  CALL flagerror(local_error,err,error,*999)
11419  END SELECT
11420  ELSE
11421  CALL flagerror("The solver linear solver iterative solver is not associated.",err,error,*999)
11422  ENDIF
11423  ELSE
11424  CALL flagerror("The solver is not a linear iterative solver.",err,error,*999)
11425  ENDIF
11426  ELSE
11427  CALL flagerror("The solver linear solver is not associated.",err,error,*999)
11428  ENDIF
11429  ELSE
11430  CALL flagerror("The solver is not a linear solver.",err,error,*999)
11431  ENDIF
11432  ENDIF
11433  ELSE
11434  CALL flagerror("Solver is not associated.",err,error,*999)
11435  ENDIF
11436 
11437  exits("Solver_LinearIterativeSolutionInitTypeSet")
11438  RETURN
11439 999 errorsexits("Solver_LinearIterativeSolutionInitTypeSet",err,error)
11440  RETURN 1
11441 
11442  END SUBROUTINE solver_lineariterativesolutioninittypeset
11443 
11444  !
11445  !================================================================================================================================
11446  !
11447 
11449  SUBROUTINE solver_linear_iterative_solve(LINEAR_ITERATIVE_SOLVER,ERR,ERROR,*)
11450 
11451  !Argument variables
11452  TYPE(linear_iterative_solver_type), POINTER :: LINEAR_ITERATIVE_SOLVER
11453  INTEGER(INTG), INTENT(OUT) :: ERR
11454  TYPE(varying_string), INTENT(OUT) :: ERROR
11455  !Local Variables
11456  INTEGER(INTG) :: CONVERGED_REASON,global_row,local_row,NUMBER_ITERATIONS,STORAGE_TYPE
11457  REAL(DP) :: RESIDUAL_NORM,SOLVER_VALUE,VALUE
11458  REAL(DP), POINTER :: RHS_DATA(:)
11459  TYPE(distributed_vector_type), POINTER :: RHS_VECTOR,SOLVER_VECTOR
11460  TYPE(domain_mapping_type), POINTER :: ROW_DOFS_MAPPING
11461  TYPE(linear_solver_type), POINTER :: LINEAR_SOLVER
11462  TYPE(solver_type), POINTER :: SOLVER
11463  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
11464  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
11465  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
11466  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
11467  TYPE(varying_string) :: LOCAL_ERROR
11468 
11469  enters("SOLVER_LINEAR_ITERATIVE_SOLVE",err,error,*999)
11470 
11471  IF(ASSOCIATED(linear_iterative_solver)) THEN
11472  linear_solver=>linear_iterative_solver%LINEAR_SOLVER
11473  IF(ASSOCIATED(linear_solver)) THEN
11474  solver=>linear_solver%SOLVER
11475  IF(ASSOCIATED(solver)) THEN
11476  solver_equations=>solver%SOLVER_EQUATIONS
11477  IF(ASSOCIATED(solver_equations)) THEN
11478  solver_matrices=>solver_equations%SOLVER_MATRICES
11479  IF(ASSOCIATED(solver_matrices)) THEN
11480  IF(solver_matrices%NUMBER_OF_MATRICES==1) THEN
11481  solver_matrix=>solver_matrices%MATRICES(1)%PTR
11482  IF(ASSOCIATED(solver_matrix)) THEN
11483  rhs_vector=>solver_matrices%RHS_VECTOR
11484  IF(ASSOCIATED(rhs_vector)) THEN
11485  solver_vector=>solver_matrices%MATRICES(1)%PTR%SOLVER_VECTOR
11486  IF(ASSOCIATED(solver_vector)) THEN
11487  CALL distributed_matrix_storage_type_get(solver_matrix%MATRIX,storage_type,err,error,*999)
11488  IF(storage_type==distributed_matrix_diagonal_storage_type) THEN
11489  solver_mapping=>solver_equations%SOLVER_MAPPING
11490  IF(ASSOCIATED(solver_mapping)) THEN
11491  row_dofs_mapping=>solver_mapping%ROW_DOFS_MAPPING
11492  IF(ASSOCIATED(row_dofs_mapping)) THEN
11493  CALL distributed_vector_data_get(rhs_vector,rhs_data,err,error,*999)
11494  DO local_row=1,solver_mapping%NUMBER_OF_ROWS
11495  global_row=row_dofs_mapping%LOCAL_TO_GLOBAL_MAP(local_row)
11496  CALL distributed_matrix_values_get(solver_matrix%MATRIX,local_row,global_row,VALUE,err,error,*999)
11497  IF(abs(VALUE)>zero_tolerance) THEN
11498  solver_value=rhs_data(local_row)/VALUE
11499  CALL distributed_vector_values_set(solver_vector,local_row,solver_value,err,error,*999)
11500  ELSE
11501  local_error="The linear solver matrix has a zero pivot on row "// &
11502  & trim(numbertovstring(local_row,"*",err,error))//"."
11503  CALL flagerror(local_error,err,error,*999)
11504  ENDIF
11505  ENDDO !matrix_idx
11506  CALL distributed_vector_data_restore(rhs_vector,rhs_data,err,error,*999)
11507  ELSE
11508  CALL flagerror("Solver mapping row dofs mapping is not associated.",err,error,*999)
11509  ENDIF
11510  ELSE
11511  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
11512  ENDIF
11513  ELSE
11514  SELECT CASE(linear_iterative_solver%SOLVER_LIBRARY)
11515  CASE(solver_cmiss_library)
11516  CALL flagerror("Not implemented.",err,error,*999)
11517  CASE(solver_petsc_library)
11518  IF(ASSOCIATED(rhs_vector%PETSC)) THEN
11519  IF(ASSOCIATED(solver_vector%PETSC)) THEN
11520  SELECT CASE(linear_iterative_solver%SOLUTION_INITIALISE_TYPE)
11521  CASE(solver_solution_initialise_zero)
11522  !Zero the solution vector
11523  CALL distributed_vector_all_values_set(solver_vector,0.0_dp,err,error,*999)
11524  !Tell PETSc that the solution vector is zero
11525  CALL petsc_kspsetinitialguessnonzero(linear_iterative_solver%KSP,.false.,err,error,*999)
11526  CASE(solver_solution_initialise_current_field)
11527  !Make sure the solver vector contains the current dependent field values
11528  CALL solver_solution_update(solver,err,error,*999)
11529  !Tell PETSc that the solution vector is nonzero
11530  CALL petsc_kspsetinitialguessnonzero(linear_iterative_solver%KSP,.true.,err,error,*999)
11531  CASE(solver_solution_initialise_no_change)
11532  !Do nothing
11533  CASE DEFAULT
11534  local_error="The linear iterative solver solution initialise type of "// &
11535  & trim(numbertovstring(linear_iterative_solver%SOLUTION_INITIALISE_TYPE,"*",err,error))// &
11536  & " is invalid."
11537  CALL flagerror(local_error,err,error,*999)
11538  END SELECT
11539  !Solver the linear system
11540 #ifdef TAUPROF
11541  CALL tau_static_phase_start("KSPSOLVE")
11542 #endif
11543  CALL petsc_kspsolve(linear_iterative_solver%KSP,rhs_vector%PETSC%VECTOR,solver_vector%PETSC%VECTOR, &
11544  & err,error,*999)
11545 #ifdef TAUPROF
11546  CALL tau_static_phase_stop("KSPSOLVE")
11547 #endif
11548  !Check for convergence
11549  CALL petsc_kspgetconvergedreason(linear_iterative_solver%KSP,converged_reason,err,error,*999)
11550  SELECT CASE(converged_reason)
11551  CASE(petsc_ksp_diverged_null)
11552  CALL flag_warning("Linear iterative solver did not converge. PETSc diverged null.",err,error,*999)
11553  CASE(petsc_ksp_diverged_its)
11554  CALL flag_warning("Linear iterative solver did not converge. PETSc diverged its.",err,error,*999)
11555  CASE(petsc_ksp_diverged_dtol)
11556  CALL flag_warning("Linear iterative solver did not converge. PETSc diverged dtol.",err,error,*999)
11557  CASE(petsc_ksp_diverged_breakdown)
11558  CALL flag_warning("Linear iterative solver did not converge. PETSc diverged breakdown.", &
11559  & err,error,*999)
11560  CASE(petsc_ksp_diverged_breakdown_bicg)
11561  CALL flag_warning("Linear iterative solver did not converge. PETSc diverged breakdown BiCG.", &
11562  & err,error,*999)
11563  CASE(petsc_ksp_diverged_nonsymmetric)
11564  CALL flag_warning("Linear iterative solver did not converge. PETSc diverged nonsymmetric.", &
11565  & err,error,*999)
11566  CASE(petsc_ksp_diverged_indefinite_pc)
11567  CALL flag_warning("Linear iterative solver did not converge. PETSc diverged indefinite PC.", &
11568  & err,error,*999)
11569  CASE(petsc_ksp_diverged_nanorinf)
11570  CALL flag_warning("Linear iterative solver did not converge. PETSc diverged NaN or Inf.", &
11571  & err,error,*999)
11572  CASE(petsc_ksp_diverged_indefinite_mat)
11573  CALL flag_warning("Linear iterative solver did not converge. PETSc diverged indefinite mat.", &
11574  & err,error,*999)
11575  END SELECT
11576  IF(solver%OUTPUT_TYPE>=solver_solver_output) THEN
11577  !Output solution characteristics
11578  CALL write_string(general_output_type,"",err,error,*999)
11579  CALL write_string(general_output_type,"Linear iterative solver parameters:",err,error,*999)
11580  CALL petsc_kspgetiterationnumber(linear_iterative_solver%KSP,number_iterations,err,error,*999)
11581  CALL write_string_value(general_output_type,"Final number of iterations = ",number_iterations, &
11582  & err,error,*999)
11583  CALL petsc_kspgetresidualnorm(linear_iterative_solver%KSP,residual_norm,err,error,*999)
11584  CALL write_string_value(general_output_type,"Final residual norm = ",residual_norm, &
11585  & err,error,*999)
11586  SELECT CASE(converged_reason)
11587  CASE(petsc_ksp_converged_rtol)
11588  CALL write_string(general_output_type,"Converged Reason = PETSc converged RTol",err,error,*999)
11589  CASE(petsc_ksp_converged_atol)
11590  CALL write_string(general_output_type,"Converged Reason = PETSc converged ATol",err,error,*999)
11591  CASE(petsc_ksp_converged_its)
11592  CALL write_string(general_output_type,"Converged Reason = PETSc converged its",err,error,*999)
11593  CASE(petsc_ksp_converged_cg_neg_curve)
11594  CALL write_string(general_output_type,"Converged Reason = PETSc converged CG neg curve", &
11595  & err,error,*999)
11596  CASE(petsc_ksp_converged_cg_constrained)
11597  CALL write_string(general_output_type,"Converged Reason = PETSc converged CG constrained", &
11598  & err,error,*999)
11599  CASE(petsc_ksp_converged_step_length)
11600  CALL write_string(general_output_type,"Converged Reason = PETSc converged step length", &
11601  & err,error,*999)
11602  CASE(petsc_ksp_converged_happy_breakdown)
11603  CALL write_string(general_output_type,"Converged Reason = PETSc converged happy breakdown", &
11604  & err,error,*999)
11605  CASE(petsc_ksp_converged_iterating)
11606  CALL write_string(general_output_type,"Converged Reason = PETSc converged iterating", &
11607  & err,error,*999)
11608  END SELECT
11609  ENDIF
11610  ELSE
11611  CALL flagerror("Solver vector PETSc vector is not associated.",err,error,*999)
11612  ENDIF
11613  ELSE
11614  CALL flagerror("RHS vector petsc PETSc is not associated.",err,error,*999)
11615  ENDIF
11616  CASE DEFAULT
11617  local_error="The solver library type of "// &
11618  & trim(numbertovstring(linear_iterative_solver%SOLVER_LIBRARY,"*",err,error))//" is invalid."
11619  CALL flagerror(local_error,err,error,*999)
11620  END SELECT
11621  ENDIF
11622  ELSE
11623  CALL flagerror("Solver vector is not associated.",err,error,*999)
11624  ENDIF
11625  ELSE
11626  CALL flagerror("RHS vector is not associated.",err,error,*999)
11627  ENDIF
11628  ELSE
11629  CALL flagerror("Solver matrix is not associated.",err,error,*999)
11630  ENDIF
11631  ELSE
11632  local_error="The given number of solver matrices of "// &
11633  & trim(numbertovstring(solver_matrices%NUMBER_OF_MATRICES,"*",err,error))// &
11634  & " is invalid. There should only be one solver matrix for a linear iterative solver."
11635  CALL flagerror(local_error,err,error,*999)
11636  ENDIF
11637  ELSE
11638  CALL flagerror("Solver solver matrices is not associated.",err,error,*999)
11639  ENDIF
11640  ELSE
11641  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
11642  ENDIF
11643  ELSE
11644  CALL flagerror("Linear solver solver is not associated.",err,error,*999)
11645  ENDIF
11646  ELSE
11647  CALL flagerror("Linear itreative solver linear solver is not associated.",err,error,*999)
11648  ENDIF
11649  ELSE
11650  CALL flagerror("Linear iterative solver is not associated.",err,error,*999)
11651  ENDIF
11652 
11653  exits("SOLVER_LINEAR_ITERATIVE_SOLVE")
11654  RETURN
11655 999 errorsexits("SOLVER_LINEAR_ITERATIVE_SOLVE",err,error)
11656  RETURN 1
11657 
11658  END SUBROUTINE solver_linear_iterative_solve
11659 
11660  !
11661  !================================================================================================================================
11662  !
11663 
11665  SUBROUTINE solver_linear_iterative_type_set(SOLVER,ITERATIVE_SOLVER_TYPE,ERR,ERROR,*)
11666 
11667  !Argument variables
11668  TYPE(solver_type), POINTER :: SOLVER
11669  INTEGER(INTG), INTENT(IN) :: ITERATIVE_SOLVER_TYPE
11670  INTEGER(INTG), INTENT(OUT) :: ERR
11671  TYPE(varying_string), INTENT(OUT) :: ERROR
11672  !Local Variables
11673  TYPE(varying_string) :: LOCAL_ERROR
11674 
11675  enters("SOLVER_LINEAR_ITERATIVE_TYPE_SET",err,error,*999)
11676 
11677  IF(ASSOCIATED(solver)) THEN
11678  IF(solver%SOLVER_FINISHED) THEN
11679  CALL flagerror("Solver has already been finished.",err,error,*999)
11680  ELSE
11681  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
11682  IF(ASSOCIATED(solver%LINEAR_SOLVER)) THEN
11683  IF(solver%LINEAR_SOLVER%LINEAR_SOLVE_TYPE==solver_linear_iterative_solve_type) THEN
11684  IF(ASSOCIATED(solver%LINEAR_SOLVER%ITERATIVE_SOLVER)) THEN
11685  IF(iterative_solver_type/=solver%LINEAR_SOLVER%ITERATIVE_SOLVER%ITERATIVE_SOLVER_TYPE) THEN
11686  !Intialise the new solver type
11687  SELECT CASE(solver%LINEAR_SOLVER%ITERATIVE_SOLVER%SOLVER_LIBRARY)
11688  CASE(solver_petsc_library)
11689  SELECT CASE(iterative_solver_type)
11690  CASE(solver_iterative_richardson)
11691  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%ITERATIVE_SOLVER_TYPE=solver_iterative_richardson
11692  CASE(solver_iterative_chebyshev)
11693  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%ITERATIVE_SOLVER_TYPE=solver_iterative_chebyshev
11694  CASE(solver_iterative_conjugate_gradient)
11695  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%ITERATIVE_SOLVER_TYPE=solver_iterative_conjugate_gradient
11696  CASE(solver_iterative_biconjugate_gradient)
11697  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%ITERATIVE_SOLVER_TYPE=solver_iterative_biconjugate_gradient
11698  CASE(solver_iterative_gmres)
11699  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%ITERATIVE_SOLVER_TYPE=solver_iterative_gmres
11700  CASE(solver_iterative_bicgstab)
11701  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%ITERATIVE_SOLVER_TYPE=solver_iterative_bicgstab
11702  CASE(solver_iterative_conjgrad_squared)
11703  solver%LINEAR_SOLVER%ITERATIVE_SOLVER%ITERATIVE_SOLVER_TYPE=solver_iterative_conjgrad_squared
11704  CASE DEFAULT
11705  local_error="The iterative solver type of "//trim(numbertovstring(iterative_solver_type,"*",err,error))// &
11706  & " is invalid."
11707  CALL flagerror(local_error,err,error,*999)
11708  END SELECT
11709  CASE DEFAULT
11710  local_error="The solver library type of "// &
11711  & trim(numbertovstring(solver%LINEAR_SOLVER%ITERATIVE_SOLVER%SOLVER_LIBRARY,"*",err,error))// &
11712  & " is invalid."
11713  CALL flagerror(local_error,err,error,*999)
11714  END SELECT
11715  ENDIF
11716  ELSE
11717  CALL flagerror("The solver linear solver iterative solver is not associated.",err,error,*999)
11718  ENDIF
11719  ELSE
11720  CALL flagerror("The solver is not a linear iterative solver.",err,error,*999)
11721  ENDIF
11722  ELSE
11723  CALL flagerror("The solver linear solver is not associated.",err,error,*999)
11724  ENDIF
11725  ELSE
11726  CALL flagerror("The solver is not a linear solver.",err,error,*999)
11727  ENDIF
11728  ENDIF
11729  ELSE
11730  CALL flagerror("Solver is not associated.",err,error,*999)
11731  ENDIF
11732 
11733  exits("SOLVER_LINEAR_ITERATIVE_TYPE_SET")
11734  RETURN
11735 999 errorsexits("SOLVER_LINEAR_ITERATIVE_TYPE_SET",err,error)
11736  RETURN 1
11737 
11738  END SUBROUTINE solver_linear_iterative_type_set
11739 
11740  !
11741  !================================================================================================================================
11742  !
11743 
11745  SUBROUTINE solver_linear_library_type_get(LINEAR_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
11746 
11747  !Argument variables
11748  TYPE(linear_solver_type), POINTER :: LINEAR_SOLVER
11749  INTEGER(INTG), INTENT(OUT) :: SOLVER_LIBRARY_TYPE
11750  INTEGER(INTG), INTENT(OUT) :: ERR
11751  TYPE(varying_string), INTENT(OUT) :: ERROR
11752  !Local Variables
11753  TYPE(linear_direct_solver_type), POINTER :: DIRECT_SOLVER
11754  TYPE(linear_iterative_solver_type), POINTER :: ITERATIVE_SOLVER
11755  TYPE(varying_string) :: LOCAL_ERROR
11756 
11757  enters("SOLVER_LINEAR_LIBRARY_TYPE_GET",err,error,*999)
11758 
11759  IF(ASSOCIATED(linear_solver)) THEN
11760  SELECT CASE(linear_solver%LINEAR_SOLVE_TYPE)
11761  CASE(solver_linear_direct_solve_type)
11762  direct_solver=>linear_solver%DIRECT_SOLVER
11763  IF(ASSOCIATED(direct_solver)) THEN
11764  CALL solver_linear_direct_library_type_get(direct_solver,solver_library_type,err,error,*999)
11765  ELSE
11766  CALL flagerror("Linear solver direct solver is not associated.",err,error,*999)
11767  ENDIF
11768  CASE(solver_linear_iterative_solve_type)
11769  iterative_solver=>linear_solver%ITERATIVE_SOLVER
11770  IF(ASSOCIATED(iterative_solver)) THEN
11771  CALL solver_linear_iterative_library_type_get(iterative_solver,solver_library_type,err,error,*999)
11772  ELSE
11773  CALL flagerror("Linear solver iterative solver is not associated.",err,error,*999)
11774  ENDIF
11775  CASE DEFAULT
11776  local_error="The linear solver type of "//trim(numbertovstring(linear_solver%LINEAR_SOLVE_TYPE,"*",err,error))// &
11777  & " is invalid."
11778  CALL flagerror(local_error,err,error,*999)
11779  END SELECT
11780  ELSE
11781  CALL flagerror("Linear solver is not associated.",err,error,*999)
11782  ENDIF
11783 
11784  exits("SOLVER_LINEAR_LIBRARY_TYPE_GET")
11785  RETURN
11786 999 errorsexits("SOLVER_LINEAR_LIBRARY_TYPE_GET",err,error)
11787  RETURN 1
11788 
11789  END SUBROUTINE solver_linear_library_type_get
11790 
11791  !
11792  !================================================================================================================================
11793  !
11794 
11796  SUBROUTINE solver_linear_library_type_set(LINEAR_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
11797 
11798  !Argument variables
11799  TYPE(linear_solver_type), POINTER :: LINEAR_SOLVER
11800  INTEGER(INTG), INTENT(IN) :: SOLVER_LIBRARY_TYPE
11801  INTEGER(INTG), INTENT(OUT) :: ERR
11802  TYPE(varying_string), INTENT(OUT) :: ERROR
11803  !Local Variables
11804  TYPE(linear_direct_solver_type), POINTER :: DIRECT_SOLVER
11805  TYPE(linear_iterative_solver_type), POINTER :: ITERATIVE_SOLVER
11806  TYPE(varying_string) :: LOCAL_ERROR
11807 
11808  enters("SOLVER_LINEAR_LIBRARY_TYPE_SET",err,error,*999)
11809 
11810  IF(ASSOCIATED(linear_solver)) THEN
11811  SELECT CASE(linear_solver%LINEAR_SOLVE_TYPE)
11812  CASE(solver_linear_direct_solve_type)
11813  direct_solver=>linear_solver%DIRECT_SOLVER
11814  IF(ASSOCIATED(direct_solver)) THEN
11815  CALL solver_linear_direct_library_type_set(direct_solver,solver_library_type,err,error,*999)
11816  ELSE
11817  CALL flagerror("Linear solver direct solver is not associated.",err,error,*999)
11818  ENDIF
11819  CASE(solver_linear_iterative_solve_type)
11820  iterative_solver=>linear_solver%ITERATIVE_SOLVER
11821  IF(ASSOCIATED(iterative_solver)) THEN
11822  CALL solver_linear_iterative_library_type_set(iterative_solver,solver_library_type,err,error,*999)
11823  ELSE
11824  CALL flagerror("Linear solver iterative solver is not associated.",err,error,*999)
11825  ENDIF
11826  CASE DEFAULT
11827  local_error="The linear solver type of "//trim(numbertovstring(linear_solver%LINEAR_SOLVE_TYPE,"*",err,error))// &
11828  & " is invalid."
11829  CALL flagerror(local_error,err,error,*999)
11830  END SELECT
11831  ELSE
11832  CALL flagerror("Linear solver is not associated.",err,error,*999)
11833  ENDIF
11834 
11835  exits("SOLVER_LINEAR_LIBRARY_TYPE_SET")
11836  RETURN
11837 999 errorsexits("SOLVER_LINEAR_LIBRARY_TYPE_SET",err,error)
11838  RETURN 1
11839 
11840  END SUBROUTINE solver_linear_library_type_set
11841 
11842  !
11843  !================================================================================================================================
11844  !
11845 
11847  SUBROUTINE solver_linear_matrices_library_type_get(LINEAR_SOLVER,MATRICES_LIBRARY_TYPE,ERR,ERROR,*)
11848 
11849  !Argument variables
11850  TYPE(linear_solver_type), POINTER :: LINEAR_SOLVER
11851  INTEGER(INTG), INTENT(OUT) :: MATRICES_LIBRARY_TYPE
11852  INTEGER(INTG), INTENT(OUT) :: ERR
11853  TYPE(varying_string), INTENT(OUT) :: ERROR
11854  !Local Variables
11855  TYPE(linear_direct_solver_type), POINTER :: DIRECT_SOLVER
11856  TYPE(linear_iterative_solver_type), POINTER :: ITERATIVE_SOLVER
11857  TYPE(varying_string) :: LOCAL_ERROR
11858 
11859  enters("SOLVER_LINEAR_MATRICES_LIBRARY_TYPE_GET",err,error,*999)
11860 
11861  IF(ASSOCIATED(linear_solver)) THEN
11862  SELECT CASE(linear_solver%LINEAR_SOLVE_TYPE)
11863  CASE(solver_linear_direct_solve_type)
11864  direct_solver=>linear_solver%DIRECT_SOLVER
11865  IF(ASSOCIATED(direct_solver)) THEN
11866  CALL solver_lineardirectmatriceslibrarytypeget(direct_solver,matrices_library_type,err,error,*999)
11867  ELSE
11868  CALL flagerror("Linear solver direct solver is not associated.",err,error,*999)
11869  ENDIF
11870  CASE(solver_linear_iterative_solve_type)
11871  iterative_solver=>linear_solver%ITERATIVE_SOLVER
11872  IF(ASSOCIATED(iterative_solver)) THEN
11873  CALL solver_lineariterativematriceslibrarytypeget(iterative_solver,matrices_library_type,err,error,*999)
11874  ELSE
11875  CALL flagerror("Linear solver iterative solver is not associated.",err,error,*999)
11876  ENDIF
11877  CASE DEFAULT
11878  local_error="The linear solver type of "//trim(numbertovstring(linear_solver%LINEAR_SOLVE_TYPE,"*",err,error))// &
11879  & " is invalid."
11880  CALL flagerror(local_error,err,error,*999)
11881  END SELECT
11882  ELSE
11883  CALL flagerror("Linear solver is not associated.",err,error,*999)
11884  ENDIF
11885 
11886  exits("SOLVER_LINEAR_MATRICES_LIBRARY_TYPE_GET")
11887  RETURN
11888 999 errorsexits("SOLVER_LINEAR_MATRICES_LIBRARY_TYPE_GET",err,error)
11889  RETURN 1
11890 
11891  END SUBROUTINE solver_linear_matrices_library_type_get
11892 
11893  !
11894  !================================================================================================================================
11895  !
11896 
11898  SUBROUTINE solver_linear_solve(LINEAR_SOLVER,ERR,ERROR,*)
11899 
11900  !Argument variables
11901  TYPE(linear_solver_type), POINTER :: LINEAR_SOLVER
11902  INTEGER(INTG), INTENT(OUT) :: ERR
11903  TYPE(varying_string), INTENT(OUT) :: ERROR
11904  !Local Variables
11905  INTEGER(INTG) :: solver_matrix_idx
11906  TYPE(solver_type), POINTER :: SOLVER
11907  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
11908  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
11909  TYPE(varying_string) :: LOCAL_ERROR
11910 
11911  enters("SOLVER_LINEAR_SOLVE",err,error,*999)
11912 
11913  IF(ASSOCIATED(linear_solver)) THEN
11914  solver=>linear_solver%SOLVER
11915  IF(ASSOCIATED(solver)) THEN
11916 
11917 #ifdef TAUPROF
11918  CALL tau_static_phase_start("Solver Matrix Assembly Phase")
11919 #endif
11920  IF(.NOT.ASSOCIATED(solver%LINKING_SOLVER)) THEN
11921  !Assemble the solver matrices
11922 !!TODO: Work out what to assemble
11923 
11924  CALL solver_matrices_static_assemble(solver,solver_matrices_linear_only,err,error,*999)
11925  ENDIF
11926 
11927 #ifdef TAUPROF
11928  CALL tau_static_phase_stop("Solver Matrix Assembly Phase")
11929 
11930  CALL tau_static_phase_start("Solve Phase")
11931 #endif
11932  SELECT CASE(linear_solver%LINEAR_SOLVE_TYPE)
11933  CASE(solver_linear_direct_solve_type)
11934  CALL solver_linear_direct_solve(linear_solver%DIRECT_SOLVER,err,error,*999)
11935  CASE(solver_linear_iterative_solve_type)
11936  CALL solver_linear_iterative_solve(linear_solver%ITERATIVE_SOLVER,err,error,*999)
11937  CASE DEFAULT
11938  local_error="The linear solver type of "//trim(numbertovstring(linear_solver%LINEAR_SOLVE_TYPE,"*",err,error))// &
11939  & " is invalid."
11940  CALL flagerror(local_error,err,error,*999)
11941  END SELECT
11942 #ifdef TAUPROF
11943  CALL tau_static_phase_stop("Solve Phase")
11944 #endif
11945 
11946  IF(solver%OUTPUT_TYPE>=solver_solver_output) THEN
11947 
11948 #ifdef TAUPROF
11949  CALL tau_static_phase_start("Solution Output Phase")
11950 #endif
11951 
11952  solver_equations=>solver%SOLVER_EQUATIONS
11953  IF(ASSOCIATED(solver_equations)) THEN
11954  solver_matrices=>solver_equations%SOLVER_MATRICES
11955  IF(ASSOCIATED(solver_matrices)) THEN
11956  CALL write_string(general_output_type,"",err,error,*999)
11957  CALL write_string(general_output_type,"Solver solution vectors:",err,error,*999)
11958  CALL write_string_value(general_output_type,"Number of solution vectors = ",solver_matrices%NUMBER_OF_MATRICES, &
11959  & err,error,*999)
11960  DO solver_matrix_idx=1,solver_matrices%NUMBER_OF_MATRICES
11961  CALL write_string_value(general_output_type,"Solution vector for solver matrix : ",solver_matrix_idx,err,error,*999)
11962  CALL distributed_vector_output(general_output_type,solver_matrices%MATRICES(solver_matrix_idx)%PTR% &
11963  & solver_vector,err,error,*999)
11964  ENDDO !solver_matrix_idx
11965  ELSE
11966  CALL flagerror("Solver equations solver matrices is not associated.",err,error,*999)
11967  ENDIF
11968  ELSE
11969  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
11970  ENDIF
11971 
11972 #ifdef TAUPROF
11973  CALL tau_static_phase_stop("Solution Output Phase")
11974 #endif
11975  ENDIF
11976 
11977  IF(.NOT.ASSOCIATED(solver%LINKING_SOLVER)) THEN
11978  !Update depenent field with solution
11979 #ifdef TAUPROF
11980  CALL tau_static_phase_start("Field Update Phase")
11981 #endif
11982  CALL solver_variables_field_update(solver,err,error,*999)
11983 #ifdef TAUPROF
11984  CALL tau_static_phase_stop("Field Update Phase")
11985 #endif
11986  ENDIF
11987  ELSE
11988  CALL flagerror("Linear solver solver is not associated.",err,error,*999)
11989  ENDIF
11990  ELSE
11991  CALL flagerror("Linear solver is not associated.",err,error,*999)
11992  ENDIF
11993 
11994  exits("SOLVER_LINEAR_SOLVE")
11995  RETURN
11996 999 errorsexits("SOLVER_LINEAR_SOLVE",err,error)
11997  RETURN 1
11998 
11999  END SUBROUTINE solver_linear_solve
12000 
12001  !
12002  !================================================================================================================================
12003  !
12004 
12006  SUBROUTINE solver_linear_type_set(SOLVER,LINEAR_SOLVE_TYPE,ERR,ERROR,*)
12007 
12008  !Argument variables
12009  TYPE(solver_type), POINTER :: SOLVER
12010  INTEGER(INTG), INTENT(IN) :: LINEAR_SOLVE_TYPE
12011  INTEGER(INTG), INTENT(OUT) :: ERR
12012  TYPE(varying_string), INTENT(OUT) :: ERROR
12013  !Local Variables
12014  INTEGER(INTG) :: DUMMY_ERR
12015  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
12016 
12017  enters("SOLVER_LINEAR_TYPE_SET",err,error,*998)
12018 
12019  IF(ASSOCIATED(solver)) THEN
12020  IF(solver%SOLVER_FINISHED) THEN
12021  CALL flagerror("Solver has already been finished.",err,error,*998)
12022  ELSE
12023  IF(solver%SOLVE_TYPE==solver_linear_type) THEN
12024  IF(ASSOCIATED(solver%LINEAR_SOLVER)) THEN
12025  IF(linear_solve_type/=solver%LINEAR_SOLVER%LINEAR_SOLVE_TYPE) THEN
12026  !Intialise the new solver type
12027  SELECT CASE(linear_solve_type)
12028  CASE(solver_linear_direct_solve_type)
12029  CALL solver_linear_direct_initialise(solver%LINEAR_SOLVER,err,error,*999)
12030  CASE(solver_linear_iterative_solve_type)
12031  CALL solver_linear_iterative_initialise(solver%LINEAR_SOLVER,err,error,*999)
12032  CASE DEFAULT
12033  local_error="The linear solver type of "//trim(numbertovstring(linear_solve_type,"*",err,error))//" is invalid."
12034  CALL flagerror(local_error,err,error,*999)
12035  END SELECT
12036  !Finalise the old solver type
12037  SELECT CASE(solver%LINEAR_SOLVER%LINEAR_SOLVE_TYPE)
12038  CASE(solver_linear_direct_solve_type)
12039  CALL solver_linear_direct_finalise(solver%LINEAR_SOLVER%DIRECT_SOLVER,err,error,*999)
12040  CASE(solver_linear_iterative_solve_type)
12041  CALL solver_linear_iterative_finalise(solver%LINEAR_SOLVER%ITERATIVE_SOLVER,err,error,*999)
12042  CASE DEFAULT
12043  local_error="The linear solver type of "// &
12044  & trim(numbertovstring(solver%LINEAR_SOLVER%LINEAR_SOLVE_TYPE,"*",err,error))//" is invalid."
12045  CALL flagerror(local_error,err,error,*999)
12046  END SELECT
12047  solver%LINEAR_SOLVER%LINEAR_SOLVE_TYPE=linear_solve_type
12048  ENDIF
12049  ELSE
12050  CALL flagerror("The solver linear solver is not associated.",err,error,*998)
12051  ENDIF
12052  ELSE
12053  CALL flagerror("The solver is not a linear solver.",err,error,*998)
12054  ENDIF
12055  ENDIF
12056  ELSE
12057  CALL flagerror("Solver is not associated.",err,error,*998)
12058  ENDIF
12059 
12060  exits("SOLVER_LINEAR_TYPE_SET")
12061  RETURN
12062 999 SELECT CASE(linear_solve_type)
12063  CASE(solver_linear_direct_solve_type)
12064  CALL solver_linear_direct_finalise(solver%LINEAR_SOLVER%DIRECT_SOLVER,dummy_err,dummy_error,*998)
12065  CASE(solver_linear_iterative_solve_type)
12066  CALL solver_linear_iterative_finalise(solver%LINEAR_SOLVER%ITERATIVE_SOLVER,dummy_err,dummy_error,*998)
12067  END SELECT
12068 998 errorsexits("SOLVER_LINEAR_TYPE_SET",err,error)
12069  RETURN 1
12070 
12071  END SUBROUTINE solver_linear_type_set
12072 
12073  !
12074  !================================================================================================================================
12075  !
12076 
12078  SUBROUTINE solver_matrices_dynamic_assemble(SOLVER,SELECTION_TYPE,ERR,ERROR,*)
12079 
12080  !Argument variable
12081  TYPE(solver_type), POINTER :: SOLVER
12082  INTEGER(INTG), INTENT(IN) :: SELECTION_TYPE
12083  INTEGER(INTG), INTENT(OUT) :: ERR
12084  TYPE(varying_string), INTENT(OUT) :: ERROR
12085  !Local Variables
12086  INTEGER(INTG) :: DYNAMIC_VARIABLE_TYPE,equations_matrix_idx,equations_row_number,equations_set_idx,LINEAR_VARIABLE_TYPE, &
12087  & rhs_boundary_condition,rhs_global_dof,rhs_variable_dof,rhs_variable_type,solver_row_idx,solver_row_number, &
12088  & solver_matrix_idx,residual_variable_dof,variable_boundary_condition,variable_type,equations_matrix_idx2, &
12089  & variable_idx,variable_global_dof,variable_dof,equations_row_number2,equations_matrix_number,DEPENDENT_VARIABLE_TYPE, &
12090  & equations_column_number,dirichlet_row,dirichlet_idx, &
12091  & interface_condition_idx,interface_matrix_idx,interface_column_number,interface_row_number, &
12092  & interface_variable_type,number_of_interface_matrices
12093  REAL(SP) :: SYSTEM_ELAPSED,SYSTEM_TIME1(1),SYSTEM_TIME2(1),USER_ELAPSED,USER_TIME1(1),USER_TIME2(1)
12094  REAL(DP) :: DAMPING_MATRIX_COEFFICIENT,DELTA_T,DYNAMIC_VALUE,FIRST_UPDATE_FACTOR,RESIDUAL_VALUE, &
12095  & LINEAR_VALUE,LINEAR_VALUE_SUM,MASS_MATRIX_COEFFICIENT,RHS_VALUE,row_coupling_coefficient,PREVIOUS_RESIDUAL_VALUE, &
12096  & SECOND_UPDATE_FACTOR,SOURCE_VALUE,STIFFNESS_MATRIX_COEFFICIENT,VALUE,JACOBIAN_MATRIX_COEFFICIENT,ALPHA_VALUE, &
12097  & MATRIX_VALUE,DYNAMIC_DISPLACEMENT_FACTOR,DYNAMIC_VELOCITY_FACTOR,DYNAMIC_ACCELERATION_FACTOR,RHS_INTEGRATED_VALUE
12098  REAL(DP) :: MatrixCoefficients(2)=(/0.0_dp,0.0_dp/)
12099  REAL(DP), POINTER :: FIELD_VALUES_VECTOR(:),PREVIOUS_VALUES_VECTOR(:),PREVIOUS_VELOCITY_VECTOR(:), &
12100  & PREVIOUS_ACCELERATION_VECTOR(:),RHS_PARAMETERS(:)
12101  LOGICAL :: HAS_INTEGRATED_VALUES
12102  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
12103  TYPE(boundary_conditions_variable_type), POINTER :: RHS_BOUNDARY_CONDITIONS,DEPENDENT_BOUNDARY_CONDITIONS
12104  TYPE(distributed_matrix_type), POINTER :: PREVIOUS_SOLVER_DISTRIBUTED_MATRIX,SOLVER_DISTRIBUTED_MATRIX
12105  TYPE(distributed_vector_type), POINTER :: DEPENDENT_VECTOR,DYNAMIC_TEMP_VECTOR,EQUATIONS_RHS_VECTOR,DISTRIBUTED_SOURCE_VECTOR, &
12106  & LINEAR_TEMP_VECTOR,PREDICTED_MEAN_ACCELERATION_VECTOR,PREDICTED_MEAN_DISPLACEMENT_VECTOR,PREDICTED_MEAN_VELOCITY_VECTOR, &
12107  & SOLVER_RHS_VECTOR, SOLVER_RESIDUAL_VECTOR,RESIDUAL_VECTOR,INCREMENTAL_VECTOR,INTERFACE_TEMP_VECTOR, &
12108  & LAGRANGE_VECTOR
12109  TYPE(domain_mapping_type), POINTER :: RHS_DOMAIN_MAPPING,VARIABLE_DOMAIN_MAPPING
12110  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
12111  TYPE(equations_type), POINTER :: EQUATIONS
12112  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
12113  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
12114  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
12115  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
12116  TYPE(equations_mapping_rhs_type), POINTER :: RHS_MAPPING
12117  TYPE(equations_mapping_source_type), POINTER :: SOURCE_MAPPING
12118  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
12119  TYPE(equations_matrices_dynamic_type), POINTER :: DYNAMIC_MATRICES
12120  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
12121  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
12122  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
12123  TYPE(equations_matrices_source_type), POINTER :: SOURCE_VECTOR
12124  TYPE(equations_matrix_type), POINTER :: DAMPING_MATRIX,LINEAR_MATRIX,MASS_MATRIX,STIFFNESS_MATRIX,EQUATIONS_MATRIX
12125  TYPE(equations_jacobian_type), POINTER :: JACOBIAN_MATRIX
12126  TYPE(jacobian_to_solver_map_type), POINTER :: JACOBIAN_TO_SOLVER_MAP
12127  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
12128  TYPE(field_type), POINTER :: DEPENDENT_FIELD,LAGRANGE_FIELD
12129  TYPE(field_variable_type), POINTER :: DYNAMIC_VARIABLE,LINEAR_VARIABLE,RHS_VARIABLE,INTERFACE_VARIABLE
12130  TYPE(field_variable_type), POINTER :: DEPENDENT_VARIABLE
12131  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
12132  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
12133  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
12134  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
12135  TYPE(varying_string) :: LOCAL_ERROR
12136  TYPE(boundary_conditions_sparsity_indices_type), POINTER :: SPARSITY_INDICES
12137 
12138  TYPE(interface_condition_type), POINTER :: INTERFACE_CONDITION
12139  TYPE(interface_equations_type), POINTER :: INTERFACE_EQUATIONS
12140  TYPE(interface_lagrange_type), POINTER :: INTERFACE_LAGRANGE
12141  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
12142  TYPE(interface_mapping_rhs_type), POINTER :: INTERFACE_RHS_MAPPING
12143  TYPE(interface_matrices_type), POINTER :: INTERFACE_MATRICES
12144  TYPE(interface_matrix_type), POINTER :: INTERFACE_MATRIX
12145  TYPE(interface_rhs_type), POINTER :: INTERFACE_RHS_VECTOR
12146  TYPE(interface_to_solver_maps_type), POINTER :: INTERFACE_TO_SOLVER_MAP
12147 
12148  REAL(DP), POINTER :: CHECK_DATA(:),PREVIOUS_RESIDUAL_PARAMETERS(:),CHECK_DATA2(:)
12149  !STABILITY_TEST under investigation
12150  LOGICAL :: STABILITY_TEST
12151  !.FALSE. guarantees weighting as described in OpenCMISS notes
12152  !.TRUE. weights mean predicted field rather than the whole NL contribution
12153  !-> to be removed later
12154  stability_test=.false.
12155 
12156  enters("SOLVER_MATRICES_DYNAMIC_ASSEMBLE",err,error,*999)
12157 
12158  IF(ASSOCIATED(solver)) THEN
12159  IF(ASSOCIATED(dynamic_solver)) NULLIFY(dynamic_solver)
12160  IF(ASSOCIATED(solver_equations)) NULLIFY(solver_equations)
12161  IF(ASSOCIATED(solver_mapping)) NULLIFY(solver_mapping)
12162  IF(ASSOCIATED(solver_matrices)) NULLIFY(solver_matrices)
12163  !
12164  IF(ASSOCIATED(boundary_conditions)) NULLIFY(boundary_conditions)
12165  IF(ASSOCIATED(rhs_boundary_conditions)) NULLIFY(rhs_boundary_conditions)
12166  IF(ASSOCIATED(dependent_boundary_conditions)) NULLIFY(dependent_boundary_conditions)
12167  IF(ASSOCIATED(previous_solver_distributed_matrix)) NULLIFY(previous_solver_distributed_matrix)
12168  IF(ASSOCIATED(solver_distributed_matrix)) NULLIFY(solver_distributed_matrix)
12169  IF(ASSOCIATED(dependent_vector)) NULLIFY(dependent_vector)
12170  IF(ASSOCIATED(dynamic_temp_vector)) NULLIFY(dynamic_temp_vector)
12171  IF(ASSOCIATED(equations_rhs_vector)) NULLIFY(equations_rhs_vector)
12172  IF(ASSOCIATED(distributed_source_vector)) NULLIFY(distributed_source_vector)
12173  IF(ASSOCIATED(linear_temp_vector)) NULLIFY(linear_temp_vector)
12174  IF(ASSOCIATED(predicted_mean_acceleration_vector)) NULLIFY(predicted_mean_acceleration_vector)
12175  IF(ASSOCIATED(predicted_mean_displacement_vector)) NULLIFY(predicted_mean_displacement_vector)
12176  IF(ASSOCIATED(predicted_mean_velocity_vector)) NULLIFY(predicted_mean_velocity_vector)
12177  IF(ASSOCIATED(solver_rhs_vector)) NULLIFY(solver_rhs_vector)
12178  IF(ASSOCIATED(solver_residual_vector)) NULLIFY(solver_residual_vector)
12179  IF(ASSOCIATED(residual_vector)) NULLIFY(residual_vector)
12180  IF(ASSOCIATED(incremental_vector)) NULLIFY(incremental_vector)
12181  IF(ASSOCIATED(rhs_domain_mapping)) NULLIFY(rhs_domain_mapping)
12182  IF(ASSOCIATED(variable_domain_mapping)) NULLIFY(variable_domain_mapping)
12183  IF(ASSOCIATED(equations)) NULLIFY(equations)
12184  IF(ASSOCIATED(equations_mapping)) NULLIFY(equations_mapping)
12185  IF(ASSOCIATED(dynamic_mapping)) NULLIFY(dynamic_mapping)
12186  IF(ASSOCIATED(nonlinear_mapping)) NULLIFY(nonlinear_mapping)
12187  IF(ASSOCIATED(linear_mapping)) NULLIFY(linear_mapping)
12188  IF(ASSOCIATED(rhs_mapping)) NULLIFY(rhs_mapping)
12189  IF(ASSOCIATED(source_mapping)) NULLIFY(source_mapping)
12190  IF(ASSOCIATED(equations_matrices)) NULLIFY(equations_matrices)
12191  IF(ASSOCIATED(dynamic_matrices)) NULLIFY(dynamic_matrices)
12192  IF(ASSOCIATED(nonlinear_matrices)) NULLIFY(nonlinear_matrices)
12193  IF(ASSOCIATED(linear_matrices)) NULLIFY(linear_matrices)
12194  IF(ASSOCIATED(rhs_vector)) NULLIFY(rhs_vector)
12195  IF(ASSOCIATED(source_vector)) NULLIFY(source_vector)
12196  IF(ASSOCIATED(damping_matrix)) NULLIFY(damping_matrix)
12197  IF(ASSOCIATED(linear_matrix)) NULLIFY(linear_matrix)
12198  IF(ASSOCIATED(mass_matrix)) NULLIFY(mass_matrix)
12199  IF(ASSOCIATED(stiffness_matrix)) NULLIFY(stiffness_matrix)
12200  IF(ASSOCIATED(equations_matrix)) NULLIFY(equations_matrix)
12201  IF(ASSOCIATED(jacobian_matrix)) NULLIFY(jacobian_matrix)
12202  IF(ASSOCIATED(jacobian_to_solver_map)) NULLIFY(jacobian_to_solver_map)
12203  IF(ASSOCIATED(equations_set)) NULLIFY(equations_set)
12204  IF(ASSOCIATED(dependent_field)) NULLIFY(dependent_field)
12205  IF(ASSOCIATED(lagrange_field)) NULLIFY(lagrange_field)
12206  IF(ASSOCIATED(dynamic_variable)) NULLIFY(dynamic_variable)
12207  IF(ASSOCIATED(linear_variable)) NULLIFY(linear_variable)
12208  IF(ASSOCIATED(rhs_variable)) NULLIFY(rhs_variable)
12209  IF(ASSOCIATED(dependent_variable)) NULLIFY(dependent_variable)
12210  IF(ASSOCIATED(solver_matrix)) NULLIFY(solver_matrix)
12211  IF(ASSOCIATED(interface_condition)) NULLIFY(interface_condition)
12212  IF(ASSOCIATED(interface_equations)) NULLIFY(interface_equations)
12213  IF(ASSOCIATED(interface_lagrange)) NULLIFY(interface_lagrange)
12214  IF(ASSOCIATED(interface_mapping)) NULLIFY(interface_mapping)
12215  IF(ASSOCIATED(interface_rhs_mapping)) NULLIFY(interface_rhs_mapping)
12216  IF(ASSOCIATED(interface_matrices)) NULLIFY(interface_matrices)
12217  IF(ASSOCIATED(interface_matrix)) NULLIFY(interface_matrix)
12218  IF(ASSOCIATED(interface_rhs_vector)) NULLIFY(interface_rhs_vector)
12219  IF(ASSOCIATED(interface_to_solver_map)) NULLIFY(interface_to_solver_map)
12220  IF(ASSOCIATED(check_data)) NULLIFY(check_data)
12221  IF(ASSOCIATED(previous_residual_parameters)) NULLIFY(previous_residual_parameters)
12222  IF(ASSOCIATED(check_data2)) NULLIFY(check_data2)
12223 
12224  !Determine which dynamic solver needs to be used
12225  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
12226  dynamic_solver=>solver%DYNAMIC_SOLVER
12227  ELSE IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
12228  dynamic_solver=>solver%LINKING_SOLVER%DYNAMIC_SOLVER
12229  ELSE
12230  CALL flagerror("Dynamic solver solve type is not associated.",err,error,*999)
12231  END IF
12232  IF(ASSOCIATED(dynamic_solver)) THEN
12233  IF(dynamic_solver%SOLVER_INITIALISED) THEN
12234  delta_t=dynamic_solver%TIME_INCREMENT
12235  SELECT CASE(dynamic_solver%DEGREE)
12236  CASE(solver_dynamic_first_degree)
12237  stiffness_matrix_coefficient=1.0_dp*dynamic_solver%THETA(1)*delta_t
12238  damping_matrix_coefficient=1.0_dp
12239  mass_matrix_coefficient=0.0_dp
12240  jacobian_matrix_coefficient=stiffness_matrix_coefficient
12241  dynamic_displacement_factor=delta_t
12242  CASE(solver_dynamic_second_degree)
12243  stiffness_matrix_coefficient=1.0_dp*(dynamic_solver%THETA(2)*delta_t*delta_t)/2.0_dp
12244  damping_matrix_coefficient=1.0_dp*dynamic_solver%THETA(1)*delta_t
12245  mass_matrix_coefficient=1.0_dp
12246  jacobian_matrix_coefficient=stiffness_matrix_coefficient
12247  first_update_factor=delta_t
12248  dynamic_displacement_factor=delta_t*delta_t/2.0_dp
12249  dynamic_velocity_factor=delta_t
12250  CASE(solver_dynamic_third_degree)
12251  stiffness_matrix_coefficient=1.0_dp*(dynamic_solver%THETA(3)*delta_t*delta_t*delta_t)/6.0_dp
12252  damping_matrix_coefficient=1.0_dp*(dynamic_solver%THETA(2)*delta_t*delta_t)/2.0_dp
12253  mass_matrix_coefficient=1.0_dp*dynamic_solver%THETA(1)*delta_t
12254  jacobian_matrix_coefficient=stiffness_matrix_coefficient
12255  first_update_factor=delta_t
12256  second_update_factor=delta_t*delta_t/2.0_dp
12257  dynamic_displacement_factor=delta_t*delta_t*delta_t/6.0_dp
12258  dynamic_velocity_factor=delta_t*delta_t/2.0_dp
12259  dynamic_acceleration_factor=delta_t
12260  CASE DEFAULT
12261  local_error="The dynamic solver degree of "//trim(numbertovstring(dynamic_solver%DEGREE,"*",err,error))// &
12262  & " is invalid."
12263  CALL flagerror(local_error,err,error,*999)
12264  END SELECT
12265  ENDIF
12266  solver_equations=>solver%SOLVER_EQUATIONS
12267  IF(ASSOCIATED(solver_equations)) THEN
12268  solver_mapping=>solver_equations%SOLVER_MAPPING
12269  IF(ASSOCIATED(solver_mapping)) THEN
12270  solver_matrices=>solver_equations%SOLVER_MATRICES
12271  IF(ASSOCIATED(solver_matrices)) THEN
12272  !Assemble the solver matrices
12273  NULLIFY(previous_solver_distributed_matrix)
12274  NULLIFY(solver_matrix)
12275  NULLIFY(solver_distributed_matrix)
12276  NULLIFY(equations)
12277  NULLIFY(equations_matrices)
12278  NULLIFY(dynamic_matrices)
12279  NULLIFY(equations_mapping)
12280  NULLIFY(dynamic_mapping)
12281  NULLIFY(stiffness_matrix)
12282  NULLIFY(damping_matrix)
12283  NULLIFY(mass_matrix)
12284 
12285  IF(selection_type==solver_matrices_all.OR. &
12286  & selection_type==solver_matrices_linear_only.OR. &
12287  & selection_type==solver_matrices_nonlinear_only.OR. &
12288  & selection_type==solver_matrices_jacobian_only) THEN
12289  IF(dynamic_solver%SOLVER_INITIALISED.OR.(.NOT.dynamic_solver%SOLVER_INITIALISED.AND. &
12290  & ((dynamic_solver%ORDER==solver_dynamic_first_order.AND.dynamic_solver%DEGREE>solver_dynamic_first_degree).OR. &
12291  & (dynamic_solver%ORDER==solver_dynamic_second_order.AND.dynamic_solver%DEGREE>solver_dynamic_second_degree)))) &
12292  & THEN
12293  !Assemble solver matrices
12294  IF(solver%OUTPUT_TYPE>=solver_timing_output) THEN
12295  CALL cpu_timer(user_cpu,user_time1,err,error,*999)
12296  CALL cpu_timer(system_cpu,system_time1,err,error,*999)
12297  ENDIF
12298 ! DO solver_matrix_idx=1,SOLVER_MAPPING%NUMBER_OF_SOLVER_MATRICES
12299 ! SOLVER_MATRIX=>SOLVER_MATRICES%MATRICES(solver_matrix_idx)%PTR
12300 ! END DO
12301 
12302  solver_matrix_idx=1
12303  IF(solver_mapping%NUMBER_OF_SOLVER_MATRICES==solver_matrix_idx) THEN
12304  solver_matrix=>solver_matrices%MATRICES(1)%PTR
12305  IF(ASSOCIATED(solver_matrix)) THEN
12306  IF(solver_matrix%UPDATE_MATRIX) THEN
12307  solver_distributed_matrix=>solver_matrix%MATRIX
12308  IF(ASSOCIATED(solver_distributed_matrix)) THEN
12309  !Initialise matrix to zero
12310  CALL distributed_matrix_all_values_set(solver_distributed_matrix,0.0_dp,err,error,*999)
12311  !Loop over the equations sets
12312  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
12313  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)%EQUATIONS
12314  IF(ASSOCIATED(equations)) THEN
12315  equations_mapping=>equations%EQUATIONS_MAPPING
12316  IF(ASSOCIATED(equations_mapping)) THEN
12317  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
12318  IF(ASSOCIATED(dynamic_mapping)) THEN
12319  equations_matrices=>equations%EQUATIONS_MATRICES
12320  IF(ASSOCIATED(equations_matrices)) THEN
12321  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
12322  IF(ASSOCIATED(dynamic_matrices)) THEN
12323  IF(dynamic_solver%SOLVER_INITIALISED) THEN
12324 
12325  IF(dynamic_mapping%STIFFNESS_MATRIX_NUMBER/=0) THEN
12326  stiffness_matrix=>dynamic_matrices%MATRICES(dynamic_mapping%STIFFNESS_MATRIX_NUMBER)%PTR
12327  IF(ASSOCIATED(stiffness_matrix)) THEN
12328  CALL solver_matrix_equations_matrix_add(solver_matrix,equations_set_idx, &
12329  & stiffness_matrix_coefficient,stiffness_matrix,err,error,*999)
12330  ELSE
12331  CALL flagerror("Dynamic stiffness matrix is not associated.",err,error,*999)
12332  ENDIF
12333  ENDIF
12334 
12335  IF(dynamic_mapping%DAMPING_MATRIX_NUMBER/=0) THEN
12336  damping_matrix=>dynamic_matrices%MATRICES(dynamic_mapping%DAMPING_MATRIX_NUMBER)%PTR
12337  IF(ASSOCIATED(damping_matrix)) THEN
12338  CALL solver_matrix_equations_matrix_add(solver_matrix,equations_set_idx, &
12339  & damping_matrix_coefficient,damping_matrix,err,error,*999)
12340  ELSE
12341  CALL flagerror("Dynamic damping matrix is not associated.",err,error,*999)
12342  ENDIF
12343  ENDIF
12344 
12345  IF(dynamic_mapping%MASS_MATRIX_NUMBER/=0) THEN
12346  mass_matrix=>dynamic_matrices%MATRICES(dynamic_mapping%MASS_MATRIX_NUMBER)%PTR
12347  IF(ASSOCIATED(mass_matrix)) THEN
12348  CALL solver_matrix_equations_matrix_add(solver_matrix,equations_set_idx, &
12349  & mass_matrix_coefficient,mass_matrix,err,error,*999)
12350  ELSE
12351  CALL flagerror("Dynamic mass matrix is not associated.",err,error,*999)
12352  ENDIF
12353  ENDIF
12354 
12355  ELSE
12356  IF(dynamic_solver%ORDER==solver_dynamic_second_order.AND. &
12357  & dynamic_solver%DEGREE==solver_dynamic_third_degree) THEN
12358  IF(dynamic_mapping%MASS_MATRIX_NUMBER/=0) THEN
12359  mass_matrix=>dynamic_matrices%MATRICES(dynamic_mapping%MASS_MATRIX_NUMBER)%PTR
12360  IF(ASSOCIATED(mass_matrix)) THEN
12361  CALL solver_matrix_equations_matrix_add(solver_matrix,equations_set_idx, &
12362  & -1.0_dp,mass_matrix,err,error,*999)
12363  ELSE
12364  CALL flagerror("Dynamic stiffness matrix is not associated.",err,error,*999)
12365  ENDIF
12366  ELSE
12367  CALL flagerror("Can not perform initial solve with no mass matrix.",err,error,*999)
12368  ENDIF
12369  ELSE
12370  IF(dynamic_mapping%DAMPING_MATRIX_NUMBER/=0) THEN
12371  damping_matrix=>dynamic_matrices%MATRICES(dynamic_mapping%DAMPING_MATRIX_NUMBER)%PTR
12372  IF(ASSOCIATED(damping_matrix)) THEN
12373  CALL solver_matrix_equations_matrix_add(solver_matrix,equations_set_idx, &
12374  & -1.0_dp,damping_matrix,err,error,*999)
12375  ELSE
12376  CALL flagerror("Dynamic damping matrix is not associated.",err,error,*999)
12377  ENDIF
12378  ELSE
12379  CALL flagerror("Can not perform initial solve with no damping matrix.",err,error,*999)
12380  ENDIF
12381  ENDIF
12382  ENDIF
12383  ELSE
12384  CALL flagerror("Equations matrices dynamic matrices is not associated.",err,error,*999)
12385  ENDIF
12386  ELSE
12387  CALL flagerror("Equations equations matrices is not associated.",err,error,*999)
12388  ENDIF
12389  ELSE
12390  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
12391  IF(ASSOCIATED(nonlinear_mapping)) THEN
12392  equations_matrices=>equations%EQUATIONS_MATRICES
12393  IF(.NOT.ASSOCIATED(equations_matrices)) THEN
12394  CALL flagerror("Equations matrices not associated.",err,error,*999)
12395  ENDIF
12396  ELSE
12397  CALL flagerror("Equations mapping dynamic mapping is not associated.",err,error,*999)
12398  ENDIF
12399  !CALL FlagError("Equations mapping dynamic mapping is not associated.",ERR,ERROR,*999)
12400  ENDIF
12401  ELSE
12402  CALL flagerror("Equations equations mapping is not associated.",err,error,*999)
12403  ENDIF
12404  ELSE
12405  local_error="Solver mapping equations is not associated for equations set number "// &
12406  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
12407  CALL flagerror(local_error,err,error,*999)
12408  ENDIF
12409  NULLIFY(jacobian_to_solver_map)
12410  NULLIFY(jacobian_matrix)
12411  IF(selection_type==solver_matrices_all.OR. &
12412  & selection_type==solver_matrices_nonlinear_only.OR. &
12413  & selection_type==solver_matrices_jacobian_only) THEN
12414 
12415  !Now set the values from the equations Jacobian
12416  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
12417  IF(ASSOCIATED(nonlinear_matrices)) THEN
12418  DO equations_matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
12419  jacobian_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
12420  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%JACOBIAN_TO_SOLVER_MATRIX_MAPS( &
12421  & equations_matrix_idx)%PTR
12422  IF(ASSOCIATED(jacobian_to_solver_map)) THEN
12423  jacobian_matrix=>jacobian_to_solver_map%JACOBIAN_MATRIX
12424  IF(ASSOCIATED(jacobian_matrix)) THEN
12425  CALL solver_matrix_jacobian_matrix_add(solver_matrix,equations_set_idx, &
12426  & jacobian_matrix_coefficient,jacobian_matrix,err,error,*999)
12427  ELSE
12428  CALL flagerror("Jacobian matrix is not associated.",err,error,*999)
12429  ENDIF
12430  ELSE
12431  local_error="Jacobian to solver map is not associated for Jacobian number "// &
12432  & trim(numbertovstring(equations_matrix_idx,"*",err,error))//"."
12433  CALL flagerror(local_error,err,error,*999)
12434  ENDIF
12435  ENDDO
12436  ENDIF
12437  ENDIF
12438  ENDDO !equations_set_idx
12439  !Loop over any interface conditions
12440  DO interface_condition_idx=1,solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS
12441  !Loop over the interface matrices
12442  DO interface_matrix_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
12443  & interface_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_INTERFACE_MATRICES
12444  interface_to_solver_map=>solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
12445  & interface_to_solver_matrix_maps_sm(solver_matrix_idx)%INTERFACE_EQUATIONS_TO_SOLVER_MATRIX_MAPS( &
12446  & interface_matrix_idx)%PTR
12447  IF(ASSOCIATED(interface_to_solver_map)) THEN
12448  interface_matrix=>interface_to_solver_map%INTERFACE_MATRIX
12449  IF(ASSOCIATED(interface_matrix)) THEN
12450  SELECT CASE(interface_matrix%INTERFACE_MATRIX_TIME_DEPENDENCE_TYPE)
12451  CASE(interface_matrix_static)
12452  matrixcoefficients(1)=stiffness_matrix_coefficient
12453  CASE(interface_matrix_first_order_dynamic)
12454  matrixcoefficients(1)=damping_matrix_coefficient
12455  CASE DEFAULT
12456  CALL flagerror("Not implemented.",err,error,*999)
12457  END SELECT
12458  IF(interface_matrix%HAS_TRANSPOSE) THEN
12459  SELECT CASE(interface_matrix%INTERFACE_MATRIX_TRANSPOSE_TIME_DEPENDENCE_TYPE)
12460  CASE(interface_matrix_static)
12461  matrixcoefficients(2)=stiffness_matrix_coefficient
12462  CASE(interface_matrix_first_order_dynamic)
12463  matrixcoefficients(2)=damping_matrix_coefficient
12464  CASE DEFAULT
12465  CALL flagerror("Not implemented.",err,error,*999)
12466  END SELECT
12467  ELSE
12468  matrixcoefficients(2)=0.0_dp
12469  ENDIF
12470  CALL solver_matrix_interface_matrix_add(solver_matrix,interface_condition_idx, &
12471  & matrixcoefficients,interface_matrix,err,error,*999)
12472  ELSE
12473  CALL flagerror("The interface matrix is not associated.",err,error,*999)
12474  ENDIF
12475  ELSE
12476  CALL flagerror("The interface matrix interface to solver map is not associated.",err,error,*999)
12477  ENDIF
12478  ENDDO !interface_matrix_idx
12479  ENDDO !interface_condition_idx
12480  !Update the solver matrix values
12481  CALL distributed_matrix_update_start(solver_distributed_matrix,err,error,*999)
12482 
12483  IF(ASSOCIATED(previous_solver_distributed_matrix)) THEN
12484  CALL distributed_matrix_update_finish(previous_solver_distributed_matrix,err,error,*999)
12485  ENDIF
12486  previous_solver_distributed_matrix=>solver_distributed_matrix
12487  ELSE
12488  CALL flagerror("Solver matrix distributed matrix is not associated.",err,error,*999)
12489  ENDIF
12490 
12491  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
12492  IF(dynamic_solver%SOLVER_INITIALISED) solver_matrix%UPDATE_MATRIX=.false.
12493  ELSE IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
12494  IF(dynamic_solver%SOLVER_INITIALISED) solver_matrix%UPDATE_MATRIX=.true.
12495  ELSE
12496  CALL flagerror("Dynamic solver solve type is not associated.",err,error,*999)
12497  END IF
12498 
12499  ENDIF !Update matrix
12500  ELSE
12501  CALL flagerror("Solver matrix is not associated.",err,error,*999)
12502  ENDIF
12503  ELSE
12504  CALL flagerror("Invalid number of solver matrices.",err,error,*999)
12505  ENDIF
12506  IF(ASSOCIATED(previous_solver_distributed_matrix)) THEN
12507  CALL distributed_matrix_update_finish(previous_solver_distributed_matrix,err,error,*999)
12508  ENDIF
12509  IF(solver%OUTPUT_TYPE>=solver_timing_output) THEN
12510  CALL cpu_timer(user_cpu,user_time2,err,error,*999)
12511  CALL cpu_timer(system_cpu,system_time2,err,error,*999)
12512  user_elapsed=user_time2(1)-user_time1(1)
12513  system_elapsed=system_time2(1)-system_time1(1)
12514  CALL write_string(general_output_type,"",err,error,*999)
12515  CALL write_string_value(general_output_type,"Total user time for solver matrices assembly = ",user_elapsed, &
12516  & err,error,*999)
12517  CALL write_string_value(general_output_type,"Total System time for solver matrices assembly = ", &
12518  & system_elapsed,err,error,*999)
12519  ENDIF
12520  ENDIF
12521  ENDIF
12522 
12523  NULLIFY(solver_rhs_vector)
12524  IF(selection_type==solver_matrices_all.OR. &
12525  & selection_type==solver_matrices_linear_only.OR. &
12526  & selection_type==solver_matrices_nonlinear_only.OR. &
12527  & selection_type==solver_matrices_rhs_residual_only.OR. &
12528  & selection_type==solver_matrices_rhs_only) THEN
12529  IF(dynamic_solver%SOLVER_INITIALISED.OR.(.NOT.dynamic_solver%SOLVER_INITIALISED.AND. &
12530  & ((dynamic_solver%ORDER==solver_dynamic_first_order.AND.dynamic_solver%DEGREE>solver_dynamic_first_degree).OR. &
12531  & (dynamic_solver%ORDER==solver_dynamic_second_order.AND.dynamic_solver%DEGREE>solver_dynamic_second_degree)))) &
12532  & THEN
12533  !Assemble rhs vector
12534  IF(solver%OUTPUT_TYPE>=solver_timing_output) THEN
12535  CALL cpu_timer(user_cpu,user_time1,err,error,*999)
12536  CALL cpu_timer(system_cpu,system_time1,err,error,*999)
12537  ENDIF
12538  IF(solver_matrices%UPDATE_RHS_VECTOR) THEN
12539 
12540  solver_rhs_vector=>solver_matrices%RHS_VECTOR
12541  IF(ASSOCIATED(solver_rhs_vector)) THEN
12542  !Initialise the RHS to zero
12543  CALL distributed_vector_all_values_set(solver_rhs_vector,0.0_dp,err,error,*999)
12544  !Get the solver variables data
12545  NULLIFY(check_data)
12546  CALL distributed_vector_data_get(solver_rhs_vector,check_data,err,error,*999)
12547  !Loop over the equations sets
12548  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
12549  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
12550  IF(ASSOCIATED(equations_set)) THEN
12551  NULLIFY(dependent_field)
12552  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
12553  equations=>equations_set%EQUATIONS
12554  IF(ASSOCIATED(dependent_field)) THEN
12555  IF(ASSOCIATED(equations)) THEN
12556  equations_matrices=>equations%EQUATIONS_MATRICES
12557  IF(ASSOCIATED(equations_matrices)) THEN
12558  equations_mapping=>equations%EQUATIONS_MAPPING
12559  IF(ASSOCIATED(equations_mapping)) THEN
12560 
12561  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
12562  IF(ASSOCIATED(dynamic_mapping)) THEN
12563  dynamic_variable_type=dynamic_mapping%DYNAMIC_VARIABLE_TYPE
12564  !Calculate the dynamic contributions
12565  dynamic_variable=>dynamic_mapping%DYNAMIC_VARIABLE
12566  IF(ASSOCIATED(dynamic_variable)) THEN
12567  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
12568  IF(ASSOCIATED(dynamic_matrices)) THEN
12569  dynamic_temp_vector=>dynamic_matrices%TEMP_VECTOR
12570  !Initialise the dynamic temporary vector to zero
12571  CALL distributed_vector_all_values_set(dynamic_temp_vector,0.0_dp,err,error,*999)
12572  IF(dynamic_mapping%STIFFNESS_MATRIX_NUMBER/=0) THEN
12573  stiffness_matrix=>dynamic_matrices%MATRICES(dynamic_mapping%STIFFNESS_MATRIX_NUMBER)%PTR
12574  IF(ASSOCIATED(stiffness_matrix)) THEN
12575  NULLIFY(predicted_mean_displacement_vector)
12576  CALL field_parameter_set_vector_get(dependent_field,dynamic_variable_type, &
12577  & field_mean_predicted_displacement_set_type,predicted_mean_displacement_vector, &
12578  & err,error,*999)
12579  CALL distributed_matrix_by_vector_add(distributed_matrix_vector_no_ghosts_type, &
12580  & -1.0_dp,stiffness_matrix%MATRIX, &
12581 ! & -DYNAMIC_SOLVER%THETA(1),STIFFNESS_MATRIX%MATRIX, &
12582  & predicted_mean_displacement_vector,dynamic_temp_vector,err,error,*999)
12583  ELSE
12584  CALL flagerror("Dynamic stiffness matrix is not associated.",err,error,*999)
12585  ENDIF
12586  ENDIF
12587  IF(dynamic_mapping%DAMPING_MATRIX_NUMBER/=0.AND. &
12588  & dynamic_solver%DEGREE>solver_dynamic_first_degree) THEN
12589  damping_matrix=>dynamic_matrices%MATRICES(dynamic_mapping%DAMPING_MATRIX_NUMBER)%PTR
12590  IF(ASSOCIATED(damping_matrix)) THEN
12591  NULLIFY(predicted_mean_velocity_vector)
12592  CALL field_parameter_set_vector_get(dependent_field,dynamic_variable_type, &
12593  & field_mean_predicted_velocity_set_type,predicted_mean_velocity_vector, &
12594  & err,error,*999)
12595  CALL distributed_matrix_by_vector_add(distributed_matrix_vector_no_ghosts_type,-1.0_dp,&
12596  & damping_matrix%MATRIX,predicted_mean_velocity_vector,dynamic_temp_vector, &
12597  & err,error,*999)
12598  ELSE
12599  CALL flagerror("Dynamic damping matrix is not associated.",err,error,*999)
12600  ENDIF
12601  ENDIF
12602  IF(dynamic_mapping%MASS_MATRIX_NUMBER/=0.AND. &
12603  & dynamic_solver%DEGREE>solver_dynamic_second_degree) THEN
12604  mass_matrix=>dynamic_matrices%MATRICES(dynamic_mapping%MASS_MATRIX_NUMBER)%PTR
12605  IF(ASSOCIATED(mass_matrix)) THEN
12606  NULLIFY(predicted_mean_acceleration_vector)
12607  CALL field_parameter_set_vector_get(dependent_field,dynamic_variable_type, &
12608  & field_mean_predicted_acceleration_set_type,predicted_mean_acceleration_vector, &
12609  & err,error,*999)
12610  ELSE
12611  CALL flagerror("Dynamic mass matrix is not associated.",err,error,*999)
12612  ENDIF
12613  ENDIF
12614  ELSE
12615  CALL flagerror("Equations matrices dynamic matrices is not associated.",err,error,*999)
12616  ENDIF
12617  ELSE
12618  CALL flagerror("Dynamic variable is not associated.",err,error,*999)
12619  ENDIF
12620  ELSE
12621  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
12622  IF(ASSOCIATED(nonlinear_mapping)) THEN
12623  !Default to FIELD_U_VARIABLE_TYPE
12624  dynamic_variable_type=field_u_variable_type
12625  IF(ASSOCIATED(dynamic_temp_vector)) NULLIFY(dynamic_temp_vector)
12626  ELSE
12627  CALL flagerror("Equations mapping dynamic mapping is not associated.",err,error,*999)
12628  ENDIF
12629  !CALL FlagError("Equations mapping dynamic mapping is not associated.",ERR,ERROR,*999)
12630  ENDIF
12631  !Calculate the contributions from any linear matrices
12632  linear_mapping=>equations_mapping%LINEAR_MAPPING
12633  IF(ASSOCIATED(linear_mapping)) THEN
12634  linear_matrices=>equations_matrices%LINEAR_MATRICES
12635  IF(ASSOCIATED(linear_matrices)) THEN
12636  DO equations_matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
12637  linear_matrix=>linear_matrices%MATRICES(equations_matrix_idx)%PTR
12638  IF(ASSOCIATED(linear_matrix)) THEN
12639  linear_variable_type=linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(equations_matrix_idx)% &
12640  & variable_type
12641  linear_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(equations_matrix_idx)% &
12642  & variable
12643  IF(ASSOCIATED(linear_variable)) THEN
12644  linear_temp_vector=>linear_matrix%TEMP_VECTOR
12645  !Initialise the linear temporary vector to zero
12646  CALL distributed_vector_all_values_set(linear_temp_vector,0.0_dp,err,error,*999)
12647  NULLIFY(dependent_vector)
12648  CALL field_parameter_set_vector_get(dependent_field,linear_variable_type, &
12649  & field_values_set_type,dependent_vector,err,error,*999)
12650  CALL distributed_matrix_by_vector_add(distributed_matrix_vector_no_ghosts_type,1.0_dp, &
12651  & linear_matrix%MATRIX,dependent_vector,linear_temp_vector,err,error,*999)
12652  ELSE
12653  CALL flagerror("Linear variable is not associated.",err,error,*999)
12654  ENDIF
12655  ELSE
12656  local_error="Linear matrix is not associated for linear matrix number "// &
12657  & trim(numbertovstring(equations_matrix_idx,"*",err,error))//"."
12658  CALL flagerror(local_error,err,error,*999)
12659  ENDIF
12660  ENDDO !equations_matrix_idx
12661  ELSE
12662  CALL flagerror("Equations matrices linear matrices is not associated.",err,error,*999)
12663  ENDIF
12664  ENDIF
12665  source_mapping=>equations_mapping%SOURCE_MAPPING
12666  IF(ASSOCIATED(source_mapping)) THEN
12667  source_vector=>equations_matrices%SOURCE_VECTOR
12668  IF(ASSOCIATED(source_vector)) THEN
12669  distributed_source_vector=>source_vector%VECTOR
12670  ELSE
12671  CALL flagerror("Source vector vector is not associated.",err,error,*999)
12672  ENDIF
12673  ENDIF
12674  rhs_mapping=>equations_mapping%RHS_MAPPING
12675  IF(ASSOCIATED(rhs_mapping)) THEN
12676  NULLIFY(rhs_parameters)
12677  rhs_variable_type=rhs_mapping%RHS_VARIABLE_TYPE
12678  CALL field_parameter_set_data_get(dependent_field,rhs_variable_type, &
12679  & field_values_set_type,rhs_parameters,err,error,*999)
12680  rhs_vector=>equations_matrices%RHS_VECTOR
12681  IF(ASSOCIATED(rhs_vector)) THEN
12682  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
12683  IF(ASSOCIATED(boundary_conditions)) THEN
12684  !!TODO: what if the equations set doesn't have a RHS vector???
12685  rhs_variable_type=rhs_mapping%RHS_VARIABLE_TYPE
12686  rhs_variable=>rhs_mapping%RHS_VARIABLE
12687  rhs_domain_mapping=>rhs_variable%DOMAIN_MAPPING
12688  CALL field_parameter_set_created(rhs_variable%FIELD,rhs_variable_type, &
12689  & field_integrated_neumann_set_type,has_integrated_values,err,error,*999)
12690  equations_rhs_vector=>rhs_vector%VECTOR
12691  CALL boundary_conditions_variable_get(boundary_conditions,rhs_variable, &
12692  & rhs_boundary_conditions,err,error,*999)
12693  IF(ASSOCIATED(rhs_boundary_conditions)) THEN
12694  !Update RHS field by integrating any point Neumann conditions
12695  CALL boundaryconditions_neumannintegrate(rhs_boundary_conditions, &
12696  & err,error,*999)
12697  !Loop over the rows in the equations set
12698  DO equations_row_number=1,equations_mapping%TOTAL_NUMBER_OF_ROWS
12699  !Get the dynamic contribution to the RHS values
12700  !
12701  IF(ASSOCIATED(dynamic_temp_vector)) THEN
12702  CALL distributed_vector_values_get(dynamic_temp_vector,equations_row_number, &
12703  & dynamic_value,err,error,*999)
12704  ELSE
12705  dynamic_value=0.0_dp
12706  ENDIF
12707  !
12708  !Get the linear matrices contribution to the RHS values if there are any
12709  IF(ASSOCIATED(linear_mapping)) THEN
12710  linear_value_sum=0.0_dp
12711  DO equations_matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
12712  linear_matrix=>linear_matrices%MATRICES(equations_matrix_idx)%PTR
12713  linear_temp_vector=>linear_matrix%TEMP_VECTOR
12714  CALL distributed_vector_values_get(linear_temp_vector,equations_row_number, &
12715  & linear_value,err,error,*999)
12716  linear_value_sum=linear_value_sum+linear_value
12717  ENDDO !equations_matrix_idx
12718  dynamic_value=dynamic_value+linear_value_sum
12719  ENDIF
12720  !Get the source vector contribute to the RHS values if there are any
12721  IF(ASSOCIATED(source_mapping)) THEN
12722  !Add in equations source values
12723  CALL distributed_vector_values_get(distributed_source_vector,equations_row_number, &
12724  & source_value,err,error,*999)
12725  dynamic_value=dynamic_value+source_value
12726  ENDIF
12727  !Get the nonlinear vector contribute to the RHS values if nonlinear solve
12728  IF(.NOT.stability_test) THEN
12729  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
12730  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
12731  IF(ASSOCIATED(nonlinear_mapping)) THEN
12732  NULLIFY(previous_residual_parameters)
12733  CALL field_parameter_set_data_get(dependent_field,dynamic_variable_type, &
12734  & field_previous_residual_set_type,previous_residual_parameters,err,error, &
12735  & *999)
12736  residual_variable_dof=nonlinear_mapping% &
12737  & equations_row_to_residual_dof_map(equations_row_number)
12738  previous_residual_value=-1.0_dp*previous_residual_parameters &
12739  & (residual_variable_dof)
12740  dynamic_value=dynamic_value+previous_residual_value*(1.0_dp-dynamic_solver% &
12741  & theta(1))
12742  ENDIF
12743  END IF
12744  END IF
12745  !Loop over the solver rows associated with this equations set row
12746  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
12747  & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
12748  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
12749  & equations_row_to_solver_rows_maps(equations_row_number)%SOLVER_ROWS( &
12750  & solver_row_idx)
12751  row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
12752  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(equations_row_number)% &
12753  & coupling_coefficients(solver_row_idx)
12754  VALUE=dynamic_value*row_coupling_coefficient
12755  CALL distributed_vector_values_add(solver_rhs_vector,solver_row_number,VALUE, &
12756  & err,error,*999)
12757  ENDDO !solver_row_idx
12758  ENDDO !equations_row_number
12759 
12760  SELECT CASE(dynamic_solver%DEGREE)
12761  CASE(solver_dynamic_first_degree)
12762  NULLIFY(field_values_vector)
12763  NULLIFY(previous_values_vector)
12764  CALL field_parameter_set_data_get(dependent_field,dynamic_variable_type, &
12765  field_values_set_type,field_values_vector,err,error,*999)
12766  CALL field_parameter_set_data_get(dependent_field,dynamic_variable_type, &
12767  field_previous_values_set_type,previous_values_vector,err,error,*999)
12768  CASE(solver_dynamic_second_degree)
12769  NULLIFY(field_values_vector)
12770  NULLIFY(previous_values_vector)
12771  NULLIFY(previous_velocity_vector)
12772  CALL field_parameter_set_data_get(dependent_field,dynamic_variable_type, &
12773  field_values_set_type,field_values_vector,err,error,*999)
12774  CALL field_parameter_set_data_get(dependent_field,dynamic_variable_type, &
12775  field_previous_values_set_type,previous_values_vector,err,error,*999)
12776  CALL field_parameter_set_data_get(dependent_field,dynamic_variable_type, &
12777  field_previous_velocity_set_type,previous_velocity_vector,err,error,*999)
12778  CASE(solver_dynamic_third_degree)
12779  NULLIFY(field_values_vector)
12780  NULLIFY(previous_values_vector)
12781  NULLIFY(previous_velocity_vector)
12782  NULLIFY(previous_acceleration_vector)
12783  CALL field_parameter_set_data_get(dependent_field,dynamic_variable_type, &
12784  field_values_set_type,field_values_vector,err,error,*999)
12785  CALL field_parameter_set_data_get(dependent_field,dynamic_variable_type, &
12786  field_previous_values_set_type,previous_values_vector,err,error,*999)
12787  CALL field_parameter_set_data_get(dependent_field,dynamic_variable_type, &
12788  field_previous_velocity_set_type,previous_velocity_vector,err,error,*999)
12789  CALL field_parameter_set_data_get(dependent_field,dynamic_variable_type, &
12790  field_previous_acceleration_set_type,previous_acceleration_vector,err,error,*999)
12791  CASE DEFAULT
12792  local_error="The dynamic solver degree of "// &
12793  & trim(numbertovstring(dynamic_solver%DEGREE,"*",err,error))// &
12794  & " is invalid."
12795  CALL flagerror(local_error,err,error,*999)
12796  END SELECT
12797 
12798  DO equations_row_number=1,equations_mapping%TOTAL_NUMBER_OF_ROWS
12799  !Get the dynamic contribution to the the RHS values
12800  rhs_variable_dof=rhs_mapping%EQUATIONS_ROW_TO_RHS_DOF_MAP(equations_row_number)
12801  rhs_global_dof=rhs_domain_mapping%LOCAL_TO_GLOBAL_MAP(rhs_variable_dof)
12802  rhs_boundary_condition=rhs_boundary_conditions%DOF_TYPES(rhs_global_dof)
12803  !Apply boundary conditions
12804  SELECT CASE(rhs_boundary_condition)
12805  CASE(boundary_condition_dof_free)
12806  !Get the equations RHS values
12807  CALL distributed_vector_values_get(equations_rhs_vector,equations_row_number, &
12808  & rhs_value,err,error,*999)
12809  IF(has_integrated_values) THEN
12810  !Add any Neumann integrated values, b = f + N q
12811  CALL field_parameter_set_get_local_dof(rhs_variable%FIELD,rhs_variable_type, &
12812  & field_integrated_neumann_set_type,rhs_variable_dof,rhs_integrated_value, &
12813  & err,error,*999)
12814  rhs_value=rhs_value+rhs_integrated_value
12815  END IF
12816  !Loop over the solver rows associated with this equations set row
12817  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
12818  & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
12819  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
12820  & equations_row_to_solver_rows_maps(equations_row_number)%SOLVER_ROWS( &
12821  & solver_row_idx)
12822  row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
12823  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(equations_row_number)% &
12824  & coupling_coefficients(solver_row_idx)
12825  VALUE=rhs_value*row_coupling_coefficient
12826  CALL distributed_vector_values_add(solver_rhs_vector,solver_row_number,VALUE, &
12827  & err,error,*999)
12828  ENDDO !solver_row_idx
12829  !Note: the Dirichlet boundary conditions are implicitly included by doing a matrix
12830  !vector product above with the dynamic stiffness matrix and the mean predicited
12831  !displacement vector
12832  !
12833  !This is only true for nonlinear cases and linear cases with fixed values at the boundaries
12834  !
12835  !For changing linear boundary conditions the following needs to be added
12836  !
12837  IF(dynamic_solver%UPDATE_BC)THEN
12838  !Set Dirichlet boundary conditions
12839  IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
12840  !for linear case only |
12841 ! IF(ASSOCIATED(LINEAR_MAPPING).AND..NOT.ASSOCIATED(NONLINEAR_MAPPING)) THEN
12842  !Loop over the dependent variables associated with this equations set row
12843 ! DO variable_idx=1,DYNAMIC_MAPPING%NUMBER_OF_LINEAR_MATRIX_VARIABLES
12844  variable_idx=1
12845 ! variable_type=DYNAMIC_MAPPING%DYNAMIC_VARIABLE_TYPES(variable_idx)
12846  variable_type=dynamic_mapping%DYNAMIC_VARIABLE_TYPE
12847  dependent_variable=>dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS( &
12848  & variable_type)%VARIABLE
12849  dependent_variable_type=dependent_variable%VARIABLE_TYPE
12850  variable_domain_mapping=>dependent_variable%DOMAIN_MAPPING
12851  CALL boundary_conditions_variable_get(boundary_conditions,dependent_variable, &
12852  & dependent_boundary_conditions,err,error,*999)
12853  variable_dof=dynamic_mapping%EQUATIONS_ROW_TO_VARIABLE_DOF_MAPS( &
12854  & equations_row_number)
12855  variable_global_dof=variable_domain_mapping%LOCAL_TO_GLOBAL_MAP(variable_dof)
12856  variable_boundary_condition=dependent_boundary_conditions%DOF_TYPES( &
12857  & variable_global_dof)
12858 
12859  IF(variable_boundary_condition==boundary_condition_dof_fixed) THEN
12860  SELECT CASE(dynamic_solver%DEGREE)
12861  CASE(solver_dynamic_first_degree)
12862  alpha_value=(field_values_vector(variable_dof)- &
12863  & previous_values_vector(variable_dof))/ &
12864  & dynamic_displacement_factor
12865  CASE(solver_dynamic_second_degree)
12866  alpha_value=(field_values_vector(variable_dof)- &
12867  & previous_values_vector(variable_dof)- &
12868  & dynamic_displacement_factor*previous_velocity_vector(variable_dof))/ &
12869  & dynamic_velocity_factor
12870  CASE(solver_dynamic_third_degree)
12871  alpha_value=(field_values_vector(variable_dof)- &
12872  & previous_values_vector(variable_dof)- &
12873  & dynamic_displacement_factor*previous_velocity_vector(variable_dof) - &
12874  & dynamic_velocity_factor*previous_acceleration_vector(variable_dof))/ &
12875  & dynamic_acceleration_factor
12876  CASE DEFAULT
12877  local_error="The dynamic solver degree of "// &
12878  & trim(numbertovstring(dynamic_solver%DEGREE,"*",err,error))// &
12879  & " is invalid."
12880  CALL flagerror(local_error,err,error,*999)
12881  END SELECT
12882 
12883 
12884  IF(abs(alpha_value)>=zero_tolerance) THEN
12885  DO equations_matrix_idx=1,dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS( &
12886  & variable_type)%NUMBER_OF_EQUATIONS_MATRICES
12887  equations_matrix_number=dynamic_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS( &
12888  & variable_type)%EQUATIONS_MATRIX_NUMBERS(equations_matrix_idx)
12889  IF(equations_matrix_number==dynamic_mapping%STIFFNESS_MATRIX_NUMBER) &
12890  & THEN
12891  alpha_value=alpha_value*stiffness_matrix_coefficient
12892  ENDIF
12893  IF(equations_matrix_number==dynamic_mapping%DAMPING_MATRIX_NUMBER) &
12894  & THEN
12895  alpha_value=alpha_value*damping_matrix_coefficient
12896  ENDIF
12897  IF(equations_matrix_number==dynamic_mapping%MASS_MATRIX_NUMBER) &
12898  & THEN
12899  alpha_value=alpha_value*mass_matrix_coefficient
12900  ENDIF
12901  equations_matrix=>dynamic_matrices% &
12902  & matrices(equations_matrix_number)%PTR
12903  equations_column_number=dynamic_mapping% &
12904  & var_to_equations_matrices_maps(variable_type)% &
12905  & dof_to_columns_maps(equations_matrix_idx)% &
12906  & column_dof(variable_dof)
12907  IF(ASSOCIATED(dependent_boundary_conditions% &
12908  & dirichlet_boundary_conditions)) THEN
12909  IF(dependent_boundary_conditions% &
12910  & number_of_dirichlet_conditions>0) THEN
12911  DO dirichlet_idx=1,dependent_boundary_conditions% &
12912  & number_of_dirichlet_conditions
12913  IF(dependent_boundary_conditions% &
12914  & dirichlet_boundary_conditions% &
12915  & dirichlet_dof_indices(dirichlet_idx)== &
12916  & equations_column_number) EXIT
12917  ENDDO
12918  SELECT CASE(equations_matrix%STORAGE_TYPE)
12919  CASE(distributed_matrix_block_storage_type)
12920  DO dirichlet_row=1,equations_matrices%TOTAL_NUMBER_OF_ROWS
12921  CALL distributed_matrix_values_get(equations_matrix% &
12922  & matrix,dirichlet_row,equations_column_number, &
12923  & matrix_value,err,error,*999)
12924  IF(abs(matrix_value)>=zero_tolerance) THEN
12925  DO solver_row_idx=1,solver_mapping% &
12926  & equations_set_to_solver_map(equations_set_idx)% &
12927  & equations_row_to_solver_rows_maps( &
12928  & dirichlet_row)%NUMBER_OF_SOLVER_ROWS
12929  solver_row_number=solver_mapping% &
12930  & equations_set_to_solver_map( &
12931  & equations_set_idx)% &
12932  & equations_row_to_solver_rows_maps( &
12933  & dirichlet_row)%SOLVER_ROWS(solver_row_idx)
12934  row_coupling_coefficient=solver_mapping% &
12935  & equations_set_to_solver_map( &
12936  & equations_set_idx)% &
12937  & equations_row_to_solver_rows_maps( &
12938  & dirichlet_row)%COUPLING_COEFFICIENTS( &
12939  & solver_row_idx)
12940  VALUE=-1.0_dp*matrix_value*alpha_value* &
12941  & row_coupling_coefficient
12942  CALL distributed_vector_values_add( &
12943  & solver_rhs_vector, &
12944  & solver_row_number,VALUE,err,error,*999)
12945  ENDDO !solver_row_idx
12946  ENDIF
12947  ENDDO !dirichlet_row
12948  CASE(distributed_matrix_diagonal_storage_type)
12949  dirichlet_row=equations_column_number
12950  CALL distributed_matrix_values_get(equations_matrix% &
12951  & matrix,dirichlet_row,equations_column_number, &
12952  & matrix_value,err,error,*999)
12953  IF(abs(matrix_value)>=zero_tolerance) THEN
12954  DO solver_row_idx=1,solver_mapping% &
12955  & equations_set_to_solver_map(equations_set_idx)% &
12956  & equations_row_to_solver_rows_maps( &
12957  & dirichlet_row)%NUMBER_OF_SOLVER_ROWS
12958  solver_row_number=solver_mapping% &
12959  & equations_set_to_solver_map( &
12960  & equations_set_idx)% &
12961  & equations_row_to_solver_rows_maps( &
12962  & dirichlet_row)%SOLVER_ROWS(solver_row_idx)
12963  row_coupling_coefficient=solver_mapping% &
12964  & equations_set_to_solver_map( &
12965  & equations_set_idx)% &
12966  & equations_row_to_solver_rows_maps( &
12967  & dirichlet_row)%COUPLING_COEFFICIENTS( &
12968  & solver_row_idx)
12969  VALUE=-1.0_dp*matrix_value*alpha_value* &
12970  & row_coupling_coefficient
12971  CALL distributed_vector_values_add( &
12972  & solver_rhs_vector, &
12973  & solver_row_number,VALUE,err,error,*999)
12974  ENDDO !solver_row_idx
12975  ENDIF
12976 
12977  CASE(distributed_matrix_column_major_storage_type)
12978  CALL flagerror("Not implemented.",err,error,*999)
12979  CASE(distributed_matrix_row_major_storage_type)
12980  CALL flagerror("Not implemented.",err,error,*999)
12981  CASE(distributed_matrix_compressed_row_storage_type)
12982  sparsity_indices=>dependent_boundary_conditions% &
12983  & dirichlet_boundary_conditions%DYNAMIC_SPARSITY_INDICES( &
12984  & equations_set_idx,equations_matrix_idx)%PTR
12985  IF(ASSOCIATED(sparsity_indices)) THEN
12986  DO equations_row_number2=sparsity_indices% &
12987  & sparse_column_indices(dirichlet_idx), &
12988  & sparsity_indices%SPARSE_COLUMN_INDICES( &
12989  & dirichlet_idx+1)-1
12990  dirichlet_row=sparsity_indices%SPARSE_ROW_INDICES( &
12991  & equations_row_number2)
12992  CALL distributed_matrix_values_get(equations_matrix% &
12993  & matrix,dirichlet_row,equations_column_number, &
12994  & matrix_value,err,error,*999)
12995  IF(abs(matrix_value)>=zero_tolerance) THEN
12996  DO solver_row_idx=1,solver_mapping% &
12997  & equations_set_to_solver_map(equations_set_idx)% &
12998  & equations_row_to_solver_rows_maps( &
12999  & dirichlet_row)%NUMBER_OF_SOLVER_ROWS
13000  solver_row_number=solver_mapping% &
13001  & equations_set_to_solver_map( &
13002  & equations_set_idx)% &
13003  & equations_row_to_solver_rows_maps( &
13004  & dirichlet_row)%SOLVER_ROWS(solver_row_idx)
13005  row_coupling_coefficient=solver_mapping% &
13006  & equations_set_to_solver_map( &
13007  & equations_set_idx)% &
13008  & equations_row_to_solver_rows_maps( &
13009  & dirichlet_row)%COUPLING_COEFFICIENTS( &
13010  & solver_row_idx)
13011  VALUE=-1.0_dp*matrix_value*alpha_value* &
13012  & row_coupling_coefficient
13013  CALL distributed_vector_values_add( &
13014  & solver_rhs_vector, &
13015  & solver_row_number,VALUE,err,error,*999)
13016  ENDDO !solver_row_idx
13017  ENDIF
13018  ENDDO !equations_row_number2
13019  ELSE
13020  CALL flagerror("Sparsity indices are not associated.", &
13021  & err,error,*999)
13022  ENDIF
13023  CASE(distributed_matrix_compressed_column_storage_type)
13024  CALL flagerror("Not implemented.",err,error,*999)
13025  CASE(distributed_matrix_row_column_storage_type)
13026  CALL flagerror("Not implemented.",err,error,*999)
13027  CASE DEFAULT
13028  local_error="The storage type of "// &
13029  & trim(numbertovstring(equations_matrix%STORAGE_TYPE,"*", &
13030  & err,error))//" is invalid."
13031  CALL flagerror(local_error,err,error,*999)
13032  END SELECT
13033  ENDIF
13034  ELSE
13035  CALL flagerror("Dirichlet boundary conditions is &
13036  & not associated.",err,error,*999)
13037  ENDIF
13038  ENDDO !matrix_idx
13039  ENDIF
13040  ENDIF
13041 ! ENDDO !variable_idx
13042  ENDIF
13043  ENDIF
13044 
13045  CASE(boundary_condition_dof_fixed)
13046  !Set Neumann boundary conditions
13047  !Loop over the solver rows associated with this equations set row
13048  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
13049  & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
13050  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
13051  & equations_row_to_solver_rows_maps(equations_row_number)%SOLVER_ROWS( &
13052  & solver_row_idx)
13053  row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
13054  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(equations_row_number)% &
13055  & coupling_coefficients(solver_row_idx)
13056  VALUE=rhs_parameters(rhs_variable_dof)*row_coupling_coefficient
13057  IF(has_integrated_values) THEN
13058  !Add any Neumann integrated values, b = f + N q
13059  CALL field_parameter_set_get_local_dof(rhs_variable%FIELD,rhs_variable_type, &
13060  & field_integrated_neumann_set_type,rhs_variable_dof,rhs_integrated_value, &
13061  & err,error,*999)
13062  VALUE=VALUE+rhs_integrated_value*row_coupling_coefficient
13063  END IF
13064  CALL distributed_vector_values_add(solver_rhs_vector,solver_row_number,VALUE, &
13065  & err,error,*999)
13066  ENDDO !solver_row_idx
13067  CASE(boundary_condition_dof_mixed)
13068  !Set Robin or is it Cauchy??? boundary conditions
13069  CALL flagerror("Mixed Boundary Conditions Not implemented.",err,error,*999)
13070  CASE DEFAULT
13071  local_error="The RHS boundary condition of "// &
13072  & trim(numbertovstring(rhs_boundary_condition,"*",err,error))// &
13073  & " for RHS variable dof number "// &
13074  & trim(numbertovstring(rhs_variable_dof,"*",err,error))//" is invalid."
13075  CALL flagerror(local_error,err,error,*999)
13076  END SELECT
13077  ENDDO !equations_row_number
13078  ELSE
13079  CALL flagerror("RHS boundary conditions variable is not associated.",err,error,*999)
13080  ENDIF
13081  ELSE
13082  CALL flagerror("Equations set boundary conditions is not associated.",err,error,*999)
13083  ENDIF
13084  ELSE
13085  CALL flagerror("Equations matrices RHS vector is not associated.",err,error,*999)
13086  ENDIF
13087  CALL field_parameter_set_data_restore(dependent_field,rhs_variable_type,field_values_set_type, &
13088  & rhs_parameters,err,error,*999)
13089  ELSE
13090  CALL flagerror("Equations mapping RHS mapping is not associated.",err,error,*999)
13091  ENDIF
13092  ELSE
13093  CALL flagerror("Equations equations mapping is not associated.",err,error,*999)
13094  ENDIF
13095  ELSE
13096  CALL flagerror("Equations equations matrices is not associated.",err,error,*999)
13097  ENDIF
13098  ELSE
13099  CALL flagerror("Equations set equations is not associated.",err,error,*999)
13100  ENDIF
13101  ELSE
13102  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
13103  ENDIF
13104  ELSE
13105  CALL flagerror("Equations set is not associated.",err,error,*999)
13106  ENDIF
13107  ENDDO !equations_set_idx
13108  !!!! TODO TODO !!!! ???
13109  !Add in any rows from any interface conditions
13110  DO interface_condition_idx=1,solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS
13111  interface_condition=>solver_mapping%INTERFACE_CONDITIONS(interface_condition_idx)%PTR
13112  IF(ASSOCIATED(interface_condition)) THEN
13113  SELECT CASE(interface_condition%METHOD)
13114  CASE(interface_condition_lagrange_multipliers_method,interface_condition_penalty_method)
13115  interface_equations=>interface_condition%INTERFACE_EQUATIONS
13116  IF(ASSOCIATED(interface_equations)) THEN
13117  interface_mapping=>interface_equations%INTERFACE_MAPPING
13118  IF(ASSOCIATED(interface_mapping)) THEN
13119  interface_lagrange=>interface_condition%LAGRANGE
13120  IF(ASSOCIATED(interface_lagrange)) THEN
13121  lagrange_field=>interface_lagrange%LAGRANGE_FIELD
13122  IF(ASSOCIATED(lagrange_field)) THEN
13123  interface_rhs_mapping=>interface_mapping%RHS_MAPPING
13124  IF(ASSOCIATED(interface_rhs_mapping)) THEN
13125  interface_matrices=>interface_equations%INTERFACE_MATRICES
13126  IF(ASSOCIATED(interface_matrices)) THEN
13127  interface_rhs_vector=>interface_matrices%RHS_VECTOR
13128  IF(ASSOCIATED(interface_rhs_vector)) THEN
13129  !Worry about BCs on the Lagrange variables later.
13130  DO interface_column_number=1,interface_mapping%TOTAL_NUMBER_OF_COLUMNS
13131  CALL distributed_vector_values_get(interface_rhs_vector%RHS_VECTOR, &
13132  & interface_column_number,rhs_value,err,error,*999)
13133  !Loop over the solver rows this interface column is mapped to
13134  DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
13135  & interface_condition_idx)%INTERFACE_COLUMN_TO_SOLVER_ROWS_MAPS( &
13136  & interface_column_number)%NUMBER_OF_SOLVER_ROWS
13137  solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
13138  & interface_condition_idx)%INTERFACE_COLUMN_TO_SOLVER_ROWS_MAPS( &
13139  & interface_column_number)%SOLVER_ROW
13140  row_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
13141  & interface_condition_idx)%INTERFACE_COLUMN_TO_SOLVER_ROWS_MAPS( &
13142  & interface_column_number)%COUPLING_COEFFICIENT
13143  VALUE=rhs_value*row_coupling_coefficient
13144  CALL distributed_vector_values_add(solver_rhs_vector,solver_row_number,VALUE, &
13145  & err,error,*999)
13146  ENDDO !solver_row_idx
13147  ENDDO !interface_column_idx
13148  ELSE
13149  CALL flagerror("Interface matrices RHS vector is not associated.",err,error,*999)
13150  ENDIF
13151  ELSE
13152  CALL flagerror("Interface equations interface matrices is not associated.",err,error,*999)
13153  ENDIF
13154  ELSE
13155  CALL flagerror("Interface mapping RHS mapping is not associated.",err,error,*999)
13156  ENDIF
13157  ELSE
13158  CALL flagerror("Interface Lagrange field is not associated.",err,error,*999)
13159  ENDIF
13160  ELSE
13161  CALL flagerror("Interface Lagrange is not associated.",err,error,*999)
13162  ENDIF
13163  ELSE
13164  CALL flagerror("Interface equations interface mapping is not associated.",err,error,*999)
13165  ENDIF
13166  ELSE
13167  CALL flagerror("Interface condition equations is not associated.",err,error,*999)
13168  ENDIF
13169  CASE(interface_condition_augmented_lagrange_method)
13170  CALL flagerror("Not implemented.",err,error,*999)
13171  CASE(interface_condition_point_to_point_method)
13172  CALL flagerror("Not implemented.",err,error,*999)
13173  CASE DEFAULT
13174  local_error="The interface condition method of "// &
13175  & trim(numbertovstring(interface_condition%METHOD,"*",err,error))// &
13176  & " is invalid."
13177  CALL flagerror(local_error,err,error,*999)
13178  END SELECT
13179  ELSE
13180  CALL flagerror("Interface condition is not associated.",err,error,*999)
13181  ENDIF
13182  ENDDO !interface_condition_idx
13183  !
13184  !Start the update the solver RHS vector values
13185  CALL distributed_vector_update_start(solver_rhs_vector,err,error,*999)
13186 
13187  NULLIFY(check_data)
13188  CALL distributed_vector_data_get(solver_rhs_vector,check_data,err,error,*999)
13189 
13190  ELSE
13191  CALL flagerror("The solver RHS vector is not associated.",err,error,*999)
13192  ENDIF
13193  ENDIF
13194  IF(solver%OUTPUT_TYPE>=solver_timing_output) THEN
13195  CALL cpu_timer(user_cpu,user_time2,err,error,*999)
13196  CALL cpu_timer(system_cpu,system_time2,err,error,*999)
13197  user_elapsed=user_time2(1)-user_time1(1)
13198  system_elapsed=system_time2(1)-system_time1(1)
13199  CALL write_string(general_output_type,"",err,error,*999)
13200  CALL write_string_value(general_output_type,"Total user time for solver RHS assembly = ",user_elapsed, &
13201  & err,error,*999)
13202  CALL write_string_value(general_output_type,"Total System time for solver RHS assembly = ",system_elapsed, &
13203  & err,error,*999)
13204  ENDIF
13205  ENDIF
13206  IF(ASSOCIATED(solver_rhs_vector)) THEN
13207  CALL distributed_vector_update_finish(solver_rhs_vector,err,error,*999)
13208  ENDIF
13209  END IF
13210 
13211  NULLIFY(solver_residual_vector)
13212  IF(selection_type==solver_matrices_all.OR. &
13213  & selection_type==solver_matrices_nonlinear_only.OR. &
13214  & selection_type==solver_matrices_residual_only.OR. &
13215  & selection_type==solver_matrices_rhs_residual_only) THEN
13216  IF(dynamic_solver%SOLVER_INITIALISED.OR.(.NOT.dynamic_solver%SOLVER_INITIALISED.AND. &
13217  & ((dynamic_solver%ORDER==solver_dynamic_first_order.AND.dynamic_solver%DEGREE>solver_dynamic_first_degree).OR. &
13218  & (dynamic_solver%ORDER==solver_dynamic_second_order.AND.dynamic_solver%DEGREE>solver_dynamic_second_degree)))) &
13219  & THEN
13220  !Assemble residual vector
13221  IF(solver%OUTPUT_TYPE>=solver_timing_output) THEN
13222  CALL cpu_timer(user_cpu,user_time1,err,error,*999)
13223  CALL cpu_timer(system_cpu,system_time1,err,error,*999)
13224  ENDIF
13225  IF(solver_matrices%UPDATE_RESIDUAL) THEN
13226  solver_residual_vector=>solver_matrices%RESIDUAL
13227  IF(ASSOCIATED(solver_residual_vector)) THEN
13228  !Initialise the residual to zero
13229  CALL distributed_vector_all_values_set(solver_residual_vector,0.0_dp,err,error,*999)
13230  !Get the solver variables data
13231  NULLIFY(check_data)
13232  CALL distributed_vector_data_get(solver_residual_vector,check_data,err,error,*999)
13233  !Loop over the equations sets
13234  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
13235  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
13236  IF(ASSOCIATED(equations_set)) THEN
13237  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
13238  IF(ASSOCIATED(dependent_field)) THEN
13239  equations=>equations_set%EQUATIONS
13240  IF(ASSOCIATED(equations)) THEN
13241  equations_matrices=>equations%EQUATIONS_MATRICES
13242  IF(ASSOCIATED(equations_matrices)) THEN
13243  equations_mapping=>equations%EQUATIONS_MAPPING
13244  IF(ASSOCIATED(equations_mapping)) THEN
13245  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
13246  IF(ASSOCIATED(dynamic_mapping)) THEN
13247  dynamic_variable_type=dynamic_mapping%DYNAMIC_VARIABLE_TYPE
13248  !Calculate the dynamic contributions
13249  dynamic_variable=>dynamic_mapping%DYNAMIC_VARIABLE
13250  IF(ASSOCIATED(dynamic_variable)) THEN
13251  dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
13252  IF(ASSOCIATED(dynamic_matrices)) THEN
13253  dynamic_temp_vector=>dynamic_matrices%TEMP_VECTOR
13254  !Initialise the dynamic temporary vector to zero
13255  CALL distributed_vector_all_values_set(dynamic_temp_vector,0.0_dp,err,error,*999)
13256  NULLIFY(incremental_vector)
13257  !Define the pointer to the INCREMENTAL_VECTOR
13258  CALL field_parameter_set_vector_get(dependent_field,dynamic_variable_type, &
13259  & field_incremental_values_set_type,incremental_vector,err,error,*999)
13260  IF(dynamic_mapping%STIFFNESS_MATRIX_NUMBER/=0) THEN
13261  stiffness_matrix=>dynamic_matrices%MATRICES(dynamic_mapping%STIFFNESS_MATRIX_NUMBER)%PTR
13262  IF(ASSOCIATED(stiffness_matrix)) THEN
13263  CALL distributed_matrix_by_vector_add(distributed_matrix_vector_no_ghosts_type, &
13264  & stiffness_matrix_coefficient,stiffness_matrix%MATRIX,incremental_vector, &
13265  & dynamic_temp_vector,err,error,*999)
13266  ELSE
13267  CALL flagerror("Dynamic stiffness matrix is not associated.",err,error,*999)
13268  ENDIF
13269  ENDIF
13270  IF(dynamic_mapping%DAMPING_MATRIX_NUMBER/=0.AND. &
13271  & dynamic_solver%DEGREE>=solver_dynamic_first_degree) THEN
13272  damping_matrix=>dynamic_matrices%MATRICES(dynamic_mapping%DAMPING_MATRIX_NUMBER)%PTR
13273  IF(ASSOCIATED(damping_matrix)) THEN
13274  CALL distributed_matrix_by_vector_add(distributed_matrix_vector_no_ghosts_type, &
13275  & damping_matrix_coefficient,damping_matrix%MATRIX,incremental_vector, &
13276  & dynamic_temp_vector,err,error,*999)
13277  ELSE
13278  CALL flagerror("Dynamic damping matrix is not associated.",err,error,*999)
13279  ENDIF
13280  ENDIF
13281  IF(dynamic_mapping%MASS_MATRIX_NUMBER/=0.AND. &
13282  & dynamic_solver%DEGREE>=solver_dynamic_second_degree) THEN
13283  mass_matrix=>dynamic_matrices%MATRICES(dynamic_mapping%MASS_MATRIX_NUMBER)%PTR
13284  IF(ASSOCIATED(mass_matrix)) THEN
13285  CALL distributed_matrix_by_vector_add(distributed_matrix_vector_no_ghosts_type, &
13286  & mass_matrix_coefficient,mass_matrix%MATRIX,incremental_vector, &
13287  & dynamic_temp_vector,err,error,*999)
13288  ELSE
13289  CALL flagerror("Dynamic mass matrix is not associated.",err,error,*999)
13290  ENDIF
13291  ENDIF
13292  ELSE
13293  CALL flagerror("Dynamic variable is not associated.",err,error,*999)
13294  ENDIF
13295  ELSE
13296  CALL flagerror("Equations matrices dynamic matrices is not associated.",err,error,*999)
13297  ENDIF
13298  ENDIF
13299  !Calculate the contributions from any linear matrices
13300  linear_mapping=>equations_mapping%LINEAR_MAPPING
13301  IF(ASSOCIATED(linear_mapping)) THEN
13302  linear_matrices=>equations_matrices%LINEAR_MATRICES
13303  IF(ASSOCIATED(linear_matrices)) THEN
13304  DO equations_matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
13305  linear_matrix=>linear_matrices%MATRICES(equations_matrix_idx)%PTR
13306  IF(ASSOCIATED(linear_matrix)) THEN
13307  linear_variable_type=linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(equations_matrix_idx)% &
13308  & variable_type
13309  linear_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(equations_matrix_idx)% &
13310  & variable
13311  IF(ASSOCIATED(linear_variable)) THEN
13312  linear_temp_vector=>linear_matrix%TEMP_VECTOR
13313  !Initialise the linear temporary vector to zero
13314  CALL distributed_vector_all_values_set(linear_temp_vector,0.0_dp,err,error,*999)
13315  NULLIFY(dependent_vector)
13316  CALL field_parameter_set_vector_get(dependent_field,linear_variable_type, &
13317  & field_values_set_type,dependent_vector,err,error,*999)
13318  CALL distributed_matrix_by_vector_add(distributed_matrix_vector_no_ghosts_type, &
13319  & 1.0_dp,linear_matrix%MATRIX,dependent_vector,linear_temp_vector,err,error,*999)
13320  ELSE
13321  CALL flagerror("Linear variable is not associated.",err,error,*999)
13322  ENDIF
13323  ELSE
13324  local_error="Linear matrix is not associated for linear matrix number "// &
13325  & trim(numbertovstring(equations_matrix_idx,"*",err,error))//"."
13326  CALL flagerror(local_error,err,error,*999)
13327  ENDIF
13328  ENDDO !equations_matrix_idx
13329  ELSE
13330  CALL flagerror("Equations matrices linear matrices is not associated.",err,error,*999)
13331  ENDIF
13332  ENDIF
13333  !Calculate the solver residual
13334  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
13335  IF(ASSOCIATED(nonlinear_mapping)) THEN
13336  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
13337  IF(ASSOCIATED(nonlinear_matrices)) THEN
13338  residual_vector=>nonlinear_matrices%RESIDUAL
13339  !Loop over the rows in the equations set
13340  DO equations_row_number=1,equations_mapping%TOTAL_NUMBER_OF_ROWS
13341  IF(solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
13342  & equations_row_to_solver_rows_maps(equations_row_number)% &
13343  & number_of_solver_rows>0) THEN
13344  !Get the equations residual contribution
13345  CALL distributed_vector_values_get(residual_vector,equations_row_number, &
13346  & residual_value,err,error,*999)
13347  IF(stability_test) THEN
13348  residual_value=residual_value
13349  ELSE
13350  residual_value=residual_value*dynamic_solver%THETA(1)
13351  ENDIF
13352  !Get the linear matrices contribution to the RHS values if there are any
13353  IF(ASSOCIATED(linear_mapping)) THEN
13354  linear_value_sum=0.0_dp
13355  DO equations_matrix_idx2=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
13356  linear_matrix=>linear_matrices%MATRICES(equations_matrix_idx2)%PTR
13357  linear_temp_vector=>linear_matrix%TEMP_VECTOR
13358  CALL distributed_vector_values_get(linear_temp_vector,equations_row_number, &
13359  & linear_value,err,error,*999)
13360  linear_value_sum=linear_value_sum+linear_value
13361  ENDDO !equations_matrix_idx2
13362  residual_value=residual_value+linear_value_sum
13363  ENDIF
13364  IF(ASSOCIATED(dynamic_mapping)) THEN
13365  !Get the dynamic contribution to the residual values
13366  CALL distributed_vector_values_get(dynamic_temp_vector,equations_row_number, &
13367  & dynamic_value,err,error,*999)
13368  residual_value=residual_value+dynamic_value
13369  ENDIF
13370  !Loop over the solver rows associated with this equations set residual row
13371  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
13372  & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
13373  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
13374  & equations_row_to_solver_rows_maps(equations_row_number)%SOLVER_ROWS( &
13375  & solver_row_idx)
13376  row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
13377  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(equations_row_number)% &
13378  & coupling_coefficients(solver_row_idx)
13379  VALUE=residual_value*row_coupling_coefficient
13380  !Add in nonlinear residual values
13381  CALL distributed_vector_values_add(solver_residual_vector,solver_row_number,VALUE, &
13382  & err,error,*999)
13383  ENDDO !solver_row_idx
13384  ENDIF
13385  ENDDO !equations_row_number
13386  ELSE
13387  CALL flagerror("Equations matrices nonlinear matrices is not associated.",err,error,*999)
13388  ENDIF
13389  ELSE
13390  CALL flagerror("Equations mapping nonlinear mapping is not associated.",err,error,*999)
13391  ENDIF
13392  ELSE
13393  CALL flagerror("Equations equations mapping is not associated.",err,error,*999)
13394  ENDIF
13395  ELSE
13396  CALL flagerror("Equations equations matrices is not associated.",err,error,*999)
13397  ENDIF
13398  ELSE
13399  CALL flagerror("Equations set equations is not associated.",err,error,*999)
13400  ENDIF
13401  ELSE
13402  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
13403  ENDIF
13404  ELSE
13405  CALL flagerror("Equations set is not associated.",err,error,*999)
13406  ENDIF
13407  ENDDO !equations_set_idx
13408 
13409  !Loop over the interface conditions
13410  DO interface_condition_idx=1,solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS
13411  interface_condition=>solver_mapping%INTERFACE_CONDITIONS(interface_condition_idx)%PTR
13412  IF(ASSOCIATED(interface_condition)) THEN
13413  lagrange_field=>interface_condition%LAGRANGE%LAGRANGE_FIELD
13414  IF(ASSOCIATED(lagrange_field)) THEN
13415  interface_equations=>interface_condition%INTERFACE_EQUATIONS
13416  IF(ASSOCIATED(interface_equations)) THEN
13417  interface_matrices=>interface_equations%INTERFACE_MATRICES
13418  IF(ASSOCIATED(interface_matrices)) THEN
13419  interface_mapping=>interface_equations%INTERFACE_MAPPING
13420  IF(ASSOCIATED(interface_mapping)) THEN
13421  SELECT CASE(interface_condition%METHOD)
13422  CASE(interface_condition_lagrange_multipliers_method)
13423  number_of_interface_matrices=interface_mapping%NUMBER_OF_INTERFACE_MATRICES
13424  CASE(interface_condition_penalty_method)
13425  number_of_interface_matrices=interface_mapping%NUMBER_OF_INTERFACE_MATRICES-1
13426  ENDSELECT
13427  !Calculate the contributions from any interface matrices
13428  DO interface_matrix_idx=1,number_of_interface_matrices
13429  !Calculate the interface matrix-Lagrange vector product residual contribution
13430  interface_matrix=>interface_matrices%MATRICES(interface_matrix_idx)%PTR
13431  IF(ASSOCIATED(interface_matrix)) THEN
13432  interface_variable_type=interface_mapping%LAGRANGE_VARIABLE_TYPE
13433  interface_variable=>interface_mapping%LAGRANGE_VARIABLE
13434  IF(ASSOCIATED(interface_variable)) THEN
13435  interface_temp_vector=>interface_matrix%TEMP_VECTOR
13436  !Initialise the linear temporary vector to zero
13437  CALL distributed_vector_all_values_set(interface_temp_vector,0.0_dp,err,error,*999)
13438  NULLIFY(lagrange_vector)
13439  CALL field_parameter_set_vector_get(lagrange_field,interface_variable_type, &
13440  & field_values_set_type,lagrange_vector,err,error,*999)
13441 
13442  !
13443  SELECT CASE(interface_matrix%INTERFACE_MATRIX_TIME_DEPENDENCE_TYPE)
13444  CASE(interface_matrix_static)
13445  matrixcoefficients(1)=stiffness_matrix_coefficient
13446  CASE(interface_matrix_first_order_dynamic)
13447  matrixcoefficients(1)=damping_matrix_coefficient
13448  CASE DEFAULT
13449  CALL flagerror("Not implemented.",err,error,*999)
13450  END SELECT
13451  IF(interface_matrix%HAS_TRANSPOSE) THEN
13452  SELECT CASE(interface_matrix%INTERFACE_MATRIX_TRANSPOSE_TIME_DEPENDENCE_TYPE)
13453  CASE(interface_matrix_static)
13454  matrixcoefficients(2)=stiffness_matrix_coefficient
13455  CASE(interface_matrix_first_order_dynamic)
13456  matrixcoefficients(2)=damping_matrix_coefficient
13457  CASE DEFAULT
13458 
13459  CALL flagerror("Not implemented.",err,error,*999)
13460  END SELECT
13461  ELSE
13462  matrixcoefficients(2)=0.0_dp
13463  ENDIF
13464  !
13465 
13466 
13467  ! CALL DISTRIBUTED_MATRIX_BY_VECTOR_ADD(DISTRIBUTED_MATRIX_VECTOR_NO_GHOSTS_TYPE,1.0_DP, &
13468  ! & INTERFACE_MATRIX%MATRIX,LAGRANGE_VECTOR,INTERFACE_TEMP_VECTOR,ERR,ERROR,*999)
13469  CALL distributed_matrix_by_vector_add(distributed_matrix_vector_no_ghosts_type, &
13470  & matrixcoefficients(1),interface_matrix%MATRIX,lagrange_vector,interface_temp_vector, &
13471  & err,error,*999)
13472 
13473  !Add interface matrix residual contribution to the solver residual
13474  DO interface_row_number=1,interface_matrix%NUMBER_OF_ROWS
13475  IF(solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
13476  & interface_to_solver_matrix_maps_im(interface_matrix_idx)% &
13477  & interface_row_to_solver_rows_map(interface_row_number)%NUMBER_OF_SOLVER_ROWS>0) THEN
13478  !Loop over the solver rows associated with this interface residual row
13479  !Currently earch interface matrix row has only one corresponding solver row number & coupling coefficient
13480  solver_row_number=solver_mapping% &
13481  & interface_condition_to_solver_map(interface_condition_idx)% &
13482  & interface_to_solver_matrix_maps_im(interface_matrix_idx)% &
13483  & interface_row_to_solver_rows_map(interface_row_number)%SOLVER_ROW
13484  row_coupling_coefficient=solver_mapping% &
13485  & interface_condition_to_solver_map(interface_condition_idx)% &
13486  & interface_to_solver_matrix_maps_im(interface_matrix_idx)% &
13487  & interface_row_to_solver_rows_map(interface_row_number)%COUPLING_COEFFICIENT
13488  CALL distributed_vector_values_get(interface_temp_vector,interface_row_number, &
13489  & residual_value,err,error,*999)
13490  VALUE=residual_value*row_coupling_coefficient
13491  !Add in nonlinear residual values
13492  CALL distributed_vector_values_add(solver_residual_vector,solver_row_number,VALUE, &
13493  & err,error,*999)
13494  ENDIF
13495  ENDDO !interface_row_number
13496  ELSE
13497  CALL flagerror("Interface variable is not associated.",err,error,*999)
13498  ENDIF
13499  !Calculate the transposed interface matrix-dependent variable product residual contribution
13500  dependent_variable_type=interface_mapping% &
13501  & interface_matrix_rows_to_var_maps(interface_matrix_idx)%VARIABLE_TYPE
13502  dependent_variable=>interface_mapping% &
13503  & interface_matrix_rows_to_var_maps(interface_matrix_idx)%VARIABLE
13504  IF(ASSOCIATED(dependent_variable)) THEN
13505  interface_temp_vector=>interface_matrix%TEMP_TRANSPOSE_VECTOR
13506  !Initialise the linear temporary vector to zero
13507  CALL distributed_vector_all_values_set(interface_temp_vector,0.0_dp,err,error,*999)
13508  NULLIFY(dependent_vector)
13509  dependent_field=>dependent_variable%FIELD
13510  !hard-coded for now TODO under the assumption that the first equations set is the solid
13511  !equations set and the second equations set is the fluid equations set
13512  !FSI only - needs to be extended/generalized for other coupled problems TODO
13513  IF(interface_matrix_idx==1) THEN
13514  CALL field_parameter_set_vector_get(dependent_field,dependent_variable_type, &
13515  & field_incremental_values_set_type,dependent_vector,err,error,*999)
13516  ELSE
13517  CALL field_parameter_set_vector_get(dependent_field,dependent_variable_type, &
13518  & field_values_set_type,dependent_vector,err,error,*999)
13519  ENDIF
13520  ! CALL DISTRIBUTED_MATRIX_BY_VECTOR_ADD(DISTRIBUTED_MATRIX_VECTOR_NO_GHOSTS_TYPE,1.0_DP, &
13521  ! & INTERFACE_MATRIX%MATRIX_TRANSPOSE,DEPENDENT_VECTOR,INTERFACE_TEMP_VECTOR,ERR,ERROR,*999)
13522  CALL distributed_matrix_by_vector_add(distributed_matrix_vector_no_ghosts_type, &
13523  & matrixcoefficients(2),interface_matrix%MATRIX_TRANSPOSE,dependent_vector, &
13524  & interface_temp_vector,err,error,*999)
13525 
13526  !Add interface matrix residual contribution to the solver residual.
13527  !The number of columns in the interface matrix is equivalent to the number of rows of the transposed interface matrices
13528  DO interface_row_number=1,interface_matrices%NUMBER_OF_COLUMNS
13529  IF(solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
13530  & interface_column_to_solver_rows_maps(interface_row_number)% &
13531  & number_of_solver_rows>0) THEN
13532  !Loop over the solver rows associated with this interface residual row
13533  !Currently earch interface matrix row has only one corresponding solver row number & coupling coefficient
13534  solver_row_number=solver_mapping% &
13535  & interface_condition_to_solver_map(interface_condition_idx)% &
13536  & interface_column_to_solver_rows_maps(interface_row_number)%SOLVER_ROW
13537  row_coupling_coefficient=solver_mapping% &
13538  & interface_condition_to_solver_map(interface_condition_idx)% &
13539  & interface_column_to_solver_rows_maps(interface_row_number)%COUPLING_COEFFICIENT
13540  CALL distributed_vector_values_get(interface_temp_vector,interface_row_number, &
13541  & residual_value,err,error,*999)
13542  ! IF(interface_matrix_idx==1) THEN
13543  ! VALUE=RESIDUAL_VALUE*row_coupling_coefficient/DELTA_T
13544  ! ELSE
13545  VALUE=residual_value*row_coupling_coefficient
13546  ! ENDIF
13547  !Add in nonlinear residual values
13548  CALL distributed_vector_values_add(solver_residual_vector,solver_row_number,VALUE, &
13549  & err,error,*999)
13550  ENDIF
13551  ENDDO !interface_row_number
13552  ELSE
13553  CALL flagerror("Dependent variable is not associated.",err,error,*999)
13554  ENDIF
13555  ELSE
13556  local_error="Interface matrix is not associated for linear matrix number "// &
13557  & trim(numbertovstring(equations_matrix_idx,"*",err,error))//"."
13558  CALL flagerror(local_error,err,error,*999)
13559  ENDIF
13560  ENDDO !interface_matrix_idx
13561  SELECT CASE(interface_condition%METHOD)
13562  CASE(interface_condition_penalty_method)
13563  interface_matrix_idx=interface_mapping%NUMBER_OF_INTERFACE_MATRICES
13564  !Calculate the Lagrange-Lagrange vector product residual contribution from the penalty term
13565  interface_matrix=>interface_matrices%MATRICES(interface_matrix_idx)%PTR
13566  IF(ASSOCIATED(interface_matrix)) THEN
13567  interface_variable_type=interface_mapping%LAGRANGE_VARIABLE_TYPE
13568  interface_variable=>interface_mapping%LAGRANGE_VARIABLE
13569  IF(ASSOCIATED(interface_variable)) THEN
13570  interface_temp_vector=>interface_matrix%TEMP_VECTOR
13571  !Initialise the linear temporary vector to zero
13572  CALL distributed_vector_all_values_set(interface_temp_vector,0.0_dp,err,error,*999)
13573  NULLIFY(lagrange_vector)
13574  CALL field_parameter_set_vector_get(lagrange_field,interface_variable_type, &
13575  & field_values_set_type,lagrange_vector,err,error,*999)
13576  CALL distributed_matrix_by_vector_add(distributed_matrix_vector_no_ghosts_type,1.0_dp, &
13577  & interface_matrix%MATRIX,lagrange_vector,interface_temp_vector,err,error,*999)
13578  !Add interface matrix residual contribution to the solver residual
13579  DO interface_row_number=1,interface_matrix%NUMBER_OF_ROWS
13580  IF(solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
13581  & interface_to_solver_matrix_maps_im(interface_matrix_idx)% &
13582  & interface_row_to_solver_rows_map(interface_row_number)%NUMBER_OF_SOLVER_ROWS>0) THEN
13583  !Loop over the solver rows associated with this interface residual row
13584  !Currently earch interface matrix row has only one corresponding solver row number & coupling coefficient
13585  solver_row_number=solver_mapping% &
13586  & interface_condition_to_solver_map(interface_condition_idx)% &
13587  & interface_to_solver_matrix_maps_im(interface_matrix_idx)% &
13588  & interface_row_to_solver_rows_map(interface_row_number)%SOLVER_ROW
13589  row_coupling_coefficient=solver_mapping% &
13590  & interface_condition_to_solver_map(interface_condition_idx)% &
13591  & interface_to_solver_matrix_maps_im(interface_matrix_idx)% &
13592  & interface_row_to_solver_rows_map(interface_row_number)%COUPLING_COEFFICIENT
13593  CALL distributed_vector_values_get(interface_temp_vector,interface_row_number, &
13594  & residual_value,err,error,*999)
13595  VALUE=residual_value*row_coupling_coefficient
13596  !Add in nonlinear residual values
13597  CALL distributed_vector_values_add(solver_residual_vector,solver_row_number,VALUE, &
13598  & err,error,*999)
13599  ENDIF
13600  ENDDO !interface_row_number
13601  ELSE
13602  CALL flagerror("Interface variable is not associated.",err,error,*999)
13603  ENDIF
13604  ELSE
13605  local_error="Interface matrix is not associated for linear matrix number "// &
13606  & trim(numbertovstring(equations_matrix_idx,"*",err,error))//"."
13607  CALL flagerror(local_error,err,error,*999)
13608  ENDIF
13609  ENDSELECT
13610  ELSE
13611  CALL flagerror("Interface mapping is not associated.",err,error,*999)
13612  ENDIF
13613  ELSE
13614  CALL flagerror("Interface matrices is not associated.",err,error,*999)
13615  ENDIF
13616  ELSE
13617  CALL flagerror("Interface equations is not associated.",err,error,*999)
13618  ENDIF
13619  ELSE
13620  CALL flagerror("Interface Lagrange field is not associated.",err,error,*999)
13621  ENDIF
13622  ELSE
13623  CALL flagerror("Interface condition is not associated.",err,error,*999)
13624  ENDIF
13625  ENDDO !interface_condition_idx
13626  !
13627  !Start the update the solver residual vector values
13628  CALL distributed_vector_update_start(solver_residual_vector,err,error,*999)
13629 
13630  NULLIFY(check_data2)
13631  CALL distributed_vector_data_get(solver_residual_vector,check_data2,err,error,*999)
13632 
13633  ELSE
13634  CALL flagerror("The solver residual vector is not associated.",err,error,*999)
13635  ENDIF
13636  ENDIF
13637  IF(ASSOCIATED(solver_residual_vector)) THEN
13638  CALL distributed_vector_update_finish(solver_residual_vector,err,error,*999)
13639  ENDIF
13640  IF(solver%OUTPUT_TYPE>=solver_timing_output) THEN
13641  CALL cpu_timer(user_cpu,user_time2,err,error,*999)
13642  CALL cpu_timer(system_cpu,system_time2,err,error,*999)
13643  user_elapsed=user_time2(1)-user_time1(1)
13644  system_elapsed=system_time2(1)-system_time1(1)
13645  CALL write_string(general_output_type,"",err,error,*999)
13646  CALL write_string_value(general_output_type,"Total user time for solver residual assembly = ", &
13647  & user_elapsed,err,error,*999)
13648  CALL write_string_value(general_output_type,"Total System time for solver residual assembly = ", &
13649  & system_elapsed,err,error,*999)
13650  ENDIF
13651  ENDIF
13652  ENDIF
13653 
13654  IF(dynamic_solver%SOLVER_INITIALISED) THEN
13655  !Set the first part of the next time step. Note that we do not have to add in the previous time value as it is
13656  !already there from when we copied the values to the previous time step.
13657  !Loop over the equations sets
13658  IF(dynamic_solver%DEGREE>solver_dynamic_first_degree) THEN
13659  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
13660  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
13661  IF(ASSOCIATED(equations_set)) THEN
13662  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
13663  IF(ASSOCIATED(dependent_field)) THEN
13664  equations=>equations_set%EQUATIONS
13665  IF(ASSOCIATED(equations)) THEN
13666  equations_mapping=>equations%EQUATIONS_MAPPING
13667  IF(ASSOCIATED(equations_mapping)) THEN
13668  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
13669  IF(ASSOCIATED(dynamic_mapping)) THEN
13670  dynamic_variable_type=dynamic_mapping%DYNAMIC_VARIABLE_TYPE
13671  SELECT CASE(dynamic_solver%DEGREE)
13672  CASE(solver_dynamic_first_degree)
13673  !Do nothing. Increment will be added after the solve.
13674  CASE(solver_dynamic_second_degree)
13675  CALL field_parameter_sets_add(dependent_field,dynamic_variable_type,first_update_factor, &
13676  & field_previous_velocity_set_type,field_values_set_type,err,error,*999)
13677  CASE(solver_dynamic_third_degree)
13678  CALL field_parameter_sets_add(dependent_field,dynamic_variable_type,[first_update_factor, &
13679  & second_update_factor],[field_previous_velocity_set_type,field_previous_values_set_type], &
13680  & field_values_set_type,err,error,*999)
13681  CALL field_parameter_sets_add(dependent_field,dynamic_variable_type,first_update_factor, &
13682  & field_previous_acceleration_set_type,field_velocity_values_set_type,err,error,*999)
13683  CASE DEFAULT
13684  local_error="The dynamic solver degree of "// &
13685  & trim(numbertovstring(dynamic_solver%DEGREE,"*",err,error))//" is invalid."
13686  CALL flagerror(local_error,err,error,*999)
13687  END SELECT
13688  ELSE
13689  local_error="Equations mapping dynamic mapping is not associated for equations set index number "// &
13690  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
13691  CALL flagerror(local_error,err,error,*999)
13692  ENDIF
13693  ELSE
13694  local_error="Equations equations mapping is not associated for equations set index number "// &
13695  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
13696  CALL flagerror(local_error,err,error,*999)
13697  ENDIF
13698  ELSE
13699  local_error="Equations set equations is not associated for equations set index number "// &
13700  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
13701  CALL flagerror(local_error,err,error,*999)
13702  ENDIF
13703  ELSE
13704  local_error="Equations set dependent field is not associated for equations set index number "// &
13705  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
13706  CALL flagerror(local_error,err,error,*999)
13707  ENDIF
13708  ELSE
13709  local_error="Equations set is not associated for equations set index number "// &
13710  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
13711  CALL flagerror(local_error,err,error,*999)
13712  ENDIF
13713  ENDDO !equations_set_idx
13714  ENDIF
13715  ENDIF
13716  !If required output the solver matrices
13717  IF(solver%OUTPUT_TYPE>=solver_matrix_output) THEN
13718  CALL solver_matrices_output(general_output_type,selection_type,solver_matrices,err,error,*999)
13719  ENDIF
13720  ELSE
13721  CALL flagerror("Solver solver matrices is not associated.",err,error,*999)
13722  ENDIF
13723  ELSE
13724  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
13725  ENDIF
13726  ELSE
13727  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
13728  ENDIF
13729  ELSE
13730  CALL flagerror("Solver dynamic solver is not associated.",err,error,*999)
13731  ENDIF
13732  ELSE
13733  CALL flagerror("Solver is not associated.",err,error,*999)
13734  ENDIF
13735 
13736  exits("SOLVER_MATRICES_DYNAMIC_ASSEMBLE")
13737  RETURN
13738 999 errorsexits("SOLVER_MATRICES_DYNAMIC_ASSEMBLE",err,error)
13739  RETURN 1
13740  END SUBROUTINE solver_matrices_dynamic_assemble
13741 
13742  !
13743  !================================================================================================================================
13744  !
13745 
13747  SUBROUTINE solver_matrices_static_assemble(SOLVER,SELECTION_TYPE,ERR,ERROR,*)
13748 
13749  !Argument variable
13750  TYPE(solver_type), POINTER :: SOLVER
13751  INTEGER(INTG), INTENT(IN) :: SELECTION_TYPE
13752  INTEGER(INTG), INTENT(OUT) :: ERR
13753  TYPE(varying_string), INTENT(OUT) :: ERROR
13754  !Local Variables
13755  INTEGER(INTG) :: dependent_variable_type,interface_variable_type,equations_column_number,equations_matrix_idx, &
13756  & equations_matrix_number,interface_row_number,equations_row_number,equations_row_number2,equations_set_idx, &
13757  & interface_column_number,interface_condition_idx,interface_matrix_idx,LINEAR_VARIABLE_TYPE,rhs_boundary_condition, &
13758  & rhs_global_dof,equations_matrix_idx2,rhs_variable_dof,rhs_variable_type,variable_boundary_condition,solver_matrix_idx, &
13759  & solver_row_idx,solver_row_number,variable_dof,variable_global_dof,variable_idx,variable_type,&
13760  & dirichlet_idx,dirichlet_row,number_of_interface_matrices
13761  REAL(SP) :: SYSTEM_ELAPSED,SYSTEM_TIME1(1),SYSTEM_TIME2(1),USER_ELAPSED,USER_TIME1(1),USER_TIME2(1)
13762  REAL(DP) :: DEPENDENT_VALUE,LINEAR_VALUE,LINEAR_VALUE_SUM,MATRIX_VALUE,RESIDUAL_VALUE,RHS_VALUE,row_coupling_coefficient, &
13763  & SOURCE_VALUE,VALUE,RHS_INTEGRATED_VALUE
13764  REAL(DP), POINTER :: RHS_PARAMETERS(:),CHECK_DATA(:),CHECK_DATA2(:),CHECK_DATA3(:),CHECK_DATA4(:)
13765  LOGICAL :: SUBTRACT_FIXED_BCS_FROM_RESIDUAL,HAS_INTEGRATED_VALUES
13766  TYPE(real_dp_ptr_type), ALLOCATABLE :: DEPENDENT_PARAMETERS(:)
13767  TYPE(boundary_conditions_type), POINTER :: BOUNDARY_CONDITIONS
13768  TYPE(boundary_conditions_variable_type), POINTER :: DEPENDENT_BOUNDARY_CONDITIONS,RHS_BOUNDARY_CONDITIONS
13769  TYPE(distributed_matrix_type), POINTER :: PREVIOUS_SOLVER_DISTRIBUTED_MATRIX,SOLVER_DISTRIBUTED_MATRIX
13770  TYPE(distributed_vector_type), POINTER :: LAGRANGE_VECTOR,DEPENDENT_VECTOR,DISTRIBUTED_SOURCE_VECTOR,EQUATIONS_RHS_VECTOR, &
13771  & LINEAR_TEMP_VECTOR,INTERFACE_TEMP_VECTOR,RESIDUAL_VECTOR,SOLVER_RESIDUAL_VECTOR,SOLVER_RHS_VECTOR
13772  TYPE(domain_mapping_type), POINTER :: RHS_DOMAIN_MAPPING,VARIABLE_DOMAIN_MAPPING
13773  TYPE(equations_jacobian_type), POINTER :: JACOBIAN_MATRIX
13774  TYPE(equations_type), POINTER :: EQUATIONS
13775  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
13776  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
13777  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
13778  TYPE(equations_mapping_rhs_type), POINTER :: RHS_MAPPING
13779  TYPE(equations_mapping_source_type), POINTER :: SOURCE_MAPPING
13780  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
13781  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
13782  TYPE(equations_matrices_nonlinear_type), POINTER :: NONLINEAR_MATRICES
13783  TYPE(equations_matrices_rhs_type), POINTER :: RHS_VECTOR
13784  TYPE(equations_matrices_source_type), POINTER :: SOURCE_VECTOR
13785  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX,LINEAR_MATRIX
13786  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
13787  TYPE(equations_to_solver_maps_type), POINTER :: EQUATIONS_TO_SOLVER_MAP
13788  TYPE(field_type), POINTER :: DEPENDENT_FIELD,LAGRANGE_FIELD
13789  TYPE(field_variable_type), POINTER :: INTERFACE_VARIABLE,DEPENDENT_VARIABLE,LINEAR_VARIABLE,RHS_VARIABLE
13790  TYPE(interface_condition_type), POINTER :: INTERFACE_CONDITION
13791  TYPE(interface_equations_type), POINTER :: INTERFACE_EQUATIONS
13792  TYPE(interface_lagrange_type), POINTER :: INTERFACE_LAGRANGE
13793  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
13794  TYPE(interface_mapping_rhs_type), POINTER :: INTERFACE_RHS_MAPPING
13795  TYPE(interface_matrices_type), POINTER :: INTERFACE_MATRICES
13796  TYPE(interface_matrix_type), POINTER :: INTERFACE_MATRIX
13797  TYPE(interface_rhs_type), POINTER :: INTERFACE_RHS_VECTOR
13798  TYPE(interface_to_solver_maps_type), POINTER :: INTERFACE_TO_SOLVER_MAP
13799  TYPE(jacobian_to_solver_map_type), POINTER :: JACOBIAN_TO_SOLVER_MAP
13800  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
13801  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
13802  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
13803  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
13804  TYPE(varying_string) :: LOCAL_ERROR
13805  TYPE(boundary_conditions_sparsity_indices_type), POINTER :: SPARSITY_INDICES
13806 
13807  enters("SOLVER_MATRICES_STATIC_ASSEMBLE",err,error,*999)
13808 
13809  IF(ASSOCIATED(solver)) THEN
13810  solver_equations=>solver%SOLVER_EQUATIONS
13811  IF(ASSOCIATED(solver_equations)) THEN
13812  solver_mapping=>solver_equations%SOLVER_MAPPING
13813  IF(ASSOCIATED(solver_mapping)) THEN
13814  solver_matrices=>solver_equations%SOLVER_MATRICES
13815  IF(ASSOCIATED(solver_matrices)) THEN
13816  !Assemble the solver matrices
13817  NULLIFY(previous_solver_distributed_matrix)
13818  IF(selection_type==solver_matrices_all.OR. &
13819  & selection_type==solver_matrices_linear_only.OR. &
13820  & selection_type==solver_matrices_nonlinear_only.OR. &
13821  & selection_type==solver_matrices_jacobian_only) THEN
13822  !Assemble solver matrices
13823  IF(solver%OUTPUT_TYPE>=solver_timing_output) THEN
13824  CALL cpu_timer(user_cpu,user_time1,err,error,*999)
13825  CALL cpu_timer(system_cpu,system_time1,err,error,*999)
13826  ENDIF
13827  !Loop over the solver matrices
13828  DO solver_matrix_idx=1,solver_mapping%NUMBER_OF_SOLVER_MATRICES
13829  solver_matrix=>solver_matrices%MATRICES(solver_matrix_idx)%PTR
13830  IF(ASSOCIATED(solver_matrix)) THEN
13831  IF(solver_matrix%UPDATE_MATRIX) THEN
13832  solver_distributed_matrix=>solver_matrix%MATRIX
13833  IF(ASSOCIATED(solver_distributed_matrix)) THEN
13834  !Initialise matrix to zero
13835  CALL distributed_matrix_all_values_set(solver_distributed_matrix,0.0_dp,err,error,*999)
13836  !Loop over the equations sets
13837  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
13838  !First Loop over the linear equations matrices
13839  DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
13840  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
13841  equations_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
13842  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%LINEAR_EQUATIONS_TO_SOLVER_MATRIX_MAPS( &
13843  & equations_matrix_idx)%PTR
13844  IF(ASSOCIATED(equations_to_solver_map)) THEN
13845  equations_matrix=>equations_to_solver_map%EQUATIONS_MATRIX
13846  IF(ASSOCIATED(equations_matrix)) THEN
13847  CALL solver_matrix_equations_matrix_add(solver_matrix,equations_set_idx,1.0_dp,equations_matrix, &
13848  & err,error,*999)
13849  ELSE
13850  CALL flagerror("The equations matrix is not associated.",err,error,*999)
13851  ENDIF
13852  ELSE
13853  CALL flagerror("The equations matrix equations to solver map is not associated.",err,error,*999)
13854  ENDIF
13855  ENDDO !equations_matrix_idx
13856  IF(selection_type==solver_matrices_all.OR. &
13857  & selection_type==solver_matrices_nonlinear_only.OR. &
13858  & selection_type==solver_matrices_jacobian_only) THEN
13859  !Now set the values from the equations Jacobian
13860  DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
13861  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_EQUATIONS_JACOBIANS
13862  jacobian_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
13863  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%JACOBIAN_TO_SOLVER_MATRIX_MAPS( &
13864  & equations_matrix_idx)%PTR
13865  IF(ASSOCIATED(jacobian_to_solver_map)) THEN
13866  jacobian_matrix=>jacobian_to_solver_map%JACOBIAN_MATRIX
13867  IF(ASSOCIATED(jacobian_matrix)) THEN
13868  CALL solver_matrix_jacobian_matrix_add(solver_matrix,equations_set_idx,1.0_dp,jacobian_matrix, &
13869  & err,error,*999)
13870  ELSE
13871  CALL flagerror("Jacobian matrix is not associated.",err,error,*999)
13872  ENDIF
13873  ELSE
13874  local_error="Jacobian to solver map is not associated for Jacobian number "// &
13875  & trim(numbertovstring(equations_matrix_idx,"*",err,error))//"."
13876  CALL flagerror(local_error,err,error,*999)
13877  ENDIF
13878  ENDDO
13879  ENDIF
13880  ENDDO !equations_set_idx
13881  !Loop over any interface conditions
13882  DO interface_condition_idx=1,solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS
13883  !Loop over the interface matrices
13884  DO interface_matrix_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
13885  & interface_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_INTERFACE_MATRICES
13886  interface_to_solver_map=>solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
13887  & interface_to_solver_matrix_maps_sm(solver_matrix_idx)%INTERFACE_EQUATIONS_TO_SOLVER_MATRIX_MAPS( &
13888  & interface_matrix_idx)%PTR
13889  IF(ASSOCIATED(interface_to_solver_map)) THEN
13890  interface_matrix=>interface_to_solver_map%INTERFACE_MATRIX
13891  IF(ASSOCIATED(interface_matrix)) THEN
13892  CALL solver_matrix_interface_matrix_add(solver_matrix,interface_condition_idx,(/1.0_dp,1.0_dp/), &
13893  & interface_matrix,err,error,*999)
13894  ELSE
13895  CALL flagerror("The interface matrix is not associated.",err,error,*999)
13896  ENDIF
13897  ELSE
13898  CALL flagerror("The interface matrix interface to solver map is not associated.",err,error,*999)
13899  ENDIF
13900  ENDDO !interface_matrix_idx
13901  ENDDO !interface_condition_idx
13902  !Update the solver matrix values
13903  CALL distributed_matrix_update_start(solver_distributed_matrix,err,error,*999)
13904  IF(ASSOCIATED(previous_solver_distributed_matrix)) THEN
13905  CALL distributed_matrix_update_finish(previous_solver_distributed_matrix,err,error,*999)
13906  ENDIF
13907  previous_solver_distributed_matrix=>solver_distributed_matrix
13908  ELSE
13909  CALL flagerror("Solver matrix distributed matrix is not associated.",err,error,*999)
13910  ENDIF
13911  ENDIF !Update matrix
13912  ELSE
13913  CALL flagerror("Solver matrix is not associated.",err,error,*999)
13914  ENDIF
13915  ENDDO !solver_matrix_idx
13916  IF(ASSOCIATED(previous_solver_distributed_matrix)) THEN
13917  CALL distributed_matrix_update_finish(previous_solver_distributed_matrix,err,error,*999)
13918  ENDIF
13919  IF(solver%OUTPUT_TYPE>=solver_timing_output) THEN
13920  CALL cpu_timer(user_cpu,user_time2,err,error,*999)
13921  CALL cpu_timer(system_cpu,system_time2,err,error,*999)
13922  user_elapsed=user_time2(1)-user_time1(1)
13923  system_elapsed=system_time2(1)-system_time1(1)
13924  CALL write_string(general_output_type,"",err,error,*999)
13925  CALL write_string_value(general_output_type,"Total user time for solver matrices assembly = ",user_elapsed, &
13926  & err,error,*999)
13927  CALL write_string_value(general_output_type,"Total System time for solver matrices assembly = ",system_elapsed, &
13928  & err,error,*999)
13929  ENDIF
13930  ENDIF
13931  !The solver matrices have only one residual vector
13932  NULLIFY(solver_residual_vector)
13933  IF(selection_type==solver_matrices_all.OR. &
13934  & selection_type==solver_matrices_nonlinear_only.OR. &
13935  & selection_type==solver_matrices_residual_only.OR. &
13936  & selection_type==solver_matrices_rhs_residual_only) THEN
13937  !Assemble residual vector
13938  !We assemble residual vector before RHS vector, then when assembling the RHS vector we subtract
13939  !the RHS terms for fixed BCs from the residual vector as this residual evaluation uses a matrix
13940  !vector product of the full equations matrix rather than the reduced solver matrix
13941  IF(solver%OUTPUT_TYPE>=solver_timing_output) THEN
13942  CALL cpu_timer(user_cpu,user_time1,err,error,*999)
13943  CALL cpu_timer(system_cpu,system_time1,err,error,*999)
13944  ENDIF
13945  IF(solver_matrices%UPDATE_RESIDUAL) THEN
13946  solver_residual_vector=>solver_matrices%RESIDUAL
13947  IF(ASSOCIATED(solver_residual_vector)) THEN
13948  !Initialise the residual to zero
13949  CALL distributed_vector_all_values_set(solver_residual_vector,0.0_dp,err,error,*999)
13950  !Loop over the equations sets
13951  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
13952  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
13953  IF(ASSOCIATED(equations_set)) THEN
13954  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
13955  IF(ASSOCIATED(dependent_field)) THEN
13956  equations=>equations_set%EQUATIONS
13957  IF(ASSOCIATED(equations)) THEN
13958  equations_matrices=>equations%EQUATIONS_MATRICES
13959  IF(ASSOCIATED(equations_matrices)) THEN
13960  equations_mapping=>equations%EQUATIONS_MAPPING
13961  IF(ASSOCIATED(equations_mapping)) THEN
13962  !Calculate the contributions from any linear matrices
13963  linear_mapping=>equations_mapping%LINEAR_MAPPING
13964  IF(ASSOCIATED(linear_mapping)) THEN
13965  linear_matrices=>equations_matrices%LINEAR_MATRICES
13966  IF(ASSOCIATED(linear_matrices)) THEN
13967  DO equations_matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
13968  linear_matrix=>linear_matrices%MATRICES(equations_matrix_idx)%PTR
13969  IF(ASSOCIATED(linear_matrix)) THEN
13970  linear_variable_type=linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(equations_matrix_idx)% &
13971  & variable_type
13972  linear_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(equations_matrix_idx)% &
13973  & variable
13974  IF(ASSOCIATED(linear_variable)) THEN
13975  linear_temp_vector=>linear_matrix%TEMP_VECTOR
13976  !Initialise the linear temporary vector to zero
13977  CALL distributed_vector_all_values_set(linear_temp_vector,0.0_dp,err,error,*999)
13978  NULLIFY(dependent_vector)
13979  CALL field_parameter_set_vector_get(dependent_field,linear_variable_type, &
13980  & field_values_set_type,dependent_vector,err,error,*999)
13981  CALL distributed_matrix_by_vector_add(distributed_matrix_vector_no_ghosts_type,1.0_dp, &
13982  & linear_matrix%MATRIX,dependent_vector,linear_temp_vector,err,error,*999)
13983  ELSE
13984  CALL flagerror("Linear variable is not associated.",err,error,*999)
13985  ENDIF
13986  ELSE
13987  local_error="Linear matrix is not associated for linear matrix number "// &
13988  & trim(numbertovstring(equations_matrix_idx,"*",err,error))//"."
13989  CALL flagerror(local_error,err,error,*999)
13990  ENDIF
13991  ENDDO !equations_matrix_idx
13992  ELSE
13993  CALL flagerror("Equations matrices linear matrices is not associated.",err,error,*999)
13994  ENDIF
13995  ENDIF
13996  !Calculate the solver residual
13997  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
13998  IF(ASSOCIATED(nonlinear_mapping)) THEN
13999  nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
14000  IF(ASSOCIATED(nonlinear_matrices)) THEN
14001  residual_vector=>nonlinear_matrices%RESIDUAL
14002  !Loop over the rows in the equations set
14003  DO equations_row_number=1,equations_mapping%TOTAL_NUMBER_OF_ROWS
14004  IF(solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
14005  & equations_row_to_solver_rows_maps(equations_row_number)% &
14006  & number_of_solver_rows>0) THEN
14007  !Get the equations residual contribution
14008  CALL distributed_vector_values_get(residual_vector,equations_row_number, &
14009  & residual_value,err,error,*999)
14010  !Get the linear matrices contribution to the RHS values if there are any
14011  IF(ASSOCIATED(linear_mapping)) THEN
14012  linear_value_sum=0.0_dp
14013  DO equations_matrix_idx2=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
14014  linear_matrix=>linear_matrices%MATRICES(equations_matrix_idx2)%PTR
14015  linear_temp_vector=>linear_matrix%TEMP_VECTOR
14016  CALL distributed_vector_values_get(linear_temp_vector,equations_row_number, &
14017  & linear_value,err,error,*999)
14018  linear_value_sum=linear_value_sum+linear_value
14019  ENDDO !equations_matrix_idx2
14020  residual_value=residual_value+linear_value_sum
14021  ENDIF
14022  !Loop over the solver rows associated with this equations set residual row
14023  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
14024  & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
14025  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
14026  & equations_row_to_solver_rows_maps(equations_row_number)%SOLVER_ROWS( &
14027  & solver_row_idx)
14028  row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
14029  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(equations_row_number)% &
14030  & coupling_coefficients(solver_row_idx)
14031  VALUE=residual_value*row_coupling_coefficient
14032  !Add in nonlinear residual values
14033  CALL distributed_vector_values_add(solver_residual_vector,solver_row_number,VALUE, &
14034  & err,error,*999)
14035  ENDDO !solver_row_idx
14036  ENDIF
14037  ENDDO !equations_row_number
14038  ELSE
14039  CALL flagerror("Equations matrices nonlinear matrices is not associated.",err,error,*999)
14040  ENDIF
14041  ELSE IF(ASSOCIATED(linear_mapping)) THEN
14042  DO equations_row_number=1,equations_mapping%TOTAL_NUMBER_OF_ROWS
14043  IF(solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
14044  & equations_row_to_solver_rows_maps(equations_row_number)% &
14045  & number_of_solver_rows>0) THEN
14046  linear_value_sum=0.0_dp
14047  DO equations_matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
14048  linear_matrix=>linear_matrices%MATRICES(equations_matrix_idx)%PTR
14049  linear_temp_vector=>linear_matrix%TEMP_VECTOR
14050  CALL distributed_vector_values_get(linear_temp_vector,equations_row_number, &
14051  & linear_value,err,error,*999)
14052  linear_value_sum=linear_value_sum+linear_value
14053  ENDDO !equations_matrix_idx
14054  residual_value=linear_value_sum
14055  !Loop over the solver rows associated with this equations set residual row
14056  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
14057  & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
14058  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
14059  & equations_row_to_solver_rows_maps(equations_row_number)%SOLVER_ROWS( &
14060  & solver_row_idx)
14061  row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
14062  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(equations_row_number)% &
14063  & coupling_coefficients(solver_row_idx)
14064  VALUE=residual_value*row_coupling_coefficient
14065  !Add in nonlinear residual values
14066  CALL distributed_vector_values_add(solver_residual_vector,solver_row_number,VALUE, &
14067  & err,error,*999)
14068  ENDDO !solver_row_idx
14069  ENDIF
14070  ENDDO !equations_row_number
14071  ENDIF
14072  ELSE
14073  CALL flagerror("Equations equations mapping is not associated.",err,error,*999)
14074  ENDIF
14075  ELSE
14076  CALL flagerror("Equations equations matrices is not associated.",err,error,*999)
14077  ENDIF
14078  ELSE
14079  CALL flagerror("Equations set equations is not associated.",err,error,*999)
14080  ENDIF
14081  ELSE
14082  CALL flagerror("Equations set dependent field is not associated.",err,error,*999)
14083  ENDIF
14084  ELSE
14085  CALL flagerror("Equations set is not associated.",err,error,*999)
14086  ENDIF
14087  ENDDO !equations_set_idx
14088  !Loop over the interface conditions
14089  DO interface_condition_idx=1,solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS
14090  interface_condition=>solver_mapping%INTERFACE_CONDITIONS(interface_condition_idx)%PTR
14091  IF(ASSOCIATED(interface_condition)) THEN
14092  lagrange_field=>interface_condition%LAGRANGE%LAGRANGE_FIELD
14093  IF(ASSOCIATED(lagrange_field)) THEN
14094  interface_equations=>interface_condition%INTERFACE_EQUATIONS
14095  IF(ASSOCIATED(interface_equations)) THEN
14096  interface_matrices=>interface_equations%INTERFACE_MATRICES
14097  IF(ASSOCIATED(interface_matrices)) THEN
14098  interface_mapping=>interface_equations%INTERFACE_MAPPING
14099  IF(ASSOCIATED(interface_mapping)) THEN
14100  SELECT CASE(interface_condition%METHOD)
14101  CASE(interface_condition_lagrange_multipliers_method)
14102  number_of_interface_matrices=interface_mapping%NUMBER_OF_INTERFACE_MATRICES
14103  CASE(interface_condition_penalty_method)
14104  number_of_interface_matrices=interface_mapping%NUMBER_OF_INTERFACE_MATRICES-1
14105  ENDSELECT
14106  !Calculate the contributions from any interface matrices
14107  DO interface_matrix_idx=1,number_of_interface_matrices
14108  !Calculate the interface matrix-Lagrange vector product residual contribution
14109  interface_matrix=>interface_matrices%MATRICES(interface_matrix_idx)%PTR
14110  IF(ASSOCIATED(interface_matrix)) THEN
14111  interface_variable_type=interface_mapping%LAGRANGE_VARIABLE_TYPE
14112  interface_variable=>interface_mapping%LAGRANGE_VARIABLE
14113  IF(ASSOCIATED(interface_variable)) THEN
14114  interface_temp_vector=>interface_matrix%TEMP_VECTOR
14115  !Initialise the linear temporary vector to zero
14116  CALL distributed_vector_all_values_set(interface_temp_vector,0.0_dp,err,error,*999)
14117  NULLIFY(lagrange_vector)
14118  CALL field_parameter_set_vector_get(lagrange_field,interface_variable_type, &
14119  & field_values_set_type,lagrange_vector,err,error,*999)
14120  CALL distributed_matrix_by_vector_add(distributed_matrix_vector_no_ghosts_type,1.0_dp, &
14121  & interface_matrix%MATRIX,lagrange_vector,interface_temp_vector,err,error,*999)
14122  !Add interface matrix residual contribution to the solver residual
14123  DO interface_row_number=1,interface_matrix%NUMBER_OF_ROWS
14124  IF(solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
14125  & interface_to_solver_matrix_maps_im(interface_matrix_idx)% &
14126  & interface_row_to_solver_rows_map(interface_row_number)%NUMBER_OF_SOLVER_ROWS>0) THEN
14127  !Loop over the solver rows associated with this interface residual row
14128  !Currently earch interface matrix row has only one corresponding solver row number & coupling coefficient
14129  solver_row_number=solver_mapping% &
14130  & interface_condition_to_solver_map(interface_condition_idx)% &
14131  & interface_to_solver_matrix_maps_im(interface_matrix_idx)% &
14132  & interface_row_to_solver_rows_map(interface_row_number)%SOLVER_ROW
14133  row_coupling_coefficient=solver_mapping% &
14134  & interface_condition_to_solver_map(interface_condition_idx)% &
14135  & interface_to_solver_matrix_maps_im(interface_matrix_idx)% &
14136  & interface_row_to_solver_rows_map(interface_row_number)%COUPLING_COEFFICIENT
14137  CALL distributed_vector_values_get(interface_temp_vector,interface_row_number, &
14138  & residual_value,err,error,*999)
14139  VALUE=residual_value*row_coupling_coefficient
14140  !Add in nonlinear residual values
14141  CALL distributed_vector_values_add(solver_residual_vector,solver_row_number,VALUE, &
14142  & err,error,*999)
14143  ENDIF
14144  ENDDO !interface_row_number
14145  ELSE
14146  CALL flagerror("Interface variable is not associated.",err,error,*999)
14147  ENDIF
14148  !Calculate the transposed interface matrix-dependent variable product residual contribution
14149  dependent_variable_type=interface_mapping% &
14150  & interface_matrix_rows_to_var_maps(interface_matrix_idx)%VARIABLE_TYPE
14151  dependent_variable=>interface_mapping% &
14152  & interface_matrix_rows_to_var_maps(interface_matrix_idx)%VARIABLE
14153  IF(ASSOCIATED(dependent_variable)) THEN
14154  interface_temp_vector=>interface_matrix%TEMP_TRANSPOSE_VECTOR
14155  !Initialise the linear temporary vector to zero
14156  CALL distributed_vector_all_values_set(interface_temp_vector,0.0_dp,err,error,*999)
14157  NULLIFY(dependent_vector)
14158  dependent_field=>dependent_variable%FIELD
14159  CALL field_parameter_set_vector_get(dependent_field,dependent_variable_type, &
14160  & field_values_set_type,dependent_vector,err,error,*999)
14161  CALL distributed_matrix_by_vector_add(distributed_matrix_vector_no_ghosts_type,1.0_dp, &
14162  & interface_matrix%MATRIX_TRANSPOSE,dependent_vector,interface_temp_vector,err,error,*999)
14163  !Add interface matrix residual contribution to the solver residual.
14164  !The number of columns in the interface matrix is equivalent to the number of rows of the transposed interface matrices
14165  DO interface_row_number=1,interface_matrices%NUMBER_OF_COLUMNS
14166  IF(solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
14167  & interface_column_to_solver_rows_maps(interface_row_number)%NUMBER_OF_SOLVER_ROWS>0) THEN
14168  !Loop over the solver rows associated with this interface residual row
14169  !Currently earch interface matrix row has only one corresponding solver row number & coupling coefficient
14170  solver_row_number=solver_mapping% &
14171  & interface_condition_to_solver_map(interface_condition_idx)% &
14172  & interface_column_to_solver_rows_maps(interface_row_number)%SOLVER_ROW
14173  row_coupling_coefficient=solver_mapping% &
14174  & interface_condition_to_solver_map(interface_condition_idx)% &
14175  & interface_column_to_solver_rows_maps(interface_row_number)%COUPLING_COEFFICIENT
14176  CALL distributed_vector_values_get(interface_temp_vector,interface_row_number, &
14177  & residual_value,err,error,*999)
14178  VALUE=residual_value*row_coupling_coefficient
14179  !Add in nonlinear residual values
14180  CALL distributed_vector_values_add(solver_residual_vector,solver_row_number,VALUE, &
14181  & err,error,*999)
14182  ENDIF
14183  ENDDO !interface_row_number
14184  ELSE
14185  CALL flagerror("Dependent variable is not associated.",err,error,*999)
14186  ENDIF
14187  ELSE
14188  local_error="Interface matrix is not associated for linear matrix number "// &
14189  & trim(numbertovstring(equations_matrix_idx,"*",err,error))//"."
14190  CALL flagerror(local_error,err,error,*999)
14191  ENDIF
14192  ENDDO !interface_matrix_idx
14193  SELECT CASE(interface_condition%METHOD)
14194  CASE(interface_condition_penalty_method)
14195  interface_matrix_idx=interface_mapping%NUMBER_OF_INTERFACE_MATRICES
14196  !Calculate the Lagrange-Lagrange vector product residual contribution from the penalty term
14197  interface_matrix=>interface_matrices%MATRICES(interface_matrix_idx)%PTR
14198  IF(ASSOCIATED(interface_matrix)) THEN
14199  interface_variable_type=interface_mapping%LAGRANGE_VARIABLE_TYPE
14200  interface_variable=>interface_mapping%LAGRANGE_VARIABLE
14201  IF(ASSOCIATED(interface_variable)) THEN
14202  interface_temp_vector=>interface_matrix%TEMP_VECTOR
14203  !Initialise the linear temporary vector to zero
14204  CALL distributed_vector_all_values_set(interface_temp_vector,0.0_dp,err,error,*999)
14205  NULLIFY(lagrange_vector)
14206  CALL field_parameter_set_vector_get(lagrange_field,interface_variable_type, &
14207  & field_values_set_type,lagrange_vector,err,error,*999)
14208  CALL distributed_matrix_by_vector_add(distributed_matrix_vector_no_ghosts_type,1.0_dp, &
14209  & interface_matrix%MATRIX,lagrange_vector,interface_temp_vector,err,error,*999)
14210  !Add interface matrix residual contribution to the solver residual
14211  DO interface_row_number=1,interface_matrix%NUMBER_OF_ROWS
14212  IF(solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
14213  & interface_to_solver_matrix_maps_im(interface_matrix_idx)% &
14214  & interface_row_to_solver_rows_map(interface_row_number)%NUMBER_OF_SOLVER_ROWS>0) THEN
14215  !Loop over the solver rows associated with this interface residual row
14216  !Currently earch interface matrix row has only one corresponding solver row number & coupling coefficient
14217  solver_row_number=solver_mapping% &
14218  & interface_condition_to_solver_map(interface_condition_idx)% &
14219  & interface_to_solver_matrix_maps_im(interface_matrix_idx)% &
14220  & interface_row_to_solver_rows_map(interface_row_number)%SOLVER_ROW
14221  row_coupling_coefficient=solver_mapping% &
14222  & interface_condition_to_solver_map(interface_condition_idx)% &
14223  & interface_to_solver_matrix_maps_im(interface_matrix_idx)% &
14224  & interface_row_to_solver_rows_map(interface_row_number)%COUPLING_COEFFICIENT
14225  CALL distributed_vector_values_get(interface_temp_vector,interface_row_number, &
14226  & residual_value,err,error,*999)
14227  VALUE=residual_value*row_coupling_coefficient
14228  !Add in nonlinear residual values
14229  CALL distributed_vector_values_add(solver_residual_vector,solver_row_number,VALUE, &
14230  & err,error,*999)
14231  ENDIF
14232  ENDDO !interface_row_number
14233  ELSE
14234  CALL flagerror("Interface variable is not associated.",err,error,*999)
14235  ENDIF
14236  ELSE
14237  local_error="Interface matrix is not associated for linear matrix number "// &
14238  & trim(numbertovstring(equations_matrix_idx,"*",err,error))//"."
14239  CALL flagerror(local_error,err,error,*999)
14240  ENDIF
14241  ENDSELECT
14242  ELSE
14243  CALL flagerror("Interface mapping is not associated.",err,error,*999)
14244  ENDIF
14245  ELSE
14246  CALL flagerror("Interface matrices is not associated.",err,error,*999)
14247  ENDIF
14248  ELSE
14249  CALL flagerror("Interface equations is not associated.",err,error,*999)
14250  ENDIF
14251  ELSE
14252  CALL flagerror("Interface Lagrange field is not associated.",err,error,*999)
14253  ENDIF
14254  ELSE
14255  CALL flagerror("Interface condition is not associated.",err,error,*999)
14256  ENDIF
14257  ENDDO !interface_condition_idx
14258  !Start the update the solver residual vector values
14259  CALL distributed_vector_update_start(solver_residual_vector,err,error,*999)
14260  ELSE
14261  CALL flagerror("The solver residual vector is not associated.",err,error,*999)
14262  ENDIF
14263  ENDIF
14264  IF(ASSOCIATED(solver_residual_vector)) THEN
14265  CALL distributed_vector_update_finish(solver_residual_vector,err,error,*999)
14266  ENDIF
14267  IF(solver%OUTPUT_TYPE>=solver_timing_output) THEN
14268  CALL cpu_timer(user_cpu,user_time2,err,error,*999)
14269  CALL cpu_timer(system_cpu,system_time2,err,error,*999)
14270  user_elapsed=user_time2(1)-user_time1(1)
14271  system_elapsed=system_time2(1)-system_time1(1)
14272  CALL write_string(general_output_type,"",err,error,*999)
14273  CALL write_string_value(general_output_type,"Total user time for solver residual assembly = ",user_elapsed, &
14274  & err,error,*999)
14275  CALL write_string_value(general_output_type,"Total System time for solver residual assembly = ",system_elapsed, &
14276  & err,error,*999)
14277  ENDIF
14278  ENDIF
14279  NULLIFY(solver_rhs_vector)
14280  IF(selection_type==solver_matrices_all.OR. &
14281  & selection_type==solver_matrices_linear_only.OR. &
14282  & selection_type==solver_matrices_nonlinear_only.OR. &
14283  & selection_type==solver_matrices_rhs_only.OR. &
14284  & selection_type==solver_matrices_rhs_residual_only) THEN
14285  !Assemble rhs vector
14286  IF(solver%OUTPUT_TYPE>=solver_timing_output) THEN
14287  CALL cpu_timer(user_cpu,user_time1,err,error,*999)
14288  CALL cpu_timer(system_cpu,system_time1,err,error,*999)
14289  ENDIF
14290  IF(solver_matrices%UPDATE_RHS_VECTOR) THEN
14291  solver_rhs_vector=>solver_matrices%RHS_VECTOR
14292  IF(ASSOCIATED(solver_rhs_vector)) THEN
14293  !Initialise the RHS to zero
14294  CALL distributed_vector_all_values_set(solver_rhs_vector,0.0_dp,err,error,*999)
14295  NULLIFY(check_data)
14296  CALL distributed_vector_data_get(solver_rhs_vector,check_data,err,error,*999)
14297  subtract_fixed_bcs_from_residual=.false.
14298  IF(selection_type==solver_matrices_all.OR. &
14299  & selection_type==solver_matrices_nonlinear_only.OR. &
14300  & selection_type==solver_matrices_rhs_residual_only) THEN
14301  IF(solver_matrices%UPDATE_RESIDUAL) THEN
14302  IF(ASSOCIATED(solver_residual_vector)) THEN
14303  subtract_fixed_bcs_from_residual=.true.
14304  ELSE
14305  CALL flagerror("The solver residual vector is not associated.",err,error,*999)
14306  ENDIF
14307  ENDIF
14308  ENDIF
14309  !Loop over the equations sets
14310  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
14311  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
14312  IF(ASSOCIATED(equations_set)) THEN
14313  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
14314  IF(ASSOCIATED(dependent_field)) THEN
14315  equations=>equations_set%EQUATIONS
14316  IF(ASSOCIATED(equations)) THEN
14317  equations_matrices=>equations%EQUATIONS_MATRICES
14318  IF(ASSOCIATED(equations_matrices)) THEN
14319  equations_mapping=>equations%EQUATIONS_MAPPING
14320  IF(ASSOCIATED(equations_mapping)) THEN
14321  source_mapping=>equations_mapping%SOURCE_MAPPING
14322  IF(ASSOCIATED(source_mapping)) THEN
14323  source_vector=>equations_matrices%SOURCE_VECTOR
14324  IF(ASSOCIATED(source_vector)) THEN
14325  distributed_source_vector=>source_vector%VECTOR
14326  ELSE
14327  CALL flagerror("Source vector vector is not associated.",err,error,*999)
14328  ENDIF
14329  ENDIF
14330  rhs_mapping=>equations_mapping%RHS_MAPPING
14331  IF(ASSOCIATED(rhs_mapping)) THEN
14332  NULLIFY(rhs_parameters)
14333  rhs_variable_type=rhs_mapping%RHS_VARIABLE_TYPE
14334  CALL field_parameter_set_data_get(dependent_field,rhs_variable_type,field_values_set_type, &
14335  & rhs_parameters,err,error,*999)
14336  NULLIFY(check_data)
14337  CALL distributed_vector_data_get(solver_rhs_vector,check_data,err,error,*999)
14338  rhs_vector=>equations_matrices%RHS_VECTOR
14339  IF(ASSOCIATED(rhs_vector)) THEN
14340  linear_mapping=>equations_mapping%LINEAR_MAPPING
14341  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
14342  IF(ASSOCIATED(linear_mapping)) THEN
14343  linear_matrices=>equations_matrices%LINEAR_MATRICES
14344  IF(ASSOCIATED(linear_matrices)) THEN
14345  ALLOCATE(dependent_parameters(linear_mapping%NUMBER_OF_LINEAR_MATRIX_VARIABLES),stat=err)
14346  IF(err/=0) CALL flagerror("Could not allocate dependent_parameters.",err,error,*999)
14347  DO variable_idx=1,linear_mapping%NUMBER_OF_LINEAR_MATRIX_VARIABLES
14348  variable_type=linear_mapping%LINEAR_MATRIX_VARIABLE_TYPES(variable_idx)
14349  NULLIFY(dependent_parameters(variable_idx)%PTR)
14350  CALL field_parameter_set_data_get(dependent_field,variable_type,field_values_set_type, &
14351  & dependent_parameters(variable_idx)%PTR,err,error,*999)
14352  ENDDO !variable_idx
14353  ELSE
14354  CALL flagerror("Equations matrices linear matrices is not associated.",err,error,*999)
14355  ENDIF
14356  ENDIF
14357  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
14358  IF(ASSOCIATED(boundary_conditions)) THEN
14359 !!TODO: what if the equations set doesn't have a RHS vector???
14360  rhs_variable=>rhs_mapping%RHS_VARIABLE
14361  rhs_variable_type=rhs_variable%VARIABLE_TYPE
14362  rhs_domain_mapping=>rhs_variable%DOMAIN_MAPPING
14363  ! Check if there are any integrated values to add
14364  CALL field_parameter_set_created(rhs_variable%FIELD,rhs_variable_type, &
14365  & field_integrated_neumann_set_type,has_integrated_values,err,error,*999)
14366  equations_rhs_vector=>rhs_vector%VECTOR
14367  CALL boundary_conditions_variable_get(boundary_conditions,rhs_variable, &
14368  & rhs_boundary_conditions,err,error,*999)
14369  IF(ASSOCIATED(rhs_boundary_conditions)) THEN
14370  !Update RHS field by integrating any point Neumann conditions
14371  CALL boundaryconditions_neumannintegrate(rhs_boundary_conditions, &
14372  & err,error,*999)
14373  !Loop over the rows in the equations set
14374  DO equations_row_number=1,equations_mapping%TOTAL_NUMBER_OF_ROWS
14375  !Get the source vector contribute to the RHS values if there are any
14376  IF(ASSOCIATED(source_mapping)) THEN
14377  !Add in equations source values
14378  CALL distributed_vector_values_get(distributed_source_vector,equations_row_number, &
14379  & source_value,err,error,*999)
14380  !Loop over the solver rows associated with this equations set row
14381  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
14382  & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
14383 
14384  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
14385  & equations_row_to_solver_rows_maps(equations_row_number)%SOLVER_ROWS( &
14386  & solver_row_idx)
14387 
14388  row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
14389  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(equations_row_number)% &
14390  & coupling_coefficients(solver_row_idx)
14391  VALUE=1.0_dp*source_value*row_coupling_coefficient
14392  !Calculates the contribution from each row of the equations matrix and adds to solver matrix
14393  CALL distributed_vector_values_add(solver_rhs_vector,solver_row_number,VALUE, &
14394  & err,error,*999)
14395  ENDDO !solver_row_idx
14396  ENDIF
14397  rhs_variable_dof=rhs_mapping%EQUATIONS_ROW_TO_RHS_DOF_MAP(equations_row_number)
14398  rhs_global_dof=rhs_domain_mapping%LOCAL_TO_GLOBAL_MAP(rhs_variable_dof)
14399  rhs_boundary_condition=rhs_boundary_conditions%DOF_TYPES(rhs_global_dof)
14400  !Apply boundary conditions
14401  SELECT CASE(rhs_boundary_condition)
14402  CASE(boundary_condition_dof_free)
14403  !Add in equations RHS values
14404  CALL distributed_vector_values_get(equations_rhs_vector,equations_row_number, &
14405  & rhs_value,err,error,*999)
14406  IF(has_integrated_values) THEN
14407  !Add any Neumann integrated values, b = f + N q
14408  CALL field_parameter_set_get_local_dof(rhs_variable%FIELD,rhs_variable_type, &
14409  & field_integrated_neumann_set_type,rhs_variable_dof,rhs_integrated_value, &
14410  & err,error,*999)
14411  rhs_value=rhs_value+rhs_integrated_value
14412  END IF
14413  !Loop over the solver rows associated with this equations set row
14414  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
14415  & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
14416  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
14417  & equations_row_to_solver_rows_maps(equations_row_number)%SOLVER_ROWS( &
14418  & solver_row_idx)
14419  row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
14420  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(equations_row_number)% &
14421  & coupling_coefficients(solver_row_idx)
14422  VALUE=rhs_value*row_coupling_coefficient
14423  CALL distributed_vector_values_add(solver_rhs_vector,solver_row_number,VALUE, &
14424  & err,error,*999)
14425  ENDDO !solver_row_idx
14426  !Set Dirichlet boundary conditions
14427  IF(ASSOCIATED(linear_mapping).AND..NOT.ASSOCIATED(nonlinear_mapping)) THEN
14428  !Loop over the dependent variables associated with this equations set row
14429  DO variable_idx=1,linear_mapping%NUMBER_OF_LINEAR_MATRIX_VARIABLES
14430  variable_type=linear_mapping%LINEAR_MATRIX_VARIABLE_TYPES(variable_idx)
14431  dependent_variable=>linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS( &
14432  & variable_type)%VARIABLE
14433  dependent_variable_type=dependent_variable%VARIABLE_TYPE
14434  variable_domain_mapping=>dependent_variable%DOMAIN_MAPPING
14435  CALL boundary_conditions_variable_get(boundary_conditions,dependent_variable, &
14436  & dependent_boundary_conditions,err,error,*999)
14437  variable_dof=linear_mapping%EQUATIONS_ROW_TO_VARIABLE_DOF_MAPS( &
14438  & equations_row_number,variable_idx)
14439  variable_global_dof=variable_domain_mapping%LOCAL_TO_GLOBAL_MAP(variable_dof)
14440  variable_boundary_condition=dependent_boundary_conditions%DOF_TYPES( &
14441  & variable_global_dof)
14442  IF(variable_boundary_condition==boundary_condition_dof_fixed) THEN
14443  dependent_value=dependent_parameters(variable_idx)%PTR(variable_dof)
14444  IF(abs(dependent_value)>=zero_tolerance) THEN
14445  DO equations_matrix_idx=1,linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS( &
14446  & variable_type)%NUMBER_OF_EQUATIONS_MATRICES
14447  equations_matrix_number=linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS( &
14448  & variable_type)%EQUATIONS_MATRIX_NUMBERS(equations_matrix_idx)
14449  equations_matrix=>linear_matrices%MATRICES(equations_matrix_number)%PTR
14450  equations_column_number=linear_mapping%VAR_TO_EQUATIONS_MATRICES_MAPS( &
14451  & variable_type)%DOF_TO_COLUMNS_MAPS(equations_matrix_idx)%COLUMN_DOF( &
14452  & variable_dof)
14453  IF(ASSOCIATED(dependent_boundary_conditions%DIRICHLET_BOUNDARY_CONDITIONS)) THEN
14454  IF(dependent_boundary_conditions%NUMBER_OF_DIRICHLET_CONDITIONS>0) THEN
14455  DO dirichlet_idx=1,dependent_boundary_conditions% &
14456  & number_of_dirichlet_conditions
14457  IF(dependent_boundary_conditions%DIRICHLET_BOUNDARY_CONDITIONS% &
14458  & dirichlet_dof_indices(dirichlet_idx)==equations_column_number) EXIT
14459  ENDDO
14460  SELECT CASE(equations_matrix%STORAGE_TYPE)
14461  CASE(distributed_matrix_block_storage_type)
14462  DO dirichlet_row=1,equations_matrices%TOTAL_NUMBER_OF_ROWS
14463  CALL distributed_matrix_values_get(equations_matrix%MATRIX, &
14464  & dirichlet_row,equations_column_number,matrix_value,err,error,*999)
14465  IF(abs(matrix_value)>=zero_tolerance) THEN
14466  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
14467  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS( &
14468  & dirichlet_row)%NUMBER_OF_SOLVER_ROWS
14469  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
14470  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS( &
14471  & dirichlet_row)%SOLVER_ROWS(solver_row_idx)
14472  row_coupling_coefficient=solver_mapping% &
14473  & equations_set_to_solver_map(equations_set_idx)% &
14474  & equations_row_to_solver_rows_maps(dirichlet_row)% &
14475  & coupling_coefficients(solver_row_idx)
14476  VALUE=-1.0_dp*matrix_value*dependent_value*row_coupling_coefficient
14477  CALL distributed_vector_values_add(solver_rhs_vector, &
14478  & solver_row_number,VALUE,err,error,*999)
14479  IF(subtract_fixed_bcs_from_residual) THEN
14480  CALL distributed_vector_values_add(solver_residual_vector, &
14481  & solver_row_number,VALUE,err,error,*999)
14482  ENDIF
14483  ENDDO !solver_row_idx
14484  ENDIF
14485  ENDDO !dirichlet_row
14486  CASE(distributed_matrix_diagonal_storage_type)
14487  dirichlet_row=equations_column_number
14488  CALL distributed_matrix_values_get(equations_matrix%MATRIX, &
14489  & dirichlet_row,equations_column_number,matrix_value,err,error,*999)
14490  IF(abs(matrix_value)>=zero_tolerance) THEN
14491  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
14492  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS( &
14493  & dirichlet_row)%NUMBER_OF_SOLVER_ROWS
14494  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
14495  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS( &
14496  & dirichlet_row)%SOLVER_ROWS(solver_row_idx)
14497  row_coupling_coefficient=solver_mapping% &
14498  & equations_set_to_solver_map(equations_set_idx)% &
14499  & equations_row_to_solver_rows_maps(dirichlet_row)% &
14500  & coupling_coefficients(solver_row_idx)
14501  VALUE=-1.0_dp*matrix_value*dependent_value*row_coupling_coefficient
14502  CALL distributed_vector_values_add(solver_rhs_vector, &
14503  & solver_row_number,VALUE,err,error,*999)
14504  IF(subtract_fixed_bcs_from_residual) THEN
14505  CALL distributed_vector_values_add(solver_residual_vector, &
14506  & solver_row_number,VALUE,err,error,*999)
14507  ENDIF
14508  ENDDO !solver_row_idx
14509  ENDIF
14510  CASE(distributed_matrix_column_major_storage_type)
14511  CALL flagerror("Not implemented.",err,error,*999)
14512  CASE(distributed_matrix_row_major_storage_type)
14513  CALL flagerror("Not implemented.",err,error,*999)
14514  CASE(distributed_matrix_compressed_row_storage_type)
14515  sparsity_indices=>dependent_boundary_conditions% &
14516  & dirichlet_boundary_conditions%LINEAR_SPARSITY_INDICES( &
14517  & equations_set_idx,equations_matrix_idx)%PTR
14518  IF(ASSOCIATED(sparsity_indices)) THEN
14519  DO equations_row_number2=sparsity_indices%SPARSE_COLUMN_INDICES( &
14520  & dirichlet_idx),sparsity_indices%SPARSE_COLUMN_INDICES( &
14521  & dirichlet_idx+1)-1
14522  dirichlet_row=sparsity_indices%SPARSE_ROW_INDICES( &
14523  & equations_row_number2)
14524  CALL distributed_matrix_values_get(equations_matrix%MATRIX, &
14525  & dirichlet_row,equations_column_number,matrix_value,err,error,*999)
14526  IF(abs(matrix_value)>=zero_tolerance) THEN
14527  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
14528  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS( &
14529  & dirichlet_row)%NUMBER_OF_SOLVER_ROWS
14530  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
14531  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS( &
14532  & dirichlet_row)%SOLVER_ROWS(solver_row_idx)
14533  row_coupling_coefficient=solver_mapping% &
14534  & equations_set_to_solver_map(equations_set_idx)% &
14535  & equations_row_to_solver_rows_maps(dirichlet_row)% &
14536  & coupling_coefficients(solver_row_idx)
14537  VALUE=-1.0_dp*matrix_value*dependent_value* &
14538  & row_coupling_coefficient
14539  CALL distributed_vector_values_add(solver_rhs_vector, &
14540  & solver_row_number,VALUE,err,error,*999)
14541  IF(subtract_fixed_bcs_from_residual) THEN
14542  CALL distributed_vector_values_add(solver_residual_vector, &
14543  & solver_row_number,VALUE,err,error,*999)
14544  ENDIF
14545  ENDDO !solver_row_idx
14546  ENDIF
14547  ENDDO !equations_row_number2
14548  ELSE
14549  CALL flagerror("Sparsity indices are not associated.",err,error,*999)
14550  ENDIF
14551  CASE(distributed_matrix_compressed_column_storage_type)
14552  CALL flagerror("Not implemented.",err,error,*999)
14553  CASE(distributed_matrix_row_column_storage_type)
14554  CALL flagerror("Not implemented.",err,error,*999)
14555  CASE DEFAULT
14556  local_error="The storage type of "// &
14557  & trim(numbertovstring(equations_matrix%STORAGE_TYPE,"*", &
14558  & err,error))//" is invalid."
14559  CALL flagerror(local_error,err,error,*999)
14560  END SELECT
14561  ENDIF
14562  ELSE
14563  CALL flagerror("Dirichlet boundary conditions is not associated.",err, &
14564  & error,*999)
14565  ENDIF
14566  ENDDO !matrix_idx
14567  ENDIF
14568  ENDIF
14569  ENDDO !variable_idx
14570  ENDIF
14571  CASE(boundary_condition_dof_fixed)
14572  rhs_value=rhs_parameters(rhs_variable_dof)
14573  ! Add any integrated RHS values calculated from point Neumann conditions, b = f + N q
14574  IF(has_integrated_values) THEN
14575  CALL field_parameter_set_get_local_dof(rhs_variable%FIELD,rhs_variable_type, &
14576  & field_integrated_neumann_set_type,rhs_variable_dof,rhs_integrated_value, &
14577  & err,error,*999)
14578  rhs_value=rhs_value+rhs_integrated_value
14579  END IF
14580  IF(abs(rhs_value)>=zero_tolerance) THEN
14581  !Loop over the solver rows associated with this equations set row
14582  DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
14583  & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
14584  solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
14585  & equations_row_to_solver_rows_maps(equations_row_number)%SOLVER_ROWS( &
14586  & solver_row_idx)
14587  row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
14588  & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(equations_row_number)% &
14589  & coupling_coefficients(solver_row_idx)
14590  !For nonlinear problems, f(x) - b = 0, and for linear, K x = b, so we always add the
14591  !right hand side field value to the solver right hand side vector
14592  VALUE=rhs_value*row_coupling_coefficient
14593  CALL distributed_vector_values_add(solver_rhs_vector,solver_row_number,VALUE, &
14594  & err,error,*999)
14595  ENDDO !solver_row_idx
14596  ENDIF
14597  CASE(boundary_condition_dof_mixed)
14598  !Set Robin or is it Cauchy??? boundary conditions
14599  CALL flagerror("Not implemented.",err,error,*999)
14600  CASE DEFAULT
14601  local_error="The RHS boundary condition of "// &
14602  & trim(numbertovstring(rhs_boundary_condition,"*",err,error))// &
14603  & " for RHS variable dof number "// &
14604  & trim(numbertovstring(rhs_variable_dof,"*",err,error))//" is invalid."
14605  CALL flagerror(local_error,err,error,*999)
14606  END SELECT
14607  ENDDO !equations_row_number
14608  IF(ASSOCIATED(solver_residual_vector)) THEN
14609  CALL distributed_vector_update_start(solver_residual_vector,err,error,*999)
14610  CALL distributed_vector_update_finish(solver_residual_vector,err,error,*999)
14611  ENDIF
14612  NULLIFY(check_data2)
14613  CALL distributed_vector_data_get(equations_rhs_vector,check_data2,err,error,*999)
14614  NULLIFY(check_data3)
14615  CALL distributed_vector_data_get(solver_rhs_vector,check_data3,err,error,*999)
14616  NULLIFY(check_data4)
14617  CALL distributed_vector_data_get(solver_rhs_vector,check_data4,err,error,*999)
14618  ELSE
14619  CALL flagerror("RHS boundary conditions variable is not associated.",err,error,*999)
14620  ENDIF
14621  ELSE
14622  CALL flagerror("Equations set boundary conditions is not associated.",err,error,*999)
14623  ENDIF
14624  IF(ASSOCIATED(linear_mapping)) THEN
14625  DO variable_idx=1,linear_mapping%NUMBER_OF_LINEAR_MATRIX_VARIABLES
14626  variable_type=linear_mapping%LINEAR_MATRIX_VARIABLE_TYPES(variable_idx)
14627  CALL field_parameter_set_data_restore(dependent_field,variable_type,field_values_set_type, &
14628  & dependent_parameters(variable_idx)%PTR,err,error,*999)
14629  ENDDO !variable_idx
14630  IF(ALLOCATED(dependent_parameters)) DEALLOCATE(dependent_parameters)
14631  ENDIF
14632  ELSE
14633  CALL flagerror("Equations matrices RHS vector is not associated.",err,error,*999)
14634  ENDIF
14635  CALL field_parameter_set_data_restore(dependent_field,rhs_variable_type,field_values_set_type, &
14636  & rhs_parameters,err,error,*999)
14637  ELSE
14638  CALL flagerror("Equations mapping RHS mapping is not associated.",err,error,*999)
14639  ENDIF
14640  ELSE
14641  CALL flagerror("Equations equations mapping is not associated.",err,error,*999)
14642  ENDIF
14643  ELSE
14644  CALL flagerror("Equations equations matrices is not associated.",err,error,*999)
14645  ENDIF
14646  ELSE
14647  CALL flagerror("Equations set equations is not associated.",err,error,*999)
14648  ENDIF
14649  ELSE
14650  CALL flagerror("Equations set is not associated.",err,error,*999)
14651  ENDIF
14652  ENDIF
14653  ENDDO !equations_set_idx
14654  !Add in any rows from any interface conditions
14655  DO interface_condition_idx=1,solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS
14656  interface_condition=>solver_mapping%INTERFACE_CONDITIONS(interface_condition_idx)%PTR
14657  IF(ASSOCIATED(interface_condition)) THEN
14658  SELECT CASE(interface_condition%METHOD)
14659  CASE(interface_condition_lagrange_multipliers_method,interface_condition_penalty_method)
14660  interface_equations=>interface_condition%INTERFACE_EQUATIONS
14661  IF(ASSOCIATED(interface_equations)) THEN
14662  interface_mapping=>interface_equations%INTERFACE_MAPPING
14663  IF(ASSOCIATED(interface_mapping)) THEN
14664  interface_lagrange=>interface_condition%LAGRANGE
14665  IF(ASSOCIATED(interface_lagrange)) THEN
14666  lagrange_field=>interface_lagrange%LAGRANGE_FIELD
14667  IF(ASSOCIATED(lagrange_field)) THEN
14668  interface_rhs_mapping=>interface_mapping%RHS_MAPPING
14669  IF(ASSOCIATED(interface_rhs_mapping)) THEN
14670  interface_matrices=>interface_equations%INTERFACE_MATRICES
14671  IF(ASSOCIATED(interface_matrices)) THEN
14672  interface_rhs_vector=>interface_matrices%RHS_VECTOR
14673  IF(ASSOCIATED(interface_rhs_vector)) THEN
14674  !Worry about BCs on the Lagrange variables later.
14675  DO interface_column_number=1,interface_mapping%TOTAL_NUMBER_OF_COLUMNS
14676  CALL distributed_vector_values_get(interface_rhs_vector%RHS_VECTOR, &
14677  & interface_column_number,rhs_value,err,error,*999)
14678  !Loop over the solver rows this interface column is mapped to
14679  DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
14680  & interface_condition_idx)%INTERFACE_COLUMN_TO_SOLVER_ROWS_MAPS( &
14681  & interface_column_number)%NUMBER_OF_SOLVER_ROWS
14682  solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
14683  & interface_condition_idx)%INTERFACE_COLUMN_TO_SOLVER_ROWS_MAPS( &
14684  & interface_column_number)%SOLVER_ROW
14685  row_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
14686  & interface_condition_idx)%INTERFACE_COLUMN_TO_SOLVER_ROWS_MAPS( &
14687  & interface_column_number)%COUPLING_COEFFICIENT
14688  VALUE=rhs_value*row_coupling_coefficient
14689  CALL distributed_vector_values_add(solver_rhs_vector,solver_row_number,VALUE, &
14690  & err,error,*999)
14691  ENDDO !solver_row_idx
14692  ENDDO !interface_column_idx
14693  ELSE
14694  CALL flagerror("Interface matrices RHS vector is not associated.",err,error,*999)
14695  ENDIF
14696  ELSE
14697  CALL flagerror("Interface equations interface matrices is not associated.",err,error,*999)
14698  ENDIF
14699  ELSE
14700  CALL flagerror("Interface mapping RHS mapping is not associated.",err,error,*999)
14701  ENDIF
14702  ELSE
14703  CALL flagerror("Interface Lagrange field is not associated.",err,error,*999)
14704  ENDIF
14705  ELSE
14706  CALL flagerror("Interface Lagrange is not associated.",err,error,*999)
14707  ENDIF
14708  ELSE
14709  CALL flagerror("Interface equations interface mapping is not associated.",err,error,*999)
14710  ENDIF
14711  ELSE
14712  CALL flagerror("Interface condition equations is not associated.",err,error,*999)
14713  ENDIF
14714  CASE(interface_condition_augmented_lagrange_method)
14715  CALL flagerror("Not implemented.",err,error,*999)
14716  CASE(interface_condition_point_to_point_method)
14717  CALL flagerror("Not implemented.",err,error,*999)
14718  CASE DEFAULT
14719  local_error="The interface condition method of "// &
14720  & trim(numbertovstring(interface_condition%METHOD,"*",err,error))// &
14721  & " is invalid."
14722  CALL flagerror(local_error,err,error,*999)
14723  END SELECT
14724  ELSE
14725  CALL flagerror("Interface condition is not associated.",err,error,*999)
14726  ENDIF
14727  ENDDO !interface_condition_idx
14728  !Start the update the solver RHS vector values
14729  CALL distributed_vector_update_start(solver_rhs_vector,err,error,*999)
14730  NULLIFY(check_data)
14731  CALL distributed_vector_data_get(solver_rhs_vector,check_data,err,error,*999)
14732  ELSE
14733  CALL flagerror("The solver RHS vector is not associated.",err,error,*999)
14734  ENDIF
14735  ENDIF
14736  IF(solver%OUTPUT_TYPE>=solver_timing_output) THEN
14737  CALL cpu_timer(user_cpu,user_time2,err,error,*999)
14738  CALL cpu_timer(system_cpu,system_time2,err,error,*999)
14739  user_elapsed=user_time2(1)-user_time1(1)
14740  system_elapsed=system_time2(1)-system_time1(1)
14741  CALL write_string(general_output_type,"",err,error,*999)
14742  CALL write_string_value(general_output_type,"Total user time for solver RHS assembly = ",user_elapsed, &
14743  & err,error,*999)
14744  CALL write_string_value(general_output_type,"Total System time for solver RHS assembly = ",system_elapsed, &
14745  & err,error,*999)
14746  ENDIF
14747  ENDIF
14748  IF(ASSOCIATED(solver_rhs_vector)) THEN
14749  CALL distributed_vector_update_finish(solver_rhs_vector,err,error,*999)
14750  ENDIF
14751  !If required output the solver matrices
14752  IF(solver%OUTPUT_TYPE>=solver_matrix_output) THEN
14753  CALL solver_matrices_output(general_output_type,selection_type,solver_matrices,err,error,*999)
14754  ENDIF
14755  ELSE
14756  CALL flagerror("Solver solver matrices is not associated.",err,error,*999)
14757  ENDIF
14758  ELSE
14759  CALL flagerror("Solver matrices solution mapping is not associated.",err,error,*999)
14760  ENDIF
14761  ELSE
14762  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
14763  ENDIF
14764  ELSE
14765  CALL flagerror("Solver is not associated.",err,error,*999)
14766  ENDIF
14767 
14768  exits("SOLVER_MATRICES_STATIC_ASSEMBLE")
14769  RETURN
14770 999 IF(ALLOCATED(dependent_parameters)) DEALLOCATE(dependent_parameters)
14771  errorsexits("SOLVER_MATRICES_STATIC_ASSEMBLE",err,error)
14772  RETURN 1
14773  END SUBROUTINE solver_matrices_static_assemble
14774 
14775  !
14776  !================================================================================================================================
14777  !
14778 
14780  SUBROUTINE solver_matrices_library_type_get(SOLVER,MATRICES_LIBRARY_TYPE,ERR,ERROR,*)
14781 
14782  !Argument variables
14783  TYPE(solver_type), POINTER :: SOLVER
14784  INTEGER(INTG), INTENT(OUT) :: MATRICES_LIBRARY_TYPE
14785  INTEGER(INTG), INTENT(OUT) :: ERR
14786  TYPE(varying_string), INTENT(OUT) :: ERROR
14787  !Local Variables
14788  TYPE(eigenproblem_solver_type), POINTER :: EIGENPROBLEM_SOLVER
14789  TYPE(linear_solver_type), POINTER :: LINEAR_SOLVER
14790  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
14791  TYPE(optimiser_solver_type), POINTER :: OPTIMISER_SOLVER
14792  TYPE(varying_string) :: LOCAL_ERROR
14793 
14794  enters("SOLVER_MATRICES_LIBRARY_TYPE_GET",err,error,*999)
14795 
14796  IF(ASSOCIATED(solver)) THEN
14797  SELECT CASE(solver%SOLVE_TYPE)
14798  CASE(solver_linear_type)
14799  linear_solver=>solver%LINEAR_SOLVER
14800  IF(ASSOCIATED(linear_solver)) THEN
14801  CALL solver_linear_matrices_library_type_get(linear_solver,matrices_library_type,err,error,*999)
14802  ELSE
14803  CALL flagerror("Solver linear solver is not associated.",err,error,*999)
14804  ENDIF
14805  CASE(solver_nonlinear_type)
14806  nonlinear_solver=>solver%NONLINEAR_SOLVER
14807  IF(ASSOCIATED(nonlinear_solver)) THEN
14808  CALL solver_nonlinear_matrices_library_type_get(nonlinear_solver,matrices_library_type,err,error,*999)
14809  ELSE
14810  CALL flagerror("Solver nonlinear solver is not associated.",err,error,*999)
14811  ENDIF
14812  CASE(solver_dynamic_type)
14813  CALL flagerror("Cannot get the solver matrices library for a dynamic solver.",err,error,*999)
14814  CASE(solver_dae_type)
14815  CALL flagerror("Cannot get the solver matrices library for an differential-algebraic equations solver.",err,error,*999)
14816  CASE(solver_eigenproblem_type)
14817  eigenproblem_solver=>solver%EIGENPROBLEM_SOLVER
14818  IF(ASSOCIATED(eigenproblem_solver)) THEN
14819  CALL solver_eigenproblemmatriceslibrarytypeget(eigenproblem_solver,matrices_library_type,err,error,*999)
14820  ELSE
14821  CALL flagerror("Solver eigenproblem solver is not associated.",err,error,*999)
14822  ENDIF
14823  CASE(solver_optimiser_type)
14824  optimiser_solver=>solver%OPTIMISER_SOLVER
14825  IF(ASSOCIATED(optimiser_solver)) THEN
14826  CALL solver_optimiser_matrices_library_type_get(optimiser_solver,matrices_library_type,err,error,*999)
14827  ELSE
14828  CALL flagerror("Solver optimiser solver is not associated.",err,error,*999)
14829  ENDIF
14830  CASE(solver_cellml_evaluator_type)
14831  CALL flagerror("Cannot get the solver matrices library for a CellML evaluator solver.",err,error,*999)
14832  CASE DEFAULT
14833  local_error="The solver type of "//trim(numbertovstring(solver%SOLVE_TYPE,"*",err,error))//" is invalid."
14834  CALL flagerror(local_error,err,error,*999)
14835  END SELECT
14836  ELSE
14837  CALL flagerror("Solver is not associated.",err,error,*999)
14838  ENDIF
14839 
14840  exits("SOLVER_MATRICES_LIBRARY_TYPE_GET")
14841  RETURN
14842 999 errorsexits("SOLVER_MATRICES_LIBRARY_TYPE_GET",err,error)
14843  RETURN 1
14844 
14845  END SUBROUTINE solver_matrices_library_type_get
14846 
14847  !
14848  !================================================================================================================================
14849  !
14850 
14852  SUBROUTINE solver_quasi_newton_absolute_tolerance_set(SOLVER,ABSOLUTE_TOLERANCE,ERR,ERROR,*)
14853 
14854  !Argument variables
14855  TYPE(solver_type), POINTER :: SOLVER
14856  REAL(DP), INTENT(IN) :: ABSOLUTE_TOLERANCE
14857  INTEGER(INTG), INTENT(OUT) :: ERR
14858  TYPE(varying_string), INTENT(OUT) :: ERROR
14859  !Local Variables
14860  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
14861  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
14862  TYPE(varying_string) :: LOCAL_ERROR
14863 
14864  enters("SOLVER_QUASI_NEWTON_ABSOLUTE_TOLERANCE_SET",err,error,*999)
14865 
14866  IF(ASSOCIATED(solver)) THEN
14867  IF(solver%SOLVER_FINISHED) THEN
14868  CALL flagerror("Solver has already been finished.",err,error,*999)
14869  ELSE
14870  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
14871  nonlinear_solver=>solver%NONLINEAR_SOLVER
14872  IF(ASSOCIATED(nonlinear_solver)) THEN
14873  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
14874  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
14875  IF(ASSOCIATED(quasi_newton_solver)) THEN
14876  IF(absolute_tolerance>zero_tolerance) THEN
14877  quasi_newton_solver%ABSOLUTE_TOLERANCE=absolute_tolerance
14878  ELSE
14879  local_error="The specified absolute tolerance of "//trim(numbertovstring(absolute_tolerance,"*",err,error))// &
14880  & " is invalid. The absolute tolerance must be > 0."
14881  CALL flagerror(local_error,err,error,*999)
14882  ENDIF
14883  ELSE
14884  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
14885  ENDIF
14886  ELSE
14887  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
14888  ENDIF
14889  ELSE
14890  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
14891  ENDIF
14892  ELSE
14893  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
14894  ENDIF
14895  ENDIF
14896  ELSE
14897  CALL flagerror("Solver is not associated.",err,error,*999)
14898  ENDIF
14899 
14900  exits("SOLVER_QUASI_NEWTON_ABSOLUTE_TOLERANCE_SET")
14901  RETURN
14902 999 errorsexits("SOLVER_QUASI_NEWTON_ABSOLUTE_TOLERANCE_SET",err,error)
14903  RETURN 1
14904 
14905  END SUBROUTINE solver_quasi_newton_absolute_tolerance_set
14906 
14907  !
14908  !================================================================================================================================
14909  !
14910 
14912  SUBROUTINE solver_quasinewtonlinesearchmonitoroutputset(solver,linesearchMonitorOutputFlag,err,error,*)
14913 
14914  !Argument variables
14915  TYPE(solver_type), POINTER :: solver
14916  LOGICAL, INTENT(IN) :: linesearchMonitorOutputFlag
14917  INTEGER(INTG), INTENT(OUT) :: err
14918  TYPE(varying_string), INTENT(OUT) :: error
14919  !Local Variables
14920  TYPE(quasi_newton_linesearch_solver_type), POINTER :: linesearchSolver
14921  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
14922  TYPE(nonlinear_solver_type), POINTER :: nonlinearSolver
14923 
14924  enters("Solver_QuasiNewtonLineSearchMonitorOutputSet",err,error,*999)
14925 
14926  IF(ASSOCIATED(solver)) THEN
14927  IF(solver%SOLVER_FINISHED) THEN
14928  CALL flagerror("Solver has already been finished.",err,error,*999)
14929  ELSE
14930  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
14931  nonlinearsolver=>solver%NONLINEAR_SOLVER
14932  IF(ASSOCIATED(nonlinearsolver)) THEN
14933  IF(nonlinearsolver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
14934  quasi_newton_solver=>nonlinearsolver%QUASI_NEWTON_SOLVER
14935  IF(ASSOCIATED(quasi_newton_solver)) THEN
14936  IF(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE==solver_quasi_newton_linesearch) THEN
14937  linesearchsolver=>quasi_newton_solver%LINESEARCH_SOLVER
14938  IF(ASSOCIATED(linesearchsolver)) THEN
14939  linesearchsolver%linesearchMonitorOutput=linesearchmonitoroutputflag
14940  ELSE
14941  CALL flagerror("The Quasi-Newton linesearch solver is not associated.",err,error,*999)
14942  ENDIF
14943  ELSE
14944  CALL flagerror("The Quasi-Newton solver is not a linesearch solver.",err,error,*999)
14945  ENDIF
14946  ELSE
14947  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
14948  ENDIF
14949  ELSE
14950  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
14951  ENDIF
14952  ELSE
14953  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
14954  ENDIF
14955  ELSE
14956  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
14957  ENDIF
14958  ENDIF
14959  ELSE
14960  CALL flagerror("Solver is not associated.",err,error,*999)
14961  ENDIF
14962 
14963  exits("Solver_QuasiNewtonLineSearchMonitorOutputSet")
14964  RETURN
14965 999 errors("Solver_QuasiNewtonLineSearchMonitorOutputSet",err,error)
14966  exits("Solver_QuasiNewtonLineSearchMonitorOutputSet")
14967  RETURN 1
14968 
14969  END SUBROUTINE solver_quasinewtonlinesearchmonitoroutputset
14970 
14971  !
14972  !================================================================================================================================
14973  !
14974 
14976  SUBROUTINE solver_quasi_newton_create_finish(QUASI_NEWTON_SOLVER,ERR,ERROR,*)
14977 
14978  !Argument variables
14979  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
14980  INTEGER(INTG), INTENT(OUT) :: ERR
14981  TYPE(varying_string), INTENT(OUT) :: ERROR
14982  !Local Variables
14983  TYPE(varying_string) :: LOCAL_ERROR
14984 
14985  enters("SOLVER_QUASI_NEWTON_CREATE_FINISH",err,error,*999)
14986 
14987  IF(ASSOCIATED(quasi_newton_solver)) THEN
14988  SELECT CASE(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE)
14989  CASE(solver_quasi_newton_linesearch)
14990  CALL solver_quasinewtonlinesearchcreatefinish(quasi_newton_solver% &
14991  & linesearch_solver,err,error,*999)
14992  CASE(solver_quasi_newton_trustregion)
14993  CALL solver_quasinewtontrustregioncreatefinish(quasi_newton_solver% &
14994  & trustregion_solver,err,error,*999)
14995  CASE DEFAULT
14996  local_error="The Quasi-Newton solver type of "// &
14997  & trim(numbertovstring(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE,"*",err,error))//" is invalid."
14998  CALL flagerror(local_error,err,error,*999)
14999  END SELECT
15000  ELSE
15001  CALL flagerror("Quasi-Newton solver is not associated.",err,error,*999)
15002  ENDIF
15003 
15004  exits("SOLVER_QUASI_NEWTON_CREATE_FINISH")
15005  RETURN
15006 999 errorsexits("SOLVER_QUASI_NEWTON_CREATE_FINISH",err,error)
15007  RETURN 1
15008 
15009  END SUBROUTINE solver_quasi_newton_create_finish
15010 
15011  !
15012  !================================================================================================================================
15013  !
15014 
15016  RECURSIVE SUBROUTINE solver_quasi_newton_finalise(QUASI_NEWTON_SOLVER,ERR,ERROR,*)
15017 
15018  !Argument variables
15019  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
15020  INTEGER(INTG), INTENT(OUT) :: ERR
15021  TYPE(varying_string), INTENT(OUT) :: ERROR
15022  !Local Variables
15023 
15024  enters("SOLVER_QUASI_NEWTON_FINALISE",err,error,*999)
15025 
15026  IF(ASSOCIATED(quasi_newton_solver)) THEN
15027  CALL solver_quasinewtonlinesearchfinalise(quasi_newton_solver%LINESEARCH_SOLVER,err,error,*999)
15028  CALL solver_quasi_newton_trustregion_finalise(quasi_newton_solver%TRUSTREGION_SOLVER,err,error,*999)
15029  CALL solver_finalise(quasi_newton_solver%LINEAR_SOLVER,err,error,*999)
15030  DEALLOCATE(quasi_newton_solver)
15031  ENDIF
15032 
15033  exits("SOLVER_QUASI_NEWTON_FINALISE")
15034  RETURN
15035 999 errorsexits("SOLVER_QUASI_NEWTON_FINALISE",err,error)
15036  RETURN 1
15037 
15038  END SUBROUTINE solver_quasi_newton_finalise
15039 
15040  !
15041  !================================================================================================================================
15042  !
15043 
15045  SUBROUTINE solver_quasi_newton_initialise(NONLINEAR_SOLVER,ERR,ERROR,*)
15046 
15047  !Argument variables
15048  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
15049  INTEGER(INTG), INTENT(OUT) :: ERR
15050  TYPE(varying_string), INTENT(OUT) :: ERROR
15051  !Local Variables
15052  INTEGER(INTG) :: DUMMY_ERR
15053  TYPE(solver_type), POINTER :: SOLVER
15054  TYPE(varying_string) :: DUMMY_ERROR
15055 
15056  enters("SOLVER_QUASI_NEWTON_INITIALISE",err,error,*998)
15057 
15058  IF(ASSOCIATED(nonlinear_solver)) THEN
15059  IF(ASSOCIATED(nonlinear_solver%QUASI_NEWTON_SOLVER)) THEN
15060  CALL flagerror("Quasi-Newton solver is already associated for this nonlinear solver.",err,error,*998)
15061  ELSE
15062  solver=>nonlinear_solver%SOLVER
15063  IF(ASSOCIATED(solver)) THEN
15064  !Allocate and initialise a Quasi-Newton solver
15065  ALLOCATE(nonlinear_solver%QUASI_NEWTON_SOLVER,stat=err)
15066  IF(err/=0) CALL flagerror("Could not allocate nonlinear solver Quasi-Newton solver.",err,error,*999)
15067  nonlinear_solver%QUASI_NEWTON_SOLVER%NONLINEAR_SOLVER=>nonlinear_solver
15068  nonlinear_solver%QUASI_NEWTON_SOLVER%SOLUTION_INITIALISE_TYPE=solver_solution_initialise_current_field
15069  nonlinear_solver%QUASI_NEWTON_SOLVER%TOTAL_NUMBER_OF_FUNCTION_EVALUATIONS=0
15070  nonlinear_solver%QUASI_NEWTON_SOLVER%TOTAL_NUMBER_OF_JACOBIAN_EVALUATIONS=0
15071  nonlinear_solver%QUASI_NEWTON_SOLVER%MAXIMUM_NUMBER_OF_ITERATIONS=50
15072  nonlinear_solver%QUASI_NEWTON_SOLVER%MAXIMUM_NUMBER_OF_FUNCTION_EVALUATIONS=1000
15073  nonlinear_solver%QUASI_NEWTON_SOLVER%JACOBIAN_CALCULATION_TYPE=solver_newton_jacobian_fd_calculated
15074  nonlinear_solver%QUASI_NEWTON_SOLVER%convergenceTestType=solver_newton_convergence_petsc_default
15075  nonlinear_solver%QUASI_NEWTON_SOLVER%ABSOLUTE_TOLERANCE=1.0e-10_dp
15076  nonlinear_solver%QUASI_NEWTON_SOLVER%RELATIVE_TOLERANCE=1.0e-05_dp
15077  nonlinear_solver%QUASI_NEWTON_SOLVER%SOLUTION_TOLERANCE=1.0e-05_dp
15078  NULLIFY(nonlinear_solver%QUASI_NEWTON_SOLVER%LINESEARCH_SOLVER)
15079  NULLIFY(nonlinear_solver%QUASI_NEWTON_SOLVER%TRUSTREGION_SOLVER)
15080  NULLIFY(nonlinear_solver%QUASI_NEWTON_SOLVER%CELLML_EVALUATOR_SOLVER)
15081  NULLIFY(nonlinear_solver%QUASI_NEWTON_SOLVER%convergenceTest)
15082  ALLOCATE(nonlinear_solver%QUASI_NEWTON_SOLVER%convergenceTest,stat=err)
15083  IF(err/=0) CALL flagerror("Could not allocate convergence test object.",err,error,*999)
15084  nonlinear_solver%QUASI_NEWTON_SOLVER%convergenceTest%energyFirstIter = 0.0_dp
15085  nonlinear_solver%QUASI_NEWTON_SOLVER%convergenceTest%normalisedEnergy = 0.0_dp
15086  !Default to a Quasi-Newton linesearch solver
15087  nonlinear_solver%QUASI_NEWTON_SOLVER%QUASI_NEWTON_SOLVE_TYPE=solver_quasi_newton_linesearch
15088  CALL solver_quasi_newton_linesearch_initialise(nonlinear_solver%QUASI_NEWTON_SOLVER,err,error,*999)
15089  !Default to a Quasi-Newton Good Broyden variant
15090  nonlinear_solver%QUASI_NEWTON_SOLVER%QUASI_NEWTON_TYPE=solver_quasi_newton_goodbroyden
15091  nonlinear_solver%QUASI_NEWTON_SOLVER%RESTART_TYPE=solver_quasi_newton_restart_periodic
15092  nonlinear_solver%QUASI_NEWTON_SOLVER%RESTART=10
15093  nonlinear_solver%QUASI_NEWTON_SOLVER%SCALE_TYPE=solver_quasi_newton_scale_jacobian
15094  !Create the linked linear solver
15095  ALLOCATE(nonlinear_solver%QUASI_NEWTON_SOLVER%LINEAR_SOLVER,stat=err)
15096  IF(err/=0) CALL flagerror("Could not allocate Quasi-Newton solver linear solver.",err,error,*999)
15097  NULLIFY(nonlinear_solver%QUASI_NEWTON_SOLVER%LINEAR_SOLVER%SOLVERS)
15098  CALL solver_initialise_ptr(nonlinear_solver%QUASI_NEWTON_SOLVER%LINEAR_SOLVER,err,error,*999)
15099  CALL solver_linear_initialise(nonlinear_solver%QUASI_NEWTON_SOLVER%LINEAR_SOLVER,err,error,*999)
15100  CALL solver_linked_solver_add(solver,nonlinear_solver%QUASI_NEWTON_SOLVER%LINEAR_SOLVER,solver_linear_type,err,error,*999)
15101  ELSE
15102  CALL flagerror("Nonlinear solver solver is not associated.",err,error,*998)
15103  ENDIF
15104  ENDIF
15105  ELSE
15106  CALL flagerror("Nonlinear solver is not associated.",err,error,*998)
15107  ENDIF
15108 
15109  exits("SOLVER_QUASI_NEWTON_INITIALISE")
15110  RETURN
15111 999 CALL solver_quasi_newton_finalise(nonlinear_solver%QUASI_NEWTON_SOLVER,dummy_err,dummy_error,*998)
15112 998 errorsexits("SOLVER_QUASI_NEWTON_INITIALISE",err,error)
15113  RETURN 1
15114 
15115  END SUBROUTINE solver_quasi_newton_initialise
15116 
15117  !
15118  !================================================================================================================================
15119  !
15120 
15122  SUBROUTINE solver_quasinewtonjacobiancalculationtypeset(SOLVER,JACOBIAN_CALCULATION_TYPE,ERR,ERROR,*)
15123 
15124  !Argument variables
15125  TYPE(solver_type), POINTER :: SOLVER
15126  INTEGER(INTG), INTENT(IN) :: JACOBIAN_CALCULATION_TYPE
15127  INTEGER(INTG), INTENT(OUT) :: ERR
15128  TYPE(varying_string), INTENT(OUT) :: ERROR
15129  !Local Variables
15130  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
15131  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
15132  TYPE(varying_string) :: LOCAL_ERROR
15133 
15134  enters("Solver_QuasiNewtonJacobianCalculationTypeSet",err,error,*999)
15135 
15136  IF(ASSOCIATED(solver)) THEN
15137  IF(solver%SOLVER_FINISHED) THEN
15138  CALL flagerror("Solver has already been finished",err,error,*999)
15139  ELSE
15140  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
15141  nonlinear_solver=>solver%NONLINEAR_SOLVER
15142  IF(ASSOCIATED(nonlinear_solver)) THEN
15143  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
15144  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
15145  IF(ASSOCIATED(quasi_newton_solver)) THEN
15146  IF(jacobian_calculation_type/=quasi_newton_solver%JACOBIAN_CALCULATION_TYPE) THEN
15147  SELECT CASE(jacobian_calculation_type)
15148  CASE(solver_newton_jacobian_not_calculated)
15149  quasi_newton_solver%JACOBIAN_CALCULATION_TYPE=solver_newton_jacobian_not_calculated
15150  CASE(solver_newton_jacobian_equations_calculated)
15151  quasi_newton_solver%JACOBIAN_CALCULATION_TYPE=solver_newton_jacobian_equations_calculated
15152  CASE(solver_newton_jacobian_fd_calculated)
15153  quasi_newton_solver%JACOBIAN_CALCULATION_TYPE=solver_newton_jacobian_fd_calculated
15154  CASE DEFAULT
15155  local_error="The Jacobian calculation type of "// &
15156  & trim(numbertovstring(jacobian_calculation_type,"*",err,error))//" is invalid."
15157  CALL flagerror(local_error,err,error,*999)
15158  END SELECT
15159  ENDIF
15160  ELSE
15161  CALL flagerror("The nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
15162  ENDIF
15163  ELSE
15164  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
15165  ENDIF
15166  ELSE
15167  CALL flagerror("The Solver nonlinear solver is not associated",err,error,*999)
15168  ENDIF
15169  ELSE
15170  CALL flagerror("The solver is not a nonlinear solver",err,error,*999)
15171  ENDIF
15172  ENDIF
15173  ELSE
15174  CALL flagerror("Solver is not associated",err,error,*999)
15175  ENDIF
15176 
15177  exits("Solver_QuasiNewtonJacobianCalculationTypeSet")
15178  RETURN
15179 999 errors("Solver_QuasiNewtonJacobianCalculationTypeSet",err,error)
15180  exits("Solver_QuasiNewtonJacobianCalculationTypeSet")
15181  RETURN 1
15182 
15183  END SUBROUTINE solver_quasinewtonjacobiancalculationtypeset
15184 
15185  !
15186  !================================================================================================================================
15187  !
15188 
15190  SUBROUTINE solver_quasi_newton_library_type_get(QUASI_NEWTON_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
15191 
15192  !Argument variables
15193  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
15194  INTEGER(INTG), INTENT(OUT) :: SOLVER_LIBRARY_TYPE
15195  INTEGER(INTG), INTENT(OUT) :: ERR
15196  TYPE(varying_string), INTENT(OUT) :: ERROR
15197  !Local Variables
15198  TYPE(quasi_newton_linesearch_solver_type), POINTER :: LINESEARCH_SOLVER
15199  TYPE(quasi_newton_trustregion_solver_type), POINTER :: TRUSTREGION_SOLVER
15200  TYPE(varying_string) :: LOCAL_ERROR
15201 
15202  enters("SOLVER_QUASI_NEWTON_LIBRARY_TYPE_GET",err,error,*999)
15203 
15204  IF(ASSOCIATED(quasi_newton_solver)) THEN
15205  SELECT CASE(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE)
15206  CASE(solver_quasi_newton_linesearch)
15207  linesearch_solver=>quasi_newton_solver%LINESEARCH_SOLVER
15208  IF(ASSOCIATED(linesearch_solver)) THEN
15209  solver_library_type=linesearch_solver%SOLVER_LIBRARY
15210  ELSE
15211  CALL flagerror("Quasi-Newton line search solver is not associated.",err,error,*999)
15212  ENDIF
15213  CASE(solver_quasi_newton_trustregion)
15214  trustregion_solver=>quasi_newton_solver%TRUSTREGION_SOLVER
15215  IF(ASSOCIATED(trustregion_solver)) THEN
15216  solver_library_type=trustregion_solver%SOLVER_LIBRARY
15217  ELSE
15218  CALL flagerror("Quasi-Newton trust region solver is not associated.",err,error,*999)
15219  ENDIF
15220  CASE DEFAULT
15221  local_error="The Quasi-Newton solver type of "// &
15222  & trim(numbertovstring(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE,"*",err,error))//" is invalid."
15223  CALL flagerror(local_error,err,error,*999)
15224  END SELECT
15225  ELSE
15226  CALL flagerror("Quasi-Newton solver is not associated.",err,error,*999)
15227  ENDIF
15228 
15229  exits("SOLVER_QUASI_NEWTON_LIBRARY_TYPE_GET")
15230  RETURN
15231 999 errorsexits("SOLVER_QUASI_NEWTON_LIBRARY_TYPE_GET",err,error)
15232  RETURN 1
15233 
15234  END SUBROUTINE solver_quasi_newton_library_type_get
15235 
15236  !
15237  !================================================================================================================================
15238  !
15239 
15241  SUBROUTINE solver_quasi_newton_library_type_set(QUASI_NEWTON_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
15242 
15243  !Argument variables
15244  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
15245  INTEGER(INTG), INTENT(IN) :: SOLVER_LIBRARY_TYPE
15246  INTEGER(INTG), INTENT(OUT) :: ERR
15247  TYPE(varying_string), INTENT(OUT) :: ERROR
15248  !Local Variables
15249  TYPE(quasi_newton_linesearch_solver_type), POINTER :: LINESEARCH_SOLVER
15250  TYPE(quasi_newton_trustregion_solver_type), POINTER :: TRUSTREGION_SOLVER
15251  TYPE(varying_string) :: LOCAL_ERROR
15252 
15253  enters("SOLVER_QUASI_NEWTON_LIBRARY_TYPE_SET",err,error,*999)
15254 
15255  IF(ASSOCIATED(quasi_newton_solver)) THEN
15256  SELECT CASE(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE)
15257  CASE(solver_quasi_newton_linesearch)
15258  linesearch_solver=>quasi_newton_solver%LINESEARCH_SOLVER
15259  IF(ASSOCIATED(linesearch_solver)) THEN
15260  SELECT CASE(solver_library_type)
15261  CASE(solver_cmiss_library)
15262  CALL flagerror("Not implemented.",err,error,*999)
15263  CASE(solver_petsc_library)
15264  linesearch_solver%SOLVER_LIBRARY=solver_petsc_library
15265  linesearch_solver%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
15266  CASE DEFAULT
15267  local_error="The solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
15268  & " is invalid for a Quasi-Newton linesearch solver."
15269  CALL flagerror(local_error,err,error,*999)
15270  END SELECT
15271  ELSE
15272  CALL flagerror("Quasi-Newton line search solver is not associated.",err,error,*999)
15273  ENDIF
15274  CASE(solver_quasi_newton_trustregion)
15275  trustregion_solver=>quasi_newton_solver%TRUSTREGION_SOLVER
15276  IF(ASSOCIATED(trustregion_solver)) THEN
15277  SELECT CASE(solver_library_type)
15278  CASE(solver_cmiss_library)
15279  CALL flagerror("Not implemented.",err,error,*999)
15280  CASE(solver_petsc_library)
15281  trustregion_solver%SOLVER_LIBRARY=solver_petsc_library
15282  trustregion_solver%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
15283  CASE DEFAULT
15284  local_error="The solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
15285  & " is invalid for a Quasi-Newton trustregion solver."
15286  CALL flagerror(local_error,err,error,*999)
15287  END SELECT
15288  ELSE
15289  CALL flagerror("Quasi-Newton trust region solver is not associated.",err,error,*999)
15290  ENDIF
15291  CASE DEFAULT
15292  local_error="The Quasi-Newton solver type of "// &
15293  & trim(numbertovstring(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE,"*",err,error))//" is invalid."
15294  CALL flagerror(local_error,err,error,*999)
15295  END SELECT
15296  ELSE
15297  CALL flagerror("Quasi-Newton solver is not associated.",err,error,*999)
15298  ENDIF
15299 
15300  exits("SOLVER_QUASI_NEWTON_LIBRARY_TYPE_SET")
15301  RETURN
15302 999 errorsexits("SOLVER_QUASI_NEWTON_LIBRARY_TYPE_SET",err,error)
15303  RETURN 1
15304 
15305  END SUBROUTINE solver_quasi_newton_library_type_set
15306 
15307  !
15308  !================================================================================================================================
15309  !
15310 
15312  SUBROUTINE solver_quasi_newton_linear_solver_get(SOLVER,LINEAR_SOLVER,ERR,ERROR,*)
15313 
15314  !Argument variables
15315  TYPE(solver_type), POINTER :: SOLVER
15316  TYPE(solver_type), POINTER :: LINEAR_SOLVER
15317  INTEGER(INTG), INTENT(OUT) :: ERR
15318  TYPE(varying_string), INTENT(OUT) :: ERROR
15319  !Local Variables
15320  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
15321  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
15322 
15323  enters("SOLVER_QUASI_NEWTON_LINEAR_SOLVER_GET",err,error,*999)
15324 
15325  IF(ASSOCIATED(solver)) THEN
15326  IF(ASSOCIATED(linear_solver)) THEN
15327  CALL flagerror("Linear solver is already associated.",err,error,*999)
15328  ELSE
15329  NULLIFY(linear_solver)
15330  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
15331  nonlinear_solver=>solver%NONLINEAR_SOLVER
15332  IF(ASSOCIATED(nonlinear_solver)) THEN
15333  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
15334  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
15335  IF(ASSOCIATED(quasi_newton_solver)) THEN
15336  linear_solver=>quasi_newton_solver%LINEAR_SOLVER
15337  IF(.NOT.ASSOCIATED(linear_solver)) &
15338  & CALL flagerror("Quasi-Newton solver linear solver is not associated.",err,error,*999)
15339  ELSE
15340  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
15341  ENDIF
15342  ELSE
15343  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
15344  ENDIF
15345  ELSE
15346  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
15347  ENDIF
15348  ELSE
15349  CALL flagerror("The specified solver is not a dynamic solver.",err,error,*999)
15350  ENDIF
15351  ENDIF
15352  ELSE
15353  CALL flagerror("Solver is not associated.",err,error,*999)
15354  ENDIF
15355 
15356  exits("SOLVER_QUASI_NEWTON_LINEAR_SOLVER_GET")
15357  RETURN
15358 999 errorsexits("SOLVER_QUASI_NEWTON_LINEAR_SOLVER_GET",err,error)
15359  RETURN 1
15360 
15361  END SUBROUTINE solver_quasi_newton_linear_solver_get
15362 
15363  !
15364  !================================================================================================================================
15365  !
15366 
15368  SUBROUTINE solver_quasi_newton_cellml_solver_get(SOLVER,CELLML_SOLVER,ERR,ERROR,*)
15369 
15370  !Argument variables
15371  TYPE(solver_type), POINTER :: SOLVER
15372  TYPE(solver_type), POINTER :: CELLML_SOLVER
15373  INTEGER(INTG), INTENT(OUT) :: ERR
15374  TYPE(varying_string), INTENT(OUT) :: ERROR
15375  !Local Variables
15376  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
15377  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
15378 
15379  enters("SOLVER_QUASI_NEWTON_CELLML_SOLVER_GET",err,error,*999)
15380 
15381  IF(ASSOCIATED(solver)) THEN
15382  IF(ASSOCIATED(cellml_solver)) THEN
15383  CALL flagerror("Linear solver is already associated.",err,error,*999)
15384  ELSE
15385  NULLIFY(cellml_solver)
15386  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
15387  nonlinear_solver=>solver%NONLINEAR_SOLVER
15388  IF(ASSOCIATED(nonlinear_solver)) THEN
15389  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
15390  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
15391  IF(ASSOCIATED(quasi_newton_solver)) THEN
15392  cellml_solver=>quasi_newton_solver%CELLML_EVALUATOR_SOLVER
15393  IF(.NOT.ASSOCIATED(cellml_solver)) &
15394  & CALL flagerror("Quasi-Newton solver CellML solver is not associated.",err,error,*999)
15395  ELSE
15396  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
15397  ENDIF
15398  ELSE
15399  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
15400  ENDIF
15401  ELSE
15402  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
15403  ENDIF
15404  ELSE IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
15405  nonlinear_solver=>solver%DYNAMIC_SOLVER%NONLINEAR_SOLVER%NONLINEAR_SOLVER
15406  IF(ASSOCIATED(nonlinear_solver)) THEN
15407  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
15408  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
15409  IF(ASSOCIATED(quasi_newton_solver)) THEN
15410  cellml_solver=>quasi_newton_solver%CELLML_EVALUATOR_SOLVER
15411  IF(.NOT.ASSOCIATED(cellml_solver)) &
15412  & CALL flagerror("Quasi-Newton solver CellML solver is not associated.",err,error,*999)
15413  ELSE
15414  CALL flagerror("Dynamic nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
15415  ENDIF
15416  ELSE
15417  CALL flagerror("The Dynamic nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
15418  ENDIF
15419  ELSE
15420  CALL flagerror("The solver dynamic nonlinear solver is not associated.",err,error,*999)
15421  ENDIF
15422  ELSE
15423  CALL flagerror("The specified solver is not a nonlinear or dynamic nonlinear solver.",err,error,*999)
15424  ENDIF
15425  ENDIF
15426  ELSE
15427  CALL flagerror("Solver is not associated.",err,error,*999)
15428  ENDIF
15429 
15430  exits("SOLVER_QUASI_NEWTON_CELLML_SOLVER_GET")
15431  RETURN
15432 999 errorsexits("SOLVER_QUASI_NEWTON_CELLML_SOLVER_GET",err,error)
15433  RETURN 1
15434 
15435  END SUBROUTINE solver_quasi_newton_cellml_solver_get
15436 
15437  !
15438  !================================================================================================================================
15439  !
15440 
15442  SUBROUTINE solver_quasinewtonconvergencetesttypeset(solver,convergenceTestType,err,error,*)
15443 
15444  !Argument variables
15445  TYPE(solver_type), POINTER :: solver
15446  INTEGER(INTG), INTENT(IN) :: convergenceTestType
15447  INTEGER(INTG), INTENT(OUT) :: err
15448  TYPE(varying_string), INTENT(OUT) :: error
15449  !Local Variables
15450  TYPE(quasi_newton_solver_type), POINTER :: quasiNewtonSolver
15451  TYPE(nonlinear_solver_type), POINTER :: nonlinearSolver
15452  TYPE(varying_string) :: localError
15453 
15454  enters("Solver_QuasiNewtonConvergenceTestTypeSet",err,error,*999)
15455 
15456  IF(ASSOCIATED(solver)) THEN
15457  IF(solver%SOLVER_FINISHED) THEN
15458  CALL flagerror("Solver has already been finished.",err,error,*999)
15459  ELSE
15460  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
15461  nonlinearsolver=>solver%NONLINEAR_SOLVER
15462  IF(ASSOCIATED(nonlinearsolver)) THEN
15463  IF(nonlinearsolver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
15464  quasinewtonsolver=>nonlinearsolver%QUASI_NEWTON_SOLVER
15465  IF(ASSOCIATED(quasinewtonsolver)) THEN
15466  SELECT CASE(convergencetesttype)
15467  CASE(solver_newton_convergence_petsc_default)
15468  quasinewtonsolver%convergenceTestType=solver_newton_convergence_petsc_default
15469  CASE(solver_newton_convergence_energy_norm)
15470  quasinewtonsolver%convergenceTestType=solver_newton_convergence_energy_norm
15471  CASE(solver_newton_convergence_differentiated_ratio)
15472  quasinewtonsolver%convergenceTestType=solver_newton_convergence_differentiated_ratio
15473  CASE DEFAULT
15474  localerror="The specified convergence test type of "//trim(numbertovstring(convergencetesttype, &
15475  & "*",err,error))//" is invalid."
15476  CALL flagerror(localerror,err,error,*999)
15477  END SELECT
15478  ELSE
15479  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
15480  ENDIF
15481  ELSE
15482  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
15483  ENDIF
15484  ELSE
15485  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
15486  ENDIF
15487  ELSE
15488  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
15489  ENDIF
15490  ENDIF
15491  ELSE
15492  CALL flagerror("Solver is not associated.",err,error,*999)
15493  ENDIF
15494 
15495  exits("Solver_QuasiNewtonConvergenceTestTypeSet")
15496  RETURN
15497 999 errorsexits("Solver_QuasiNewtonConvergenceTestTypeSet",err,error)
15498  RETURN 1
15499 
15500  END SUBROUTINE solver_quasinewtonconvergencetesttypeset
15501 
15502  !
15503  !================================================================================================================================
15504  !
15505 
15507  SUBROUTINE solver_quasinewtonlinesearchcreatefinish(LINESEARCH_SOLVER,ERR,ERROR,*)
15508 
15509  !Argument variables
15510  TYPE(quasi_newton_linesearch_solver_type), POINTER :: LINESEARCH_SOLVER
15511  INTEGER(INTG), INTENT(OUT) :: ERR
15512  TYPE(varying_string), INTENT(OUT) :: ERROR
15513  !Local Variables
15514  EXTERNAL :: problem_solverjacobianevaluatepetsc
15515  EXTERNAL :: problem_solverjacobianfdcalculatepetsc
15516  EXTERNAL :: problem_solverresidualevaluatepetsc
15517  EXTERNAL :: problem_solverconvergencetestpetsc
15518  EXTERNAL :: problem_solvernonlinearmonitorpetsc
15519  INTEGER(INTG) :: equations_matrix_idx,equations_set_idx,interface_condition_idx,interface_matrix_idx
15520  TYPE(distributed_matrix_type), POINTER :: JACOBIAN_MATRIX
15521  TYPE(distributed_vector_type), POINTER :: RESIDUAL_VECTOR
15522  TYPE(equations_type), POINTER :: EQUATIONS
15523  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
15524  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
15525  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
15526  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
15527  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
15528  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
15529  TYPE(field_type), POINTER :: DEPENDENT_FIELD,LAGRANGE_FIELD
15530  TYPE(field_variable_type), POINTER :: LINEAR_VARIABLE,INTERFACE_VARIABLE,LAGRANGE_VARIABLE
15531  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
15532  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
15533  TYPE(solver_type), POINTER :: LINEAR_SOLVER,SOLVER
15534  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
15535  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
15536  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
15537  TYPE(solver_matrix_type), POINTER :: SOLVER_JACOBIAN
15538  TYPE(interface_condition_type), POINTER :: INTERFACE_CONDITION
15539  TYPE(interface_equations_type), POINTER :: INTERFACE_EQUATIONS
15540  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
15541  TYPE(interface_matrices_type), POINTER :: INTERFACE_MATRICES
15542  TYPE(interface_matrix_type), POINTER :: INTERFACE_MATRIX
15543 
15544  TYPE(varying_string) :: LOCAL_ERROR
15545 
15546  enters("Solver_QuasiNewtonLinesearchCreateFinish",err,error,*999)
15547 
15548  IF(ASSOCIATED(linesearch_solver)) THEN
15549  quasi_newton_solver=>linesearch_solver%QUASI_NEWTON_SOLVER
15550  IF(ASSOCIATED(quasi_newton_solver)) THEN
15551  nonlinear_solver=>quasi_newton_solver%NONLINEAR_SOLVER
15552  IF(ASSOCIATED(nonlinear_solver)) THEN
15553  solver=>nonlinear_solver%SOLVER
15554  IF(ASSOCIATED(solver)) THEN
15555  solver_equations=>solver%SOLVER_EQUATIONS
15556  IF(ASSOCIATED(solver_equations)) THEN
15557  SELECT CASE(linesearch_solver%SOLVER_LIBRARY)
15558  CASE(solver_cmiss_library)
15559  CALL flagerror("Not implemented.",err,error,*999)
15560  CASE(solver_petsc_library)
15561  solver_mapping=>solver_equations%SOLVER_MAPPING
15562  IF(ASSOCIATED(solver_mapping)) THEN
15563  !Loop over the equations set in the solver equations
15564  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
15565  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)%EQUATIONS
15566  IF(ASSOCIATED(equations)) THEN
15567  equations_set=>equations%EQUATIONS_SET
15568  IF(ASSOCIATED(equations_set)) THEN
15569  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
15570  IF(ASSOCIATED(dependent_field)) THEN
15571  equations_mapping=>equations%EQUATIONS_MAPPING
15572  IF(ASSOCIATED(equations_mapping)) THEN
15573  linear_mapping=>equations_mapping%LINEAR_MAPPING
15574  IF(ASSOCIATED(linear_mapping)) THEN
15575  !If there are any linear matrices create temporary vector for matrix-vector products
15576  equations_matrices=>equations%EQUATIONS_MATRICES
15577  IF(ASSOCIATED(equations_matrices)) THEN
15578  linear_matrices=>equations_matrices%LINEAR_MATRICES
15579  IF(ASSOCIATED(linear_matrices)) THEN
15580  DO equations_matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
15581  equations_matrix=>linear_matrices%MATRICES(equations_matrix_idx)%PTR
15582  IF(ASSOCIATED(equations_matrix)) THEN
15583  IF(.NOT.ASSOCIATED(equations_matrix%TEMP_VECTOR)) THEN
15584  linear_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(equations_matrix_idx)%VARIABLE
15585  IF(ASSOCIATED(linear_variable)) THEN
15586  CALL distributed_vector_create_start(linear_variable%DOMAIN_MAPPING, &
15587  & equations_matrix%TEMP_VECTOR,err,error,*999)
15588  CALL distributed_vector_data_type_set(equations_matrix%TEMP_VECTOR, &
15589  & distributed_matrix_vector_dp_type,err,error,*999)
15590  CALL distributed_vector_create_finish(equations_matrix%TEMP_VECTOR,err,error,*999)
15591  ELSE
15592  CALL flagerror("Linear mapping linear variable is not associated.",err,error,*999)
15593  ENDIF
15594  ENDIF
15595  ELSE
15596  CALL flagerror("Equations matrix is not associated.",err,error,*999)
15597  ENDIF
15598  ENDDO !equations_matrix_idx
15599  ELSE
15600  CALL flagerror("Equations matrices linear matrices is not associated.",err,error,*999)
15601  ENDIF
15602  ELSE
15603  CALL flagerror("Equations equations matrices is not associated.",err,error,*999)
15604  ENDIF
15605  ENDIF
15606  ELSE
15607  CALL flagerror("Equations equations mapping is not associated.",err,error,*999)
15608  ENDIF
15609  ELSE
15610  local_error="Equations set dependent field is not associated for equations set index "// &
15611  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
15612  CALL flagerror(local_error,err,error,*999)
15613  ENDIF
15614  ELSE
15615  local_error="Equations equations set is not associated for equations set index "// &
15616  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
15617  CALL flagerror(local_error,err,error,*999)
15618  ENDIF
15619  ELSE
15620  local_error="Equations is not associated for equations set index "// &
15621  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
15622  CALL flagerror(local_error,err,error,*999)
15623  ENDIF
15624  ENDDO !equations_set_idx
15625  !Loop over the interface conditions
15626  DO interface_condition_idx=1,solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS
15627  interface_condition=>solver_mapping%INTERFACE_CONDITIONS(interface_condition_idx)%PTR
15628  IF(ASSOCIATED(interface_condition)) THEN
15629  lagrange_field=>interface_condition%LAGRANGE%LAGRANGE_FIELD
15630  IF(ASSOCIATED(lagrange_field)) THEN
15631  interface_equations=>interface_condition%INTERFACE_EQUATIONS
15632  IF(ASSOCIATED(interface_equations)) THEN
15633  interface_matrices=>interface_equations%INTERFACE_MATRICES
15634  IF(ASSOCIATED(interface_matrices)) THEN
15635  interface_mapping=>interface_equations%INTERFACE_MAPPING
15636  IF(ASSOCIATED(interface_mapping)) THEN
15637  lagrange_variable=>interface_mapping%LAGRANGE_VARIABLE
15638  IF(ASSOCIATED(lagrange_variable)) THEN
15639  !Create temporary vector for matrix-vector products
15640  DO interface_matrix_idx=1,interface_mapping%NUMBER_OF_INTERFACE_MATRICES
15641  interface_matrix=>interface_matrices%MATRICES(interface_matrix_idx)%PTR
15642  IF(ASSOCIATED(interface_matrix)) THEN
15643  IF(.NOT.ASSOCIATED(interface_matrix%TEMP_VECTOR)) THEN
15644  interface_variable=>interface_mapping% &
15645  & interface_matrix_rows_to_var_maps(interface_matrix_idx)%VARIABLE
15646  IF(ASSOCIATED(interface_variable)) THEN
15647  !Set up the temporary interface distributed vector to be used with interface matrices
15648  CALL distributed_vector_create_start(interface_variable%DOMAIN_MAPPING, &
15649  & interface_matrix%TEMP_VECTOR,err,error,*999)
15650  CALL distributed_vector_data_type_set(interface_matrix%TEMP_VECTOR, &
15651  & distributed_matrix_vector_dp_type,err,error,*999)
15652  CALL distributed_vector_create_finish(interface_matrix%TEMP_VECTOR,err,error,*999)
15653  !Set up the temporary interface distributed vector to be used with transposed interface matrices
15654  CALL distributed_vector_create_start(lagrange_variable%DOMAIN_MAPPING, &
15655  & interface_matrix%TEMP_TRANSPOSE_VECTOR,err,error,*999)
15656  CALL distributed_vector_data_type_set(interface_matrix%TEMP_TRANSPOSE_VECTOR, &
15657  & distributed_matrix_vector_dp_type,err,error,*999)
15658  CALL distributed_vector_create_finish(interface_matrix%TEMP_TRANSPOSE_VECTOR, &
15659  & err,error,*999)
15660  ELSE
15661  CALL flagerror("Interface mapping variable is not associated.",err,error,*999)
15662  ENDIF
15663  ENDIF
15664  ELSE
15665  CALL flagerror("Interface matrix is not associated.",err,error,*999)
15666  ENDIF
15667  ENDDO !interface_matrix_idx
15668  ELSE
15669  CALL flagerror("Interface matrix is not associated.",err,error,*999)
15670  ENDIF
15671  ELSE
15672  CALL flagerror("interface condition mapping is not associated.",err,error,*999)
15673  ENDIF
15674  ELSE
15675  CALL flagerror("Interface matrices is not associated.",err,error,*999)
15676  ENDIF
15677  ELSE
15678  local_error="Interface eqauations is not associated for interface condition index "// &
15679  & trim(numbertovstring(interface_condition_idx,"*",err,error))//"."
15680  CALL flagerror(local_error,err,error,*999)
15681  ENDIF
15682  ELSE
15683  local_error="Interface condition Lagrange field is not associated for interface condition "// &
15684  & trim(numbertovstring(interface_condition_idx,"*",err,error))//"."
15685  CALL flagerror(local_error,err,error,*999)
15686  ENDIF
15687  ELSE
15688  local_error="Interface condition is not associated for interface condition index "// &
15689  & trim(numbertovstring(interface_condition_idx,"*",err,error))//"."
15690  CALL flagerror(local_error,err,error,*999)
15691  ENDIF
15692  ENDDO !interface_idx
15693  !Create the PETSc SNES solver
15694  CALL petsc_snescreate(computational_environment%MPI_COMM,linesearch_solver%snes,err,error,*999)
15695  !Set the nonlinear solver type to be a Quasi-Newton line search solver
15696  CALL petsc_snessettype(linesearch_solver%snes,petsc_snesqn,err,error,*999)
15697  !Following routines don't work for petsc version < 3.5.
15698  !Set the nonlinear Quasi-Newton type
15699  SELECT CASE(quasi_newton_solver%QUASI_NEWTON_TYPE)
15700  CASE(solver_quasi_newton_lbfgs)
15701  CALL petsc_snesqnsettype(linesearch_solver%snes,petsc_snes_qn_lbfgs,err,error,*999)
15702  CASE(solver_quasi_newton_goodbroyden)
15703  CALL petsc_snesqnsettype(linesearch_solver%snes,petsc_snes_qn_broyden,err,error,*999)
15704  CASE(solver_quasi_newton_badbroyden)
15705  CALL petsc_snesqnsettype(linesearch_solver%snes,petsc_snes_qn_badbroyden,err,error,*999)
15706  CASE DEFAULT
15707  local_error="The specified nonlinear Quasi-Newton type of "// &
15708  & trim(numbertovstring(quasi_newton_solver%QUASI_NEWTON_TYPE,"*",err,error))//" is invalid."
15709  CALL flagerror(local_error,err,error,*999)
15710  END SELECT
15711  !Set the nonlinear Quasi-Newton restart type
15712  SELECT CASE(quasi_newton_solver%RESTART_TYPE)
15713  CASE(solver_quasi_newton_restart_none)
15714  CALL petsc_snesqnsetrestarttype(linesearch_solver%snes,petsc_snes_qn_restart_none,err,error,*999)
15715  CASE(solver_quasi_newton_restart_powell)
15716  CALL petsc_snesqnsetrestarttype(linesearch_solver%snes,petsc_snes_qn_restart_powell,err,error,*999)
15717  CASE(solver_quasi_newton_restart_periodic)
15718  CALL petsc_snesqnsetrestarttype(linesearch_solver%snes,petsc_snes_qn_restart_periodic,err,error,*999)
15719  CASE DEFAULT
15720  local_error="The specified nonlinear Quasi-Newton restart type of "// &
15721  & trim(numbertovstring(quasi_newton_solver%RESTART_TYPE,"*",err,error))//" is invalid."
15722  CALL flagerror(local_error,err,error,*999)
15723  END SELECT
15724  !Set the nonlinear Quasi-Newton scale type
15725  SELECT CASE(quasi_newton_solver%SCALE_TYPE)
15726  CASE(solver_quasi_newton_scale_none)
15727  CALL petsc_snesqnsetscaletype(linesearch_solver%snes,petsc_snes_qn_scale_none,err,error,*999)
15728  CASE(solver_quasi_newton_scale_shanno)
15729  CALL petsc_snesqnsetscaletype(linesearch_solver%snes,petsc_snes_qn_scale_shanno,err,error,*999)
15730  CASE(solver_quasi_newton_scale_linesearch)
15731  CALL petsc_snesqnsetscaletype(linesearch_solver%snes,petsc_snes_qn_scale_linesearch,err,error,*999)
15732  CASE(solver_quasi_newton_scale_jacobian)
15733  CALL petsc_snesqnsetscaletype(linesearch_solver%snes,petsc_snes_qn_scale_jacobian,err,error,*999)
15734  CASE DEFAULT
15735  local_error="The specified nonlinear Quasi-Newton scale type of "// &
15736  & trim(numbertovstring(quasi_newton_solver%SCALE_TYPE,"*",err,error))//" is invalid."
15737  CALL flagerror(local_error,err,error,*999)
15738  END SELECT
15739 
15740  !Set the Quasi-Newton restart
15741  !Not implemented yet, as there is currently no routine in PETSc for this. If need be, this can be set in your petscrc file.
15742  !Create the solver matrices and vectors
15743  linear_solver=>quasi_newton_solver%LINEAR_SOLVER
15744  IF(ASSOCIATED(linear_solver)) THEN
15745  NULLIFY(solver_matrices)
15746  CALL solver_matrices_create_start(solver_equations,solver_matrices,err,error,*999)
15747  CALL solver_matrices_library_type_set(solver_matrices,solver_petsc_library,err,error,*999)
15748  SELECT CASE(solver_equations%SPARSITY_TYPE)
15749  CASE(solver_sparse_matrices)
15750  CALL solver_matrices_storage_type_set(solver_matrices,[distributed_matrix_compressed_row_storage_type], &
15751  & err,error,*999)
15752  CASE(solver_full_matrices)
15753  CALL solver_matrices_storage_type_set(solver_matrices,[distributed_matrix_block_storage_type], &
15754  & err,error,*999)
15755  CASE DEFAULT
15756  local_error="The specified solver equations sparsity type of "// &
15757  & trim(numbertovstring(solver_equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
15758  CALL flagerror(local_error,err,error,*999)
15759  END SELECT
15760  CALL solver_matrices_create_finish(solver_matrices,err,error,*999)
15761  !Link linear solver
15762  linear_solver%SOLVER_EQUATIONS=>solver%SOLVER_EQUATIONS
15763  !Finish the creation of the linear solver
15764  CALL solver_linear_create_finish(linear_solver%LINEAR_SOLVER,err,error,*999)
15765  !Associate linear solver's KSP to nonlinear solver's SNES
15766  SELECT CASE(linear_solver%LINEAR_SOLVER%LINEAR_SOLVE_TYPE)
15767  CASE(solver_linear_direct_solve_type)
15768  CALL petsc_snessetksp(linesearch_solver%snes,linear_solver%linear_solver%direct_solver%ksp,err,error,*999)
15769  CASE(solver_linear_iterative_solve_type)
15770  CALL petsc_snessetksp(linesearch_solver%snes,linear_solver%linear_solver%iterative_solver%ksp,err,error,*999)
15771  END SELECT
15772 
15773  !Set the nonlinear function
15774  residual_vector=>solver_matrices%RESIDUAL
15775  IF(ASSOCIATED(residual_vector)) THEN
15776  IF(ASSOCIATED(residual_vector%PETSC)) THEN
15777  !Pass the linesearch solver object rather than the temporary solver
15778  CALL petsc_snessetfunction(linesearch_solver%snes,residual_vector%PETSC%VECTOR, &
15779  & problem_solverresidualevaluatepetsc,linesearch_solver%QUASI_NEWTON_SOLVER%NONLINEAR_SOLVER%SOLVER, &
15780  & err,error,*999)
15781  SELECT CASE(linesearch_solver%QUASI_NEWTON_SOLVER%convergenceTestType)
15782  CASE(solver_newton_convergence_petsc_default)
15783  !Default convergence test, do nothing
15784  CASE(solver_newton_convergence_energy_norm,solver_newton_convergence_differentiated_ratio)
15785  CALL petsc_snessetconvergencetest(linesearch_solver%snes,problem_solverconvergencetestpetsc, &
15786  & linesearch_solver%QUASI_NEWTON_SOLVER%NONLINEAR_SOLVER%SOLVER,err,error,*999)
15787  CASE DEFAULT
15788  local_error="The specified convergence test type of "//trim(numbertovstring(linesearch_solver% &
15789  & quasi_newton_solver%convergenceTestType,"*",err,error))//" is invalid."
15790  CALL flagerror(local_error,err,error,*999)
15791  END SELECT
15792  ELSE
15793  CALL flagerror("The residual vector PETSc is not associated.",err,error,*999)
15794  ENDIF
15795  ELSE
15796  CALL flagerror("Solver matrices residual vector is not associated.",err,error,*999)
15797  ENDIF
15798 
15799  !Set the Jacobian
15800  IF(solver_matrices%NUMBER_OF_MATRICES==1) THEN
15801  solver_jacobian=>solver_matrices%MATRICES(1)%PTR
15802  IF(ASSOCIATED(solver_jacobian)) THEN
15803  jacobian_matrix=>solver_jacobian%MATRIX
15804  IF(ASSOCIATED(jacobian_matrix)) THEN
15805  IF(ASSOCIATED(jacobian_matrix%PETSC)) THEN
15806  SELECT CASE(quasi_newton_solver%JACOBIAN_CALCULATION_TYPE)
15807  CASE(solver_newton_jacobian_not_calculated)
15808  CALL flagerror("Cannot have no Jacobian calculation for a PETSc nonlinear linesearch solver.", &
15809  & err,error,*999)
15810  CASE(solver_newton_jacobian_equations_calculated)
15811  solver_jacobian%UPDATE_MATRIX=.true. !CMISS will fill in the Jacobian values
15812  !Pass the linesearch solver object rather than the temporary solver
15813  CALL petsc_snessetjacobian(linesearch_solver%snes,jacobian_matrix%PETSC%MATRIX, &
15814  & jacobian_matrix%PETSC%MATRIX,problem_solverjacobianevaluatepetsc, &
15815  & linesearch_solver%QUASI_NEWTON_SOLVER%NONLINEAR_SOLVER%SOLVER,err,error,*999)
15816  CASE(solver_newton_jacobian_fd_calculated)
15817  solver_jacobian%UPDATE_MATRIX=.false. !Petsc will fill in the Jacobian values
15818  CALL distributed_matrix_form(jacobian_matrix,err,error,*999)
15819  SELECT CASE(solver_equations%SPARSITY_TYPE)
15820  CASE(solver_sparse_matrices)
15821  CALL petsc_matcoloringcreate(jacobian_matrix%PETSC%MATRIX,linesearch_solver%jacobianMatColoring, &
15822  & err,error,*999)
15823  CALL petsc_matcoloringsettype(linesearch_solver%jacobianMatColoring,petsc_matcoloring_sl, &
15824  & err,error,*999)
15825  CALL petsc_matcoloringsetfromoptions(linesearch_solver%jacobianMatColoring,err,error,*999)
15826  CALL petsc_matcoloringapply(linesearch_solver%jacobianMatColoring,linesearch_solver% &
15827  & jacobianiscoloring,err,error,*999)
15828  CALL petsc_matcoloringdestroy(linesearch_solver%jacobianMatColoring,err,error,*999)
15829  CALL petsc_matfdcoloringcreate(jacobian_matrix%PETSC%MATRIX,linesearch_solver% &
15830  & jacobianiscoloring,linesearch_solver%jacobianMatFDColoring,err,error,*999)
15831  CALL petsc_matfdcoloringsetfunction(linesearch_solver%jacobianMatFDColoring, &
15832  & problem_solverresidualevaluatepetsc,linesearch_solver%QUASI_NEWTON_SOLVER%NONLINEAR_SOLVER% &
15833  & solver,err,error,*999)
15834  CALL petsc_matfdcoloringsetfromoptions(linesearch_solver%jacobianMatFDColoring,err,error,*999)
15835  CALL petsc_matfdcoloringsetup(jacobian_matrix%PETSC%MATRIX,linesearch_solver% &
15836  & jacobianiscoloring,linesearch_solver%jacobianMatFDColoring,err,error,*999)
15837  CALL petsc_iscoloringdestroy(linesearch_solver%jacobianISColoring,err,error,*999)
15838  CASE(solver_full_matrices)
15839  !Do nothing
15840  CASE DEFAULT
15841  local_error="The specified solver equations sparsity type of "// &
15842  & trim(numbertovstring(solver_equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
15843  CALL flagerror(local_error,err,error,*999)
15844  END SELECT
15845  CALL petsc_snessetjacobian(linesearch_solver%snes,jacobian_matrix%PETSC%MATRIX, &
15846  & jacobian_matrix%PETSC%MATRIX,problem_solverjacobianfdcalculatepetsc,linesearch_solver% &
15847  & quasi_newton_solver%NONLINEAR_SOLVER%SOLVER,err,error,*999)
15848  CASE DEFAULT
15849  local_error="The Jacobian calculation type of "// &
15850  & trim(numbertovstring(quasi_newton_solver%JACOBIAN_CALCULATION_TYPE,"*",err,error))// &
15851  & " is invalid."
15852  CALL flagerror(local_error,err,error,*999)
15853  END SELECT
15854  ELSE
15855  CALL flagerror("Jacobian matrix PETSc is not associated.",err,error,*999)
15856  ENDIF
15857  ELSE
15858  CALL flagerror("Solver Jacobian matrix is not associated.",err,error,*999)
15859  ENDIF
15860  ELSE
15861  CALL flagerror("The solver Jacobian is not associated.",err,error,*999)
15862  ENDIF
15863  ELSE
15864  local_error="Invalid number of solver matrices. The number of solver matrices is "// &
15865  & trim(numbertovstring(solver_matrices%NUMBER_OF_MATRICES,"*",err,error))//" and it should be 1."
15866  CALL flagerror(local_error,err,error,*999)
15867  ENDIF
15868  IF(solver%OUTPUT_TYPE>=solver_progress_output) THEN
15869  !Set the monitor
15870  !Pass the linesearch solver object rather than the temporary solver
15871  CALL petsc_snesmonitorset(linesearch_solver%snes,problem_solvernonlinearmonitorpetsc, &
15872  & linesearch_solver%QUASI_NEWTON_SOLVER%NONLINEAR_SOLVER%SOLVER,err,error,*999)
15873  ENDIF
15874  CALL petsc_snesgetlinesearch(linesearch_solver%snes,linesearch_solver%snesLineSearch,err,error,*999)
15875  !Set the line search type and order where applicable
15876  SELECT CASE(linesearch_solver%linesearch_type)
15877  CASE(solver_quasi_newton_linesearch_basic)
15878  CALL petsc_sneslinesearchsettype(linesearch_solver%snesLineSearch,petsc_snes_linesearch_basic,err,error,*999)
15879  CASE(solver_quasi_newton_linesearch_l2)
15880  CALL petsc_sneslinesearchsettype(linesearch_solver%snesLineSearch,petsc_snes_linesearch_l2,err,error,*999)
15881  CASE(solver_quasi_newton_linesearch_cp)
15882  CALL petsc_sneslinesearchsettype(linesearch_solver%snesLineSearch,petsc_snes_linesearch_cp,err,error,*999)
15883  CASE DEFAULT
15884  local_error="The nonlinear Quasi-Newton line search type of "// &
15885  & trim(numbertovstring(linesearch_solver%linesearch_type,"*",err,error))//" is invalid."
15886  CALL flagerror(local_error,err,error,*999)
15887  END SELECT
15888  ! Set step tolerances, leave iterative line search options as defaults
15889  CALL petsc_sneslinesearchsettolerances(linesearch_solver%snesLineSearch, &
15890  & linesearch_solver%LINESEARCH_STEPTOLERANCE,linesearch_solver%LINESEARCH_MAXSTEP, &
15891  & petsc_default_real,petsc_default_real,petsc_default_real, &
15892  & petsc_default_integer,err,error,*999)
15893  IF(linesearch_solver%linesearchMonitorOutput) THEN
15894  CALL petsc_sneslinesearchsetmonitor(linesearch_solver%snesLineSearch,petsc_true,err,error,*999)
15895  ELSE
15896  CALL petsc_sneslinesearchsetmonitor(linesearch_solver%snesLineSearch,petsc_false,err,error,*999)
15897  ENDIF
15898  !Set the tolerances for the SNES solver
15899  CALL petsc_snessettolerances(linesearch_solver%snes,quasi_newton_solver%ABSOLUTE_TOLERANCE, &
15900  & quasi_newton_solver%RELATIVE_TOLERANCE,quasi_newton_solver%SOLUTION_TOLERANCE, &
15901  & quasi_newton_solver%MAXIMUM_NUMBER_OF_ITERATIONS, &
15902  & quasi_newton_solver%MAXIMUM_NUMBER_OF_FUNCTION_EVALUATIONS,err,error,*999)
15903  !Set any further SNES options from the command line options
15904  CALL petsc_snessetfromoptions(linesearch_solver%snes,err,error,*999)
15905  ELSE
15906  CALL flagerror("Quasi-Newton linesearch solver linear solver is not associated.",err,error,*999)
15907  ENDIF
15908  ELSE
15909  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
15910  ENDIF
15911  CASE DEFAULT
15912  local_error="The solver library type of "// &
15913  & trim(numbertovstring(linesearch_solver%SOLVER_LIBRARY,"*",err,error))//" is invalid."
15914  CALL flagerror(local_error,err,error,*999)
15915  END SELECT
15916  ELSE
15917  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
15918  ENDIF
15919  ELSE
15920  CALL flagerror("Nonlinear solver solver is not associated.",err,error,*999)
15921  ENDIF
15922  ELSE
15923  CALL flagerror("Quasi-Newton solver nonlinear solver is not associated.",err,error,*999)
15924  ENDIF
15925  ELSE
15926  CALL flagerror("Linesearch solver Quasi-Newton solver is not associated.",err,error,*999)
15927  ENDIF
15928  ELSE
15929  CALL flagerror("Line search solver is not associated.",err,error,*999)
15930  ENDIF
15931 
15932  exits("Solver_QuasiNewtonLinesearchCreateFinish")
15933  RETURN
15934 999 errorsexits("Solver_QuasiNewtonLinesearchCreateFinish",err,error)
15935  RETURN 1
15936 
15937  END SUBROUTINE solver_quasinewtonlinesearchcreatefinish
15938 
15939  !
15940  !================================================================================================================================
15941  !
15942 
15944  SUBROUTINE solver_quasinewtonlinesearchfinalise(linesearchSolver,err,error,*)
15945 
15946  !Argument variables
15947  TYPE(quasi_newton_linesearch_solver_type), POINTER :: linesearchSolver
15948  INTEGER(INTG), INTENT(OUT) :: err
15949  TYPE(varying_string), INTENT(OUT) :: error
15950  !Local Variables
15951 
15952  enters("Solver_QuasiNewtonLinesearchFinalise",err,error,*999)
15953 
15954  IF(ASSOCIATED(linesearchsolver)) THEN
15955  CALL petsc_iscoloringfinalise(linesearchsolver%jacobianISColoring,err,error,*999)
15956  CALL petsc_matcoloringfinalise(linesearchsolver%jacobianMatColoring,err,error,*999)
15957  CALL petsc_matfdcoloringfinalise(linesearchsolver%jacobianMatFDColoring,err,error,*999)
15958  CALL petsc_sneslinesearchfinalise(linesearchsolver%snesLineSearch,err,error,*999)
15959  CALL petsc_snesfinalise(linesearchsolver%snes,err,error,*999)
15960  DEALLOCATE(linesearchsolver)
15961  ENDIF
15962 
15963  exits("Solver_QuasiNewtonLinesearchFinalise")
15964  RETURN
15965 999 errorsexits("Solver_QuasiNewtonLinesearchFinalise",err,error)
15966  RETURN 1
15967 
15968  END SUBROUTINE solver_quasinewtonlinesearchfinalise
15969 
15970  !
15971  !================================================================================================================================
15972  !
15973 
15975  SUBROUTINE solver_quasi_newton_linesearch_initialise(QUASI_NEWTON_SOLVER,ERR,ERROR,*)
15976 
15977  !Argument variables
15978  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
15979  INTEGER(INTG), INTENT(OUT) :: ERR
15980  TYPE(varying_string), INTENT(OUT) :: ERROR
15981  !Local Variables
15982  INTEGER(INTG) :: DUMMY_ERR
15983  TYPE(varying_string) :: DUMMY_ERROR
15984 
15985  enters("SOLVER_QUASI_NEWTON_LINESEARCH_INITIALISE",err,error,*998)
15986 
15987  IF(ASSOCIATED(quasi_newton_solver)) THEN
15988  IF(ASSOCIATED(quasi_newton_solver%LINESEARCH_SOLVER)) THEN
15989  CALL flagerror("Quasi-Newton line search solver is already associated for this Quasi-Newton solver.",err,error,*998)
15990  ELSE
15991  !Allocate and initialise the Quasi-Newton linesearch solver
15992  ALLOCATE(quasi_newton_solver%LINESEARCH_SOLVER,stat=err)
15993  IF(err/=0) CALL flagerror("Could not allocate nonlinear solver Quasi-Newton line search solver.",err,error,*999)
15994  quasi_newton_solver%LINESEARCH_SOLVER%QUASI_NEWTON_SOLVER=>quasi_newton_solver
15995  quasi_newton_solver%LINESEARCH_SOLVER%SOLVER_LIBRARY=solver_petsc_library
15996  quasi_newton_solver%LINESEARCH_SOLVER%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
15997  quasi_newton_solver%LINESEARCH_SOLVER%LINESEARCH_TYPE=solver_quasi_newton_linesearch_cp
15998  quasi_newton_solver%LINESEARCH_SOLVER%LINESEARCH_MAXSTEP=1.0e8_dp
15999  quasi_newton_solver%LINESEARCH_SOLVER%LINESEARCH_STEPTOLERANCE=convergence_tolerance
16000  CALL petsc_matcoloringinitialise(quasi_newton_solver%LINESEARCH_SOLVER%jacobianMatColoring,err,error,*999)
16001  CALL petsc_iscoloringinitialise(quasi_newton_solver%LINESEARCH_SOLVER%jacobianISColoring,err,error,*999)
16002  CALL petsc_matfdcoloringinitialise(quasi_newton_solver%LINESEARCH_SOLVER%jacobianMatFDColoring,err,error,*999)
16003  CALL petsc_snesinitialise(quasi_newton_solver%LINESEARCH_SOLVER%snes,err,error,*999)
16004  CALL petsc_sneslinesearchinitialise(quasi_newton_solver%LINESEARCH_SOLVER%snesLineSearch,err,error,*999)
16005  quasi_newton_solver%LINESEARCH_SOLVER%linesearchMonitorOutput=.false.
16006  ENDIF
16007  ELSE
16008  CALL flagerror("Quasi-Newton solver is not associated.",err,error,*998)
16009  ENDIF
16010 
16011  exits("SOLVER_QUASI_NEWTON_LINESEARCH_INITIALISE")
16012  RETURN
16013 999 CALL solver_quasinewtonlinesearchfinalise(quasi_newton_solver%LINESEARCH_SOLVER,dummy_err,dummy_error,*998)
16014 998 errorsexits("SOLVER_QUASI_NEWTON_LINESEARCH_INITIALISE",err,error)
16015  RETURN 1
16016 
16017  END SUBROUTINE solver_quasi_newton_linesearch_initialise
16018 
16019  !
16020  !================================================================================================================================
16021  !
16022 
16024  SUBROUTINE solver_quasi_newton_linesearch_maxstep_set(SOLVER,LINESEARCH_MAXSTEP,ERR,ERROR,*)
16025 
16026  !Argument variables
16027  TYPE(solver_type), POINTER :: SOLVER
16028  REAL(DP), INTENT(IN) :: LINESEARCH_MAXSTEP
16029  INTEGER(INTG), INTENT(OUT) :: ERR
16030  TYPE(varying_string), INTENT(OUT) :: ERROR
16031  !Local Variables
16032  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
16033  TYPE(quasi_newton_linesearch_solver_type), POINTER :: LINESEARCH_SOLVER
16034  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
16035  TYPE(varying_string) :: LOCAL_ERROR
16036 
16037  enters("SOLVER_QUASI_NEWTON_LINESEARCH_MAXSTEP_SET",err,error,*999)
16038 
16039  IF(ASSOCIATED(solver)) THEN
16040  IF(solver%SOLVER_FINISHED) THEN
16041  CALL flagerror("Solver has already been finished.",err,error,*999)
16042  ELSE
16043  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
16044  nonlinear_solver=>solver%NONLINEAR_SOLVER
16045  IF(ASSOCIATED(nonlinear_solver)) THEN
16046  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
16047  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
16048  IF(ASSOCIATED(quasi_newton_solver)) THEN
16049  IF(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE==solver_quasi_newton_linesearch) THEN
16050  linesearch_solver=>quasi_newton_solver%LINESEARCH_SOLVER
16051  IF(ASSOCIATED(linesearch_solver)) THEN
16052  IF(linesearch_maxstep>zero_tolerance) THEN
16053  linesearch_solver%LINESEARCH_MAXSTEP=linesearch_maxstep
16054  ELSE
16055  local_error="The specified line search maximum step of "// &
16056  & trim(numbertovstring(linesearch_maxstep,"*",err,error))// &
16057  & " is invalid. The line search maximum step must be > 0."
16058  CALL flagerror(local_error,err,error,*999)
16059  ENDIF
16060  ELSE
16061  CALL flagerror("The Quasi-Newton solver line search solver is not associated.",err,error,*999)
16062  ENDIF
16063  ELSE
16064  CALL flagerror("The Quasi-Newton solver is not a line search solver.",err,error,*999)
16065  ENDIF
16066  ELSE
16067  CALL flagerror("The nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
16068  ENDIF
16069  ELSE
16070  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
16071  ENDIF
16072  ELSE
16073  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
16074  ENDIF
16075  ELSE
16076  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
16077  ENDIF
16078  ENDIF
16079  ELSE
16080  CALL flagerror("Solver is not associated.",err,error,*999)
16081  ENDIF
16082 
16083  exits("SOLVER_QUASI_NEWTON_LINESEARCH_MAXSTEP_SET")
16084  RETURN
16085 999 errorsexits("SOLVER_QUASI_NEWTON_LINESEARCH_MAXSTEP_SET",err,error)
16086  RETURN 1
16087 
16088  END SUBROUTINE solver_quasi_newton_linesearch_maxstep_set
16089 
16090  !
16091  !================================================================================================================================
16092  !
16093 
16094  !Solves a nonlinear Quasi-Newton line search solver
16095  SUBROUTINE solver_quasi_newton_linesearch_solve(LINESEARCH_SOLVER,ERR,ERROR,*)
16096 
16097  !Argument variables
16098  TYPE(quasi_newton_linesearch_solver_type), POINTER :: LINESEARCH_SOLVER
16099  INTEGER(INTG), INTENT(OUT) :: ERR
16100  TYPE(varying_string), INTENT(OUT) :: ERROR
16101  !Local Variables
16102  !EXTERNAL :: Problem_SolverResidualEvaluatePetsc
16103  INTEGER(INTG) :: CONVERGED_REASON,NUMBER_ITERATIONS
16104  REAL(DP) :: FUNCTION_NORM
16105  TYPE(distributed_vector_type), POINTER :: RHS_VECTOR,SOLVER_VECTOR
16106  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
16107  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
16108  TYPE(petscvectype) :: FUNCTION_VECTOR
16109  TYPE(solver_type), POINTER :: SOLVER
16110  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
16111  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
16112  TYPE(varying_string) :: LOCAL_ERROR
16113 
16114  enters("SOLVER_QUASI_NEWTON_LINESEARCH_SOLVE",err,error,*999)
16115 
16116  IF(ASSOCIATED(linesearch_solver)) THEN
16117  quasi_newton_solver=>linesearch_solver%QUASI_NEWTON_SOLVER
16118  IF(ASSOCIATED(quasi_newton_solver)) THEN
16119  nonlinear_solver=>quasi_newton_solver%NONLINEAR_SOLVER
16120  IF(ASSOCIATED(nonlinear_solver)) THEN
16121  solver=>nonlinear_solver%SOLVER
16122  IF(ASSOCIATED(solver)) THEN
16123  solver_equations=>solver%SOLVER_EQUATIONS
16124  IF(ASSOCIATED(solver_equations)) THEN
16125  solver_matrices=>solver_equations%SOLVER_MATRICES
16126  IF(ASSOCIATED(solver_matrices)) THEN
16127  IF(solver_matrices%NUMBER_OF_MATRICES==1) THEN
16128  rhs_vector=>solver_matrices%RHS_VECTOR
16129  IF(ASSOCIATED(rhs_vector)) THEN
16130  solver_vector=>solver_matrices%MATRICES(1)%PTR%SOLVER_VECTOR
16131  IF(ASSOCIATED(solver_vector)) THEN
16132  SELECT CASE(linesearch_solver%SOLVER_LIBRARY)
16133  CASE(solver_cmiss_library)
16134  CALL flagerror("Not implemented.",err,error,*999)
16135  CASE(solver_petsc_library)
16136  SELECT CASE(quasi_newton_solver%SOLUTION_INITIALISE_TYPE)
16137  CASE(solver_solution_initialise_zero)
16138  !Zero the solution vector
16139  CALL distributed_vector_all_values_set(solver_vector,0.0_dp,err,error,*999)
16140  CASE(solver_solution_initialise_current_field)
16141  !Make sure the solver vector contains the current dependent field values
16142  CALL solver_solution_update(solver,err,error,*999)
16143  CASE(solver_solution_initialise_no_change)
16144  !Do nothing
16145  CASE DEFAULT
16146  local_error="The Quasi-Newton solver solution initialise type of "// &
16147  & trim(numbertovstring(quasi_newton_solver%SOLUTION_INITIALISE_TYPE,"*",err,error))// &
16148  & " is invalid."
16149  CALL flagerror(local_error,err,error,*999)
16150  END SELECT
16151  !Solve the nonlinear equations
16152  CALL petsc_snessolve(linesearch_solver%snes,rhs_vector%PETSC%VECTOR,solver_vector%PETSC%VECTOR, &
16153  & err,error,*999)
16154  !Check for convergence
16155  CALL petsc_snesgetconvergedreason(linesearch_solver%snes,converged_reason,err,error,*999)
16156  SELECT CASE(converged_reason)
16157  CASE(petsc_snes_diverged_function_count)
16158  CALL flag_warning("Nonlinear line search solver did not converge. PETSc diverged function count.", &
16159  & err,error,*999)
16160  CASE(petsc_snes_diverged_linear_solve)
16161  CALL flag_warning("Nonlinear line search solver did not converge. PETSc diverged linear solve.", &
16162  & err,error,*999)
16163  CASE(petsc_snes_diverged_fnorm_nan)
16164  CALL flag_warning("Nonlinear line search solver did not converge. PETSc diverged F Norm NaN.", &
16165  & err,error,*999)
16166  CASE(petsc_snes_diverged_max_it)
16167  CALL flag_warning("Nonlinear line search solver did not converge. PETSc diverged maximum iterations.", &
16168  & err,error,*999)
16169  CASE(petsc_snes_diverged_line_search)
16170  CALL flag_warning("Nonlinear line search solver did not converge. PETSc diverged line search.", &
16171  & err,error,*999)
16172  CASE(petsc_snes_diverged_local_min)
16173  CALL flag_warning("Nonlinear line search solver did not converge. PETSc diverged local minimum.", &
16174  & err,error,*999)
16175  END SELECT
16176  IF(solver%OUTPUT_TYPE>=solver_solver_output) THEN
16177  !Output solution characteristics
16178  CALL write_string(general_output_type,"",err,error,*999)
16179  CALL write_string(general_output_type,"Quasi-Newton linesearch solver parameters:",err,error,*999)
16180  CALL petsc_snesgetiterationnumber(linesearch_solver%snes,number_iterations,err,error,*999)
16181  CALL write_string_value(general_output_type,"Final number of iterations = ",number_iterations, &
16182  & err,error,*999)
16183  CALL petsc_snesgetfunction(linesearch_solver%snes,function_vector,err,error,*999)
16184  CALL petsc_vecnorm(function_vector,petsc_norm_2,function_norm,err,error,*999)
16185  CALL write_string_value(general_output_type,"Final function norm = ",function_norm, &
16186  & err,error,*999)
16187  SELECT CASE(converged_reason)
16188  CASE(petsc_snes_converged_fnorm_abs)
16189  CALL write_string(general_output_type,"Converged Reason = PETSc converged F Norm absolute.", &
16190  & err,error,*999)
16191  CASE(petsc_snes_converged_fnorm_relative)
16192  CALL write_string(general_output_type,"Converged Reason = PETSc converged F Norm relative.", &
16193  & err,error,*999)
16194  CASE(petsc_snes_converged_its)
16195  CALL write_string(general_output_type,"Converged Reason = PETSc converged its.",err,error,*999)
16196  CASE(petsc_snes_converged_iterating)
16197  CALL write_string(general_output_type,"Converged Reason = PETSc converged iterating.",err,error,*999)
16198  END SELECT
16199  ENDIF
16200  CASE DEFAULT
16201  local_error="The Quasi-Newton line search solver library type of "// &
16202  & trim(numbertovstring(linesearch_solver%SOLVER_LIBRARY,"*",err,error))//" is invalid."
16203  CALL flagerror(local_error,err,error,*999)
16204  END SELECT
16205  ELSE
16206  CALL flagerror("Solver vector is not associated.",err,error,*999)
16207  ENDIF
16208  ELSE
16209  CALL flagerror("Solver RHS vector is not associated.",err,error,*999)
16210  ENDIF
16211  ELSE
16212  local_error="The number of solver matrices of "// &
16213  & trim(numbertovstring(solver_matrices%NUMBER_OF_MATRICES,"*",err,error))// &
16214  & " is invalid. There should only be one solver matrix for a Quasi-Newton linesearch solver."
16215  CALL flagerror(local_error,err,error,*999)
16216  ENDIF
16217  ELSE
16218  CALL flagerror("Solver matrices is not associated.",err,error,*999)
16219  ENDIF
16220  ELSE
16221  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
16222  ENDIF
16223  ELSE
16224  CALL flagerror("Nonlinear solver solver is not associated.",err,error,*999)
16225  ENDIF
16226  ELSE
16227  CALL flagerror("Quasi-Newton solver nonlinear solver is not associated.",err,error,*999)
16228  ENDIF
16229  ELSE
16230  CALL flagerror("Linesearch solver Quasi-Newton solver is not associated.",err,error,*999)
16231  ENDIF
16232  ELSE
16233  CALL flagerror("Linesearch solver is not associated.",err,error,*999)
16234  ENDIF
16235 
16236  exits("SOLVER_QUASI_NEWTON_LINESEARCH_SOLVE")
16237  RETURN
16238 999 errorsexits("SOLVER_QUASI_NEWTON_LINESEARCH_SOLVE",err,error)
16239  RETURN 1
16240 
16241  END SUBROUTINE solver_quasi_newton_linesearch_solve
16242 
16243  !
16244  !================================================================================================================================
16245  !
16246 
16248  SUBROUTINE solver_quasi_newton_linesearch_steptol_set(SOLVER,LINESEARCH_STEPTOL,ERR,ERROR,*)
16249 
16250  !Argument variables
16251  TYPE(solver_type), POINTER :: SOLVER
16252  REAL(DP), INTENT(IN) :: LINESEARCH_STEPTOL
16253  INTEGER(INTG), INTENT(OUT) :: ERR
16254  TYPE(varying_string), INTENT(OUT) :: ERROR
16255  !Local Variables
16256  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
16257  TYPE(quasi_newton_linesearch_solver_type), POINTER :: LINESEARCH_SOLVER
16258  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
16259  TYPE(varying_string) :: LOCAL_ERROR
16260 
16261  enters("SOLVER_QUASI_NEWTON_LINESEARCH_STEPTOL_SET",err,error,*999)
16262 
16263  IF(ASSOCIATED(solver)) THEN
16264  IF(solver%SOLVER_FINISHED) THEN
16265  CALL flagerror("Solver has already been finished.",err,error,*999)
16266  ELSE
16267  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
16268  nonlinear_solver=>solver%NONLINEAR_SOLVER
16269  IF(ASSOCIATED(nonlinear_solver)) THEN
16270  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
16271  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
16272  IF(ASSOCIATED(quasi_newton_solver)) THEN
16273  IF(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE==solver_quasi_newton_linesearch) THEN
16274  linesearch_solver=>quasi_newton_solver%LINESEARCH_SOLVER
16275  IF(ASSOCIATED(linesearch_solver)) THEN
16276  IF(linesearch_steptol>zero_tolerance) THEN
16277  linesearch_solver%LINESEARCH_STEPTOLERANCE=linesearch_steptol
16278  ELSE
16279  local_error="The specified line search step tolerance of "// &
16280  & trim(numbertovstring(linesearch_steptol,"*",err,error))// &
16281  & " is invalid. The line search step tolerance must be > 0."
16282  CALL flagerror(local_error,err,error,*999)
16283  ENDIF
16284  ELSE
16285  CALL flagerror("The Quasi-Newton solver line search solver is not associated.",err,error,*999)
16286  ENDIF
16287  ELSE
16288  CALL flagerror("The Quasi-Newton solver is not a line search solver.",err,error,*999)
16289  ENDIF
16290  ELSE
16291  CALL flagerror("The nonlinear Quasi-Newton solver is not associated.",err,error,*999)
16292  ENDIF
16293  ELSE
16294  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
16295  ENDIF
16296  ELSE
16297  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
16298  ENDIF
16299  ELSE
16300  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
16301  ENDIF
16302  ENDIF
16303  ELSE
16304  CALL flagerror("Solver is not associated.",err,error,*999)
16305  ENDIF
16306 
16307  exits("SOLVER_QUASI_NEWTON_LINESEARCH_STEPTOL_SET")
16308  RETURN
16309 999 errorsexits("SOLVER_QUASI_NEWTON_LINESEARCH_STEPTOL_SET",err,error)
16310  RETURN 1
16311 
16312  END SUBROUTINE solver_quasi_newton_linesearch_steptol_set
16313 
16314  !
16315  !================================================================================================================================
16316  !
16317 
16319  SUBROUTINE solver_quasi_newton_linesearch_type_set(SOLVER,LINESEARCH_TYPE,ERR,ERROR,*)
16320 
16321  !Argument variables
16322  TYPE(solver_type), POINTER :: SOLVER
16323  INTEGER(INTG), INTENT(IN) :: LINESEARCH_TYPE
16324  INTEGER(INTG), INTENT(OUT) :: ERR
16325  TYPE(varying_string), INTENT(OUT) :: ERROR
16326  !Local Variables
16327  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
16328  TYPE(quasi_newton_linesearch_solver_type), POINTER :: LINESEARCH_SOLVER
16329  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
16330  TYPE(varying_string) :: LOCAL_ERROR
16331 
16332  enters("SOLVER_QUASI_NEWTON_LINESEARCH_TYPE_SET",err,error,*999)
16333 
16334  IF(ASSOCIATED(solver)) THEN
16335  IF(solver%SOLVER_FINISHED) THEN
16336  CALL flagerror("Solver has already been finished.",err,error,*999)
16337  ELSE
16338  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
16339  nonlinear_solver=>solver%NONLINEAR_SOLVER
16340  IF(ASSOCIATED(nonlinear_solver)) THEN
16341  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
16342  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
16343  IF(ASSOCIATED(quasi_newton_solver)) THEN
16344  IF(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE==solver_quasi_newton_linesearch) THEN
16345  linesearch_solver=>quasi_newton_solver%LINESEARCH_SOLVER
16346  IF(ASSOCIATED(linesearch_solver)) THEN
16347  SELECT CASE(linesearch_type)
16348  CASE(solver_quasi_newton_linesearch_basic)
16349  linesearch_solver%LINESEARCH_TYPE=solver_quasi_newton_linesearch_basic
16350  CASE(solver_quasi_newton_linesearch_l2)
16351  linesearch_solver%LINESEARCH_TYPE=solver_quasi_newton_linesearch_l2
16352  CASE(solver_quasi_newton_linesearch_cp)
16353  linesearch_solver%LINESEARCH_TYPE=solver_quasi_newton_linesearch_cp
16354  CASE DEFAULT
16355  local_error="The specified line search type of "//trim(numbertovstring(linesearch_type,"*",err,error))// &
16356  & " is invalid."
16357  CALL flagerror(local_error,err,error,*999)
16358  END SELECT
16359  ELSE
16360  CALL flagerror("The Quasi-Newton solver line search solver is not associated.",err,error,*999)
16361  ENDIF
16362  ELSE
16363  CALL flagerror("The Quasi-Newton solver is not a line search solver.",err,error,*999)
16364  ENDIF
16365  ELSE
16366  CALL flagerror("The nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
16367  ENDIF
16368  ELSE
16369  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
16370  ENDIF
16371  ELSE
16372  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
16373  ENDIF
16374  ELSE
16375  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
16376  ENDIF
16377  ENDIF
16378  ELSE
16379  CALL flagerror("Solver is not associated.",err,error,*999)
16380  ENDIF
16381 
16382  exits("SOLVER_QUASI_NEWTON_LINESEARCH_TYPE_SET")
16383  RETURN
16384 999 errorsexits("SOLVER_QUASI_NEWTON_LINESEARCH_TYPE_SET",err,error)
16385  RETURN 1
16386 
16387  END SUBROUTINE solver_quasi_newton_linesearch_type_set
16388 
16389  !
16390  !================================================================================================================================
16391  !
16392 
16394  SUBROUTINE solver_quasinewtonmatriceslibrarytypeget(QUASI_NEWTON_SOLVER,MATRICES_LIBRARY_TYPE,ERR,ERROR,*)
16395 
16396  !Argument variables
16397  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
16398  INTEGER(INTG), INTENT(OUT) :: MATRICES_LIBRARY_TYPE
16399  INTEGER(INTG), INTENT(OUT) :: ERR
16400  TYPE(varying_string), INTENT(OUT) :: ERROR
16401  !Local Variables
16402  TYPE(quasi_newton_linesearch_solver_type), POINTER :: LINESEARCH_SOLVER
16403  TYPE(quasi_newton_trustregion_solver_type), POINTER :: TRUSTREGION_SOLVER
16404  TYPE(varying_string) :: LOCAL_ERROR
16405 
16406  enters("SOLVER_QUASI_NEWTON_LIBRARY_TYPE_GET",err,error,*999)
16407 
16408  IF(ASSOCIATED(quasi_newton_solver)) THEN
16409  SELECT CASE(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE)
16410  CASE(solver_quasi_newton_linesearch)
16411  linesearch_solver=>quasi_newton_solver%LINESEARCH_SOLVER
16412  IF(ASSOCIATED(linesearch_solver)) THEN
16413  matrices_library_type=linesearch_solver%SOLVER_MATRICES_LIBRARY
16414  ELSE
16415  CALL flagerror("Quasi-Newton line search solver is not associated.",err,error,*999)
16416  ENDIF
16417  CASE(solver_quasi_newton_trustregion)
16418  trustregion_solver=>quasi_newton_solver%TRUSTREGION_SOLVER
16419  IF(ASSOCIATED(trustregion_solver)) THEN
16420  matrices_library_type=trustregion_solver%SOLVER_MATRICES_LIBRARY
16421  ELSE
16422  CALL flagerror("Quasi-Newton trust region solver is not associated.",err,error,*999)
16423  ENDIF
16424  CASE DEFAULT
16425  local_error="The Quasi-Newton solver type of "// &
16426  & trim(numbertovstring(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE,"*",err,error))//" is invalid."
16427  CALL flagerror(local_error,err,error,*999)
16428  END SELECT
16429  ELSE
16430  CALL flagerror("Quasi-Newton solver is not associated.",err,error,*999)
16431  ENDIF
16432 
16433  exits("Solver_QuasiNewtonMatricesLibraryTypeGet")
16434  RETURN
16435 999 errorsexits("Solver_QuasiNewtonMatricesLibraryTypeGet",err,error)
16436  RETURN 1
16437 
16438  END SUBROUTINE solver_quasinewtonmatriceslibrarytypeget
16439 
16440  !
16441  !================================================================================================================================
16442  !
16443 
16445  SUBROUTINE solver_quasinewtonmaximumfunctionevaluationsset(SOLVER,MAXIMUM_FUNCTION_EVALUATIONS,ERR,ERROR,*)
16446 
16447  !Argument variables
16448  TYPE(solver_type), POINTER :: SOLVER
16449  INTEGER(INTG), INTENT(IN) :: MAXIMUM_FUNCTION_EVALUATIONS
16450  INTEGER(INTG), INTENT(OUT) :: ERR
16451  TYPE(varying_string), INTENT(OUT) :: ERROR
16452  !Local Variables
16453  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
16454  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
16455  TYPE(varying_string) :: LOCAL_ERROR
16456 
16457  enters("Solver_QuasiNewtonMaximumFunctionEvaluationsSet",err,error,*999)
16458 
16459  IF(ASSOCIATED(solver)) THEN
16460  IF(solver%SOLVER_FINISHED) THEN
16461  CALL flagerror("Solver has already been finished.",err,error,*999)
16462  ELSE
16463  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
16464  nonlinear_solver=>solver%NONLINEAR_SOLVER
16465  IF(ASSOCIATED(nonlinear_solver)) THEN
16466  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
16467  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
16468  IF(ASSOCIATED(quasi_newton_solver)) THEN
16469  IF(maximum_function_evaluations>0) THEN
16470  quasi_newton_solver%MAXIMUM_NUMBER_OF_FUNCTION_EVALUATIONS=maximum_function_evaluations
16471  ELSE
16472  local_error="The specified maximum number of function evaluations of "// &
16473  & trim(numbertovstring(maximum_function_evaluations,"*",err,error))// &
16474  & " is invalid. The maximum number of function evaluations must be > 0."
16475  CALL flagerror(local_error,err,error,*999)
16476  ENDIF
16477  ELSE
16478  CALL flagerror("The nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
16479  ENDIF
16480  ELSE
16481  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
16482  ENDIF
16483  ELSE
16484  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
16485  ENDIF
16486  ELSE
16487  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
16488  ENDIF
16489  ENDIF
16490  ELSE
16491  CALL flagerror("Solver is not associated.",err,error,*999)
16492  ENDIF
16493 
16494  exits("Solver_QuasiNewtonMaximumFunctionEvaluationsSet")
16495  RETURN
16496 999 errors("Solver_QuasiNewtonMaximumFunctionEvaluationsSet",err,error)
16497  exits("Solver_QuasiNewtonMaximumFunctionEvaluationsSet")
16498  RETURN 1
16499 
16500  END SUBROUTINE solver_quasinewtonmaximumfunctionevaluationsset
16501 
16502  !
16503  !================================================================================================================================
16504  !
16505 
16507  SUBROUTINE solver_quasi_newton_maximum_iterations_set(SOLVER,MAXIMUM_ITERATIONS,ERR,ERROR,*)
16508 
16509  !Argument variables
16510  TYPE(solver_type), POINTER :: SOLVER
16511  INTEGER(INTG), INTENT(IN) :: MAXIMUM_ITERATIONS
16512  INTEGER(INTG), INTENT(OUT) :: ERR
16513  TYPE(varying_string), INTENT(OUT) :: ERROR
16514  !Local Variables
16515  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
16516  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
16517  TYPE(varying_string) :: LOCAL_ERROR
16518 
16519  enters("SOLVER_QUASI_NEWTON_MAXIMUM_ITERATIONS_SET",err,error,*999)
16520 
16521  IF(ASSOCIATED(solver)) THEN
16522  IF(solver%SOLVER_FINISHED) THEN
16523  CALL flagerror("Solver has already been finished.",err,error,*999)
16524  ELSE
16525  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
16526  nonlinear_solver=>solver%NONLINEAR_SOLVER
16527  IF(ASSOCIATED(nonlinear_solver)) THEN
16528  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
16529  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
16530  IF(ASSOCIATED(quasi_newton_solver)) THEN
16531  IF(maximum_iterations>0) THEN
16532  quasi_newton_solver%MAXIMUM_NUMBER_OF_ITERATIONS=maximum_iterations
16533  ELSE
16534  local_error="The specified maximum iterations of "//trim(numbertovstring(maximum_iterations,"*",err,error))// &
16535  & " is invalid. The maximum number of iterations must be > 0."
16536  CALL flagerror(local_error,err,error,*999)
16537  ENDIF
16538  ELSE
16539  CALL flagerror("Nonlinear sovler Quasi-Newton solver is not associated.",err,error,*999)
16540  ENDIF
16541  ELSE
16542  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
16543  ENDIF
16544  ELSE
16545  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
16546  ENDIF
16547  ELSE
16548  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
16549  ENDIF
16550  ENDIF
16551  ELSE
16552  CALL flagerror("Solver is not associated.",err,error,*999)
16553  ENDIF
16554 
16555  exits("SOLVER_QUASI_NEWTON_MAXIMUM_ITERATIONS_SET")
16556  RETURN
16557 999 errorsexits("SOLVER_QUASI_NEWTON_MAXIMUM_ITERATIONS_SET",err,error)
16558  RETURN 1
16559 
16560  END SUBROUTINE solver_quasi_newton_maximum_iterations_set
16561 
16562  !
16563  !================================================================================================================================
16564  !
16565 
16567  SUBROUTINE solver_quasi_newton_relative_tolerance_set(SOLVER,RELATIVE_TOLERANCE,ERR,ERROR,*)
16568 
16569  !Argument variables
16570  TYPE(solver_type), POINTER :: SOLVER
16571  REAL(DP), INTENT(IN) :: RELATIVE_TOLERANCE
16572  INTEGER(INTG), INTENT(OUT) :: ERR
16573  TYPE(varying_string), INTENT(OUT) :: ERROR
16574  !Local Variables
16575  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
16576  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
16577  TYPE(varying_string) :: LOCAL_ERROR
16578 
16579  enters("SOLVER_QUASI_NEWTON_RELATIVE_TOLERANCE_SET",err,error,*999)
16580 
16581  IF(ASSOCIATED(solver)) THEN
16582  IF(solver%SOLVER_FINISHED) THEN
16583  CALL flagerror("Solver has already been finished.",err,error,*999)
16584  ELSE
16585  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
16586  nonlinear_solver=>solver%NONLINEAR_SOLVER
16587  IF(ASSOCIATED(nonlinear_solver)) THEN
16588  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
16589  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
16590  IF(ASSOCIATED(quasi_newton_solver)) THEN
16591  IF(relative_tolerance>zero_tolerance) THEN
16592  quasi_newton_solver%RELATIVE_TOLERANCE=relative_tolerance
16593  ELSE
16594  local_error="The specified relative tolerance of "//trim(numbertovstring(relative_tolerance,"*",err,error))// &
16595  & " is invalid. The relative tolerance must be > 0."
16596  CALL flagerror(local_error,err,error,*999)
16597  ENDIF
16598  ELSE
16599  CALL flagerror("The nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
16600  ENDIF
16601  ELSE
16602  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
16603  ENDIF
16604  ELSE
16605  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
16606  ENDIF
16607  ELSE
16608  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
16609  ENDIF
16610  ENDIF
16611  ELSE
16612  CALL flagerror("Solver is not associated.",err,error,*999)
16613  ENDIF
16614 
16615  exits("SOLVER_QUASI_NEWTON_RELATIVE_TOLERANCE_SET")
16616  RETURN
16617 999 errorsexits("SOLVER_QUASI_NEWTON_RELATIVE_TOLERANCE_SET",err,error)
16618  RETURN 1
16619 
16620  END SUBROUTINE solver_quasi_newton_relative_tolerance_set
16621 
16622  !
16623  !================================================================================================================================
16624  !
16625 
16627  SUBROUTINE solver_quasi_newton_solution_init_type_set(SOLVER,SOLUTION_INITIALISE_TYPE,ERR,ERROR,*)
16628 
16629  !Argument variables
16630  TYPE(solver_type), POINTER :: SOLVER
16631  INTEGER(INTG), INTENT(IN) :: SOLUTION_INITIALISE_TYPE
16632  INTEGER(INTG), INTENT(OUT) :: ERR
16633  TYPE(varying_string), INTENT(OUT) :: ERROR
16634  !Local Variables
16635  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
16636  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
16637  TYPE(varying_string) :: LOCAL_ERROR
16638 
16639  enters("SOLVER_NONLINAR_QUASI_NEWTON_SOLUTION_INIT_TYPE_SET",err,error,*999)
16640 
16641  IF(ASSOCIATED(solver)) THEN
16642  IF(solver%SOLVER_FINISHED) THEN
16643  CALL flagerror("Solver has already been finished.",err,error,*999)
16644  ELSE
16645  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
16646  nonlinear_solver=>solver%NONLINEAR_SOLVER
16647  IF(ASSOCIATED(nonlinear_solver)) THEN
16648  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
16649  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
16650  IF(ASSOCIATED(quasi_newton_solver)) THEN
16651  SELECT CASE(solution_initialise_type)
16652  CASE(solver_solution_initialise_zero)
16653  quasi_newton_solver%SOLUTION_INITIALISE_TYPE=solver_solution_initialise_zero
16654  CASE(solver_solution_initialise_current_field)
16655  quasi_newton_solver%SOLUTION_INITIALISE_TYPE=solver_solution_initialise_current_field
16656  CASE(solver_solution_initialise_no_change)
16657  quasi_newton_solver%SOLUTION_INITIALISE_TYPE=solver_solution_initialise_no_change
16658  CASE DEFAULT
16659  local_error="The specified solution initialise type of "// &
16660  & trim(numbertovstring(solution_initialise_type,"*",err,error))//" is invalid."
16661  CALL flagerror(local_error,err,error,*999)
16662  END SELECT
16663  ELSE
16664  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
16665  ENDIF
16666  ELSE
16667  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
16668  ENDIF
16669  ELSE
16670  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
16671  ENDIF
16672  ELSE
16673  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
16674  ENDIF
16675  ENDIF
16676  ELSE
16677  CALL flagerror("Solver is not associated.",err,error,*999)
16678  ENDIF
16679 
16680  exits("SOLVER_QUASI_NEWTON_SOLUTION_INIT_TYPE_SET")
16681  RETURN
16682 999 errorsexits("SOLVER_QUASI_NEWTON_SOLUTION_INIT_TYPE_SET",err,error)
16683  RETURN 1
16684 
16685  END SUBROUTINE solver_quasi_newton_solution_init_type_set
16686 
16687  !
16688  !================================================================================================================================
16689  !
16690 
16692  SUBROUTINE solver_quasi_newton_solution_tolerance_set(SOLVER,SOLUTION_TOLERANCE,ERR,ERROR,*)
16693 
16694  !Argument variables
16695  TYPE(solver_type), POINTER :: SOLVER
16696  REAL(DP), INTENT(IN) :: SOLUTION_TOLERANCE
16697  INTEGER(INTG), INTENT(OUT) :: ERR
16698  TYPE(varying_string), INTENT(OUT) :: ERROR
16699  !Local Variables
16700  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
16701  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
16702  TYPE(varying_string) :: LOCAL_ERROR
16703 
16704  enters("SOLVER_QUASI_NEWTON_SOLUTION_TOLERANCE_SET",err,error,*999)
16705 
16706  IF(ASSOCIATED(solver)) THEN
16707  IF(solver%SOLVER_FINISHED) THEN
16708  CALL flagerror("Solver has already been finished.",err,error,*999)
16709  ELSE
16710  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
16711  nonlinear_solver=>solver%NONLINEAR_SOLVER
16712  IF(ASSOCIATED(nonlinear_solver)) THEN
16713  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
16714  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
16715  IF(ASSOCIATED(quasi_newton_solver)) THEN
16716  IF(solution_tolerance>zero_tolerance) THEN
16717  quasi_newton_solver%SOLUTION_TOLERANCE=solution_tolerance
16718  ELSE
16719  local_error="The specified solution tolerance of "//trim(numbertovstring(solution_tolerance,"*",err,error))// &
16720  & " is invalid. The relative tolerance must be > 0."
16721  CALL flagerror(local_error,err,error,*999)
16722  ENDIF
16723  ELSE
16724  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
16725  ENDIF
16726  ELSE
16727  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
16728  ENDIF
16729  ELSE
16730  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
16731  ENDIF
16732  ELSE
16733  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
16734  ENDIF
16735  ENDIF
16736  ELSE
16737  CALL flagerror("Solver is not associated.",err,error,*999)
16738  ENDIF
16739 
16740  exits("SOLVER_QUASI_NEWTON_SOLUTION_TOLERANCE_SET")
16741  RETURN
16742 999 errorsexits("SOLVER_QUASI_NEWTON_SOLUTION_TOLERANCE_SET",err,error)
16743  RETURN 1
16744 
16745  END SUBROUTINE solver_quasi_newton_solution_tolerance_set
16746 
16747  !
16748  !================================================================================================================================
16749  !
16750 
16751  !Solves a nonlinear Quasi-Newton solver
16752  SUBROUTINE solver_quasi_newton_solve(QUASI_NEWTON_SOLVER,ERR,ERROR,*)
16753 
16754  !Argument variables
16755  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
16756  INTEGER(INTG), INTENT(OUT) :: ERR
16757  TYPE(varying_string), INTENT(OUT) :: ERROR
16758  !Local Variables
16759  TYPE(varying_string) :: LOCAL_ERROR
16760 
16761  enters("SOLVER_QUASI_NEWTON_SOLVE",err,error,*999)
16762 
16763  IF(ASSOCIATED(quasi_newton_solver)) THEN
16764  SELECT CASE(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE)
16765  CASE(solver_quasi_newton_linesearch)
16766  CALL solver_quasi_newton_linesearch_solve(quasi_newton_solver%LINESEARCH_SOLVER,err,error,*999)
16767  CASE(solver_quasi_newton_trustregion)
16768  CALL solver_quasi_newton_trustregion_solve(quasi_newton_solver%TRUSTREGION_SOLVER,err,error,*999)
16769  CASE DEFAULT
16770  local_error="The nonlinear solver type of "// &
16771  & trim(numbertovstring(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE,"*",err,error))//" is invalid."
16772  CALL flagerror(local_error,err,error,*999)
16773  END SELECT
16774  ELSE
16775  CALL flagerror("Quasi-Newton solver is not associated.",err,error,*999)
16776  ENDIF
16777 
16778  exits("SOLVER_QUASI_NEWTON_SOLVE")
16779  RETURN
16780 999 errorsexits("SOLVER_QUASI_NEWTON_SOLVE",err,error)
16781  RETURN 1
16782 
16783  END SUBROUTINE solver_quasi_newton_solve
16784 
16785  !
16786  !================================================================================================================================
16787  !
16788 
16790  SUBROUTINE solver_quasinewtontrustregioncreatefinish(TRUSTREGION_SOLVER,ERR,ERROR,*)
16791 
16792  !Argument variables
16793  TYPE(quasi_newton_trustregion_solver_type), POINTER :: TRUSTREGION_SOLVER
16794  INTEGER(INTG), INTENT(OUT) :: ERR
16795  TYPE(varying_string), INTENT(OUT) :: ERROR
16796  !Local Variables
16797  EXTERNAL :: problem_solverresidualevaluatepetsc
16798  INTEGER(INTG) :: equations_matrix_idx,equations_set_idx
16799  TYPE(distributed_vector_type), POINTER :: RESIDUAL_VECTOR
16800  TYPE(equations_type), POINTER :: EQUATIONS
16801  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
16802  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
16803  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
16804  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
16805  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
16806  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
16807  TYPE(field_type), POINTER :: DEPENDENT_FIELD
16808  TYPE(field_variable_type), POINTER :: LINEAR_VARIABLE
16809  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
16810  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
16811  TYPE(solver_type), POINTER :: SOLVER
16812  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
16813  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
16814  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
16815  TYPE(varying_string) :: LOCAL_ERROR
16816 
16817  enters("Solver_QuasiNewtonTrustRegionCreateFinish",err,error,*999)
16818 
16819  IF(ASSOCIATED(trustregion_solver)) THEN
16820  quasi_newton_solver=>trustregion_solver%QUASI_NEWTON_SOLVER
16821  IF(ASSOCIATED(quasi_newton_solver)) THEN
16822  nonlinear_solver=>quasi_newton_solver%NONLINEAR_SOLVER
16823  IF(ASSOCIATED(nonlinear_solver)) THEN
16824  solver=>nonlinear_solver%SOLVER
16825  IF(ASSOCIATED(solver)) THEN
16826  solver_equations=>solver%SOLVER_EQUATIONS
16827  IF(ASSOCIATED(solver_equations)) THEN
16828  SELECT CASE(trustregion_solver%SOLVER_LIBRARY)
16829  CASE(solver_cmiss_library)
16830  CALL flagerror("Not implemented.",err,error,*999)
16831  CASE(solver_petsc_library)
16832  solver_mapping=>solver_equations%SOLVER_MAPPING
16833  IF(ASSOCIATED(solver_mapping)) THEN
16834  !Loop over the equations set in the solver equations
16835  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
16836  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)%EQUATIONS
16837  IF(ASSOCIATED(equations)) THEN
16838  equations_set=>equations%EQUATIONS_SET
16839  IF(ASSOCIATED(equations_set)) THEN
16840  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
16841  IF(ASSOCIATED(dependent_field)) THEN
16842  equations_mapping=>equations%EQUATIONS_MAPPING
16843  IF(ASSOCIATED(equations_mapping)) THEN
16844  linear_mapping=>equations_mapping%LINEAR_MAPPING
16845  IF(ASSOCIATED(linear_mapping)) THEN
16846  !If there are any linear matrices create temporary vector for matrix-vector products
16847  equations_matrices=>equations%EQUATIONS_MATRICES
16848  IF(ASSOCIATED(equations_matrices)) THEN
16849  linear_matrices=>equations_matrices%LINEAR_MATRICES
16850  IF(ASSOCIATED(linear_matrices)) THEN
16851  DO equations_matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
16852  equations_matrix=>linear_matrices%MATRICES(equations_matrix_idx)%PTR
16853  IF(ASSOCIATED(equations_matrix)) THEN
16854  IF(.NOT.ASSOCIATED(equations_matrix%TEMP_VECTOR)) THEN
16855  linear_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(equations_matrix_idx)%VARIABLE
16856  IF(ASSOCIATED(linear_variable)) THEN
16857  CALL distributed_vector_create_start(linear_variable%DOMAIN_MAPPING, &
16858  & equations_matrix%TEMP_VECTOR,err,error,*999)
16859  CALL distributed_vector_data_type_set(equations_matrix%TEMP_VECTOR, &
16860  & distributed_matrix_vector_dp_type,err,error,*999)
16861  CALL distributed_vector_create_finish(equations_matrix%TEMP_VECTOR,err,error,*999)
16862  ELSE
16863  CALL flagerror("Linear mapping linear variable is not associated.",err,error,*999)
16864  ENDIF
16865  ENDIF
16866  ELSE
16867  CALL flagerror("Equations matrix is not associated.",err,error,*999)
16868  ENDIF
16869  ENDDO !equations_matrix_idx
16870  ELSE
16871  CALL flagerror("Equations matrices linear matrices is not associated.",err,error,*999)
16872  ENDIF
16873  ELSE
16874  CALL flagerror("Equations equations matrices is not associated.",err,error,*999)
16875  ENDIF
16876  ENDIF
16877  ELSE
16878  CALL flagerror("Equations equations mapping is not associated.",err,error,*999)
16879  ENDIF
16880  ELSE
16881  local_error="Equations set dependent field is not associated for equations set index "// &
16882  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
16883  CALL flagerror(local_error,err,error,*999)
16884  ENDIF
16885  ELSE
16886  local_error="Equations equations set is not associated for equations set index "// &
16887  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
16888  CALL flagerror(local_error,err,error,*999)
16889  ENDIF
16890  ELSE
16891  local_error="Equations is not associated for equations set index "// &
16892  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
16893  CALL flagerror(local_error,err,error,*999)
16894  ENDIF
16895  ENDDO !equations_set_idx
16896 
16897  !Create the solver matrices and vectors
16898  CALL solver_matrices_create_start(solver_equations,solver_matrices,err,error,*999)
16899  CALL solver_matrices_library_type_set(solver_matrices,solver_petsc_library,err,error,*999)
16900 !!TODO: set up the matrix structure if using an analytic Jacobian
16901  CALL solver_matrices_create_finish(solver_matrices,err,error,*999)
16902  !Create the PETSc SNES solver
16903  CALL petsc_snescreate(computational_environment%MPI_COMM,trustregion_solver%snes,err,error,*999)
16904  !Set the nonlinear solver type to be a Quasi-Newton trust region solver
16905  CALL petsc_snessettype(trustregion_solver%snes,petsc_snesnewtontr,err,error,*999)
16906  !Set the nonlinear function
16907  residual_vector=>solver_matrices%RESIDUAL
16908  IF(ASSOCIATED(residual_vector)) THEN
16909  IF(ASSOCIATED(residual_vector%PETSC)) THEN
16910  CALL petsc_snessetfunction(trustregion_solver%snes,residual_vector%PETSC%VECTOR, &
16911  & problem_solverresidualevaluatepetsc,solver,err,error,*999)
16912  CALL flagerror("The residual vector PETSc is not associated.",err,error,*999)
16913  ENDIF
16914  ELSE
16915  CALL flagerror("Solver matrices residual vector is not associated.",err,error,*999)
16916  ENDIF
16917  !Set the Jacobian if necessary
16918  !Set the trust region delta ???
16919 
16920  !Set the trust region tolerance
16921  CALL petsc_snessettrustregiontolerance(trustregion_solver%snes,trustregion_solver%TRUSTREGION_TOLERANCE, &
16922  & err,error,*999)
16923  !Set the tolerances for the SNES solver
16924  CALL petsc_snessettolerances(trustregion_solver%snes,quasi_newton_solver%ABSOLUTE_TOLERANCE, &
16925  & quasi_newton_solver%RELATIVE_TOLERANCE,quasi_newton_solver%SOLUTION_TOLERANCE, &
16926  & quasi_newton_solver%MAXIMUM_NUMBER_OF_ITERATIONS,quasi_newton_solver%MAXIMUM_NUMBER_OF_FUNCTION_EVALUATIONS, &
16927  & err,error,*999)
16928  !Set any further SNES options from the command line options
16929  CALL petsc_snessetfromoptions(trustregion_solver%snes,err,error,*999)
16930  ELSE
16931  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
16932  ENDIF
16933  CASE DEFAULT
16934  local_error="The solver library type of "// &
16935  & trim(numbertovstring(trustregion_solver%SOLVER_LIBRARY,"*",err,error))//" is invalid."
16936  CALL flagerror(local_error,err,error,*999)
16937  END SELECT
16938  ELSE
16939  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
16940  ENDIF
16941  ELSE
16942  CALL flagerror("Nonlinear solver solver is not associated.",err,error,*999)
16943  ENDIF
16944  ELSE
16945  CALL flagerror("Quasi-Newton solver nonlinear solver is not associated.",err,error,*999)
16946  ENDIF
16947  ELSE
16948  CALL flagerror("Trust region Quasi-Newton solver is not associated.",err,error,*999)
16949  ENDIF
16950  ELSE
16951  CALL flagerror("Trust region solver is not associated.",err,error,*999)
16952  ENDIF
16953 
16954  exits("Solver_QuasiNewtonTrustRegionCreateFinish")
16955  RETURN
16956 999 errorsexits("Solver_QuasiNewtonTrustRegionCreateFinish",err,error)
16957  RETURN 1
16958 
16959  END SUBROUTINE solver_quasinewtontrustregioncreatefinish
16960 
16961  !
16962  !================================================================================================================================
16963  !
16964 
16966  SUBROUTINE solver_quasi_newton_trustregion_delta0_set(SOLVER,TRUSTREGION_DELTA0,ERR,ERROR,*)
16967 
16968  !Argument variables
16969  TYPE(solver_type), POINTER :: SOLVER
16970  REAL(DP), INTENT(IN) :: TRUSTREGION_DELTA0
16971  INTEGER(INTG), INTENT(OUT) :: ERR
16972  TYPE(varying_string), INTENT(OUT) :: ERROR
16973  !Local Variables
16974  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
16975  TYPE(quasi_newton_trustregion_solver_type), POINTER :: TRUSTREGION_SOLVER
16976  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
16977  TYPE(varying_string) :: LOCAL_ERROR
16978 
16979  enters("SOLVER_QUASI_NEWTON_TRUSTREGION_DELTA0_SET",err,error,*999)
16980 
16981  IF(ASSOCIATED(solver)) THEN
16982  IF(solver%SOLVER_FINISHED) THEN
16983  CALL flagerror("Solver has already been finished.",err,error,*999)
16984  ELSE
16985  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
16986  nonlinear_solver=>solver%NONLINEAR_SOLVER
16987  IF(ASSOCIATED(nonlinear_solver)) THEN
16988  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
16989  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
16990  IF(ASSOCIATED(quasi_newton_solver)) THEN
16991  IF(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE==solver_quasi_newton_trustregion) THEN
16992  trustregion_solver=>quasi_newton_solver%TRUSTREGION_SOLVER
16993  IF(ASSOCIATED(trustregion_solver)) THEN
16994  IF(trustregion_delta0>zero_tolerance) THEN
16995  trustregion_solver%TRUSTREGION_DELTA0=trustregion_delta0
16996  ELSE
16997  local_error="The specified trust region delta0 of "// &
16998  & trim(numbertovstring(trustregion_delta0,"*",err,error))// &
16999  & " is invalid. The trust region delta0 must be > 0."
17000  CALL flagerror(local_error,err,error,*999)
17001  ENDIF
17002  ELSE
17003  CALL flagerror("The Quasi-Newton solver trust region solver is not associated.",err,error,*999)
17004  ENDIF
17005  ELSE
17006  CALL flagerror("The Quasi-Newton solver is not a trust region solver.",err,error,*999)
17007  ENDIF
17008  ELSE
17009  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
17010  ENDIF
17011  ELSE
17012  CALL flagerror("Nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
17013  ENDIF
17014  ELSE
17015  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
17016  ENDIF
17017  ELSE
17018  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
17019  ENDIF
17020  ENDIF
17021  ELSE
17022  CALL flagerror("Solver is not associated.",err,error,*999)
17023  ENDIF
17024 
17025  exits("SOLVER_QUASI_NEWTON_TRUSTREGION_DELTA0_SET")
17026  RETURN
17027 999 errorsexits("SOLVER_QUASI_NEWTON_TRUSTREGION_DELTA0_SET",err,error)
17028  RETURN 1
17029 
17030  END SUBROUTINE solver_quasi_newton_trustregion_delta0_set
17031 
17032  !
17033  !================================================================================================================================
17034  !
17035 
17037  SUBROUTINE solver_quasi_newton_trustregion_finalise(TRUSTREGION_SOLVER,ERR,ERROR,*)
17038 
17039  !Argument variables
17040  TYPE(quasi_newton_trustregion_solver_type), POINTER :: TRUSTREGION_SOLVER
17041  INTEGER(INTG), INTENT(OUT) :: ERR
17042  TYPE(varying_string), INTENT(OUT) :: ERROR
17043  !Local Variables
17044 
17045  enters("SOLVER_QUASI_NEWTON_TRUSTREGION_FINALISE",err,error,*999)
17046 
17047  IF(ASSOCIATED(trustregion_solver)) THEN
17048  CALL petsc_snesfinalise(trustregion_solver%snes,err,error,*999)
17049  DEALLOCATE(trustregion_solver)
17050  ENDIF
17051 
17052  exits("SOLVER_QUASI_NEWTON_TRUSTREGION_FINALISE")
17053  RETURN
17054 999 errorsexits("SOLVER_QUASI_NEWTON_TRUSTREGION_FINALISE",err,error)
17055  RETURN 1
17056 
17057  END SUBROUTINE solver_quasi_newton_trustregion_finalise
17058 
17059  !
17060  !================================================================================================================================
17061  !
17062 
17064  SUBROUTINE solver_quasi_newton_trustregion_initialise(QUASI_NEWTON_SOLVER,ERR,ERROR,*)
17065 
17066  !Argument variables
17067  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
17068  INTEGER(INTG), INTENT(OUT) :: ERR
17069  TYPE(varying_string), INTENT(OUT) :: ERROR
17070  !Local Variables
17071  INTEGER(INTG) :: DUMMY_ERR
17072  TYPE(varying_string) :: DUMMY_ERROR
17073 
17074  enters("SOLVER_QUASI_NEWTON_TRUSTREGION_INITIALISE",err,error,*998)
17075 
17076  IF(ASSOCIATED(quasi_newton_solver)) THEN
17077  IF(ASSOCIATED(quasi_newton_solver%TRUSTREGION_SOLVER)) THEN
17078  CALL flagerror("Trust region solver is already associated for this nonlinear solver.",err,error,*998)
17079  ELSE
17080  ALLOCATE(quasi_newton_solver%TRUSTREGION_SOLVER,stat=err)
17081  IF(err/=0) CALL flagerror("Could not allocate Quasi-Newton solver trust region solver.",err,error,*999)
17082  quasi_newton_solver%TRUSTREGION_SOLVER%QUASI_NEWTON_SOLVER=>quasi_newton_solver
17083  quasi_newton_solver%TRUSTREGION_SOLVER%SOLVER_LIBRARY=solver_petsc_library
17084  quasi_newton_solver%TRUSTREGION_SOLVER%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
17085 !!TODO: set this properly
17086  quasi_newton_solver%TRUSTREGION_SOLVER%TRUSTREGION_DELTA0=0.01_dp
17087  CALL petsc_snesinitialise(quasi_newton_solver%TRUSTREGION_SOLVER%snes,err,error,*999)
17088  ENDIF
17089  ELSE
17090  CALL flagerror("Quasi-Newton solver is not associated.",err,error,*998)
17091  ENDIF
17092 
17093  exits("SOLVER_QUASI_NEWTON_TRUSTREGION_INITIALISE")
17094  RETURN
17095 999 CALL solver_quasi_newton_trustregion_finalise(quasi_newton_solver%TRUSTREGION_SOLVER,dummy_err,dummy_error,*998)
17096 998 errorsexits("SOLVER_QUASI_NEWTON_TRUSTREGION_INITIALISE",err,error)
17097  RETURN 1
17098 
17099  END SUBROUTINE solver_quasi_newton_trustregion_initialise
17100 
17101  !
17102  !================================================================================================================================
17103  !
17104 
17105  !Solves a nonlinear Quasi-Newton trust region solver
17106  SUBROUTINE solver_quasi_newton_trustregion_solve(TRUSTREGION_SOLVER,ERR,ERROR,*)
17107 
17108  !Argument variables
17109  TYPE(quasi_newton_trustregion_solver_type), POINTER :: TRUSTREGION_SOLVER
17110  INTEGER(INTG), INTENT(OUT) :: ERR
17111  TYPE(varying_string), INTENT(OUT) :: ERROR
17112  !Local Variables
17113  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
17114  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
17115  TYPE(solver_type), POINTER :: SOLVER
17116  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
17117  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
17118  TYPE(varying_string) :: LOCAL_ERROR
17119 
17120  enters("SOLVER_QUASI_NEWTON_TRUSTREGION_SOLVE",err,error,*999)
17121 
17122  IF(ASSOCIATED(trustregion_solver)) THEN
17123  quasi_newton_solver=>trustregion_solver%QUASI_NEWTON_SOLVER
17124  IF(ASSOCIATED(quasi_newton_solver)) THEN
17125  nonlinear_solver=>quasi_newton_solver%NONLINEAR_SOLVER
17126  IF(ASSOCIATED(nonlinear_solver)) THEN
17127  solver=>nonlinear_solver%SOLVER
17128  IF(ASSOCIATED(solver)) THEN
17129  solver_equations=>solver%SOLVER_EQUATIONS
17130  IF(ASSOCIATED(solver_equations)) THEN
17131  solver_matrices=>solver_equations%SOLVER_MATRICES
17132  IF(ASSOCIATED(solver_matrices)) THEN
17133  SELECT CASE(trustregion_solver%SOLVER_LIBRARY)
17134  CASE(solver_cmiss_library)
17135  CALL flagerror("Not implemented.",err,error,*999)
17136  CASE(solver_petsc_library)
17137  CALL flagerror("Not implemented.",err,error,*999)
17138  CASE DEFAULT
17139  local_error="The nonlinear Quasi-Newton trust region solver library type of "// &
17140  & trim(numbertovstring(trustregion_solver%SOLVER_LIBRARY,"*",err,error))//" is invalid."
17141  CALL flagerror(local_error,err,error,*999)
17142  END SELECT
17143  ELSE
17144  CALL flagerror("Solver matrices is not associated.",err,error,*999)
17145  ENDIF
17146  ELSE
17147  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
17148  ENDIF
17149  ELSE
17150  CALL flagerror("Nonlinear solver solver is not associated.",err,error,*999)
17151  ENDIF
17152  ELSE
17153  CALL flagerror("Quasi-Newton solver nonlinear solver is not associated.",err,error,*999)
17154  ENDIF
17155  ELSE
17156  CALL flagerror("Trust region solver Quasi-Newton solver is not associated.",err,error,*999)
17157  ENDIF
17158  ELSE
17159  CALL flagerror("Trust region solver is not associated.",err,error,*999)
17160  ENDIF
17161 
17162  exits("SOLVER_QUASI_NEWTON_TRUSTREGION_SOLVE")
17163  RETURN
17164 999 errorsexits("SOLVER_QUASI_NEWTON_TRUSTREGION_SOLVE",err,error)
17165  RETURN 1
17166 
17167  END SUBROUTINE solver_quasi_newton_trustregion_solve
17168 
17169  !
17170  !================================================================================================================================
17171  !
17172 
17174  SUBROUTINE solver_quasinewtontrustregiontoleranceset(SOLVER,TRUSTREGION_TOLERANCE,ERR,ERROR,*)
17175 
17176  !Argument variables
17177  TYPE(solver_type), POINTER :: SOLVER
17178  REAL(DP), INTENT(IN) :: TRUSTREGION_TOLERANCE
17179  INTEGER(INTG), INTENT(OUT) :: ERR
17180  TYPE(varying_string), INTENT(OUT) :: ERROR
17181  !Local Variables
17182  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
17183  TYPE(quasi_newton_trustregion_solver_type), POINTER :: TRUSTREGION_SOLVER
17184  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
17185  TYPE(varying_string) :: LOCAL_ERROR
17186 
17187  enters("Solver_QuasiNewtonTrustRegionToleranceSet",err,error,*999)
17188 
17189  IF(ASSOCIATED(solver)) THEN
17190  IF(solver%SOLVER_FINISHED) THEN
17191  CALL flagerror("Solver has already been finished.",err,error,*999)
17192  ELSE
17193  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
17194  nonlinear_solver=>solver%NONLINEAR_SOLVER
17195  IF(ASSOCIATED(nonlinear_solver)) THEN
17196  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
17197  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
17198  IF(ASSOCIATED(quasi_newton_solver)) THEN
17199  IF(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE==solver_quasi_newton_trustregion) THEN
17200  trustregion_solver=>quasi_newton_solver%TRUSTREGION_SOLVER
17201  IF(ASSOCIATED(trustregion_solver)) THEN
17202  IF(trustregion_tolerance>zero_tolerance) THEN
17203  trustregion_solver%TRUSTREGION_TOLERANCE=trustregion_tolerance
17204  ELSE
17205  local_error="The specified trust region tolerance of "// &
17206  & trim(numbertovstring(trustregion_tolerance,"*",err,error))// &
17207  & " is invalid. The trust region tolerance must be > 0."
17208  CALL flagerror(local_error,err,error,*999)
17209  ENDIF
17210  ELSE
17211  CALL flagerror("The Quasi-Newton solver trust region solver is not associated.",err,error,*999)
17212  ENDIF
17213  ELSE
17214  CALL flagerror("The Quasi-Newton solver is not a trust region solver.",err,error,*999)
17215  ENDIF
17216  ELSE
17217  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
17218  ENDIF
17219  ELSE
17220  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
17221  ENDIF
17222  ELSE
17223  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
17224  ENDIF
17225  ELSE
17226  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
17227  ENDIF
17228  ENDIF
17229  ELSE
17230  CALL flagerror("Solver is not associated.",err,error,*999)
17231  ENDIF
17232 
17233  exits("Solver_QuasiNewtonTrustRegionToleranceSet")
17234  RETURN
17235 999 errorsexits("Solver_QuasiNewtonTrustRegionToleranceSet",err,error)
17236  RETURN 1
17237 
17238  END SUBROUTINE solver_quasinewtontrustregiontoleranceset
17239 
17240  !
17241  !================================================================================================================================
17242  !
17243 
17245  SUBROUTINE solver_quasi_newton_restart_set(SOLVER,RESTART,ERR,ERROR,*)
17246 
17247  !Argument variables
17248  TYPE(solver_type), POINTER :: SOLVER
17249  INTEGER(INTG), INTENT(IN) :: RESTART
17250  INTEGER(INTG), INTENT(OUT) :: ERR
17251  TYPE(varying_string), INTENT(OUT) :: ERROR
17252  !Local Variables
17253  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
17254  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
17255 
17256  enters("SOLVER_QUASI_NEWTON_RESTART_TYPE_SET",err,error,*999)
17257 
17258  IF(ASSOCIATED(solver)) THEN
17259  IF(solver%SOLVER_FINISHED) THEN
17260  CALL flagerror("Solver has already been finished.",err,error,*999)
17261  ELSE
17262  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
17263  nonlinear_solver=>solver%NONLINEAR_SOLVER
17264  IF(ASSOCIATED(nonlinear_solver)) THEN
17265  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
17266  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
17267  IF(ASSOCIATED(quasi_newton_solver)) THEN
17268  quasi_newton_solver%RESTART=restart
17269  ELSE
17270  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
17271  ENDIF
17272  ELSE
17273  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
17274  ENDIF
17275  ELSE
17276  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
17277  ENDIF
17278  ELSE
17279  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
17280  ENDIF
17281  ENDIF
17282  ELSE
17283  CALL flagerror("Solver is not associated.",err,error,*999)
17284  ENDIF
17285 
17286  exits("SOLVER_QUASI_NEWTON_RESTART_SET")
17287  RETURN
17288 999 errorsexits("SOLVER_QUASI_NEWTON_RESTART_SET",err,error)
17289  RETURN 1
17290 
17291  END SUBROUTINE solver_quasi_newton_restart_set
17292 
17293  !
17294  !================================================================================================================================
17295  !
17296 
17298  SUBROUTINE solver_quasi_newton_restart_type_set(SOLVER,QUASI_NEWTON_RESTART_TYPE,ERR,ERROR,*)
17299 
17300  !Argument variables
17301  TYPE(solver_type), POINTER :: SOLVER
17302  INTEGER(INTG), INTENT(IN) :: QUASI_NEWTON_RESTART_TYPE
17303  INTEGER(INTG), INTENT(OUT) :: ERR
17304  TYPE(varying_string), INTENT(OUT) :: ERROR
17305  !Local Variables
17306  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
17307  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
17308  TYPE(varying_string) :: LOCAL_ERROR
17309 
17310  enters("SOLVER_QUASI_NEWTON_RESTART_TYPE_SET",err,error,*999)
17311 
17312  IF(ASSOCIATED(solver)) THEN
17313  IF(solver%SOLVER_FINISHED) THEN
17314  CALL flagerror("Solver has already been finished.",err,error,*999)
17315  ELSE
17316  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
17317  nonlinear_solver=>solver%NONLINEAR_SOLVER
17318  IF(ASSOCIATED(nonlinear_solver)) THEN
17319  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
17320  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
17321  IF(ASSOCIATED(quasi_newton_solver)) THEN
17322  IF(quasi_newton_restart_type/=quasi_newton_solver%RESTART_TYPE) THEN
17323  !Intialise the new type
17324  SELECT CASE(quasi_newton_restart_type)
17325  CASE(solver_quasi_newton_restart_none)
17326  quasi_newton_solver%RESTART_TYPE=solver_quasi_newton_restart_none
17327  CASE(solver_quasi_newton_restart_powell)
17328  quasi_newton_solver%RESTART_TYPE=solver_quasi_newton_restart_powell
17329  CASE(solver_quasi_newton_restart_periodic)
17330  quasi_newton_solver%RESTART_TYPE=solver_quasi_newton_restart_periodic
17331  CASE DEFAULT
17332  local_error="The Quasi-Newton restart type of "//trim(numbertovstring( &
17333  & quasi_newton_restart_type,"*",err,error))// &
17334  & " is invalid."
17335  CALL flagerror(local_error,err,error,*999)
17336  END SELECT
17337  ENDIF
17338  ELSE
17339  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
17340  ENDIF
17341  ELSE
17342  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
17343  ENDIF
17344  ELSE
17345  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
17346  ENDIF
17347  ELSE
17348  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
17349  ENDIF
17350  ENDIF
17351  ELSE
17352  CALL flagerror("Solver is not associated.",err,error,*999)
17353  ENDIF
17354 
17355  exits("SOLVER_QUASI_NEWTON_RESTART_TYPE_SET")
17356  RETURN
17357 999 errorsexits("SOLVER_QUASI_NEWTON_RESTART_TYPE_SET",err,error)
17358  RETURN 1
17359 
17360  END SUBROUTINE solver_quasi_newton_restart_type_set
17361 
17362  !
17363  !================================================================================================================================
17364  !
17365 
17367  SUBROUTINE solver_quasi_newton_scale_type_set(SOLVER,QUASI_NEWTON_SCALE_TYPE,ERR,ERROR,*)
17368 
17369  !Argument variables
17370  TYPE(solver_type), POINTER :: SOLVER
17371  INTEGER(INTG), INTENT(IN) :: QUASI_NEWTON_SCALE_TYPE
17372  INTEGER(INTG), INTENT(OUT) :: ERR
17373  TYPE(varying_string), INTENT(OUT) :: ERROR
17374  !Local Variables
17375  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
17376  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
17377  TYPE(varying_string) :: LOCAL_ERROR
17378 
17379  enters("SOLVER_QUASI_NEWTON_SCALE_TYPE_SET",err,error,*999)
17380 
17381  IF(ASSOCIATED(solver)) THEN
17382  IF(solver%SOLVER_FINISHED) THEN
17383  CALL flagerror("Solver has already been finished.",err,error,*999)
17384  ELSE
17385  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
17386  nonlinear_solver=>solver%NONLINEAR_SOLVER
17387  IF(ASSOCIATED(nonlinear_solver)) THEN
17388  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
17389  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
17390  IF(ASSOCIATED(quasi_newton_solver)) THEN
17391  IF(quasi_newton_scale_type/=quasi_newton_solver%SCALE_TYPE) THEN
17392  !Intialise the new type
17393  SELECT CASE(quasi_newton_scale_type)
17394  CASE(solver_quasi_newton_scale_none)
17395  quasi_newton_solver%SCALE_TYPE=solver_quasi_newton_scale_none
17396  CASE(solver_quasi_newton_scale_shanno)
17397  quasi_newton_solver%SCALE_TYPE=solver_quasi_newton_scale_shanno
17398  CASE(solver_quasi_newton_scale_linesearch)
17399  quasi_newton_solver%SCALE_TYPE=solver_quasi_newton_scale_linesearch
17400  CASE(solver_quasi_newton_scale_jacobian)
17401  quasi_newton_solver%SCALE_TYPE=solver_quasi_newton_scale_jacobian
17402  CASE DEFAULT
17403  local_error="The Quasi-Newton scale type of "//trim(numbertovstring( &
17404  & quasi_newton_scale_type,"*",err,error))// &
17405  & " is invalid."
17406  CALL flagerror(local_error,err,error,*999)
17407  END SELECT
17408  ENDIF
17409  ELSE
17410  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
17411  ENDIF
17412  ELSE
17413  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
17414  ENDIF
17415  ELSE
17416  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
17417  ENDIF
17418  ELSE
17419  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
17420  ENDIF
17421  ENDIF
17422  ELSE
17423  CALL flagerror("Solver is not associated.",err,error,*999)
17424  ENDIF
17425 
17426  exits("SOLVER_QUASI_NEWTON_SCALE_TYPE_SET")
17427  RETURN
17428 999 errorsexits("SOLVER_QUASI_NEWTON_SCALE_TYPE_SET",err,error)
17429  RETURN 1
17430 
17431  END SUBROUTINE solver_quasi_newton_scale_type_set
17432 
17433  !
17434  !================================================================================================================================
17435  !
17436 
17438  SUBROUTINE solver_quasi_newton_type_set(SOLVER,QUASI_NEWTON_TYPE,ERR,ERROR,*)
17439 
17440  !Argument variables
17441  TYPE(solver_type), POINTER :: SOLVER
17442  INTEGER(INTG), INTENT(IN) :: QUASI_NEWTON_TYPE
17443  INTEGER(INTG), INTENT(OUT) :: ERR
17444  TYPE(varying_string), INTENT(OUT) :: ERROR
17445  !Local Variables
17446  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
17447  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
17448  TYPE(varying_string) :: LOCAL_ERROR
17449 
17450  enters("SOLVER_QUASI_NEWTON_TYPE_SET",err,error,*999)
17451 
17452  IF(ASSOCIATED(solver)) THEN
17453  IF(solver%SOLVER_FINISHED) THEN
17454  CALL flagerror("Solver has already been finished.",err,error,*999)
17455  ELSE
17456  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
17457  nonlinear_solver=>solver%NONLINEAR_SOLVER
17458  IF(ASSOCIATED(nonlinear_solver)) THEN
17459  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
17460  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
17461  IF(ASSOCIATED(quasi_newton_solver)) THEN
17462  IF(quasi_newton_type/=quasi_newton_solver%QUASI_NEWTON_TYPE) THEN
17463  !Intialise the new type
17464  SELECT CASE(quasi_newton_type)
17465  CASE(solver_quasi_newton_lbfgs)
17466  quasi_newton_solver%QUASI_NEWTON_TYPE=solver_quasi_newton_lbfgs
17467  CASE(solver_quasi_newton_goodbroyden)
17468  quasi_newton_solver%QUASI_NEWTON_TYPE=solver_quasi_newton_goodbroyden
17469  CASE(solver_quasi_newton_badbroyden)
17470  quasi_newton_solver%QUASI_NEWTON_TYPE=solver_quasi_newton_badbroyden
17471  CASE DEFAULT
17472  local_error="The Quasi-Newton type of "//trim(numbertovstring(quasi_newton_type,"*",err,error))// &
17473  & " is invalid."
17474  CALL flagerror(local_error,err,error,*999)
17475  END SELECT
17476  ENDIF
17477  ELSE
17478  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
17479  ENDIF
17480  ELSE
17481  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*999)
17482  ENDIF
17483  ELSE
17484  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
17485  ENDIF
17486  ELSE
17487  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
17488  ENDIF
17489  ENDIF
17490  ELSE
17491  CALL flagerror("Solver is not associated.",err,error,*999)
17492  ENDIF
17493 
17494  exits("SOLVER_QUASI_NEWTON_TYPE_SET")
17495  RETURN
17496 999 errorsexits("SOLVER_QUASI_NEWTON_TYPE_SET",err,error)
17497  RETURN 1
17498 
17499  END SUBROUTINE solver_quasi_newton_type_set
17500 
17501  !
17502  !================================================================================================================================
17503  !
17504 
17506  SUBROUTINE solver_quasi_newton_solve_type_set(SOLVER,QUASI_NEWTON_SOLVE_TYPE,ERR,ERROR,*)
17507 
17508  !Argument variables
17509  TYPE(solver_type), POINTER :: SOLVER
17510  INTEGER(INTG), INTENT(IN) :: QUASI_NEWTON_SOLVE_TYPE
17511  INTEGER(INTG), INTENT(OUT) :: ERR
17512  TYPE(varying_string), INTENT(OUT) :: ERROR
17513  !Local Variables
17514  INTEGER(INTG) :: DUMMY_ERR
17515  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
17516  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
17517  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
17518 
17519  enters("SOLVER_QUASI_NEWTON_SOLVE_TYPE_SET",err,error,*998)
17520 
17521  IF(ASSOCIATED(solver)) THEN
17522  IF(solver%SOLVER_FINISHED) THEN
17523  CALL flagerror("Solver has already been finished.",err,error,*998)
17524  ELSE
17525  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
17526  nonlinear_solver=>solver%NONLINEAR_SOLVER
17527  IF(ASSOCIATED(nonlinear_solver)) THEN
17528  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_quasi_newton) THEN
17529  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
17530  IF(ASSOCIATED(quasi_newton_solver)) THEN
17531  IF(quasi_newton_solve_type/=quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE) THEN
17532  !Intialise the new solver type
17533  SELECT CASE(quasi_newton_solve_type)
17534  CASE(solver_quasi_newton_linesearch)
17535  CALL solver_quasi_newton_linesearch_initialise(quasi_newton_solver,err,error,*999)
17536  CASE(solver_quasi_newton_trustregion)
17537  CALL solver_quasi_newton_trustregion_initialise(quasi_newton_solver,err,error,*999)
17538  CASE DEFAULT
17539  local_error="The Quasi-Newton solver type of " &
17540  & //trim(numbertovstring(quasi_newton_solve_type,"*",err,error))// &
17541  & " is invalid."
17542  CALL flagerror(local_error,err,error,*999)
17543  END SELECT
17544  !Finalise the old solver type
17545  SELECT CASE(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE)
17546  CASE(solver_quasi_newton_linesearch)
17547  CALL solver_quasinewtonlinesearchfinalise(quasi_newton_solver%LINESEARCH_SOLVER,err,error,*999)
17548  CASE(solver_quasi_newton_trustregion)
17549  CALL solver_quasi_newton_trustregion_finalise(quasi_newton_solver%TRUSTREGION_SOLVER,err,error,*999)
17550  CASE DEFAULT
17551  local_error="The Quasi-Newton solver type of "// &
17552  & trim(numbertovstring(quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE,"*",err,error))//" is invalid."
17553  CALL flagerror(local_error,err,error,*999)
17554  END SELECT
17555  quasi_newton_solver%QUASI_NEWTON_SOLVE_TYPE=quasi_newton_solve_type
17556  ENDIF
17557  ELSE
17558  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*998)
17559  ENDIF
17560  ELSE
17561  CALL flagerror("The nonlinear solver is not a Quasi-Newton solver.",err,error,*998)
17562  ENDIF
17563  ELSE
17564  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*998)
17565  ENDIF
17566  ELSE
17567  CALL flagerror("The solver is not a nonlinear solver.",err,error,*998)
17568  ENDIF
17569  ENDIF
17570  ELSE
17571  CALL flagerror("Solver is not associated.",err,error,*998)
17572  ENDIF
17573 
17574  exits("SOLVER_QUASI_NEWTON_SOLVE_TYPE_SET")
17575  RETURN
17576 999 SELECT CASE(quasi_newton_solve_type)
17577  CASE(solver_quasi_newton_linesearch)
17578  CALL solver_quasinewtonlinesearchfinalise(quasi_newton_solver%LINESEARCH_SOLVER,dummy_err,dummy_error,*998)
17579  CASE(solver_quasi_newton_trustregion)
17580  CALL solver_quasi_newton_trustregion_finalise(quasi_newton_solver%TRUSTREGION_SOLVER,dummy_err,dummy_error,*998)
17581  END SELECT
17582 998 errorsexits("SOLVER_QUASI_NEWTON_SOLVE_TYPE_SET",err,error)
17583  RETURN 1
17584 
17585  END SUBROUTINE solver_quasi_newton_solve_type_set
17586 
17587  !
17588  !================================================================================================================================
17589  !
17590 
17592  SUBROUTINE solver_newton_absolute_tolerance_set(SOLVER,ABSOLUTE_TOLERANCE,ERR,ERROR,*)
17593 
17594  !Argument variables
17595  TYPE(solver_type), POINTER :: SOLVER
17596  REAL(DP), INTENT(IN) :: ABSOLUTE_TOLERANCE
17597  INTEGER(INTG), INTENT(OUT) :: ERR
17598  TYPE(varying_string), INTENT(OUT) :: ERROR
17599  !Local Variables
17600  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
17601  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
17602  TYPE(varying_string) :: LOCAL_ERROR
17603 
17604  enters("SOLVER_NEWTON_ABSOLUTE_TOLERANCE_SET",err,error,*999)
17605 
17606  IF(ASSOCIATED(solver)) THEN
17607  IF(solver%SOLVER_FINISHED) THEN
17608  CALL flagerror("Solver has already been finished.",err,error,*999)
17609  ELSE
17610  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
17611  nonlinear_solver=>solver%NONLINEAR_SOLVER
17612  IF(ASSOCIATED(nonlinear_solver)) THEN
17613  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
17614  newton_solver=>nonlinear_solver%NEWTON_SOLVER
17615  IF(ASSOCIATED(newton_solver)) THEN
17616  IF(absolute_tolerance>zero_tolerance) THEN
17617  newton_solver%ABSOLUTE_TOLERANCE=absolute_tolerance
17618  ELSE
17619  local_error="The specified absolute tolerance of "//trim(numbertovstring(absolute_tolerance,"*",err,error))// &
17620  & " is invalid. The absolute tolerance must be > 0."
17621  CALL flagerror(local_error,err,error,*999)
17622  ENDIF
17623  ELSE
17624  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
17625  ENDIF
17626  ELSE
17627  CALL flagerror("The nonlinear solver is not a Newton solver.",err,error,*999)
17628  ENDIF
17629  ELSE
17630  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
17631  ENDIF
17632  ELSE
17633  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
17634  ENDIF
17635  ENDIF
17636  ELSE
17637  CALL flagerror("Solver is not associated.",err,error,*999)
17638  ENDIF
17639 
17640  exits("SOLVER_NEWTON_ABSOLUTE_TOLERANCE_SET")
17641  RETURN
17642 999 errorsexits("SOLVER_NEWTON_ABSOLUTE_TOLERANCE_SET",err,error)
17643  RETURN 1
17644 
17645  END SUBROUTINE solver_newton_absolute_tolerance_set
17646 
17647  !
17648  !================================================================================================================================
17649  !
17650 
17652  SUBROUTINE solver_newtonlinesearchmonitoroutputset(solver,linesearchMonitorOutputFlag,err,error,*)
17653 
17654  !Argument variables
17655  TYPE(solver_type), POINTER :: solver
17656  LOGICAL, INTENT(IN) :: linesearchMonitorOutputFlag
17657  INTEGER(INTG), INTENT(OUT) :: err
17658  TYPE(varying_string), INTENT(OUT) :: error
17659  !Local Variables
17660  TYPE(newton_linesearch_solver_type), POINTER :: linesearchSolver
17661  TYPE(newton_solver_type), POINTER :: newtonSolver
17662  TYPE(nonlinear_solver_type), POINTER :: nonlinearSolver
17663 
17664  enters("Solver_NewtonLineSearchMonitorOutputSet",err,error,*999)
17665 
17666  IF(ASSOCIATED(solver)) THEN
17667  IF(solver%SOLVER_FINISHED) THEN
17668  CALL flagerror("Solver has already been finished.",err,error,*999)
17669  ELSE
17670  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
17671  nonlinearsolver=>solver%NONLINEAR_SOLVER
17672  IF(ASSOCIATED(nonlinearsolver)) THEN
17673  IF(nonlinearsolver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
17674  newtonsolver=>nonlinearsolver%NEWTON_SOLVER
17675  IF(ASSOCIATED(newtonsolver)) THEN
17676  IF(newtonsolver%NEWTON_SOLVE_TYPE==solver_newton_linesearch) THEN
17677  linesearchsolver=>newtonsolver%LINESEARCH_SOLVER
17678  IF(ASSOCIATED(linesearchsolver)) THEN
17679  linesearchsolver%linesearchMonitorOutput=linesearchmonitoroutputflag
17680  ELSE
17681  CALL flagerror("The Newton linesearch solver is not associated.",err,error,*999)
17682  ENDIF
17683  ELSE
17684  CALL flagerror("The Newton solver is not a linesearch solver.",err,error,*999)
17685  ENDIF
17686  ELSE
17687  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
17688  ENDIF
17689  ELSE
17690  CALL flagerror("The nonlinear solver is not a Newton solver.",err,error,*999)
17691  ENDIF
17692  ELSE
17693  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
17694  ENDIF
17695  ELSE
17696  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
17697  ENDIF
17698  ENDIF
17699  ELSE
17700  CALL flagerror("Solver is not associated.",err,error,*999)
17701  ENDIF
17702 
17703  exits("Solver_NewtonLineSearchMonitorOutputSet")
17704  RETURN
17705 999 errorsexits("Solver_NewtonLineSearchMonitorOutputSet",err,error)
17706  RETURN 1
17707 
17708  END SUBROUTINE solver_newtonlinesearchmonitoroutputset
17709 
17710  !
17711  !================================================================================================================================
17712  !
17713 
17715  SUBROUTINE solver_newton_create_finish(NEWTON_SOLVER,ERR,ERROR,*)
17716 
17717  !Argument variables
17718  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
17719  INTEGER(INTG), INTENT(OUT) :: ERR
17720  TYPE(varying_string), INTENT(OUT) :: ERROR
17721  !Local Variables
17722  TYPE(varying_string) :: LOCAL_ERROR
17723 
17724  enters("SOLVER_NEWTON_CREATE_FINISH",err,error,*999)
17725 
17726  IF(ASSOCIATED(newton_solver)) THEN
17727  SELECT CASE(newton_solver%NEWTON_SOLVE_TYPE)
17728  CASE(solver_newton_linesearch)
17729  CALL solver_newton_linesearch_create_finish(newton_solver%LINESEARCH_SOLVER,err,error,*999)
17730  CASE(solver_newton_trustregion)
17731  CALL solver_newton_trustregion_create_finish(newton_solver%TRUSTREGION_SOLVER,err,error,*999)
17732  CASE DEFAULT
17733  local_error="The Newton solver type of "// &
17734  & trim(numbertovstring(newton_solver%NEWTON_SOLVE_TYPE,"*",err,error))//" is invalid."
17735  CALL flagerror(local_error,err,error,*999)
17736  END SELECT
17737  ELSE
17738  CALL flagerror("Newton solver is not associated.",err,error,*999)
17739  ENDIF
17740 
17741  exits("SOLVER_NEWTON_CREATE_FINISH")
17742  RETURN
17743 999 errorsexits("SOLVER_NEWTON_CREATE_FINISH",err,error)
17744  RETURN 1
17745 
17746  END SUBROUTINE solver_newton_create_finish
17747 
17748  !
17749  !================================================================================================================================
17750  !
17751 
17753  RECURSIVE SUBROUTINE solver_newton_finalise(NEWTON_SOLVER,ERR,ERROR,*)
17754 
17755  !Argument variables
17756  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
17757  INTEGER(INTG), INTENT(OUT) :: ERR
17758  TYPE(varying_string), INTENT(OUT) :: ERROR
17759  !Local Variables
17760 
17761  enters("SOLVER_NEWTON_FINALISE",err,error,*999)
17762 
17763  IF(ASSOCIATED(newton_solver)) THEN
17764  CALL solver_newton_linesearch_finalise(newton_solver%LINESEARCH_SOLVER,err,error,*999)
17765  CALL solver_newton_trustregion_finalise(newton_solver%TRUSTREGION_SOLVER,err,error,*999)
17766  CALL solver_finalise(newton_solver%LINEAR_SOLVER,err,error,*999)
17767  DEALLOCATE(newton_solver)
17768  ENDIF
17769 
17770  exits("SOLVER_NEWTON_FINALISE")
17771  RETURN
17772 999 errorsexits("SOLVER_NEWTON_FINALISE",err,error)
17773  RETURN 1
17774 
17775  END SUBROUTINE solver_newton_finalise
17776 
17777  !
17778  !================================================================================================================================
17779  !
17780 
17782  SUBROUTINE solver_newton_initialise(NONLINEAR_SOLVER,ERR,ERROR,*)
17783 
17784  !Argument variables
17785  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
17786  INTEGER(INTG), INTENT(OUT) :: ERR
17787  TYPE(varying_string), INTENT(OUT) :: ERROR
17788  !Local Variables
17789  INTEGER(INTG) :: DUMMY_ERR
17790  TYPE(solver_type), POINTER :: SOLVER
17791  TYPE(varying_string) :: DUMMY_ERROR
17792 
17793  enters("SOLVER_NEWTON_INITIALISE",err,error,*998)
17794 
17795  IF(ASSOCIATED(nonlinear_solver)) THEN
17796  IF(ASSOCIATED(nonlinear_solver%NEWTON_SOLVER)) THEN
17797  CALL flagerror("Newton solver is already associated for this nonlinear solver.",err,error,*998)
17798  ELSE
17799  solver=>nonlinear_solver%SOLVER
17800  IF(ASSOCIATED(solver)) THEN
17801  !Allocate and initialise a Newton solver
17802  ALLOCATE(nonlinear_solver%NEWTON_SOLVER,stat=err)
17803  IF(err/=0) CALL flagerror("Could not allocate nonlinear solver Newton solver.",err,error,*999)
17804  nonlinear_solver%NEWTON_SOLVER%NONLINEAR_SOLVER=>nonlinear_solver
17805  nonlinear_solver%NEWTON_SOLVER%SOLUTION_INITIALISE_TYPE=solver_solution_initialise_current_field
17806  nonlinear_solver%NEWTON_SOLVER%TOTAL_NUMBER_OF_FUNCTION_EVALUATIONS=0
17807  nonlinear_solver%NEWTON_SOLVER%TOTAL_NUMBER_OF_JACOBIAN_EVALUATIONS=0
17808  nonlinear_solver%NEWTON_SOLVER%MAXIMUM_NUMBER_OF_ITERATIONS=50
17809  nonlinear_solver%NEWTON_SOLVER%MAXIMUM_NUMBER_OF_FUNCTION_EVALUATIONS=1000
17810  nonlinear_solver%NEWTON_SOLVER%JACOBIAN_CALCULATION_TYPE=solver_newton_jacobian_fd_calculated
17811  nonlinear_solver%NEWTON_SOLVER%convergenceTestType=solver_newton_convergence_petsc_default
17812  nonlinear_solver%NEWTON_SOLVER%ABSOLUTE_TOLERANCE=1.0e-10_dp
17813  nonlinear_solver%NEWTON_SOLVER%RELATIVE_TOLERANCE=1.0e-05_dp
17814  nonlinear_solver%NEWTON_SOLVER%SOLUTION_TOLERANCE=1.0e-05_dp
17815  NULLIFY(nonlinear_solver%NEWTON_SOLVER%LINESEARCH_SOLVER)
17816  NULLIFY(nonlinear_solver%NEWTON_SOLVER%TRUSTREGION_SOLVER)
17817  NULLIFY(nonlinear_solver%NEWTON_SOLVER%CELLML_EVALUATOR_SOLVER)
17818  NULLIFY(nonlinear_solver%NEWTON_SOLVER%convergenceTest)
17819  ALLOCATE(nonlinear_solver%NEWTON_SOLVER%convergenceTest,stat=err)
17820  IF(err/=0) CALL flagerror("Could not allocate convergence test object.",err,error,*999)
17821  nonlinear_solver%NEWTON_SOLVER%convergenceTest%energyFirstIter = 0.0_dp
17822  nonlinear_solver%NEWTON_SOLVER%convergenceTest%normalisedEnergy = 0.0_dp
17823  !Default to a Newton linesearch solver
17824  nonlinear_solver%NEWTON_SOLVER%NEWTON_SOLVE_TYPE=solver_newton_linesearch
17825  CALL solver_newton_linesearch_initialise(nonlinear_solver%NEWTON_SOLVER,err,error,*999)
17826  !Create the linked linear solver
17827  ALLOCATE(nonlinear_solver%NEWTON_SOLVER%LINEAR_SOLVER,stat=err)
17828  IF(err/=0) CALL flagerror("Could not allocate Newton solver linear solver.",err,error,*999)
17829  NULLIFY(nonlinear_solver%NEWTON_SOLVER%LINEAR_SOLVER%SOLVERS)
17830  CALL solver_initialise_ptr(nonlinear_solver%NEWTON_SOLVER%LINEAR_SOLVER,err,error,*999)
17831  CALL solver_linear_initialise(nonlinear_solver%NEWTON_SOLVER%LINEAR_SOLVER,err,error,*999)
17832  CALL solver_linked_solver_add(solver,nonlinear_solver%NEWTON_SOLVER%LINEAR_SOLVER,solver_linear_type,err,error,*999)
17833  ELSE
17834  CALL flagerror("Nonlinear solver solver is not associated.",err,error,*998)
17835  ENDIF
17836  ENDIF
17837  ELSE
17838  CALL flagerror("Nonlinear solver is not associated.",err,error,*998)
17839  ENDIF
17840 
17841  exits("SOLVER_NEWTON_INITIALISE")
17842  RETURN
17843 999 CALL solver_newton_finalise(nonlinear_solver%NEWTON_SOLVER,dummy_err,dummy_error,*998)
17844 998 errorsexits("SOLVER_NEWTON_INITIALISE",err,error)
17845  RETURN 1
17846 
17847  END SUBROUTINE solver_newton_initialise
17848 
17849  !
17850  !================================================================================================================================
17851  !
17852 
17854  SUBROUTINE solver_newton_jacobian_calculation_type_set(SOLVER,JACOBIAN_CALCULATION_TYPE,ERR,ERROR,*)
17855 
17856  !Argument variables
17857  TYPE(solver_type), POINTER :: SOLVER
17858  INTEGER(INTG), INTENT(IN) :: JACOBIAN_CALCULATION_TYPE
17859  INTEGER(INTG), INTENT(OUT) :: ERR
17860  TYPE(varying_string), INTENT(OUT) :: ERROR
17861  !Local Variables
17862  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
17863  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
17864  TYPE(varying_string) :: LOCAL_ERROR
17865 
17866  enters("SOLVER_NEWTON_JACOBIAN_CALCULATION_TYPE_SET",err,error,*999)
17867 
17868  IF(ASSOCIATED(solver)) THEN
17869  IF(solver%SOLVER_FINISHED) THEN
17870  CALL flagerror("Solver has already been finished",err,error,*999)
17871  ELSE
17872  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
17873  nonlinear_solver=>solver%NONLINEAR_SOLVER
17874  IF(ASSOCIATED(nonlinear_solver)) THEN
17875  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
17876  newton_solver=>nonlinear_solver%NEWTON_SOLVER
17877  IF(ASSOCIATED(newton_solver)) THEN
17878  IF(jacobian_calculation_type/=newton_solver%JACOBIAN_CALCULATION_TYPE) THEN
17879  SELECT CASE(jacobian_calculation_type)
17880  CASE(solver_newton_jacobian_not_calculated)
17881  newton_solver%JACOBIAN_CALCULATION_TYPE=solver_newton_jacobian_not_calculated
17882  CASE(solver_newton_jacobian_equations_calculated)
17883  newton_solver%JACOBIAN_CALCULATION_TYPE=solver_newton_jacobian_equations_calculated
17884  CASE(solver_newton_jacobian_fd_calculated)
17885  newton_solver%JACOBIAN_CALCULATION_TYPE=solver_newton_jacobian_fd_calculated
17886  CASE DEFAULT
17887  local_error="The Jacobian calculation type of "// &
17888  & trim(numbertovstring(jacobian_calculation_type,"*",err,error))//" is invalid."
17889  CALL flagerror(local_error,err,error,*999)
17890  END SELECT
17891  ENDIF
17892  ELSE
17893  CALL flagerror("The nonlinear solver Newton solver is not associated.",err,error,*999)
17894  ENDIF
17895  ELSE
17896  CALL flagerror("The nonlinear solver is not a Newton solver.",err,error,*999)
17897  ENDIF
17898  ELSE
17899  CALL flagerror("The Solver nonlinear solver is not associated",err,error,*999)
17900  ENDIF
17901  ELSE
17902  CALL flagerror("The solver is not a nonlinear solver",err,error,*999)
17903  ENDIF
17904  ENDIF
17905  ELSE
17906  CALL flagerror("Solver is not associated",err,error,*999)
17907  ENDIF
17908 
17909  exits("SOLVER_NEWTON_JACOBIAN_CALCULATION_TYPE_SET")
17910  RETURN
17911 999 errorsexits("SOLVER_NEWTON_JACOBIAN_CALCULATION_TYPE_SET",err,error)
17912  RETURN 1
17913 
17914  END SUBROUTINE solver_newton_jacobian_calculation_type_set
17915 
17916  !
17917  !================================================================================================================================
17918  !
17919 
17921  SUBROUTINE solver_newton_library_type_get(NEWTON_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
17922 
17923  !Argument variables
17924  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
17925  INTEGER(INTG), INTENT(OUT) :: SOLVER_LIBRARY_TYPE
17926  INTEGER(INTG), INTENT(OUT) :: ERR
17927  TYPE(varying_string), INTENT(OUT) :: ERROR
17928  !Local Variables
17929  TYPE(newton_linesearch_solver_type), POINTER :: LINESEARCH_SOLVER
17930  TYPE(newton_trustregion_solver_type), POINTER :: TRUSTREGION_SOLVER
17931  TYPE(varying_string) :: LOCAL_ERROR
17932 
17933  enters("SOLVER_NEWTON_LIBRARY_TYPE_GET",err,error,*999)
17934 
17935  IF(ASSOCIATED(newton_solver)) THEN
17936  SELECT CASE(newton_solver%NEWTON_SOLVE_TYPE)
17937  CASE(solver_newton_linesearch)
17938  linesearch_solver=>newton_solver%LINESEARCH_SOLVER
17939  IF(ASSOCIATED(linesearch_solver)) THEN
17940  solver_library_type=linesearch_solver%SOLVER_LIBRARY
17941  ELSE
17942  CALL flagerror("Newton line search solver is not associated.",err,error,*999)
17943  ENDIF
17944  CASE(solver_newton_trustregion)
17945  trustregion_solver=>newton_solver%TRUSTREGION_SOLVER
17946  IF(ASSOCIATED(trustregion_solver)) THEN
17947  solver_library_type=trustregion_solver%SOLVER_LIBRARY
17948  ELSE
17949  CALL flagerror("Newton trust region solver is not associated.",err,error,*999)
17950  ENDIF
17951  CASE DEFAULT
17952  local_error="The Newton solver type of "// &
17953  & trim(numbertovstring(newton_solver%NEWTON_SOLVE_TYPE,"*",err,error))//" is invalid."
17954  CALL flagerror(local_error,err,error,*999)
17955  END SELECT
17956  ELSE
17957  CALL flagerror("Newton solver is not associated.",err,error,*999)
17958  ENDIF
17959 
17960  exits("SOLVER_NEWTON_LIBRARY_TYPE_GET")
17961  RETURN
17962 999 errorsexits("SOLVER_NEWTON_LIBRARY_TYPE_GET",err,error)
17963  RETURN 1
17964 
17965  END SUBROUTINE solver_newton_library_type_get
17966 
17967  !
17968  !================================================================================================================================
17969  !
17970 
17972  SUBROUTINE solver_newton_library_type_set(NEWTON_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
17973 
17974  !Argument variables
17975  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
17976  INTEGER(INTG), INTENT(IN) :: SOLVER_LIBRARY_TYPE
17977  INTEGER(INTG), INTENT(OUT) :: ERR
17978  TYPE(varying_string), INTENT(OUT) :: ERROR
17979  !Local Variables
17980  TYPE(newton_linesearch_solver_type), POINTER :: LINESEARCH_SOLVER
17981  TYPE(newton_trustregion_solver_type), POINTER :: TRUSTREGION_SOLVER
17982  TYPE(varying_string) :: LOCAL_ERROR
17983 
17984  enters("SOLVER_NEWTON_LIBRARY_TYPE_SET",err,error,*999)
17985 
17986  IF(ASSOCIATED(newton_solver)) THEN
17987  SELECT CASE(newton_solver%NEWTON_SOLVE_TYPE)
17988  CASE(solver_newton_linesearch)
17989  linesearch_solver=>newton_solver%LINESEARCH_SOLVER
17990  IF(ASSOCIATED(linesearch_solver)) THEN
17991  SELECT CASE(solver_library_type)
17992  CASE(solver_cmiss_library)
17993  CALL flagerror("Not implemented.",err,error,*999)
17994  CASE(solver_petsc_library)
17995  linesearch_solver%SOLVER_LIBRARY=solver_petsc_library
17996  linesearch_solver%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
17997  CASE DEFAULT
17998  local_error="The solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
17999  & " is invalid for a Newton linesearch solver."
18000  CALL flagerror(local_error,err,error,*999)
18001  END SELECT
18002  ELSE
18003  CALL flagerror("Newton line search solver is not associated.",err,error,*999)
18004  ENDIF
18005  CASE(solver_newton_trustregion)
18006  trustregion_solver=>newton_solver%TRUSTREGION_SOLVER
18007  IF(ASSOCIATED(trustregion_solver)) THEN
18008  SELECT CASE(solver_library_type)
18009  CASE(solver_cmiss_library)
18010  CALL flagerror("Not implemented.",err,error,*999)
18011  CASE(solver_petsc_library)
18012  trustregion_solver%SOLVER_LIBRARY=solver_petsc_library
18013  trustregion_solver%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
18014  CASE DEFAULT
18015  local_error="The solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
18016  & " is invalid for a Newton trustregion solver."
18017  CALL flagerror(local_error,err,error,*999)
18018  END SELECT
18019  ELSE
18020  CALL flagerror("Newton trust region solver is not associated.",err,error,*999)
18021  ENDIF
18022  CASE DEFAULT
18023  local_error="The Newton solver type of "// &
18024  & trim(numbertovstring(newton_solver%NEWTON_SOLVE_TYPE,"*",err,error))//" is invalid."
18025  CALL flagerror(local_error,err,error,*999)
18026  END SELECT
18027  ELSE
18028  CALL flagerror("Newton solver is not associated.",err,error,*999)
18029  ENDIF
18030 
18031  exits("SOLVER_NEWTON_LIBRARY_TYPE_SET")
18032  RETURN
18033 999 errorsexits("SOLVER_NEWTON_LIBRARY_TYPE_SET",err,error)
18034  RETURN 1
18035 
18036  END SUBROUTINE solver_newton_library_type_set
18037 
18038  !
18039  !================================================================================================================================
18040  !
18041 
18043  SUBROUTINE solver_newton_linear_solver_get(SOLVER,LINEAR_SOLVER,ERR,ERROR,*)
18044 
18045  !Argument variables
18046  TYPE(solver_type), POINTER :: SOLVER
18047  TYPE(solver_type), POINTER :: LINEAR_SOLVER
18048  INTEGER(INTG), INTENT(OUT) :: ERR
18049  TYPE(varying_string), INTENT(OUT) :: ERROR
18050  !Local Variables
18051  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
18052  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
18053 
18054  enters("SOLVER_NEWTON_LINEAR_SOLVER_GET",err,error,*999)
18055 
18056  IF(ASSOCIATED(solver)) THEN
18057  IF(ASSOCIATED(linear_solver)) THEN
18058  CALL flagerror("Linear solver is already associated.",err,error,*999)
18059  ELSE
18060  NULLIFY(linear_solver)
18061  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
18062  nonlinear_solver=>solver%NONLINEAR_SOLVER
18063  IF(ASSOCIATED(nonlinear_solver)) THEN
18064  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
18065  newton_solver=>nonlinear_solver%NEWTON_SOLVER
18066  IF(ASSOCIATED(newton_solver)) THEN
18067  linear_solver=>newton_solver%LINEAR_SOLVER
18068  IF(.NOT.ASSOCIATED(linear_solver)) &
18069  & CALL flagerror("Newton solver linear solver is not associated.",err,error,*999)
18070  ELSE
18071  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
18072  ENDIF
18073  ELSE
18074  CALL flagerror("The nonlinear solver is not a Newton solver.",err,error,*999)
18075  ENDIF
18076  ELSE
18077  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
18078  ENDIF
18079  ELSE
18080  CALL flagerror("The specified solver is not a dynamic solver.",err,error,*999)
18081  ENDIF
18082  ENDIF
18083  ELSE
18084  CALL flagerror("Solver is not associated.",err,error,*999)
18085  ENDIF
18086 
18087  exits("SOLVER_NEWTON_LINEAR_SOLVER_GET")
18088  RETURN
18089 999 errorsexits("SOLVER_NEWTON_LINEAR_SOLVER_GET",err,error)
18090  RETURN 1
18091 
18092  END SUBROUTINE solver_newton_linear_solver_get
18093 
18094  !
18095  !================================================================================================================================
18096  !
18097 
18099  SUBROUTINE solver_newton_cellml_solver_get(SOLVER,CELLML_SOLVER,ERR,ERROR,*)
18100 
18101  !Argument variables
18102  TYPE(solver_type), POINTER :: SOLVER
18103  TYPE(solver_type), POINTER :: CELLML_SOLVER
18104  INTEGER(INTG), INTENT(OUT) :: ERR
18105  TYPE(varying_string), INTENT(OUT) :: ERROR
18106  !Local Variables
18107  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
18108  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
18109 
18110  enters("SOLVER_NEWTON_CELLML_SOLVER_GET",err,error,*999)
18111 
18112  IF(ASSOCIATED(solver)) THEN
18113  IF(ASSOCIATED(cellml_solver)) THEN
18114  CALL flagerror("Linear solver is already associated.",err,error,*999)
18115  ELSE
18116  NULLIFY(cellml_solver)
18117  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
18118  nonlinear_solver=>solver%NONLINEAR_SOLVER
18119  IF(ASSOCIATED(nonlinear_solver)) THEN
18120  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
18121  newton_solver=>nonlinear_solver%NEWTON_SOLVER
18122  IF(ASSOCIATED(newton_solver)) THEN
18123  cellml_solver=>newton_solver%CELLML_EVALUATOR_SOLVER
18124  IF(.NOT.ASSOCIATED(cellml_solver)) &
18125  & CALL flagerror("Newton solver CellML solver is not associated.",err,error,*999)
18126  ELSE
18127  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
18128  ENDIF
18129  ELSE
18130  CALL flagerror("The nonlinear solver is not a Newton solver.",err,error,*999)
18131  ENDIF
18132  ELSE
18133  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
18134  ENDIF
18135  ELSE IF(solver%SOLVE_TYPE==solver_dynamic_type) THEN
18136  nonlinear_solver=>solver%DYNAMIC_SOLVER%NONLINEAR_SOLVER%NONLINEAR_SOLVER
18137  IF(ASSOCIATED(nonlinear_solver)) THEN
18138  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
18139  newton_solver=>nonlinear_solver%NEWTON_SOLVER
18140  IF(ASSOCIATED(newton_solver)) THEN
18141  cellml_solver=>newton_solver%CELLML_EVALUATOR_SOLVER
18142  IF(.NOT.ASSOCIATED(cellml_solver)) &
18143  & CALL flagerror("Newton solver CellML solver is not associated.",err,error,*999)
18144  ELSE
18145  CALL flagerror("Dynamic nonlinear solver Newton solver is not associated.",err,error,*999)
18146  ENDIF
18147  ELSE
18148  CALL flagerror("The Dynamic nonlinear solver is not a Newton solver.",err,error,*999)
18149  ENDIF
18150  ELSE
18151  CALL flagerror("The solver dynamic nonlinear solver is not associated.",err,error,*999)
18152  ENDIF
18153  ELSE
18154  CALL flagerror("The specified solver is not a nonlinear or dynamic nonlinear solver.",err,error,*999)
18155  ENDIF
18156  ENDIF
18157  ELSE
18158  CALL flagerror("Solver is not associated.",err,error,*999)
18159  ENDIF
18160 
18161  exits("SOLVER_NEWTON_CELLML_SOLVER_GET")
18162  RETURN
18163 999 errorsexits("SOLVER_NEWTON_CELLML_SOLVER_GET",err,error)
18164  RETURN 1
18165 
18166  END SUBROUTINE solver_newton_cellml_solver_get
18167 
18168  !
18169  !================================================================================================================================
18170  !
18171 
18173  SUBROUTINE solver_newtonconvergencetesttypeset(solver,convergenceTestType,err,error,*)
18174 
18175  !Argument variables
18176  TYPE(solver_type), POINTER :: solver
18177  INTEGER(INTG), INTENT(IN) :: convergenceTestType
18178  INTEGER(INTG), INTENT(OUT) :: err
18179  TYPE(varying_string), INTENT(OUT) :: error
18180  !Local Variables
18181  TYPE(newton_solver_type), POINTER :: newtonSolver
18182  TYPE(nonlinear_solver_type), POINTER :: nonlinearSolver
18183  TYPE(varying_string) :: localError
18184 
18185  enters("Solver_NewtonConvergenceTestTypeSet",err,error,*999)
18186 
18187  IF(ASSOCIATED(solver)) THEN
18188  IF(solver%SOLVER_FINISHED) THEN
18189  CALL flagerror("Solver has already been finished.",err,error,*999)
18190  ELSE
18191  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
18192  nonlinearsolver=>solver%NONLINEAR_SOLVER
18193  IF(ASSOCIATED(nonlinearsolver)) THEN
18194  IF(nonlinearsolver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
18195  newtonsolver=>nonlinearsolver%NEWTON_SOLVER
18196  IF(ASSOCIATED(newtonsolver)) THEN
18197  SELECT CASE(convergencetesttype)
18198  CASE(solver_newton_convergence_petsc_default)
18199  newtonsolver%convergenceTestType=solver_newton_convergence_petsc_default
18200  CASE(solver_newton_convergence_energy_norm)
18201  newtonsolver%convergenceTestType=solver_newton_convergence_energy_norm
18202  CASE(solver_newton_convergence_differentiated_ratio)
18203  newtonsolver%convergenceTestType=solver_newton_convergence_differentiated_ratio
18204  CASE DEFAULT
18205  localerror="The specified convergence test type of "//trim(numbertovstring(convergencetesttype, &
18206  & "*",err,error))//" is invalid."
18207  CALL flagerror(localerror,err,error,*999)
18208  END SELECT
18209  ELSE
18210  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
18211  ENDIF
18212  ELSE
18213  CALL flagerror("The nonlinear solver is not a Newton solver.",err,error,*999)
18214  ENDIF
18215  ELSE
18216  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
18217  ENDIF
18218  ELSE
18219  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
18220  ENDIF
18221  ENDIF
18222  ELSE
18223  CALL flagerror("Solver is not associated.",err,error,*999)
18224  ENDIF
18225 
18226  exits("Solver_NewtonConvergenceTestTypeSet")
18227  RETURN
18228 999 errorsexits("Solver_NewtonConvergenceTestTypeSet",err,error)
18229  RETURN 1
18230 
18231  END SUBROUTINE solver_newtonconvergencetesttypeset
18232 
18233  !
18234  !================================================================================================================================
18235  !
18236 
18238  SUBROUTINE solver_newton_linesearch_alpha_set(SOLVER,LINESEARCH_ALPHA,ERR,ERROR,*)
18239 
18240  !Argument variables
18241  TYPE(solver_type), POINTER :: SOLVER
18242  REAL(DP), INTENT(IN) :: LINESEARCH_ALPHA
18243  INTEGER(INTG), INTENT(OUT) :: ERR
18244  TYPE(varying_string), INTENT(OUT) :: ERROR
18245  !Local Variables
18246  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
18247  TYPE(newton_linesearch_solver_type), POINTER :: LINESEARCH_SOLVER
18248  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
18249  TYPE(varying_string) :: LOCAL_ERROR
18250 
18251  enters("SOLVER_NEWTON_LINESEARCH_ALPHA_SET",err,error,*999)
18252 
18253  IF(ASSOCIATED(solver)) THEN
18254  IF(solver%SOLVER_FINISHED) THEN
18255  CALL flagerror("Solver has already been finished.",err,error,*999)
18256  ELSE
18257  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
18258  nonlinear_solver=>solver%NONLINEAR_SOLVER
18259  IF(ASSOCIATED(nonlinear_solver)) THEN
18260  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
18261  newton_solver=>nonlinear_solver%NEWTON_SOLVER
18262  IF(ASSOCIATED(newton_solver)) THEN
18263  IF(newton_solver%NEWTON_SOLVE_TYPE==solver_newton_linesearch) THEN
18264  linesearch_solver=>newton_solver%LINESEARCH_SOLVER
18265  IF(ASSOCIATED(linesearch_solver)) THEN
18266  IF(linesearch_alpha>zero_tolerance) THEN
18267  linesearch_solver%LINESEARCH_ALPHA=linesearch_alpha
18268  ELSE
18269  local_error="The specified line search alpha of "//trim(numbertovstring(linesearch_alpha,"*",err,error))// &
18270  & " is invalid. The line search alpha must be > 0."
18271  CALL flagerror(local_error,err,error,*999)
18272  ENDIF
18273  ELSE
18274  CALL flagerror("The Newton solver line search solver is not associated.",err,error,*999)
18275  ENDIF
18276  ELSE
18277  CALL flagerror("The Newton solver is not a line search solver.",err,error,*999)
18278  ENDIF
18279  ELSE
18280  CALL flagerror("The nonlinear solver Newton solver is not associated.",err,error,*999)
18281  ENDIF
18282  ELSE
18283  CALL flagerror("The nonlinear solver is not a Newton solver.",err,error,*999)
18284  ENDIF
18285  ELSE
18286  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
18287  ENDIF
18288  ELSE
18289  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
18290  ENDIF
18291  ENDIF
18292  ELSE
18293  CALL flagerror("Solver is not associated.",err,error,*999)
18294  ENDIF
18295 
18296  exits("SOLVER_NEWTON_LINESEARCH_ALPHA_SET")
18297  RETURN
18298 999 errorsexits("SOLVER_NEWTON_LINESEARCH_ALPHA_SET",err,error)
18299  RETURN 1
18300 
18301  END SUBROUTINE solver_newton_linesearch_alpha_set
18302 
18303  !
18304  !================================================================================================================================
18305  !
18306 
18308  SUBROUTINE solver_newton_linesearch_create_finish(LINESEARCH_SOLVER,ERR,ERROR,*)
18309 
18310  !Argument variables
18311  TYPE(newton_linesearch_solver_type), POINTER :: LINESEARCH_SOLVER
18312  INTEGER(INTG), INTENT(OUT) :: ERR
18313  TYPE(varying_string), INTENT(OUT) :: ERROR
18314  !Local Variables
18315  EXTERNAL :: problem_solverjacobianevaluatepetsc
18316  EXTERNAL :: problem_solverjacobianfdcalculatepetsc
18317  EXTERNAL :: problem_solverresidualevaluatepetsc
18318  EXTERNAL :: problem_solverconvergencetestpetsc
18319  EXTERNAL :: problem_solvernonlinearmonitorpetsc
18320  INTEGER(INTG) :: equations_matrix_idx,equations_set_idx,interface_condition_idx,interface_matrix_idx
18321  TYPE(distributed_matrix_type), POINTER :: JACOBIAN_MATRIX
18322  TYPE(distributed_vector_type), POINTER :: RESIDUAL_VECTOR
18323  TYPE(equations_type), POINTER :: EQUATIONS
18324  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
18325  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
18326  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
18327  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
18328  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
18329  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
18330  TYPE(field_type), POINTER :: DEPENDENT_FIELD,LAGRANGE_FIELD
18331  TYPE(field_variable_type), POINTER :: LINEAR_VARIABLE,INTERFACE_VARIABLE,LAGRANGE_VARIABLE
18332  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
18333  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
18334  TYPE(solver_type), POINTER :: LINEAR_SOLVER,SOLVER
18335  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
18336  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
18337  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
18338  TYPE(solver_matrix_type), POINTER :: SOLVER_JACOBIAN
18339  TYPE(interface_condition_type), POINTER :: INTERFACE_CONDITION
18340  TYPE(interface_equations_type), POINTER :: INTERFACE_EQUATIONS
18341  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
18342  TYPE(interface_matrices_type), POINTER :: INTERFACE_MATRICES
18343  TYPE(interface_matrix_type), POINTER :: INTERFACE_MATRIX
18344 
18345  TYPE(varying_string) :: LOCAL_ERROR
18346 
18347  enters("SOLVER_NEWTON_LINESEARCH_CREATE_FINISH",err,error,*999)
18348 
18349  IF(ASSOCIATED(linesearch_solver)) THEN
18350  newton_solver=>linesearch_solver%NEWTON_SOLVER
18351  IF(ASSOCIATED(newton_solver)) THEN
18352  nonlinear_solver=>newton_solver%NONLINEAR_SOLVER
18353  IF(ASSOCIATED(nonlinear_solver)) THEN
18354  solver=>nonlinear_solver%SOLVER
18355  IF(ASSOCIATED(solver)) THEN
18356  solver_equations=>solver%SOLVER_EQUATIONS
18357  IF(ASSOCIATED(solver_equations)) THEN
18358  SELECT CASE(linesearch_solver%SOLVER_LIBRARY)
18359  CASE(solver_cmiss_library)
18360  CALL flagerror("Not implemented.",err,error,*999)
18361  CASE(solver_petsc_library)
18362  solver_mapping=>solver_equations%SOLVER_MAPPING
18363  IF(ASSOCIATED(solver_mapping)) THEN
18364  !Loop over the equations set in the solver equations
18365  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
18366  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)%EQUATIONS
18367  IF(ASSOCIATED(equations)) THEN
18368  equations_set=>equations%EQUATIONS_SET
18369  IF(ASSOCIATED(equations_set)) THEN
18370  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
18371  IF(ASSOCIATED(dependent_field)) THEN
18372  equations_mapping=>equations%EQUATIONS_MAPPING
18373  IF(ASSOCIATED(equations_mapping)) THEN
18374  linear_mapping=>equations_mapping%LINEAR_MAPPING
18375  IF(ASSOCIATED(linear_mapping)) THEN
18376  !If there are any linear matrices create temporary vector for matrix-vector products
18377  equations_matrices=>equations%EQUATIONS_MATRICES
18378  IF(ASSOCIATED(equations_matrices)) THEN
18379  linear_matrices=>equations_matrices%LINEAR_MATRICES
18380  IF(ASSOCIATED(linear_matrices)) THEN
18381  DO equations_matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
18382  equations_matrix=>linear_matrices%MATRICES(equations_matrix_idx)%PTR
18383  IF(ASSOCIATED(equations_matrix)) THEN
18384  IF(.NOT.ASSOCIATED(equations_matrix%TEMP_VECTOR)) THEN
18385  linear_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(equations_matrix_idx)%VARIABLE
18386  IF(ASSOCIATED(linear_variable)) THEN
18387  CALL distributed_vector_create_start(linear_variable%DOMAIN_MAPPING, &
18388  & equations_matrix%TEMP_VECTOR,err,error,*999)
18389  CALL distributed_vector_data_type_set(equations_matrix%TEMP_VECTOR, &
18390  & distributed_matrix_vector_dp_type,err,error,*999)
18391  CALL distributed_vector_create_finish(equations_matrix%TEMP_VECTOR,err,error,*999)
18392  ELSE
18393  CALL flagerror("Linear mapping linear variable is not associated.",err,error,*999)
18394  ENDIF
18395  ENDIF
18396  ELSE
18397  CALL flagerror("Equations matrix is not associated.",err,error,*999)
18398  ENDIF
18399  ENDDO !equations_matrix_idx
18400  ELSE
18401  CALL flagerror("Equations matrices linear matrices is not associated.",err,error,*999)
18402  ENDIF
18403  ELSE
18404  CALL flagerror("Equations equations matrices is not associated.",err,error,*999)
18405  ENDIF
18406  ENDIF
18407  ELSE
18408  CALL flagerror("Equations equations mapping is not associated.",err,error,*999)
18409  ENDIF
18410  ELSE
18411  local_error="Equations set dependent field is not associated for equations set index "// &
18412  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
18413  CALL flagerror(local_error,err,error,*999)
18414  ENDIF
18415  ELSE
18416  local_error="Equations equations set is not associated for equations set index "// &
18417  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
18418  CALL flagerror(local_error,err,error,*999)
18419  ENDIF
18420  ELSE
18421  local_error="Equations is not associated for equations set index "// &
18422  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
18423  CALL flagerror(local_error,err,error,*999)
18424  ENDIF
18425  ENDDO !equations_set_idx
18426  !Loop over the interface conditions
18427  DO interface_condition_idx=1,solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS
18428  interface_condition=>solver_mapping%INTERFACE_CONDITIONS(interface_condition_idx)%PTR
18429  IF(ASSOCIATED(interface_condition)) THEN
18430  lagrange_field=>interface_condition%LAGRANGE%LAGRANGE_FIELD
18431  IF(ASSOCIATED(lagrange_field)) THEN
18432  interface_equations=>interface_condition%INTERFACE_EQUATIONS
18433  IF(ASSOCIATED(interface_equations)) THEN
18434  interface_matrices=>interface_equations%INTERFACE_MATRICES
18435  IF(ASSOCIATED(interface_matrices)) THEN
18436  interface_mapping=>interface_equations%INTERFACE_MAPPING
18437  IF(ASSOCIATED(interface_mapping)) THEN
18438  lagrange_variable=>interface_mapping%LAGRANGE_VARIABLE
18439  IF(ASSOCIATED(lagrange_variable)) THEN
18440  !Create temporary vector for matrix-vector products
18441  DO interface_matrix_idx=1,interface_mapping%NUMBER_OF_INTERFACE_MATRICES
18442  interface_matrix=>interface_matrices%MATRICES(interface_matrix_idx)%PTR
18443  IF(ASSOCIATED(interface_matrix)) THEN
18444  IF(.NOT.ASSOCIATED(interface_matrix%TEMP_VECTOR)) THEN
18445  interface_variable=>interface_mapping% &
18446  & interface_matrix_rows_to_var_maps(interface_matrix_idx)%VARIABLE
18447  IF(ASSOCIATED(interface_variable)) THEN
18448  !Set up the temporary interface distributed vector to be used with interface matrices
18449  CALL distributed_vector_create_start(interface_variable%DOMAIN_MAPPING, &
18450  & interface_matrix%TEMP_VECTOR,err,error,*999)
18451  CALL distributed_vector_data_type_set(interface_matrix%TEMP_VECTOR, &
18452  & distributed_matrix_vector_dp_type,err,error,*999)
18453  CALL distributed_vector_create_finish(interface_matrix%TEMP_VECTOR,err,error,*999)
18454  !Set up the temporary interface distributed vector to be used with transposed interface matrices
18455  CALL distributed_vector_create_start(lagrange_variable%DOMAIN_MAPPING, &
18456  & interface_matrix%TEMP_TRANSPOSE_VECTOR,err,error,*999)
18457  CALL distributed_vector_data_type_set(interface_matrix%TEMP_TRANSPOSE_VECTOR, &
18458  & distributed_matrix_vector_dp_type,err,error,*999)
18459  CALL distributed_vector_create_finish(interface_matrix%TEMP_TRANSPOSE_VECTOR, &
18460  & err,error,*999)
18461  ELSE
18462  CALL flagerror("Interface mapping variable is not associated.",err,error,*999)
18463  ENDIF
18464  ENDIF
18465  ELSE
18466  CALL flagerror("Interface matrix is not associated.",err,error,*999)
18467  ENDIF
18468  ENDDO !interface_matrix_idx
18469  ELSE
18470  CALL flagerror("Interface matrix is not associated.",err,error,*999)
18471  ENDIF
18472  ELSE
18473  CALL flagerror("interface condition mapping is not associated.",err,error,*999)
18474  ENDIF
18475  ELSE
18476  CALL flagerror("Interface matrices is not associated.",err,error,*999)
18477  ENDIF
18478  ELSE
18479  local_error="Interface eqauations is not associated for interface condition index "// &
18480  & trim(numbertovstring(interface_condition_idx,"*",err,error))//"."
18481  CALL flagerror(local_error,err,error,*999)
18482  ENDIF
18483  ELSE
18484  local_error="Interface condition Lagrange field is not associated for interface condition "// &
18485  & trim(numbertovstring(interface_condition_idx,"*",err,error))//"."
18486  CALL flagerror(local_error,err,error,*999)
18487  ENDIF
18488  ELSE
18489  local_error="Interface condition is not associated for interface condition index "// &
18490  & trim(numbertovstring(interface_condition_idx,"*",err,error))//"."
18491  CALL flagerror(local_error,err,error,*999)
18492  ENDIF
18493  ENDDO !interface_idx
18494  !Create the PETSc SNES solver
18495  CALL petsc_snescreate(computational_environment%MPI_COMM,linesearch_solver%snes,err,error,*999)
18496  !Set the nonlinear solver type to be a Newton line search solver
18497  CALL petsc_snessettype(linesearch_solver%snes,petsc_snesnewtonls,err,error,*999)
18498 
18499  !Create the solver matrices and vectors
18500  linear_solver=>newton_solver%LINEAR_SOLVER
18501  IF(ASSOCIATED(linear_solver)) THEN
18502  NULLIFY(solver_matrices)
18503  CALL solver_matrices_create_start(solver_equations,solver_matrices,err,error,*999)
18504  CALL solver_matrices_library_type_set(solver_matrices,solver_petsc_library,err,error,*999)
18505  SELECT CASE(solver_equations%SPARSITY_TYPE)
18506  CASE(solver_sparse_matrices)
18507  CALL solver_matrices_storage_type_set(solver_matrices,[distributed_matrix_compressed_row_storage_type], &
18508  & err,error,*999)
18509  CASE(solver_full_matrices)
18510  CALL solver_matrices_storage_type_set(solver_matrices,[distributed_matrix_block_storage_type], &
18511  & err,error,*999)
18512  CASE DEFAULT
18513  local_error="The specified solver equations sparsity type of "// &
18514  & trim(numbertovstring(solver_equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
18515  CALL flagerror(local_error,err,error,*999)
18516  END SELECT
18517  CALL solver_matrices_create_finish(solver_matrices,err,error,*999)
18518  !Link linear solver
18519  linear_solver%SOLVER_EQUATIONS=>solver%SOLVER_EQUATIONS
18520  !Finish the creation of the linear solver
18521  CALL solver_linear_create_finish(linear_solver%LINEAR_SOLVER,err,error,*999)
18522  !Associate linear solver's KSP to nonlinear solver's SNES
18523  SELECT CASE(linear_solver%LINEAR_SOLVER%LINEAR_SOLVE_TYPE)
18524  CASE(solver_linear_direct_solve_type)
18525  CALL petsc_snessetksp(linesearch_solver%snes,linear_solver%linear_solver%direct_solver%ksp,err,error,*999)
18526  CASE(solver_linear_iterative_solve_type)
18527  CALL petsc_snessetksp(linesearch_solver%snes,linear_solver%linear_solver%iterative_solver%ksp,err,error,*999)
18528  END SELECT
18529 
18530  !Set the nonlinear function
18531  residual_vector=>solver_matrices%RESIDUAL
18532  IF(ASSOCIATED(residual_vector)) THEN
18533  IF(ASSOCIATED(residual_vector%PETSC)) THEN
18534  !Set the solver as a context for the SNES object
18535  CALL petsc_snessetapplicationcontext(linesearch_solver%snes,linesearch_solver%NEWTON_SOLVER% &
18536  & nonlinear_solver%SOLVER,err,error,*999)
18537  !Pass the linesearch solver object rather than the temporary solver
18538  CALL petsc_snessetfunction(linesearch_solver%snes,residual_vector%PETSC%VECTOR, &
18539  & problem_solverresidualevaluatepetsc,linesearch_solver%NEWTON_SOLVER%NONLINEAR_SOLVER%SOLVER, &
18540  & err,error,*999)
18541  SELECT CASE(linesearch_solver%NEWTON_SOLVER%convergenceTestType)
18542  CASE(solver_newton_convergence_petsc_default)
18543  !Default convergence test, do nothing
18544  CASE(solver_newton_convergence_energy_norm,solver_newton_convergence_differentiated_ratio)
18545  CALL petsc_snessetconvergencetest(linesearch_solver%snes,problem_solverconvergencetestpetsc, &
18546  & linesearch_solver%NEWTON_SOLVER%NONLINEAR_SOLVER%SOLVER,err,error,*999)
18547  CASE DEFAULT
18548  local_error="The specified convergence test type of "//trim(numbertovstring(linesearch_solver% &
18549  & newton_solver%convergenceTestType,"*",err,error))//" is invalid."
18550  CALL flagerror(local_error,err,error,*999)
18551  END SELECT
18552  ELSE
18553  CALL flagerror("The residual vector PETSc is not associated.",err,error,*999)
18554  ENDIF
18555  ELSE
18556  CALL flagerror("Solver matrices residual vector is not associated.",err,error,*999)
18557  ENDIF
18558 
18559  !Set the Jacobian
18560  IF(solver_matrices%NUMBER_OF_MATRICES==1) THEN
18561  solver_jacobian=>solver_matrices%MATRICES(1)%PTR
18562  IF(ASSOCIATED(solver_jacobian)) THEN
18563  jacobian_matrix=>solver_jacobian%MATRIX
18564  IF(ASSOCIATED(jacobian_matrix)) THEN
18565  IF(ASSOCIATED(jacobian_matrix%PETSC)) THEN
18566  SELECT CASE(newton_solver%JACOBIAN_CALCULATION_TYPE)
18567  CASE(solver_newton_jacobian_not_calculated)
18568  CALL flagerror("Cannot have no Jacobian calculation for a PETSc nonlinear linesearch solver.", &
18569  & err,error,*999)
18570  CASE(solver_newton_jacobian_equations_calculated)
18571  solver_jacobian%UPDATE_MATRIX=.true. !CMISS will fill in the Jacobian values
18572  !Pass the linesearch solver object rather than the temporary solver
18573  CALL petsc_snessetjacobian(linesearch_solver%snes,jacobian_matrix%PETSC%MATRIX, &
18574  & jacobian_matrix%PETSC%MATRIX,problem_solverjacobianevaluatepetsc, &
18575  & linesearch_solver%NEWTON_SOLVER%NONLINEAR_SOLVER%SOLVER,err,error,*999)
18576  CASE(solver_newton_jacobian_fd_calculated)
18577  solver_jacobian%UPDATE_MATRIX=.false. !Petsc will fill in the Jacobian values
18578  CALL distributed_matrix_form(jacobian_matrix,err,error,*999)
18579  SELECT CASE(solver_equations%SPARSITY_TYPE)
18580  CASE(solver_sparse_matrices)
18581  CALL petsc_matcoloringcreate(jacobian_matrix%petsc%matrix,linesearch_solver%jacobianMatColoring, &
18582  & err,error,*999)
18583  CALL petsc_matcoloringsettype(linesearch_solver%jacobianMatColoring,petsc_matcoloring_sl, &
18584  & err,error,*999)
18585  CALL petsc_matcoloringsetfromoptions(linesearch_solver%jacobianMatColoring,err,error,*999)
18586  CALL petsc_matcoloringapply(linesearch_solver%jacobianMatColoring,linesearch_solver% &
18587  & jacobianiscoloring,err,error,*999)
18588  CALL petsc_matcoloringdestroy(linesearch_solver%jacobianMatColoring,err,error,*999)
18589  !Compute SNESComputeJacobianDefaultColor data structure
18590  CALL petsc_matfdcoloringcreate(jacobian_matrix%petsc%matrix,linesearch_solver%jacobianISColoring, &
18591  & linesearch_solver%jacobianMatFDColoring,err,error,*999)
18592  !Pass the linesearch solver object rather than the temporary solver
18593  CALL petsc_matfdcoloringsetfunction(linesearch_solver%jacobianMatFDColoring, &
18594  & problem_solverresidualevaluatepetsc,linesearch_solver%NEWTON_SOLVER%NONLINEAR_SOLVER% &
18595  & solver,err,error,*999)
18596  CALL petsc_matfdcoloringsetfromoptions(linesearch_solver%jacobianMatFDColoring,err,error,*999)
18597  CALL petsc_matfdcoloringsetup(jacobian_matrix%petsc%matrix,linesearch_solver%jacobianISColoring, &
18598  & linesearch_solver%jacobianMatFDColoring,err,error,*999)
18599  CALL petsc_iscoloringdestroy(linesearch_solver%jacobianISColoring,err,error,*999)
18600  CASE(solver_full_matrices)
18601  !Do nothing
18602  CASE DEFAULT
18603  local_error="The specified solver equations sparsity type of "// &
18604  & trim(numbertovstring(solver_equations%SPARSITY_TYPE,"*",err,error))//" is invalid."
18605  CALL flagerror(local_error,err,error,*999)
18606  END SELECT
18607  CALL petsc_snessetjacobian(linesearch_solver%snes,jacobian_matrix%petsc%matrix, &
18608  & jacobian_matrix%petsc%matrix,problem_solverjacobianfdcalculatepetsc,linesearch_solver% &
18609  & newton_solver%NONLINEAR_SOLVER%SOLVER,err,error,*999)
18610  CASE DEFAULT
18611  local_error="The Jacobian calculation type of "// &
18612  & trim(numbertovstring(newton_solver%JACOBIAN_CALCULATION_TYPE,"*",err,error))// &
18613  & " is invalid."
18614  CALL flagerror(local_error,err,error,*999)
18615  END SELECT
18616  ELSE
18617  CALL flagerror("Jacobian matrix PETSc is not associated.",err,error,*999)
18618  ENDIF
18619  ELSE
18620  CALL flagerror("Solver Jacobian matrix is not associated.",err,error,*999)
18621  ENDIF
18622  ELSE
18623  CALL flagerror("The solver Jacobian is not associated.",err,error,*999)
18624  ENDIF
18625  ELSE
18626  local_error="Invalid number of solver matrices. The number of solver matrices is "// &
18627  & trim(numbertovstring(solver_matrices%NUMBER_OF_MATRICES,"*",err,error))//" and it should be 1."
18628  CALL flagerror(local_error,err,error,*999)
18629  ENDIF
18630  IF(solver%OUTPUT_TYPE>=solver_progress_output) THEN
18631  !Set the monitor
18632  !Pass the linesearch solver object rather than the temporary solver
18633  CALL petsc_snesmonitorset(linesearch_solver%snes,problem_solvernonlinearmonitorpetsc, &
18634  & linesearch_solver%NEWTON_SOLVER%NONLINEAR_SOLVER%SOLVER,err,error,*999)
18635  ENDIF
18636  CALL petsc_snesgetlinesearch(linesearch_solver%snes,linesearch_solver%snesLineSearch,err,error,*999)
18637  !Set the line search type and order where applicable
18638  SELECT CASE(linesearch_solver%linesearch_type)
18639  CASE(solver_newton_linesearch_nonorms)
18640  CALL petsc_sneslinesearchsettype(linesearch_solver%snesLineSearch,petsc_snes_linesearch_basic,err,error,*999)
18641  CALL petsc_sneslinesearchsetcomputenorms(linesearch_solver%snesLineSearch,.false.,err,error,*999)
18642  CASE(solver_newton_linesearch_linear)
18643  CALL petsc_sneslinesearchsettype(linesearch_solver%snesLineSearch,petsc_snes_linesearch_cp,err,error,*999)
18644  CALL petsc_sneslinesearchsetorder(linesearch_solver%snesLineSearch,petsc_snes_linesearch_order_linear, &
18645  & err,error,*999)
18646  CASE(solver_newton_linesearch_quadratic)
18647  CALL petsc_sneslinesearchsettype(linesearch_solver%snesLineSearch,petsc_snes_linesearch_bt,err,error,*999)
18648  CALL petsc_sneslinesearchsetorder(linesearch_solver%snesLineSearch,petsc_snes_linesearch_order_quadratic, &
18649  & err,error,*999)
18650  CASE(solver_newton_linesearch_cubic)
18651  CALL petsc_sneslinesearchsettype(linesearch_solver%snesLineSearch,petsc_snes_linesearch_bt,err,error,*999)
18652  CALL petsc_sneslinesearchsetorder(linesearch_solver%snesLineSearch,petsc_snes_linesearch_order_cubic, &
18653  & err,error,*999)
18654  CASE DEFAULT
18655  local_error="The nonlinear Newton line search type of "// &
18656  & trim(numbertovstring(linesearch_solver%linesearch_type,"*",err,error))//" is invalid."
18657  CALL flagerror(local_error,err,error,*999)
18658  END SELECT
18659  SELECT CASE(linesearch_solver%linesearch_type)
18660  CASE(solver_newton_linesearch_quadratic,solver_newton_linesearch_cubic)
18661  ! Alpha parameter only applicable for back-tracking linesearch
18662  CALL petsc_sneslinesearchbtsetalpha(linesearch_solver%snesLineSearch,linesearch_solver%LINESEARCH_ALPHA, &
18663  & err,error,*999)
18664  END SELECT
18665  !Set step tolerances, leave iterative line search options as defaults.
18666 !!TODO: set the rtol, atol, ltol and maxits properly.
18667  CALL petsc_sneslinesearchsettolerances(linesearch_solver%snesLineSearch, &
18668  & linesearch_solver%LINESEARCH_STEPTOLERANCE,linesearch_solver%LINESEARCH_MAXSTEP, &
18669  & petsc_default_real,petsc_default_real,petsc_default_real,petsc_default_integer,err,error,*999)
18670  IF(linesearch_solver%linesearchMonitorOutput) THEN
18671  CALL petsc_sneslinesearchsetmonitor(linesearch_solver%snesLineSearch,petsc_true,err,error,*999)
18672  ELSE
18673  CALL petsc_sneslinesearchsetmonitor(linesearch_solver%snesLineSearch,petsc_false,err,error,*999)
18674  ENDIF
18675  !Set the tolerances for the SNES solver
18676  CALL petsc_snessettolerances(linesearch_solver%snes,newton_solver%ABSOLUTE_TOLERANCE, &
18677  & newton_solver%RELATIVE_TOLERANCE,newton_solver%SOLUTION_TOLERANCE, &
18678  & newton_solver%MAXIMUM_NUMBER_OF_ITERATIONS, &
18679  & newton_solver%MAXIMUM_NUMBER_OF_FUNCTION_EVALUATIONS,err,error,*999)
18680  !Set any further SNES options from the command line options
18681  CALL petsc_snessetfromoptions(linesearch_solver%snes,err,error,*999)
18682  ELSE
18683  CALL flagerror("Newton linesearch solver linear solver is not associated.",err,error,*999)
18684  ENDIF
18685  ELSE
18686  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
18687  ENDIF
18688  CASE DEFAULT
18689  local_error="The solver library type of "// &
18690  & trim(numbertovstring(linesearch_solver%SOLVER_LIBRARY,"*",err,error))//" is invalid."
18691  CALL flagerror(local_error,err,error,*999)
18692  END SELECT
18693  ELSE
18694  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
18695  ENDIF
18696  ELSE
18697  CALL flagerror("Nonlinear solver solver is not associated.",err,error,*999)
18698  ENDIF
18699  ELSE
18700  CALL flagerror("Newton solver nonlinear solver is not associated.",err,error,*999)
18701  ENDIF
18702  ELSE
18703  CALL flagerror("Linesearch solver Newton solver is not associated.",err,error,*999)
18704  ENDIF
18705  ELSE
18706  CALL flagerror("Line search solver is not associated.",err,error,*999)
18707  ENDIF
18708 
18709  exits("SOLVER_NEWTON_LINESEARCH_CREATE_FINISH")
18710  RETURN
18711 999 errorsexits("SOLVER_NEWTON_LINESEARCH_CREATE_FINISH",err,error)
18712  RETURN 1
18713 
18714  END SUBROUTINE solver_newton_linesearch_create_finish
18715 
18716  !
18717  !================================================================================================================================
18718  !
18719 
18721  SUBROUTINE solver_newton_linesearch_finalise(LINESEARCH_SOLVER,ERR,ERROR,*)
18722 
18723  !Argument variables
18724  TYPE(newton_linesearch_solver_type), POINTER :: LINESEARCH_SOLVER
18725  INTEGER(INTG), INTENT(OUT) :: ERR
18726  TYPE(varying_string), INTENT(OUT) :: ERROR
18727  !Local Variables
18728 
18729  enters("SOLVER_NEWTON_LINESEARCH_FINALISE",err,error,*999)
18730 
18731  IF(ASSOCIATED(linesearch_solver)) THEN
18732  CALL petsc_matcoloringfinalise(linesearch_solver%jacobianMatColoring,err,error,*999)
18733  CALL petsc_iscoloringfinalise(linesearch_solver%jacobianISColoring,err,error,*999)
18734  CALL petsc_matfdcoloringfinalise(linesearch_solver%jacobianMatFDColoring,err,error,*999)
18735  CALL petsc_sneslinesearchfinalise(linesearch_solver%snesLineSearch,err,error,*999)
18736  CALL petsc_snesfinalise(linesearch_solver%snes,err,error,*999)
18737  DEALLOCATE(linesearch_solver)
18738  ENDIF
18739 
18740  exits("SOLVER_NEWTON_LINESEARCH_FINALISE")
18741  RETURN
18742 999 errorsexits("SOLVER_NEWTON_LINESEARCH_FINALISE",err,error)
18743  RETURN 1
18744 
18745  END SUBROUTINE solver_newton_linesearch_finalise
18746 
18747  !
18748  !================================================================================================================================
18749  !
18750 
18752  SUBROUTINE solver_newton_linesearch_initialise(NEWTON_SOLVER,ERR,ERROR,*)
18753 
18754  !Argument variables
18755  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
18756  INTEGER(INTG), INTENT(OUT) :: ERR
18757  TYPE(varying_string), INTENT(OUT) :: ERROR
18758  !Local Variables
18759  INTEGER(INTG) :: DUMMY_ERR
18760  TYPE(varying_string) :: DUMMY_ERROR
18761 
18762  enters("SOLVER_NEWTON_LINESEARCH_INITIALISE",err,error,*998)
18763 
18764  IF(ASSOCIATED(newton_solver)) THEN
18765  IF(ASSOCIATED(newton_solver%LINESEARCH_SOLVER)) THEN
18766  CALL flagerror("Netwon line search solver is already associated for this Newton solver.",err,error,*998)
18767  ELSE
18768  !Allocate and initialise the Newton linesearch solver
18769  ALLOCATE(newton_solver%LINESEARCH_SOLVER,stat=err)
18770  IF(err/=0) CALL flagerror("Could not allocate nonlinear solver Newton line search solver.",err,error,*999)
18771  newton_solver%LINESEARCH_SOLVER%NEWTON_SOLVER=>newton_solver
18772  newton_solver%LINESEARCH_SOLVER%SOLVER_LIBRARY=solver_petsc_library
18773  newton_solver%LINESEARCH_SOLVER%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
18774  newton_solver%LINESEARCH_SOLVER%LINESEARCH_TYPE=solver_newton_linesearch_cubic
18775  newton_solver%LINESEARCH_SOLVER%LINESEARCH_ALPHA=0.0001_dp
18776  newton_solver%LINESEARCH_SOLVER%LINESEARCH_MAXSTEP=1.0e8_dp
18777  newton_solver%LINESEARCH_SOLVER%LINESEARCH_STEPTOLERANCE=convergence_tolerance
18778  CALL petsc_matcoloringinitialise(newton_solver%LINESEARCH_SOLVER%jacobianMatColoring,err,error,*999)
18779  CALL petsc_iscoloringinitialise(newton_solver%LINESEARCH_SOLVER%jacobianISColoring,err,error,*999)
18780  CALL petsc_matfdcoloringinitialise(newton_solver%LINESEARCH_SOLVER%jacobianMatFDColoring,err,error,*999)
18781  CALL petsc_snesinitialise(newton_solver%LINESEARCH_SOLVER%snes,err,error,*999)
18782  CALL petsc_sneslinesearchinitialise(newton_solver%LINESEARCH_SOLVER%snesLineSearch,err,error,*999)
18783  newton_solver%LINESEARCH_SOLVER%linesearchMonitorOutput=.false.
18784  ENDIF
18785  ELSE
18786  CALL flagerror("Newton solver is not associated.",err,error,*998)
18787  ENDIF
18788 
18789  exits("SOLVER_NEWTON_LINESEARCH_INITIALISE")
18790  RETURN
18791 999 CALL solver_newton_linesearch_finalise(newton_solver%LINESEARCH_SOLVER,dummy_err,dummy_error,*998)
18792 998 errorsexits("SOLVER_NEWTON_LINESEARCH_INITIALISE",err,error)
18793  RETURN 1
18794 
18795  END SUBROUTINE solver_newton_linesearch_initialise
18796 
18797  !
18798  !================================================================================================================================
18799  !
18800 
18802  SUBROUTINE solver_newton_linesearch_maxstep_set(SOLVER,LINESEARCH_MAXSTEP,ERR,ERROR,*)
18803 
18804  !Argument variables
18805  TYPE(solver_type), POINTER :: SOLVER
18806  REAL(DP), INTENT(IN) :: LINESEARCH_MAXSTEP
18807  INTEGER(INTG), INTENT(OUT) :: ERR
18808  TYPE(varying_string), INTENT(OUT) :: ERROR
18809  !Local Variables
18810  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
18811  TYPE(newton_linesearch_solver_type), POINTER :: LINESEARCH_SOLVER
18812  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
18813  TYPE(varying_string) :: LOCAL_ERROR
18814 
18815  enters("SOLVER_NEWTON_LINESEARCH_MAXSTEP_SET",err,error,*999)
18816 
18817  IF(ASSOCIATED(solver)) THEN
18818  IF(solver%SOLVER_FINISHED) THEN
18819  CALL flagerror("Solver has already been finished.",err,error,*999)
18820  ELSE
18821  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
18822  nonlinear_solver=>solver%NONLINEAR_SOLVER
18823  IF(ASSOCIATED(nonlinear_solver)) THEN
18824  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
18825  newton_solver=>nonlinear_solver%NEWTON_SOLVER
18826  IF(ASSOCIATED(newton_solver)) THEN
18827  IF(newton_solver%NEWTON_SOLVE_TYPE==solver_newton_linesearch) THEN
18828  linesearch_solver=>newton_solver%LINESEARCH_SOLVER
18829  IF(ASSOCIATED(linesearch_solver)) THEN
18830  IF(linesearch_maxstep>zero_tolerance) THEN
18831  linesearch_solver%LINESEARCH_MAXSTEP=linesearch_maxstep
18832  ELSE
18833  local_error="The specified line search maximum step of "// &
18834  & trim(numbertovstring(linesearch_maxstep,"*",err,error))// &
18835  & " is invalid. The line search maximum step must be > 0."
18836  CALL flagerror(local_error,err,error,*999)
18837  ENDIF
18838  ELSE
18839  CALL flagerror("The Newton solver line search solver is not associated.",err,error,*999)
18840  ENDIF
18841  ELSE
18842  CALL flagerror("The Newton solver is not a line search solver.",err,error,*999)
18843  ENDIF
18844  ELSE
18845  CALL flagerror("The nonlinear solver Newton solver is not associated.",err,error,*999)
18846  ENDIF
18847  ELSE
18848  CALL flagerror("The nonlinear solver is not a Newton solver.",err,error,*999)
18849  ENDIF
18850  ELSE
18851  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
18852  ENDIF
18853  ELSE
18854  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
18855  ENDIF
18856  ENDIF
18857  ELSE
18858  CALL flagerror("Solver is not associated.",err,error,*999)
18859  ENDIF
18860 
18861  exits("SOLVER_NEWTON_LINESEARCH_MAXSTEP_SET")
18862  RETURN
18863 999 errorsexits("SOLVER_NEWTON_LINESEARCH_MAXSTEP_SET",err,error)
18864  RETURN 1
18865 
18866  END SUBROUTINE solver_newton_linesearch_maxstep_set
18867 
18868  !
18869  !================================================================================================================================
18870  !
18871 
18872  !Solves a nonlinear Newton line search solver
18873  SUBROUTINE solver_newton_linesearch_solve(LINESEARCH_SOLVER,ERR,ERROR,*)
18874 
18875  !Argument variables
18876  TYPE(newton_linesearch_solver_type), POINTER :: LINESEARCH_SOLVER
18877  INTEGER(INTG), INTENT(OUT) :: ERR
18878  TYPE(varying_string), INTENT(OUT) :: ERROR
18879  !Local Variables
18880  INTEGER(INTG) :: CONVERGED_REASON,NUMBER_ITERATIONS
18881  REAL(DP) :: FUNCTION_NORM
18882  TYPE(distributed_vector_type), POINTER :: RHS_VECTOR,SOLVER_VECTOR
18883  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
18884  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
18885  TYPE(petscvectype) :: FUNCTION_VECTOR
18886  TYPE(solver_type), POINTER :: SOLVER
18887  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
18888  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
18889  TYPE(varying_string) :: LOCAL_ERROR
18890 
18891  enters("SOLVER_NEWTON_LINESEARCH_SOLVE",err,error,*999)
18892 
18893  IF(ASSOCIATED(linesearch_solver)) THEN
18894  newton_solver=>linesearch_solver%NEWTON_SOLVER
18895  IF(ASSOCIATED(newton_solver)) THEN
18896  nonlinear_solver=>newton_solver%NONLINEAR_SOLVER
18897  IF(ASSOCIATED(nonlinear_solver)) THEN
18898  solver=>nonlinear_solver%SOLVER
18899  IF(ASSOCIATED(solver)) THEN
18900  solver_equations=>solver%SOLVER_EQUATIONS
18901  IF(ASSOCIATED(solver_equations)) THEN
18902  solver_matrices=>solver_equations%SOLVER_MATRICES
18903  IF(ASSOCIATED(solver_matrices)) THEN
18904  IF(solver_matrices%NUMBER_OF_MATRICES==1) THEN
18905  rhs_vector=>solver_matrices%RHS_VECTOR
18906  IF(ASSOCIATED(rhs_vector)) THEN
18907  solver_vector=>solver_matrices%MATRICES(1)%PTR%SOLVER_VECTOR
18908  IF(ASSOCIATED(solver_vector)) THEN
18909  SELECT CASE(linesearch_solver%SOLVER_LIBRARY)
18910  CASE(solver_cmiss_library)
18911  CALL flagerror("Not implemented.",err,error,*999)
18912  CASE(solver_petsc_library)
18913  SELECT CASE(newton_solver%SOLUTION_INITIALISE_TYPE)
18914  CASE(solver_solution_initialise_zero)
18915  !Zero the solution vector
18916  CALL distributed_vector_all_values_set(solver_vector,0.0_dp,err,error,*999)
18917  CASE(solver_solution_initialise_current_field)
18918  !Make sure the solver vector contains the current dependent field values
18919  CALL solver_solution_update(solver,err,error,*999)
18920  CASE(solver_solution_initialise_no_change)
18921  !Do nothing
18922  CASE DEFAULT
18923  local_error="The Newton solver solution initialise type of "// &
18924  & trim(numbertovstring(newton_solver%SOLUTION_INITIALISE_TYPE,"*",err,error))// &
18925  & " is invalid."
18926  CALL flagerror(local_error,err,error,*999)
18927  END SELECT
18928  !Solve the nonlinear equations
18929  CALL petsc_snessolve(linesearch_solver%snes,rhs_vector%PETSC%VECTOR,solver_vector%PETSC%VECTOR, &
18930  & err,error,*999)
18931  !Check for convergence
18932  CALL petsc_snesgetconvergedreason(linesearch_solver%snes,converged_reason,err,error,*999)
18933  SELECT CASE(converged_reason)
18934  CASE(petsc_snes_diverged_function_domain)
18935  CALL flagerror("Nonlinear line search solver did not converge. PETSc diverged function domain.", &
18936  & err,error,*999)
18937  CASE(petsc_snes_diverged_function_count)
18938  CALL flagerror("Nonlinear line search solver did not converge. PETSc diverged function count.", &
18939  & err,error,*999)
18940  CASE(petsc_snes_diverged_linear_solve)
18941  CALL flagerror("Nonlinear line search solver did not converge. PETSc diverged linear solve.", &
18942  & err,error,*999)
18943  CASE(petsc_snes_diverged_fnorm_nan)
18944  CALL flagerror("Nonlinear line search solver did not converge. PETSc diverged F Norm NaN.", &
18945  & err,error,*999)
18946  CASE(petsc_snes_diverged_max_it)
18947  CALL flagerror("Nonlinear line search solver did not converge. PETSc diverged maximum iterations.", &
18948  & err,error,*999)
18949  CASE(petsc_snes_diverged_line_search)
18950  CALL flagerror("Nonlinear line search solver did not converge. PETSc diverged line search.", &
18951  & err,error,*999)
18952  CASE(petsc_snes_diverged_local_min)
18953  CALL flagerror("Nonlinear line search solver did not converge. PETSc diverged local minimum.", &
18954  & err,error,*999)
18955  END SELECT
18956  IF(solver%OUTPUT_TYPE>=solver_solver_output) THEN
18957  !Output solution characteristics
18958  CALL write_string(general_output_type,"",err,error,*999)
18959  CALL write_string(general_output_type,"Newton linesearch solver parameters:",err,error,*999)
18960  CALL petsc_snesgetiterationnumber(linesearch_solver%snes,number_iterations,err,error,*999)
18961  CALL write_string_value(general_output_type,"Final number of iterations = ",number_iterations, &
18962  & err,error,*999)
18963  CALL petsc_snesgetfunction(linesearch_solver%snes,function_vector,err,error,*999)
18964  CALL petsc_vecnorm(function_vector,petsc_norm_2,function_norm,err,error,*999)
18965  CALL write_string_value(general_output_type,"Final function norm = ",function_norm, &
18966  & err,error,*999)
18967  SELECT CASE(converged_reason)
18968  CASE(petsc_snes_converged_fnorm_abs)
18969  CALL write_string(general_output_type,"Converged Reason = PETSc converged F Norm absolute.", &
18970  & err,error,*999)
18971  CASE(petsc_snes_converged_fnorm_relative)
18972  CALL write_string(general_output_type,"Converged Reason = PETSc converged F Norm relative.", &
18973  & err,error,*999)
18974  CASE(petsc_snes_converged_snorm_relative)
18975  CALL write_string(general_output_type,"Converged Reason = PETSc converged S Norm relative.", &
18976  & err,error,*999)
18977  CASE(petsc_snes_converged_its)
18978  CALL write_string(general_output_type,"Converged Reason = PETSc converged its.",err,error,*999)
18979  CASE(petsc_snes_converged_iterating)
18980  CALL write_string(general_output_type,"Converged Reason = PETSc converged iterating.",err,error,*999)
18981  END SELECT
18982  ENDIF
18983  CASE DEFAULT
18984  local_error="The Newton line search solver library type of "// &
18985  & trim(numbertovstring(linesearch_solver%SOLVER_LIBRARY,"*",err,error))//" is invalid."
18986  CALL flagerror(local_error,err,error,*999)
18987  END SELECT
18988  ELSE
18989  CALL flagerror("Solver vector is not associated.",err,error,*999)
18990  ENDIF
18991  ELSE
18992  CALL flagerror("Solver RHS vector is not associated.",err,error,*999)
18993  ENDIF
18994  ELSE
18995  local_error="The number of solver matrices of "// &
18996  & trim(numbertovstring(solver_matrices%NUMBER_OF_MATRICES,"*",err,error))// &
18997  & " is invalid. There should only be one solver matrix for a Newton linesearch solver."
18998  CALL flagerror(local_error,err,error,*999)
18999  ENDIF
19000  ELSE
19001  CALL flagerror("Solver matrices is not associated.",err,error,*999)
19002  ENDIF
19003  ELSE
19004  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
19005  ENDIF
19006  ELSE
19007  CALL flagerror("Nonlinear solver solver is not associated.",err,error,*999)
19008  ENDIF
19009  ELSE
19010  CALL flagerror("Newton solver nonlinear solver is not associated.",err,error,*999)
19011  ENDIF
19012  ELSE
19013  CALL flagerror("Linesearch solver Newton solver is not associated.",err,error,*999)
19014  ENDIF
19015  ELSE
19016  CALL flagerror("Linesearch solver is not associated.",err,error,*999)
19017  ENDIF
19018 
19019  exits("SOLVER_NEWTON_LINESEARCH_SOLVE")
19020  RETURN
19021 999 errorsexits("SOLVER_NEWTON_LINESEARCH_SOLVE",err,error)
19022  RETURN 1
19023 
19024  END SUBROUTINE solver_newton_linesearch_solve
19025 
19026  !
19027  !================================================================================================================================
19028  !
19029 
19031  SUBROUTINE solver_newton_linesearch_steptol_set(SOLVER,LINESEARCH_STEPTOL,ERR,ERROR,*)
19032 
19033  !Argument variables
19034  TYPE(solver_type), POINTER :: SOLVER
19035  REAL(DP), INTENT(IN) :: LINESEARCH_STEPTOL
19036  INTEGER(INTG), INTENT(OUT) :: ERR
19037  TYPE(varying_string), INTENT(OUT) :: ERROR
19038  !Local Variables
19039  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
19040  TYPE(newton_linesearch_solver_type), POINTER :: LINESEARCH_SOLVER
19041  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
19042  TYPE(varying_string) :: LOCAL_ERROR
19043 
19044  enters("SOLVER_NEWTON_LINESEARCH_STEPTOL_SET",err,error,*999)
19045 
19046  IF(ASSOCIATED(solver)) THEN
19047  IF(solver%SOLVER_FINISHED) THEN
19048  CALL flagerror("Solver has already been finished.",err,error,*999)
19049  ELSE
19050  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
19051  nonlinear_solver=>solver%NONLINEAR_SOLVER
19052  IF(ASSOCIATED(nonlinear_solver)) THEN
19053  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
19054  newton_solver=>nonlinear_solver%NEWTON_SOLVER
19055  IF(ASSOCIATED(newton_solver)) THEN
19056  IF(newton_solver%NEWTON_SOLVE_TYPE==solver_newton_linesearch) THEN
19057  linesearch_solver=>newton_solver%LINESEARCH_SOLVER
19058  IF(ASSOCIATED(linesearch_solver)) THEN
19059  IF(linesearch_steptol>zero_tolerance) THEN
19060  linesearch_solver%LINESEARCH_STEPTOLERANCE=linesearch_steptol
19061  ELSE
19062  local_error="The specified line search step tolerance of "// &
19063  & trim(numbertovstring(linesearch_steptol,"*",err,error))// &
19064  & " is invalid. The line search step tolerance must be > 0."
19065  CALL flagerror(local_error,err,error,*999)
19066  ENDIF
19067  ELSE
19068  CALL flagerror("The Newton solver line search solver is not associated.",err,error,*999)
19069  ENDIF
19070  ELSE
19071  CALL flagerror("The Newton solver is not a line search solver.",err,error,*999)
19072  ENDIF
19073  ELSE
19074  CALL flagerror("The nonlinear Newton solver is not associated.",err,error,*999)
19075  ENDIF
19076  ELSE
19077  CALL flagerror("The nonlinear solver is not a Newton solver.",err,error,*999)
19078  ENDIF
19079  ELSE
19080  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
19081  ENDIF
19082  ELSE
19083  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
19084  ENDIF
19085  ENDIF
19086  ELSE
19087  CALL flagerror("Solver is not associated.",err,error,*999)
19088  ENDIF
19089 
19090  exits("SOLVER_NEWTON_LINESEARCH_STEPTOL_SET")
19091  RETURN
19092 999 errorsexits("SOLVER_NEWTON_LINESEARCH_STEPTOL_SET",err,error)
19093  RETURN 1
19094 
19095  END SUBROUTINE solver_newton_linesearch_steptol_set
19096 
19097  !
19098  !================================================================================================================================
19099  !
19100 
19102  SUBROUTINE solver_newton_linesearch_type_set(SOLVER,LINESEARCH_TYPE,ERR,ERROR,*)
19103 
19104  !Argument variables
19105  TYPE(solver_type), POINTER :: SOLVER
19106  INTEGER(INTG), INTENT(IN) :: LINESEARCH_TYPE
19107  INTEGER(INTG), INTENT(OUT) :: ERR
19108  TYPE(varying_string), INTENT(OUT) :: ERROR
19109  !Local Variables
19110  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
19111  TYPE(newton_linesearch_solver_type), POINTER :: LINESEARCH_SOLVER
19112  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
19113  TYPE(varying_string) :: LOCAL_ERROR
19114 
19115  enters("SOLVER_NEWTON_LINESEARCH_TYPE_SET",err,error,*999)
19116 
19117  IF(ASSOCIATED(solver)) THEN
19118  IF(solver%SOLVER_FINISHED) THEN
19119  CALL flagerror("Solver has already been finished.",err,error,*999)
19120  ELSE
19121  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
19122  nonlinear_solver=>solver%NONLINEAR_SOLVER
19123  IF(ASSOCIATED(nonlinear_solver)) THEN
19124  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
19125  newton_solver=>nonlinear_solver%NEWTON_SOLVER
19126  IF(ASSOCIATED(newton_solver)) THEN
19127  IF(newton_solver%NEWTON_SOLVE_TYPE==solver_newton_linesearch) THEN
19128  linesearch_solver=>newton_solver%LINESEARCH_SOLVER
19129  IF(ASSOCIATED(linesearch_solver)) THEN
19130  SELECT CASE(linesearch_type)
19131  CASE(solver_newton_linesearch_nonorms)
19132  linesearch_solver%LINESEARCH_TYPE=solver_newton_linesearch_nonorms
19133  CASE(solver_newton_linesearch_linear)
19134  linesearch_solver%LINESEARCH_TYPE=solver_newton_linesearch_linear
19135  CASE(solver_newton_linesearch_quadratic)
19136  linesearch_solver%LINESEARCH_TYPE=solver_newton_linesearch_quadratic
19137  CASE(solver_newton_linesearch_cubic)
19138  linesearch_solver%LINESEARCH_TYPE=solver_newton_linesearch_cubic
19139  CASE DEFAULT
19140  local_error="The specified line search type of "//trim(numbertovstring(linesearch_type,"*",err,error))// &
19141  & " is invalid."
19142  CALL flagerror(local_error,err,error,*999)
19143  END SELECT
19144  ELSE
19145  CALL flagerror("The Newton solver line search solver is not associated.",err,error,*999)
19146  ENDIF
19147  ELSE
19148  CALL flagerror("The Newton solver is not a line search solver.",err,error,*999)
19149  ENDIF
19150  ELSE
19151  CALL flagerror("The nonlinear solver Newton solver is not associated.",err,error,*999)
19152  ENDIF
19153  ELSE
19154  CALL flagerror("The nonlinear solver is not a Newton solver.",err,error,*999)
19155  ENDIF
19156  ELSE
19157  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
19158  ENDIF
19159  ELSE
19160  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
19161  ENDIF
19162  ENDIF
19163  ELSE
19164  CALL flagerror("Solver is not associated.",err,error,*999)
19165  ENDIF
19166 
19167  exits("SOLVER_NEWTON_LINESEARCH_TYPE_SET")
19168  RETURN
19169 999 errorsexits("SOLVER_NEWTON_LINESEARCH_TYPE_SET",err,error)
19170  RETURN 1
19171 
19172  END SUBROUTINE solver_newton_linesearch_type_set
19173 
19174  !
19175  !================================================================================================================================
19176  !
19177 
19179  SUBROUTINE solver_newton_matrices_library_type_get(NEWTON_SOLVER,MATRICES_LIBRARY_TYPE,ERR,ERROR,*)
19180 
19181  !Argument variables
19182  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
19183  INTEGER(INTG), INTENT(OUT) :: MATRICES_LIBRARY_TYPE
19184  INTEGER(INTG), INTENT(OUT) :: ERR
19185  TYPE(varying_string), INTENT(OUT) :: ERROR
19186  !Local Variables
19187  TYPE(newton_linesearch_solver_type), POINTER :: LINESEARCH_SOLVER
19188  TYPE(newton_trustregion_solver_type), POINTER :: TRUSTREGION_SOLVER
19189  TYPE(varying_string) :: LOCAL_ERROR
19190 
19191  enters("SOLVER_NEWTON_LIBRARY_TYPE_GET",err,error,*999)
19192 
19193  IF(ASSOCIATED(newton_solver)) THEN
19194  SELECT CASE(newton_solver%NEWTON_SOLVE_TYPE)
19195  CASE(solver_newton_linesearch)
19196  linesearch_solver=>newton_solver%LINESEARCH_SOLVER
19197  IF(ASSOCIATED(linesearch_solver)) THEN
19198  matrices_library_type=linesearch_solver%SOLVER_MATRICES_LIBRARY
19199  ELSE
19200  CALL flagerror("Newton line search solver is not associated.",err,error,*999)
19201  ENDIF
19202  CASE(solver_newton_trustregion)
19203  trustregion_solver=>newton_solver%TRUSTREGION_SOLVER
19204  IF(ASSOCIATED(trustregion_solver)) THEN
19205  matrices_library_type=trustregion_solver%SOLVER_MATRICES_LIBRARY
19206  ELSE
19207  CALL flagerror("Newton trust region solver is not associated.",err,error,*999)
19208  ENDIF
19209  CASE DEFAULT
19210  local_error="The Newton solver type of "// &
19211  & trim(numbertovstring(newton_solver%NEWTON_SOLVE_TYPE,"*",err,error))//" is invalid."
19212  CALL flagerror(local_error,err,error,*999)
19213  END SELECT
19214  ELSE
19215  CALL flagerror("Newton solver is not associated.",err,error,*999)
19216  ENDIF
19217 
19218  exits("SOLVER_NEWTON_MATRICES_LIBRARY_TYPE_GET")
19219  RETURN
19220 999 errorsexits("SOLVER_NEWTON_MATRICES_LIBRARY_TYPE_GET",err,error)
19221  RETURN 1
19222 
19223  END SUBROUTINE solver_newton_matrices_library_type_get
19224 
19225  !
19226  !================================================================================================================================
19227  !
19228 
19230  SUBROUTINE solver_newtonmaximumfunctionevaluationsset(SOLVER,MAXIMUM_FUNCTION_EVALUATIONS,ERR,ERROR,*)
19231 
19232  !Argument variables
19233  TYPE(solver_type), POINTER :: SOLVER
19234  INTEGER(INTG), INTENT(IN) :: MAXIMUM_FUNCTION_EVALUATIONS
19235  INTEGER(INTG), INTENT(OUT) :: ERR
19236  TYPE(varying_string), INTENT(OUT) :: ERROR
19237  !Local Variables
19238  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
19239  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
19240  TYPE(varying_string) :: LOCAL_ERROR
19241 
19242  enters("Solver_NewtonMaximumFunctionEvaluationsSet",err,error,*999)
19243 
19244  IF(ASSOCIATED(solver)) THEN
19245  IF(solver%SOLVER_FINISHED) THEN
19246  CALL flagerror("Solver has already been finished.",err,error,*999)
19247  ELSE
19248  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
19249  nonlinear_solver=>solver%NONLINEAR_SOLVER
19250  IF(ASSOCIATED(nonlinear_solver)) THEN
19251  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
19252  newton_solver=>nonlinear_solver%NEWTON_SOLVER
19253  IF(ASSOCIATED(newton_solver)) THEN
19254  IF(maximum_function_evaluations>0) THEN
19255  newton_solver%MAXIMUM_NUMBER_OF_FUNCTION_EVALUATIONS=maximum_function_evaluations
19256  ELSE
19257  local_error="The specified maximum number of function evaluations of "// &
19258  & trim(numbertovstring(maximum_function_evaluations,"*",err,error))// &
19259  & " is invalid. The maximum number of function evaluations must be > 0."
19260  CALL flagerror(local_error,err,error,*999)
19261  ENDIF
19262  ELSE
19263  CALL flagerror("The nonlinear solver Newton solver is not associated.",err,error,*999)
19264  ENDIF
19265  ELSE
19266  CALL flagerror("The nonlinear solver is not a Newton solver.",err,error,*999)
19267  ENDIF
19268  ELSE
19269  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
19270  ENDIF
19271  ELSE
19272  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
19273  ENDIF
19274  ENDIF
19275  ELSE
19276  CALL flagerror("Solver is not associated.",err,error,*999)
19277  ENDIF
19278 
19279  exits("Solver_NewtonMaximumFunctionEvaluationsSet")
19280  RETURN
19281 999 errorsexits("Solver_NewtonMaximumFunctionEvaluationsSet",err,error)
19282  RETURN 1
19283 
19284  END SUBROUTINE solver_newtonmaximumfunctionevaluationsset
19285 
19286  !
19287  !================================================================================================================================
19288  !
19289 
19291  SUBROUTINE solver_newton_maximum_iterations_set(SOLVER,MAXIMUM_ITERATIONS,ERR,ERROR,*)
19292 
19293  !Argument variables
19294  TYPE(solver_type), POINTER :: SOLVER
19295  INTEGER(INTG), INTENT(IN) :: MAXIMUM_ITERATIONS
19296  INTEGER(INTG), INTENT(OUT) :: ERR
19297  TYPE(varying_string), INTENT(OUT) :: ERROR
19298  !Local Variables
19299  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
19300  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
19301  TYPE(varying_string) :: LOCAL_ERROR
19302 
19303  enters("SOLVER_NEWTON_MAXIMUM_ITERATIONS_SET",err,error,*999)
19304 
19305  IF(ASSOCIATED(solver)) THEN
19306  IF(solver%SOLVER_FINISHED) THEN
19307  CALL flagerror("Solver has already been finished.",err,error,*999)
19308  ELSE
19309  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
19310  nonlinear_solver=>solver%NONLINEAR_SOLVER
19311  IF(ASSOCIATED(nonlinear_solver)) THEN
19312  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
19313  newton_solver=>nonlinear_solver%NEWTON_SOLVER
19314  IF(ASSOCIATED(newton_solver)) THEN
19315  IF(maximum_iterations>0) THEN
19316  newton_solver%MAXIMUM_NUMBER_OF_ITERATIONS=maximum_iterations
19317  ELSE
19318  local_error="The specified maximum iterations of "//trim(numbertovstring(maximum_iterations,"*",err,error))// &
19319  & " is invalid. The maximum number of iterations must be > 0."
19320  CALL flagerror(local_error,err,error,*999)
19321  ENDIF
19322  ELSE
19323  CALL flagerror("Nonlinear sovler Newton solver is not associated.",err,error,*999)
19324  ENDIF
19325  ELSE
19326  CALL flagerror("The nonlinear solver is not a Newton solver.",err,error,*999)
19327  ENDIF
19328  ELSE
19329  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
19330  ENDIF
19331  ELSE
19332  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
19333  ENDIF
19334  ENDIF
19335  ELSE
19336  CALL flagerror("Solver is not associated.",err,error,*999)
19337  ENDIF
19338 
19339  exits("SOLVER_NEWTON_MAXIMUM_ITERATIONS_SET")
19340  RETURN
19341 999 errorsexits("SOLVER_NEWTON_MAXIMUM_ITERATIONS_SET",err,error)
19342  RETURN 1
19343 
19344  END SUBROUTINE solver_newton_maximum_iterations_set
19345 
19346  !
19347  !================================================================================================================================
19348  !
19349 
19351  SUBROUTINE solver_newton_relative_tolerance_set(SOLVER,RELATIVE_TOLERANCE,ERR,ERROR,*)
19352 
19353  !Argument variables
19354  TYPE(solver_type), POINTER :: SOLVER
19355  REAL(DP), INTENT(IN) :: RELATIVE_TOLERANCE
19356  INTEGER(INTG), INTENT(OUT) :: ERR
19357  TYPE(varying_string), INTENT(OUT) :: ERROR
19358  !Local Variables
19359  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
19360  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
19361  TYPE(varying_string) :: LOCAL_ERROR
19362 
19363  enters("SOLVER_NEWTON_RELATIVE_TOLERANCE_SET",err,error,*999)
19364 
19365  IF(ASSOCIATED(solver)) THEN
19366  IF(solver%SOLVER_FINISHED) THEN
19367  CALL flagerror("Solver has already been finished.",err,error,*999)
19368  ELSE
19369  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
19370  nonlinear_solver=>solver%NONLINEAR_SOLVER
19371  IF(ASSOCIATED(nonlinear_solver)) THEN
19372  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
19373  newton_solver=>nonlinear_solver%NEWTON_SOLVER
19374  IF(ASSOCIATED(newton_solver)) THEN
19375  IF(relative_tolerance>zero_tolerance) THEN
19376  newton_solver%RELATIVE_TOLERANCE=relative_tolerance
19377  ELSE
19378  local_error="The specified relative tolerance of "//trim(numbertovstring(relative_tolerance,"*",err,error))// &
19379  & " is invalid. The relative tolerance must be > 0."
19380  CALL flagerror(local_error,err,error,*999)
19381  ENDIF
19382  ELSE
19383  CALL flagerror("The nonlinear solver Newton solver is not associated.",err,error,*999)
19384  ENDIF
19385  ELSE
19386  CALL flagerror("The nonlinear solver is not a Newton solver.",err,error,*999)
19387  ENDIF
19388  ELSE
19389  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
19390  ENDIF
19391  ELSE
19392  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
19393  ENDIF
19394  ENDIF
19395  ELSE
19396  CALL flagerror("Solver is not associated.",err,error,*999)
19397  ENDIF
19398 
19399  exits("SOLVER_NEWTON_RELATIVE_TOLERANCE_SET")
19400  RETURN
19401 999 errorsexits("SOLVER_NEWTON_RELATIVE_TOLERANCE_SET",err,error)
19402  RETURN 1
19403 
19404  END SUBROUTINE solver_newton_relative_tolerance_set
19405 
19406  !
19407  !================================================================================================================================
19408  !
19409 
19411  SUBROUTINE solver_newton_solution_init_type_set(SOLVER,SOLUTION_INITIALISE_TYPE,ERR,ERROR,*)
19412 
19413  !Argument variables
19414  TYPE(solver_type), POINTER :: SOLVER
19415  INTEGER(INTG), INTENT(IN) :: SOLUTION_INITIALISE_TYPE
19416  INTEGER(INTG), INTENT(OUT) :: ERR
19417  TYPE(varying_string), INTENT(OUT) :: ERROR
19418  !Local Variables
19419  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
19420  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
19421  TYPE(varying_string) :: LOCAL_ERROR
19422 
19423  enters("SOLVER_NEWTON_SOLUTION_INIT_TYPE_SET",err,error,*999)
19424 
19425  IF(ASSOCIATED(solver)) THEN
19426  IF(solver%SOLVER_FINISHED) THEN
19427  CALL flagerror("Solver has already been finished.",err,error,*999)
19428  ELSE
19429  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
19430  nonlinear_solver=>solver%NONLINEAR_SOLVER
19431  IF(ASSOCIATED(nonlinear_solver)) THEN
19432  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
19433  newton_solver=>nonlinear_solver%NEWTON_SOLVER
19434  IF(ASSOCIATED(newton_solver)) THEN
19435  SELECT CASE(solution_initialise_type)
19436  CASE(solver_solution_initialise_zero)
19437  newton_solver%SOLUTION_INITIALISE_TYPE=solver_solution_initialise_zero
19438  CASE(solver_solution_initialise_current_field)
19439  newton_solver%SOLUTION_INITIALISE_TYPE=solver_solution_initialise_current_field
19440  CASE(solver_solution_initialise_no_change)
19441  newton_solver%SOLUTION_INITIALISE_TYPE=solver_solution_initialise_no_change
19442  CASE DEFAULT
19443  local_error="The specified solution initialise type of "// &
19444  & trim(numbertovstring(solution_initialise_type,"*",err,error))//" is invalid."
19445  CALL flagerror(local_error,err,error,*999)
19446  END SELECT
19447  ELSE
19448  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
19449  ENDIF
19450  ELSE
19451  CALL flagerror("The nonlinear solver is not a Newton solver.",err,error,*999)
19452  ENDIF
19453  ELSE
19454  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
19455  ENDIF
19456  ELSE
19457  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
19458  ENDIF
19459  ENDIF
19460  ELSE
19461  CALL flagerror("Solver is not associated.",err,error,*999)
19462  ENDIF
19463 
19464  exits("SOLVER_NEWTON_SOLUTION_INIT_TYPE_SET")
19465  RETURN
19466 999 errorsexits("SOLVER_NEWTON_SOLUTION_INIT_TYPE_SET",err,error)
19467  RETURN 1
19468 
19469  END SUBROUTINE solver_newton_solution_init_type_set
19470 
19471  !
19472  !================================================================================================================================
19473  !
19474 
19476  SUBROUTINE solver_newton_solution_tolerance_set(SOLVER,SOLUTION_TOLERANCE,ERR,ERROR,*)
19477 
19478  !Argument variables
19479  TYPE(solver_type), POINTER :: SOLVER
19480  REAL(DP), INTENT(IN) :: SOLUTION_TOLERANCE
19481  INTEGER(INTG), INTENT(OUT) :: ERR
19482  TYPE(varying_string), INTENT(OUT) :: ERROR
19483  !Local Variables
19484  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
19485  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
19486  TYPE(varying_string) :: LOCAL_ERROR
19487 
19488  enters("SOLVER_NEWTON_SOLUTION_TOLERANCE_SET",err,error,*999)
19489 
19490  IF(ASSOCIATED(solver)) THEN
19491  IF(solver%SOLVER_FINISHED) THEN
19492  CALL flagerror("Solver has already been finished.",err,error,*999)
19493  ELSE
19494  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
19495  nonlinear_solver=>solver%NONLINEAR_SOLVER
19496  IF(ASSOCIATED(nonlinear_solver)) THEN
19497  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
19498  newton_solver=>nonlinear_solver%NEWTON_SOLVER
19499  IF(ASSOCIATED(newton_solver)) THEN
19500  IF(solution_tolerance>zero_tolerance) THEN
19501  newton_solver%SOLUTION_TOLERANCE=solution_tolerance
19502  ELSE
19503  local_error="The specified solution tolerance of "//trim(numbertovstring(solution_tolerance,"*",err,error))// &
19504  & " is invalid. The relative tolerance must be > 0."
19505  CALL flagerror(local_error,err,error,*999)
19506  ENDIF
19507  ELSE
19508  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
19509  ENDIF
19510  ELSE
19511  CALL flagerror("The nonlinear solver is not a Newton solver.",err,error,*999)
19512  ENDIF
19513  ELSE
19514  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
19515  ENDIF
19516  ELSE
19517  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
19518  ENDIF
19519  ENDIF
19520  ELSE
19521  CALL flagerror("Solver is not associated.",err,error,*999)
19522  ENDIF
19523 
19524  exits("SOLVER_NEWTON_SOLUTION_TOLERANCE_SET")
19525  RETURN
19526 999 errorsexits("SOLVER_NEWTON_SOLUTION_TOLERANCE_SET",err,error)
19527  RETURN 1
19528 
19529  END SUBROUTINE solver_newton_solution_tolerance_set
19530 
19531  !
19532  !================================================================================================================================
19533  !
19534 
19535  !Solves a nonlinear Newton solver
19536  SUBROUTINE solver_newton_solve(NEWTON_SOLVER,ERR,ERROR,*)
19537 
19538  !Argument variables
19539  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
19540  INTEGER(INTG), INTENT(OUT) :: ERR
19541  TYPE(varying_string), INTENT(OUT) :: ERROR
19542  !Local Variables
19543  TYPE(varying_string) :: LOCAL_ERROR
19544 
19545  enters("SOLVER_NEWTON_SOLVE",err,error,*999)
19546 
19547  IF(ASSOCIATED(newton_solver)) THEN
19548  SELECT CASE(newton_solver%NEWTON_SOLVE_TYPE)
19549  CASE(solver_newton_linesearch)
19550  CALL solver_newton_linesearch_solve(newton_solver%LINESEARCH_SOLVER,err,error,*999)
19551  CASE(solver_newton_trustregion)
19552  CALL solver_newton_trustregion_solve(newton_solver%TRUSTREGION_SOLVER,err,error,*999)
19553  CASE DEFAULT
19554  local_error="The nonlinear solver type of "// &
19555  & trim(numbertovstring(newton_solver%NEWTON_SOLVE_TYPE,"*",err,error))//" is invalid."
19556  CALL flagerror(local_error,err,error,*999)
19557  END SELECT
19558  ELSE
19559  CALL flagerror("Newton solver is not associated.",err,error,*999)
19560  ENDIF
19561 
19562  exits("SOLVER_NEWTON_SOLVE")
19563  RETURN
19564 999 errorsexits("SOLVER_NEWTON_SOLVE",err,error)
19565  RETURN 1
19566 
19567  END SUBROUTINE solver_newton_solve
19568 
19569  !
19570  !================================================================================================================================
19571  !
19572 
19574  SUBROUTINE solver_newton_trustregion_create_finish(TRUSTREGION_SOLVER,ERR,ERROR,*)
19575 
19576  !Argument variables
19577  TYPE(newton_trustregion_solver_type), POINTER :: TRUSTREGION_SOLVER
19578  INTEGER(INTG), INTENT(OUT) :: ERR
19579  TYPE(varying_string), INTENT(OUT) :: ERROR
19580  !Local Variables
19581  EXTERNAL :: problem_solverresidualevaluatepetsc
19582  INTEGER(INTG) :: equations_matrix_idx,equations_set_idx
19583  TYPE(distributed_vector_type), POINTER :: RESIDUAL_VECTOR
19584  TYPE(equations_type), POINTER :: EQUATIONS
19585  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
19586  TYPE(equations_mapping_linear_type), POINTER :: LINEAR_MAPPING
19587  TYPE(equations_matrices_type), POINTER :: EQUATIONS_MATRICES
19588  TYPE(equations_matrices_linear_type), POINTER :: LINEAR_MATRICES
19589  TYPE(equations_matrix_type), POINTER :: EQUATIONS_MATRIX
19590  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
19591  TYPE(field_type), POINTER :: DEPENDENT_FIELD
19592  TYPE(field_variable_type), POINTER :: LINEAR_VARIABLE
19593  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
19594  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
19595  TYPE(solver_type), POINTER :: SOLVER
19596  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
19597  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
19598  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
19599  TYPE(varying_string) :: LOCAL_ERROR
19600 
19601  enters("SOLVER_NEWTON_TRUSTREGION_CREATE_FINISH",err,error,*999)
19602 
19603  IF(ASSOCIATED(trustregion_solver)) THEN
19604  newton_solver=>trustregion_solver%NEWTON_SOLVER
19605  IF(ASSOCIATED(newton_solver)) THEN
19606  nonlinear_solver=>newton_solver%NONLINEAR_SOLVER
19607  IF(ASSOCIATED(nonlinear_solver)) THEN
19608  solver=>nonlinear_solver%SOLVER
19609  IF(ASSOCIATED(solver)) THEN
19610  solver_equations=>solver%SOLVER_EQUATIONS
19611  IF(ASSOCIATED(solver_equations)) THEN
19612  SELECT CASE(trustregion_solver%SOLVER_LIBRARY)
19613  CASE(solver_cmiss_library)
19614  CALL flagerror("Not implemented.",err,error,*999)
19615  CASE(solver_petsc_library)
19616  solver_mapping=>solver_equations%SOLVER_MAPPING
19617  IF(ASSOCIATED(solver_mapping)) THEN
19618  !Loop over the equations set in the solver equations
19619  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
19620  equations=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)%EQUATIONS
19621  IF(ASSOCIATED(equations)) THEN
19622  equations_set=>equations%EQUATIONS_SET
19623  IF(ASSOCIATED(equations_set)) THEN
19624  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
19625  IF(ASSOCIATED(dependent_field)) THEN
19626  equations_mapping=>equations%EQUATIONS_MAPPING
19627  IF(ASSOCIATED(equations_mapping)) THEN
19628  linear_mapping=>equations_mapping%LINEAR_MAPPING
19629  IF(ASSOCIATED(linear_mapping)) THEN
19630  !If there are any linear matrices create temporary vector for matrix-vector products
19631  equations_matrices=>equations%EQUATIONS_MATRICES
19632  IF(ASSOCIATED(equations_matrices)) THEN
19633  linear_matrices=>equations_matrices%LINEAR_MATRICES
19634  IF(ASSOCIATED(linear_matrices)) THEN
19635  DO equations_matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
19636  equations_matrix=>linear_matrices%MATRICES(equations_matrix_idx)%PTR
19637  IF(ASSOCIATED(equations_matrix)) THEN
19638  IF(.NOT.ASSOCIATED(equations_matrix%TEMP_VECTOR)) THEN
19639  linear_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(equations_matrix_idx)%VARIABLE
19640  IF(ASSOCIATED(linear_variable)) THEN
19641  CALL distributed_vector_create_start(linear_variable%DOMAIN_MAPPING, &
19642  & equations_matrix%TEMP_VECTOR,err,error,*999)
19643  CALL distributed_vector_data_type_set(equations_matrix%TEMP_VECTOR, &
19644  & distributed_matrix_vector_dp_type,err,error,*999)
19645  CALL distributed_vector_create_finish(equations_matrix%TEMP_VECTOR,err,error,*999)
19646  ELSE
19647  CALL flagerror("Linear mapping linear variable is not associated.",err,error,*999)
19648  ENDIF
19649  ENDIF
19650  ELSE
19651  CALL flagerror("Equations matrix is not associated.",err,error,*999)
19652  ENDIF
19653  ENDDO !equations_matrix_idx
19654  ELSE
19655  CALL flagerror("Equations matrices linear matrices is not associated.",err,error,*999)
19656  ENDIF
19657  ELSE
19658  CALL flagerror("Equations equations matrices is not associated.",err,error,*999)
19659  ENDIF
19660  ENDIF
19661  ELSE
19662  CALL flagerror("Equations equations mapping is not associated.",err,error,*999)
19663  ENDIF
19664  ELSE
19665  local_error="Equations set dependent field is not associated for equations set index "// &
19666  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
19667  CALL flagerror(local_error,err,error,*999)
19668  ENDIF
19669  ELSE
19670  local_error="Equations equations set is not associated for equations set index "// &
19671  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
19672  CALL flagerror(local_error,err,error,*999)
19673  ENDIF
19674  ELSE
19675  local_error="Equations is not associated for equations set index "// &
19676  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
19677  CALL flagerror(local_error,err,error,*999)
19678  ENDIF
19679  ENDDO !equations_set_idx
19680 
19681  !Create the solver matrices and vectors
19682  CALL solver_matrices_create_start(solver_equations,solver_matrices,err,error,*999)
19683  CALL solver_matrices_library_type_set(solver_matrices,solver_petsc_library,err,error,*999)
19684 !!TODO: set up the matrix structure if using an analytic Jacobian
19685  CALL solver_matrices_create_finish(solver_matrices,err,error,*999)
19686  !Create the PETSc SNES solver
19687  CALL petsc_snescreate(computational_environment%MPI_COMM,trustregion_solver%snes,err,error,*999)
19688  !Set the nonlinear solver type to be a Newton trust region solver
19689  CALL petsc_snessettype(trustregion_solver%snes,petsc_snesnewtontr,err,error,*999)
19690  !Set the solver as the SNES application context
19691  CALL petsc_snessetapplicationcontext(trustregion_solver%snes,solver,err,error,*999)
19692  !Set the nonlinear function
19693  residual_vector=>solver_matrices%RESIDUAL
19694  IF(ASSOCIATED(residual_vector)) THEN
19695  IF(ASSOCIATED(residual_vector%PETSC)) THEN
19696  CALL petsc_snessetfunction(trustregion_solver%snes,residual_vector%PETSC%VECTOR, &
19697  & problem_solverresidualevaluatepetsc,solver,err,error,*999)
19698  CALL flagerror("The residual vector PETSc is not associated.",err,error,*999)
19699  ENDIF
19700  ELSE
19701  CALL flagerror("Solver matrices residual vector is not associated.",err,error,*999)
19702  ENDIF
19703  !Set the Jacobian if necessary
19704  !Set the trust region delta ???
19705 
19706  !Set the trust region tolerance
19707  CALL petsc_snessettrustregiontolerance(trustregion_solver%snes,trustregion_solver%TRUSTREGION_TOLERANCE, &
19708  & err,error,*999)
19709  !Set the tolerances for the SNES solver
19710  CALL petsc_snessettolerances(trustregion_solver%snes,newton_solver%ABSOLUTE_TOLERANCE, &
19711  & newton_solver%RELATIVE_TOLERANCE,newton_solver%SOLUTION_TOLERANCE, &
19712  & newton_solver%MAXIMUM_NUMBER_OF_ITERATIONS,newton_solver%MAXIMUM_NUMBER_OF_FUNCTION_EVALUATIONS, &
19713  & err,error,*999)
19714  !Set any further SNES options from the command line options
19715  CALL petsc_snessetfromoptions(trustregion_solver%snes,err,error,*999)
19716  ELSE
19717  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
19718  ENDIF
19719  CASE DEFAULT
19720  local_error="The solver library type of "// &
19721  & trim(numbertovstring(trustregion_solver%SOLVER_LIBRARY,"*",err,error))//" is invalid."
19722  CALL flagerror(local_error,err,error,*999)
19723  END SELECT
19724  ELSE
19725  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
19726  ENDIF
19727  ELSE
19728  CALL flagerror("Nonlinear solver solver is not associated.",err,error,*999)
19729  ENDIF
19730  ELSE
19731  CALL flagerror("Newton solver nonlinear solver is not associated.",err,error,*999)
19732  ENDIF
19733  ELSE
19734  CALL flagerror("Trust region Newton solver is not associated.",err,error,*999)
19735  ENDIF
19736  ELSE
19737  CALL flagerror("Trust region solver is not associated.",err,error,*999)
19738  ENDIF
19739 
19740  exits("SOLVER_NEWTON_TRUSTREGION_CREATE_FINISH")
19741  RETURN
19742 999 errorsexits("SOLVER_NEWTON_TRUSTREGION_CREATE_FINISH",err,error)
19743  RETURN 1
19744 
19745  END SUBROUTINE solver_newton_trustregion_create_finish
19746 
19747  !
19748  !================================================================================================================================
19749  !
19750 
19752  SUBROUTINE solver_newton_trustregion_delta0_set(SOLVER,TRUSTREGION_DELTA0,ERR,ERROR,*)
19753 
19754  !Argument variables
19755  TYPE(solver_type), POINTER :: SOLVER
19756  REAL(DP), INTENT(IN) :: TRUSTREGION_DELTA0
19757  INTEGER(INTG), INTENT(OUT) :: ERR
19758  TYPE(varying_string), INTENT(OUT) :: ERROR
19759  !Local Variables
19760  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
19761  TYPE(newton_trustregion_solver_type), POINTER :: TRUSTREGION_SOLVER
19762  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
19763  TYPE(varying_string) :: LOCAL_ERROR
19764 
19765  enters("SOLVER_NEWTON_TRUSTREGION_DELTA0_SET",err,error,*999)
19766 
19767  IF(ASSOCIATED(solver)) THEN
19768  IF(solver%SOLVER_FINISHED) THEN
19769  CALL flagerror("Solver has already been finished.",err,error,*999)
19770  ELSE
19771  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
19772  nonlinear_solver=>solver%NONLINEAR_SOLVER
19773  IF(ASSOCIATED(nonlinear_solver)) THEN
19774  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
19775  newton_solver=>nonlinear_solver%NEWTON_SOLVER
19776  IF(ASSOCIATED(newton_solver)) THEN
19777  IF(newton_solver%NEWTON_SOLVE_TYPE==solver_newton_trustregion) THEN
19778  trustregion_solver=>newton_solver%TRUSTREGION_SOLVER
19779  IF(ASSOCIATED(trustregion_solver)) THEN
19780  IF(trustregion_delta0>zero_tolerance) THEN
19781  trustregion_solver%TRUSTREGION_DELTA0=trustregion_delta0
19782  ELSE
19783  local_error="The specified trust region delta0 of "// &
19784  & trim(numbertovstring(trustregion_delta0,"*",err,error))// &
19785  & " is invalid. The trust region delta0 must be > 0."
19786  CALL flagerror(local_error,err,error,*999)
19787  ENDIF
19788  ELSE
19789  CALL flagerror("The Newton solver trust region solver is not associated.",err,error,*999)
19790  ENDIF
19791  ELSE
19792  CALL flagerror("The Newton solver is not a trust region solver.",err,error,*999)
19793  ENDIF
19794  ELSE
19795  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
19796  ENDIF
19797  ELSE
19798  CALL flagerror("Nonlinear solver is not a Newton solver.",err,error,*999)
19799  ENDIF
19800  ELSE
19801  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
19802  ENDIF
19803  ELSE
19804  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
19805  ENDIF
19806  ENDIF
19807  ELSE
19808  CALL flagerror("Solver is not associated.",err,error,*999)
19809  ENDIF
19810 
19811  exits("SOLVER_NEWTON_TRUSTREGION_DELTA0_SET")
19812  RETURN
19813 999 errorsexits("SOLVER_NEWTON_TRUSTREGION_DELTA0_SET",err,error)
19814  RETURN 1
19815 
19816  END SUBROUTINE solver_newton_trustregion_delta0_set
19817 
19818  !
19819  !================================================================================================================================
19820  !
19821 
19823  SUBROUTINE solver_newton_trustregion_finalise(TRUSTREGION_SOLVER,ERR,ERROR,*)
19824 
19825  !Argument variables
19826  TYPE(newton_trustregion_solver_type), POINTER :: TRUSTREGION_SOLVER
19827  INTEGER(INTG), INTENT(OUT) :: ERR
19828  TYPE(varying_string), INTENT(OUT) :: ERROR
19829  !Local Variables
19830 
19831  enters("SOLVER_NEWTON_TRUSTREGION_FINALISE",err,error,*999)
19832 
19833  IF(ASSOCIATED(trustregion_solver)) THEN
19834  CALL petsc_snesfinalise(trustregion_solver%snes,err,error,*999)
19835  DEALLOCATE(trustregion_solver)
19836  ENDIF
19837 
19838  exits("SOLVER_NEWTON_TRUSTREGION_FINALISE")
19839  RETURN
19840 999 errorsexits("SOLVER_NEWTON_TRUSTREGION_FINALISE",err,error)
19841  RETURN 1
19842 
19843  END SUBROUTINE solver_newton_trustregion_finalise
19844 
19845  !
19846  !================================================================================================================================
19847  !
19848 
19850  SUBROUTINE solver_newton_trustregion_initialise(NEWTON_SOLVER,ERR,ERROR,*)
19851 
19852  !Argument variables
19853  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
19854  INTEGER(INTG), INTENT(OUT) :: ERR
19855  TYPE(varying_string), INTENT(OUT) :: ERROR
19856  !Local Variables
19857  INTEGER(INTG) :: DUMMY_ERR
19858  TYPE(varying_string) :: DUMMY_ERROR
19859 
19860  enters("SOLVER_NEWTON_TRUSTREGION_INITIALISE",err,error,*998)
19861 
19862  IF(ASSOCIATED(newton_solver)) THEN
19863  IF(ASSOCIATED(newton_solver%TRUSTREGION_SOLVER)) THEN
19864  CALL flagerror("Trust region solver is already associated for this nonlinear solver.",err,error,*998)
19865  ELSE
19866  ALLOCATE(newton_solver%TRUSTREGION_SOLVER,stat=err)
19867  IF(err/=0) CALL flagerror("Could not allocate Newton solver trust region solver.",err,error,*999)
19868  newton_solver%TRUSTREGION_SOLVER%NEWTON_SOLVER=>newton_solver
19869  newton_solver%TRUSTREGION_SOLVER%SOLVER_LIBRARY=solver_petsc_library
19870  newton_solver%TRUSTREGION_SOLVER%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
19871 !!TODO: set this properly
19872  newton_solver%TRUSTREGION_SOLVER%TRUSTREGION_DELTA0=0.01_dp
19873  CALL petsc_snesinitialise(newton_solver%TRUSTREGION_SOLVER%snes,err,error,*999)
19874  ENDIF
19875  ELSE
19876  CALL flagerror("Newton solver is not associated.",err,error,*998)
19877  ENDIF
19878 
19879  exits("SOLVER_NEWTON_TRUSTREGION_INITIALISE")
19880  RETURN
19881 999 CALL solver_newton_trustregion_finalise(newton_solver%TRUSTREGION_SOLVER,dummy_err,dummy_error,*998)
19882 998 errorsexits("SOLVER_NEWTON_TRUSTREGION_INITIALISE",err,error)
19883  RETURN 1
19884 
19885  END SUBROUTINE solver_newton_trustregion_initialise
19886 
19887  !
19888  !================================================================================================================================
19889  !
19890 
19891  !Solves a nonlinear Newton trust region solver
19892  SUBROUTINE solver_newton_trustregion_solve(TRUSTREGION_SOLVER,ERR,ERROR,*)
19893 
19894  !Argument variables
19895  TYPE(newton_trustregion_solver_type), POINTER :: TRUSTREGION_SOLVER
19896  INTEGER(INTG), INTENT(OUT) :: ERR
19897  TYPE(varying_string), INTENT(OUT) :: ERROR
19898  !Local Variables
19899  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
19900  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
19901  TYPE(solver_type), POINTER :: SOLVER
19902  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
19903  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
19904  TYPE(varying_string) :: LOCAL_ERROR
19905 
19906  enters("SOLVER_NEWTON_TRUSTREGION_SOLVE",err,error,*999)
19907 
19908  IF(ASSOCIATED(trustregion_solver)) THEN
19909  newton_solver=>trustregion_solver%NEWTON_SOLVER
19910  IF(ASSOCIATED(newton_solver)) THEN
19911  nonlinear_solver=>newton_solver%NONLINEAR_SOLVER
19912  IF(ASSOCIATED(nonlinear_solver)) THEN
19913  solver=>nonlinear_solver%SOLVER
19914  IF(ASSOCIATED(solver)) THEN
19915  solver_equations=>solver%SOLVER_EQUATIONS
19916  IF(ASSOCIATED(solver_equations)) THEN
19917  solver_matrices=>solver_equations%SOLVER_MATRICES
19918  IF(ASSOCIATED(solver_matrices)) THEN
19919  SELECT CASE(trustregion_solver%SOLVER_LIBRARY)
19920  CASE(solver_cmiss_library)
19921  CALL flagerror("Not implemented.",err,error,*999)
19922  CASE(solver_petsc_library)
19923  CALL flagerror("Not implemented.",err,error,*999)
19924  CASE DEFAULT
19925  local_error="The nonlinear Newton trust region solver library type of "// &
19926  & trim(numbertovstring(trustregion_solver%SOLVER_LIBRARY,"*",err,error))//" is invalid."
19927  CALL flagerror(local_error,err,error,*999)
19928  END SELECT
19929  ELSE
19930  CALL flagerror("Solver matrices is not associated.",err,error,*999)
19931  ENDIF
19932  ELSE
19933  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
19934  ENDIF
19935  ELSE
19936  CALL flagerror("Nonlinear solver solver is not associated.",err,error,*999)
19937  ENDIF
19938  ELSE
19939  CALL flagerror("Newton solver nonlinear solver is not associated.",err,error,*999)
19940  ENDIF
19941  ELSE
19942  CALL flagerror("Trust region solver Newton solver is not associated.",err,error,*999)
19943  ENDIF
19944  ELSE
19945  CALL flagerror("Trust region solver is not associated.",err,error,*999)
19946  ENDIF
19947 
19948  exits("SOLVER_NEWTON_TRUSTREGION_SOLVE")
19949  RETURN
19950 999 errorsexits("SOLVER_NEWTON_TRUSTREGION_SOLVE",err,error)
19951  RETURN 1
19952 
19953  END SUBROUTINE solver_newton_trustregion_solve
19954 
19955  !
19956  !================================================================================================================================
19957  !
19958 
19960  SUBROUTINE solver_newton_trustregion_tolerance_set(SOLVER,TRUSTREGION_TOLERANCE,ERR,ERROR,*)
19961 
19962  !Argument variables
19963  TYPE(solver_type), POINTER :: SOLVER
19964  REAL(DP), INTENT(IN) :: TRUSTREGION_TOLERANCE
19965  INTEGER(INTG), INTENT(OUT) :: ERR
19966  TYPE(varying_string), INTENT(OUT) :: ERROR
19967  !Local Variables
19968  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
19969  TYPE(newton_trustregion_solver_type), POINTER :: TRUSTREGION_SOLVER
19970  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
19971  TYPE(varying_string) :: LOCAL_ERROR
19972 
19973  enters("SOLVER_NEWTON_TRUSTREGION_TOLERANCE_SET",err,error,*999)
19974 
19975  IF(ASSOCIATED(solver)) THEN
19976  IF(solver%SOLVER_FINISHED) THEN
19977  CALL flagerror("Solver has already been finished.",err,error,*999)
19978  ELSE
19979  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
19980  nonlinear_solver=>solver%NONLINEAR_SOLVER
19981  IF(ASSOCIATED(nonlinear_solver)) THEN
19982  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
19983  newton_solver=>nonlinear_solver%NEWTON_SOLVER
19984  IF(ASSOCIATED(newton_solver)) THEN
19985  IF(newton_solver%NEWTON_SOLVE_TYPE==solver_newton_trustregion) THEN
19986  trustregion_solver=>newton_solver%TRUSTREGION_SOLVER
19987  IF(ASSOCIATED(trustregion_solver)) THEN
19988  IF(trustregion_tolerance>zero_tolerance) THEN
19989  trustregion_solver%TRUSTREGION_TOLERANCE=trustregion_tolerance
19990  ELSE
19991  local_error="The specified trust region tolerance of "// &
19992  & trim(numbertovstring(trustregion_tolerance,"*",err,error))// &
19993  & " is invalid. The trust region tolerance must be > 0."
19994  CALL flagerror(local_error,err,error,*999)
19995  ENDIF
19996  ELSE
19997  CALL flagerror("The Newton solver trust region solver is not associated.",err,error,*999)
19998  ENDIF
19999  ELSE
20000  CALL flagerror("The Newton solver is not a trust region solver.",err,error,*999)
20001  ENDIF
20002  ELSE
20003  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
20004  ENDIF
20005  ELSE
20006  CALL flagerror("The nonlinear solver is not a Newton solver.",err,error,*999)
20007  ENDIF
20008  ELSE
20009  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*999)
20010  ENDIF
20011  ELSE
20012  CALL flagerror("The solver is not a nonlinear solver.",err,error,*999)
20013  ENDIF
20014  ENDIF
20015  ELSE
20016  CALL flagerror("Solver is not associated.",err,error,*999)
20017  ENDIF
20018 
20019  exits("SOLVER_NEWTON_TRUSTREGION_TOLERANCE_SET")
20020  RETURN
20021 999 errorsexits("SOLVER_NEWTON_TRUSTREGION_TOLERANCE_SET",err,error)
20022  RETURN 1
20023 
20024  END SUBROUTINE solver_newton_trustregion_tolerance_set
20025 
20026  !
20027  !================================================================================================================================
20028  !
20029 
20031  SUBROUTINE solver_newton_type_set(SOLVER,NEWTON_SOLVE_TYPE,ERR,ERROR,*)
20032 
20033  !Argument variables
20034  TYPE(solver_type), POINTER :: SOLVER
20035  INTEGER(INTG), INTENT(IN) :: NEWTON_SOLVE_TYPE
20036  INTEGER(INTG), INTENT(OUT) :: ERR
20037  TYPE(varying_string), INTENT(OUT) :: ERROR
20038  !Local Variables
20039  INTEGER(INTG) :: DUMMY_ERR
20040  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
20041  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
20042  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
20043 
20044  enters("SOLVER_NEWTON_TYPE_SET",err,error,*998)
20045 
20046  IF(ASSOCIATED(solver)) THEN
20047  IF(solver%SOLVER_FINISHED) THEN
20048  CALL flagerror("Solver has already been finished.",err,error,*998)
20049  ELSE
20050  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
20051  nonlinear_solver=>solver%NONLINEAR_SOLVER
20052  IF(ASSOCIATED(nonlinear_solver)) THEN
20053  IF(nonlinear_solver%NONLINEAR_SOLVE_TYPE==solver_nonlinear_newton) THEN
20054  newton_solver=>nonlinear_solver%NEWTON_SOLVER
20055  IF(ASSOCIATED(newton_solver)) THEN
20056  IF(newton_solve_type/=newton_solver%NEWTON_SOLVE_TYPE) THEN
20057  !Intialise the new solver type
20058  SELECT CASE(newton_solve_type)
20059  CASE(solver_newton_linesearch)
20060  CALL solver_newton_linesearch_initialise(newton_solver,err,error,*999)
20061  CASE(solver_newton_trustregion)
20062  CALL solver_newton_trustregion_initialise(newton_solver,err,error,*999)
20063  CASE DEFAULT
20064  local_error="The Newton solver type of "//trim(numbertovstring(newton_solve_type,"*",err,error))// &
20065  & " is invalid."
20066  CALL flagerror(local_error,err,error,*999)
20067  END SELECT
20068  !Finalise the old solver type
20069  SELECT CASE(newton_solver%NEWTON_SOLVE_TYPE)
20070  CASE(solver_newton_linesearch)
20071  CALL solver_newton_linesearch_finalise(newton_solver%LINESEARCH_SOLVER,err,error,*999)
20072  CASE(solver_newton_trustregion)
20073  CALL solver_newton_trustregion_finalise(newton_solver%TRUSTREGION_SOLVER,err,error,*999)
20074  CASE DEFAULT
20075  local_error="The Newton solver type of "// &
20076  & trim(numbertovstring(newton_solver%NEWTON_SOLVE_TYPE,"*",err,error))//" is invalid."
20077  CALL flagerror(local_error,err,error,*999)
20078  END SELECT
20079  newton_solver%NEWTON_SOLVE_TYPE=newton_solve_type
20080  ENDIF
20081  ELSE
20082  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*998)
20083  ENDIF
20084  ELSE
20085  CALL flagerror("The nonlinear solver is not a Newton solver.",err,error,*998)
20086  ENDIF
20087  ELSE
20088  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*998)
20089  ENDIF
20090  ELSE
20091  CALL flagerror("The solver is not a nonlinear solver.",err,error,*998)
20092  ENDIF
20093  ENDIF
20094  ELSE
20095  CALL flagerror("Solver is not associated.",err,error,*998)
20096  ENDIF
20097 
20098  exits("SOLVER_NEWTON_TYPE_SET")
20099  RETURN
20100 999 SELECT CASE(newton_solve_type)
20101  CASE(solver_newton_linesearch)
20102  CALL solver_newton_linesearch_finalise(newton_solver%LINESEARCH_SOLVER,dummy_err,dummy_error,*998)
20103  CASE(solver_newton_trustregion)
20104  CALL solver_newton_trustregion_finalise(newton_solver%TRUSTREGION_SOLVER,dummy_err,dummy_error,*998)
20105  END SELECT
20106 998 errorsexits("SOLVER_NEWTON_TYPE_SET",err,error)
20107  RETURN 1
20108 
20109  END SUBROUTINE solver_newton_type_set
20110 
20111  !
20112  !================================================================================================================================
20113  !
20114 
20115 
20116  !
20117  !================================================================================================================================
20118  !
20119 
20121  SUBROUTINE solver_nonlinear_create_finish(NONLINEAR_SOLVER,ERR,ERROR,*)
20122 
20123  !Argument variables
20124  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
20125  INTEGER(INTG), INTENT(OUT) :: ERR
20126  TYPE(varying_string), INTENT(OUT) :: ERROR
20127  !Local Variables
20128  TYPE(varying_string) :: LOCAL_ERROR
20129 
20130  enters("SOLVER_NONLINEAR_CREATE_FINISH",err,error,*999)
20131 
20132  IF(ASSOCIATED(nonlinear_solver)) THEN
20133  SELECT CASE(nonlinear_solver%NONLINEAR_SOLVE_TYPE)
20134  CASE(solver_nonlinear_newton)
20135  CALL solver_newton_create_finish(nonlinear_solver%NEWTON_SOLVER,err,error,*999)
20136  CASE(solver_nonlinear_bfgs_inverse)
20137  CALL flagerror("Not implemented.",err,error,*999)
20138  CASE(solver_nonlinear_sqp)
20139  CALL flagerror("Not implemented.",err,error,*999)
20140  CASE(solver_nonlinear_quasi_newton)
20141  CALL solver_quasi_newton_create_finish(nonlinear_solver%QUASI_NEWTON_SOLVER,err,error,*999)
20142  CASE DEFAULT
20143  local_error="The nonlinear solver type of "// &
20144  & trim(numbertovstring(nonlinear_solver%NONLINEAR_SOLVE_TYPE,"*",err,error))//" is invalid."
20145  CALL flagerror(local_error,err,error,*999)
20146  END SELECT
20147  ELSE
20148  CALL flagerror("Nonlinear solver is not associated.",err,error,*999)
20149  ENDIF
20150 
20151  exits("SOLVER_NONLINEAR_CREATE_FINISH")
20152  RETURN
20153 999 errorsexits("SOLVER_NONLINEAR_CREATE_FINISH",err,error)
20154  RETURN 1
20155 
20156  END SUBROUTINE solver_nonlinear_create_finish
20157 
20158  !
20159  !================================================================================================================================
20160  !
20161 
20163  SUBROUTINE solver_nonlinear_divergence_exit(SOLVER,ERR,ERROR,*)
20164  TYPE(solver_type), INTENT(IN) :: SOLVER
20165  INTEGER(INTG), INTENT(OUT) :: ERR
20166  TYPE(varying_string), INTENT(OUT) :: ERROR
20167  !Local variables
20168  TYPE(nonlinear_solver_type),POINTER :: NONLINEAR_SOLVER
20169  TYPE(newton_solver_type),POINTER :: NEWTON_SOLVER
20170  TYPE(newton_linesearch_solver_type),POINTER :: NEWTON_LINESEARCH_SOLVER
20171  TYPE(quasi_newton_solver_type),POINTER :: QUASI_NEWTON_SOLVER
20172  TYPE(quasi_newton_linesearch_solver_type),POINTER :: QUASI_NEWTON_LINESEARCH_SOLVER
20173  INTEGER(INTG) :: CONVERGED_REASON
20174 
20175  enters("SOLVER_NONLINEAR_DIVERGENCE_EXIT",err,error,*999)
20176 
20177  NULLIFY(nonlinear_solver,newton_solver,newton_linesearch_solver,quasi_newton_solver,quasi_newton_linesearch_solver)
20178 
20179  nonlinear_solver=>solver%NONLINEAR_SOLVER
20180  IF(ASSOCIATED(nonlinear_solver)) THEN
20181  SELECT CASE(nonlinear_solver%NONLINEAR_SOLVE_TYPE)
20182  CASE(solver_nonlinear_newton)
20183  newton_solver=>nonlinear_solver%NEWTON_SOLVER
20184  IF(ASSOCIATED(newton_solver)) THEN
20185  SELECT CASE (newton_solver%NEWTON_SOLVE_TYPE)
20186  CASE(solver_newton_linesearch)
20187  newton_linesearch_solver=>newton_solver%LINESEARCH_SOLVER
20188  IF(ASSOCIATED(newton_linesearch_solver)) THEN
20189  CALL petsc_snesgetconvergedreason(newton_linesearch_solver%snes,converged_reason,err,error,*999)
20190  SELECT CASE(converged_reason)
20191  CASE(petsc_snes_diverged_function_count)
20192  CALL flagerror("Nonlinear line search solver did not converge. Exit due to PETSc diverged function count.", &
20193  & err,error,*999)
20194  CASE(petsc_snes_diverged_linear_solve)
20195  CALL flagerror("Nonlinear line search solver did not converge. Exit due to PETSc diverged linear solve.", &
20196  & err,error,*999)
20197  CASE(petsc_snes_diverged_fnorm_nan)
20198  CALL flagerror("Nonlinear line search solver did not converge. Exit due to PETSc diverged F Norm NaN.", &
20199  & err,error,*999)
20200  CASE(petsc_snes_diverged_max_it)
20201  CALL flagerror("Nonlinear line search solver did not converge. Exit due to PETSc diverged maximum iterations.", &
20202  & err,error,*999)
20203  CASE(petsc_snes_diverged_line_search)
20204  CALL flagerror("Nonlinear line search solver did not converge. Exit due to PETSc diverged line search.", &
20205  & err,error,*999)
20206  CASE(petsc_snes_diverged_local_min)
20207  CALL flagerror("Nonlinear line search solver did not converge. Exit due to PETSc diverged local minimum.", &
20208  & err,error,*999)
20209  END SELECT
20210  ELSE
20211  CALL flagerror("Linesearch solver is not associated.",err,error,*999)
20212  ENDIF
20213  CASE(solver_newton_trustregion)
20214  !Not yet implemented. Don't kick up a fuss, just exit
20215  END SELECT
20216  ELSE
20217  CALL flagerror("Newton solver is not associated.",err,error,*999)
20218  ENDIF
20219  CASE(solver_nonlinear_bfgs_inverse)
20220  !Not yet implemented. Don't kick up a fuss, just exit
20221  CASE(solver_nonlinear_sqp)
20222  !Not yet implemented. Don't kick up a fuss, just exit
20223  CASE(solver_nonlinear_quasi_newton)
20224  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
20225  IF(ASSOCIATED(quasi_newton_solver)) THEN
20226  quasi_newton_linesearch_solver=>quasi_newton_solver%LINESEARCH_SOLVER
20227  IF(ASSOCIATED(quasi_newton_linesearch_solver)) THEN
20228  CALL petsc_snesgetconvergedreason(quasi_newton_linesearch_solver%snes,converged_reason,err,error,*999)
20229  SELECT CASE(converged_reason)
20230  CASE(petsc_snes_diverged_function_count)
20231  CALL flagerror("Nonlinear line search solver did not converge. Exit due to PETSc diverged function count.", &
20232  & err,error,*999)
20233  CASE(petsc_snes_diverged_linear_solve)
20234  CALL flagerror("Nonlinear line search solver did not converge. Exit due to PETSc diverged linear solve.", &
20235  & err,error,*999)
20236  CASE(petsc_snes_diverged_fnorm_nan)
20237  CALL flagerror("Nonlinear line search solver did not converge. Exit due to PETSc diverged F Norm NaN.", &
20238  & err,error,*999)
20239  CASE(petsc_snes_diverged_max_it)
20240  CALL flagerror("Nonlinear line search solver did not converge. Exit due to PETSc diverged maximum iterations.", &
20241  & err,error,*999)
20242  CASE(petsc_snes_diverged_line_search)
20243  CALL flagerror("Nonlinear line search solver did not converge. Exit due to PETSc diverged line search.", &
20244  & err,error,*999)
20245  CASE(petsc_snes_diverged_local_min)
20246  CALL flagerror("Nonlinear line search solver did not converge. Exit due to PETSc diverged local minimum.", &
20247  & err,error,*999)
20248  END SELECT
20249  ELSE
20250  CALL flagerror("Linesearch solver is not associated.",err,error,*999)
20251  ENDIF
20252  ELSE
20253  CALL flagerror("Newton solver is not associated.",err,error,*999)
20254  ENDIF
20255  END SELECT
20256  ELSE
20257  CALL flagerror("Nonlinear solver is not associated.",err,error,*999)
20258  ENDIF
20259 
20260  exits("SOLVER_NONLINEAR_DIVERGENCE_EXIT")
20261  RETURN
20262 999 errorsexits("SOLVER_NONLINEAR_DIVERGENCE_EXIT",err,error)
20263  RETURN 1
20264  END SUBROUTINE solver_nonlinear_divergence_exit
20265 
20266  !
20267  !================================================================================================================================
20268  !
20269 
20271  RECURSIVE SUBROUTINE solver_nonlinear_finalise(NONLINEAR_SOLVER,ERR,ERROR,*)
20272 
20273  !Argument variables
20274  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
20275  INTEGER(INTG), INTENT(OUT) :: ERR
20276  TYPE(varying_string), INTENT(OUT) :: ERROR
20277  !Local Variables
20278  TYPE(varying_string) :: LOCAL_ERROR
20279 
20280  enters("SOLVER_NONLINEAR_FINALISE",err,error,*999)
20281 
20282  IF(ASSOCIATED(nonlinear_solver)) THEN
20283  SELECT CASE(nonlinear_solver%NONLINEAR_SOLVE_TYPE)
20284  CASE(solver_nonlinear_newton)
20285  CALL solver_newton_finalise(nonlinear_solver%NEWTON_SOLVER,err,error,*999)
20286  CASE(solver_nonlinear_bfgs_inverse)
20287  CALL flagerror("Not implemented.",err,error,*999)
20288  CASE(solver_nonlinear_sqp)
20289  CALL flagerror("Not implemented.",err,error,*999)
20290  CASE(solver_nonlinear_quasi_newton)
20291  CALL solver_quasi_newton_finalise(nonlinear_solver%QUASI_NEWTON_SOLVER,err,error,*999)
20292  CASE DEFAULT
20293  local_error="The nonlinear solver type of "// &
20294  & trim(numbertovstring(nonlinear_solver%NONLINEAR_SOLVE_TYPE,"*",err,error))//" is invalid."
20295  CALL flagerror(local_error,err,error,*999)
20296  END SELECT
20297  DEALLOCATE(nonlinear_solver)
20298  ENDIF
20299 
20300  exits("SOLVER_NONLINEAR_FINALISE")
20301  RETURN
20302 999 errorsexits("SOLVER_NONLINEAR_FINALISE",err,error)
20303  RETURN 1
20304 
20305  END SUBROUTINE solver_nonlinear_finalise
20306 
20307  !
20308  !================================================================================================================================
20309  !
20310 
20312  SUBROUTINE solver_nonlinear_initialise(SOLVER,ERR,ERROR,*)
20313 
20314  !Argument variables
20315  TYPE(solver_type), POINTER :: SOLVER
20316  INTEGER(INTG), INTENT(OUT) :: ERR
20317  TYPE(varying_string), INTENT(OUT) :: ERROR
20318  !Local Variables
20319  INTEGER(INTG) :: DUMMY_ERR
20320  TYPE(varying_string) :: DUMMY_ERROR
20321 
20322  enters("SOLVER_NONLINEAR_INITIALISE",err,error,*998)
20323 
20324  IF(ASSOCIATED(solver)) THEN
20325  IF(ASSOCIATED(solver%NONLINEAR_SOLVER)) THEN
20326  CALL flagerror("Nonlinear solver is already associated for this solver.",err,error,*998)
20327  ELSE
20328  !Allocate and initialise a Nonlinear solver
20329  ALLOCATE(solver%NONLINEAR_SOLVER,stat=err)
20330  IF(err/=0) CALL flagerror("Could not allocate solver nonlinear solver.",err,error,*999)
20331  solver%NONLINEAR_SOLVER%SOLVER=>solver
20332  NULLIFY(solver%NONLINEAR_SOLVER%NEWTON_SOLVER)
20333  !Default to a nonlinear Newton solver
20334  solver%NONLINEAR_SOLVER%NONLINEAR_SOLVE_TYPE=solver_nonlinear_newton
20335  CALL solver_newton_initialise(solver%NONLINEAR_SOLVER,err,error,*999)
20336  ENDIF
20337  ELSE
20338  CALL flagerror("Solver is not associated.",err,error,*998)
20339  ENDIF
20340 
20341  exits("SOLVER_NONLINEAR_INITIALISE")
20342  RETURN
20343 999 CALL solver_nonlinear_finalise(solver%NONLINEAR_SOLVER,dummy_err,dummy_error,*998)
20344 998 errorsexits("SOLVER_NONLINEAR_INITIALISE",err,error)
20345  RETURN 1
20346 
20347  END SUBROUTINE solver_nonlinear_initialise
20348 
20349  !
20350  !================================================================================================================================
20351  !
20352 
20354  SUBROUTINE solver_nonlinear_library_type_get(NONLINEAR_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
20355 
20356  !Argument variables
20357  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
20358  INTEGER(INTG), INTENT(OUT) :: SOLVER_LIBRARY_TYPE
20359  INTEGER(INTG), INTENT(OUT) :: ERR
20360  TYPE(varying_string), INTENT(OUT) :: ERROR
20361  !Local Variables
20362  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
20363  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
20364  TYPE(varying_string) :: LOCAL_ERROR
20365 
20366  enters("SOLVER_NONLINEAR_LIBRARY_TYPE_GET",err,error,*999)
20367 
20368  IF(ASSOCIATED(nonlinear_solver)) THEN
20369  SELECT CASE(nonlinear_solver%NONLINEAR_SOLVE_TYPE)
20370  CASE(solver_nonlinear_newton)
20371  newton_solver=>nonlinear_solver%NEWTON_SOLVER
20372  IF(ASSOCIATED(newton_solver)) THEN
20373  CALL solver_newton_library_type_get(newton_solver,solver_library_type,err,error,*999)
20374  ELSE
20375  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
20376  ENDIF
20377  CASE(solver_nonlinear_bfgs_inverse)
20378  CALL flagerror("Not implemented.",err,error,*999)
20379  CASE(solver_nonlinear_sqp)
20380  CALL flagerror("Not implemented.",err,error,*999)
20381  CASE(solver_nonlinear_quasi_newton)
20382  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
20383  IF(ASSOCIATED(quasi_newton_solver)) THEN
20384  CALL solver_quasi_newton_library_type_get(quasi_newton_solver, &
20385  & solver_library_type,err,error,*999)
20386  ELSE
20387  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
20388  ENDIF
20389  CASE DEFAULT
20390  local_error="The nonlinear solver type of "// &
20391  & trim(numbertovstring(nonlinear_solver%NONLINEAR_SOLVE_TYPE,"*",err,error))//" is invalid."
20392  CALL flagerror(local_error,err,error,*999)
20393  END SELECT
20394  ELSE
20395  CALL flagerror("Nonlinear solver is not associated.",err,error,*999)
20396  ENDIF
20397 
20398  exits("SOLVER_NONLINEAR_LIBRARY_TYPE_GET")
20399  RETURN
20400 999 errorsexits("SOLVER_NONLINEAR_LIBRARY_TYPE_GET",err,error)
20401  RETURN 1
20402 
20403  END SUBROUTINE solver_nonlinear_library_type_get
20404 
20405  !
20406  !================================================================================================================================
20407  !
20408 
20410  SUBROUTINE solver_nonlinear_library_type_set(NONLINEAR_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
20411 
20412  !Argument variables
20413  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
20414  INTEGER(INTG), INTENT(IN) :: SOLVER_LIBRARY_TYPE
20415  INTEGER(INTG), INTENT(OUT) :: ERR
20416  TYPE(varying_string), INTENT(OUT) :: ERROR
20417  !Local Variables
20418  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
20419  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
20420  TYPE(varying_string) :: LOCAL_ERROR
20421 
20422  enters("SOLVER_NONLINEAR_LIBRARY_TYPE_SET",err,error,*999)
20423 
20424  IF(ASSOCIATED(nonlinear_solver)) THEN
20425  SELECT CASE(nonlinear_solver%NONLINEAR_SOLVE_TYPE)
20426  CASE(solver_nonlinear_newton)
20427  newton_solver=>nonlinear_solver%NEWTON_SOLVER
20428  IF(ASSOCIATED(newton_solver)) THEN
20429  CALL solver_newton_library_type_set(newton_solver,solver_library_type,err,error,*999)
20430  ELSE
20431  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
20432  ENDIF
20433  CASE(solver_nonlinear_bfgs_inverse)
20434  CALL flagerror("Not implemented.",err,error,*999)
20435  CASE(solver_nonlinear_sqp)
20436  CALL flagerror("Not implemented.",err,error,*999)
20437  CASE(solver_nonlinear_quasi_newton)
20438  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
20439  IF(ASSOCIATED(quasi_newton_solver)) THEN
20440  CALL solver_quasi_newton_library_type_set(quasi_newton_solver, &
20441  & solver_library_type,err,error,*999)
20442  ELSE
20443  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
20444  ENDIF
20445  CASE DEFAULT
20446  local_error="The nonlinear solver type of "// &
20447  & trim(numbertovstring(nonlinear_solver%NONLINEAR_SOLVE_TYPE,"*",err,error))//" is invalid."
20448  CALL flagerror(local_error,err,error,*999)
20449  END SELECT
20450  ELSE
20451  CALL flagerror("Nonlinear solver is not associated.",err,error,*999)
20452  ENDIF
20453 
20454  exits("SOLVER_NONLINEAR_LIBRARY_TYPE_SET")
20455  RETURN
20456 999 errorsexits("SOLVER_NONLINEAR_LIBRARY_TYPE_SET",err,error)
20457  RETURN 1
20458 
20459  END SUBROUTINE solver_nonlinear_library_type_set
20460 
20461  !
20462  !================================================================================================================================
20463  !
20464 
20466  SUBROUTINE solver_nonlinear_matrices_library_type_get(NONLINEAR_SOLVER,MATRICES_LIBRARY_TYPE,ERR,ERROR,*)
20467 
20468  !Argument variables
20469  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
20470  INTEGER(INTG), INTENT(OUT) :: MATRICES_LIBRARY_TYPE
20471  INTEGER(INTG), INTENT(OUT) :: ERR
20472  TYPE(varying_string), INTENT(OUT) :: ERROR
20473  !Local Variables
20474  TYPE(newton_solver_type), POINTER :: NEWTON_SOLVER
20475  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
20476  TYPE(varying_string) :: LOCAL_ERROR
20477 
20478  enters("SOLVER_NONLINEAR_MATRICES_LIBRARY_TYPE_GET",err,error,*999)
20479 
20480  IF(ASSOCIATED(nonlinear_solver)) THEN
20481  SELECT CASE(nonlinear_solver%NONLINEAR_SOLVE_TYPE)
20482  CASE(solver_nonlinear_newton)
20483  newton_solver=>nonlinear_solver%NEWTON_SOLVER
20484  IF(ASSOCIATED(newton_solver)) THEN
20485  CALL solver_newton_matrices_library_type_get(newton_solver,matrices_library_type,err,error,*999)
20486  ELSE
20487  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
20488  ENDIF
20489  CASE(solver_nonlinear_bfgs_inverse)
20490  CALL flagerror("Not implemented.",err,error,*999)
20491  CASE(solver_nonlinear_sqp)
20492  CALL flagerror("Not implemented.",err,error,*999)
20493  CASE(solver_nonlinear_quasi_newton)
20494  quasi_newton_solver=>nonlinear_solver%QUASI_NEWTON_SOLVER
20495  IF(ASSOCIATED(quasi_newton_solver)) THEN
20496  CALL solver_quasinewtonmatriceslibrarytypeget(quasi_newton_solver, &
20497  & matrices_library_type,err,error,*999)
20498  ELSE
20499  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
20500  ENDIF
20501  CASE DEFAULT
20502  local_error="The nonlinear solver type of "// &
20503  & trim(numbertovstring(nonlinear_solver%NONLINEAR_SOLVE_TYPE,"*",err,error))//" is invalid."
20504  CALL flagerror(local_error,err,error,*999)
20505  END SELECT
20506  ELSE
20507  CALL flagerror("Nonlinear solver is not associated.",err,error,*999)
20508  ENDIF
20509 
20510  exits("SOLVER_NONLINEAR_MATRICES_LIBRARY_TYPE_GET")
20511  RETURN
20512 999 errorsexits("SOLVER_NONLINEAR_MATRICES_LIBRARY_TYPE_GET",err,error)
20513  RETURN 1
20514 
20515  END SUBROUTINE solver_nonlinear_matrices_library_type_get
20516 
20517  !
20518  !================================================================================================================================
20519  !
20520 
20522  SUBROUTINE solver_nonlinear_monitor(nonlinearSolver,its,norm,err,error,*)
20523 
20524  !Argument variables
20525  TYPE(nonlinear_solver_type), POINTER :: nonlinearSolver
20526  INTEGER(INTG), INTENT(IN) :: its
20527  REAL(DP), INTENT(IN) :: norm
20528  INTEGER(INTG), INTENT(OUT) :: err
20529  TYPE(varying_string), INTENT(OUT) :: error
20530  !Local Variables
20531  REAL(DP) :: xnorm
20532  REAL(DP) :: fnorm
20533  REAL(DP) :: ynorm
20534  TYPE(newton_linesearch_solver_type), POINTER :: newtonLinesearchSolver
20535  TYPE(newton_solver_type), POINTER :: newtonSolver
20536  TYPE(quasi_newton_linesearch_solver_type), POINTER :: quasiNewtonlinesearchSolver
20537  TYPE(quasi_newton_solver_type), POINTER :: QUASI_NEWTON_SOLVER
20538  TYPE(varying_string) :: localError
20539 
20540  enters("SOLVER_NONLINEAR_MONITOR",err,error,*999)
20541 
20542  IF(ASSOCIATED(nonlinearsolver)) THEN
20543 
20544  CALL write_string(general_output_type,"",err,error,*999)
20545  CALL write_string(general_output_type,"Nonlinear solve monitor: ",err,error,*999)
20546  CALL write_string(general_output_type,"",err,error,*999)
20547  CALL write_string_value(general_output_type," Iteration number = ",its,err,error,*999)
20548  SELECT CASE(nonlinearsolver%NONLINEAR_SOLVE_TYPE)
20549  CASE(solver_nonlinear_newton)
20550  newtonsolver=>nonlinearsolver%NEWTON_SOLVER
20551  IF(ASSOCIATED(newtonsolver)) THEN
20552  SELECT CASE(newtonsolver%convergenceTestType)
20553  CASE(solver_newton_convergence_petsc_default)
20554  CALL write_string_value(general_output_type," Function Norm = ",norm,err,error,*999)
20555  CASE(solver_newton_convergence_energy_norm)
20556  SELECT CASE(newtonsolver%NEWTON_SOLVE_TYPE)
20557  CASE(solver_newton_linesearch)
20558  newtonlinesearchsolver=>newtonsolver%LINESEARCH_SOLVER
20559  IF(ASSOCIATED(newtonlinesearchsolver)) THEN
20560  CALL petsc_sneslinesearchgetnorms(newtonlinesearchsolver%sneslinesearch,xnorm,fnorm,ynorm,err,error,*999)
20561  CALL write_string_value(general_output_type," Solution Norm = ",xnorm,err,error,*999)
20562  CALL write_string_value(general_output_type," Solution Update Norm = ",ynorm,err,error,*999)
20563  CALL write_string_value(general_output_type," Function Norm = ",fnorm,err,error,*999)
20564  CALL write_string_value(general_output_type," Normalised Energy Norm = ", &
20565  & newtonsolver%convergenceTest%normalisedEnergy,err,error,*999)
20566  ELSE
20567  CALL flagerror("Newton solver linesearch solver is not associated.",err,error,*999)
20568  ENDIF
20569  CASE(solver_newton_trustregion)
20570  CALL flagerror("The Newton Trust region solver is not implemented.",err,error,*999)
20571  CASE DEFAULT
20572  localerror="The Newton solve type of "// &
20573  & trim(numbertovstring(newtonsolver%NEWTON_SOLVE_TYPE,"*",err,error))//"is invalid."
20574  CALL flagerror(localerror,err,error,*999)
20575  END SELECT
20576  CASE(solver_newton_convergence_differentiated_ratio)
20577  CALL flagerror("The Sum of differentiated ratios of unconstrained to constrained residuals"// &
20578  & "convergence test type is not implemented.",err,error,*999)
20579  END SELECT
20580  CALL write_string(general_output_type," Newton solver information: ",err,error,*999)
20581  CALL write_string_value(general_output_type," Number of function evaluations = ",newtonsolver% &
20582  & total_number_of_function_evaluations,err,error,*999)
20583  CALL write_string_value(general_output_type," Number of Jacobian evaluations = ",newtonsolver% &
20584  & total_number_of_jacobian_evaluations,err,error,*999)
20585  ELSE
20586  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
20587  ENDIF
20588  CASE(solver_nonlinear_bfgs_inverse)
20589  !Do nothing
20590  CASE(solver_nonlinear_sqp)
20591  !Do nothing
20592  CASE(solver_nonlinear_quasi_newton)
20593  quasi_newton_solver=>nonlinearsolver%QUASI_NEWTON_SOLVER
20594  IF(ASSOCIATED(quasi_newton_solver)) THEN
20595  SELECT CASE(quasi_newton_solver%convergenceTestType)
20596  CASE(solver_newton_convergence_petsc_default)
20597  CALL write_string_value(general_output_type," Function Norm = ",norm,err,error,*999)
20598  CASE(solver_newton_convergence_energy_norm)
20599  quasinewtonlinesearchsolver=>quasi_newton_solver%LINESEARCH_SOLVER
20600  IF(ASSOCIATED(quasinewtonlinesearchsolver)) THEN
20601  CALL petsc_sneslinesearchgetnorms(quasinewtonlinesearchsolver%sneslinesearch, &
20602  & xnorm,fnorm,ynorm,err,error,*999)
20603  CALL write_string_value(general_output_type," Solution Norm = ",xnorm,err,error,*999)
20604  CALL write_string_value(general_output_type," Solution Update Norm = ",ynorm,err,error,*999)
20605  CALL write_string_value(general_output_type," Function Norm = ",fnorm,err,error,*999)
20606  CALL write_string_value(general_output_type," Normalised Energy Norm = ", &
20607  & quasi_newton_solver%convergenceTest%normalisedEnergy,err,error,*999)
20608  ELSE
20609  CALL flagerror("Quasi-Newton solver linesearch solver is not associated.",err,error,*999)
20610  ENDIF
20611  CASE(solver_newton_convergence_differentiated_ratio)
20612  CALL flagerror("The Sum of differentiated ratios of unconstrained to constrained residuals"// &
20613  & "convergence test type is not implemented.",err,error,*999)
20614  END SELECT
20615  CALL write_string(general_output_type," Quasi-Newton solver information: ",err,error,*999)
20616  CALL write_string_value(general_output_type," Number of function evaluations = ",quasi_newton_solver% &
20617  & total_number_of_function_evaluations,err,error,*999)
20618  CALL write_string_value(general_output_type," Number of Jacobian evaluations = ",quasi_newton_solver% &
20619  & total_number_of_jacobian_evaluations,err,error,*999)
20620  ELSE
20621  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*999)
20622  ENDIF
20623  CASE DEFAULT
20624  localerror="The nonlinear solver type of "// &
20625  & trim(numbertovstring(nonlinearsolver%NONLINEAR_SOLVE_TYPE,"*",err,error))// &
20626  & " is invalid."
20627  CALL flagerror(localerror,err,error,*999)
20628  END SELECT
20629  ELSE
20630  CALL flagerror("Nonlinear solver is not associated.",err,error,*999)
20631  ENDIF
20632 
20633  exits("SOLVER_NONLINEAR_MONITOR")
20634  RETURN
20635 999 errorsexits("SOLVER_NONLINEAR_MONITOR",err,error)
20636  RETURN 1
20637  END SUBROUTINE solver_nonlinear_monitor
20638 
20639  !
20640  !================================================================================================================================
20641  !
20642 
20643  !Solves a nonlinear solver
20644  SUBROUTINE solver_nonlinear_solve(NONLINEAR_SOLVER,ERR,ERROR,*)
20645 
20646  !Argument variables
20647  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
20648  INTEGER(INTG), INTENT(OUT) :: ERR
20649  TYPE(varying_string), INTENT(OUT) :: ERROR
20650  !Local Variables
20651  INTEGER(INTG) :: solver_matrix_idx
20652  TYPE(solver_type), POINTER :: SOLVER
20653  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
20654  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
20655  TYPE(varying_string) :: LOCAL_ERROR
20656 
20657  enters("SOLVER_NONLINEAR_SOLVE",err,error,*999)
20658 
20659  IF(ASSOCIATED(nonlinear_solver)) THEN
20660  solver=>nonlinear_solver%SOLVER
20661  IF(ASSOCIATED(solver)) THEN
20662  SELECT CASE(nonlinear_solver%NONLINEAR_SOLVE_TYPE)
20663  CASE(solver_nonlinear_newton)
20664  CALL solver_newton_solve(nonlinear_solver%NEWTON_SOLVER,err,error,*999)
20665  CASE(solver_nonlinear_bfgs_inverse)
20666  CALL flagerror("Not implemented.",err,error,*999)
20667  CASE(solver_nonlinear_sqp)
20668  CALL flagerror("Not implemented.",err,error,*999)
20669  CASE(solver_nonlinear_quasi_newton)
20670  CALL solver_quasi_newton_solve(nonlinear_solver%QUASI_NEWTON_SOLVER,err,error,*999)
20671  CASE DEFAULT
20672  local_error="The nonlinear solver type of "// &
20673  & trim(numbertovstring(nonlinear_solver%NONLINEAR_SOLVE_TYPE,"*",err,error))//" is invalid."
20674  CALL flagerror(local_error,err,error,*999)
20675  END SELECT
20676 
20677  IF(solver%OUTPUT_TYPE>=solver_solver_output) THEN
20678 
20679 #ifdef TAUPROF
20680  CALL tau_static_phase_start("Solution Output Phase")
20681 #endif
20682 
20683  solver_equations=>solver%SOLVER_EQUATIONS
20684  IF(ASSOCIATED(solver_equations)) THEN
20685  solver_matrices=>solver_equations%SOLVER_MATRICES
20686  IF(ASSOCIATED(solver_matrices)) THEN
20687  CALL write_string(general_output_type,"",err,error,*999)
20688  CALL write_string(general_output_type,"Solver solution vectors:",err,error,*999)
20689  CALL write_string_value(general_output_type,"Number of solution vectors = ",solver_matrices%NUMBER_OF_MATRICES, &
20690  & err,error,*999)
20691  DO solver_matrix_idx=1,solver_matrices%NUMBER_OF_MATRICES
20692  CALL write_string_value(general_output_type,"Solution vector for solver matrix : ",solver_matrix_idx, &
20693  & err,error,*999)
20694  CALL distributed_vector_output(general_output_type,solver_matrices%MATRICES(solver_matrix_idx)%PTR% &
20695  & solver_vector,err,error,*999)
20696  ENDDO !solver_matrix_idx
20697  ELSE
20698  CALL flagerror("Solver equations solver matrices is not associated.",err,error,*999)
20699  ENDIF
20700  ELSE
20701  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
20702  ENDIF
20703 
20704 #ifdef TAUPROF
20705  CALL tau_static_phase_stop("Solution Output Phase")
20706 #endif
20707  ENDIF
20708  ELSE
20709  CALL flagerror("Nonlinear solver solver is not associated.",err,error,*999)
20710  ENDIF
20711  ELSE
20712  CALL flagerror("Nonlinear solver is not associated.",err,error,*999)
20713  ENDIF
20714 
20715  exits("SOLVER_NONLINEAR_SOLVE")
20716  RETURN
20717 999 errorsexits("SOLVER_NONLINEAR_SOLVE",err,error)
20718  RETURN 1
20719 
20720  END SUBROUTINE solver_nonlinear_solve
20721 
20722  !
20723  !================================================================================================================================
20724  !
20725 
20727  SUBROUTINE solver_nonlinear_type_set(SOLVER,NONLINEAR_SOLVE_TYPE,ERR,ERROR,*)
20728 
20729  !Argument variables
20730  TYPE(solver_type), POINTER :: SOLVER
20731  INTEGER(INTG), INTENT(IN) :: NONLINEAR_SOLVE_TYPE
20732  INTEGER(INTG), INTENT(OUT) :: ERR
20733  TYPE(varying_string), INTENT(OUT) :: ERROR
20734  !Local Variables
20735  INTEGER(INTG) :: DUMMY_ERR
20736  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
20737  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
20738 
20739  enters("SOLVER_NONLINEAR_TYPE_SET",err,error,*998)
20740 
20741  IF(ASSOCIATED(solver)) THEN
20742  IF(solver%SOLVER_FINISHED) THEN
20743  CALL flagerror("Solver has already been finished.",err,error,*998)
20744  ELSE
20745  CALL solver_linked_solver_remove(solver,solver_linear_type,err,error,*999)
20746  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
20747  nonlinear_solver=>solver%NONLINEAR_SOLVER
20748  IF(ASSOCIATED(nonlinear_solver)) THEN
20749  IF(nonlinear_solve_type/=nonlinear_solver%NONLINEAR_SOLVE_TYPE) THEN
20750  !Finalise the old solver type
20751  SELECT CASE(nonlinear_solver%NONLINEAR_SOLVE_TYPE)
20752  CASE(solver_nonlinear_newton)
20753  CALL solver_newton_finalise(nonlinear_solver%NEWTON_SOLVER,err,error,*999)
20754  CASE(solver_nonlinear_bfgs_inverse)
20755  CALL flagerror("Not implemented.",err,error,*999)
20756  CASE(solver_nonlinear_sqp)
20757  CALL flagerror("Not implemented.",err,error,*999)
20758  CASE(solver_nonlinear_quasi_newton)
20759  CALL solver_quasi_newton_finalise(nonlinear_solver%QUASI_NEWTON_SOLVER,err,error,*999)
20760  CASE DEFAULT
20761  local_error="The nonlinear solver type of "// &
20762  & trim(numbertovstring(nonlinear_solver%NONLINEAR_SOLVE_TYPE,"*",err,error))//" is invalid."
20763  CALL flagerror(local_error,err,error,*999)
20764  END SELECT
20765  nonlinear_solver%NONLINEAR_SOLVE_TYPE=nonlinear_solve_type
20766  !Intialise the new solver type
20767  SELECT CASE(nonlinear_solve_type)
20768  CASE(solver_nonlinear_newton)
20769  NULLIFY(nonlinear_solver%NEWTON_SOLVER)
20770  CALL solver_newton_initialise(nonlinear_solver,err,error,*999)
20771  CASE(solver_nonlinear_bfgs_inverse)
20772  CALL flagerror("Not implemented.",err,error,*999)
20773  CASE(solver_nonlinear_sqp)
20774  CALL flagerror("Not implemented.",err,error,*999)
20775  CASE(solver_nonlinear_quasi_newton)
20776  NULLIFY(nonlinear_solver%QUASI_NEWTON_SOLVER)
20777  CALL solver_quasi_newton_initialise(nonlinear_solver,err,error,*999)
20778  CASE DEFAULT
20779  local_error="The specified nonlinear solver type of "// &
20780  & trim(numbertovstring(nonlinear_solve_type,"*",err,error))//" is invalid."
20781  CALL flagerror(local_error,err,error,*999)
20782  END SELECT
20783  ENDIF
20784  ELSE
20785  CALL flagerror("The solver nonlinear solver is not associated.",err,error,*998)
20786  ENDIF
20787  ELSE
20788  CALL flagerror("The solver is not a nonlinear solver.",err,error,*998)
20789  ENDIF
20790  ENDIF
20791  ELSE
20792  CALL flagerror("Solver is not associated.",err,error,*998)
20793  ENDIF
20794 
20795  exits("SOLVER_NONLINEAR_TYPE_SET")
20796  RETURN
20797 999 SELECT CASE(nonlinear_solve_type)
20798  CASE(solver_nonlinear_newton)
20799  CALL solver_newton_finalise(nonlinear_solver%NEWTON_SOLVER,dummy_err,dummy_error,*998)
20800  CASE(solver_nonlinear_bfgs_inverse)
20801  CALL flagerror("Not implemented.",err,error,*998)
20802  CASE(solver_nonlinear_sqp)
20803  CALL flagerror("Not implemented.",err,error,*998)
20804  CASE(solver_nonlinear_quasi_newton)
20805  CALL solver_quasi_newton_finalise(nonlinear_solver%QUASI_NEWTON_SOLVER,dummy_err,dummy_error,*998)
20806  END SELECT
20807 998 errorsexits("SOLVER_NONLINEAR_TYPE_SET",err,error)
20808  RETURN 1
20809 
20810  END SUBROUTINE solver_nonlinear_type_set
20811 
20812  !
20813  !================================================================================================================================
20814  !
20815 
20817  SUBROUTINE solver_optimiser_create_finish(OPTIMISER_SOLVER,ERR,ERROR,*)
20818 
20819  !Argument variables
20820  TYPE(optimiser_solver_type), POINTER :: OPTIMISER_SOLVER
20821  INTEGER(INTG), INTENT(OUT) :: ERR
20822  TYPE(varying_string), INTENT(OUT) :: ERROR
20823  !Local Variables
20824 
20825  enters("SOLVER_OPTIMISER_CREATE_FINISH",err,error,*999)
20826 
20827  IF(ASSOCIATED(optimiser_solver)) THEN
20828  CALL flagerror("Not implemented.",err,error,*999)
20829  ELSE
20830  CALL flagerror("Optimiser solver is not associated.",err,error,*999)
20831  ENDIF
20832 
20833  exits("SOLVER_OPTIMISER_CREATE_FINISH")
20834  RETURN
20835 999 errorsexits("SOLVER_OPTIMISER_CREATE_FINISH",err,error)
20836  RETURN 1
20837 
20838  END SUBROUTINE solver_optimiser_create_finish
20839 
20840  !
20841  !================================================================================================================================
20842  !
20843 
20845  SUBROUTINE solver_optimiser_finalise(OPTIMISER_SOLVER,ERR,ERROR,*)
20846 
20847  !Argument variables
20848  TYPE(optimiser_solver_type), POINTER :: OPTIMISER_SOLVER
20849  INTEGER(INTG), INTENT(OUT) :: ERR
20850  TYPE(varying_string), INTENT(OUT) :: ERROR
20851  !Local Variables
20852 
20853  enters("SOLVER_OPTIMISER_FINALISE",err,error,*999)
20854 
20855  IF(ASSOCIATED(optimiser_solver)) THEN
20856  DEALLOCATE(optimiser_solver)
20857  ENDIF
20858 
20859  exits("SOLVER_OPTIMISER_FINALISE")
20860  RETURN
20861 999 errorsexits("SOLVER_OPTIMISER_FINALISE",err,error)
20862  RETURN 1
20863 
20864  END SUBROUTINE solver_optimiser_finalise
20865 
20866  !
20867  !================================================================================================================================
20868  !
20869 
20871  SUBROUTINE solver_optimiser_initialise(SOLVER,ERR,ERROR,*)
20872 
20873  !Argument variables
20874  TYPE(solver_type), POINTER :: SOLVER
20875  INTEGER(INTG), INTENT(OUT) :: ERR
20876  TYPE(varying_string), INTENT(OUT) :: ERROR
20877  !Local Variables
20878  INTEGER(INTG) :: DUMMY_ERR
20879  TYPE(varying_string) :: DUMMY_ERROR
20880 
20881  enters("SOLVER_OPTIMISER_INITIALISE",err,error,*998)
20882 
20883  IF(ASSOCIATED(solver)) THEN
20884  IF(ASSOCIATED(solver%OPTIMISER_SOLVER)) THEN
20885  CALL flagerror("Optimiser solver is already associated for this solver.",err,error,*998)
20886  ELSE
20887  ALLOCATE(solver%OPTIMISER_SOLVER,stat=err)
20888  IF(err/=0) CALL flagerror("Could not allocate solver optimiser solver.",err,error,*999)
20889  solver%OPTIMISER_SOLVER%SOLVER=>solver
20890  solver%OPTIMISER_SOLVER%SOLVER_LIBRARY=solver_tao_library
20891  solver%OPTIMISER_SOLVER%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
20892  ENDIF
20893  ELSE
20894  CALL flagerror("Solver is not associated.",err,error,*998)
20895  ENDIF
20896 
20897  exits("SOLVER_OPTIMISER_INITIALISE")
20898  RETURN
20899 999 CALL solver_optimiser_finalise(solver%OPTIMISER_SOLVER,dummy_err,dummy_error,*998)
20900 998 errorsexits("SOLVER_OPTIMISER_INITIALISE",err,error)
20901  RETURN 1
20902 
20903  END SUBROUTINE solver_optimiser_initialise
20904 
20905  !
20906  !================================================================================================================================
20907  !
20908 
20910  SUBROUTINE solver_optimiser_library_type_get(OPTIMISER_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
20911 
20912  !Argument variables
20913  TYPE(optimiser_solver_type), POINTER :: OPTIMISER_SOLVER
20914  INTEGER(INTG), INTENT(OUT) :: SOLVER_LIBRARY_TYPE
20915  INTEGER(INTG), INTENT(OUT) :: ERR
20916  TYPE(varying_string), INTENT(OUT) :: ERROR
20917  !Local Variables
20918 
20919  enters("SOLVER_OPTIMISER_LIBRARY_TYPE_GET",err,error,*999)
20920 
20921  IF(ASSOCIATED(optimiser_solver)) THEN
20922  solver_library_type=optimiser_solver%SOLVER_LIBRARY
20923  ELSE
20924  CALL flagerror("Optimiser solver is not associated.",err,error,*999)
20925  ENDIF
20926 
20927  exits("SOLVER_OPTIMISER_LIBRARY_TYPE_GET")
20928  RETURN
20929 999 errorsexits("SOLVER_OPTIMISER_LIBRARY_TYPE_GET",err,error)
20930  RETURN 1
20931 
20932  END SUBROUTINE solver_optimiser_library_type_get
20933 
20934  !
20935  !================================================================================================================================
20936  !
20937 
20939  SUBROUTINE solver_optimiser_library_type_set(OPTIMISER_SOLVER,SOLVER_LIBRARY_TYPE,ERR,ERROR,*)
20940 
20941  !Argument variables
20942  TYPE(optimiser_solver_type), POINTER :: OPTIMISER_SOLVER
20943  INTEGER(INTG), INTENT(IN) :: SOLVER_LIBRARY_TYPE
20944  INTEGER(INTG), INTENT(OUT) :: ERR
20945  TYPE(varying_string), INTENT(OUT) :: ERROR
20946  !Local Variables
20947  TYPE(varying_string) :: LOCAL_ERROR
20948 
20949  enters("SOLVER_OPTIMISER_LIBRARY_TYPE_SET",err,error,*999)
20950 
20951  IF(ASSOCIATED(optimiser_solver)) THEN
20952  SELECT CASE(solver_library_type)
20953  CASE(solver_cmiss_library)
20954  CALL flagerror("Not implemented.",err,error,*999)
20955  CASE(solver_tao_library)
20956  optimiser_solver%SOLVER_LIBRARY=solver_tao_library
20957  optimiser_solver%SOLVER_MATRICES_LIBRARY=distributed_matrix_vector_petsc_type
20958  CASE DEFAULT
20959  local_error="The specified solver library type of "//trim(numbertovstring(solver_library_type,"*",err,error))// &
20960  & " is invalid for an optimiser solver."
20961  CALL flagerror(local_error,err,error,*999)
20962  END SELECT
20963  ELSE
20964  CALL flagerror("Optimiser solver is not associated.",err,error,*999)
20965  ENDIF
20966 
20967  exits("SOLVER_OPTIMISER_LIBRARY_TYPE_SET")
20968  RETURN
20969 999 errorsexits("SOLVER_OPTIMISER_LIBRARY_TYPE_SET",err,error)
20970  RETURN 1
20971 
20972  END SUBROUTINE solver_optimiser_library_type_set
20973 
20974  !
20975  !================================================================================================================================
20976  !
20977 
20979  SUBROUTINE solver_optimiser_matrices_library_type_get(OPTIMISER_SOLVER,MATRICES_LIBRARY_TYPE,ERR,ERROR,*)
20980 
20981  !Argument variables
20982  TYPE(optimiser_solver_type), POINTER :: OPTIMISER_SOLVER
20983  INTEGER(INTG), INTENT(OUT) :: MATRICES_LIBRARY_TYPE
20984  INTEGER(INTG), INTENT(OUT) :: ERR
20985  TYPE(varying_string), INTENT(OUT) :: ERROR
20986  !Local Variables
20987 
20988  enters("SOLVER_OPTIMISER_MATRICES_LIBRARY_TYPE_GET",err,error,*999)
20989 
20990  IF(ASSOCIATED(optimiser_solver)) THEN
20991  matrices_library_type=optimiser_solver%SOLVER_MATRICES_LIBRARY
20992  ELSE
20993  CALL flagerror("Optimiser solver is not associated.",err,error,*999)
20994  ENDIF
20995 
20996  exits("SOLVER_OPTIMISER_MATRICES_LIBRARY_TYPE_GET")
20997  RETURN
20998 999 errorsexits("SOLVER_OPTIMISER_MATRICES_LIBRARY_TYPE_GET",err,error)
20999  RETURN 1
21000 
21001  END SUBROUTINE solver_optimiser_matrices_library_type_get
21002 
21003  !
21004  !================================================================================================================================
21005  !
21006 
21008  SUBROUTINE solver_optimiser_solve(OPTIMISER_SOLVER,ERR,ERROR,*)
21009 
21010  !Argument variables
21011  TYPE(optimiser_solver_type), POINTER :: OPTIMISER_SOLVER
21012  INTEGER(INTG), INTENT(OUT) :: ERR
21013  TYPE(varying_string), INTENT(OUT) :: ERROR
21014  !Local Variables
21015 
21016  enters("SOLVER_OPTIMISER_SOLVE",err,error,*999)
21017 
21018  IF(ASSOCIATED(optimiser_solver)) THEN
21019  CALL flagerror("Not implemented.",err,error,*999)
21020  ELSE
21021  CALL flagerror("Optimiser solver is not associated.",err,error,*999)
21022  ENDIF
21023 
21024  exits("SOLVER_OPTIMISER_SOLVE")
21025  RETURN
21026 999 errorsexits("SOLVER_OPTIMISER_SOLVE",err,error)
21027  RETURN 1
21028 
21029  END SUBROUTINE solver_optimiser_solve
21030 
21031  !
21032  !================================================================================================================================
21033  !
21034 
21036  SUBROUTINE solver_output_type_set(SOLVER,OUTPUT_TYPE,ERR,ERROR,*)
21037 
21038  !Argument variables
21039  TYPE(solver_type), POINTER :: SOLVER
21040  INTEGER(INTG), INTENT(IN) :: OUTPUT_TYPE
21041  INTEGER(INTG), INTENT(OUT) :: ERR
21042  TYPE(varying_string), INTENT(OUT) :: ERROR
21043  !Local Variables
21044  TYPE(varying_string) :: LOCAL_ERROR
21045 
21046  enters("SOLVER_OUTPUT_TYPE_SET",err,error,*999)
21047 
21048  IF(ASSOCIATED(solver)) THEN
21049  IF(solver%SOLVER_FINISHED) THEN
21050  CALL flagerror("Solver has already been finished.",err,error,*999)
21051  ELSE
21052  SELECT CASE(output_type)
21053  CASE(solver_no_output)
21054  solver%OUTPUT_TYPE=solver_no_output
21055  CASE(solver_progress_output)
21056  solver%OUTPUT_TYPE=solver_progress_output
21057  CASE(solver_timing_output)
21058  solver%OUTPUT_TYPE=solver_timing_output
21059  CASE(solver_solver_output)
21060  solver%OUTPUT_TYPE=solver_solver_output
21061  CASE(solver_matrix_output)
21062  solver%OUTPUT_TYPE=solver_matrix_output
21063  CASE DEFAULT
21064  local_error="The specified solver output type of "// &
21065  & trim(numbertovstring(output_type,"*",err,error))//" is invalid."
21066  CALL flagerror(local_error,err,error,*999)
21067  END SELECT
21068  ENDIF
21069  ELSE
21070  CALL flagerror("Solver is not associated.",err,error,*999)
21071  ENDIF
21072 
21073  exits("SOLVER_OUTPUT_TYPE_SET")
21074  RETURN
21075 999 errorsexits("SOLVER_OUTPUT_TYPE_SET",err,error)
21076  RETURN 1
21077 
21078  END SUBROUTINE solver_output_type_set
21079 
21080  !
21081  !================================================================================================================================
21082  !
21083 
21085  SUBROUTINE solver_solution_update(SOLVER,ERR,ERROR,*)
21086 
21087  !Argument variables
21088  TYPE(solver_type), POINTER :: SOLVER
21089  INTEGER(INTG), INTENT(OUT) :: ERR
21090  TYPE(varying_string), INTENT(OUT) :: ERROR
21091  !Local Variables
21092  INTEGER(INTG) :: column_number,equations_set_idx,local_number,solver_matrix_idx,variable_dof_idx,variable_idx,variable_type, &
21093  & interface_condition_idx
21094  REAL(DP) :: additive_constant,VALUE,coupling_coefficient
21095  REAL(DP), POINTER :: VARIABLE_DATA(:)
21096  TYPE(distributed_vector_type), POINTER :: SOLVER_VECTOR
21097  TYPE(domain_mapping_type), POINTER :: DOMAIN_MAPPING
21098  TYPE(field_type), POINTER :: DEPENDENT_FIELD,LAGRANGE_FIELD
21099  TYPE(field_variable_type), POINTER :: DEPENDENT_VARIABLE,LAGRANGE_VARIABLE
21100  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
21101  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
21102  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
21103  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
21104 
21105  NULLIFY(variable_data)
21106 
21107  enters("SOLVER_SOLUTION_UPDATE",err,error,*999)
21108 
21109  IF(ASSOCIATED(solver)) THEN
21110  IF(solver%SOLVER_FINISHED) THEN
21111  solver_equations=>solver%SOLVER_EQUATIONS
21112  IF(ASSOCIATED(solver_equations)) THEN
21113  solver_matrices=>solver_equations%SOLVER_MATRICES
21114  IF(ASSOCIATED(solver_matrices)) THEN
21115  solver_mapping=>solver_matrices%SOLVER_MAPPING
21116  IF(ASSOCIATED(solver_mapping)) THEN
21117  DO solver_matrix_idx=1,solver_matrices%NUMBER_OF_MATRICES
21118  solver_matrix=>solver_matrices%MATRICES(solver_matrix_idx)%PTR
21119  IF(ASSOCIATED(solver_matrix)) THEN
21120  solver_vector=>solver_matrix%SOLVER_VECTOR
21121  IF(ASSOCIATED(solver_vector)) THEN
21122  domain_mapping=>solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)%COLUMN_DOFS_MAPPING
21123  IF(ASSOCIATED(domain_mapping)) THEN
21124  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
21125  DO variable_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
21126  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_VARIABLES
21127  dependent_variable=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
21128  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%VARIABLES(variable_idx)%PTR
21129  IF(ASSOCIATED(dependent_variable)) THEN
21130  variable_type=dependent_variable%VARIABLE_TYPE
21131  dependent_field=>dependent_variable%FIELD
21132  NULLIFY(variable_data)
21133  CALL field_parameter_set_data_get(dependent_field,variable_type,field_values_set_type,variable_data, &
21134  & err,error,*999)
21135  DO variable_dof_idx=1,dependent_variable%NUMBER_OF_DOFS
21136  column_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
21137  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%VARIABLE_TO_SOLVER_COL_MAPS(variable_idx)% &
21138  & column_numbers(variable_dof_idx)
21139  IF(column_number/=0) THEN
21140  coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
21141  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%VARIABLE_TO_SOLVER_COL_MAPS( &
21142  & variable_idx)%COUPLING_COEFFICIENTS(variable_dof_idx)
21143  additive_constant=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
21144  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%VARIABLE_TO_SOLVER_COL_MAPS( &
21145  & variable_idx)%ADDITIVE_CONSTANTS(variable_dof_idx)
21146  VALUE=variable_data(variable_dof_idx)*coupling_coefficient+additive_constant
21147  local_number=domain_mapping%GLOBAL_TO_LOCAL_MAP(column_number)%LOCAL_NUMBER(1)
21148  CALL distributed_vector_values_set(solver_vector,local_number,VALUE,err,error,*999)
21149  ENDIF
21150  ENDDO !variable_dof_idx
21151  CALL field_parameter_set_data_restore(dependent_field,variable_type,field_values_set_type, &
21152  & variable_data,err,error,*999)
21153  ELSE
21154  CALL flagerror("Variable is not associated.",err,error,*999)
21155  ENDIF
21156  ENDDO !variable_idx
21157  ENDDO !equations_set_idx
21158  DO interface_condition_idx=1,solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS
21159  lagrange_variable=>solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
21160  & interface_to_solver_matrix_maps_sm(solver_matrix_idx)%LAGRANGE_VARIABLE
21161  IF(ASSOCIATED(dependent_variable)) THEN
21162  variable_type=lagrange_variable%VARIABLE_TYPE
21163  lagrange_field=>lagrange_variable%FIELD
21164  NULLIFY(variable_data)
21165  CALL field_parameter_set_data_get(lagrange_field,variable_type,field_values_set_type,variable_data, &
21166  & err,error,*999)
21167  DO variable_dof_idx=1,lagrange_variable%NUMBER_OF_DOFS
21168  column_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
21169  & interface_to_solver_matrix_maps_sm(solver_matrix_idx)%LAGRANGE_VARIABLE_TO_SOLVER_COL_MAP% &
21170  & column_numbers(variable_dof_idx)
21171  IF(column_number/=0) THEN
21172  coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
21173  & interface_to_solver_matrix_maps_sm(solver_matrix_idx)%LAGRANGE_VARIABLE_TO_SOLVER_COL_MAP% &
21174  & coupling_coefficients(variable_dof_idx)
21175  additive_constant=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
21176  & interface_to_solver_matrix_maps_sm(solver_matrix_idx)%LAGRANGE_VARIABLE_TO_SOLVER_COL_MAP% &
21177  & additive_constants(variable_dof_idx)
21178  VALUE=variable_data(variable_dof_idx)*coupling_coefficient+additive_constant
21179  local_number=domain_mapping%GLOBAL_TO_LOCAL_MAP(column_number)%LOCAL_NUMBER(1)
21180  CALL distributed_vector_values_set(solver_vector,local_number,VALUE,err,error,*999)
21181  ENDIF
21182  ENDDO !variable_dof_idx
21183  CALL field_parameter_set_data_restore(dependent_field,variable_type,field_values_set_type, &
21184  & variable_data,err,error,*999)
21185  ELSE
21186  CALL flagerror("Variable is not associated.",err,error,*999)
21187  ENDIF
21188  ENDDO !equations_set_idx
21189  ELSE
21190  CALL flagerror("Domain mapping is not associated.",err,error,*999)
21191  ENDIF
21192  CALL distributed_vector_update_start(solver_vector,err,error,*999)
21193  CALL distributed_vector_update_finish(solver_vector,err,error,*999)
21194  ELSE
21195  CALL flagerror("Solver vector is not associated.",err,error,*999)
21196  ENDIF
21197  ELSE
21198  CALL flagerror("Solver matrix is not associated.",err,error,*999)
21199  ENDIF
21200  ENDDO !solver_matrix_idx
21201  ELSE
21202  CALL flagerror("Solver matrices solution mapping is not associated.",err,error,*999)
21203  ENDIF
21204  ELSE
21205  CALL flagerror("Solver equations solver matrices are not associated.",err,error,*999)
21206  ENDIF
21207  ELSE
21208  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
21209  ENDIF
21210  ELSE
21211  CALL flagerror("Solver has not been finished.",err,error,*999)
21212  ENDIF
21213  ELSE
21214  CALL flagerror("Solver is not associated.",err,error,*999)
21215  ENDIF
21216 
21217  exits("SOLVER_SOLUTION_UPDATE")
21218  RETURN
21219 999 errorsexits("SOLVER_SOLUTION_UPDATE",err,error)
21220  RETURN 1
21221 
21222  END SUBROUTINE solver_solution_update
21223 
21224  !
21225  !================================================================================================================================
21226  !
21227 
21229  SUBROUTINE solver_solver_equations_get(SOLVER,SOLVER_EQUATIONS,ERR,ERROR,*)
21230 
21231  !Argument variables
21232  TYPE(solver_type), POINTER :: SOLVER
21233  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
21234  INTEGER(INTG), INTENT(OUT) :: ERR
21235  TYPE(varying_string), INTENT(OUT) :: ERROR
21236  !Local Variables
21237 
21238  enters("SOLVER_SOLVER_EQUATIONS_GET",err,error,*998)
21239 
21240  IF(ASSOCIATED(solver)) THEN
21241  IF(solver%SOLVER_FINISHED) THEN
21242  IF(ASSOCIATED(solver_equations)) THEN
21243  CALL flagerror("Solver equations is already associated.",err,error,*998)
21244  ELSE
21245  solver_equations=>solver%SOLVER_EQUATIONS
21246  IF(.NOT.ASSOCIATED(solver_equations)) CALL flagerror("Solver equations is not associated.",err,error,*999)
21247  ENDIF
21248  ELSE
21249  CALL flagerror("Solver has not been finished.",err,error,*998)
21250  ENDIF
21251  ELSE
21252  CALL flagerror("Solver is not associated.",err,error,*998)
21253  ENDIF
21254 
21255  exits("SOLVER_SOLVER_EQUATIONS_GET")
21256  RETURN
21257 999 NULLIFY(solver_equations)
21258 998 errorsexits("SOLVER_SOLVER_EQUATIONS_GET",err,error)
21259  RETURN 1
21260 
21261  END SUBROUTINE solver_solver_equations_get
21262 
21263  !
21264  !================================================================================================================================
21265  !
21266 
21268  RECURSIVE SUBROUTINE solver_solve(SOLVER,ERR,ERROR,*)
21269 
21270  !Argument variables
21271  TYPE(solver_type), POINTER :: SOLVER
21272  INTEGER(INTG), INTENT(OUT) :: ERR
21273  TYPE(varying_string), INTENT(OUT) :: ERROR
21274  !Local Variables
21275  REAL(SP) :: SYSTEM_ELAPSED,SYSTEM_TIME1(1),SYSTEM_TIME2(1),USER_ELAPSED,USER_TIME1(1),USER_TIME2(1)
21276  TYPE(varying_string) :: LOCAL_ERROR
21277 
21278  enters("SOLVER_SOLVE",err,error,*999)
21279 
21280  IF(ASSOCIATED(solver)) THEN
21281  IF(solver%SOLVER_FINISHED) THEN
21282  IF(solver%OUTPUT_TYPE>=solver_timing_output) THEN
21283  CALL cpu_timer(user_cpu,user_time1,err,error,*999)
21284  CALL cpu_timer(system_cpu,system_time1,err,error,*999)
21285  ENDIF
21286  !Solve the system depending on the solver type
21287  SELECT CASE(solver%SOLVE_TYPE)
21288  CASE(solver_linear_type)
21289  !Solve linear equations
21290  CALL solver_linear_solve(solver%LINEAR_SOLVER,err,error,*999)
21291  CASE(solver_nonlinear_type)
21292  !Solve nonlinear equations
21293  CALL solver_nonlinear_solve(solver%NONLINEAR_SOLVER,err,error,*999)
21294  CASE(solver_dynamic_type)
21295  !Solve dynamic equations
21296  CALL solver_dynamic_solve(solver%DYNAMIC_SOLVER,err,error,*999)
21297  CASE(solver_dae_type)
21298  !Solve differential-algebraic equations
21299  CALL solver_dae_solve(solver%DAE_SOLVER,err,error,*999)
21300  CASE(solver_eigenproblem_type)
21301  !Solve eigenproblem
21302  CALL solver_eigenproblem_solve(solver%EIGENPROBLEM_SOLVER,err,error,*999)
21303  CASE(solver_optimiser_type)
21304  !Solve an optimisation problem
21305  CALL solver_optimiser_solve(solver%OPTIMISER_SOLVER,err,error,*999)
21306  CASE(solver_cellml_evaluator_type)
21307  !Solve a CellML evaluator
21308  CALL solver_cellml_evaluator_solve(solver%CELLML_EVALUATOR_SOLVER,err,error,*999)
21309  CASE DEFAULT
21310  local_error="The solver type of "//trim(numbertovstring(solver%SOLVE_TYPE,"*",err,error))//" is invalid."
21311  CALL flagerror(local_error,err,error,*999)
21312  END SELECT
21313  !If necessary output the timing information
21314  IF(solver%OUTPUT_TYPE>=solver_timing_output) THEN
21315  CALL cpu_timer(user_cpu,user_time2,err,error,*999)
21316  CALL cpu_timer(system_cpu,system_time2,err,error,*999)
21317  user_elapsed=user_time2(1)-user_time1(1)
21318  system_elapsed=system_time2(1)-system_time1(1)
21319  CALL write_string(general_output_type,"",err,error,*999)
21320  CALL write_string_value(general_output_type,"Total user time for solve = ",user_elapsed, &
21321  & err,error,*999)
21322  CALL write_string_value(general_output_type,"Total System time for solve = ",system_elapsed, &
21323  & err,error,*999)
21324  ENDIF
21325  ELSE
21326  CALL flagerror("Solver has not been finished.",err,error,*999)
21327  ENDIF
21328  ELSE
21329  CALL flagerror("Solver is not associated.",err,error,*999)
21330  ENDIF
21331 
21332  exits("SOLVER_SOLVE")
21333  RETURN
21334 999 errorsexits("SOLVER_SOLVE",err,error)
21335  RETURN 1
21336 
21337  END SUBROUTINE solver_solve
21338 
21339  !
21340  !================================================================================================================================
21341  !
21342 
21344  SUBROUTINE solver_type_set(SOLVER,SOLVE_TYPE,ERR,ERROR,*)
21345 
21346  !Argument variables
21347  TYPE(solver_type), POINTER :: SOLVER
21348  INTEGER(INTG), INTENT(IN) :: SOLVE_TYPE
21349  INTEGER(INTG), INTENT(OUT) :: ERR
21350  TYPE(varying_string), INTENT(OUT) :: ERROR
21351  !Local Variables
21352  INTEGER(INTG) :: DUMMY_ERR
21353  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
21354 
21355  enters("SOLVER_TYPE_SET",err,error,*998)
21356 
21357  IF(ASSOCIATED(solver)) THEN
21358  IF(solver%SOLVER_FINISHED) THEN
21359  CALL flagerror("Solver has already been finished.",err,error,*998)
21360  ELSE
21361  IF(ASSOCIATED(solver%LINKING_SOLVER)) THEN
21362  CALL flagerror("Can not changed the solver type for a solve that has been linked.",err,error,*998)
21363  ELSE
21364  IF(solve_type/=solver%SOLVE_TYPE) THEN
21365  !Initialise the new solver type
21366  SELECT CASE(solve_type)
21367  CASE(solver_linear_type)
21368  CALL solver_linear_initialise(solver,err,error,*999)
21369  CASE(solver_nonlinear_type)
21370  CALL solver_nonlinear_initialise(solver,err,error,*999)
21371  CASE(solver_dynamic_type)
21372  CALL solver_dynamic_initialise(solver,err,error,*999)
21373  CASE(solver_dae_type)
21374  CALL solver_dae_initialise(solver,err,error,*999)
21375  CASE(solver_eigenproblem_type)
21376  CALL solver_eigenproblem_initialise(solver,err,error,*999)
21377  CASE(solver_optimiser_type)
21378  CALL solver_optimiser_initialise(solver,err,error,*999)
21379  CASE(solver_cellml_evaluator_type)
21380  CALL solver_cellml_evaluator_initialise(solver,err,error,*999)
21381  CASE(solver_geometric_transformation_type)
21382  CALL solver_geometrictransformationinitialise(solver,err,error,*999)
21383  CASE DEFAULT
21384  local_error="The specified solve type of "//trim(numbertovstring(solve_type,"*",err,error))//" is invalid."
21385  CALL flagerror(local_error,err,error,*999)
21386  END SELECT
21387  !Finalise the old solve type
21388  SELECT CASE(solver%SOLVE_TYPE)
21389  CASE(solver_linear_type)
21390  CALL solver_linear_finalise(solver%LINEAR_SOLVER,err,error,*999)
21391  CASE(solver_nonlinear_type)
21392  CALL solver_nonlinear_finalise(solver%NONLINEAR_SOLVER,err,error,*999)
21393  CASE(solver_dynamic_type)
21394  CALL solver_dynamic_finalise(solver%DYNAMIC_SOLVER,err,error,*999)
21395  CASE(solver_dae_type)
21396  CALL solver_dae_finalise(solver%DAE_SOLVER,err,error,*999)
21397  CASE(solver_eigenproblem_type)
21398  CALL solver_eigenproblem_finalise(solver%EIGENPROBLEM_SOLVER,err,error,*999)
21399  CASE(solver_optimiser_type)
21400  CALL solver_optimiser_finalise(solver%OPTIMISER_SOLVER,err,error,*999)
21401  CASE(solver_cellml_evaluator_type)
21402  CALL solver_cellml_evaluator_finalise(solver%CELLML_EVALUATOR_SOLVER,err,error,*999)
21403  CASE(solver_geometric_transformation_type)
21404  CALL solver_geometrictransformationfinalise(solver%geometricTransformationSolver,err,error,*999)
21405  CASE DEFAULT
21406  local_error="The solver solve type of "//trim(numbertovstring(solver%SOLVE_TYPE,"*",err,error))//" is invalid."
21407  CALL flagerror(local_error,err,error,*999)
21408  END SELECT
21409  !Set the solve type
21410  solver%SOLVE_TYPE=solve_type
21411  ENDIF
21412  ENDIF
21413  ENDIF
21414  ELSE
21415  CALL flagerror("Solver is not associated.",err,error,*998)
21416  ENDIF
21417 
21418  exits("SOLVER_TYPE_SET")
21419  RETURN
21420 999 SELECT CASE(solve_type)
21421  CASE(solver_linear_type)
21422  CALL solver_linear_finalise(solver%LINEAR_SOLVER,dummy_err,dummy_error,*998)
21423  CASE(solver_nonlinear_type)
21424  CALL solver_nonlinear_finalise(solver%NONLINEAR_SOLVER,dummy_err,dummy_error,*998)
21425  CASE(solver_dynamic_type)
21426  CALL solver_dynamic_finalise(solver%DYNAMIC_SOLVER,dummy_err,dummy_error,*998)
21427  CASE(solver_dae_type)
21428  CALL solver_dae_finalise(solver%DAE_SOLVER,dummy_err,dummy_error,*998)
21429  CASE(solver_eigenproblem_type)
21430  CALL solver_eigenproblem_finalise(solver%EIGENPROBLEM_SOLVER,dummy_err,dummy_error,*998)
21431  CASE(solver_optimiser_type)
21432  CALL solver_optimiser_finalise(solver%OPTIMISER_SOLVER,dummy_err,dummy_error,*998)
21433  CASE(solver_geometric_transformation_type)
21434  CALL solver_geometrictransformationfinalise(solver%geometricTransformationSolver,err,error,*999)
21435  END SELECT
21436 998 errorsexits("SOLVER_TYPE_SET",err,error)
21437  RETURN 1
21438 
21439  END SUBROUTINE solver_type_set
21440 
21441  !
21442  !================================================================================================================================
21443  !
21444 
21446  SUBROUTINE solver_variables_dynamic_field_update(SOLVER,ERR,ERROR,*)
21447 
21448  !Argument variables
21449  TYPE(solver_type), POINTER :: SOLVER
21450  INTEGER(INTG), INTENT(OUT) :: ERR
21451  TYPE(varying_string), INTENT(OUT) :: ERROR
21452  !Local Variables
21453  INTEGER(INTG) :: DUMMY_ERR,DYNAMIC_VARIABLE_TYPE,equations_idx,equations_set_idx,solver_dof_idx,solver_matrix_idx,variable_dof
21454  REAL(DP) :: ACCELERATION_VALUE,additive_constant,DELTA_T,DISPLACEMENT_VALUE,PREDICTED_DISPLACEMENT,PREVIOUS_ACCELERATION, &
21455  & PREVIOUS_DISPLACEMENT,PREVIOUS_VELOCITY,SOLVER_VALUE,variable_coefficient,VELOCITY_VALUE
21456  REAL(DP), POINTER :: SOLVER_DATA(:)
21457  TYPE(distributed_vector_type), POINTER :: SOLVER_VECTOR
21458  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
21459  TYPE(equations_type), POINTER :: EQUATIONS
21460  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
21461  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
21462  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
21463  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
21464  TYPE(field_type), POINTER :: DEPENDENT_FIELD
21465  TYPE(field_variable_type), POINTER :: DEPENDENT_VARIABLE
21466  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
21467  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
21468  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
21469  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
21470  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
21471 
21472  NULLIFY(solver_data)
21473 
21474  enters("SOLVER_VARIABLES_DYNAMIC_FIELD_UPDATE",err,error,*998)
21475 
21476  IF(ASSOCIATED(solver)) THEN
21477  IF(solver%SOLVER_FINISHED) THEN
21478  dynamic_solver=>solver%DYNAMIC_SOLVER
21479  IF(ASSOCIATED(dynamic_solver)) THEN
21480  delta_t=dynamic_solver%TIME_INCREMENT
21481  solver_equations=>solver%SOLVER_EQUATIONS
21482  IF(ASSOCIATED(solver_equations)) THEN
21483  solver_matrices=>solver_equations%SOLVER_MATRICES
21484  IF(ASSOCIATED(solver_matrices)) THEN
21485  solver_mapping=>solver_matrices%SOLVER_MAPPING
21486  IF(ASSOCIATED(solver_mapping)) THEN
21487  DO solver_matrix_idx=1,solver_matrices%NUMBER_OF_MATRICES
21488  solver_matrix=>solver_matrices%MATRICES(solver_matrix_idx)%PTR
21489  IF(ASSOCIATED(solver_matrix)) THEN
21490  solver_vector=>solver_matrix%SOLVER_VECTOR
21491  IF(ASSOCIATED(solver_vector)) THEN
21492  !Get the solver variables data
21493  CALL distributed_vector_data_get(solver_vector,solver_data,err,error,*999)
21494  !Loop over the solver variable dofs
21495  DO solver_dof_idx=1,solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)%NUMBER_OF_DOFS
21496  !Loop over the equations sets associated with this dof
21497  DO equations_idx=1,solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
21498  & solver_dof_to_variable_maps(solver_dof_idx)%NUMBER_OF_EQUATION_DOFS
21499  SELECT CASE(solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
21500  & solver_dof_to_variable_maps(solver_dof_idx)%EQUATIONS_TYPES(equations_idx))
21501  CASE(solver_mapping_equations_equations_set)
21502  dependent_variable=>solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
21503  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE(equations_idx)%PTR
21504  IF(ASSOCIATED(dependent_variable)) THEN
21505  dynamic_variable_type=dependent_variable%VARIABLE_TYPE
21506  NULLIFY(dependent_field)
21507  dependent_field=>dependent_variable%FIELD
21508  IF(ASSOCIATED(dependent_field)) THEN
21509  !Get the dependent field dof the solver dof is mapped to
21510  variable_dof=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
21511  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE_DOF(equations_idx)
21512  variable_coefficient=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
21513  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE_COEFFICIENT(equations_idx)
21514  additive_constant=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
21515  & solver_dof_to_variable_maps(solver_dof_idx)%ADDITIVE_CONSTANT(equations_idx)
21516  solver_value=solver_data(solver_dof_idx)*variable_coefficient+additive_constant
21517  !Set the dependent field dof
21518  IF(dynamic_solver%SOLVER_INITIALISED) THEN
21519  SELECT CASE(dynamic_solver%DEGREE)
21520  CASE(solver_dynamic_first_degree)
21521  !If we are nonlinear then use the previously calculated predicted displacement
21522  IF(dynamic_solver%LINEARITY==solver_dynamic_nonlinear) THEN
21523  CALL field_parameter_set_get_local_dof(dependent_field,dynamic_variable_type, &
21524  & field_predicted_displacement_set_type,variable_dof,predicted_displacement, &
21525  & err,error,*999)
21526  displacement_value=predicted_displacement+delta_t*solver_value
21527  ELSE
21528  CALL field_parameter_set_get_local_dof(dependent_field,dynamic_variable_type, &
21529  & field_values_set_type,variable_dof,previous_displacement, &
21530  & err,error,*999)
21531  displacement_value=previous_displacement+delta_t*solver_value
21532  ENDIF
21533  CALL field_parameter_set_update_local_dof(dependent_field,dynamic_variable_type, &
21534  & field_values_set_type,variable_dof,displacement_value,err,error,*999)
21535  CASE(solver_dynamic_second_degree)
21536  !If we are nonlinear then use the previously calculated predicted displacement
21537  IF(dynamic_solver%LINEARITY==solver_dynamic_nonlinear) THEN
21538  CALL field_parameter_set_get_local_dof(dependent_field,dynamic_variable_type, &
21539  & field_predicted_displacement_set_type,variable_dof,predicted_displacement, &
21540  & err,error,*999)
21541  CALL field_parameter_set_get_local_dof(dependent_field,dynamic_variable_type, &
21542  & field_previous_velocity_set_type,variable_dof,previous_velocity, &
21543  & err,error,*999)
21544  displacement_value=predicted_displacement+delta_t*previous_velocity+ &
21545  & (delta_t*delta_t/2.0_dp)*solver_value
21546  ELSE
21547  CALL field_parameter_set_get_local_dof(dependent_field,dynamic_variable_type, &
21548  & field_values_set_type,variable_dof,previous_displacement, &
21549  & err,error,*999)
21550  CALL field_parameter_set_get_local_dof(dependent_field,dynamic_variable_type, &
21551  & field_previous_velocity_set_type,variable_dof,previous_velocity, &
21552  & err,error,*999)
21553  displacement_value=previous_displacement+delta_t*previous_velocity+ &
21554  & (delta_t*delta_t/2.0_dp)*solver_value
21555  ENDIF
21556  CALL field_parameter_set_get_local_dof(dependent_field,dynamic_variable_type, &
21557  & field_previous_velocity_set_type,variable_dof,previous_velocity, &
21558  & err,error,*999)
21559  velocity_value=previous_velocity+delta_t*solver_value
21560  CALL field_parameter_set_update_local_dof(dependent_field,dynamic_variable_type, &
21561  & field_values_set_type,variable_dof,displacement_value,err,error,*999)
21562  CALL field_parameter_set_update_local_dof(dependent_field,dynamic_variable_type, &
21563  & field_velocity_values_set_type,variable_dof,velocity_value,err,error,*999)
21564  CASE(solver_dynamic_third_degree)
21565  !If we are nonlinear then use the previously calculated predicted displacement
21566  IF(dynamic_solver%LINEARITY==solver_dynamic_nonlinear) THEN
21567  CALL field_parameter_set_get_local_dof(dependent_field,dynamic_variable_type, &
21568  & field_predicted_displacement_set_type,variable_dof,predicted_displacement, &
21569  & err,error,*999)
21570  CALL field_parameter_set_get_local_dof(dependent_field,dynamic_variable_type, &
21571  & field_previous_velocity_set_type,variable_dof,previous_velocity, &
21572  & err,error,*999)
21573  CALL field_parameter_set_get_local_dof(dependent_field,dynamic_variable_type, &
21574  & field_previous_acceleration_set_type,variable_dof,previous_acceleration, &
21575  & err,error,*999)
21576  displacement_value=predicted_displacement+delta_t*previous_velocity+ &
21577  & (delta_t*delta_t/2.0_dp)*previous_acceleration+ &
21578  & (delta_t*delta_t*delta_t/6.0_dp)*solver_value
21579  ELSE
21580  CALL field_parameter_set_get_local_dof(dependent_field,dynamic_variable_type, &
21581  & field_values_set_type,variable_dof,previous_displacement, &
21582  & err,error,*999)
21583  CALL field_parameter_set_get_local_dof(dependent_field,dynamic_variable_type, &
21584  & field_previous_velocity_set_type,variable_dof,previous_velocity, &
21585  & err,error,*999)
21586  CALL field_parameter_set_get_local_dof(dependent_field,dynamic_variable_type, &
21587  & field_previous_acceleration_set_type,variable_dof,previous_acceleration, &
21588  & err,error,*999)
21589  displacement_value=previous_displacement+delta_t*previous_velocity+ &
21590  & (delta_t*delta_t/2.0_dp)*previous_acceleration+ &
21591  & (delta_t*delta_t*delta_t/6.0_dp)*solver_value
21592  ENDIF
21593  CALL field_parameter_set_get_local_dof(dependent_field,dynamic_variable_type, &
21594  & field_previous_velocity_set_type,variable_dof,previous_velocity, &
21595  & err,error,*999)
21596  velocity_value=previous_velocity+delta_t*previous_acceleration+ &
21597  & (delta_t*delta_t/2.0_dp)*solver_value
21598  CALL field_parameter_set_get_local_dof(dependent_field,dynamic_variable_type, &
21599  & field_previous_acceleration_set_type,variable_dof,previous_acceleration, &
21600  & err,error,*999)
21601  acceleration_value=previous_acceleration+delta_t*solver_value
21602  CALL field_parameter_set_update_local_dof(dependent_field,dynamic_variable_type, &
21603  & field_values_set_type,variable_dof,displacement_value,err,error,*999)
21604  CALL field_parameter_set_update_local_dof(dependent_field,dynamic_variable_type, &
21605  & field_velocity_values_set_type,variable_dof,velocity_value,err,error,*999)
21606  CALL field_parameter_set_update_local_dof(dependent_field,dynamic_variable_type, &
21607  & field_acceleration_values_set_type,variable_dof,acceleration_value,err,error,*999)
21608  CASE DEFAULT
21609  local_error="The dynamic solver degree of "// &
21610  & trim(numbertovstring(dynamic_solver%DEGREE,"*",err,error))// &
21611  & " is invalid."
21612  CALL flagerror(local_error,err,error,*999)
21613  END SELECT
21614  ELSE
21615  SELECT CASE(dynamic_solver%ORDER)
21616  CASE(solver_dynamic_first_order)
21617  SELECT CASE(dynamic_solver%DEGREE)
21618  CASE(solver_dynamic_first_degree)
21619  !Do nothing
21620  CASE(solver_dynamic_second_degree)
21621  CALL field_parameter_set_update_local_dof(dependent_field,dynamic_variable_type, &
21622  & field_initial_velocity_set_type,variable_dof,solver_value,err,error,*999)
21623  CASE(solver_dynamic_third_degree)
21624  CALL field_parameter_set_update_local_dof(dependent_field,dynamic_variable_type, &
21625  & field_initial_velocity_set_type,variable_dof,solver_value,err,error,*999)
21626  CALL field_parameter_set_update_local_dof(dependent_field,dynamic_variable_type, &
21627  & field_initial_acceleration_set_type,variable_dof,0.0_dp,err,error,*999)
21628  CASE DEFAULT
21629  local_error="The dynamic solver degree of "// &
21630  & trim(numbertovstring(dynamic_solver%DEGREE,"*",err,error))//" is invalid."
21631  CALL flagerror(local_error,err,error,*999)
21632  END SELECT
21633  CASE(solver_dynamic_second_order)
21634  IF(dynamic_solver%DEGREE==solver_dynamic_third_degree) THEN
21635  CALL field_parameter_set_update_local_dof(dependent_field,dynamic_variable_type, &
21636  & field_initial_acceleration_set_type,variable_dof,solver_value,err,error,*999)
21637  ENDIF
21638  CASE DEFAULT
21639  local_error="The dynamic solver order of "// &
21640  & trim(numbertovstring(dynamic_solver%ORDER,"*",err,error))//" is invalid."
21641  CALL flagerror(local_error,err,error,*999)
21642  END SELECT
21643  ENDIF
21644  ELSE
21645  CALL flagerror("Dependent field is not associated.",err,error,*999)
21646  ENDIF
21647  ELSE
21648  CALL flagerror("Dependent variable is not associated.",err,error,*999)
21649  ENDIF
21650  CASE(solver_mapping_equations_interface_condition)
21651  !
21652  CASE DEFAULT
21653  local_error="The equations type of "//trim(numbertovstring(solver_mapping% &
21654  & solver_col_to_equations_cols_map(solver_matrix_idx)%SOLVER_DOF_TO_VARIABLE_MAPS(solver_dof_idx)% &
21655  & equations_types(equations_idx),"*",err,error))//" of equations index "// &
21656  & trim(numbertovstring(equations_idx,"*",err,error))//" for solver degree-of-freedom "// &
21657  & trim(numbertovstring(solver_dof_idx,"*",err,error))//" is invalid."
21658  CALL flagerror(local_error,err,error,*999)
21659  END SELECT
21660  ENDDO !equations_idx
21661  ENDDO !solver_dof_idx
21662  !Restore the solver dof data
21663  CALL distributed_vector_data_restore(solver_vector,solver_data,err,error,*999)
21664  !Start the transfer of the field dofs
21665  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
21666  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
21667  IF(ASSOCIATED(equations_set)) THEN
21668  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
21669  IF(ASSOCIATED(dependent_field)) THEN
21670  equations=>equations_set%EQUATIONS
21671  IF(ASSOCIATED(equations)) THEN
21672  equations_mapping=>equations%EQUATIONS_MAPPING
21673  IF(ASSOCIATED(equations_mapping)) THEN
21674  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
21675  IF(ASSOCIATED(dynamic_mapping)) THEN
21676  dynamic_variable_type=dynamic_mapping%DYNAMIC_VARIABLE_TYPE
21677  IF(dynamic_solver%SOLVER_INITIALISED) THEN
21678  CALL field_parameter_set_update_start(dependent_field,dynamic_variable_type, &
21679  & field_values_set_type,err,error,*999)
21680  IF(dynamic_solver%DEGREE>solver_dynamic_first_degree) THEN
21681  CALL field_parameter_set_update_start(dependent_field,dynamic_variable_type, &
21682  & field_velocity_values_set_type,err,error,*999)
21683  IF(dynamic_solver%DEGREE>solver_dynamic_third_degree) THEN
21684  CALL field_parameter_set_update_start(dependent_field,dynamic_variable_type, &
21685  & field_acceleration_values_set_type,err,error,*999)
21686  ENDIF
21687  ENDIF
21688  ELSE
21689  SELECT CASE(dynamic_solver%ORDER)
21690  CASE(solver_dynamic_first_order)
21691  SELECT CASE(dynamic_solver%DEGREE)
21692  CASE(solver_dynamic_first_degree)
21693  !Do nothing
21694  CASE(solver_dynamic_second_degree)
21695  CALL field_parameter_set_update_start(dependent_field,dynamic_variable_type, &
21696  & field_initial_velocity_set_type,err,error,*999)
21697  CASE(solver_dynamic_third_degree)
21698  CALL field_parameter_set_update_start(dependent_field,dynamic_variable_type, &
21699  & field_initial_velocity_set_type,err,error,*999)
21700  CALL field_parameter_set_update_start(dependent_field,dynamic_variable_type, &
21701  & field_initial_acceleration_set_type,err,error,*999)
21702  CASE DEFAULT
21703  local_error="The dynamic solver degree of "// &
21704  & trim(numbertovstring(dynamic_solver%DEGREE,"*",err,error))//" is invalid."
21705  CALL flagerror(local_error,err,error,*999)
21706  END SELECT
21707  CASE(solver_dynamic_second_order)
21708  IF(dynamic_solver%DEGREE==solver_dynamic_third_degree) THEN
21709  CALL field_parameter_set_update_start(dependent_field,dynamic_variable_type, &
21710  & field_initial_acceleration_set_type,err,error,*999)
21711  ENDIF
21712  CASE DEFAULT
21713  local_error="The dynamic solver order of "// &
21714  & trim(numbertovstring(dynamic_solver%ORDER,"*",err,error))//" is invalid."
21715  CALL flagerror(local_error,err,error,*999)
21716  END SELECT
21717  ENDIF
21718  ELSE
21719  !
21720  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
21721  IF(ASSOCIATED(nonlinear_mapping)) THEN
21722  dynamic_variable_type=field_u_variable_type
21723  IF(dynamic_solver%SOLVER_INITIALISED) THEN
21724  CALL field_parameter_set_update_start(dependent_field,dynamic_variable_type, &
21725  & field_values_set_type,err,error,*999)
21726  IF(dynamic_solver%DEGREE>solver_dynamic_first_degree) THEN
21727  CALL field_parameter_set_update_start(dependent_field,dynamic_variable_type, &
21728  & field_velocity_values_set_type,err,error,*999)
21729  IF(dynamic_solver%DEGREE>solver_dynamic_third_degree) THEN
21730  CALL field_parameter_set_update_start(dependent_field,dynamic_variable_type, &
21731  & field_acceleration_values_set_type,err,error,*999)
21732  ENDIF
21733  ENDIF
21734  ELSE
21735  SELECT CASE(dynamic_solver%ORDER)
21736  CASE(solver_dynamic_first_order)
21737  SELECT CASE(dynamic_solver%DEGREE)
21738  CASE(solver_dynamic_first_degree)
21739  !Do nothing
21740  CASE(solver_dynamic_second_degree)
21741  CALL field_parameter_set_update_start(dependent_field,dynamic_variable_type, &
21742  & field_initial_velocity_set_type,err,error,*999)
21743  CASE(solver_dynamic_third_degree)
21744  CALL field_parameter_set_update_start(dependent_field,dynamic_variable_type, &
21745  & field_initial_velocity_set_type,err,error,*999)
21746  CALL field_parameter_set_update_start(dependent_field,dynamic_variable_type, &
21747  & field_initial_acceleration_set_type,err,error,*999)
21748  CASE DEFAULT
21749  local_error="The dynamic solver degree of "// &
21750  & trim(numbertovstring(dynamic_solver%DEGREE,"*",err,error))//" is invalid."
21751  CALL flagerror(local_error,err,error,*999)
21752  END SELECT
21753  CASE(solver_dynamic_second_order)
21754  IF(dynamic_solver%DEGREE==solver_dynamic_third_degree) THEN
21755  CALL field_parameter_set_update_start(dependent_field,dynamic_variable_type, &
21756  & field_initial_acceleration_set_type,err,error,*999)
21757  ENDIF
21758  CASE DEFAULT
21759  local_error="The dynamic solver order of "// &
21760  & trim(numbertovstring(dynamic_solver%ORDER,"*",err,error))//" is invalid."
21761  CALL flagerror(local_error,err,error,*999)
21762  END SELECT
21763  ENDIF
21764  ELSE
21765  local_error="Neither equations mapping dynamic mapping nor equations mapping nonlinear "// &
21766  & "mapping is associated for equations set index number "// &
21767  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
21768  CALL flagerror(local_error,err,error,*999)
21769  ENDIF
21770  ENDIF
21771  ELSE
21772  local_error="Equations equations mapping is not associated for equations set index number "// &
21773  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
21774  CALL flagerror(local_error,err,error,*999)
21775  ENDIF
21776  ELSE
21777  local_error="Equations set equations is not associated for equations set index number "// &
21778  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
21779  CALL flagerror(local_error,err,error,*999)
21780  ENDIF
21781  ELSE
21782  local_error="Equations set dependent field is not associated for equations set index number "// &
21783  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
21784  CALL flagerror(local_error,err,error,*999)
21785  ENDIF
21786  ELSE
21787  local_error="Equations set is not associated for equations set index number "// &
21788  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
21789  CALL flagerror(local_error,err,error,*999)
21790  ENDIF
21791  ENDDO !equations_set_idx
21792  !Finish the transfer of the field dofs
21793  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
21794  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
21795  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
21796  equations=>equations_set%EQUATIONS
21797  equations_mapping=>equations%EQUATIONS_MAPPING
21798  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
21799  !
21800  IF(ASSOCIATED(dynamic_mapping))THEN
21801  !
21802  dynamic_variable_type=dynamic_mapping%DYNAMIC_VARIABLE_TYPE
21803  IF(dynamic_solver%SOLVER_INITIALISED) THEN
21804  CALL field_parameter_set_update_finish(dependent_field,dynamic_variable_type,field_values_set_type, &
21805  & err,error,*999)
21806  IF(dynamic_solver%DEGREE>solver_dynamic_first_degree) THEN
21807  CALL field_parameter_set_update_finish(dependent_field,dynamic_variable_type, &
21808  & field_velocity_values_set_type,err,error,*999)
21809  IF(dynamic_solver%DEGREE>solver_dynamic_third_degree) THEN
21810  CALL field_parameter_set_update_finish(dependent_field,dynamic_variable_type, &
21811  & field_acceleration_values_set_type,err,error,*999)
21812  ENDIF
21813  ENDIF
21814  ELSE
21815  SELECT CASE(dynamic_solver%ORDER)
21816  CASE(solver_dynamic_first_order)
21817  SELECT CASE(dynamic_solver%DEGREE)
21818  CASE(solver_dynamic_first_degree)
21819  !Do nothing
21820  CASE(solver_dynamic_second_degree)
21821  CALL field_parameter_set_update_finish(dependent_field,dynamic_variable_type, &
21822  & field_initial_velocity_set_type,err,error,*999)
21823  CASE(solver_dynamic_third_degree)
21824  CALL field_parameter_set_update_finish(dependent_field,dynamic_variable_type, &
21825  & field_initial_velocity_set_type,err,error,*999)
21826  CALL field_parameter_set_update_finish(dependent_field,dynamic_variable_type, &
21827  & field_initial_acceleration_set_type,err,error,*999)
21828  CASE DEFAULT
21829  local_error="The dynamic solver degree of "// &
21830  & trim(numbertovstring(dynamic_solver%DEGREE,"*",err,error))//" is invalid."
21831  CALL flagerror(local_error,err,error,*999)
21832  END SELECT
21833  CASE(solver_dynamic_second_order)
21834  IF(dynamic_solver%DEGREE==solver_dynamic_third_degree) THEN
21835  CALL field_parameter_set_update_finish(dependent_field,dynamic_variable_type, &
21836  & field_initial_acceleration_set_type,err,error,*999)
21837  ENDIF
21838  CASE DEFAULT
21839  local_error="The dynamic solver order of "// &
21840  & trim(numbertovstring(dynamic_solver%ORDER,"*",err,error))//" is invalid."
21841  CALL flagerror(local_error,err,error,*999)
21842  END SELECT
21843  ENDIF
21844  !
21845  ELSE
21846  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
21847  IF(ASSOCIATED(nonlinear_mapping)) THEN
21848  dynamic_variable_type=field_u_variable_type
21849  IF(dynamic_solver%SOLVER_INITIALISED) THEN
21850  CALL field_parameter_set_update_finish(dependent_field,dynamic_variable_type,field_values_set_type, &
21851  & err,error,*999)
21852  IF(dynamic_solver%DEGREE>solver_dynamic_first_degree) THEN
21853  CALL field_parameter_set_update_finish(dependent_field,dynamic_variable_type, &
21854  & field_velocity_values_set_type,err,error,*999)
21855  IF(dynamic_solver%DEGREE>solver_dynamic_third_degree) THEN
21856  CALL field_parameter_set_update_finish(dependent_field,dynamic_variable_type, &
21857  & field_acceleration_values_set_type,err,error,*999)
21858  ENDIF
21859  ENDIF
21860  ELSE
21861  SELECT CASE(dynamic_solver%ORDER)
21862  CASE(solver_dynamic_first_order)
21863  SELECT CASE(dynamic_solver%DEGREE)
21864  CASE(solver_dynamic_first_degree)
21865  !Do nothing
21866  CASE(solver_dynamic_second_degree)
21867  CALL field_parameter_set_update_finish(dependent_field,dynamic_variable_type, &
21868  & field_initial_velocity_set_type,err,error,*999)
21869  CASE(solver_dynamic_third_degree)
21870  CALL field_parameter_set_update_finish(dependent_field,dynamic_variable_type, &
21871  & field_initial_velocity_set_type,err,error,*999)
21872  CALL field_parameter_set_update_finish(dependent_field,dynamic_variable_type, &
21873  & field_initial_acceleration_set_type,err,error,*999)
21874  CASE DEFAULT
21875  local_error="The dynamic solver degree of "// &
21876  & trim(numbertovstring(dynamic_solver%DEGREE,"*",err,error))//" is invalid."
21877  CALL flagerror(local_error,err,error,*999)
21878  END SELECT
21879  CASE(solver_dynamic_second_order)
21880  IF(dynamic_solver%DEGREE==solver_dynamic_third_degree) THEN
21881  CALL field_parameter_set_update_finish(dependent_field,dynamic_variable_type, &
21882  & field_initial_acceleration_set_type,err,error,*999)
21883  ENDIF
21884  CASE DEFAULT
21885  local_error="The dynamic solver order of "// &
21886  & trim(numbertovstring(dynamic_solver%ORDER,"*",err,error))//" is invalid."
21887  CALL flagerror(local_error,err,error,*999)
21888  END SELECT
21889  ENDIF
21890  ELSE
21891  CALL flagerror("Neither dynamic nor nonlinear mapping is associated",err,error,*999)
21892  ENDIF
21893  ENDIF
21894  !
21895  ENDDO !equations_set_idx
21896  ELSE
21897  CALL flagerror("Solver vector is not associated.",err,error,*998)
21898  ENDIF
21899  ELSE
21900  CALL flagerror("Solver matrix is not associated.",err,error,*998)
21901  ENDIF
21902  ENDDO !solver_matrix_idx
21903  ELSE
21904  CALL flagerror("Solver matrices solution mapping is not associated.",err,error,*998)
21905  ENDIF
21906  ELSE
21907  CALL flagerror("Solver equations solver matrices are not associated.",err,error,*998)
21908  ENDIF
21909  ELSE
21910  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
21911  ENDIF
21912  ELSE
21913  CALL flagerror("Solver dynamic solver is not associated.",err,error,*999)
21914  ENDIF
21915  ELSE
21916  CALL flagerror("Solver has not been finished.",err,error,*998)
21917  ENDIF
21918  ELSE
21919  CALL flagerror("Solver is not associated.",err,error,*998)
21920  ENDIF
21921 
21922  exits("SOLVER_VARIABLES_DYNAMIC_FIELD_UPDATE")
21923  RETURN
21924 999 IF(ASSOCIATED(solver_data)) CALL distributed_vector_data_restore(solver_vector,solver_data,dummy_err,dummy_error,*998)
21925 998 errorsexits("SOLVER_VARIABLES_DYNAMIC_FIELD_UPDATE",err,error)
21926  RETURN 1
21927 
21928  END SUBROUTINE solver_variables_dynamic_field_update
21929 
21930  !
21931  !================================================================================================================================
21932  !
21933 
21935  SUBROUTINE solver_variablesdynamicfieldpreviousvaluesupdate(SOLVER,ERR,ERROR,*)
21936 
21937  !Argument variables
21938  TYPE(solver_type), POINTER :: SOLVER
21939  INTEGER(INTG), INTENT(OUT) :: ERR
21940  TYPE(varying_string), INTENT(OUT) :: ERROR
21941  !Local Variables
21942  INTEGER(INTG) :: VARIABLE_TYPE,equations_set_idx,solver_matrix_idx, &
21943  & residual_variable_idx,variable_idx
21944  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
21945  TYPE(equations_type), POINTER :: EQUATIONS
21946  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
21947  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
21948  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
21949  TYPE(field_type), POINTER :: FIELD
21950  TYPE(field_variable_type), POINTER :: FIELD_VARIABLE,RESIDUAL_VARIABLE
21951  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
21952  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
21953  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
21954  TYPE(varying_string) :: LOCAL_ERROR
21955 
21956  enters("Solver_VariablesDynamicFieldPreviousValuesUpdate",err,error,*999)
21957 
21958  IF(ASSOCIATED(solver)) THEN
21959  IF(solver%SOLVER_FINISHED) THEN
21960  dynamic_solver=>solver%DYNAMIC_SOLVER
21961  IF(ASSOCIATED(dynamic_solver)) THEN
21962  solver_equations=>solver%SOLVER_EQUATIONS
21963  IF(ASSOCIATED(solver_equations)) THEN
21964  solver_matrices=>solver_equations%SOLVER_MATRICES
21965  IF(ASSOCIATED(solver_matrices)) THEN
21966  solver_mapping=>solver_matrices%SOLVER_MAPPING
21967  IF(ASSOCIATED(solver_mapping)) THEN
21968  DO solver_matrix_idx=1,solver_matrices%NUMBER_OF_MATRICES
21969  !Loop over the variables involved in the solver matrix.
21970  DO variable_idx=1,solver_mapping%VARIABLES_LIST(solver_matrix_idx)%NUMBER_OF_VARIABLES
21971  field_variable=>solver_mapping%VARIABLES_LIST(solver_matrix_idx)%VARIABLES(variable_idx)%VARIABLE
21972  IF(ASSOCIATED(field_variable)) THEN
21973  variable_type=field_variable%VARIABLE_TYPE
21974  field=>field_variable%FIELD
21975  !Copy the displacements
21976  CALL field_parameter_sets_copy(field,variable_type,field_values_set_type, &
21977  & field_previous_values_set_type,1.0_dp,err,error,*999)
21978  IF(dynamic_solver%DEGREE>=solver_dynamic_second_degree) THEN
21979  !Copy velocity
21980  CALL field_parameter_sets_copy(field,variable_type,field_velocity_values_set_type, &
21981  & field_previous_velocity_set_type,1.0_dp,err,error,*999)
21982  IF(dynamic_solver%DEGREE>=solver_dynamic_third_degree) THEN
21983  !Copy acceleration
21984  CALL field_parameter_sets_copy(field,variable_type,field_acceleration_values_set_type, &
21985  & field_previous_acceleration_set_type,1.0_dp,err,error,*999)
21986  ENDIF
21987  ENDIF
21988  ELSE
21989  local_error="The solver mapping variables list variable is not associated for variable index "// &
21990  & trim(numbertovstring(variable_idx,"*",err,error))//"."
21991  CALL flagerror(local_error,err,error,*999)
21992  ENDIF
21993  ENDDO !variable_idx
21994  IF(dynamic_solver%LINEARITY==solver_dynamic_nonlinear) THEN
21995  !Loop over the equations sets and copy any residuals
21996  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
21997  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
21998  IF(ASSOCIATED(equations_set)) THEN
21999  equations=>equations_set%EQUATIONS
22000  IF(ASSOCIATED(equations)) THEN
22001  IF(equations%LINEARITY==equations_nonlinear) THEN
22002  equations_mapping=>equations%EQUATIONS_MAPPING
22003  IF(ASSOCIATED(equations_mapping)) THEN
22004  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
22005  IF(ASSOCIATED(nonlinear_mapping)) THEN
22006  DO residual_variable_idx=1,nonlinear_mapping%NUMBER_OF_RESIDUAL_VARIABLES
22007  residual_variable=>nonlinear_mapping%RESIDUAL_VARIABLES(residual_variable_idx)%PTR
22008  IF(ASSOCIATED(residual_variable)) THEN
22009  CALL field_parameter_sets_copy(residual_variable%FIELD,residual_variable%VARIABLE_TYPE, &
22010  & field_residual_set_type,field_previous_residual_set_type,1.0_dp,err,error,*999)
22011  ELSE
22012  local_error="Nonlinear mapping residual variable is not associated for "// &
22013  "residual variable index "//trim(numbertovstring(residual_variable_idx,"*",err,error))// &
22014  & "."
22015  CALL flagerror(local_error,err,error,*999)
22016  ENDIF
22017  ENDDO !residual_variable_idx
22018  ELSE
22019  CALL flagerror("Equations mapping nonlinear mapping is not associated.",err,error,*999)
22020  ENDIF
22021  ELSE
22022  CALL flagerror("Equations equations mapping is not associated.",err,error,*999)
22023  ENDIF
22024  ENDIF
22025  ELSE
22026  CALL flagerror("Equations set equations is not associated.",err,error,*999)
22027  ENDIF
22028  ELSE
22029  local_error="The solver mapping equations set is not associated for equations set index "// &
22030  & trim(numbertovstring(equations_set_idx,"*",err,error))//"."
22031  CALL flagerror(local_error,err,error,*999)
22032  ENDIF
22033  ENDDO !equations_set_idx
22034  ENDIF
22035  ENDDO !solver_matrix_idx
22036  ELSE
22037  CALL flagerror("Solver matrices solution mapping is not associated.",err,error,*999)
22038  ENDIF
22039  ELSE
22040  CALL flagerror("Solver equations solver matrices are not associated.",err,error,*999)
22041  ENDIF
22042  ELSE
22043  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
22044  ENDIF
22045  ELSE
22046  CALL flagerror("Solver dynamic solver is not associated.",err,error,*999)
22047  ENDIF
22048  ELSE
22049  CALL flagerror("Solver has not been finished.",err,error,*999)
22050  ENDIF
22051  ELSE
22052  CALL flagerror("Solver is not associated.",err,error,*999)
22053  ENDIF
22054 
22055  exits("Solver_VariablesDynamicFieldPreviousValuesUpdate")
22056  RETURN
22057 999 errors("Solver_VariablesDynamicFieldPreviousValuesUpdate",err,error)
22058  exits("Solver_VariablesDynamicFieldPreviousValuesUpdate")
22059  RETURN 1
22060 
22061  END SUBROUTINE solver_variablesdynamicfieldpreviousvaluesupdate
22062 
22063  !
22064  !================================================================================================================================
22065  !
22066 
22068  SUBROUTINE solver_variables_dynamic_nonlinear_update(SOLVER,ERR,ERROR,*)
22069 
22070  !Argument variables
22071  TYPE(solver_type), POINTER :: SOLVER
22072  INTEGER(INTG), INTENT(OUT) :: ERR
22073  TYPE(varying_string), INTENT(OUT) :: ERROR
22074 
22075  !Local Variables
22076  INTEGER(INTG) :: DUMMY_ERR,DYNAMIC_VARIABLE_TYPE,equations_idx,equations_set_idx,solver_dof_idx,solver_matrix_idx,variable_dof
22077  REAL(DP) :: additive_constant,DELTA_T,VALUE,variable_coefficient
22078  REAL(DP) :: ALPHA_VALUE,DYNAMIC_ALPHA_FACTOR, DYNAMIC_U_FACTOR,PREDICTED_DISPLACEMENT
22079  INTEGER(INTG) :: variable_idx,VARIABLE_TYPE,interface_condition_idx
22080  REAL(DP), POINTER :: SOLVER_DATA(:)
22081  TYPE(distributed_vector_type), POINTER :: SOLVER_VECTOR
22082  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
22083  TYPE(interface_equations_type), POINTER :: INTERFACE_EQUATIONS
22084  TYPE(interface_condition_type), POINTER :: INTERFACE_CONDITION
22085  TYPE(field_type), POINTER :: DEPENDENT_FIELD
22086  TYPE(field_variable_type), POINTER :: DEPENDENT_VARIABLE
22087  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
22088  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
22089  TYPE(equations_mapping_dynamic_type), POINTER :: DYNAMIC_MAPPING
22090  TYPE(equations_mapping_nonlinear_type), POINTER :: NONLINEAR_MAPPING
22091  TYPE(equations_mapping_type), POINTER :: EQUATIONS_MAPPING
22092  TYPE(interface_mapping_type), POINTER :: INTERFACE_MAPPING
22093  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
22094  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
22095  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
22096 
22097 
22098  TYPE(dynamic_solver_type), POINTER :: DYNAMIC_SOLVER
22099  TYPE(equations_type), POINTER :: EQUATIONS
22100 
22101  !STABILITY_TEST under investigation
22102  LOGICAL :: STABILITY_TEST
22103  !.FALSE. guarantees weighting as described in OpenCMISS notes
22104  !.TRUE. weights mean predicted field rather than the whole NL contribution
22105  !-> to be removed later
22106  stability_test=.false.
22107 
22108  NULLIFY(solver_data)
22109 
22110  enters("SOLVER_VARIABLES_DYNAMIC_NONLINEAR_UPDATE",err,error,*998)
22111 
22112  IF(ASSOCIATED(solver)) THEN
22113  IF(solver%SOLVER_FINISHED) THEN
22114  solver_equations=>solver%SOLVER_EQUATIONS
22115  IF(ASSOCIATED(solver%LINKING_SOLVER)) THEN
22116  dynamic_solver=>solver%LINKING_SOLVER%DYNAMIC_SOLVER
22117  !Define the dynamic alpha factor
22118  IF(ASSOCIATED(dynamic_solver)) THEN
22119  IF(dynamic_solver%SOLVER_INITIALISED) THEN
22120  delta_t=dynamic_solver%TIME_INCREMENT
22121  SELECT CASE(dynamic_solver%DEGREE)
22122  CASE(solver_dynamic_first_degree)
22123  dynamic_alpha_factor=delta_t
22124  dynamic_u_factor=1.0_dp
22125  CASE(solver_dynamic_second_degree)
22126  dynamic_alpha_factor=delta_t*delta_t/2.0_dp
22127  dynamic_u_factor=1.0_dp
22128  CASE(solver_dynamic_third_degree)
22129  dynamic_alpha_factor=delta_t*delta_t*delta_t/6.0_dp
22130  dynamic_u_factor=1.0_dp
22131  CASE DEFAULT
22132  local_error="The dynamic solver degree of "//trim(numbertovstring(dynamic_solver%DEGREE,"*",err,error))// &
22133  & " is invalid."
22134  CALL flagerror(local_error,err,error,*999)
22135  END SELECT
22136  ENDIF
22137  ENDIF
22138  ELSE
22139  CALL flagerror("Dynamic solver linking solver is not associated.",err,error,*999)
22140  ENDIF
22141  !Set the dependent field for calculating the nonlinear residual and Jacobian values
22142  IF(ASSOCIATED(solver_equations)) THEN
22143  solver_matrices=>solver_equations%SOLVER_MATRICES
22144  IF(ASSOCIATED(solver_matrices)) THEN
22145  solver_mapping=>solver_matrices%SOLVER_MAPPING
22146  IF(ASSOCIATED(solver_mapping)) THEN
22147  DO solver_matrix_idx=1,solver_matrices%NUMBER_OF_MATRICES
22148  solver_matrix=>solver_matrices%MATRICES(solver_matrix_idx)%PTR
22149  IF(ASSOCIATED(solver_matrix)) THEN
22150  solver_vector=>solver_matrix%SOLVER_VECTOR
22151  IF(ASSOCIATED(solver_vector)) THEN
22152  !Get the solver variables data
22153  CALL distributed_vector_data_get(solver_vector,solver_data,err,error,*999)
22154  !Loop over the solver variable dofs
22155  DO solver_dof_idx=1,solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)%NUMBER_OF_DOFS
22156  !Loop over the equations associated with this dof
22157  DO equations_idx=1,solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22158  & solver_dof_to_variable_maps(solver_dof_idx)%NUMBER_OF_EQUATION_DOFS
22159  SELECT CASE(solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22160  & solver_dof_to_variable_maps(solver_dof_idx)%EQUATIONS_TYPES(equations_idx))
22161  CASE(solver_mapping_equations_equations_set)
22162  !Equations set dof.
22163  dependent_variable=>solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22164  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE(equations_idx)%PTR
22165 
22166 
22167  !EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(equations_idx)%PTR .!Wrong indexing!. replaced by:
22168  equations_set=>solver_mapping%EQUATIONS_SETS(solver_mapping% &
22169  & solver_col_to_equations_cols_map(solver_matrix_idx)% &
22170  & solver_dof_to_variable_maps(solver_dof_idx)%EQUATIONS_INDICES(equations_idx))%PTR
22171 
22172 
22173  IF(ASSOCIATED(equations_set)) THEN
22174  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
22175  equations=>equations_set%EQUATIONS
22176  IF(ASSOCIATED(dependent_variable)) THEN
22177  variable_type=dependent_variable%VARIABLE_TYPE
22178  IF(ASSOCIATED(dependent_field)) THEN
22179  IF(ASSOCIATED(equations)) THEN
22180  equations_mapping=>equations%EQUATIONS_MAPPING
22181  IF(ASSOCIATED(equations_mapping)) THEN
22182  dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
22183  IF(ASSOCIATED(dynamic_mapping)) THEN
22184  dynamic_variable_type=dynamic_mapping%DYNAMIC_VARIABLE_TYPE
22185  !Get the dependent field variable dof the solver dof is mapped to
22186  variable_dof=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22187  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE_DOF(equations_idx)
22188  variable_coefficient=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22189  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE_COEFFICIENT(equations_idx)
22190  additive_constant=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22191  & solver_dof_to_variable_maps(solver_dof_idx)%ADDITIVE_CONSTANT(equations_idx)
22192  !Store the alpha increment
22193  alpha_value=solver_data(solver_dof_idx)
22194  CALL field_parameter_set_update_local_dof(dependent_field,variable_type, &
22195  & field_incremental_values_set_type,variable_dof,alpha_value,err,error,*999)
22196  !Get the predicted displacement data
22197  CALL field_parameter_set_get_local_dof(dependent_field,dynamic_variable_type, &
22198  & field_predicted_displacement_set_type,variable_dof,predicted_displacement, &
22199  & err,error,*999)
22200  !Calculate solver data only
22201  VALUE=alpha_value*variable_coefficient+additive_constant
22202  !Calculate modified input values for residual and Jacobian calculation
22203  IF(stability_test) THEN
22204  VALUE=VALUE*dynamic_solver%THETA(1)
22205  ENDIF
22206  VALUE=VALUE*dynamic_alpha_factor+predicted_displacement
22207  CALL field_parameter_set_update_local_dof(dependent_field,variable_type, &
22208  & field_values_set_type,variable_dof,VALUE,err,error,*999)
22209  ELSE
22210  !
22211  nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
22212  IF(ASSOCIATED(nonlinear_mapping)) THEN
22213  !Default to FIELD_U_VARIABLE_TYPE
22214  dynamic_variable_type=field_u_variable_type
22215  !Get the dependent field variable dof the solver dof is mapped to
22216  variable_dof=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22217  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE_DOF(equations_idx)
22218  variable_coefficient=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22219  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE_COEFFICIENT(equations_idx)
22220  additive_constant=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22221  & solver_dof_to_variable_maps(solver_dof_idx)%ADDITIVE_CONSTANT(equations_idx)
22222  !Store the alpha increment
22223  alpha_value=solver_data(solver_dof_idx)
22224  CALL field_parameter_set_update_local_dof(dependent_field,variable_type, &
22225  & field_incremental_values_set_type,variable_dof,alpha_value,err,error,*999)
22226  !Get the predicted displacement data
22227  CALL field_parameter_set_get_local_dof(dependent_field,dynamic_variable_type, &
22228  & field_predicted_displacement_set_type,variable_dof,predicted_displacement, &
22229  & err,error,*999)
22230  !Calculate solver data only
22231  VALUE=alpha_value*variable_coefficient+additive_constant
22232  !Calculate modified input values for residual and Jacobian calculation
22233  IF(stability_test) THEN
22234  VALUE=VALUE*dynamic_solver%THETA(1)
22235  ENDIF
22236  VALUE=VALUE*dynamic_alpha_factor+predicted_displacement
22237  CALL field_parameter_set_update_local_dof(dependent_field,variable_type, &
22238  & field_values_set_type,variable_dof,VALUE,err,error,*999)
22239  ELSE
22240  CALL flagerror("Neither dynamic nor nonlinear mapping is associated",err,error,*999)
22241  ENDIF
22242  !CALL FlagError("Dynamic mapping is not associated.",ERR,ERROR,*999)
22243  !
22244  ENDIF
22245  ELSE
22246  CALL flagerror("Equations mapping is not associated.",err,error,*999)
22247  ENDIF
22248  ELSE
22249  CALL flagerror("Equations are not associated.",err,error,*999)
22250  ENDIF
22251  ELSE
22252  CALL flagerror("Dependent field is not associated.",err,error,*999)
22253  ENDIF
22254  ELSE
22255  CALL flagerror("Dependent variable is not associated.",err,error,*999)
22256  ENDIF
22257  ELSE
22258  CALL flagerror("Equations set is not associated.",err,error,*999)
22259  ENDIF
22260  CASE(solver_mapping_equations_interface_condition)
22261  !
22262  !Equations set dof.
22263  dependent_variable=>solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22264  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE(equations_idx)%PTR
22265  !EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(equations_idx)%PTR see above
22266  interface_condition=>solver_mapping%INTERFACE_CONDITIONS(solver_mapping% &
22267  & solver_col_to_equations_cols_map(solver_matrix_idx)% &
22268  & solver_dof_to_variable_maps(solver_dof_idx)%EQUATIONS_INDICES(equations_idx))%PTR
22269  IF(ASSOCIATED(interface_condition)) THEN
22270  !TODO Generalize
22271  dependent_field=>interface_condition%LAGRANGE%LAGRANGE_FIELD
22272  interface_equations=>interface_condition%INTERFACE_EQUATIONS
22273  IF(ASSOCIATED(dependent_variable)) THEN
22274  variable_type=dependent_variable%VARIABLE_TYPE
22275  IF(ASSOCIATED(dependent_field)) THEN
22276  IF(ASSOCIATED(interface_equations)) THEN
22277  interface_mapping=>interface_equations%INTERFACE_MAPPING
22278  IF(ASSOCIATED(interface_mapping)) THEN
22279  dynamic_variable_type=interface_mapping%LAGRANGE_VARIABLE_TYPE
22280  !Get the dependent field variable dof the solver dof is mapped to
22281  variable_dof=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22282  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE_DOF(equations_idx)
22283  variable_coefficient=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22284  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE_COEFFICIENT(equations_idx)
22285  additive_constant=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22286  & solver_dof_to_variable_maps(solver_dof_idx)%ADDITIVE_CONSTANT(equations_idx)
22287  predicted_displacement=0.0_dp
22288  !Store the alpha increment
22289  alpha_value=solver_data(solver_dof_idx)
22290  !Calculate solver data only
22291  VALUE=alpha_value*variable_coefficient+additive_constant
22292  !Calculate modified input values for residual and Jacobian calculation
22293  IF(stability_test) THEN
22294  VALUE=VALUE*dynamic_solver%THETA(1)
22295  ENDIF
22296  VALUE=VALUE*dynamic_alpha_factor+predicted_displacement
22297  CALL field_parameter_set_update_local_dof(dependent_field,variable_type, &
22298  & field_values_set_type,variable_dof,VALUE,err,error,*999)
22299  ELSE
22300  CALL flagerror("Interface mapping is not associated.",err,error,*999)
22301  ENDIF
22302  ELSE
22303  CALL flagerror("Interface equations are not associated.",err,error,*999)
22304  ENDIF
22305  ELSE
22306  CALL flagerror("Dependent field is not associated.",err,error,*999)
22307  ENDIF
22308  ELSE
22309  CALL flagerror("Dependent variable is not associated.",err,error,*999)
22310  ENDIF
22311  ELSE
22312  CALL flagerror("Interface condition is not associated.",err,error,*999)
22313  ENDIF
22314  CASE DEFAULT
22315  local_error="The equations type of "//trim(numbertovstring(solver_mapping% &
22316  & solver_col_to_equations_cols_map(solver_matrix_idx)%SOLVER_DOF_TO_VARIABLE_MAPS(solver_dof_idx)% &
22317  & equations_types(equations_idx),"*",err,error))//" of equations index "// &
22318  & trim(numbertovstring(equations_idx,"*",err,error))//" for solver degree-of-freedom "// &
22319  & trim(numbertovstring(solver_dof_idx,"*",err,error))//" is invalid."
22320  CALL flagerror(local_error,err,error,*999)
22321  END SELECT
22322  ENDDO !equations_idx
22323  ENDDO !solver_dof_idx
22324  !Restore the solver dof data
22325  CALL distributed_vector_data_restore(solver_vector,solver_data,err,error,*999)
22326  !Start the transfer of the field dofs
22327  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
22328  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
22329  IF(ASSOCIATED(equations_set)) THEN
22330  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
22331  DO variable_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
22332  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_VARIABLES
22333  variable_type=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
22334  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%VARIABLE_TYPES(variable_idx)
22335  CALL field_parameter_set_update_start(dependent_field,variable_type,field_values_set_type,err,error,*999)
22336  CALL field_parameter_set_update_start(dependent_field,variable_type,field_incremental_values_set_type, &
22337  & err,error,*999)
22338  ENDDO !variable_idx
22339  ELSE
22340  CALL flagerror("Equations set is not associated.",err,error,*999)
22341  ENDIF
22342  ENDDO !equations_set_idx
22343  !Finish the transfer of the field dofs
22344  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
22345  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
22346  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
22347  DO variable_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
22348  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_VARIABLES
22349  variable_type=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
22350  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%VARIABLE_TYPES(variable_idx)
22351  CALL field_parameter_set_update_finish(dependent_field,variable_type,field_values_set_type,err,error,*999)
22352  CALL field_parameter_set_update_finish(dependent_field,variable_type,field_incremental_values_set_type, &
22353  & err,error,*999)
22354  ENDDO !variable_idx
22355  ENDDO !equations_set_idx
22356 
22357 
22358  !TODO Generalize
22359  DO interface_condition_idx=1,solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS
22360  interface_condition=>solver_mapping%INTERFACE_CONDITIONS(interface_condition_idx)%PTR
22361  dependent_field=>interface_condition%LAGRANGE%LAGRANGE_FIELD
22362  variable_type=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
22363  & interface_to_solver_matrix_maps_sm(solver_matrix_idx)%LAGRANGE_VARIABLE_TYPE
22364  CALL field_parameter_set_update_start(dependent_field,variable_type,field_values_set_type,err,error,*999)
22365  CALL field_parameter_set_update_finish(dependent_field,variable_type,field_values_set_type,err,error,*999)
22366  ENDDO
22367  ELSE
22368  CALL flagerror("Solver vector is not associated.",err,error,*998)
22369  ENDIF
22370  ELSE
22371  CALL flagerror("Solver matrix is not associated.",err,error,*998)
22372  ENDIF
22373  ENDDO !solver_matrix_idx
22374  ELSE
22375  CALL flagerror("Solver matrices solution mapping is not associated.",err,error,*998)
22376  ENDIF
22377  ELSE
22378  CALL flagerror("Solver equations solver matrices are not associated.",err,error,*998)
22379  ENDIF
22380  ELSE
22381  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
22382  ENDIF
22383  ELSE
22384  CALL flagerror("Solver has not been finished.",err,error,*998)
22385  ENDIF
22386  ELSE
22387  CALL flagerror("Solver is not associated.",err,error,*998)
22388  ENDIF
22389 
22390  exits("SOLVER_VARIABLES_DYNAMIC_NONLINEAR_UPDATE")
22391  RETURN
22392 999 IF(ASSOCIATED(solver_data)) CALL distributed_vector_data_restore(solver_vector,solver_data,dummy_err,dummy_error,*998)
22393 998 errorsexits("SOLVER_VARIABLES_DYNAMIC_NONLINEAR_UPDATE",err,error)
22394  RETURN 1
22395  END SUBROUTINE solver_variables_dynamic_nonlinear_update
22396 
22397 
22398  !
22399  !================================================================================================================================
22400  !
22401 
22403  SUBROUTINE solver_variables_field_update(SOLVER,ERR,ERROR,*)
22404 
22405  !Argument variables
22406  TYPE(solver_type), POINTER :: SOLVER
22407  INTEGER(INTG), INTENT(OUT) :: ERR
22408  TYPE(varying_string), INTENT(OUT) :: ERROR
22409  !Local Variables
22410  INTEGER(INTG) :: DUMMY_ERR,equations_idx,equations_set_idx,solver_dof_idx,solver_matrix_idx,variable_dof,variable_idx, &
22411  & VARIABLE_TYPE
22412  REAL(DP) :: additive_constant,VALUE,variable_coefficient
22413  REAL(DP), POINTER :: SOLVER_DATA(:)
22414  TYPE(distributed_vector_type), POINTER :: SOLVER_VECTOR
22415  TYPE(equations_set_type), POINTER :: EQUATIONS_SET
22416  TYPE(field_type), POINTER :: DEPENDENT_FIELD,LAGRANGE_FIELD
22417  TYPE(field_variable_type), POINTER :: DEPENDENT_VARIABLE,LAGRANGE_VARIABLE
22418  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
22419  TYPE(solver_mapping_type), POINTER :: SOLVER_MAPPING
22420  TYPE(solver_matrices_type), POINTER :: SOLVER_MATRICES
22421  TYPE(solver_matrix_type), POINTER :: SOLVER_MATRIX
22422  TYPE(varying_string) :: DUMMY_ERROR,LOCAL_ERROR
22423 
22424  NULLIFY(solver_data)
22425 
22426  enters("SOLVER_VARIABLES_FIELD_UPDATE",err,error,*998)
22427 
22428  IF(ASSOCIATED(solver)) THEN
22429  IF(solver%SOLVER_FINISHED) THEN
22430  solver_equations=>solver%SOLVER_EQUATIONS
22431  IF(ASSOCIATED(solver_equations)) THEN
22432  solver_matrices=>solver_equations%SOLVER_MATRICES
22433  IF(ASSOCIATED(solver_matrices)) THEN
22434  solver_mapping=>solver_matrices%SOLVER_MAPPING
22435  IF(ASSOCIATED(solver_mapping)) THEN
22436  DO solver_matrix_idx=1,solver_matrices%NUMBER_OF_MATRICES
22437  solver_matrix=>solver_matrices%MATRICES(solver_matrix_idx)%PTR
22438  IF(ASSOCIATED(solver_matrix)) THEN
22439  solver_vector=>solver_matrix%SOLVER_VECTOR
22440  IF(ASSOCIATED(solver_vector)) THEN
22441  !Get the solver variables data
22442  CALL distributed_vector_data_get(solver_vector,solver_data,err,error,*999)
22443  !Loop over the solver variable dofs
22444  DO solver_dof_idx=1,solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)%NUMBER_OF_DOFS
22445  !Loop over the equations associated with this dof
22446  DO equations_idx=1,solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22447  & solver_dof_to_variable_maps(solver_dof_idx)%NUMBER_OF_EQUATION_DOFS
22448  SELECT CASE(solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22449  & solver_dof_to_variable_maps(solver_dof_idx)%EQUATIONS_TYPES(equations_idx))
22450  CASE(solver_mapping_equations_equations_set)
22451  !Equations set dof.
22452  dependent_variable=>solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22453  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE(equations_idx)%PTR
22454  IF(ASSOCIATED(dependent_variable)) THEN
22455  variable_type=dependent_variable%VARIABLE_TYPE
22456  dependent_field=>dependent_variable%FIELD
22457  IF(ASSOCIATED(dependent_field)) THEN
22458  !Get the dependent field variable dof the solver dof is mapped to
22459  variable_dof=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22460  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE_DOF(equations_idx)
22461  variable_coefficient=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22462  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE_COEFFICIENT(equations_idx)
22463  additive_constant=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22464  & solver_dof_to_variable_maps(solver_dof_idx)%ADDITIVE_CONSTANT(equations_idx)
22465  !Set the dependent field variable dof
22466  VALUE=solver_data(solver_dof_idx)*variable_coefficient+additive_constant
22467  CALL field_parameter_set_update_local_dof(dependent_field,variable_type,field_values_set_type, &
22468  & variable_dof,VALUE,err,error,*999)
22469  ELSE
22470  CALL flagerror("Dependent field is not associated.",err,error,*999)
22471  ENDIF
22472  ELSE
22473  CALL flagerror("Dependent variable is not associated.",err,error,*999)
22474  ENDIF
22475  CASE(solver_mapping_equations_interface_condition)
22476  !Interface condition dof.
22477  lagrange_variable=>solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22478  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE(equations_idx)%PTR
22479  IF(ASSOCIATED(lagrange_variable)) THEN
22480  variable_type=lagrange_variable%VARIABLE_TYPE
22481  lagrange_field=>lagrange_variable%FIELD
22482  IF(ASSOCIATED(lagrange_field)) THEN
22483  !Get the dependent field variable dof the solver dof is mapped to
22484  variable_dof=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22485  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE_DOF(equations_idx)
22486  variable_coefficient=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22487  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE_COEFFICIENT(equations_idx)
22488  additive_constant=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22489  & solver_dof_to_variable_maps(solver_dof_idx)%ADDITIVE_CONSTANT(equations_idx)
22490  !Set the dependent field variable dof
22491  VALUE=solver_data(solver_dof_idx)*variable_coefficient+additive_constant
22492  CALL field_parameter_set_update_local_dof(lagrange_field,variable_type,field_values_set_type, &
22493  & variable_dof,VALUE,err,error,*999)
22494  ELSE
22495  CALL flagerror("Lagrange field is not associated.",err,error,*999)
22496  ENDIF
22497  ELSE
22498  CALL flagerror("Lagrange variable is not associated.",err,error,*999)
22499  ENDIF
22500  CASE DEFAULT
22501  local_error="The equations type of "//trim(numbertovstring(solver_mapping% &
22502  & solver_col_to_equations_cols_map(solver_matrix_idx)%SOLVER_DOF_TO_VARIABLE_MAPS(solver_dof_idx)% &
22503  & equations_types(equations_idx),"*",err,error))//" of equations index "// &
22504  & trim(numbertovstring(equations_idx,"*",err,error))//" for solver degree-of-freedom "// &
22505  & trim(numbertovstring(solver_dof_idx,"*",err,error))//" is invalid."
22506  CALL flagerror(local_error,err,error,*999)
22507  END SELECT
22508  ENDDO !equations_idx
22509  ENDDO !solver_dof_idx
22510  IF(diagnostics2) THEN
22511  CALL write_string_value(diagnostic_output_type," Solver matrix index = ",solver_matrix_idx,err,error,*999)
22512  DO solver_dof_idx=1,solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)%NUMBER_OF_DOFS
22513  CALL write_string_value(diagnostic_output_type," Solver dof index = ",solver_dof_idx,err,error,*999)
22514  DO equations_idx=1,solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22515  & solver_dof_to_variable_maps(solver_dof_idx)%NUMBER_OF_EQUATION_DOFS
22516  CALL write_string_value(diagnostic_output_type," Equations index = ",equations_idx,err,error,*999)
22517  variable_dof=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22518  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE_DOF(equations_idx)
22519  variable_coefficient=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22520  & solver_dof_to_variable_maps(solver_dof_idx)%VARIABLE_COEFFICIENT(equations_idx)
22521  additive_constant=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(solver_matrix_idx)% &
22522  & solver_dof_to_variable_maps(solver_dof_idx)%ADDITIVE_CONSTANT(equations_idx)
22523  VALUE=solver_data(solver_dof_idx)*variable_coefficient+additive_constant
22524  CALL write_string_value(diagnostic_output_type," Variable dof = ",variable_dof,err,error,*999)
22525  CALL write_string_value(diagnostic_output_type," Variable coefficient = ",variable_coefficient, &
22526  & err,error,*999)
22527  CALL write_string_value(diagnostic_output_type," Additive constant = ",additive_constant, &
22528  & err,error,*999)
22529  CALL write_string_value(diagnostic_output_type," Value = ",VALUE,err,error,*999)
22530  ENDDO
22531  ENDDO
22532  ENDIF
22533  !Restore the solver dof data
22534  CALL distributed_vector_data_restore(solver_vector,solver_data,err,error,*999)
22535  !Start the transfer of the field dofs
22536  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
22537  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
22538  IF(ASSOCIATED(equations_set)) THEN
22539  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
22540  DO variable_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
22541  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_VARIABLES
22542  variable_type=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
22543  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%VARIABLE_TYPES(variable_idx)
22544  CALL field_parameter_set_update_start(dependent_field,variable_type,field_values_set_type,err,error,*999)
22545  ENDDO !variable_idx
22546  ELSE
22547  CALL flagerror("Equations set is not associated.",err,error,*999)
22548  ENDIF
22549  ENDDO !equations_set_idx
22550  !Finish the transfer of the field dofs
22551  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
22552  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
22553  dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
22554  DO variable_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
22555  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_VARIABLES
22556  variable_type=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
22557  & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%VARIABLE_TYPES(variable_idx)
22558  CALL field_parameter_set_update_finish(dependent_field,variable_type,field_values_set_type,err,error,*999)
22559  ENDDO !variable_idx
22560  ENDDO !equations_set_idx
22561  ELSE
22562  CALL flagerror("Solver vector is not associated.",err,error,*998)
22563  ENDIF
22564  ELSE
22565  CALL flagerror("Solver matrix is not associated.",err,error,*998)
22566  ENDIF
22567  ENDDO !solver_matrix_idx
22568  ELSE
22569  CALL flagerror("Solver matrices solution mapping is not associated.",err,error,*998)
22570  ENDIF
22571  ELSE
22572  CALL flagerror("Solver equations solver matrices are not associated.",err,error,*998)
22573  ENDIF
22574  ELSE
22575  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
22576  ENDIF
22577  ELSE
22578  CALL flagerror("Solver has not been finished.",err,error,*998)
22579  ENDIF
22580  ELSE
22581  CALL flagerror("Solver is not associated.",err,error,*998)
22582  ENDIF
22583 
22584  exits("SOLVER_VARIABLES_FIELD_UPDATE")
22585  RETURN
22586 999 IF(ASSOCIATED(solver_data)) CALL distributed_vector_data_restore(solver_vector,solver_data,dummy_err,dummy_error,*998)
22587 998 errorsexits("SOLVER_VARIABLES_FIELD_UPDATE",err,error)
22588  RETURN 1
22589 
22590  END SUBROUTINE solver_variables_field_update
22591 
22592  !
22593  !================================================================================================================================
22594  !
22595 
22597  SUBROUTINE solvers_create_finish(SOLVERS,ERR,ERROR,*)
22598 
22599  !Argument variables
22600  TYPE(solvers_type), POINTER :: SOLVERS
22601  INTEGER(INTG), INTENT(OUT) :: ERR
22602  TYPE(varying_string), INTENT(OUT) :: ERROR
22603  !Local Variables
22604  INTEGER(INTG) :: solver_idx
22605  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
22606  TYPE(solver_type), POINTER :: SOLVER
22607 
22608  enters("SOLVERS_CREATE_FINISH",err,error,*999)
22609 
22610  IF(ASSOCIATED(solvers)) THEN
22611  IF(solvers%SOLVERS_FINISHED) THEN
22612  CALL flagerror("Solvers has already been finished.",err,error,*999)
22613  ELSE
22614  control_loop=>solvers%CONTROL_LOOP
22615  IF(ASSOCIATED(control_loop)) THEN
22616  !Finish the solver creation
22617  IF(ALLOCATED(solvers%SOLVERS)) THEN
22618  DO solver_idx=1,solvers%NUMBER_OF_SOLVERS
22619  solver=>solvers%SOLVERS(solver_idx)%PTR
22620  IF(ASSOCIATED(solver)) THEN
22621  CALL solver_create_finish(solver,err,error,*999)
22622  ELSE
22623  CALL flagerror("Solver is not associated.",err,error,*999)
22624  ENDIF
22625  ENDDO !solver_idx
22626  solvers%SOLVERS_FINISHED=.true.
22627  ELSE
22628  CALL flagerror("Solvers solvers is not allocated.",err,error,*999)
22629  ENDIF
22630  ELSE
22631  CALL flagerror("Solvers control loop is not associated.",err,error,*999)
22632  ENDIF
22633  ENDIF
22634  ELSE
22635  CALL flagerror("Solvers is not associated.",err,error,*999)
22636  ENDIF
22637 
22638  exits("SOLVERS_CREATE_FINISH")
22639  RETURN
22640 999 errorsexits("SOLVERS_CREATE_FINISH",err,error)
22641  RETURN 1
22642 
22643  END SUBROUTINE solvers_create_finish
22644 
22645  !
22646  !================================================================================================================================
22647  !
22648 
22650  SUBROUTINE solvers_create_start(CONTROL_LOOP,SOLVERS,ERR,ERROR,*)
22651 
22652  !Argument variables
22653  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
22654  TYPE(solvers_type), POINTER :: SOLVERS
22655  INTEGER(INTG), INTENT(OUT) :: ERR
22656  TYPE(varying_string), INTENT(OUT) :: ERROR
22657  !Local Variables
22658  TYPE(varying_string) :: LOCAL_ERROR
22659 
22660  enters("SOLVERS_CREATE_START",err,error,*999)
22661 
22662  IF(ASSOCIATED(control_loop)) THEN
22663  IF(control_loop%CONTROL_LOOP_FINISHED) THEN
22664  IF(control_loop%NUMBER_OF_SUB_LOOPS==0) THEN
22665  IF(ASSOCIATED(solvers)) THEN
22666  CALL flagerror("Solvers is already associated.",err,error,*999)
22667  ELSE
22668  NULLIFY(solvers)
22669  !Initialise the solvers
22670  CALL solvers_initialise(control_loop,err,error,*999)
22671  !Return the pointer
22672  solvers=>control_loop%SOLVERS
22673  ENDIF
22674  ELSE
22675  local_error="Invalid control loop setup. The specified control loop has "// &
22676  & trim(numbertovstring(control_loop%NUMBER_OF_SUB_LOOPS,"*",err,error))// &
22677  & " sub loops. To create solvers the control loop must have 0 sub loops."
22678  CALL flagerror(local_error,err,error,*999)
22679  ENDIF
22680  ELSE
22681  CALL flagerror("Control loop has not been finished.",err,error,*999)
22682  ENDIF
22683  ELSE
22684  CALL flagerror("Control loop is not associated.",err,error,*999)
22685  ENDIF
22686 
22687  exits("SOLVERS_CREATE_START")
22688  RETURN
22689 999 errorsexits("SOLVERS_CREATE_START",err,error)
22690  RETURN 1
22691  END SUBROUTINE solvers_create_start
22692 
22693  !
22694  !================================================================================================================================
22695  !
22696 
22698  SUBROUTINE solvers_destroy(SOLVERS,ERR,ERROR,*)
22699 
22700  !Argument variables
22701  TYPE(solvers_type), POINTER :: SOLVERS
22702  INTEGER(INTG), INTENT(OUT) :: ERR
22703  TYPE(varying_string), INTENT(OUT) :: ERROR
22704  !Local Variables
22705 
22706  enters("SOLVERS_DESTROY",err,error,*999)
22707 
22708  IF(ASSOCIATED(solvers)) THEN
22709  CALL solvers_finalise(solvers,err,error,*999)
22710  ELSE
22711  CALL flagerror("Solvers is not associated.",err,error,*999)
22712  ENDIF
22713 
22714  exits("SOLVERS_DESTROY")
22715  RETURN
22716 999 errorsexits("SOLVERS_DESTROY",err,error)
22717  RETURN 1
22718 
22719  END SUBROUTINE solvers_destroy
22720 
22721  !
22722  !================================================================================================================================
22723  !
22724 
22726  SUBROUTINE solvers_finalise(SOLVERS,ERR,ERROR,*)
22727 
22728  !Argument variables
22729  TYPE(solvers_type), POINTER :: SOLVERS
22730  INTEGER(INTG), INTENT(OUT) :: ERR
22731  TYPE(varying_string), INTENT(OUT) :: ERROR
22732  !Local Variables
22733  INTEGER(INTG) :: solver_idx
22734 
22735  enters("SOLVERS_FINALISE",err,error,*999)
22736 
22737  IF(ASSOCIATED(solvers)) THEN
22738  IF(ALLOCATED(solvers%SOLVERS)) THEN
22739  DO solver_idx=1,SIZE(solvers%SOLVERS,1)
22740  CALL solver_finalise(solvers%SOLVERS(solver_idx)%PTR,err,error,*999)
22741  ENDDO !solver_idx
22742  DEALLOCATE(solvers%SOLVERS)
22743  ENDIF
22744  DEALLOCATE(solvers)
22745  ENDIF
22746 
22747  exits("SOLVERS_FINALISE")
22748  RETURN
22749 999 errorsexits("SOLVERS_FINALISE",err,error)
22750  RETURN 1
22751  END SUBROUTINE solvers_finalise
22752 
22753  !
22754  !================================================================================================================================
22755  !
22756 
22758  SUBROUTINE solvers_initialise(CONTROL_LOOP,ERR,ERROR,*)
22759 
22760  !Argument variables
22761  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
22762  INTEGER(INTG), INTENT(OUT) :: ERR
22763  TYPE(varying_string), INTENT(OUT) :: ERROR
22764  !Local Variables
22765  INTEGER(INTG) :: DUMMY_ERR,solver_idx
22766  TYPE(varying_string) :: DUMMY_ERROR
22767 
22768  enters("SOLVERS_INITIALISE",err,error,*998)
22769 
22770  IF(ASSOCIATED(control_loop)) THEN
22771  IF(ASSOCIATED(control_loop%SOLVERS)) THEN
22772  CALL flagerror("Solvers is already allocated for this control loop.",err,error,*998)
22773  ELSE
22774  ALLOCATE(control_loop%SOLVERS,stat=err)
22775  IF(err/=0) CALL flagerror("Could not allocate control loop solvers.",err,error,*999)
22776  control_loop%SOLVERS%CONTROL_LOOP=>control_loop
22777  control_loop%SOLVERS%SOLVERS_FINISHED=.false.
22778  control_loop%SOLVERS%NUMBER_OF_SOLVERS=1
22779  ALLOCATE(control_loop%SOLVERS%SOLVERS(control_loop%SOLVERS%NUMBER_OF_SOLVERS),stat=err)
22780  IF(err/=0) CALL flagerror("Could not allocate solvers solvers.",err,error,*999)
22781  DO solver_idx=1,control_loop%SOLVERS%NUMBER_OF_SOLVERS
22782  NULLIFY(control_loop%SOLVERS%SOLVERS(solver_idx)%PTR)
22783  CALL solver_initialise(control_loop%SOLVERS,solver_idx,err,error,*999)
22784  ENDDO !solver_idx
22785  ENDIF
22786  ELSE
22787  CALL flagerror("Control loop is not associated.",err,error,*998)
22788  ENDIF
22789 
22790  exits("SOLVERS_INITIALISE")
22791  RETURN
22792 999 CALL solvers_finalise(control_loop%SOLVERS,dummy_err,dummy_error,*998)
22793 998 errorsexits("SOLVERS_INITIALISE",err,error)
22794  RETURN 1
22795 
22796  END SUBROUTINE solvers_initialise
22797 
22798 
22799  !
22800  !================================================================================================================================
22801  !
22802 
22804  SUBROUTINE solvers_number_set(SOLVERS,NUMBER_OF_SOLVERS,ERR,ERROR,*)
22805 
22806  !Argument variables
22807  TYPE(solvers_type), POINTER :: SOLVERS
22808  INTEGER(INTG), INTENT(IN) :: NUMBER_OF_SOLVERS
22809  INTEGER(INTG), INTENT(OUT) :: ERR
22810  TYPE(varying_string), INTENT(OUT) :: ERROR
22811  !Local Variables
22812  INTEGER(INTG) :: solver_idx, OLD_NUMBER_OF_SOLVERS
22813  TYPE(solver_ptr_type), ALLOCATABLE :: OLD_SOLVERS(:)
22814  TYPE(varying_string) :: LOCAL_ERROR
22815 
22816  enters("SOLVERS_NUMBER_SET",err,error,*998)
22817 
22818  IF(ASSOCIATED(solvers)) THEN
22819  IF(solvers%SOLVERS_FINISHED) THEN
22820  CALL flagerror("Solvers have already been finished.",err,error,*998)
22821  ELSE
22822  IF(number_of_solvers>0) THEN
22823  old_number_of_solvers=solvers%NUMBER_OF_SOLVERS
22824  IF(number_of_solvers/=old_number_of_solvers) THEN
22825  ALLOCATE(old_solvers(old_number_of_solvers),stat=err)
22826  IF(err/=0) CALL flagerror("Could not allocate old solvers.",err,error,*999)
22827  DO solver_idx=1,old_number_of_solvers
22828  old_solvers(solver_idx)%PTR=>solvers%SOLVERS(solver_idx)%PTR
22829  ENDDO !solver_idx
22830  IF(ALLOCATED(solvers%SOLVERS)) DEALLOCATE(solvers%SOLVERS)
22831  ALLOCATE(solvers%SOLVERS(number_of_solvers),stat=err)
22832  IF(err/=0) CALL flagerror("Could not allocate solvers.",err,error,*999)
22833  IF(number_of_solvers>old_number_of_solvers) THEN
22834  DO solver_idx=1,old_number_of_solvers
22835  solvers%SOLVERS(solver_idx)%PTR=>old_solvers(solver_idx)%PTR
22836  ENDDO !solver_idx
22837  solvers%NUMBER_OF_SOLVERS=number_of_solvers
22838  DO solver_idx=old_number_of_solvers+1,number_of_solvers
22839  NULLIFY(solvers%SOLVERS(solver_idx)%PTR)
22840  CALL solver_initialise(solvers,solver_idx,err,error,*999)
22841  ENDDO !solution_idx
22842  ELSE
22843  DO solver_idx=1,number_of_solvers
22844  solvers%SOLVERS(solver_idx)%PTR=>old_solvers(solver_idx)%PTR
22845  ENDDO !solver_idx
22846  DO solver_idx=number_of_solvers+1,old_number_of_solvers
22847  CALL solver_finalise(old_solvers(solver_idx)%PTR,err,error,*999)
22848  ENDDO !solver_idx
22849  solvers%NUMBER_OF_SOLVERS=number_of_solvers
22850  ENDIF
22851  ENDIF
22852  ELSE
22853  local_error="The specified number of solvers of "//trim(numbertovstring(number_of_solvers,"*",err,error))// &
22854  & " is invalid. The number of solvers must be > 0."
22855  CALL flagerror(local_error,err,error,*998)
22856  ENDIF
22857  ENDIF
22858  ELSE
22859  CALL flagerror("Solvers is not associated.",err,error,*998)
22860  ENDIF
22861 
22862  exits("SOLVERS_NUMBER_SET")
22863  RETURN
22864 999 IF(ALLOCATED(old_solvers)) DEALLOCATE(old_solvers)
22865 998 errorsexits("SOLVERS_NUMBER_SET",err,error)
22866  RETURN 1
22867 
22868  END SUBROUTINE solvers_number_set
22869 
22870  !
22871  !================================================================================================================================
22872  !
22873 
22875  SUBROUTINE solvers_solver_get(SOLVERS,SOLVER_INDEX,SOLVER,ERR,ERROR,*)
22876 
22877  !Argument variables
22878  TYPE(solvers_type), POINTER :: SOLVERS
22879  INTEGER(INTG), INTENT(IN) :: SOLVER_INDEX
22880  TYPE(solver_type), POINTER :: SOLVER
22881  INTEGER(INTG), INTENT(OUT) :: ERR
22882  TYPE(varying_string), INTENT(OUT) :: ERROR
22883  !Local Variables
22884  TYPE(varying_string) :: LOCAL_ERROR
22885 
22886  enters("SOLVERS_SOLVER_GET",err,error,*998)
22887 
22888  IF(ASSOCIATED(solvers)) THEN
22889  IF(ASSOCIATED(solver)) THEN
22890  CALL flagerror("Solver is already associated.",err,error,*998)
22891  ELSE
22892  NULLIFY(solver)
22893  IF(solver_index>0.AND.solver_index<=solvers%NUMBER_OF_SOLVERS) THEN
22894  IF(ALLOCATED(solvers%SOLVERS)) THEN
22895  solver=>solvers%SOLVERS(solver_index)%PTR
22896  IF(.NOT.ASSOCIATED(solver)) CALL flagerror("Solver is not associated.",err,error,*999)
22897  ELSE
22898  CALL flagerror("Solvers solvers is not associated.",err,error,*999)
22899  ENDIF
22900  ELSE
22901  local_error="The specified solver index of "//trim(numbertovstring(solver_index,"*",err,error))// &
22902  & " is invalid. The solver index must be >= 1 and <= "// &
22903  & trim(numbertovstring(solvers%NUMBER_OF_SOLVERS,"*",err,error))//"."
22904  CALL flagerror(local_error,err,error,*999)
22905  ENDIF
22906  ENDIF
22907  ELSE
22908  CALL flagerror("Solvers is not associated.",err,error,*998)
22909  ENDIF
22910 
22911  exits("SOLVERS_SOLVER_GET")
22912  RETURN
22913 999 NULLIFY(solver)
22914 998 errorsexits("SOLVERS_SOLVER_GET",err,error)
22915  RETURN 1
22916 
22917  END SUBROUTINE solvers_solver_get
22918 
22919  !
22920  !================================================================================================================================
22921  !
22922 
22924  SUBROUTINE solver_linked_solver_add(SOLVER,SOLVER_TO_LINK,SOLV_TYPE,ERR,ERROR,*)
22925 
22926  !Argument variables
22927  TYPE(solver_type), POINTER :: SOLVER
22928  TYPE(solver_type), POINTER :: SOLVER_TO_LINK
22929  INTEGER(INTG), INTENT(IN) :: SOLV_TYPE
22930  INTEGER(INTG), INTENT(OUT) :: ERR
22931  TYPE(varying_string), INTENT(OUT) :: ERROR
22932  !Local Variables
22933  TYPE(varying_string) :: LOCAL_ERROR
22934  TYPE(solver_ptr_type), ALLOCATABLE, TARGET :: OLD_LINKED_SOLVERS(:)
22935  INTEGER(INTG) :: solver_idx
22936 
22937  enters("SOLVER_LINKED_SOLVER_ADD",err,error,*999)
22938 
22939  IF(ASSOCIATED(solver)) THEN
22940  IF(ASSOCIATED(solver_to_link)) THEN
22941  IF(solv_type>=1 .AND. solv_type<=solver_number_of_solver_types) THEN
22942  !does the solver have already linked solvers?
22943  IF(solver%NUMBER_OF_LINKED_SOLVERS==0) THEN
22944  !no - then start the creation of linked solvers
22945  ALLOCATE(solver%LINKED_SOLVERS(1),stat=err)
22946  IF(err/=0) CALL flagerror("Could not allocate linked solvers.",err,error,*999)
22947  DO solver_idx=1,solver_number_of_solver_types
22948  NULLIFY(solver%LINKED_SOLVER_TYPE_MAP(solver_idx)%PTR)
22949  ENDDO !solver_idx
22950  solver%LINKED_SOLVER_TYPE_MAP(solv_type)%PTR=>solver_to_link
22951  solver%LINKED_SOLVERS(1)%PTR=>solver_to_link
22952  solver%NUMBER_OF_LINKED_SOLVERS=solver%NUMBER_OF_LINKED_SOLVERS+1
22953  ELSE IF(solver%NUMBER_OF_LINKED_SOLVERS>0.AND.solver%NUMBER_OF_LINKED_SOLVERS<=solver_number_of_solver_types) THEN
22954  !yes, there are already linked solvers
22955  !check if a solver of the same type has already been linked
22956  DO solver_idx=1,solver%NUMBER_OF_LINKED_SOLVERS
22957  IF(solver%LINKED_SOLVERS(solver_idx)%PTR%SOLVE_TYPE==solv_type) THEN
22958  local_error="The solver has already a linked solver of type "//trim(numbertovstring(solv_type, &
22959  & "*",err,error))//" attached to it."
22960  CALL flagerror(local_error,err,error,*999)
22961  ENDIF
22962  ENDDO !solver_idx
22963  ALLOCATE(old_linked_solvers(solver%NUMBER_OF_LINKED_SOLVERS),stat=err)
22964  IF(err/=0) CALL flagerror("Could not old linked solvers.",err,error,*999)
22965  DO solver_idx=1,solver%NUMBER_OF_LINKED_SOLVERS
22966  old_linked_solvers(solver_idx)%PTR=>solver%LINKED_SOLVERS(solver_idx)%PTR
22967  ENDDO
22968  DEALLOCATE(solver%LINKED_SOLVERS)
22969  ALLOCATE(solver%LINKED_SOLVERS(solver%NUMBER_OF_LINKED_SOLVERS+1),stat=err)
22970  IF(err/=0) CALL flagerror("Could not new linked solvers.",err,error,*999)
22971  DO solver_idx=1,solver%NUMBER_OF_LINKED_SOLVERS
22972  solver%LINKED_SOLVERS(solver_idx)%PTR=>old_linked_solvers(solver_idx)%PTR
22973  ENDDO
22974  solver%LINKED_SOLVERS(solver%NUMBER_OF_LINKED_SOLVERS+1)%PTR=>solver_to_link
22975  solver%LINKED_SOLVER_TYPE_MAP(solv_type)%PTR=>solver_to_link
22976  solver%NUMBER_OF_LINKED_SOLVERS=solver%NUMBER_OF_LINKED_SOLVERS+1
22977  DEALLOCATE(old_linked_solvers)
22978  ELSE
22979  local_error="The number of linked solvers is "//trim(numbertovstring(solver%NUMBER_OF_LINKED_SOLVERS,"*",err, &
22980  & error))//" but should be between 0 and "//trim(numbertovstring(solver_number_of_solver_types,"*",err,error))//"."
22981  CALL flagerror(local_error,err,error,*999)
22982  ENDIF
22983  !set the solver type for the linked solver
22984  solver%LINKED_SOLVER_TYPE_MAP(solv_type)%PTR%SOLVE_TYPE=solv_type
22985  !set the linking solver for the linked solver
22986  solver%LINKED_SOLVER_TYPE_MAP(solv_type)%PTR%LINKING_SOLVER=>solver
22987  ELSE
22988  local_error="The specified solver type is "//trim(numbertovstring(solv_type,"*",err,error))//&
22989  & " but should be between 1 and "//trim(numbertovstring(solver_number_of_solver_types,"*",err,error))//"."
22990  CALL flagerror(local_error,err,error,*999)
22991  ENDIF
22992  ELSE
22993  CALL flagerror("The solver to link is not associated.",err,error,*999)
22994  ENDIF
22995  ELSE
22996  CALL flagerror("Solver is not associated.",err,error,*999)
22997  ENDIF
22998 
22999  exits("SOLVER_LINKED_SOLVER_ADD")
23000  RETURN
23001 999 errorsexits("SOLVER_LINKED_SOLVER_ADD",err,error)
23002  RETURN 1
23003  END SUBROUTINE solver_linked_solver_add
23004 
23005  !
23006  !================================================================================================================================
23007  !
23008 
23010  SUBROUTINE solver_linked_solver_remove(SOLVER,SOLV_TYPE,ERR,ERROR,*)
23011 
23012  !Argument variables
23013  TYPE(solver_type), POINTER :: SOLVER
23014  INTEGER(INTG), INTENT(IN) :: SOLV_TYPE
23015  INTEGER(INTG), INTENT(OUT) :: ERR
23016  TYPE(varying_string), INTENT(OUT) :: ERROR
23017  !Local Variables
23018  TYPE(varying_string) :: LOCAL_ERROR
23019  INTEGER(INTG) :: solver_idx
23020 
23021  enters("SOLVER_LINKED_SOLVER_REMOVE",err,error,*999)
23022 
23023  IF(ASSOCIATED(solver)) THEN
23024  IF(solv_type>=1 .AND. solv_type<=solver_number_of_solver_types) THEN
23025  !Check if there is any linked solvers
23026  IF(solver%NUMBER_OF_LINKED_SOLVERS>0.AND.solver%NUMBER_OF_LINKED_SOLVERS<=solver_number_of_solver_types) THEN
23027  !Check if a solver of the same type has already been linked
23028  DO solver_idx=1,solver%NUMBER_OF_LINKED_SOLVERS
23029  IF(solver%LINKED_SOLVERS(solver_idx)%PTR%SOLVE_TYPE==solv_type) THEN
23030  DEALLOCATE(solver%LINKED_SOLVERS)
23031  solver%NUMBER_OF_LINKED_SOLVERS=solver%NUMBER_OF_LINKED_SOLVERS-1
23032  ENDIF
23033  ENDDO !solver_idx
23034  ENDIF
23035  ELSE
23036  local_error="The specified solver type is "//trim(numbertovstring(solv_type,"*",err,error))//&
23037  & " but should be between 1 and "//trim(numbertovstring(solver_number_of_solver_types,"*",err,error))//"."
23038  CALL flagerror(local_error,err,error,*999)
23039  ENDIF
23040  ELSE
23041  CALL flagerror("Solver is not associated.",err,error,*999)
23042  ENDIF
23043 
23044  exits("SOLVER_LINKED_SOLVER_REMOVE")
23045  RETURN
23046 999 errorsexits("SOLVER_LINKED_SOLVER_REMOVE",err,error)
23047  RETURN 1
23048 
23049  END SUBROUTINE solver_linked_solver_remove
23050 
23051 
23052 
23053  !
23054  !================================================================================================================================
23055  !
23056 
23057 END MODULE solver_routines
23058 
23059 !
23060 !================================================================================================================================
23061 !
23062 
23064 SUBROUTINE solver_time_stepping_monitor_petsc(ts,STEPS,TIME,X,CTX,ERR)
23065 
23066  USE base_routines
23067  USE cmisspetsctypes
23068  USE iso_varying_string
23069  USE kinds
23070  USE solver_routines
23071  USE strings
23072  USE types
23073 
23074  IMPLICIT NONE
23075 
23076  !Argument variables
23077  TYPE(petsctstype), INTENT(INOUT) :: ts
23078  INTEGER(INTG), INTENT(INOUT) :: STEPS
23079  REAL(DP), INTENT(INOUT) :: TIME
23080  TYPE(petscvectype), INTENT(INOUT) :: X
23081  TYPE(solver_type), POINTER :: CTX
23082  INTEGER(INTG), INTENT(INOUT) :: ERR
23083  !Local Variables
23084  TYPE(dae_solver_type), POINTER :: DAE_SOLVER
23085  TYPE(varying_string) :: ERROR,LOCAL_ERROR
23086 
23087  IF(ASSOCIATED(ctx)) THEN
23088  IF(ctx%SOLVE_TYPE==solver_dae_type) THEN
23089  dae_solver=>ctx%DAE_SOLVER
23090 
23091  CALL solver_time_stepping_monitor(dae_solver,steps,time,err,error,*999)
23092 
23093  ELSE
23094  local_error="Invalid solve type. The solve type of "//trim(numbertovstring(ctx%SOLVE_TYPE,"*",err,error))// &
23095  & " does not correspond to a differntial-algebraic equations solver."
23096  CALL flagerror(local_error,err,error,*999)
23097  ENDIF
23098  ELSE
23099  CALL flagerror("Solver context is not associated.",err,error,*999)
23100  ENDIF
23101 
23102  RETURN
23103 999 CALL write_error(err,error,*998)
23104 998 CALL flag_warning("Error monitoring differential-algebraic equations solve.",err,error,*997)
23105 997 RETURN
23106 END SUBROUTINE solver_time_stepping_monitor_petsc
23107 
23108 
23109 !
23110 !================================================================================================================================
23111 !
23113 SUBROUTINE solver_nonlinear_monitor_petsc(snes,ITS,NORM,CTX,ERR)
23114 
23115  USE base_routines
23116  USE cmisspetsctypes
23117  USE iso_varying_string
23118  USE kinds
23119  USE solver_routines
23120  USE strings
23121  USE types
23122 
23123  IMPLICIT NONE
23124 
23125  !Argument variables
23126  TYPE(petscsnestype), INTENT(INOUT) :: snes
23127  INTEGER(INTG), INTENT(INOUT) :: ITS
23128  REAL(DP), INTENT(INOUT) :: NORM
23129  TYPE(solver_type), POINTER :: CTX
23130  INTEGER(INTG), INTENT(INOUT) :: ERR
23131  !Local Variables
23132  TYPE(nonlinear_solver_type), POINTER :: NONLINEAR_SOLVER
23133  TYPE(varying_string) :: ERROR,LOCAL_ERROR
23134 
23135  IF(ASSOCIATED(ctx)) THEN
23136  IF(ctx%SOLVE_TYPE==solver_nonlinear_type) THEN
23137  nonlinear_solver=>ctx%NONLINEAR_SOLVER
23138 
23139  CALL solver_nonlinear_monitor(nonlinear_solver,its,norm,err,error,*999)
23140 
23141  ELSE
23142  local_error="Invalid solve type. The solve type of "//trim(numbertovstring(ctx%SOLVE_TYPE,"*",err,error))// &
23143  & " does not correspond to a nonlinear solver."
23144  CALL flagerror(local_error,err,error,*999)
23145  ENDIF
23146  ELSE
23147  CALL flagerror("Solver context is not associated.",err,error,*999)
23148  ENDIF
23149 
23150  RETURN
23151 999 CALL write_error(err,error,*998)
23152 998 CALL flag_warning("Error monitoring nonlinear solve.",err,error,*997)
23153 997 RETURN
23154 END SUBROUTINE solver_nonlinear_monitor_petsc
solver_routines::solver_dae_rush_larson_initialise
subroutine solver_dae_rush_larson_initialise(DAE_SOLVER, ERR, ERROR,)
Initialise an Rush-Larson solver for a differential-algebraic equation solver.
Definition: solver_routines.f90:4706
problem_constants::solver_equations_second_order_dynamic
integer(intg), parameter solver_equations_second_order_dynamic
Solver equations are second order dynamic.
Definition: problem_constants.f90:312
base_routines::enters
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Definition: base_routines.f90:363
solver_routines::solver_quasi_newton_scale_shanno
integer(intg), parameter, public solver_quasi_newton_scale_shanno
Use Shanno scaling.
Definition: solver_routines.f90:210
input_output::write_string_value
Write a string followed by a value to a given output stream.
Definition: input_output.f90:86
types::forward_euler_dae_solver_type
Contains information for an forward Euler differential-algebraic equation solver. ...
Definition: types.f90:2510
solver_routines::solvers_create_finish
subroutine, public solvers_create_finish(SOLVERS, ERR, ERROR,)
Finish the creation of solvers.
Definition: solver_routines.f90:22598
solver_routines::solver_newton_trustregion_solve
subroutine solver_newton_trustregion_solve(TRUSTREGION_SOLVER, ERR, ERROR,)
Definition: solver_routines.f90:19893
cmisspetsc::petsc_tsfinalise
subroutine, public petsc_tsfinalise(ts, err, error,)
Definition: cmiss_petsc.f90:5828
solver_routines::solver_dynamic_newmark3_scheme
integer(intg), parameter, public solver_dynamic_newmark3_scheme
3rd Newmark dynamic solver
Definition: solver_routines.f90:290
solver_routines::solver_newton_linesearch_steptol_set
subroutine, public solver_newton_linesearch_steptol_set(SOLVER, LINESEARCH_STEPTOL, ERR, ERROR,)
Sets/changes the line search step tolerance for a nonlinear Newton line search solver.
Definition: solver_routines.f90:19032
cmiss_cellml::cellml_field_to_cellml_update
subroutine, public cellml_field_to_cellml_update(CELLML, ERR, ERROR,)
Updates any cellml fields from the mapped fields.
Definition: cmiss_cellml.f90:785
solver_routines::solver_matrices_dynamic_assemble
subroutine, public solver_matrices_dynamic_assemble(SOLVER, SELECTION_TYPE, ERR, ERROR,)
Assembles the solver matrices and rhs from the dynamic equations.
Definition: solver_routines.f90:12079
solver_routines::solver_dynamic_third_degree
integer(intg), parameter, public solver_dynamic_third_degree
Dynamic solver uses a third degree polynomial for time interpolation.
Definition: solver_routines.f90:273
solver_routines::solver_variables_field_update
subroutine, public solver_variables_field_update(SOLVER, ERR, ERROR,)
Updates the dependent variables from the solver solution for static solvers.
Definition: solver_routines.f90:22404
solver_routines::solver_dynamic_theta_set
Definition: solver_routines.f90:395
solver_routines::solver_dae_bdf
integer(intg), parameter, public solver_dae_bdf
General BDF differential-algebraic equation solver.
Definition: solver_routines.f90:321
types::equations_mapping_type
Contains information on the equations mapping i.e., how field variable DOFS are mapped to the rows an...
Definition: types.f90:1681
types::cellml_equations_type
Contains information about the CellML equations for a solver.
Definition: types.f90:2475
types::equations_type
Contains information about the equations in an equations set.
Definition: types.f90:1735
solver_routines::solver_lineariterativerelativetoleranceset
subroutine, public solver_lineariterativerelativetoleranceset(SOLVER, RELATIVE_TOLERANCE, ERR, ERROR,)
Sets/changes the relative tolerance for an iterative linear solver.
Definition: solver_routines.f90:11333
solver_routines::solver_timing_output
integer(intg), parameter, public solver_timing_output
Timing output from the solver routines plus below.
Definition: solver_routines.f90:351
solver_routines::solver_newton_relative_tolerance_set
subroutine, public solver_newton_relative_tolerance_set(SOLVER, RELATIVE_TOLERANCE, ERR, ERROR,)
Sets/changes the relative tolerance for a nonlinear Newton solver.
Definition: solver_routines.f90:19352
solver_routines::solver_nonlinear_divergence_exit
subroutine, public solver_nonlinear_divergence_exit(SOLVER, ERR, ERROR,)
Instead of warning on nonlinear divergence, exit with error.
Definition: solver_routines.f90:20164
solver_matrices_routines
This module handles all solver matrix and rhs routines.
Definition: solver_matrices_routines.f90:45
solver_routines::solver_iterative_sor_preconditioner
integer(intg), parameter, public solver_iterative_sor_preconditioner
Successive over relaxation preconditioner type.
Definition: solver_routines.f90:154
solver_routines::solver_newton_finalise
recursive subroutine solver_newton_finalise(NEWTON_SOLVER, ERR, ERROR,)
Finalise a Newton solver and deallocate all memory.
Definition: solver_routines.f90:17754
solver_routines::solver_dae_bdf_finalise
subroutine solver_dae_bdf_finalise(BDF_SOLVER, ERR, ERROR,)
Finalise a BDF differential-algebraic equation solver and deallocate all memory.
Definition: solver_routines.f90:3411
solver_routines::solver_dynamic_backward_euler_scheme
integer(intg), parameter, public solver_dynamic_backward_euler_scheme
Backward Euler (implicit) dynamic solver.
Definition: solver_routines.f90:281
solver_routines::solver_dae_euler_forward
integer(intg), parameter, public solver_dae_euler_forward
Forward Euler differential equation solver.
Definition: solver_routines.f90:331
solver_routines::solver_optimiser_library_type_get
subroutine solver_optimiser_library_type_get(OPTIMISER_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for an optimiser solver.
Definition: solver_routines.f90:20911
solver_routines::solver_quasi_newton_lbfgs
integer(intg), parameter, public solver_quasi_newton_lbfgs
LBFGS Quasi-Newton type.
Definition: solver_routines.f90:182
problem_constants
This module handles all problem wide constants.
Definition: problem_constants.f90:45
problem_constants::solver_equations_first_order_dynamic
integer(intg), parameter solver_equations_first_order_dynamic
Solver equations are first order dynamic.
Definition: problem_constants.f90:311
solver_routines::solver_iterative_additive_schwarz_preconditioner
integer(intg), parameter, public solver_iterative_additive_schwarz_preconditioner
Additive Schwrz preconditioner type.
Definition: solver_routines.f90:157
solver_routines::solver_dynamic_order_set
subroutine, public solver_dynamic_order_set(SOLVER, ORDER, ERR, ERROR,)
Sets/changes the order for a dynamic solver.
Definition: solver_routines.f90:6327
solver_routines::solver_newton_linesearch_create_finish
subroutine solver_newton_linesearch_create_finish(LINESEARCH_SOLVER, ERR, ERROR,)
Finishes the process of creating nonlinear Newton line search solver.
Definition: solver_routines.f90:18309
solver_routines::solver_dae_euler_improved
integer(intg), parameter, public solver_dae_euler_improved
Improved Euler differential equation solver.
Definition: solver_routines.f90:333
distributed_matrix_vector::distributed_vector_create_start
subroutine, public distributed_vector_create_start(DOMAIN_MAPPING, DISTRIBUTED_VECTOR, ERR, ERROR,)
Starts the creation a distributed vector.
Definition: distributed_matrix_vector.f90:6475
solver_routines::solver_dae_euler_solver_type_set
subroutine, public solver_dae_euler_solver_type_set(SOLVER, DAE_EULER_TYPE, ERR, ERROR,)
Sets/changes the solve type for an Euler differential-algebraic equation solver.
Definition: solver_routines.f90:2969
solver_routines::solver_lineariterativematriceslibrarytypeget
subroutine solver_lineariterativematriceslibrarytypeget(ITERATIVE_SOLVER, MATRICES_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for an iterative linear solver matrices.
Definition: solver_routines.f90:11162
solver_routines::solver_dae_external_finalise
subroutine solver_dae_external_finalise(EXTERNAL_SOLVER, ERR, ERROR,)
Finalise an external differential-algebraic equation solver and deallocate all memory.
Definition: solver_routines.f90:4001
types::runge_kutta_dae_solver_type
Contains information for a Runge-Kutta differential-algebraic equation solver.
Definition: types.f90:2544
types::crank_nicolson_dae_solver_type
Contains information for a Crank-Nicholson differential-algebraic equation solver.
Definition: types.f90:2538
cmisspetsc
This module is a CMISS buffer module to the PETSc library.
Definition: cmiss_petsc.f90:45
solver_routines::solver_newton_trustregion_delta0_set
subroutine, public solver_newton_trustregion_delta0_set(SOLVER, TRUSTREGION_DELTA0, ERR, ERROR,)
Sets/changes the trust region delta0 for a nonlinear Newton trust region solver solver.
Definition: solver_routines.f90:19753
cmisspetsc::petsc_vecsetvalues
subroutine, public petsc_vecsetvalues(x, n, indices, values, insertMode, err, error,)
Buffer routine to the PETSc VecSetValues routine.
Definition: cmiss_petsc.f90:7441
distributed_matrix_vector::distributed_vector_create_finish
subroutine, public distributed_vector_create_finish(DISTRIBUTED_VECTOR, ERR, ERROR,)
Finishes the creation a distributed vector.
Definition: distributed_matrix_vector.f90:6424
cmisspetsc::petsc_tssetduration
subroutine, public petsc_tssetduration(ts, maxSteps, maxTime, err, error,)
Buffer routine to the PETSc TSSetDuration routine.
Definition: cmiss_petsc.f90:6001
solver_routines::solver_dae_index_1
integer(intg), parameter, public solver_dae_index_1
Index 1 differential-algebraic equation.
Definition: solver_routines.f90:308
solver_routines::solver_linear_iterative_solve_type
integer(intg), parameter, public solver_linear_iterative_solve_type
Iterative linear solver type.
Definition: solver_routines.f90:122
solver_routines::solver_dynamic_library_type_get
subroutine solver_dynamic_library_type_get(DYNAMIC_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for a dynamic solver.
Definition: solver_routines.f90:5653
solver_routines::solver_dae_library_type_get
subroutine solver_dae_library_type_get(DAE_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for a differential-algebraic equation solver.
Definition: solver_routines.f90:3139
solver_routines::solver_geometrictransformationtranslationset
subroutine, public solver_geometrictransformationtranslationset(solver, translation, incrementIdx, err, error,)
Set the translation for a geometric transformation.
Definition: solver_routines.f90:8518
cmisspetsctypes
This module contains types related to the PETSc library.
Definition: cmiss_petsc_types.f90:45
solver_routines::solver_geometrictransformationmatrixset
subroutine, public solver_geometrictransformationmatrixset(solver, matrix, incrementIdx, err, error,)
Set the full transformation matrix for a geometric transformation at a load increment.
Definition: solver_routines.f90:8296
types::euler_dae_solver_type
Contains information for an Euler differential-algebraic equation solver.
Definition: types.f90:2528
solver_routines::solver_dynamic_initialise
subroutine solver_dynamic_initialise(SOLVER, ERR, ERROR,)
Initialise a dynamic solver for a solver.
Definition: solver_routines.f90:5596
cmisspetsc::petsc_tssetrhsfunction
subroutine, public petsc_tssetrhsfunction(ts, rates, rhsFunction, ctx, err, error,)
Buffer routine to the PETSc TSSetRHSFunction routine.
Definition: cmiss_petsc.f90:6157
solver_routines::solver_initialise_ptr
subroutine solver_initialise_ptr(SOLVER, ERR, ERROR,)
Initialise a solver.
Definition: solver_routines.f90:8797
solver_routines::solver_linear_direct_solve_type
integer(intg), parameter, public solver_linear_direct_solve_type
Direct linear solver type.
Definition: solver_routines.f90:121
constants::library_cmiss_type
integer(intg), parameter library_cmiss_type
CMISS (internal) library type.
Definition: constants.f90:159
types::solver_type
Contains information on the type of solver to be used.
Definition: types.f90:2777
solver_routines::solver_iterative_bicgstab
integer(intg), parameter, public solver_iterative_bicgstab
Stabalised bi-conjugate gradient iterative solver type.
Definition: solver_routines.f90:143
solver_routines::solver_dynamic_bossak_newmark2_scheme
integer(intg), parameter, public solver_dynamic_bossak_newmark2_scheme
2nd Bossak-Newmark dynamic solver
Definition: solver_routines.f90:297
solver_routines::solver_solution_initialise_current_field
integer(intg), parameter, public solver_solution_initialise_current_field
Initialise the solution by copying in the current dependent field values.
Definition: solver_routines.f90:341
solver_routines::solver_newton_jacobian_equations_calculated
integer(intg), parameter, public solver_newton_jacobian_equations_calculated
The Jacobian values will be calculated analytically for the nonlinear equations set.
Definition: solver_routines.f90:238
solver_routines::solver_petsc_library
integer(intg), parameter, public solver_petsc_library
PETSc solver library.
Definition: solver_routines.f90:104
solver_routines::solver_linear_direct_library_type_set
subroutine solver_linear_direct_library_type_set(DIRECT_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library to use for a direct linear solver.
Definition: solver_routines.f90:9644
solver_routines::solvers_number_set
subroutine, public solvers_number_set(SOLVERS, NUMBER_OF_SOLVERS, ERR, ERROR,)
Sets/changes the number of solvers.
Definition: solver_routines.f90:22805
solver_routines::solver_dynamic_theta_set_dp1
subroutine solver_dynamic_theta_set_dp1(SOLVER, THETA, ERR, ERROR,)
Sets/changes a single theta value for a dynamic solver.
Definition: solver_routines.f90:6691
solver_routines::solver_direct_lu
integer(intg), parameter, public solver_direct_lu
LU direct linear solver.
Definition: solver_routines.f90:129
solver_routines::solver_optimiser_solve
subroutine solver_optimiser_solve(OPTIMISER_SOLVER, ERR, ERROR,)
Solve an optimiser solver.
Definition: solver_routines.f90:21009
solver_routines::solver_geometrictransformationscalingsset
subroutine, public solver_geometrictransformationscalingsset(solver, scalings, err, error,)
Set the scalings for geometric transformation solver.
Definition: solver_routines.f90:8472
solver_routines::solver_newton_solve
subroutine solver_newton_solve(NEWTON_SOLVER, ERR, ERROR,)
Definition: solver_routines.f90:19537
solver_matrices_routines::solver_matrices_create_finish
subroutine, public solver_matrices_create_finish(SOLVER_MATRICES, ERR, ERROR,)
Finishes the process of creating the solver matrices.
Definition: solver_matrices_routines.f90:104
solver_routines::solver_dae_time_step_set
subroutine, public solver_dae_time_step_set(SOLVER, TIME_STEP, ERR, ERROR,)
Set/change the (initial) time step size for a differential-algebraic equation solver.
Definition: solver_routines.f90:5047
solver_routines::solver_dynamic_crank_nicolson_scheme
integer(intg), parameter, public solver_dynamic_crank_nicolson_scheme
Crank-Nicolson dynamic solver.
Definition: solver_routines.f90:282
solver_routines::solver_iterative_conjgrad_squared
integer(intg), parameter, public solver_iterative_conjgrad_squared
Conjugate gradient squared iterative solver type.
Definition: solver_routines.f90:144
solver_routines::solver_dynamic_degree_set
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.
Definition: solver_routines.f90:5484
solver_routines::solver_quasinewtonjacobiancalculationtypeset
subroutine, public solver_quasinewtonjacobiancalculationtypeset(SOLVER, JACOBIAN_CALCULATION_TYPE, ERR, ERROR,)
Sets/changes the type of Jacobian calculation type for a Quasi-Newton solver.
Definition: solver_routines.f90:15123
solver_routines::solver_dae_rush_larson
integer(intg), parameter, public solver_dae_rush_larson
Rush-Larson differential-algebraic equation solver.
Definition: solver_routines.f90:322
solver_routines::solver_newton_linesearch_finalise
subroutine solver_newton_linesearch_finalise(LINESEARCH_SOLVER, ERR, ERROR,)
Finalise a nonlinear Newton line search solver and deallocate all memory.
Definition: solver_routines.f90:18722
solver_routines::solver_dynamic_first_order
integer(intg), parameter, public solver_dynamic_first_order
Dynamic solver has first order terms.
Definition: solver_routines.f90:255
solver_routines::solver_newton_solution_tolerance_set
subroutine, public solver_newton_solution_tolerance_set(SOLVER, SOLUTION_TOLERANCE, ERR, ERROR,)
Sets/changes the solution tolerance for a nonlinear Newton solver.
Definition: solver_routines.f90:19477
solver_routines::solver_dae_euler_forward_integrate
subroutine solver_dae_euler_forward_integrate(FORWARD_EULER_SOLVER, CELLML, N, START_TIME, END_TIME, TIME_INCREMENT, ONLY_ONE_MODEL_INDEX, MODELS_DATA, MAX_NUMBER_STATES, STATE_DATA, MAX_NUMBER_PARAMETERS, PARAMETERS_DATA, MAX_NUMBER_INTERMEDIATES, INTERMEDIATE_DATA, ERR, ERROR,)
Integrate using a forward Euler differential-algebraic equation solver.
Definition: solver_routines.f90:2071
solver_routines::solver_linear_iterative_library_type_get
subroutine solver_linear_iterative_library_type_get(ITERATIVE_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for an iterative linear solver.
Definition: solver_routines.f90:11008
solver_routines::solver_type_set
subroutine, public solver_type_set(SOLVER, SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type for a solver.
Definition: solver_routines.f90:21345
solver_routines::solver_mumpssetcntl
subroutine, public solver_mumpssetcntl(solver, icntl, val, err, error,)
Sets MUMPS CNTL(icntl)=val through PETSc Mat API (see MUMPS user guide for more info). Must be called after the boundary conditions have been set up.
Definition: solver_routines.f90:9956
constants::library_lusol_type
integer(intg), parameter library_lusol_type
LUSOL library type.
Definition: constants.f90:165
solver_routines::solver_dae_rush_larson_solve
subroutine solver_dae_rush_larson_solve(RUSH_LARSON_SOLVER, ERR, ERROR,)
Solve using a Rush-Larson differential-algebraic equation solver.
Definition: solver_routines.f90:4747
solver_routines::solver_essl_library
integer(intg), parameter, public solver_essl_library
ESSL solver library.
Definition: solver_routines.f90:110
types::equations_set_type
Contains information on an equations set.
Definition: types.f90:1941
solver_routines::solver_quasi_newton_finalise
recursive subroutine solver_quasi_newton_finalise(QUASI_NEWTON_SOLVER, ERR, ERROR,)
Finalise a Quasi-Newton solver and deallocate all memory.
Definition: solver_routines.f90:15017
constants::library_mumps_type
integer(intg), parameter library_mumps_type
MUMPS library type.
Definition: constants.f90:161
solver_routines::solver_nonlinear_finalise
recursive subroutine solver_nonlinear_finalise(NONLINEAR_SOLVER, ERR, ERROR,)
Finalise a nonlinear solver for a solver.
Definition: solver_routines.f90:20272
solver_routines::solver_dae_euler_library_type_get
subroutine solver_dae_euler_library_type_get(EULER_DAE_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for an Euler differential-algebraic equation solver.
Definition: solver_routines.f90:2730
solver_routines::solver_dae_type
integer(intg), parameter, public solver_dae_type
A differential-algebraic equation solver.
Definition: solver_routines.f90:91
solver_routines::solver_linear_direct_solve
subroutine solver_linear_direct_solve(LINEAR_DIRECT_SOLVER, ERR, ERROR,)
Solve a linear direct solver.
Definition: solver_routines.f90:10065
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
constants::library_umfpack_type
integer(intg), parameter library_umfpack_type
UMFPack library type.
Definition: constants.f90:164
solver_routines::solvers_create_start
subroutine, public solvers_create_start(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Start the creation of a solvers for the control loop.
Definition: solver_routines.f90:22651
solver_routines::solver_daecellmlpetsccontextset
subroutine solver_daecellmlpetsccontextset(ctx, solver, cellml, dofIdx, err, error,)
Set a CellML PETSc context.
Definition: solver_routines.f90:3543
solver_routines::solver_linear_initialise
subroutine solver_linear_initialise(SOLVER, ERR, ERROR,)
Initialise a linear solver for a solver.
Definition: solver_routines.f90:10470
solver_routines::solver_newton_trustregion
integer(intg), parameter, public solver_newton_trustregion
Newton trust region nonlinear solver type.
Definition: solver_routines.f90:220
solver_routines::solver_linear_iterative_library_type_set
subroutine solver_linear_iterative_library_type_set(ITERATIVE_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library to use for an iterative linear solver.
Definition: solver_routines.f90:11055
solver_routines::solver_newton_jacobian_not_calculated
integer(intg), parameter, public solver_newton_jacobian_not_calculated
The Jacobian values will not be calculated for the nonlinear equations set.
Definition: solver_routines.f90:237
solver_routines::solver_full_matrices
integer(intg), parameter, public solver_full_matrices
Use fully populated solver matrices.
Definition: solver_routines.f90:361
solver_time_stepping_monitor_petsc
subroutine solver_time_stepping_monitor_petsc(ts, STEPS, TIME, X, CTX, ERR)
Called from the PETSc TS solvers to monitor the dynamic solver.
Definition: solver_routines.f90:23065
cmiss_cellml::cellml_cellml_to_field_update
subroutine, public cellml_cellml_to_field_update(CELLML, ERR, ERROR,)
Updates any mapped fields from the cellml fields.
Definition: cmiss_cellml.f90:206
solver_routines::solver_library_type_get
subroutine, public solver_library_type_get(SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Gets the type of library to use for the solver.
Definition: solver_routines.f90:8975
solver_routines::solver_dynamic_linearity_type_set
subroutine, public solver_dynamic_linearity_type_set(SOLVER, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for the dynamic solver.
Definition: solver_routines.f90:5758
solver_routines::solver_dae_euler_improved_finalise
subroutine solver_dae_euler_improved_finalise(IMPROVED_EULER_SOLVER, ERR, ERROR,)
Finalise an improved Euler differential-algebaic equation and deallocate all memory.
Definition: solver_routines.f90:2589
solver_routines::solver_newton_linear_solver_get
subroutine, public solver_newton_linear_solver_get(SOLVER, LINEAR_SOLVER, ERR, ERROR,)
Returns the linear solver associated with a Newton solver.
Definition: solver_routines.f90:18044
solver_routines::solver_dae_adams_moulton_initialise
subroutine solver_dae_adams_moulton_initialise(DAE_SOLVER, ERR, ERROR,)
Initialise an Adams-Moulton solver for a differential-algebraic equation solver.
Definition: solver_routines.f90:1778
solver_routines::solver_newton_cellml_solver_get
subroutine, public solver_newton_cellml_solver_get(SOLVER, CELLML_SOLVER, ERR, ERROR,)
Returns the CellML solver associated with a Newton solver.
Definition: solver_routines.f90:18100
solver_routines::solver_dae_euler
integer(intg), parameter, public solver_dae_euler
Euler differential-algebraic equation solver.
Definition: solver_routines.f90:317
solver_routines::solver_dae_crank_nicolson_solve
subroutine solver_dae_crank_nicolson_solve(CRANK_NICOLSON_SOLVER, ERR, ERROR,)
Solve using a Crank-Nicolson differential-algebraic equation solver.
Definition: solver_routines.f90:3973
solver_routines::solvers_finalise
subroutine solvers_finalise(SOLVERS, ERR, ERROR,)
Finalises the solvers and deallocates all memory.
Definition: solver_routines.f90:22727
timer
This module contains routines for timing the program.
Definition: timer_f.f90:45
solver_routines::solver_destroy
subroutine, public solver_destroy(SOLVER, ERR, ERROR,)
Destroys a solver.
Definition: solver_routines.f90:5093
solver_routines::solver_newton_linesearch_maxstep_set
subroutine, public solver_newton_linesearch_maxstep_set(SOLVER, LINESEARCH_MAXSTEP, ERR, ERROR,)
Sets/changes the line search maximum step for a nonlinear Newton linesearch solver.
Definition: solver_routines.f90:18803
types::cellml_evaluator_solver_type
Contains information for a CellML evaluation solver.
Definition: types.f90:2753
solver_routines::solverequations_numberofmatricesget
subroutine, public solverequations_numberofmatricesget(solverEquations, numberOfMatrices, err, error,)
Get the number of solver matrices for the solver equations.
Definition: solver_routines.f90:7845
problem_constants::solver_equations_static
integer(intg), parameter solver_equations_static
Solver equations are static.
Definition: problem_constants.f90:309
solver_routines::solver_newtonmaximumfunctionevaluationsset
subroutine, public solver_newtonmaximumfunctionevaluationsset(SOLVER, MAXIMUM_FUNCTION_EVALUATIONS, ERR, ERROR,)
Sets/changes the maximum number of function evaluations for a nonlinear Newton solver.
Definition: solver_routines.f90:19231
solver_routines::solver_create_finish
subroutine solver_create_finish(SOLVER, ERR, ERROR,)
Finishes the process of creating a solver.
Definition: solver_routines.f90:1714
solver_routines::solver_dynamic_linearity_type_get
subroutine, public solver_dynamic_linearity_type_get(SOLVER, LINEARITY_TYPE, ERR, ERROR,)
Returns the linearity type for the dynamic solver.
Definition: solver_routines.f90:5719
solver_routines::solver_equations_sparsity_type_set
subroutine, public solver_equations_sparsity_type_set(SOLVER_EQUATIONS, SPARSITY_TYPE, ERR, ERROR,)
Sets/changes the sparsity type for solver equations.
Definition: solver_routines.f90:7734
solver_routines::solver_geometrictransformationrotationset
subroutine, public solver_geometrictransformationrotationset(solver, pt, axis, theta, incrementIdx, err, error,)
Set the rotation for a geometric transformation.
Definition: solver_routines.f90:8379
solver_routines::solver_linear_type_set
subroutine, public solver_linear_type_set(SOLVER, LINEAR_SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type of linear solver.
Definition: solver_routines.f90:12007
solver_routines::solver_newton_trustregion_initialise
subroutine solver_newton_trustregion_initialise(NEWTON_SOLVER, ERR, ERROR,)
Initialise a Newton trust region solver for a nonlinear solver.
Definition: solver_routines.f90:19851
solver_routines::solver_quasinewtonmaximumfunctionevaluationsset
subroutine, public solver_quasinewtonmaximumfunctionevaluationsset(SOLVER, MAXIMUM_FUNCTION_EVALUATIONS, ERR, ERROR,)
Sets/changes the maximum number of function evaluations for a nonlinear Quasi-Newton solver...
Definition: solver_routines.f90:16446
maths
This module contains all mathematics support routines.
Definition: maths.f90:45
solver_routines::solver_dae_bdf_initialise
subroutine solver_dae_bdf_initialise(DAE_SOLVER, ERR, ERROR,)
Initialise a BDF solver for a differential-algebraic equation solver.
Definition: solver_routines.f90:3437
solver_routines::solvers_solver_get
subroutine, public solvers_solver_get(SOLVERS, SOLVER_INDEX, SOLVER, ERR, ERROR,)
Returns a pointer to the specified solver in the list of solvers.
Definition: solver_routines.f90:22876
types::adams_moulton_dae_solver_type
Contains information for an Adams-Moulton differential-algebraic equation solver. ...
Definition: types.f90:2550
types::field_type
Contains information for a field defined on a region.
Definition: types.f90:1346
base_routines::write_error
Flags a warning to the user.
Definition: base_routines.f90:284
solver_routines::solver_direct_svd
integer(intg), parameter, public solver_direct_svd
SVD direct linear solver.
Definition: solver_routines.f90:131
solver_routines::solver_dae_euler_improved_solve
subroutine solver_dae_euler_improved_solve(IMPROVED_EULER_SOLVER, ERR, ERROR,)
Solve using an improved Euler differential-algebraic equation solver.
Definition: solver_routines.f90:2657
solver_routines::solver_daecellmlrhsevaluate
subroutine, public solver_daecellmlrhsevaluate(model, time, stateStartIdx, stateDataOffset, stateData, parameterStartIdx, parameterDataOffset, parameterData, intermediateStartIdx, intermediateDataOffset, intermediateData, rateStartIdx, rateDataOffset, rateData, err, error,)
Integrate using a forward Euler differential-algebraic equation solver.
Definition: solver_routines.f90:4220
solver_routines::solver_iterative_block_jacobi_preconditioner
integer(intg), parameter, public solver_iterative_block_jacobi_preconditioner
Iterative block Jacobi preconditioner type.
Definition: solver_routines.f90:153
solver_routines::solver_equations_finalise
subroutine solver_equations_finalise(SOLVER_EQUATIONS, ERR, ERROR,)
Finalises the solver equations and deallocates all memory.
Definition: solver_routines.f90:7445
problem_constants::solver_equations_linear
integer(intg), parameter solver_equations_linear
Solver equations are linear.
Definition: problem_constants.f90:301
solver_routines::solver_nonlinear_library_type_get
subroutine solver_nonlinear_library_type_get(NONLINEAR_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for a nonlinear solver.
Definition: solver_routines.f90:20355
solver_routines::solver_newton_jacobian_calculation_type_set
subroutine, public solver_newton_jacobian_calculation_type_set(SOLVER, JACOBIAN_CALCULATION_TYPE, ERR, ERROR,)
Sets/changes the type of Jacobian calculation type for a Newton solver.
Definition: solver_routines.f90:17855
solver_routines::solver_mumpsseticntl
subroutine, public solver_mumpsseticntl(solver, icntl, ivalue, err, error,)
Sets MUMPS ICNTL(icntl)=ivalue through PETSc Mat API (see MUMPS user guide for more info)...
Definition: solver_routines.f90:9837
solver_routines::solver_newton_create_finish
subroutine solver_newton_create_finish(NEWTON_SOLVER, ERR, ERROR,)
Finishes the process of creating a Newton solver.
Definition: solver_routines.f90:17716
solver_routines::cellml_equations_initialise
subroutine cellml_equations_initialise(SOLVER, ERR, ERROR,)
Initialises the CellML equations for a solver.
Definition: solver_routines.f90:908
solver_routines::solver_solution_initialise_no_change
integer(intg), parameter, public solver_solution_initialise_no_change
Do not change the solution before a solve.
Definition: solver_routines.f90:342
iso_varying_string
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
Definition: iso_varying_string.f90:62
solver_routines::solver_equations_create_finish
subroutine, public solver_equations_create_finish(SOLVER_EQUATIONS, ERR, ERROR,)
Finishes the process of creating solver equations.
Definition: solver_routines.f90:7166
solver_routines::solver_lineardirectmatriceslibrarytypeget
subroutine solver_lineardirectmatriceslibrarytypeget(DIRECT_SOLVER, MATRICES_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for a direct linear solver matrices.
Definition: solver_routines.f90:9806
solver_routines::solver_optimiser_finalise
subroutine solver_optimiser_finalise(OPTIMISER_SOLVER, ERR, ERROR,)
Finalise a optimiser solver.
Definition: solver_routines.f90:20846
solver_mapping_routines
This module handles all solver mapping routines.
Definition: solver_mapping_routines.f90:45
solver_routines::solver_initialise
subroutine solver_initialise(SOLVERS, SOLVER_INDEX, ERR, ERROR,)
Initialise a solver for a control loop.
Definition: solver_routines.f90:8743
solver_routines::solver_sparse_matrices
integer(intg), parameter, public solver_sparse_matrices
Use sparse solver matrices.
Definition: solver_routines.f90:360
solver_routines::solver_dae_euler_backward_initialise
subroutine solver_dae_euler_backward_initialise(EULER_DAE_SOLVER, ERR, ERROR,)
Initialise a backward Euler solver for a differential-algebraic equation solver.
Definition: solver_routines.f90:1902
solver_routines::solvers_initialise
subroutine solvers_initialise(CONTROL_LOOP, ERR, ERROR,)
Initialises the solvers for a control loop.
Definition: solver_routines.f90:22759
solver_routines::solver_equations_create_start
subroutine, public solver_equations_create_start(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Starts the process of creating solver equations.
Definition: solver_routines.f90:7209
solver_routines::solver_iterative_jacobi_preconditioner
integer(intg), parameter, public solver_iterative_jacobi_preconditioner
Jacobi preconditioner type.
Definition: solver_routines.f90:152
solver_routines::solver_newton_initialise
subroutine solver_newton_initialise(NONLINEAR_SOLVER, ERR, ERROR,)
Initialise a Newton solver for a nonlinear solver.
Definition: solver_routines.f90:17783
solver_matrices_routines::solver_matrices_create_start
subroutine, public solver_matrices_create_start(SOLVER_EQUATIONS, SOLVER_MATRICES, ERR, ERROR,)
Starts the process of creating the solver matrices.
Definition: solver_matrices_routines.f90:218
solver_routines::solver_newton_linesearch_type_set
subroutine, public solver_newton_linesearch_type_set(SOLVER, LINESEARCH_TYPE, ERR, ERROR,)
Sets/changes the line search type for a nonlinear Newton linesearch solver.
Definition: solver_routines.f90:19103
solver_routines::solver_dynamic_mean_predicted_calculate
subroutine solver_dynamic_mean_predicted_calculate(SOLVER, ERR, ERROR,)
Copies the current to previous time-step, calculates mean predicted values, predicted values and prev...
Definition: solver_routines.f90:5930
solver_routines::solver_cellml_evaluator_library_type_set
subroutine solver_cellml_evaluator_library_type_set(CELLML_EVALUATOR_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library to use for a CellML evaluator solver.
Definition: solver_routines.f90:1107
solver_routines::solver_cellml_evaluator_finalise
subroutine, public solver_cellml_evaluator_finalise(CELLML_EVALUATOR_SOLVER, ERR, ERROR,)
Finalise a CellML evaluator solver.
Definition: solver_routines.f90:1013
solver_routines::solver_lineariterativeabsolutetoleranceset
subroutine, public solver_lineariterativeabsolutetoleranceset(SOLVER, ABSOLUTE_TOLERANCE, ERR, ERROR,)
Sets/changes the maximum absolute tolerance for an iterative linear solver.
Definition: solver_routines.f90:10514
solver_routines::solver_pastix_library
integer(intg), parameter, public solver_pastix_library
PaStiX solver library.
Definition: solver_routines.f90:114
solver_routines::solver_quasi_newton_cellml_solver_get
subroutine, public solver_quasi_newton_cellml_solver_get(SOLVER, CELLML_SOLVER, ERR, ERROR,)
Returns the CellML solver associated with a Quasi-Newton solver.
Definition: solver_routines.f90:15369
solver_routines::solver_dynamic_type
integer(intg), parameter, public solver_dynamic_type
A dynamic solver.
Definition: solver_routines.f90:90
solver_routines::solver_dynamic_restart_get
subroutine, public solver_dynamic_restart_get(SOLVER, RESTART, ERR, ERROR,)
Returns the restart value for a dynamic solver.
Definition: solver_routines.f90:6206
solver_routines::solver_dae_external_initialise
subroutine solver_dae_external_initialise(DAE_SOLVER, ERR, ERROR,)
Initialise an external solver for a differential-algebraic equation solver.
Definition: solver_routines.f90:4027
solver_routines::solver_dynamic_degree_get
subroutine, public solver_dynamic_degree_get(SOLVER, DEGREE, ERR, ERROR,)
Returns the degree of the polynomial used to interpolate time for a dynamic solver.
Definition: solver_routines.f90:5441
constants::library_essl_type
integer(intg), parameter library_essl_type
ESSL library type.
Definition: constants.f90:166
solver_routines::solver_equations_initialise
subroutine solver_equations_initialise(SOLVER, ERR, ERROR,)
Initialises the solver equations for a solver.
Definition: solver_routines.f90:7474
solver_routines::solver_nonlinear_quasi_newton
integer(intg), parameter, public solver_nonlinear_quasi_newton
Sequential Quasi-Newton nonlinear solver type.
Definition: solver_routines.f90:167
types::equations_mapping_dynamic_type
Contains information for mapping field variables to the dynamic matrices in the equations set of the ...
Definition: types.f90:1571
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
solver_routines::solverequations_rhsvectorget
subroutine, public solverequations_rhsvectorget(solverEquations, rhsVector, err, error,)
Get the right hand side vector from the solver equations.
Definition: solver_routines.f90:8065
constants
This module contains all program wide constants.
Definition: constants.f90:45
solver_routines::solver_newton_trustregion_create_finish
subroutine solver_newton_trustregion_create_finish(TRUSTREGION_SOLVER, ERR, ERROR,)
Finishes the process of creating nonlinear Newton trust region solver.
Definition: solver_routines.f90:19575
problem_constants::solver_equations_nonlinear
integer(intg), parameter solver_equations_nonlinear
Solver equations are nonlinear.
Definition: problem_constants.f90:302
solver_routines::solver_library_type_set
subroutine, public solver_library_type_set(SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library type to use for the solver.
Definition: solver_routines.f90:9067
solver_routines::solver_optimiser_initialise
subroutine solver_optimiser_initialise(SOLVER, ERR, ERROR,)
Initialise an optimiser solver for a solver.
Definition: solver_routines.f90:20872
solver_routines::solver_dae_euler_improved_initialise
subroutine solver_dae_euler_improved_initialise(EULER_DAE_SOLVER, ERR, ERROR,)
Initialise an improved Euler solver for a differential-algebraic equation solver. ...
Definition: solver_routines.f90:2615
solver_routines::cellml_equations_destroy
subroutine, public cellml_equations_destroy(CELLML_EQUATIONS, ERR, ERROR,)
Destroys the CellML equations.
Definition: solver_routines.f90:853
solver_routines::solver_quasi_newton_library_type_set
subroutine solver_quasi_newton_library_type_set(QUASI_NEWTON_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library to use for a Quasi-Newton solver.
Definition: solver_routines.f90:15242
solver_routines::cellml_equations_cellml_add
subroutine, public cellml_equations_cellml_add(CELLML_EQUATIONS, CELLML, CELLML_INDEX, ERR, ERROR,)
Adds a CellML environment to a solvers CellML equations.
Definition: solver_routines.f90:721
base_routines::flag_warning
Flags a warning to the user.
Definition: base_routines.f90:232
solver_routines::solver_daecellmlpetsccontextinitialise
subroutine solver_daecellmlpetsccontextinitialise(ctx, err, error,)
Initialise a CellML PETSc context.
Definition: solver_routines.f90:3506
solver_routines::solver_quasi_newton_solution_init_type_set
subroutine, public solver_quasi_newton_solution_init_type_set(SOLVER, SOLUTION_INITIALISE_TYPE, ERR, ERROR,)
Sets/changes the solution initialisation for a nonlinear Quasi-Newton solver.
Definition: solver_routines.f90:16628
solver_routines::solverequations_vectorget
subroutine, public solverequations_vectorget(solverEquations, matrixIndex, vector, err, error,)
Get the vector assiciated with a solver matrix from the solver equations matrices.
Definition: solver_routines.f90:7965
solver_routines::solver_dynamic_second_degree_gear_scheme
integer(intg), parameter, public solver_dynamic_second_degree_gear_scheme
2nd degree Gear dynamic solver
Definition: solver_routines.f90:285
solver_routines::solverequations_residualvectorget
subroutine, public solverequations_residualvectorget(solverEquations, residualVector, err, error,)
Get the residual vector from the solver equations for nonlinear problems.
Definition: solver_routines.f90:8022
solver_routines::solver_newton_solution_init_type_set
subroutine, public solver_newton_solution_init_type_set(SOLVER, SOLUTION_INITIALISE_TYPE, ERR, ERROR,)
Sets/changes the solution initialisation for a nonlinear Newton solver.
Definition: solver_routines.f90:19412
types::cellmlpetsccontexttype
Contains information on the solver, cellml, dof etc. for which cellml equations are to be evaluated b...
Definition: types.f90:2318
solver_routines::solver_cellml_evaluator_time_get
subroutine solver_cellml_evaluator_time_get(CELLML_EVALUATOR_SOLVER, TIME, ERR, ERROR,)
Returns the time for a CellML evaluator solver.
Definition: solver_routines.f90:1144
solver_routines::solver_newton_convergence_petsc_default
integer(intg), parameter, public solver_newton_convergence_petsc_default
Petsc default convergence test.
Definition: solver_routines.f90:246
solver_routines::solver_dae_adams_moulton_finalise
subroutine solver_dae_adams_moulton_finalise(ADAMS_MOULTON_SOLVER, ERR, ERROR,)
Finalise an Adams-Moulton differential-algebraic equation solver and deallocate all memory...
Definition: solver_routines.f90:1752
solver_nonlinear_monitor_petsc
subroutine solver_nonlinear_monitor_petsc(snes, ITS, NORM, CTX, ERR)
Called from the PETSc SNES solvers to monitor the Newton nonlinear solver.
Definition: solver_routines.f90:23114
solver_routines::solver_newton_linesearch_initialise
subroutine solver_newton_linesearch_initialise(NEWTON_SOLVER, ERR, ERROR,)
Initialise a nonlinear Newton line search solver for a Newton solver.
Definition: solver_routines.f90:18753
solver_routines::solver_dynamic_houbolt_scheme
integer(intg), parameter, public solver_dynamic_houbolt_scheme
Houbolt dynamic solver.
Definition: solver_routines.f90:294
cmisspetsc::petsc_tssetexactfinaltime
subroutine, public petsc_tssetexactfinaltime(ts, exactFinalTime, err, error,)
Buffer routine to the PETSc TSSetExactFinalTime routine.
Definition: cmiss_petsc.f90:6032
solver_routines::solver_dynamic_zlamal_scheme
integer(intg), parameter, public solver_dynamic_zlamal_scheme
Zlamal dynamic solver.
Definition: solver_routines.f90:284
cmisspetsc::petsc_tssetsolution
subroutine, public petsc_tssetsolution(ts, initialSolution, err, error,)
Buffer routine to the PETSc TSSetSolution routine.
Definition: cmiss_petsc.f90:6189
solver_routines::solver_newton_library_type_get
subroutine solver_newton_library_type_get(NEWTON_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for a Newton solver.
Definition: solver_routines.f90:17922
solver_routines::solver_dae_euler_forward_finalise
subroutine solver_dae_euler_forward_finalise(FORWARD_EULER_SOLVER, ERR, ERROR,)
Finalise a forward Euler differential-algebraic equation and deallocate all memory.
Definition: solver_routines.f90:2001
solver_routines::solver_newton_linesearch_solve
subroutine solver_newton_linesearch_solve(LINESEARCH_SOLVER, ERR, ERROR,)
Definition: solver_routines.f90:18874
solver_matrices_routines::solver_matrices_storage_type_set
subroutine, public solver_matrices_storage_type_set(SOLVER_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the solver matrices.
Definition: solver_matrices_routines.f90:611
solver_routines::solver_dae_runge_kutta_initialise
subroutine solver_dae_runge_kutta_initialise(DAE_SOLVER, ERR, ERROR,)
Initialise a Runge-Kutta solver for a differential-algebraic equation solver.
Definition: solver_routines.f90:4611
solver_routines::solver_iterative_incomplete_lu_preconditioner
integer(intg), parameter, public solver_iterative_incomplete_lu_preconditioner
Incomplete LU preconditioner type.
Definition: solver_routines.f90:156
solver_routines::solver_dynamic_user_defined_scheme
integer(intg), parameter, public solver_dynamic_user_defined_scheme
User specified degree and theta dynamic solver.
Definition: solver_routines.f90:300
solver_routines::solver_iterative_conjugate_gradient
integer(intg), parameter, public solver_iterative_conjugate_gradient
Conjugate gradient iterative solver type.
Definition: solver_routines.f90:140
types::nonlinear_solver_type
Contains information for a nonlinear solver.
Definition: types.f90:2731
solver_routines::solver_quasi_newton_linesearch_basic
integer(intg), parameter, public solver_quasi_newton_linesearch_basic
Simple damping line search.
Definition: solver_routines.f90:191
solver_routines::solver_geometrictransformationfieldset
subroutine, public solver_geometrictransformationfieldset(solver, field, variableType, err, error,)
Set the field and field variable type for geometric transformation solver.
Definition: solver_routines.f90:8221
problem_constants::solver_equations_quasistatic
integer(intg), parameter solver_equations_quasistatic
Solver equations are quasistatic.
Definition: problem_constants.f90:310
solver_routines::solver_quasi_newton_linesearch_maxstep_set
subroutine, public solver_quasi_newton_linesearch_maxstep_set(SOLVER, LINESEARCH_MAXSTEP, ERR, ERROR,)
Sets/changes the line search maximum step for a nonlinear Quasi-Newton linesearch solver...
Definition: solver_routines.f90:16025
solver_routines::solver_newton_library_type_set
subroutine solver_newton_library_type_set(NEWTON_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library to use for a Newton solver.
Definition: solver_routines.f90:17973
solver_routines::solver_newton_linesearch
integer(intg), parameter, public solver_newton_linesearch
Newton line search nonlinear solver type.
Definition: solver_routines.f90:219
solver_routines::solver_equations_linearity_type_set
subroutine, public solver_equations_linearity_type_set(SOLVER_EQUATIONS, LINEARITY_TYPE, ERR, ERROR,)
Sets/changes the linearity type for solver equations.
Definition: solver_routines.f90:7577
solver_routines::solver_linear_direct_type_set
subroutine, public solver_linear_direct_type_set(SOLVER, DIRECT_SOLVER_TYPE, ERR, ERROR,)
Sets/changes the type of direct linear solver.
Definition: solver_routines.f90:10365
solver_routines::solver_dynamic_linear_solver_get
subroutine, public solver_dynamic_linear_solver_get(SOLVER, LINEAR_SOLVER, ERR, ERROR,)
Returns the linear solver associated with a dynamic solver.
Definition: solver_routines.f90:5885
solver_routines::solver_output_type_set
subroutine, public solver_output_type_set(SOLVER, OUTPUT_TYPE, ERR, ERROR,)
Sets/changes the output type for a solver.
Definition: solver_routines.f90:21037
solver_routines::solver_quasi_newton_linesearch_cp
integer(intg), parameter, public solver_quasi_newton_linesearch_cp
Critical point secant line search.
Definition: solver_routines.f90:193
solver_routines::solver_hypre_library
integer(intg), parameter, public solver_hypre_library
Hypre solver library.
Definition: solver_routines.f90:113
solver_routines::cellml_equations_create_start
subroutine, public cellml_equations_create_start(SOLVER, CELLML_EQUATIONS, ERR, ERROR,)
Starts the process of creating CellML equations.
Definition: solver_routines.f90:818
solver_routines::solver_quasi_newton_linesearch_initialise
subroutine solver_quasi_newton_linesearch_initialise(QUASI_NEWTON_SOLVER, ERR, ERROR,)
Initialise a nonlinear Quasi-Newton line search solver for a Quasi-Newton solver. ...
Definition: solver_routines.f90:15976
cmisspetsc::petsc_vecdestroy
subroutine, public petsc_vecdestroy(x, err, error,)
Buffer routine to the PETSc VecDestroy routine.
Definition: cmiss_petsc.f90:6775
solver_routines::solver_dae_bdf_integrate
subroutine solver_dae_bdf_integrate(BDF_SOLVER, CELLML, N, START_TIME, END_TIME, TIME_INCREMENT, ONLY_ONE_MODEL_INDEX, MODELS_DATA, MAX_NUMBER_STATES, STATE_DATA, MAX_NUMBER_PARAMETERS, PARAMETERS_DATA, MAX_NUMBER_INTERMEDIATES, INTERMEDIATE_DATA, ERR, ERROR,)
Integrate using a BDF differential-algebraic equation solver.
Definition: solver_routines.f90:3594
solver_routines::solver_lusol_library
integer(intg), parameter, public solver_lusol_library
LUSOL solver library.
Definition: solver_routines.f90:109
solver_routines::solver_dae_differential_only
integer(intg), parameter, public solver_dae_differential_only
Differential equations only.
Definition: solver_routines.f90:307
solver_routines::solver_dae_euler_backward
integer(intg), parameter, public solver_dae_euler_backward
Backward Euler differential equation solver.
Definition: solver_routines.f90:332
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
solver_routines::solver_quasi_newton_linesearch_type_set
subroutine, public solver_quasi_newton_linesearch_type_set(SOLVER, LINESEARCH_TYPE, ERR, ERROR,)
Sets/changes the line search type for a nonlinear Quasi-Newton linesearch solver. ...
Definition: solver_routines.f90:16320
solver_routines::solver_linear_direct_cholesky_finalise
subroutine solver_linear_direct_cholesky_finalise(DIRECT_SOLVER, ERR, ERROR,)
Finalise a Cholesky direct linear solver and deallocate all memory.
Definition: solver_routines.f90:9287
solver_routines::solver_lineariterativesolutioninittypeset
subroutine, public solver_lineariterativesolutioninittypeset(SOLVER, SOLUTION_INITIALISE_TYPE, ERR, ERROR,)
Sets/changes the solution initialise type for an iterative linear solver.
Definition: solver_routines.f90:11389
solver_routines::solver_quasi_newton_scale_jacobian
integer(intg), parameter, public solver_quasi_newton_scale_jacobian
Scale by inverting a previously computed Jacobian.
Definition: solver_routines.f90:212
solver_routines::solver_quasi_newton_solve
subroutine solver_quasi_newton_solve(QUASI_NEWTON_SOLVER, ERR, ERROR,)
Definition: solver_routines.f90:16753
solver_routines::solver_dae_euler_initialise
subroutine solver_dae_euler_initialise(DAE_SOLVER, ERR, ERROR,)
Initialise an Euler solver for a differential-algebraic equation solver.
Definition: solver_routines.f90:2685
solver_routines::solver_equations_boundary_conditions_get
subroutine, public solver_equations_boundary_conditions_get(SOLVER_EQUATIONS, BOUNDARY_CONDITIONS, ERR, ERROR,)
Gets the boundary conditions for solver equations.
Definition: solver_routines.f90:7127
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
solver_routines::solver_linear_direct_initialise
subroutine solver_linear_direct_initialise(LINEAR_SOLVER, ERR, ERROR,)
Initialise a direct linear solver for a lienar solver.
Definition: solver_routines.f90:9563
solver_routines::solver_linear_iterative_gmres_restart_set
subroutine, public solver_linear_iterative_gmres_restart_set(SOLVER, GMRES_RESTART, ERR, ERROR,)
Sets/changes the GMRES restart value for a GMRES iterative linear solver.
Definition: solver_routines.f90:10894
solver_routines::solver_cellml_equations_get
subroutine, public solver_cellml_equations_get(SOLVER, CELLML_EQUATIONS, ERR, ERROR,)
Returns a pointer to the CellML equations for a solver.
Definition: solver_routines.f90:947
solver_routines::solver_label_set_vs
subroutine solver_label_set_vs(SOLVER, LABEL, ERR, ERROR,)
Sets the label of a solver.
Definition: solver_routines.f90:8943
types::equations_mapping_nonlinear_type
Contains information on the equations mapping for nonlinear matrices i.e., how a field variable is ma...
Definition: types.f90:1623
types::equations_matrices_type
Contains information on the equations matrices and vectors.
Definition: types.f90:1520
cmisspetsc::petsc_tssetinitialtimestep
subroutine, public petsc_tssetinitialtimestep(ts, initialTime, timeStep, err, error,)
Buffer routine to the PETSc TSSetInitialTimeStep routine.
Definition: cmiss_petsc.f90:6096
solver_routines::solver_dae_euler_forward_solve
subroutine solver_dae_euler_forward_solve(FORWARD_EULER_SOLVER, ERR, ERROR,)
Solve using a forward Euler differential-algebraic equation solver.
Definition: solver_routines.f90:2440
solver_routines::solver_eigenproblem_create_finish
subroutine solver_eigenproblem_create_finish(EIGENPROBLEM_SOLVER, ERR, ERROR,)
Finishes the process of creating a eigenproblem solver.
Definition: solver_routines.f90:6911
solver_routines::solver_superlu_library
integer(intg), parameter, public solver_superlu_library
SuperLU solver library.
Definition: solver_routines.f90:106
solver_routines::solver_quasi_newton_relative_tolerance_set
subroutine, public solver_quasi_newton_relative_tolerance_set(SOLVER, RELATIVE_TOLERANCE, ERR, ERROR,)
Sets/changes the relative tolerance for a nonlinear Quasi-Newton solver.
Definition: solver_routines.f90:16568
solver_routines::solver_eigenproblem_library_type_set
subroutine solver_eigenproblem_library_type_set(EIGENPROBLEM_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library to use for an eigenproblem solver.
Definition: solver_routines.f90:7033
solver_routines::solver_linear_iterative_create_finish
subroutine solver_linear_iterative_create_finish(LINEAR_ITERATIVE_SOLVER, ERR, ERROR,)
Finishes the process of creating a linear iterative solver.
Definition: solver_routines.f90:10570
input_output::write_string
Write a string to a given output stream.
Definition: input_output.f90:74
base_routines
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
Definition: base_routines.f90:45
solver_routines::solver_iterative_incomplete_cholesky_preconditioner
integer(intg), parameter, public solver_iterative_incomplete_cholesky_preconditioner
Incomplete Cholesky preconditioner type.
Definition: solver_routines.f90:155
solver_routines::solver_dae_index_3
integer(intg), parameter, public solver_dae_index_3
Index 3 differential-algebraic equation.
Definition: solver_routines.f90:310
solver_routines::solver_iterative_gmres
integer(intg), parameter, public solver_iterative_gmres
Generalised minimum residual iterative solver type.
Definition: solver_routines.f90:142
solver_routines::solver_quasinewtonconvergencetesttypeset
subroutine, public solver_quasinewtonconvergencetesttypeset(solver, convergenceTestType, err, error,)
Sets/changes the convergence test for a Quasi-Newton nonlinear solver.
Definition: solver_routines.f90:15443
types::equations_matrices_linear_type
Contains information of the linear matrices for equations matrices.
Definition: types.f90:1479
base_routines::general_output_type
integer(intg), parameter, public general_output_type
General output type.
Definition: base_routines.f90:66
solver_routines::solver_quasi_newton_trustregion_finalise
subroutine solver_quasi_newton_trustregion_finalise(TRUSTREGION_SOLVER, ERR, ERROR,)
Finalise a nonlinear Quasi-Newton trust region solver and deallocate all memory.
Definition: solver_routines.f90:17038
solver_routines::solver_quasi_newton_scale_linesearch
integer(intg), parameter, public solver_quasi_newton_scale_linesearch
Scale based upon line search lambda.
Definition: solver_routines.f90:211
solver_routines::solver_eigenproblemmatriceslibrarytypeget
subroutine solver_eigenproblemmatriceslibrarytypeget(EIGENPROBLEM_SOLVER, MATRICES_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for an eigenproblem solver matrices.
Definition: solver_routines.f90:7070
solver_routines::solver_dae_external_solve
subroutine solver_dae_external_solve(EXTERNAL_SOLVER, ERR, ERROR,)
Solve using an external differential-algebraic equation solver.
Definition: solver_routines.f90:4068
solver_routines::solver_newton_matrices_library_type_get
subroutine solver_newton_matrices_library_type_get(NEWTON_SOLVER, MATRICES_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for a Newton solver matrices.
Definition: solver_routines.f90:19180
solver_routines::solver_dae_euler_solver_type_get
subroutine, public solver_dae_euler_solver_type_get(SOLVER, DAE_EULER_TYPE, ERR, ERROR,)
Returns the solve type for an Euler differential-algebraic equation solver.
Definition: solver_routines.f90:2915
solver_routines::solver_dynamic_theta_set_dp
subroutine solver_dynamic_theta_set_dp(SOLVER, THETA, ERR, ERROR,)
Sets/changes the theta value for a dynamic solver.
Definition: solver_routines.f90:6715
solver_routines::solver_quasi_newton_linesearch
integer(intg), parameter, public solver_quasi_newton_linesearch
Quasi-Newton line search nonlinear solver type.
Definition: solver_routines.f90:174
solver_routines::solver_dae_bdf_solve
subroutine solver_dae_bdf_solve(BDF_SOLVER, ERR, ERROR,)
Solve using a BDF differential-algebraic equation solver.
Definition: solver_routines.f90:3765
iso_varying_string::trim
Definition: iso_varying_string.f90:204
solver_routines::solver_dynamic_second_degree_liniger1_scheme
integer(intg), parameter, public solver_dynamic_second_degree_liniger1_scheme
1st 2nd degree Liniger dynamic solver
Definition: solver_routines.f90:286
solver_routines::solver_dynamic_finalise
recursive subroutine solver_dynamic_finalise(DYNAMIC_SOLVER, ERR, ERROR,)
Finalise a dynamic solver and deallocates all memory.
Definition: solver_routines.f90:5564
solver_routines::solver_dynamic_create_finish
subroutine solver_dynamic_create_finish(DYNAMIC_SOLVER, ERR, ERROR,)
Finishes the process of creating a dynamic solver.
Definition: solver_routines.f90:5121
types::external_dae_solver_type
Contains information for an external differential-algebraic equation solver.
Definition: types.f90:2568
solver_routines::solver_newton_convergence_differentiated_ratio
integer(intg), parameter, public solver_newton_convergence_differentiated_ratio
Sum of differentiated ratios of unconstrained to constrained residuals convergence test...
Definition: solver_routines.f90:248
solver_routines::solver_lineariterativedivergencetoleranceset
subroutine, public solver_lineariterativedivergencetoleranceset(SOLVER, DIVERGENCE_TOLERANCE, ERR, ERROR,)
Sets/changes the maximum divergence tolerance for an iterative linear solver.
Definition: solver_routines.f90:10802
solver_routines::solver_dynamic_second_order
integer(intg), parameter, public solver_dynamic_second_order
Dynamic solver has second order terms.
Definition: solver_routines.f90:256
solver_routines::solver_quasinewtonlinesearchmonitoroutputset
subroutine, public solver_quasinewtonlinesearchmonitoroutputset(solver, linesearchMonitorOutputFlag, err, error,)
Enables/disables output monitoring for a nonlinear Quasi-Newton line search solver.
Definition: solver_routines.f90:14913
solver_routines::solver_dynamic_euler_scheme
integer(intg), parameter, public solver_dynamic_euler_scheme
Euler (explicit) dynamic solver.
Definition: solver_routines.f90:280
constants::library_hypre_type
integer(intg), parameter library_hypre_type
Hypre library type.
Definition: constants.f90:169
solver_routines::solver_dynamic_nonlinear_solver_get
subroutine, public solver_dynamic_nonlinear_solver_get(SOLVER, NONLINEAR_SOLVER, ERR, ERROR,)
Returns the nonlinear solver associated with a dynamic solver.
Definition: solver_routines.f90:5839
solver_routines::solver_tao_library
integer(intg), parameter, public solver_tao_library
TAO solver library.
Definition: solver_routines.f90:112
solver_routines::solver_linear_iterative_initialise
subroutine solver_linear_iterative_initialise(LINEAR_SOLVER, ERR, ERROR,)
Initialise an iterative linear solver for a linear solver.
Definition: solver_routines.f90:10958
solver_routines::solver_equations_equations_set_add
subroutine, public solver_equations_equations_set_add(SOLVER_EQUATIONS, EQUATIONS_SET, EQUATIONS_SET_INDEX, ERR, ERROR,)
Adds equations sets to solver equations.
Definition: solver_routines.f90:7299
constants::library_petsc_type
integer(intg), parameter library_petsc_type
PETSc library type.
Definition: constants.f90:160
solver_routines::solver_nonlinear_type
integer(intg), parameter, public solver_nonlinear_type
A nonlinear solver.
Definition: solver_routines.f90:89
solver_routines::solver_lineariterativepreconditionertypeset
subroutine, public solver_lineariterativepreconditionertypeset(SOLVER, ITERATIVE_PRECONDITIONER_TYPE, ERR, ERROR,)
Sets/changes the type of preconditioner for an iterative linear solver.
Definition: solver_routines.f90:11248
solver_routines::solver_dae_crank_nicolson_initialise
subroutine solver_dae_crank_nicolson_initialise(DAE_SOLVER, ERR, ERROR,)
Initialise a Crank-Nicolson solver for a differential-algebraic equation solver.
Definition: solver_routines.f90:3931
solver_routines::solver_quasi_newton_type_set
subroutine, public solver_quasi_newton_type_set(SOLVER, QUASI_NEWTON_TYPE, ERR, ERROR,)
Sets/changes the type of nonlinear Quasi-Newton solver.
Definition: solver_routines.f90:17439
solver_routines::solver_geometric_transformation_type
integer(intg), parameter, public solver_geometric_transformation_type
An geometric transformation solver.
Definition: solver_routines.f90:96
solver_routines::solver_quasi_newton_restart_none
integer(intg), parameter, public solver_quasi_newton_restart_none
Never restart.
Definition: solver_routines.f90:200
solver_routines::solver_nonlinear_type_set
subroutine, public solver_nonlinear_type_set(SOLVER, NONLINEAR_SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type of nonlinear solver.
Definition: solver_routines.f90:20728
types::cellml_state_field_type
Contains information on the state field for a CellML environment.
Definition: types.f90:2294
solver_routines::solver_solution_update
subroutine, public solver_solution_update(SOLVER, ERR, ERROR,)
Updates the solver solution from the field variables.
Definition: solver_routines.f90:21086
solver_routines::solver_optimiser_library_type_set
subroutine solver_optimiser_library_type_set(OPTIMISER_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library to use for an optimisation solver.
Definition: solver_routines.f90:20940
solver_routines::solver_quasi_newton_create_finish
subroutine solver_quasi_newton_create_finish(QUASI_NEWTON_SOLVER, ERR, ERROR,)
Finishes the process of creating a Quasi-Newton solver.
Definition: solver_routines.f90:14977
solver_routines::solver_solution_initialise_zero
integer(intg), parameter, public solver_solution_initialise_zero
Initialise the solution by zeroing it before a solve.
Definition: solver_routines.f90:340
comp_environment
This module contains all computational environment variables.
Definition: computational_environment.f90:46
solver_routines::solver_spooles_library
integer(intg), parameter, public solver_spooles_library
Spooles solver library.
Definition: solver_routines.f90:107
solver_routines::solver_cellml_evaluator_type
integer(intg), parameter, public solver_cellml_evaluator_type
A CellML evaluation solver.
Definition: solver_routines.f90:94
solver_routines::solver_label_set_c
subroutine solver_label_set_c(SOLVER, LABEL, ERR, ERROR,)
Sets the label of a solver.
Definition: solver_routines.f90:8910
solver_routines::solver_quasi_newton_library_type_get
subroutine solver_quasi_newton_library_type_get(QUASI_NEWTON_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for a Quasi-Newton solver.
Definition: solver_routines.f90:15191
solver_matrices_routines::solver_matrices_library_type_get
subroutine solver_matrices_library_type_get(SOLVER_MATRICES, LIBRARY_TYPE, ERR, ERROR,)
Gets the library type for the solver matrices (and vectors)
Definition: solver_matrices_routines.f90:416
solver_routines::solver_dynamic_solve
subroutine solver_dynamic_solve(DYNAMIC_SOLVER, ERR, ERROR,)
Solve a dynamic solver.
Definition: solver_routines.f90:6555
solver_routines::solver_nonlinear_matrices_library_type_get
subroutine solver_nonlinear_matrices_library_type_get(NONLINEAR_SOLVER, MATRICES_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for a nonlinear solver matrices.
Definition: solver_routines.f90:20467
solver_routines::solver_nonlinear_monitor
subroutine, public solver_nonlinear_monitor(nonlinearSolver, its, norm, err, error,)
Monitors the nonlinear solve.
Definition: solver_routines.f90:20523
solver_routines::solver_dynamic_update_bc_set
subroutine, public solver_dynamic_update_bc_set(SOLVER, UPDATE_BC, ERR, ERROR,)
Sets/changes the bc flag for a dynamic solver.
Definition: solver_routines.f90:6819
cmiss_cellml::cellml_models_field_not_constant
integer(intg), parameter, public cellml_models_field_not_constant
The CellML environement models field is not constant.
Definition: cmiss_cellml.f90:104
solver_routines::solver_newton_linesearch_cubic
integer(intg), parameter, public solver_newton_linesearch_cubic
Cubic search for Newton line search nonlinear solves.
Definition: solver_routines.f90:230
solver_routines::solver_quasi_newton_restart_powell
integer(intg), parameter, public solver_quasi_newton_restart_powell
Restart based upon descent criteria.
Definition: solver_routines.f90:201
solver_routines::solver_dae_index_2
integer(intg), parameter, public solver_dae_index_2
Index 2 differential-algebraic equation.
Definition: solver_routines.f90:309
solver_routines::solver_linear_direct_finalise
subroutine solver_linear_direct_finalise(LINEAR_DIRECT_SOLVER, ERR, ERROR,)
Finalise a direct linear solver for a linear solver and deallocate all memory.
Definition: solver_routines.f90:9530
solver_routines::solver_geometrictransformationfinalise
subroutine solver_geometrictransformationfinalise(geometricTransformationSolver, err, error,)
Finalise a geometric transformation solver for a solver.
Definition: solver_routines.f90:8581
cmisspetsc::petsc_tscreate
subroutine, public petsc_tscreate(communicator, ts, err, error,)
Buffer routine to the PETSc TSCreate routine.
Definition: cmiss_petsc.f90:5878
solver_routines::solver_quasinewtonmatriceslibrarytypeget
subroutine solver_quasinewtonmatriceslibrarytypeget(QUASI_NEWTON_SOLVER, MATRICES_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for a Quasi-Newton solver matrices.
Definition: solver_routines.f90:16395
solver_routines::solver_eigenproblem_library_type_get
subroutine solver_eigenproblem_library_type_get(EIGENPROBLEM_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for an eigenproblem solver.
Definition: solver_routines.f90:7004
solver_routines::solver_nonlinear_create_finish
subroutine solver_nonlinear_create_finish(NONLINEAR_SOLVER, ERR, ERROR,)
Finishes the process of creating a nonlinear solver.
Definition: solver_routines.f90:20122
solver_routines::solver_iterative_no_preconditioner
integer(intg), parameter, public solver_iterative_no_preconditioner
No preconditioner type.
Definition: solver_routines.f90:151
solver_routines::solver_iterative_chebyshev
integer(intg), parameter, public solver_iterative_chebyshev
Chebyshev iterative solver type.
Definition: solver_routines.f90:139
solver_routines::solver_newton_trustregion_tolerance_set
subroutine, public solver_newton_trustregion_tolerance_set(SOLVER, TRUSTREGION_TOLERANCE, ERR, ERROR,)
Sets/changes the trust region tolerance for a nonlinear Newton trust region solver.
Definition: solver_routines.f90:19961
solver_routines::solver_equations_destroy
subroutine, public solver_equations_destroy(SOLVER_EQUATIONS, ERR, ERROR,)
Destroys the solver equations.
Definition: solver_routines.f90:7271
solver_routines::solver_dynamic_third_degree_liniger1_scheme
integer(intg), parameter, public solver_dynamic_third_degree_liniger1_scheme
1st 3rd degree Liniger dynamic solver
Definition: solver_routines.f90:292
cmisspetsc::petsc_vecgetvalues
subroutine, public petsc_vecgetvalues(x, n, indices, values, err, error,)
Buffer routine to the PETSc VecGetValues routine.
Definition: cmiss_petsc.f90:7033
solver_routines::solver_linear_direct_library_type_get
subroutine solver_linear_direct_library_type_get(DIRECT_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for a direct linear solver.
Definition: solver_routines.f90:9603
solver_routines::solver_newtonconvergencetesttypeset
subroutine, public solver_newtonconvergencetesttypeset(solver, convergenceTestType, err, error,)
Sets/changes the convergence test for a Newton nonlinear solver.
Definition: solver_routines.f90:18174
solver_routines::solver_matrices_library_type_get
subroutine solver_matrices_library_type_get(SOLVER, MATRICES_LIBRARY_TYPE, ERR, ERROR,)
Gets the type of library to use for the solver matrices.
Definition: solver_routines.f90:14781
cmisspetsc::petsc_tssolve
subroutine, public petsc_tssolve(ts, x, finalTime, err, error,)
Buffer routine to the PETSc TSSolve routine.
Definition: cmiss_petsc.f90:6279
types::improved_euler_dae_solver_type
Contains information for an improved Euler differential-algebraic equation solver.
Definition: types.f90:2522
solver_routines::solver_cellml_evaluator_solve
subroutine solver_cellml_evaluator_solve(CELLML_EVALUATOR_SOLVER, ERR, ERROR,)
Solve a CellML evaluator solver.
Definition: solver_routines.f90:1201
types::solver_equations_type
Contains information about the solver equations for a solver.
Definition: types.f90:2452
solver_routines::solver_dae_rush_larson_finalise
subroutine solver_dae_rush_larson_finalise(RUSH_LARSON_SOLVER, ERR, ERROR,)
Finalise a Rush-Larson differential-algebraic equation solver and deallocate all memory.
Definition: solver_routines.f90:4680
solver_routines::solver_mumps_library
integer(intg), parameter, public solver_mumps_library
MUMPS solver library.
Definition: solver_routines.f90:105
solver_routines::solver_quasinewtonlinesearchfinalise
subroutine solver_quasinewtonlinesearchfinalise(linesearchSolver, err, error,)
Finalise a nonlinear Quasi-Newton line search solver and deallocate all memory.
Definition: solver_routines.f90:15945
solver_routines::solver_quasi_newton_restart_set
subroutine, public solver_quasi_newton_restart_set(SOLVER, RESTART, ERR, ERROR,)
Sets/changes the restart of nonlinear Quasi-Newton solver.
Definition: solver_routines.f90:17246
solver_routines::solver_nonlinear_initialise
subroutine solver_nonlinear_initialise(SOLVER, ERR, ERROR,)
Initialise a nonlinear solver for a solver.
Definition: solver_routines.f90:20313
solver_routines::solver_dynamic_times_set
subroutine, public solver_dynamic_times_set(SOLVER, CURRENT_TIME, TIME_INCREMENT, ERR, ERROR,)
Sets/changes the dynamic times for a dynamic solver.
Definition: solver_routines.f90:6863
solver_routines::solver_dae_euler_forward_initialise
subroutine solver_dae_euler_forward_initialise(EULER_DAE_SOLVER, ERR, ERROR,)
Initialise a forward Euler solver for a differential-algebraic equation solver.
Definition: solver_routines.f90:2027
solver_routines::solver_newton_cellml_evaluator_create
subroutine, public solver_newton_cellml_evaluator_create(SOLVER, CELLML_SOLVER, ERR, ERROR,)
Create a CellML evaluator solver for the Newton solver.
Definition: solver_routines.f90:8689
solver_routines::solver_geometrictransformationnumberofloadincrementsset
subroutine, public solver_geometrictransformationnumberofloadincrementsset(solver, numberOfIncrements, err, error,)
Set the number of load increments for geometric transformation solver.
Definition: solver_routines.f90:8344
solver_routines::solver_linear_direct_lu_finalise
subroutine solver_linear_direct_lu_finalise(DIRECT_SOLVER, ERR, ERROR,)
Finalise a LU direct linear solver and deallocate all memory.
Definition: solver_routines.f90:9711
solver_routines::solver_time_stepping_monitor
subroutine, public solver_time_stepping_monitor(DAE_SOLVER, STEPS, TIME, ERR, ERROR,)
Monitors the differential-algebraic equations solve.
Definition: solver_routines.f90:6292
solver_routines::solver_dae_euler_backward_finalise
subroutine solver_dae_euler_backward_finalise(BACKWARD_EULER_SOLVER, ERR, ERROR,)
Finalise a backward Euler differential-algebraic equation and deallocate all memory.
Definition: solver_routines.f90:1876
solver_routines::solver_quasi_newton_trustregion
integer(intg), parameter, public solver_quasi_newton_trustregion
Quasi-Newton trust region nonlinear solver type.
Definition: solver_routines.f90:175
solver_routines::solver_dynamic_second_degree_liniger2_scheme
integer(intg), parameter, public solver_dynamic_second_degree_liniger2_scheme
2nd 2nd degree Liniger dynamic solver
Definition: solver_routines.f90:287
solver_routines::solver_dae_euler_solve
subroutine solver_dae_euler_solve(EULER_SOLVER, ERR, ERROR,)
Solve using an Euler differential-algebraic equation solver.
Definition: solver_routines.f90:2875
solver_routines::solver_progress_output
integer(intg), parameter, public solver_progress_output
Progress output from solver routines.
Definition: solver_routines.f90:350
solver_routines::solver_dae_euler_backward_solve
subroutine solver_dae_euler_backward_solve(BACKWARD_EULER_SOLVER, ERR, ERROR,)
Solve using a backward Euler differential-algebraic equation solver.
Definition: solver_routines.f90:1944
cmisspetsc::petsc_tssundialssettolerance
subroutine, public petsc_tssundialssettolerance(ts, absTol, relTol, err, error,)
Buffer routine to the PETSc TSSundialsSetTolerance routine.
Definition: cmiss_petsc.f90:6370
solver_routines::solver_nonlinear_newton
integer(intg), parameter, public solver_nonlinear_newton
Newton nonlinear solver type.
Definition: solver_routines.f90:164
cmisspetsc::petsc_tssundialssettype
subroutine, public petsc_tssundialssettype(ts, sundialsType, err, error,)
Buffer routine to the PETSc TSSundialsSetType routine.
Definition: cmiss_petsc.f90:6341
solver_routines::solver_dynamic_library_type_set
subroutine solver_dynamic_library_type_set(DYNAMIC_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library to use for a dynamic solver.
Definition: solver_routines.f90:5682
constants::library_spooles_type
integer(intg), parameter library_spooles_type
SPOOLES library type.
Definition: constants.f90:163
solver_routines::solverequations_matrixget
subroutine, public solverequations_matrixget(solverEquations, matrixIndex, matrix, err, error,)
Get a solver matrix from the solver equations matrices.
Definition: solver_routines.f90:7880
solver_routines::solver_iterative_biconjugate_gradient
integer(intg), parameter, public solver_iterative_biconjugate_gradient
Bi-conjugate gradient iterative solver type.
Definition: solver_routines.f90:141
solver_routines::solver_quasi_newton_trustregion_delta0_set
subroutine, public solver_quasi_newton_trustregion_delta0_set(SOLVER, TRUSTREGION_DELTA0, ERR, ERROR,)
Sets/changes the trust region delta0 for a nonlinear Quasi-Newton trust region solver solver...
Definition: solver_routines.f90:16967
types::dynamic_solver_type
Contains information for a dynamic solver.
Definition: types.f90:2489
solver_routines::solver_lineariterativemaximumiterationsset
subroutine, public solver_lineariterativemaximumiterationsset(SOLVER, MAXIMUM_ITERATIONS, ERR, ERROR,)
Sets/changes the maximum number of iterations for an iterative linear solver.
Definition: solver_routines.f90:11192
solver_routines::solver_no_output
integer(intg), parameter, public solver_no_output
No output from the solver routines.
Definition: solver_routines.f90:349
solver_routines::solver_linear_direct_create_finish
subroutine solver_linear_direct_create_finish(LINEAR_DIRECT_SOLVER, ERR, ERROR,)
Finishes the process of creating a linear direct solver.
Definition: solver_routines.f90:9341
solver_routines::solver_variables_dynamic_nonlinear_update
subroutine, public solver_variables_dynamic_nonlinear_update(SOLVER, ERR, ERROR,)
Update the field values form the dynamic factor * current solver values AND add in mean predicted dis...
Definition: solver_routines.f90:22069
solver_routines::solver_quasi_newton_linesearch_l2
integer(intg), parameter, public solver_quasi_newton_linesearch_l2
Secant line search over the L2 norm of the function.
Definition: solver_routines.f90:192
solver_routines::solver_dynamic_linear
integer(intg), parameter, public solver_dynamic_linear
Dynamic solver has linear terms.
Definition: solver_routines.f90:263
base_routines::diagnostics1
logical, save, public diagnostics1
.TRUE. if level 1 diagnostic output is active in the current routine
Definition: base_routines.f90:153
solver_routines::solver_dae_solver_type_set
subroutine, public solver_dae_solver_type_set(SOLVER, DAE_SOLVE_TYPE, ERR, ERROR,)
Sets/changes the solve type for an differential-algebraic equation solver.
Definition: solver_routines.f90:4911
distributed_matrix_vector
This module handles all distributed matrix vector routines.
Definition: distributed_matrix_vector.f90:45
solver_routines::solver_linear_direct_svd_initialise
subroutine solver_linear_direct_svd_initialise(DIRECT_SOLVER, ERR, ERROR,)
Initialise a SVD direct linear solver for a direct linear solver.
Definition: solver_routines.f90:10337
interface_conditions_constants
This module defines all constants shared across interface condition routines.
Definition: interface_conditions_constants.f90:45
solver_routines::solver_quasi_newton_solve_type_set
subroutine, public solver_quasi_newton_solve_type_set(SOLVER, QUASI_NEWTON_SOLVE_TYPE, ERR, ERROR,)
Sets/changes the solve type of nonlinear Quasi-Newton solver.
Definition: solver_routines.f90:17507
types::backward_euler_dae_solver_type
Contains information for an backward Euler differential-algebraic equation solver.
Definition: types.f90:2516
solver_routines::solver_quasi_newton_linear_solver_get
subroutine, public solver_quasi_newton_linear_solver_get(SOLVER, LINEAR_SOLVER, ERR, ERROR,)
Returns the linear solver associated with a Quasi-Newton solver.
Definition: solver_routines.f90:15313
solver_routines::solver_variablesdynamicfieldpreviousvaluesupdate
subroutine, public solver_variablesdynamicfieldpreviousvaluesupdate(SOLVER, ERR, ERROR,)
Updates the previous values from the solver solution for dynamic solvers.
Definition: solver_routines.f90:21936
boundary_conditions_routines
This module handles all boundary conditions routines.
Definition: boundary_condition_routines.f90:45
types::cellml_models_field_type
Contains information on the models field for a CellML environment.
Definition: types.f90:2285
solver_routines::solver_dynamic_hilbert_hughes_taylor2_scheme
integer(intg), parameter, public solver_dynamic_hilbert_hughes_taylor2_scheme
1st Hilbert-Hughes-Taylor dynamic solver
Definition: solver_routines.f90:299
solver_routines
This module handles all solver routines.
Definition: solver_routines.f90:45
solver_routines::solver_dynamic_bossak_newmark1_scheme
integer(intg), parameter, public solver_dynamic_bossak_newmark1_scheme
1st Bossak-Newmark dynamic solver
Definition: solver_routines.f90:296
cmiss_cellml
This module is a OpenCMISS(cm) buffer module to OpenCMISS(cellml).
Definition: cmiss_cellml.f90:45
solver_routines::solver_nonlinear_library_type_set
subroutine solver_nonlinear_library_type_set(NONLINEAR_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library to use for a nonlinear solver.
Definition: solver_routines.f90:20411
types::equations_matrix_type
Contains information about an equations matrix.
Definition: types.f90:1429
solver_routines::solver_nonlinear_bfgs_inverse
integer(intg), parameter, public solver_nonlinear_bfgs_inverse
BFGS inverse nonlinear solver type.
Definition: solver_routines.f90:165
solver_routines::solver_finalise
recursive subroutine solver_finalise(SOLVER, ERR, ERROR,)
Finalises a solver and deallocates all memory.
Definition: solver_routines.f90:8108
solver_routines::solver_eigenproblem_initialise
subroutine solver_eigenproblem_initialise(SOLVER, ERR, ERROR,)
Initialise a eigenproblem solver for a solver.
Definition: solver_routines.f90:6965
solver_routines::solver_label_get
Definition: solver_routines.f90:400
solver_routines::solver_dae_finalise
subroutine solver_dae_finalise(DAE_SOLVER, ERR, ERROR,)
Finalise a differential-algebraic equation solver and deallocate all memory.
Definition: solver_routines.f90:3052
solver_routines::solver_linked_solver_add
subroutine, public solver_linked_solver_add(SOLVER, SOLVER_TO_LINK, SOLV_TYPE, ERR, ERROR,)
Adds a linked solver to the solver. Also sets the solver type for the linked solver, als well as its linking solver.
Definition: solver_routines.f90:22925
solver_routines::solver_quasinewtonlinesearchcreatefinish
subroutine solver_quasinewtonlinesearchcreatefinish(LINESEARCH_SOLVER, ERR, ERROR,)
Finishes the process of creating nonlinear Quasi-Newton line search solver.
Definition: solver_routines.f90:15508
solver_routines::solver_dynamic_restart_set
subroutine, public solver_dynamic_restart_set(SOLVER, RESTART, ERR, ERROR,)
Sets/changes the restart value for a dynamic solver.
Definition: solver_routines.f90:6249
distributed_matrix_vector::distributed_vector_data_type_set
subroutine, public distributed_vector_data_type_set(DISTRIBUTED_VECTOR, DATA_TYPE, ERR, ERROR,)
Sets/changes the data type of a distributed vector.
Definition: distributed_matrix_vector.f90:6542
cmisspetsc::petsc_tssetproblemtype
subroutine, public petsc_tssetproblemtype(ts, probType, err, error,)
Buffer routine to the PETSc TSSetProblemType routine.
Definition: cmiss_petsc.f90:6127
solver_routines::solvers_destroy
subroutine, public solvers_destroy(SOLVERS, ERR, ERROR,)
Destroys the solvers.
Definition: solver_routines.f90:22699
solver_routines::solver_linear_solve
subroutine solver_linear_solve(LINEAR_SOLVER, ERR, ERROR,)
Solve a linear solver.
Definition: solver_routines.f90:11899
types::bdf_dae_solver_type
Contains information for a BDF differential-algebraic equation solver.
Definition: types.f90:2556
interface_matrices_constants
This module defines all constants shared across interface matrices routines.
Definition: interface_matrices_constants.f90:45
solver_routines::solver_dae_crank_nicolson_finalise
subroutine solver_dae_crank_nicolson_finalise(CRANK_NICOLSON_SOLVER, ERR, ERROR,)
Finalise a Crank-Nicolson differential-algebraic equation solver and deallocate all memory...
Definition: solver_routines.f90:3905
solver_routines::solver_quasi_newton_scale_none
integer(intg), parameter, public solver_quasi_newton_scale_none
Don&#39;t scale the problem.
Definition: solver_routines.f90:209
distributed_matrix_vector::distributed_matrix_block_storage_type
integer(intg), parameter, public distributed_matrix_block_storage_type
Distributed matrix block storage type.
Definition: distributed_matrix_vector.f90:97
solver_routines::solver_cellml_evaluator_initialise
subroutine solver_cellml_evaluator_initialise(SOLVER, ERR, ERROR,)
Initialise a CellML evaluator solver for a solver.
Definition: solver_routines.f90:1039
solver_routines::solver_dynamic_wilson_scheme
integer(intg), parameter, public solver_dynamic_wilson_scheme
Wilson dynamic solver.
Definition: solver_routines.f90:295
solver_routines::solver_newton_linesearch_nonorms
integer(intg), parameter, public solver_newton_linesearch_nonorms
No norms line search for Newton line search nonlinear solves.
Definition: solver_routines.f90:227
constants::library_lapack_type
integer(intg), parameter library_lapack_type
LAPACK library type.
Definition: constants.f90:167
solver_routines::solver_geometrictransformationclear
subroutine, public solver_geometrictransformationclear(solver, err, error,)
Clear transformation for a geometric transformation solver.
Definition: solver_routines.f90:8181
cmisspetsc::petsc_vecassemblyend
subroutine, public petsc_vecassemblyend(x, err, error,)
Buffer routine to the PETSc VecAssemblyEnd routine.
Definition: cmiss_petsc.f90:6480
solver_routines::solver_dae_runge_kutta_finalise
subroutine solver_dae_runge_kutta_finalise(RUNGE_KUTTA_SOLVER, ERR, ERROR,)
Finalise a Runge-Kutta differential-algebraic equation solver and deallocate all memory.
Definition: solver_routines.f90:4585
solver_routines::solver_label_get_vs
subroutine solver_label_get_vs(SOLVER, LABEL, ERR, ERROR,)
Returns the label of a solver.
Definition: solver_routines.f90:8881
solver_routines::cellml_equations_finalise
subroutine cellml_equations_finalise(CELLML_EQUATIONS, ERR, ERROR,)
Finalises the CellML equations and deallocates all memory.
Definition: solver_routines.f90:881
solver_routines::solver_dynamic_third_degree_gear_scheme
integer(intg), parameter, public solver_dynamic_third_degree_gear_scheme
3rd degree Gear dynamic solver
Definition: solver_routines.f90:291
solver_routines::solver_dae_euler_library_type_set
subroutine solver_dae_euler_library_type_set(EULER_DAE_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library to use for an Euler differential-algebraic equation solver...
Definition: solver_routines.f90:2789
types::cellml_ptr_type
A buffer type to allow for an array of pointers to a CELLML_TYPE.
Definition: types.f90:2393
base_routines::diagnostic_output_type
integer(intg), parameter, public diagnostic_output_type
Diagnostic output type.
Definition: base_routines.f90:67
solver_routines::solver_geometrictransformationarbitrarypathset
subroutine, public solver_geometrictransformationarbitrarypathset(solver, arbitraryPath, err, error,)
Set the arbitrary path logical for geometric transformation solver.
Definition: solver_routines.f90:8147
types::solver_mapping_type
Contains information on the solver mapping between the global equation sets and the solver matrices...
Definition: types.f90:3091
solver_routines::solver_geometrictransformationinitialise
subroutine solver_geometrictransformationinitialise(solver, err, error,)
Initialise a geometric transformation solver for a solver.
Definition: solver_routines.f90:8615
solver_routines::solver_number_of_solver_types
integer(intg), parameter, public solver_number_of_solver_types
Number of different solver types possible.
Definition: solver_routines.f90:87
solver_routines::solver_linear_direct_cholesky_initialise
subroutine solver_linear_direct_cholesky_initialise(DIRECT_SOLVER, ERR, ERROR,)
Initialise a Cholesky direct linear solver for a direct linear solver.
Definition: solver_routines.f90:9313
solver_routines::solver_eigenproblem_solve
subroutine solver_eigenproblem_solve(EIGENPROBLEM_SOLVER, ERR, ERROR,)
Solve a eigenproblem solver.
Definition: solver_routines.f90:7099
solver_routines::solver_dae_adams_moulton_solve
subroutine solver_dae_adams_moulton_solve(ADAMS_MOULTON_SOLVER, ERR, ERROR,)
Solve using an Adams-Moulton differential-algebraic equation solver.
Definition: solver_routines.f90:1820
solver_routines::solver_dynamic_scheme_set
subroutine, public solver_dynamic_scheme_set(SOLVER, SCHEME, ERR, ERROR,)
Sets/changes the scheme for a dynamic solver.
Definition: solver_routines.f90:6384
solver_routines::solver_linear_iterative_finalise
subroutine solver_linear_iterative_finalise(LINEAR_ITERATIVE_SOLVER, ERR, ERROR,)
Finalise an iterative linear solver for a linear solver and deallocate all memory.
Definition: solver_routines.f90:10860
solver_routines::solver_dae_runge_kutta_solve
subroutine solver_dae_runge_kutta_solve(RUNGE_KUTTA_SOLVER, ERR, ERROR,)
Solve using a Runge-Kutta differential-algebraic equation solver.
Definition: solver_routines.f90:4652
solver_routines::solver_dae_adams_moulton
integer(intg), parameter, public solver_dae_adams_moulton
Adams-Moulton differential-algebraic equation solver.
Definition: solver_routines.f90:320
solver_routines::solver_dae_euler_finalise
subroutine solver_dae_euler_finalise(EULER_SOLVER, ERR, ERROR,)
Finalise an Euler differential-algebraic equation solver and deallocate all memory.
Definition: solver_routines.f90:1972
solver_routines::solver_label_get_c
subroutine solver_label_get_c(SOLVER, LABEL, ERR, ERROR,)
Returns the label of a solver.
Definition: solver_routines.f90:8845
solver_routines::solver_linear_create_finish
subroutine solver_linear_create_finish(LINEAR_SOLVER, ERR, ERROR,)
Finishes the process of creating a linear solver.
Definition: solver_routines.f90:9170
solver_routines::solver_optimiser_create_finish
subroutine solver_optimiser_create_finish(OPTIMISER_SOLVER, ERR, ERROR,)
Finishes the process of creating an optimiser solver.
Definition: solver_routines.f90:20818
solver_routines::solver_dynamic_newmark1_scheme
integer(intg), parameter, public solver_dynamic_newmark1_scheme
1st Newmark dynamic solver
Definition: solver_routines.f90:288
solver_routines::solver_quasi_newton_goodbroyden
integer(intg), parameter, public solver_quasi_newton_goodbroyden
"Good" Broyden Quasi-Newton type
Definition: solver_routines.f90:183
types::solver_matrices_type
Contains information on the solver matrices and rhs vector.
Definition: types.f90:2427
solver_routines::solver_dae_solver_type_get
subroutine, public solver_dae_solver_type_get(SOLVER, DAE_SOLVE_TYPE, ERR, ERROR,)
Returns the solve type for an differential-algebraic equation solver.
Definition: solver_routines.f90:4868
types::field_variable_type
Contains information for a field variable defined on a field.
Definition: types.f90:1289
solver_routines::cellml_equations_create_finish
subroutine, public cellml_equations_create_finish(CELLML_EQUATIONS, ERR, ERROR,)
Finishes the process of creating CellML equations.
Definition: solver_routines.f90:780
solver_routines::solver_dynamic_nonlinear
integer(intg), parameter, public solver_dynamic_nonlinear
Dynamic solver has nonlinear terms.
Definition: solver_routines.f90:264
solver_routines::solver_dae_library_type_set
subroutine solver_dae_library_type_set(DAE_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library to use for a differential-algebraic equation solver.
Definition: solver_routines.f90:3224
solver_routines::solver_linked_solver_remove
subroutine, public solver_linked_solver_remove(SOLVER, SOLV_TYPE, ERR, ERROR,)
Adds a linked solver to the solver. Also sets the solver type for the linked solver, als well as its linking solver.
Definition: solver_routines.f90:23011
solver_routines::solver_label_set
Definition: solver_routines.f90:405
solver_routines::solver_linear_finalise
subroutine solver_linear_finalise(LINEAR_SOLVER, ERR, ERROR,)
Finalise a linear solver for a solver.
Definition: solver_routines.f90:10442
solver_routines::solver_quasi_newton_trustregion_solve
subroutine solver_quasi_newton_trustregion_solve(TRUSTREGION_SOLVER, ERR, ERROR,)
Definition: solver_routines.f90:17107
solver_routines::solver_newton_linesearch_quadratic
integer(intg), parameter, public solver_newton_linesearch_quadratic
Quadratic search for Newton line search nonlinear solves.
Definition: solver_routines.f90:229
solver_routines::solver_quasi_newton_restart_type_set
subroutine, public solver_quasi_newton_restart_type_set(SOLVER, QUASI_NEWTON_RESTART_TYPE, ERR, ERROR,)
Sets/changes the restart type of nonlinear Quasi-Newton solver.
Definition: solver_routines.f90:17299
solver_routines::solver_quasi_newton_solution_tolerance_set
subroutine, public solver_quasi_newton_solution_tolerance_set(SOLVER, SOLUTION_TOLERANCE, ERR, ERROR,)
Sets/changes the solution tolerance for a nonlinear Quasi-Newton solver.
Definition: solver_routines.f90:16693
cmisspetsc::petsc_vecassemblybegin
subroutine, public petsc_vecassemblybegin(x, err, error,)
Buffer routine to the PETSc VecAssemblyBegin routine.
Definition: cmiss_petsc.f90:6450
types::cellml_model_type
This type is a wrapper for the C_PTR which references the actual CellML model definition object...
Definition: types.f90:2266
solver_routines::solver_quasi_newton_badbroyden
integer(intg), parameter, public solver_quasi_newton_badbroyden
"Bad" Broyden Quasi-Newton type
Definition: solver_routines.f90:184
solver_routines::solver_newtonlinesearchmonitoroutputset
subroutine, public solver_newtonlinesearchmonitoroutputset(solver, linesearchMonitorOutputFlag, err, error,)
Enables/disables output monitoring for a nonlinear Newton line search solver.
Definition: solver_routines.f90:17653
solver_routines::solver_optimiser_matrices_library_type_get
subroutine solver_optimiser_matrices_library_type_get(OPTIMISER_SOLVER, MATRICES_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for an optimiser solver matrices.
Definition: solver_routines.f90:20980
solver_routines::solver_dae_external
integer(intg), parameter, public solver_dae_external
External (e.g., CellML generated) differential-algebraic equation solver.
Definition: solver_routines.f90:323
solver_routines::solver_newton_linesearch_linear
integer(intg), parameter, public solver_newton_linesearch_linear
Linear search for Newton line search nonlinear solves.
Definition: solver_routines.f90:228
solver_routines::solver_quasi_newton_absolute_tolerance_set
subroutine, public solver_quasi_newton_absolute_tolerance_set(SOLVER, ABSOLUTE_TOLERANCE, ERR, ERROR,)
Sets/changes the maximum absolute tolerance for a nonlinear Quasi-Newton solver.
Definition: solver_routines.f90:14853
solver_routines::solver_dynamic_third_degree_liniger2_scheme
integer(intg), parameter, public solver_dynamic_third_degree_liniger2_scheme
2nd 3rd degree Liniger dynamic solver
Definition: solver_routines.f90:293
solver_routines::solver_daecellmlpetsccontextfinalise
subroutine solver_daecellmlpetsccontextfinalise(ctx, err, error,)
Finalise a CellML PETSc solver context.
Definition: solver_routines.f90:3477
solver_routines::solver_equations_time_dependence_type_set
subroutine, public solver_equations_time_dependence_type_set(SOLVER_EQUATIONS, TIME_DEPENDENCE_TYPE, ERR, ERROR,)
Sets/changes the time dependence type for solver equations.
Definition: solver_routines.f90:7788
solver_routines::solver_variables_dynamic_field_update
subroutine, public solver_variables_dynamic_field_update(SOLVER, ERR, ERROR,)
Updates the dependent variables from the solver solution for dynamic solvers.
Definition: solver_routines.f90:21447
solver_routines::solver_direct_cholesky
integer(intg), parameter, public solver_direct_cholesky
Cholesky direct linear solver.
Definition: solver_routines.f90:130
solver_routines::solver_cmiss_library
integer(intg), parameter, public solver_cmiss_library
CMISS (internal) solver library.
Definition: solver_routines.f90:103
solver_routines::solver_nonlinear_solve
subroutine solver_nonlinear_solve(NONLINEAR_SOLVER, ERR, ERROR,)
Definition: solver_routines.f90:20645
solver_routines::solver_linear_matrices_library_type_get
subroutine solver_linear_matrices_library_type_get(LINEAR_SOLVER, MATRICES_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for a linear solver matrices.
Definition: solver_routines.f90:11848
solver_routines::solver_cellml_evaluator_create_finish
subroutine solver_cellml_evaluator_create_finish(CELLML_EVALUATOR_SOLVER, ERR, ERROR,)
Finishes the process of creating a CellML evaluator solver.
Definition: solver_routines.f90:985
types::dae_solver_type
Contains information for an differential-algebraic equation solver.
Definition: types.f90:2573
equations_set_constants
This module defines all constants shared across equations set routines.
Definition: equations_set_constants.f90:45
solver_routines::solver_eigenproblem_type
integer(intg), parameter, public solver_eigenproblem_type
A eigenproblem solver.
Definition: solver_routines.f90:92
solver_routines::solver_linear_library_type_get
subroutine solver_linear_library_type_get(LINEAR_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for a linear solver.
Definition: solver_routines.f90:11746
solver_routines::solver_nonlinear_sqp
integer(intg), parameter, public solver_nonlinear_sqp
Sequential Quadratic Program nonlinear solver type.
Definition: solver_routines.f90:166
solver_routines::solver_linear_direct_svd_finalise
subroutine solver_linear_direct_svd_finalise(LINEAR_DIRECT_SOLVER, ERR, ERROR,)
Finalise a SVD direct linear solver and deallocate all memory.
Definition: solver_routines.f90:10311
solver_routines::solver_solver_equations_get
subroutine, public solver_solver_equations_get(SOLVER, SOLVER_EQUATIONS, ERR, ERROR,)
Returns a pointer to the solver equations for a solver.
Definition: solver_routines.f90:21230
solver_routines::solver_iterative_richardson
integer(intg), parameter, public solver_iterative_richardson
Richardson iterative solver type.
Definition: solver_routines.f90:138
distributed_matrix_vector::distributed_matrix_vector_dp_type
integer(intg), parameter, public distributed_matrix_vector_dp_type
Double precision real distributed matrix-vector data type.
Definition: distributed_matrix_vector.f90:90
solver_routines::solver_linear_iterative_type_set
subroutine, public solver_linear_iterative_type_set(SOLVER, ITERATIVE_SOLVER_TYPE, ERR, ERROR,)
Sets/changes the type of iterative linear solver.
Definition: solver_routines.f90:11666
solver_routines::solver_matrix_output
integer(intg), parameter, public solver_matrix_output
Solver matrices output from the solver routines plus below.
Definition: solver_routines.f90:353
constants::library_superlu_type
integer(intg), parameter library_superlu_type
SuperLU library type.
Definition: constants.f90:162
solver_routines::solver_linear_direct_lu_initialise
subroutine solver_linear_direct_lu_initialise(DIRECT_SOLVER, ERR, ERROR,)
Initialise a LU direct linear solver for a direct linear solver.
Definition: solver_routines.f90:9770
solver_routines::solver_umfpack_library
integer(intg), parameter, public solver_umfpack_library
UMFPACK solver library.
Definition: solver_routines.f90:108
solver_routines::solver_matrices_static_assemble
subroutine, public solver_matrices_static_assemble(SOLVER, SELECTION_TYPE, ERR, ERROR,)
Assembles the solver matrices and rhs from the static equations.
Definition: solver_routines.f90:13748
solver_routines::solver_dynamic_galerkin_scheme
integer(intg), parameter, public solver_dynamic_galerkin_scheme
Galerkin dynamic solver.
Definition: solver_routines.f90:283
solver_routines::solver_quasi_newton_initialise
subroutine solver_quasi_newton_initialise(NONLINEAR_SOLVER, ERR, ERROR,)
Initialise a Quasi-Newton solver for a nonlinear solver.
Definition: solver_routines.f90:15046
solver_routines::solver_newton_linesearch_alpha_set
subroutine, public solver_newton_linesearch_alpha_set(SOLVER, LINESEARCH_ALPHA, ERR, ERROR,)
Sets/changes the line search alpha for a Newton linesearch solver.
Definition: solver_routines.f90:18239
solver_routines::solver_quasinewtontrustregiontoleranceset
subroutine, public solver_quasinewtontrustregiontoleranceset(SOLVER, TRUSTREGION_TOLERANCE, ERR, ERROR,)
Sets/changes the trust region tolerance for a nonlinear Quasi-Newton trust region solver...
Definition: solver_routines.f90:17175
solver_routines::solverequations_boundaryconditionscreatefinish
subroutine, public solverequations_boundaryconditionscreatefinish(SOLVER_EQUATIONS, ERR, ERROR,)
Finishes the creation of boundary conditions for the given solver equations.
Definition: solver_routines.f90:7630
solver_routines::solver_dynamic_first_degree
integer(intg), parameter, public solver_dynamic_first_degree
Dynamic solver uses a first degree polynomial for time interpolation.
Definition: solver_routines.f90:271
solver_routines::solver_linear_iterative_solve
subroutine solver_linear_iterative_solve(LINEAR_ITERATIVE_SOLVER, ERR, ERROR,)
Solves a linear iterative linear solver.
Definition: solver_routines.f90:11450
solver_routines::solver_dae_solve
subroutine solver_dae_solve(DAE_SOLVER, ERR, ERROR,)
Solve a differential-algebraic equation solver.
Definition: solver_routines.f90:4775
solver_routines::solverequations_jacobianmatrixget
subroutine, public solverequations_jacobianmatrixget(solverEquations, matrix, err, error,)
Get the Jacobian matrix from the solver equations matrices for nonlinear solver equations.
Definition: solver_routines.f90:7933
solver_routines::solver_state_iteration_type
integer(intg), parameter solver_state_iteration_type
An state iteration solver.
Definition: solver_routines.f90:95
solver_routines::solver_quasi_newton_trustregion_initialise
subroutine solver_quasi_newton_trustregion_initialise(QUASI_NEWTON_SOLVER, ERR, ERROR,)
Initialise a Quaso-Newton trust region solver for a nonlinear solver.
Definition: solver_routines.f90:17065
solver_routines::solver_newton_jacobian_fd_calculated
integer(intg), parameter, public solver_newton_jacobian_fd_calculated
The Jacobian values will be calculated using finite differences for the nonlinear equations set...
Definition: solver_routines.f90:239
solver_routines::solver_newton_type_set
subroutine, public solver_newton_type_set(SOLVER, NEWTON_SOLVE_TYPE, ERR, ERROR,)
Sets/changes the type of nonlinear Newton solver.
Definition: solver_routines.f90:20032
solver_routines::solverequations_boundaryconditionscreatestart
subroutine, public solverequations_boundaryconditionscreatestart(SOLVER_EQUATIONS, BOUNDARY_CONDITIONS, ERR, ERROR,)
Starts the creation of boundary conditions for the given solver equations, and returns a pointer to t...
Definition: solver_routines.f90:7696
cmisspetsc::petsc_veccreateseq
subroutine, public petsc_veccreateseq(communicator, n, x, err, error,)
Buffer routine to the PETSc VecCreateSeq routine.
Definition: cmiss_petsc.f90:6710
solver_routines::solver_newton_trustregion_finalise
subroutine solver_newton_trustregion_finalise(TRUSTREGION_SOLVER, ERR, ERROR,)
Finalise a nonlinear Newton trust region solver and deallocate all memory.
Definition: solver_routines.f90:19824
solver_routines::solver_solver_output
integer(intg), parameter, public solver_solver_output
Solver specific output from the solver routines plus below.
Definition: solver_routines.f90:352
solver_routines::solver_newton_maximum_iterations_set
subroutine, public solver_newton_maximum_iterations_set(SOLVER, MAXIMUM_ITERATIONS, ERR, ERROR,)
Sets/changes the maximum number of iterations for a nonlinear Newton solver.
Definition: solver_routines.f90:19292
solver_routines::solver_dynamic_newmark2_scheme
integer(intg), parameter, public solver_dynamic_newmark2_scheme
2nd Newmark dynamic solver
Definition: solver_routines.f90:289
solver_routines::solver_quasi_newton_scale_type_set
subroutine, public solver_quasi_newton_scale_type_set(SOLVER, QUASI_NEWTON_SCALE_TYPE, ERR, ERROR,)
Sets/changes the scale type of nonlinear Quasi-Newton solver.
Definition: solver_routines.f90:17368
solver_routines::solver_dynamic_hilbert_hughes_taylor1_scheme
integer(intg), parameter, public solver_dynamic_hilbert_hughes_taylor1_scheme
1st Hilbert-Hughes-Taylor dynamic solver
Definition: solver_routines.f90:298
solver_routines::solver_equations_interface_condition_add
subroutine, public solver_equations_interface_condition_add(SOLVER_EQUATIONS, INTERFACE_CONDITION, INTERFACE_CONDITION_INDEX, ERR, ERROR,)
Adds an interface condition to the solver equations.
Definition: solver_routines.f90:7516
solver_routines::solver_dae_times_set
subroutine, public solver_dae_times_set(SOLVER, START_TIME, END_TIME, ERR, ERROR,)
Set/change the times for a differential-algebraic equation solver.
Definition: solver_routines.f90:4999
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
solver_routines::solver_quasi_newton_maximum_iterations_set
subroutine, public solver_quasi_newton_maximum_iterations_set(SOLVER, MAXIMUM_ITERATIONS, ERR, ERROR,)
Sets/changes the maximum number of iterations for a nonlinear Quasi-Newton solver.
Definition: solver_routines.f90:16508
solver_routines::solver_linear_type
integer(intg), parameter, public solver_linear_type
A linear solver.
Definition: solver_routines.f90:88
constants::library_pastix_type
integer(intg), parameter library_pastix_type
PaStiX library type.
Definition: constants.f90:170
solver_routines::solver_dae_initialise
subroutine solver_dae_initialise(SOLVER, ERR, ERROR,)
Initialise a differential-algebraic equation solver for a solver.
Definition: solver_routines.f90:3085
solver_routines::solver_quasinewtontrustregioncreatefinish
subroutine solver_quasinewtontrustregioncreatefinish(TRUSTREGION_SOLVER, ERR, ERROR,)
Finishes the process of creating nonlinear Quasi-Newton trust region solver.
Definition: solver_routines.f90:16791
solver_routines::solver_newton_convergence_energy_norm
integer(intg), parameter, public solver_newton_convergence_energy_norm
Energy norm convergence test.
Definition: solver_routines.f90:247
solver_routines::solver_cellml_evaluator_time_set
subroutine solver_cellml_evaluator_time_set(CELLML_EVALUATOR_SOLVER, TIME, ERR, ERROR,)
Sets/changes the time for a CellML evaluator solver.
Definition: solver_routines.f90:1173
cmisspetsc::petsc_tssettype
subroutine, public petsc_tssettype(ts, method, err, error,)
Buffer routine to the PETSc TSSetType routine.
Definition: cmiss_petsc.f90:6249
solver_routines::solver_cellml_evaluator_library_type_get
subroutine solver_cellml_evaluator_library_type_get(CELLML_EVALUATOR_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Returns the type of library to use for a CellML evaluator solver.
Definition: solver_routines.f90:1078
solver_routines::solver_linear_library_type_set
subroutine solver_linear_library_type_set(LINEAR_SOLVER, SOLVER_LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the type of library to use for a linear solver.
Definition: solver_routines.f90:11797
constants::zero_tolerance
real(dp), parameter zero_tolerance
Definition: constants.f90:70
solver_routines::solver_eigenproblem_finalise
subroutine solver_eigenproblem_finalise(EIGENPROBLEM_SOLVER, ERR, ERROR,)
Finalise a eigenproblem solver for a solver.
Definition: solver_routines.f90:6939
solver_routines::solver_quasi_newton_restart_periodic
integer(intg), parameter, public solver_quasi_newton_restart_periodic
Restart after a fixed number of iterations.
Definition: solver_routines.f90:202
solver_routines::solver_cellml_evaluate
subroutine solver_cellml_evaluate(CELLML_EVALUATOR_SOLVER, CELLML, N, ONLY_ONE_MODEL_INDEX, MODELS_DATA, MAX_NUMBER_STATES, STATE_DATA, MAX_NUMBER_PARAMETERS, PARAMETERS_DATA, MAX_NUMBER_INTERMEDIATES, INTERMEDIATE_DATA, ERR, ERROR,)
Evaluate the CellML equations.
Definition: solver_routines.f90:1343
solver_routines::solver_solve
recursive subroutine, public solver_solve(SOLVER, ERR, ERROR,)
Solve the problem.
Definition: solver_routines.f90:21269
distributed_matrix_vector::distributed_matrix_diagonal_storage_type
integer(intg), parameter, public distributed_matrix_diagonal_storage_type
Distributed matrix diagonal storage type.
Definition: distributed_matrix_vector.f90:98
types::rush_larson_dae_solver_type
Contains information for a Rush-Larson differential-algebraic equation solver.
Definition: types.f90:2562
types::cellml_type
Contains information for a CellML environment.
Definition: types.f90:2372
constants::library_tao_type
integer(intg), parameter library_tao_type
TAO library type.
Definition: constants.f90:168
types::equations_mapping_linear_type
Contains information for mapping field variables to the linear matrices in the equations set of the m...
Definition: types.f90:1587
solver_matrices_routines::solver_matrices_library_type_set
subroutine, public solver_matrices_library_type_set(SOLVER_MATRICES, LIBRARY_TYPE, ERR, ERROR,)
Sets the library type for the solver matrices (and vectors)
Definition: solver_matrices_routines.f90:449
solver_routines::solver_lapack_library
integer(intg), parameter, public solver_lapack_library
LAPACK solver library.
Definition: solver_routines.f90:111
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
solver_routines::solver_dynamic_ale_set
subroutine, public solver_dynamic_ale_set(SOLVER, ALE, ERR, ERROR,)
Sets/changes the ALE flag for a dynamic solver.
Definition: solver_routines.f90:6775
distributed_matrix_vector::distributed_matrix_compressed_row_storage_type
integer(intg), parameter, public distributed_matrix_compressed_row_storage_type
Distributed matrix compressed row storage type.
Definition: distributed_matrix_vector.f90:101
solver_routines::solver_quasi_newton_linesearch_solve
subroutine solver_quasi_newton_linesearch_solve(LINESEARCH_SOLVER, ERR, ERROR,)
Definition: solver_routines.f90:16096
solver_routines::solver_dae_crank_nicolson
integer(intg), parameter, public solver_dae_crank_nicolson
Crank-Nicolson differential-algebraic equation solver.
Definition: solver_routines.f90:318
solver_routines::solver_dynamic_second_degree
integer(intg), parameter, public solver_dynamic_second_degree
Dynamic solver uses a second degree polynomial for time interpolation.
Definition: solver_routines.f90:272
solver_routines::solver_dae_create_finish
subroutine solver_dae_create_finish(DAE_SOLVER, ERR, ERROR,)
Finishes the process of creating a differential-algebraic equation solver.
Definition: solver_routines.f90:1848
types::equations_matrices_dynamic_type
Contains information of the dynamic matrices for equations matrices.
Definition: types.f90:1471
solver_routines::solver_optimiser_type
integer(intg), parameter, public solver_optimiser_type
An optimiser solver.
Definition: solver_routines.f90:93
solver_routines::solver_newton_absolute_tolerance_set
subroutine, public solver_newton_absolute_tolerance_set(SOLVER, ABSOLUTE_TOLERANCE, ERR, ERROR,)
Sets/changes the maximum absolute tolerance for a nonlinear Newton solver.
Definition: solver_routines.f90:17593
solver_routines::solver_quasi_newton_linesearch_steptol_set
subroutine, public solver_quasi_newton_linesearch_steptol_set(SOLVER, LINESEARCH_STEPTOL, ERR, ERROR,)
Sets/changes the line search step tolerance for a nonlinear Quasi-Newton line search solver...
Definition: solver_routines.f90:16249
solver_routines::solver_dae_runge_kutta
integer(intg), parameter, public solver_dae_runge_kutta
Runge-Kutta differential-algebraic equation solver.
Definition: solver_routines.f90:319
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45