OpenCMISS-Iron Internal API Documentation
problem_routines.f90
Go to the documentation of this file.
1 
43 
45 MODULE problem_routines
46 
47  USE base_routines
48  USE bioelectric_routines
49  USE classical_field_routines
50  USE control_loop_routines
51  USE distributed_matrix_vector
52  USE elasticity_routines
53  USE equations_set_constants
54  USE equations_set_routines
55  USE field_routines
56  USE field_io_routines
57  USE finite_elasticity_routines
58  USE fitting_routines
59  USE fluid_mechanics_routines
60  USE input_output
61  USE interface_conditions_constants
62  USE interface_conditions_routines
63  USE interface_routines
64  USE iso_varying_string
65  USE kinds
66  USE multi_physics_routines
67  USE problem_constants
68  USE reaction_diffusion_equation_routines
69  USE solver_routines
70  USE solver_matrices_routines
71  USE strings
72  USE timer
73  USE types
74 
75 #include "macros.h"
76 
77  IMPLICIT NONE
78 
79  PRIVATE
80 
81  !Module parameters
82 
83  !Module types
84 
85  !Module variables
86 
87  TYPE(problems_type), TARGET :: problems
88 
89  !Interfaces
90 
91  INTERFACE problem_cellml_equations_get
92  MODULE PROCEDURE problem_cellml_equations_get_0
93  MODULE PROCEDURE problem_cellml_equations_get_1
94  END INTERFACE !PROBLEM_CELLML_EQUATIONS_GET
95 
96  INTERFACE problem_control_loop_get
97  MODULE PROCEDURE problem_control_loop_get_0
98  MODULE PROCEDURE problem_control_loop_get_1
99  END INTERFACE !PROBLEM_CONTROL_LOOP_GET
100 
101  INTERFACE problem_solver_equations_get
102  MODULE PROCEDURE problem_solver_equations_get_0
103  MODULE PROCEDURE problem_solver_equations_get_1
104  END INTERFACE !PROBLEM_SOLVER_EQUATIONS_GET
105 
106  INTERFACE problem_solver_get
107  MODULE PROCEDURE problem_solver_get_0
108  MODULE PROCEDURE problem_solver_get_1
109  END INTERFACE !PROBLEM_SOLVER_GET
110 
111  PUBLIC problems_initialise,problems_finalise
112 
113  PUBLIC problem_cellml_equations_create_start,problem_cellml_equations_create_finish
114 
115  PUBLIC problem_cellml_equations_get
116 
117  PUBLIC problem_create_start,problem_create_finish,problem_destroy
118 
119  PUBLIC problem_specificationget,problem_specificationsizeget
120 
121  PUBLIC problem_control_loop_create_start,problem_control_loop_create_finish
122 
123  PUBLIC problem_control_loop_destroy
124 
125  PUBLIC problem_control_loop_get
126 
127  PUBLIC problem_solverdaecellmlrhsevaluate
128 
129  PUBLIC problem_solverequationsboundaryconditionsanalytic
130 
131  PUBLIC problem_solver_equations_create_start,problem_solver_equations_create_finish
132 
133  PUBLIC problem_solver_equations_destroy
134 
135  PUBLIC problem_solver_equations_get
136 
137  PUBLIC problem_solver_jacobian_evaluate,problem_solver_residual_evaluate
138 
139  PUBLIC problem_solver_get
140 
141  PUBLIC problem_solvernonlinearmonitor
142 
143  PUBLIC problem_solve
144 
145  PUBLIC problem_solvers_create_start,problem_solvers_create_finish
146 
147  PUBLIC problem_solvers_destroy
148 
149  PUBLIC problem_user_number_find
150 
151 CONTAINS
152 
153  !
154  !================================================================================================================================
155  !
156 
158  SUBROUTINE problem_cellml_equations_create_finish(PROBLEM,ERR,ERROR,*)
159 
160  !Argument variables
161  TYPE(problem_type), POINTER :: problem
162  INTEGER(INTG), INTENT(OUT) :: err
163  TYPE(varying_string), INTENT(OUT) :: error
164  !Local Variables
165  TYPE(problem_setup_type) :: problem_setup_info
166 
167  enters("PROBLEM_CELLML_EQUATIONS_CREATE_FINISH",err,error,*999)
168 
169  IF(ASSOCIATED(problem)) THEN
170  !Initialise the problem setup information
171  CALL problem_setup_initialise(problem_setup_info,err,error,*999)
172  problem_setup_info%SETUP_TYPE=problem_setup_cellml_equations_type
173  problem_setup_info%ACTION_TYPE=problem_setup_finish_action
174  !Finish problem specific startup
175  CALL problem_setup(problem,problem_setup_info,err,error,*999)
176  !Finalise the problem setup information
177  CALL problem_setup_finalise(problem_setup_info,err,error,*999)
178  ELSE
179  CALL flagerror("Problem is not associated.",err,error,*999)
180  ENDIF
181 
182  exits("PROBLEM_CELLML_EQUATIONS_CREATE_FINISH")
183  RETURN
184 999 errorsexits("PROBLEM_CELLML_EQUATIONS_CREATE_FINISH",err,error)
185  RETURN 1
186  END SUBROUTINE problem_cellml_equations_create_finish
187 
188  !
189  !================================================================================================================================
190  !
191 
193  SUBROUTINE problem_cellml_equations_create_start(PROBLEM,ERR,ERROR,*)
194 
195  !Argument variablesg
196  TYPE(problem_type), POINTER :: problem
197  INTEGER(INTG), INTENT(OUT) :: err
198  TYPE(varying_string), INTENT(OUT) :: error
199  !Local Variables
200  TYPE(problem_setup_type) :: problem_setup_info
201 
202  enters("PROBLEM_CELLML_EQUATIONS_CREATE_START",err,error,*999)
203 
204  IF(ASSOCIATED(problem)) THEN
205  !Initialise the problem setup information
206  CALL problem_setup_initialise(problem_setup_info,err,error,*999)
207  problem_setup_info%SETUP_TYPE=problem_setup_cellml_equations_type
208  problem_setup_info%ACTION_TYPE=problem_setup_start_action
209  !Start the problem specific control setup
210  CALL problem_setup(problem,problem_setup_info,err,error,*999)
211  !Finalise the problem setup information
212  CALL problem_setup_finalise(problem_setup_info,err,error,*999)
213  ELSE
214  CALL flagerror("Problem is not associated.",err,error,*999)
215  ENDIF
216 
217  exits("PROBLEM_CELLML_EQUATIONS_CREATE_START")
218  RETURN
219 999 errorsexits("PROBLEM_CELLML_EQUATIONS_CREATE_START",err,error)
220  RETURN 1
221  END SUBROUTINE problem_cellml_equations_create_start
222 
223  !
224  !================================================================================================================================
225  !
226 
228  SUBROUTINE problem_cellml_equations_get_0(PROBLEM,CONTROL_LOOP_IDENTIFIER,SOLVER_INDEX,CELLML_EQUATIONS,ERR,ERROR,*)
229 
230  !Argument variables
231  TYPE(problem_type), POINTER :: problem
232  INTEGER(INTG), INTENT(IN) :: control_loop_identifier
233  INTEGER(INTG), INTENT(IN) :: solver_index
234  TYPE(cellml_equations_type), POINTER :: cellml_equations
235  INTEGER(INTG), INTENT(OUT) :: err
236  TYPE(varying_string), INTENT(OUT) :: error
237  !Local Variables
238 
239  enters("PROBLEM_CELLML_EQUATIONS_GET_0",err,error,*999)
240 
241  CALL problem_cellml_equations_get_1(problem,[control_loop_identifier],solver_index,cellml_equations,err,error,*999)
242 
243  exits("PROBLEM_CELLML_EQUATIONS_GET_0")
244  RETURN
245 999 errorsexits("PROBLEM_CELLML_EQUATIONS_GET_0",err,error)
246  RETURN 1
247  END SUBROUTINE problem_cellml_equations_get_0
248 
249  !
250  !================================================================================================================================
251  !
252 
254  SUBROUTINE problem_cellml_equations_get_1(PROBLEM,CONTROL_LOOP_IDENTIFIER,SOLVER_INDEX,CELLML_EQUATIONS,ERR,ERROR,*)
255 
256  !Argument variables
257  TYPE(problem_type), POINTER :: problem
258  INTEGER(INTG), INTENT(IN) :: control_loop_identifier(:)
259  INTEGER(INTG), INTENT(IN) :: solver_index
260  TYPE(cellml_equations_type), POINTER :: cellml_equations
261  INTEGER(INTG), INTENT(OUT) :: err
262  TYPE(varying_string), INTENT(OUT) :: error
263  !Local Variables
264  TYPE(control_loop_type), POINTER :: control_loop,control_loop_root
265  TYPE(solver_type), POINTER :: solver
266  TYPE(solvers_type), POINTER :: solvers
267  TYPE(varying_string) :: local_error
268 
269  enters("PROBLEM_CELLML_EQUATIONS_GET_1",err,error,*999)
270 
271  IF(ASSOCIATED(problem)) THEN
272  IF(ASSOCIATED(cellml_equations)) THEN
273  CALL flagerror("The CellML equations is already associated.",err,error,*999)
274  ELSE
275  NULLIFY(cellml_equations)
276  control_loop_root=>problem%CONTROL_LOOP
277  IF(ASSOCIATED(control_loop_root)) THEN
278  NULLIFY(control_loop)
279  CALL control_loop_get(control_loop_root,control_loop_identifier,control_loop,err,error,*999)
280  solvers=>control_loop%SOLVERS
281  IF(ASSOCIATED(solvers)) THEN
282  IF(solver_index>0.AND.solver_index<=solvers%NUMBER_OF_SOLVERS) THEN
283  solver=>solvers%SOLVERS(solver_index)%PTR
284  IF(ASSOCIATED(solver)) THEN
285  cellml_equations=>solver%CELLML_EQUATIONS
286  IF(.NOT.ASSOCIATED(cellml_equations)) CALL flagerror("CellML equations is not associated.",err,error,*999)
287  ELSE
288  CALL flagerror("Solver is not associated.",err,error,*999)
289  ENDIF
290  ELSE
291  local_error="The specified solver index of "//trim(number_to_vstring(solver_index,"*",err,error))// &
292  & " is invalid. The index must be > 0 and <= "// &
293  & trim(number_to_vstring(solvers%NUMBER_OF_SOLVERS,"*",err,error))//"."
294  CALL flagerror(local_error,err,error,*999)
295  ENDIF
296  ELSE
297  CALL flagerror("Solvers is not associated.",err,error,*999)
298  ENDIF
299  ELSE
300  CALL flagerror("Problem control loop is not associated.",err,error,*999)
301  ENDIF
302  ENDIF
303  ELSE
304  CALL flagerror("Problem is not associated.",err,error,*999)
305  ENDIF
306 
307  exits("PROBLEM_CELLML_EQUATIONS_GET_1")
308  RETURN
309 999 errorsexits("PROBLEM_CELLML_EQUATIONS_GET_1",err,error)
310  RETURN 1
311  END SUBROUTINE problem_cellml_equations_get_1
312 
313  !
314  !================================================================================================================================
315  !
316 
318  SUBROUTINE problem_cellml_equations_solve(CELLML_EQUATIONS,ERR,ERROR,*)
319 
320  !Argument variables
321  TYPE(cellml_equations_type), POINTER :: cellml_equations
322  INTEGER(INTG), INTENT(OUT) :: err
323  TYPE(varying_string), INTENT(OUT) :: error
324  !Local Variables
325  TYPE(solver_type), POINTER :: solver
326 
327  enters("PROBLEM_CELLML_EQUATIONS_SOLVE",err,error,*999)
328 
329  IF(ASSOCIATED(cellml_equations)) THEN
330  IF(cellml_equations%CELLML_EQUATIONS_FINISHED) THEN
331  solver=>cellml_equations%SOLVER
332  IF(ASSOCIATED(solver)) THEN
333 
334  CALL solver_solve(solver,err,error,*999)
335 
336  ELSE
337  CALL flagerror("CellML equations solver is not associated.",err,error,*999)
338  ENDIF
339  ELSE
340  CALL flagerror("CellML equations have not been finished.",err,error,*999)
341  ENDIF
342  ELSE
343  CALL flagerror("CellML equations is not associated.",err,error,*999)
344  ENDIF
345 
346  exits("PROBLEM_CELLML_EQUATIONS_SOLVE")
347  RETURN
348 999 errorsexits("PROBLEM_CELLML_EQUATIONS_SOLVE",err,error)
349  RETURN 1
350 
351  END SUBROUTINE problem_cellml_equations_solve
352 
353  !
354  !================================================================================================================================
355  !
356 
358  SUBROUTINE problem_solverdaecellmlrhsevaluate(cellML,time,dofIdx,stateData,rateData,err,error,*)
359 
360  !Argument variables
361  TYPE(cellml_type), POINTER :: cellml
362  REAL(DP), INTENT(IN) :: time
363  INTEGER(INTG), INTENT(IN) :: dofidx
364  REAL(DP), POINTER :: statedata(:)
365  REAL(DP), POINTER :: ratedata(:)
366  INTEGER(INTG), INTENT(OUT) :: err
367  TYPE(varying_string), INTENT(OUT) :: error
368  !Local Variables
369  INTEGER(INTG) :: dofordertype,intermediatedataoffset,maxnumberofintermediates,maxnumberofparameters,maxnumberofstates, &
370  modelidx,parameterdataoffset
371  INTEGER(INTG), POINTER :: modelsdata(:)
372  REAL(DP), POINTER :: intermediatedata(:),parameterdata(:)
373  TYPE(cellml_model_type), POINTER :: model
374  TYPE(field_type), POINTER :: intermediatefield,modelsfield,parametersfield
375  TYPE(field_variable_type), POINTER :: modelsvariable
376 
377  enters("Problem_SolverDAECellMLRHSEvaluate",err,error,*999)
378 
379  IF(ASSOCIATED(cellml)) THEN
380  maxnumberofstates=cellml%MAXIMUM_NUMBER_OF_STATE
381  maxnumberofintermediates=cellml%MAXIMUM_NUMBER_OF_INTERMEDIATE
382  maxnumberofparameters=cellml%MAXIMUM_NUMBER_OF_PARAMETERS
383  !Make sure CellML fields have been updated to the current value of any mapped fields
384  IF(ASSOCIATED(cellml%MODELS_FIELD)) THEN
385  modelsfield=>cellml%MODELS_FIELD%MODELS_FIELD
386  IF(ASSOCIATED(modelsfield)) THEN
387  NULLIFY(modelsvariable)
388  CALL field_variableget(modelsfield,field_u_variable_type,modelsvariable,err,error,*999)
389  CALL field_dofordertypeget(modelsfield,field_u_variable_type,dofordertype,err,error,*999)
390  CALL field_parametersetdataget(modelsfield,field_u_variable_type,field_values_set_type,modelsdata,err,error,*999)
391  modelidx=modelsdata(dofidx)
392  model=>cellml%models(modelidx)%ptr
393  IF(ASSOCIATED(model)) THEN
394  IF(dofordertype==field_separated_component_dof_order) THEN
395  parameterdataoffset=modelsvariable%TOTAL_NUMBER_OF_DOFS
396  intermediatedataoffset=modelsvariable%TOTAL_NUMBER_OF_DOFS
397  ELSE
398  parameterdataoffset=maxnumberofparameters
399  intermediatedataoffset=maxnumberofintermediates
400  ENDIF
401  NULLIFY(parameterdata)
402  !Get the parameters information if this environment has any.
403  IF(ASSOCIATED(cellml%PARAMETERS_FIELD)) THEN
404  parametersfield=>cellml%PARAMETERS_FIELD%PARAMETERS_FIELD
405  IF(ASSOCIATED(parametersfield)) THEN
406  CALL field_parametersetdataget(parametersfield,field_u_variable_type,field_values_set_type,parameterdata, &
407  & err,error,*999)
408  ENDIF
409  ENDIF
410  !Get the intermediate information if this environment has any.
411  NULLIFY(intermediatedata)
412  IF(ASSOCIATED(cellml%INTERMEDIATE_FIELD)) THEN
413  intermediatefield=>cellml%INTERMEDIATE_FIELD%INTERMEDIATE_FIELD
414  IF(ASSOCIATED(intermediatefield)) THEN
415  CALL field_parametersetdataget(intermediatefield,field_u_variable_type,field_values_set_type,intermediatedata, &
416  & err,error,*999)
417  ENDIF
418  ENDif!associated intermediate
419 
420  !Evaluate the CellML RHS
421  CALL solver_daecellmlrhsevaluate(model,time,1,1,statedata,dofidx,parameterdataoffset,parameterdata,dofidx, &
422  intermediatedataoffset,intermediatedata,1,1,ratedata,err,error,*999)
423 
424  ELSE
425  CALL flagerror("Model is not associated.",err,error,*999)
426  ENDIF
427  ELSE
428  CALL flagerror("Models field not associated.",err,error,*999)
429  ENDIF
430  ELSE
431  CALL flagerror("CellML models field is not associated.",err,error,*999)
432  ENDIF
433  ELSE
434  CALL flagerror("CellML is not associated.",err,error,*999)
435  ENDIF
436 
437  exits("Problem_SolverDAECellMLRHSEvaluate")
438  RETURN
439 999 errorsexits("Problem_SolverDAECellMLRHSEvaluate",err,error)
440  RETURN 1
441 
442  END SUBROUTINE problem_solverdaecellmlrhsevaluate
443 
444  !
445  !================================================================================================================================
446  !
447 
449  RECURSIVE SUBROUTINE problem_control_loop_solve(CONTROL_LOOP,ERR,ERROR,*)
450 
451  !Argument variables
452  TYPE(control_loop_type), POINTER :: control_loop
453  INTEGER(INTG), INTENT(OUT) :: err
454  TYPE(varying_string), INTENT(OUT) :: error
455  !Local Variables
456  INTEGER(INTG) :: iteration_idx,loop_idx,solver_idx
457  TYPE(control_loop_type), POINTER :: control_loop2
458  TYPE(control_loop_fixed_type), POINTER :: fixed_loop
459  TYPE(control_loop_simple_type), POINTER :: simple_loop
460  TYPE(control_loop_time_type), POINTER :: time_loop
461  TYPE(control_loop_while_type), POINTER :: while_loop
462  TYPE(control_loop_load_increment_type), POINTER :: load_increment_loop
463  TYPE(solver_type), POINTER :: solver
464  TYPE(solvers_type), POINTER :: solvers
465  TYPE(varying_string) :: local_error
466 
467  enters("PROBLEM_CONTROL_LOOP_SOLVE",err,error,*999)
468 
469  IF(ASSOCIATED(control_loop)) THEN
470  IF(control_loop%CONTROL_LOOP_FINISHED) THEN
471  !Solve this control loop
472  IF(control_loop%OUTPUT_TYPE>=control_loop_progress_output) THEN
473  CALL write_string(general_output_type,"",err,error,*999)
474  CALL write_string_value(general_output_type,"Control loop: ",control_loop%LABEL,err,error,*999)
475  CALL write_string_value(general_output_type," Control loop level = ",control_loop%CONTROL_LOOP_LEVEL,err,error,*999)
476  CALL write_string_value(general_output_type," Sub loop index = ",control_loop%SUB_LOOP_INDEX,err,error,*999)
477  ENDIF
478  SELECT CASE(control_loop%LOOP_TYPE)
479  CASE(problem_control_simple_type)
480  simple_loop=>control_loop%SIMPLE_LOOP
481  IF(ASSOCIATED(simple_loop)) THEN
482  IF(control_loop%OUTPUT_TYPE>=control_loop_progress_output) THEN
483  CALL write_string(general_output_type,"",err,error,*999)
484  CALL write_string(general_output_type,"Simple control loop: ",err,error,*999)
485  ENDIF
486  CALL problem_control_loop_pre_loop(control_loop,err,error,*999)
487  IF(control_loop%NUMBER_OF_SUB_LOOPS==0) THEN
488  !If there are no sub loops then solve.
489  solvers=>control_loop%SOLVERS
490  IF(ASSOCIATED(solvers)) THEN
491  DO solver_idx=1,solvers%NUMBER_OF_SOLVERS
492  solver=>solvers%SOLVERS(solver_idx)%PTR
493 
494  CALL problem_solver_solve(solver,err,error,*999)
495 
496  ENDDO !solver_idx
497  ELSE
498  CALL flagerror("Control loop solvers is not associated.",err,error,*999)
499  ENDIF
500  ELSE
501  !If there are sub loops the recursively solve those control loops
502  DO loop_idx=1,control_loop%NUMBER_OF_SUB_LOOPS
503  control_loop2=>control_loop%SUB_LOOPS(loop_idx)%PTR
504  CALL problem_control_loop_solve(control_loop2,err,error,*999)
505  ENDDO !loop_idx
506  ENDIF
507  CALL problem_control_loop_post_loop(control_loop,err,error,*999)
508  ELSE
509  CALL flagerror("Control loop simple loop is not associated.",err,error,*999)
510  ENDIF
511  CASE(problem_control_fixed_loop_type)
512  fixed_loop=>control_loop%FIXED_LOOP
513  IF(ASSOCIATED(fixed_loop)) THEN
514  DO iteration_idx=fixed_loop%START_ITERATION,fixed_loop%STOP_ITERATION,fixed_loop%ITERATION_INCREMENT
515  IF(control_loop%OUTPUT_TYPE>=control_loop_progress_output) THEN
516  CALL write_string(general_output_type,"",err,error,*999)
517  CALL write_string_value(general_output_type,"Fixed control loop iteration: ",iteration_idx,err,error,*999)
518  ENDIF
519  fixed_loop%ITERATION_NUMBER=iteration_idx
520  CALL problem_control_loop_pre_loop(control_loop,err,error,*999)
521  IF(control_loop%NUMBER_OF_SUB_LOOPS==0) THEN
522  !If there are no sub loops then solve
523  solvers=>control_loop%SOLVERS
524  IF(ASSOCIATED(solvers)) THEN
525  DO solver_idx=1,solvers%NUMBER_OF_SOLVERS
526  solver=>solvers%SOLVERS(solver_idx)%PTR
527 
528  CALL problem_solver_solve(solver,err,error,*999)
529 
530  ENDDO !solver_idx
531  ELSE
532  CALL flagerror("Control loop solvers is not associated.",err,error,*999)
533  ENDIF
534  ELSE
535  !If there are sub loops the recursively solve those control loops
536  DO loop_idx=1,control_loop%NUMBER_OF_SUB_LOOPS
537  control_loop2=>control_loop%SUB_LOOPS(loop_idx)%PTR
538  CALL problem_control_loop_solve(control_loop2,err,error,*999)
539  ENDDO !loop_idx
540  ENDIF
541  CALL problem_control_loop_post_loop(control_loop,err,error,*999)
542  ENDDO !iteration_idx
543  ELSE
544  CALL flagerror("Control loop fixed loop is not associated.",err,error,*999)
545  ENDIF
546  CASE(problem_control_time_loop_type)
547  time_loop=>control_loop%TIME_LOOP
548  IF(ASSOCIATED(time_loop)) THEN
549  !Set the current time to be the start time. Solvers should use the first time step to do any initialisation.
550  time_loop%CURRENT_TIME=time_loop%START_TIME
551 
552  !Precompute the number of iterations from total time span and time increment if it was not specified explicitely
553  IF (time_loop%NUMBER_OF_ITERATIONS==0) THEN
554  time_loop%NUMBER_OF_ITERATIONS=ceiling((time_loop%STOP_TIME-time_loop%START_TIME)/time_loop%TIME_INCREMENT)
555  !If number of iterations was specified but does not match TIME_INCREMENT, e.g. TIME_INCREMENT is still at the default value, compute correct TIME_INCREMENT
556  ELSEIF (ceiling((time_loop%STOP_TIME-time_loop%START_TIME)/time_loop%TIME_INCREMENT) &
557  & /= time_loop%NUMBER_OF_ITERATIONS) THEN
558  time_loop%TIME_INCREMENT = (time_loop%STOP_TIME-time_loop%START_TIME)/time_loop%NUMBER_OF_ITERATIONS
559  ENDIF
560 
561  time_loop%ITERATION_NUMBER=0
562  DO WHILE(time_loop%ITERATION_NUMBER<time_loop%NUMBER_OF_ITERATIONS)
563  IF(control_loop%OUTPUT_TYPE>=control_loop_progress_output) THEN
564  CALL write_string(general_output_type,"",err,error,*999)
565  CALL write_string_value(general_output_type,"Time control loop iteration: ",time_loop%ITERATION_NUMBER, &
566  & err,error,*999)
567  CALL write_string_value(general_output_type," Total number of iterations: ",time_loop%NUMBER_OF_ITERATIONS, &
568  & err,error,*999)
569  CALL write_string_value(general_output_type," Current time = ",time_loop%CURRENT_TIME, &
570  & err,error,*999)
571  CALL write_string_value(general_output_type," Stop time = ",time_loop%STOP_TIME, &
572  & err,error,*999)
573  CALL write_string_value(general_output_type," Time increment = ",time_loop%TIME_INCREMENT, &
574  & err,error,*999)
575  ENDIF
576  !Perform any pre-loop actions.
577  CALL problem_control_loop_pre_loop(control_loop,err,error,*999)
578  IF(control_loop%NUMBER_OF_SUB_LOOPS==0) THEN
579  !If there are no sub loops then solve.
580  solvers=>control_loop%SOLVERS
581  IF(ASSOCIATED(solvers)) THEN
582  DO solver_idx=1,solvers%NUMBER_OF_SOLVERS
583  solver=>solvers%SOLVERS(solver_idx)%PTR
584 
585  CALL problem_solver_solve(solver,err,error,*999)
586 
587  ENDDO !solver_idx
588  ELSE
589  CALL flagerror("Control loop solvers is not associated.",err,error,*999)
590  ENDIF
591  ELSE
592  !If there are sub loops the recursively solve those control loops
593  DO loop_idx=1,control_loop%NUMBER_OF_SUB_LOOPS
594  control_loop2=>control_loop%SUB_LOOPS(loop_idx)%PTR
595  CALL problem_control_loop_solve(control_loop2,err,error,*999)
596  ENDDO !loop_idx
597  ENDIF
598  !Perform any post loop actions.
599  CALL problem_control_loop_post_loop(control_loop,err,error,*999)
600  !Increment loop counter and time
601  time_loop%ITERATION_NUMBER=time_loop%ITERATION_NUMBER+1
602  time_loop%GLOBAL_ITERATION_NUMBER=time_loop%GLOBAL_ITERATION_NUMBER+1
603  time_loop%CURRENT_TIME=time_loop%CURRENT_TIME+time_loop%TIME_INCREMENT
604  ENDDO !time loop
605  ELSE
606  CALL flagerror("Control loop time loop is not associated.",err,error,*999)
607  ENDIF
608  CASE(problem_control_while_loop_type)
609  while_loop=>control_loop%WHILE_LOOP
610  IF(ASSOCIATED(while_loop)) THEN
611  while_loop%ITERATION_NUMBER=0
612  while_loop%CONTINUE_LOOP=.true.
613  DO WHILE(while_loop%CONTINUE_LOOP.AND.while_loop%ITERATION_NUMBER &
614  & <while_loop%MAXIMUM_NUMBER_OF_ITERATIONS)
615  while_loop%ITERATION_NUMBER=while_loop%ITERATION_NUMBER+1
616  IF(control_loop%OUTPUT_TYPE>=control_loop_progress_output) THEN
617  CALL write_string(general_output_type,"",err,error,*999)
618  CALL write_string_value(general_output_type,"While control loop iteration: ",while_loop%ITERATION_NUMBER, &
619  & err,error,*999)
620  CALL write_string_value(general_output_type," Maximum number of iterations = ", &
621  & while_loop%MAXIMUM_NUMBER_OF_ITERATIONS,err,error,*999)
622  ENDIF
623  CALL problem_control_loop_pre_loop(control_loop,err,error,*999)
624  IF(control_loop%NUMBER_OF_SUB_LOOPS==0) THEN
625  !If there are no sub loops then solve
626  solvers=>control_loop%SOLVERS
627  IF(ASSOCIATED(solvers)) THEN
628  DO solver_idx=1,solvers%NUMBER_OF_SOLVERS
629  solver=>solvers%SOLVERS(solver_idx)%PTR
630  IF(ASSOCIATED(solver)) THEN
631  IF(ASSOCIATED(solver%SOLVER_EQUATIONS)) THEN
632  CALL problem_solver_load_increment_apply(solver%SOLVER_EQUATIONS,1, &
633  & 1,err,error,*999)
634  ENDIF
635  CALL problem_solver_solve(solver,err,error,*999)
636  ELSE
637  CALL flagerror("Solver is not associated.",err,error,*999)
638  ENDIF
639  ENDDO !solver_idx
640  ELSE
641  CALL flagerror("Control loop solvers is not associated.",err,error,*999)
642  ENDIF
643  ELSE
644  !If there are sub loops the recursively solve those control loops
645  DO loop_idx=1,control_loop%NUMBER_OF_SUB_LOOPS
646  control_loop2=>control_loop%SUB_LOOPS(loop_idx)%PTR
647  CALL problem_control_loop_solve(control_loop2,err,error,*999)
648  ENDDO !loop_idx
649  ENDIF
650  CALL problem_control_loop_post_loop(control_loop,err,error,*999)
651  ENDDO !while loop
652  ELSE
653  CALL flagerror("Control loop while loop is not associated.",err,error,*999)
654  ENDIF
655  CASE(problem_control_load_increment_loop_type)
656  load_increment_loop=>control_loop%LOAD_INCREMENT_LOOP
657  IF(ASSOCIATED(load_increment_loop)) THEN
658  load_increment_loop%ITERATION_NUMBER=0
659  IF (load_increment_loop%MAXIMUM_NUMBER_OF_ITERATIONS<1) THEN
660  ! automatic stepping
661  CALL flagerror("Automatic load incrementing is not implemented yet.",err,error,*999)
662  ELSE
663  ! fixed number of steps
664  DO WHILE(load_increment_loop%ITERATION_NUMBER<load_increment_loop%MAXIMUM_NUMBER_OF_ITERATIONS)
665  load_increment_loop%ITERATION_NUMBER=load_increment_loop%ITERATION_NUMBER+1
666  IF(control_loop%OUTPUT_TYPE>=control_loop_progress_output) THEN
667  CALL write_string(general_output_type,"",err,error,*999)
668  CALL write_string_value(general_output_type,"Load increment control loop iteration: ", &
669  & load_increment_loop%ITERATION_NUMBER,err,error,*999)
670  CALL write_string_value(general_output_type," Maximum number of iterations = ", &
671  & load_increment_loop%MAXIMUM_NUMBER_OF_ITERATIONS,err,error,*999)
672  ENDIF
673  CALL problem_control_loop_pre_loop(control_loop,err,error,*999)
674  IF(control_loop%NUMBER_OF_SUB_LOOPS==0) THEN
675  !If there are no sub loops then solve
676  solvers=>control_loop%SOLVERS
677  IF(ASSOCIATED(solvers)) THEN
678  DO solver_idx=1,solvers%NUMBER_OF_SOLVERS
679  solver=>solvers%SOLVERS(solver_idx)%PTR
680  IF(ASSOCIATED(solver)) THEN
681  IF(ASSOCIATED(solver%SOLVER_EQUATIONS)) THEN
682  !Apply incremented boundary conditions here =>
683  CALL problem_solver_load_increment_apply(solver%SOLVER_EQUATIONS,load_increment_loop%ITERATION_NUMBER, &
684  & load_increment_loop%MAXIMUM_NUMBER_OF_ITERATIONS,err,error,*999)
685  ENDIF
686  CALL problem_solver_solve(solver,err,error,*999)
687  ELSE
688  CALL flagerror("Solver is not associated.",err,error,*999)
689  ENDIF
690  ENDDO !solver_idx
691  ELSE
692  CALL flagerror("Control loop solvers is not associated.",err,error,*999)
693  ENDIF
694  ELSE
695  !If there are sub loops the recursively solve those control loops
696  DO loop_idx=1,control_loop%NUMBER_OF_SUB_LOOPS
697  control_loop2=>control_loop%SUB_LOOPS(loop_idx)%PTR
698  CALL problem_control_loop_solve(control_loop2,err,error,*999)
699  ENDDO !loop_idx
700  ENDIF
701  CALL problem_control_loop_post_loop(control_loop,err,error,*999)
702  ENDDO !while loop
703  ENDIF
704  ELSE
705  CALL flagerror("Control loop while loop is not associated.",err,error,*999)
706  ENDIF
707  CASE DEFAULT
708  local_error="The control loop loop type of "//trim(number_to_vstring(control_loop%LOOP_TYPE,"*",err,error))// &
709  & " is invalid."
710  CALL flagerror(local_error,err,error,*999)
711  END SELECT
712  ELSE
713  CALL flagerror("Control loop has not been finished.",err,error,*999)
714  ENDIF
715  ELSE
716  CALL flagerror("Control loop is not associated",err,error,*999)
717  ENDIF
718 
719  exits("PROBLEM_CONTROL_LOOP_SOLVE")
720  RETURN
721 999 errorsexits("PROBLEM_CONTROL_LOOP_SOLVE",err,error)
722  RETURN 1
723  END SUBROUTINE problem_control_loop_solve
724 
725  !
726  !================================================================================================================================
727  !
728 
730  SUBROUTINE problem_create_finish(PROBLEM,ERR,ERROR,*)
731 
732  !Argument variables
733  TYPE(problem_type), POINTER :: problem
734  INTEGER(INTG), INTENT(OUT) :: err
735  TYPE(varying_string), INTENT(OUT) :: error
736  !Local Variables
737  INTEGER(INTG) :: problem_idx
738  TYPE(problem_setup_type) :: problem_setup_info
739 
740  enters("PROBLEM_CREATE_FINISH",err,error,*999)
741 
742  IF(ASSOCIATED(problem)) THEN
743  !Initialise the problem setup information
744  CALL problem_setup_initialise(problem_setup_info,err,error,*999)
745  problem_setup_info%SETUP_TYPE=problem_setup_initial_type
746  problem_setup_info%ACTION_TYPE=problem_setup_finish_action
747  !Finish the problem specific setup
748  CALL problem_setup(problem,problem_setup_info,err,error,*999)
749  !Finalise the problem setup information
750  CALL problem_setup_finalise(problem_setup_info,err,error,*999)
751  !Finish the problem creation
752  problem%PROBLEM_FINISHED=.true.
753  ELSE
754  CALL flagerror("Problem is not associated.",err,error,*999)
755  ENDIF
756 
757  IF(diagnostics1) THEN
758  CALL write_string_value(diagnostic_output_type,"Number of problems = ",problems%NUMBER_OF_PROBLEMS,err,error,*999)
759  DO problem_idx=1,problems%NUMBER_OF_PROBLEMS
760  CALL write_string_value(diagnostic_output_type,"Problem number = ",problem_idx,err,error,*999)
761  CALL write_string_value(diagnostic_output_type," User number = ",problems%PROBLEMS(problem_idx)%PTR%USER_NUMBER, &
762  & err,error,*999)
763  CALL write_string_value(diagnostic_output_type," Global number = ",problems%PROBLEMS(problem_idx)%PTR%GLOBAL_NUMBER, &
764  & err,error,*999)
765  CALL write_string_vector(diagnostic_output_type,1,1,SIZE(problems%PROBLEMS(problem_idx)%PTR%SPECIFICATION,1),8,8, &
766  & problems%PROBLEMS(problem_idx)%PTR%SPECIFICATION,'(" Problem specification = ",8(X,I3))','(16X,8(X,I3))', &
767  & err,error,*999)
768  ENDDO !problem_idx
769  ENDIF
770 
771  exits("PROBLEM_CREATE_FINISH")
772  RETURN
773 999 errorsexits("PROBLEM_CREATE_FINISH",err,error)
774  RETURN 1
775 
776  END SUBROUTINE problem_create_finish
777 
778  !
779  !================================================================================================================================
780  !
781 
783  SUBROUTINE problem_create_start(USER_NUMBER,PROBLEM_SPECIFICATION,PROBLEM,ERR,ERROR,*)
784 
785  !Argument variables
786  INTEGER(INTG), INTENT(IN) :: user_number
787  INTEGER(INTG), INTENT(IN) :: problem_specification(:)
788  TYPE(problem_type), POINTER :: problem
789  INTEGER(INTG), INTENT(OUT) :: err
790  TYPE(varying_string), INTENT(OUT) :: error
791  !Local Variables
792  INTEGER(INTG) :: problem_idx
793  TYPE(problem_type), POINTER :: new_problem
794  TYPE(problem_ptr_type), POINTER :: new_problems(:)
795  TYPE(problem_setup_type) :: problem_setup_info
796  TYPE(varying_string) :: local_error
797 
798  NULLIFY(new_problem)
799  NULLIFY(new_problems)
800 
801  enters("PROBLEM_CREATE_START",err,error,*999)
802 
803  IF(ASSOCIATED(problem)) THEN
804  CALL flagerror("Problem is already associated.",err,error,*999)
805  ELSE
806  NULLIFY(problem)
807  CALL problem_user_number_find(user_number,problem,err,error,*999)
808  IF(ASSOCIATED(problem)) THEN
809  local_error="Problem number "//trim(number_to_vstring(user_number,"*",err,error))//" has already been created."
810  CALL flagerror(local_error,err,error,*999)
811  ELSE
812  !Allocate the new problem
813  ALLOCATE(new_problem,stat=err)
814  IF(err/=0) CALL flagerror("Could not allocate new problem.",err,error,*999)
815  !Initalise problem
816  CALL problem_initialise(new_problem,err,error,*999)
817  !Set default problem values
818  new_problem%USER_NUMBER=user_number
819  new_problem%GLOBAL_NUMBER=problems%NUMBER_OF_PROBLEMS+1
820  new_problem%PROBLEMS=>problems
821  !Set problem specification
822  CALL problem_specificationset(new_problem,problem_specification,err,error,*999)
823  !For compatibility with old code, set class, type and subtype
824  new_problem%PROBLEM_FINISHED=.false.
825  !Initialise the problem setup information
826  CALL problem_setup_initialise(problem_setup_info,err,error,*999)
827  problem_setup_info%SETUP_TYPE=problem_setup_initial_type
828  problem_setup_info%ACTION_TYPE=problem_setup_start_action
829  !Start problem specific setup
830  CALL problem_setup(new_problem,problem_setup_info,err,error,*999)
831  !Finalise the problem setup information
832  CALL problem_setup_finalise(problem_setup_info,err,error,*999)
833  !Add new problem into list of problems
834  ALLOCATE(new_problems(problems%NUMBER_OF_PROBLEMS+1),stat=err)
835  IF(err/=0) CALL flagerror("Could not allocate new problems.",err,error,*999)
836  DO problem_idx=1,problems%NUMBER_OF_PROBLEMS
837  new_problems(problem_idx)%PTR=>problems%PROBLEMS(problem_idx)%PTR
838  ENDDO !problem_idx
839  new_problems(problems%NUMBER_OF_PROBLEMS+1)%PTR=>new_problem
840  IF(ASSOCIATED(problems%PROBLEMS)) DEALLOCATE(problems%PROBLEMS)
841  problems%PROBLEMS=>new_problems
842  problems%NUMBER_OF_PROBLEMS=problems%NUMBER_OF_PROBLEMS+1
843  problem=>new_problem
844  ENDIF
845  ENDIF
846 
847  exits("PROBLEM_CREATE_START")
848  RETURN
849 999 errorsexits("PROBLEM_CREATE_START",err,error)
850  RETURN 1
851  END SUBROUTINE problem_create_start
852 
853  !
854  !================================================================================================================================
855  !
856 
858  SUBROUTINE problem_destroy(PROBLEM,ERR,ERROR,*)
859 
860  !Argument variables
861  TYPE(problem_type), POINTER :: problem
862  INTEGER(INTG), INTENT(OUT) :: err
863  TYPE(varying_string), INTENT(OUT) :: error
864  !Local Variables
865  INTEGER(INTG) :: problem_idx,problem_position
866  TYPE(problem_ptr_type), POINTER :: new_problems(:)
867 
868  NULLIFY(new_problems)
869 
870  enters("PROBLEM_DESTROY",err,error,*999)
871 
872  IF(ASSOCIATED(problem)) THEN
873  IF(ASSOCIATED(problems%PROBLEMS)) THEN
874 
875  problem_position=problem%GLOBAL_NUMBER
876 
877  !Destroy all the problem components
878  CALL problem_finalise(problem,err,error,*999)
879 
880  !Remove the problem from the list of problems
881  IF(problems%NUMBER_OF_PROBLEMS>1) THEN
882  ALLOCATE(new_problems(problems%NUMBER_OF_PROBLEMS-1),stat=err)
883  IF(err/=0) CALL flagerror("Could not allocate new problems.",err,error,*999)
884  DO problem_idx=1,problems%NUMBER_OF_PROBLEMS
885  IF(problem_idx<problem_position) THEN
886  new_problems(problem_idx)%PTR=>problems%PROBLEMS(problem_idx)%PTR
887  ELSE IF(problem_idx>problem_position) THEN
888  problems%PROBLEMS(problem_idx)%PTR%GLOBAL_NUMBER=problems%PROBLEMS(problem_idx)%PTR%GLOBAL_NUMBER-1
889  new_problems(problem_idx-1)%PTR=>problems%PROBLEMS(problem_idx)%PTR
890  ENDIF
891  ENDDO !problem_idx
892  DEALLOCATE(problems%PROBLEMS)
893  problems%PROBLEMS=>new_problems
894  problems%NUMBER_OF_PROBLEMS=problems%NUMBER_OF_PROBLEMS-1
895  ELSE
896  DEALLOCATE(problems%PROBLEMS)
897  problems%NUMBER_OF_PROBLEMS=0
898  ENDIF
899 
900  ELSE
901  CALL flagerror("Problem problems is not associated.",err,error,*999)
902  ENDIF
903  ELSE
904  CALL flagerror("Problem is not associated.",err,error,*998)
905  ENDIF
906 
907  exits("PROBLEM_DESTROY")
908  RETURN
909 999 IF(ASSOCIATED(new_problems)) DEALLOCATE(new_problems)
910 998 errorsexits("PROBLEM_DESTROY",err,error)
911  RETURN 1
912  END SUBROUTINE problem_destroy
913 
914  !
915  !================================================================================================================================
916  !
917 
919  SUBROUTINE problem_setup_finalise(PROBLEM_SETUP_INFO,ERR,ERROR,*)
920 
921  !Argument variables
922  TYPE(problem_setup_type), INTENT(OUT) :: problem_setup_info
923  INTEGER(INTG), INTENT(OUT) :: err
924  TYPE(varying_string), INTENT(OUT) :: error
925  !Local Variables
926 
927  enters("PROBLEM_SETUP_FINALISE",err,error,*999)
928 
929  problem_setup_info%SETUP_TYPE=0
930  problem_setup_info%ACTION_TYPE=0
931 
932  exits("PROBLEM_SETUP_FINALISE")
933  RETURN
934 999 errorsexits("PROBLEM_SETUP_FINALISE",err,error)
935  RETURN 1
936  END SUBROUTINE problem_setup_finalise
937 
938  !
939  !================================================================================================================================
940  !
941 
943  SUBROUTINE problem_setup_initialise(PROBLEM_SETUP_INFO,ERR,ERROR,*)
944 
945  !Argument variables
946  TYPE(problem_setup_type), INTENT(OUT) :: problem_setup_info
947  INTEGER(INTG), INTENT(OUT) :: err
948  TYPE(varying_string), INTENT(OUT) :: error
949  !Local Variables
950 
951  enters("PROBLEM_SETUP_INITIALISE",err,error,*999)
952 
953  problem_setup_info%SETUP_TYPE=0
954  problem_setup_info%ACTION_TYPE=0
955 
956  exits("PROBLEM_SETUP_INITIALISE")
957  RETURN
958 999 errorsexits("PROBLEM_SETUP_INITIALISE",err,error)
959  RETURN 1
960  END SUBROUTINE problem_setup_initialise
961 
962  !
963  !================================================================================================================================
964  !
965 
967  SUBROUTINE problem_finalise(PROBLEM,ERR,ERROR,*)
968 
969  !Argument variables
970  TYPE(problem_type), POINTER :: problem
971  INTEGER(INTG), INTENT(OUT) :: err
972  TYPE(varying_string), INTENT(OUT) :: error
973  !Local Variables
974 
975  enters("PROBLEM_FINALISE",err,error,*999)
976 
977  IF(ASSOCIATED(problem)) THEN
978  IF(ASSOCIATED(problem%CONTROL_LOOP)) CALL control_loop_destroy(problem%CONTROL_LOOP,err,error,*999)
979  IF(ALLOCATED(problem%SPECIFICATION)) DEALLOCATE(problem%SPECIFICATION)
980  DEALLOCATE(problem)
981  ENDIF
982 
983  exits("PROBLEM_FINALISE")
984  RETURN
985 999 errorsexits("PROBLEM_FINALISE",err,error)
986  RETURN 1
987  END SUBROUTINE problem_finalise
988 
989  !
990  !================================================================================================================================
991  !
992 
994  SUBROUTINE problem_initialise(PROBLEM,ERR,ERROR,*)
995 
996  !Argument variables
997  TYPE(problem_type), POINTER :: problem
998  INTEGER(INTG), INTENT(OUT) :: err
999  TYPE(varying_string), INTENT(OUT) :: error
1000  !Local Variables
1001 
1002  enters("PROBLEM_INITIALISE",err,error,*999)
1003 
1004  IF(ASSOCIATED(problem)) THEN
1005  problem%USER_NUMBER=0
1006  problem%GLOBAL_NUMBER=0
1007  problem%PROBLEM_FINISHED=.false.
1008  NULLIFY(problem%PROBLEMS)
1009  NULLIFY(problem%CONTROL_LOOP)
1010  ELSE
1011  CALL flagerror("Problem is not associated.",err,error,*999)
1012  ENDIF
1013 
1014  exits("PROBLEM_INITIALISE")
1015  RETURN
1016 999 errorsexits("PROBLEM_INITIALISE",err,error)
1017  RETURN 1
1018  END SUBROUTINE problem_initialise
1019 
1020  !
1021  !================================================================================================================================
1022  !
1023 
1025  SUBROUTINE problem_control_loop_create_finish(PROBLEM,ERR,ERROR,*)
1026 
1027  !Argument variables
1028  TYPE(problem_type), POINTER :: problem
1029  INTEGER(INTG), INTENT(OUT) :: err
1030  TYPE(varying_string), INTENT(OUT) :: error
1031  !Local Variables
1032  TYPE(problem_setup_type) :: problem_setup_info
1033 
1034  enters("PROBLEM_CONTROL_LOOP_CREATE_FINISH",err,error,*999)
1035 
1036  IF(ASSOCIATED(problem)) THEN
1037  IF(ASSOCIATED(problem%CONTROL_LOOP)) THEN
1038  IF(problem%CONTROL_LOOP%CONTROL_LOOP_FINISHED) THEN
1039  CALL flagerror("Problem control loop has already been finished.",err,error,*999)
1040  ELSE
1041  !Initialise the problem setup information
1042  CALL problem_setup_initialise(problem_setup_info,err,error,*999)
1043  problem_setup_info%SETUP_TYPE=problem_setup_control_type
1044  problem_setup_info%ACTION_TYPE=problem_setup_finish_action
1045  !Finish problem specific startup
1046  CALL problem_setup(problem,problem_setup_info,err,error,*999)
1047  !Finalise the problem setup information
1048  CALL problem_setup_finalise(problem_setup_info,err,error,*999)
1049  !Finish problem control creation
1050  problem%CONTROL_LOOP%CONTROL_LOOP_FINISHED=.true.
1051  ENDIF
1052  ELSE
1053  CALL flagerror("The problem control loop is not associated.",err,error,*999)
1054  ENDIF
1055  ELSE
1056  CALL flagerror("Problem is not associated.",err,error,*999)
1057  ENDIF
1058 
1059  exits("PROBLEM_CONTROL_LOOP_CREATE_FINISH")
1060  RETURN
1061 999 errorsexits("PROBLEM_CONTROL_LOOP_CREATE_FINISH",err,error)
1062  RETURN 1
1063  END SUBROUTINE problem_control_loop_create_finish
1064 
1065  !
1066  !================================================================================================================================
1067  !
1068 
1074  SUBROUTINE problem_control_loop_create_start(PROBLEM,ERR,ERROR,*)
1075 
1076  !Argument variables
1077  TYPE(problem_type), POINTER :: problem
1078  INTEGER(INTG), INTENT(OUT) :: err
1079  TYPE(varying_string), INTENT(OUT) :: error
1080  !Local Variables
1081  TYPE(problem_setup_type) :: problem_setup_info
1082 
1083  enters("PROBLEM_CONTROL_LOOP_CREATE_START",err,error,*999)
1084 
1085  IF(ASSOCIATED(problem)) THEN
1086  IF(ASSOCIATED(problem%CONTROL_LOOP)) THEN
1087  CALL flagerror("The problem control loop is already associated.",err,error,*999)
1088  ELSE
1089  !Initialise the problem setup information
1090  CALL problem_setup_initialise(problem_setup_info,err,error,*999)
1091  problem_setup_info%SETUP_TYPE=problem_setup_control_type
1092  problem_setup_info%ACTION_TYPE=problem_setup_start_action
1093  !Start the problem specific control setup
1094  CALL problem_setup(problem,problem_setup_info,err,error,*999)
1095  !Finalise the problem setup information
1096  CALL problem_setup_finalise(problem_setup_info,err,error,*999)
1097  ENDIF
1098  ELSE
1099  CALL flagerror("Problem is not associated.",err,error,*999)
1100  ENDIF
1101 
1102  exits("PROBLEM_CONTROL_LOOP_CREATE_START")
1103  RETURN
1104 999 errorsexits("PROBLEM_CONTROL_LOOP_CREATE_START",err,error)
1105  RETURN 1
1106  END SUBROUTINE problem_control_loop_create_start
1107 
1108  !
1109  !================================================================================================================================
1110  !
1111 
1113  SUBROUTINE problem_control_loop_destroy(PROBLEM,ERR,ERROR,*)
1114 
1115  !Argument variables
1116  TYPE(problem_type), POINTER :: problem
1117  INTEGER(INTG), INTENT(OUT) :: err
1118  TYPE(varying_string), INTENT(OUT) :: error
1119  !Local Variables
1120 
1121  enters("PROBLEM_CONTROL_LOOP_DESTROY",err,error,*999)
1122 
1123  IF(ASSOCIATED(problem)) THEN
1124  IF(ASSOCIATED(problem%CONTROL_LOOP)) THEN
1125  CALL control_loop_destroy(problem%CONTROL_LOOP,err,error,*999)
1126  ELSE
1127  CALL flagerror("Problem control loop is not associated.",err,error,*999)
1128  ENDIF
1129  ELSE
1130  CALL flagerror("Problem is not associated.",err,error,*999)
1131  ENDIF
1132 
1133  exits("PROBLEM_CONTROL_LOOP_DESTROY")
1134  RETURN
1135 999 errorsexits("PROBLEM_CONTROL_LOOP_DESTROY",err,error)
1136  RETURN 1
1137  END SUBROUTINE problem_control_loop_destroy
1138 
1139  !
1140  !================================================================================================================================
1141  !
1142 
1144  SUBROUTINE problem_control_loop_get_0(PROBLEM,CONTROL_LOOP_IDENTIFIER,CONTROL_LOOP,ERR,ERROR,*)
1145 
1146  !Argument variables
1147  TYPE(problem_type), POINTER :: problem
1148  INTEGER(INTG), INTENT(IN) :: control_loop_identifier
1149  TYPE(control_loop_type), POINTER :: control_loop
1150  INTEGER(INTG), INTENT(OUT) :: err
1151  TYPE(varying_string), INTENT(OUT) :: error
1152  !Local Variables
1153 
1154  enters("PROBLEM_CONTROL_LOOP_GET_0",err,error,*999)
1155 
1156  CALL problem_control_loop_get_1(problem,[control_loop_identifier],control_loop,err,error,*999)
1157 
1158  exits("PROBLEM_CONTROL_LOOP_GET_0")
1159  RETURN
1160 999 errorsexits("PROBLEM_CONTROL_LOOP_GET_0",err,error)
1161  RETURN 1
1162  END SUBROUTINE problem_control_loop_get_0
1163 
1164  !
1165  !================================================================================================================================
1166  !
1167 
1169  SUBROUTINE problem_control_loop_get_1(PROBLEM,CONTROL_LOOP_IDENTIFIER,CONTROL_LOOP,ERR,ERROR,*)
1170 
1171  !Argument variables
1172  TYPE(problem_type), POINTER :: problem
1173  INTEGER(INTG), INTENT(IN) :: control_loop_identifier(:)
1174  TYPE(control_loop_type), POINTER :: control_loop
1175  INTEGER(INTG), INTENT(OUT) :: err
1176  TYPE(varying_string), INTENT(OUT) :: error
1177  !Local Variables
1178  TYPE(control_loop_type), POINTER :: control_loop_root
1179 
1180  enters("PROBLEM_CONTROL_LOOP_GET_1",err,error,*999)
1181 
1182  IF(ASSOCIATED(problem)) THEN
1183  IF(ASSOCIATED(control_loop)) THEN
1184  CALL flagerror("Control loop is already associated.",err,error,*999)
1185  ELSE
1186  control_loop_root=>problem%CONTROL_LOOP
1187  IF(ASSOCIATED(control_loop_root)) THEN
1188  NULLIFY(control_loop)
1189  CALL control_loop_get(control_loop_root,control_loop_identifier,control_loop,err,error,*999)
1190  ELSE
1191  CALL flagerror("Problem control loop is not associated.",err,error,*999)
1192  ENDIF
1193  ENDIF
1194  ELSE
1195  CALL flagerror("Problem is not associated.",err,error,*999)
1196  ENDIF
1197 
1198  exits("PROBLEM_CONTROL_LOOP_GET_1")
1199  RETURN
1200 999 errorsexits("PROBLEM_CONTROL_LOOP_GET_1",err,error)
1201  RETURN 1
1202  END SUBROUTINE problem_control_loop_get_1
1203 
1204  !
1205  !================================================================================================================================
1206  !
1207 
1209  SUBROUTINE problem_setup(problem,problemSetupInfo,err,error,*)
1210 
1211  !Argument variables
1212  TYPE(problem_type), POINTER :: problem
1213  TYPE(problem_setup_type), INTENT(INOUT) :: problemsetupinfo
1214  INTEGER(INTG), INTENT(OUT) :: err
1215  TYPE(varying_string), INTENT(OUT) :: error
1216  !Local Variables
1217  TYPE(varying_string) :: localerror
1218 
1219  enters("Problem_Setup",err,error,*999)
1220 
1221  IF(ASSOCIATED(problem)) THEN
1222  IF(.NOT.ALLOCATED(problem%specification)) THEN
1223  CALL flagerror("Problem specification is not allocated.",err,error,*999)
1224  ELSE IF(SIZE(problem%specification,1)<1) THEN
1225  CALL flagerror("Problem specification must have at least one entry.",err,error,*999)
1226  ENDIF
1227  SELECT CASE(problem%specification(1))
1228  CASE(problem_elasticity_class)
1229  CALL elasticity_problem_setup(problem,problemsetupinfo,err,error,*999)
1230  CASE(problem_fluid_mechanics_class)
1231  CALL fluid_mechanics_problem_setup(problem,problemsetupinfo,err,error,*999)
1232  CASE(problem_bioelectrics_class)
1233  CALL bioelectric_problem_setup(problem,problemsetupinfo,err,error,*999)
1234  CASE(problem_electromagnetics_class)
1235  CALL flagerror("Not implemented.",err,error,*999)
1236  CASE(problem_classical_field_class)
1237  CALL classical_field_problem_setup(problem,problemsetupinfo,err,error,*999)
1238  CASE(problem_fitting_class)
1239  CALL fitting_problem_setup(problem,problemsetupinfo,err,error,*999)
1240  CASE(problem_modal_class)
1241  CALL flagerror("Not implemented.",err,error,*999)
1242  CASE(problem_multi_physics_class)
1243  CALL multi_physics_problem_setup(problem,problemsetupinfo,err,error,*999)
1244  CASE DEFAULT
1245  localerror="The first problem specification of "//trim(numbertovstring(problem%specification(1),"*",err,error))// &
1246  & " is not valid."
1247  CALL flagerror(localerror,err,error,*999)
1248  END SELECT
1249  ELSE
1250  CALL flagerror("Problem is not associated.",err,error,*999)
1251  ENDIF
1252 
1253  exits("Problem_Setup")
1254  RETURN
1255 999 errorsexits("Problem_Setup",err,error)
1256  RETURN 1
1257 
1258  END SUBROUTINE problem_setup
1259 
1260  !
1261  !================================================================================================================================
1262  !
1263 
1265  SUBROUTINE problem_solver_equations_get_0(PROBLEM,CONTROL_LOOP_IDENTIFIER,SOLVER_INDEX,SOLVER_EQUATIONS,ERR,ERROR,*)
1266 
1267  !Argument variables
1268  TYPE(problem_type), POINTER :: problem
1269  INTEGER(INTG), INTENT(IN) :: control_loop_identifier
1270  INTEGER(INTG), INTENT(IN) :: solver_index
1271  TYPE(solver_equations_type), POINTER :: solver_equations
1272  INTEGER(INTG), INTENT(OUT) :: err
1273  TYPE(varying_string), INTENT(OUT) :: error
1274  !Local Variables
1275 
1276  enters("PROBLEM_SOLVER_EQUATIONS_GET_0",err,error,*999)
1277 
1278  CALL problem_solver_equations_get_1(problem,[control_loop_identifier],solver_index,solver_equations,err,error,*999)
1279 
1280  exits("PROBLEM_SOLVER_EQUATIONS_GET_0")
1281  RETURN
1282 999 errorsexits("PROBLEM_SOLVER_EQUATIONS_GET_0",err,error)
1283  RETURN 1
1284  END SUBROUTINE problem_solver_equations_get_0
1285 
1286  !
1287  !================================================================================================================================
1288  !
1289 
1291  SUBROUTINE problem_solver_equations_get_1(PROBLEM,CONTROL_LOOP_IDENTIFIER,SOLVER_INDEX,SOLVER_EQUATIONS,ERR,ERROR,*)
1292 
1293  !Argument variables
1294  TYPE(problem_type), POINTER :: problem
1295  INTEGER(INTG), INTENT(IN) :: control_loop_identifier(:)
1296  INTEGER(INTG), INTENT(IN) :: solver_index
1297  TYPE(solver_equations_type), POINTER :: solver_equations
1298  INTEGER(INTG), INTENT(OUT) :: err
1299  TYPE(varying_string), INTENT(OUT) :: error
1300  !Local Variables
1301  TYPE(control_loop_type), POINTER :: control_loop,control_loop_root
1302  TYPE(solver_type), POINTER :: solver
1303  TYPE(solvers_type), POINTER :: solvers
1304  TYPE(varying_string) :: local_error
1305 
1306  enters("PROBLEM_SOLVER_EQUATIONS_GET_1",err,error,*999)
1307 
1308  IF(ASSOCIATED(problem)) THEN
1309  IF(ASSOCIATED(solver_equations)) THEN
1310  CALL flagerror("The solver equations is already associated.",err,error,*999)
1311  ELSE
1312  NULLIFY(solver_equations)
1313  control_loop_root=>problem%CONTROL_LOOP
1314  IF(ASSOCIATED(control_loop_root)) THEN
1315  NULLIFY(control_loop)
1316  CALL control_loop_get(control_loop_root,control_loop_identifier,control_loop,err,error,*999)
1317  solvers=>control_loop%SOLVERS
1318  IF(ASSOCIATED(solvers)) THEN
1319  IF(solver_index>0.AND.solver_index<=solvers%NUMBER_OF_SOLVERS) THEN
1320  solver=>solvers%SOLVERS(solver_index)%PTR
1321  IF(ASSOCIATED(solver)) THEN
1322  solver_equations=>solver%SOLVER_EQUATIONS
1323  IF(.NOT.ASSOCIATED(solver_equations)) CALL flagerror("Solver equations is not associated.",err,error,*999)
1324  ELSE
1325  CALL flagerror("Solver is not associated.",err,error,*999)
1326  ENDIF
1327  ELSE
1328  local_error="The specified solver index of "//trim(number_to_vstring(solver_index,"*",err,error))// &
1329  & " is invalid. The index must be > 0 and <= "// &
1330  & trim(number_to_vstring(solvers%NUMBER_OF_SOLVERS,"*",err,error))//"."
1331  CALL flagerror(local_error,err,error,*999)
1332  ENDIF
1333  ELSE
1334  CALL flagerror("Solvers is not associated.",err,error,*999)
1335  ENDIF
1336  ELSE
1337  CALL flagerror("Problem control loop is not associated.",err,error,*999)
1338  ENDIF
1339  ENDIF
1340  ELSE
1341  CALL flagerror("Problem is not associated.",err,error,*999)
1342  ENDIF
1343 
1344  exits("PROBLEM_SOLVER_EQUATIONS_GET_1")
1345  RETURN
1346 999 errorsexits("PROBLEM_SOLVER_EQUATIONS_GET_1",err,error)
1347  RETURN 1
1348  END SUBROUTINE problem_solver_equations_get_1
1349 
1350  !
1351  !================================================================================================================================
1352  !
1353 
1355  SUBROUTINE problem_solver_jacobian_evaluate(SOLVER,ERR,ERROR,*)
1356 
1357  !Argument variables
1358  TYPE(solver_type), POINTER :: solver, linking_solver
1359  INTEGER(INTG), INTENT(OUT) :: err
1360  TYPE(varying_string), INTENT(OUT) :: error
1361  !Local Variables
1362  INTEGER(INTG) :: equations_set_idx,solver_matrix_idx
1363  TYPE(equations_set_type), POINTER :: equations_set
1364  TYPE(solver_type), POINTER :: cellml_solver
1365  TYPE(newton_solver_type), POINTER :: newton_solver
1366  TYPE(solver_equations_type), POINTER :: solver_equations
1367  TYPE(solver_mapping_type), POINTER :: solver_mapping
1368  TYPE(solver_matrices_type), POINTER :: solver_matrices
1369  TYPE(solver_matrix_type), POINTER :: solver_matrix
1370  TYPE(varying_string) :: local_error
1371 
1372  enters("PROBLEM_SOLVER_JACOBIAN_EVALUATE",err,error,*999)
1373 
1374  IF(ASSOCIATED(solver)) THEN
1375  IF(solver%SOLVER_FINISHED) THEN
1376  solver_equations=>solver%SOLVER_EQUATIONS
1377  IF(ASSOCIATED(solver_equations)) THEN
1378  solver_mapping=>solver_equations%SOLVER_MAPPING
1379  IF(ASSOCIATED(solver_mapping)) THEN
1380  IF(solver%OUTPUT_TYPE>=solver_matrix_output) THEN
1381  solver_matrices=>solver_equations%SOLVER_MATRICES
1382  IF(ASSOCIATED(solver_matrices)) THEN
1383  CALL write_string(general_output_type,"",err,error,*999)
1384  CALL write_string(general_output_type,"Solver vector values:",err,error,*999)
1385  DO solver_matrix_idx=1,solver_matrices%NUMBER_OF_MATRICES
1386  solver_matrix=>solver_matrices%MATRICES(solver_matrix_idx)%PTR
1387  IF(ASSOCIATED(solver_matrix)) THEN
1388  CALL write_string_value(general_output_type,"Solver matrix : ",solver_matrix_idx,err,error,*999)
1389  CALL distributed_vector_output(general_output_type,solver_matrix%SOLVER_VECTOR,err,error,*999)
1390  ELSE
1391  local_error="Solver matrix is not associated for solver matrix index "// &
1392  & trim(number_to_vstring(solver_matrix_idx,"*",err,error))//"."
1393  CALL flagerror(local_error,err,error,*999)
1394  ENDIF
1395  ENDDO !solver_matrix_idx
1396  ELSE
1397  CALL flagerror("Solver equations solver matrices is not associated.",err,error,*999)
1398  ENDIF
1399  ENDIF
1400  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
1401  !Check if the nonlinear solver is linked to a dynamic solver
1402  linking_solver=>solver%LINKING_SOLVER
1403  IF(ASSOCIATED(linking_solver)) THEN
1404  IF(linking_solver%SOLVE_TYPE==solver_dynamic_type) THEN
1405  !Update the field values from the dynamic factor * current solver values AND add in mean predicted displacements/
1406  CALL solver_variables_dynamic_nonlinear_update(solver,err,error,*999)
1407  !check for a linked CellML solver
1408 !!TODO: This should be generalised for nonlinear solvers in general and not just Newton solvers.
1409  newton_solver=>solver%NONLINEAR_SOLVER%NEWTON_SOLVER
1410  IF(ASSOCIATED(newton_solver)) THEN
1411  cellml_solver=>newton_solver%CELLML_EVALUATOR_SOLVER
1412  IF(ASSOCIATED(cellml_solver)) THEN
1413  CALL solver_solve(cellml_solver,err,error,*999)
1414  ENDIF
1415  ELSE
1416  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
1417  ENDIF
1418  !Calculate the Jacobian
1419  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
1420  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
1421  !Assemble the equations for dynamic problems
1422  CALL equations_set_jacobian_evaluate(equations_set,err,error,*999)
1423  ENDDO !equations_set_idx
1424  !Assemble the dynamic nonlinear solver matrices
1425  CALL solver_matrices_dynamic_assemble(solver,solver_matrices_jacobian_only,err,error,*999)
1426  ELSE
1427  CALL flagerror("Solver equations linking solver mapping is not dynamic.",err,error,*999)
1428  END IF
1429  ELSE
1430  !Otherwise perform as steady nonlinear
1431  !Copy the current solution vector to the dependent field
1432  CALL solver_variables_field_update(solver,err,error,*999)
1433  !check for a linked CellML solver
1434 !!TODO: This should be generalised for nonlinear solvers in general and not just Newton solvers.
1435  newton_solver=>solver%NONLINEAR_SOLVER%NEWTON_SOLVER
1436  IF(ASSOCIATED(newton_solver)) THEN
1437  cellml_solver=>newton_solver%CELLML_EVALUATOR_SOLVER
1438  IF(ASSOCIATED(cellml_solver)) THEN
1439  CALL solver_solve(cellml_solver,err,error,*999)
1440  ENDIF
1441  ELSE
1442  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
1443  ENDIF
1444  !Calculate the Jacobian
1445  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
1446  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
1447  !Assemble the equations for linear problems
1448  CALL equations_set_jacobian_evaluate(equations_set,err,error,*999)
1449  ENDDO !equations_set_idx
1450  !Update interface matrices
1451 ! DO interfaceConditionIdx=1,SOLVER_MAPPING%NUMBER_OF_INTERFACE_CONDITIONS
1452 ! interfaceCondition=>SOLVER_MAPPING%INTERFACE_CONDITIONS(interfaceConditionIdx)%PTR
1453 ! !Assemble the interface condition for the Jacobian LHS
1454 ! CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"********************Jacobian evaluation******************",ERR,ERROR,*999)
1455 ! CALL INTERFACE_CONDITION_ASSEMBLE(interfaceCondition,err,error,*999)
1456 ! ENDDO
1457  !Assemble the static nonlinear solver matrices
1458  CALL solver_matrices_static_assemble(solver,solver_matrices_jacobian_only,err,error,*999)
1459  END IF
1460  ELSE
1461  CALL flagerror("Solver equations solver type is not associated.",err,error,*999)
1462  END IF
1463  ELSE
1464  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
1465  ENDIF
1466  ELSE
1467  CALL flagerror("Solver solver equations mapping is not associated.",err,error,*999)
1468  ENDIF
1469  ELSE
1470  CALL flagerror("Solver has not been finished.",err,error,*999)
1471  ENDIF
1472  ELSE
1473  CALL flagerror("Solver is not associated.",err,error,*999)
1474  ENDIF
1475 
1476  exits("PROBLEM_SOLVER_JACOBIAN_EVALUATE")
1477  RETURN
1478 999 errorsexits("PROBLEM_SOLVER_JACOBIAN_EVALUATE",err,error)
1479  RETURN 1
1480  END SUBROUTINE problem_solver_jacobian_evaluate
1481 
1482  !
1483  !================================================================================================================================
1484  !
1485 
1487  SUBROUTINE problem_solver_residual_evaluate(SOLVER,ERR,ERROR,*)
1488 
1489  !Argument variables
1490  TYPE(solver_type), POINTER :: solver
1491  INTEGER(INTG), INTENT(OUT) :: err
1492  TYPE(varying_string), INTENT(OUT) :: error
1493  !Local Variables
1494  INTEGER(INTG) :: equations_set_idx,solver_matrix_idx
1495  TYPE(equations_set_type), POINTER :: equations_set
1496  TYPE(solver_type), POINTER :: cellml_solver,linking_solver
1497  TYPE(solver_equations_type), POINTER :: solver_equations
1498  TYPE(solver_mapping_type), POINTER :: solver_mapping
1499  TYPE(solver_matrices_type), POINTER :: solver_matrices
1500  TYPE(solver_matrix_type), POINTER :: solver_matrix
1501 
1502  TYPE(varying_string) :: local_error
1503 
1504  NULLIFY(cellml_solver)
1505  NULLIFY(linking_solver)
1506 
1507  enters("PROBLEM_SOLVER_RESIDUAL_EVALUATE",err,error,*999)
1508 
1509  IF(ASSOCIATED(solver)) THEN
1510  IF(solver%SOLVER_FINISHED) THEN
1511  solver_equations=>solver%SOLVER_EQUATIONS
1512  IF(ASSOCIATED(solver_equations)) THEN
1513  solver_mapping=>solver_equations%SOLVER_MAPPING
1514  IF(ASSOCIATED(solver_mapping)) THEN
1515  IF(solver%OUTPUT_TYPE>=solver_matrix_output) THEN
1516  solver_matrices=>solver_equations%SOLVER_MATRICES
1517  IF(ASSOCIATED(solver_matrices)) THEN
1518  CALL write_string(general_output_type,"",err,error,*999)
1519  CALL write_string(general_output_type,"Solver vector values:",err,error,*999)
1520  DO solver_matrix_idx=1,solver_matrices%NUMBER_OF_MATRICES
1521  solver_matrix=>solver_matrices%MATRICES(solver_matrix_idx)%PTR
1522  IF(ASSOCIATED(solver_matrix)) THEN
1523  CALL write_string_value(general_output_type,"Solver matrix : ",solver_matrix_idx,err,error,*999)
1524  CALL distributed_vector_output(general_output_type,solver_matrix%SOLVER_VECTOR,err,error,*999)
1525  ELSE
1526  local_error="Solver matrix is not associated for solver matrix index "// &
1527  & trim(number_to_vstring(solver_matrix_idx,"*",err,error))//"."
1528  CALL flagerror(local_error,err,error,*999)
1529  ENDIF
1530  ENDDO !solver_matrix_idx
1531  ELSE
1532  CALL flagerror("Solver equations solver matrices is not associated.",err,error,*999)
1533  ENDIF
1534  ENDIF
1535  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
1536  !Check if the nonlinear solver is linked to a dynamic solver
1537  linking_solver=>solver%LINKING_SOLVER
1538  IF(ASSOCIATED(linking_solver)) THEN
1539  IF(linking_solver%SOLVE_TYPE==solver_dynamic_type) THEN
1540  !Update the field values from the dynamic factor*current solver values AND add in predicted displacements
1541  CALL solver_variables_dynamic_nonlinear_update(solver,err,error,*999)
1542  !Caculate the strain field for an CellML evaluator solver
1543  CALL problem_pre_residual_evaluate(solver,err,error,*999)
1544  !check for a linked CellML solver
1545 
1546 !!TODO: This should be generalised for nonlinear solvers in general and not just Newton solvers.
1547  SELECT CASE(solver%NONLINEAR_SOLVER%NONLINEAR_SOLVE_TYPE)
1548  CASE(solver_nonlinear_newton)
1549  cellml_solver=>solver%NONLINEAR_SOLVER%NEWTON_SOLVER%CELLML_EVALUATOR_SOLVER
1550  CASE(solver_nonlinear_quasi_newton)
1551  cellml_solver=>solver%NONLINEAR_SOLVER%QUASI_NEWTON_SOLVER%CELLML_EVALUATOR_SOLVER
1552  CASE DEFAULT
1553  local_error="Linked CellML solver is not implemented for nonlinear solver type " &
1554  & //trim(number_to_vstring(solver%NONLINEAR_SOLVER%NONLINEAR_SOLVE_TYPE,"*",err,error))//"."
1555  CALL flagerror(local_error,err,error,*999)
1556  END SELECT
1557  IF(ASSOCIATED(cellml_solver)) CALL solver_solve(cellml_solver,err,error,*999)
1558  !Calculate the residual for each element (M, C, K and g)
1559  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
1560  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
1561  SELECT CASE(equations_set%EQUATIONS%LINEARITY)
1562  CASE(equations_linear)
1563  !Assemble the equations for linear equations
1564  CALL equations_set_assemble(equations_set,err,error,*999)
1565  CASE(equations_nonlinear)
1566  !Evaluate the residual for nonlinear equations
1567  CALL equations_set_residual_evaluate(equations_set,err,error,*999)
1568  END SELECT
1569  ENDDO !equations_set_idx
1570  !Assemble the final solver residual.
1571  CALL solver_matrices_dynamic_assemble(solver,solver_matrices_rhs_residual_only,err,error,*999)
1572  ELSE
1573  CALL flagerror("Solver equations linking solver mapping is not dynamic.",err,error,*999)
1574  END IF
1575  ELSE
1576  !Perform as normal nonlinear solver
1577  !Copy the current solution vector to the dependent field
1578  CALL solver_variables_field_update(solver,err,error,*999)
1579  !Caculate the strain field for an CellML evaluator solver
1580  CALL problem_pre_residual_evaluate(solver,err,error,*999)
1581  !check for a linked CellML solver
1582 !!TODO: This should be generalised for nonlinear solvers in general and not just Newton solvers.
1583  SELECT CASE(solver%NONLINEAR_SOLVER%NONLINEAR_SOLVE_TYPE)
1584  CASE(solver_nonlinear_newton)
1585  cellml_solver=>solver%NONLINEAR_SOLVER%NEWTON_SOLVER%CELLML_EVALUATOR_SOLVER
1586  CASE(solver_nonlinear_quasi_newton)
1587  cellml_solver=>solver%NONLINEAR_SOLVER%QUASI_NEWTON_SOLVER%CELLML_EVALUATOR_SOLVER
1588  CASE DEFAULT
1589  local_error="Linked CellML solver is not implemented for nonlinear solver type " &
1590  & //trim(number_to_vstring(solver%NONLINEAR_SOLVER%NONLINEAR_SOLVE_TYPE,"*",err,error))//"."
1591  CALL flagerror(local_error,err,error,*999)
1592  END SELECT
1593  IF(ASSOCIATED(cellml_solver)) CALL solver_solve(cellml_solver,err,error,*999)
1594  !Make sure the equations sets are up to date
1595  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
1596  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
1597  SELECT CASE(equations_set%EQUATIONS%LINEARITY)
1598  CASE(equations_linear)
1599  !Assemble the equations for linear equations
1600  CALL equations_set_assemble(equations_set,err,error,*999)
1601  CASE(equations_nonlinear)
1602  !Evaluate the residual for nonlinear equations
1603  CALL equations_set_residual_evaluate(equations_set,err,error,*999)
1604  END SELECT
1605  ENDDO !equations_set_idx
1606  !Note that the linear interface matrices are not required to be updated since these matrices do not change
1607  !Update interface matrices
1608 ! DO interfaceConditionIdx=1,SOLVER_MAPPING%NUMBER_OF_INTERFACE_CONDITIONS
1609 ! interfaceCondition=>SOLVER_MAPPING%INTERFACE_CONDITIONS(interfaceConditionIdx)%PTR
1610 ! !Assemble the interface condition for the Jacobian LHS
1611 ! CALL WRITE_STRING(GENERAL_OUTPUT_TYPE,"********************Residual evaluation******************",ERR,ERROR,*999)
1612 ! CALL INTERFACE_CONDITION_ASSEMBLE(interfaceCondition,err,error,*999)
1613 ! ENDDO
1614  !Assemble the solver matrices
1615  CALL solver_matrices_static_assemble(solver,solver_matrices_rhs_residual_only,err,error,*999)
1616  END IF
1617  ELSE
1618  CALL flagerror("Solver equations solver type is not associated.",err,error,*999)
1619  END IF
1620  ELSE
1621  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
1622  ENDIF
1623  ELSE
1624  CALL flagerror("Solver solver equations mapping is not associated.",err,error,*999)
1625  ENDIF
1626  CALL problem_post_residual_evaluate(solver,err,error,*999)
1627  ELSE
1628  CALL flagerror("Solver has not been finished.",err,error,*999)
1629  ENDIF
1630  ELSE
1631  CALL flagerror("Solver is not associated.",err,error,*999)
1632  ENDIF
1633 
1634  exits("PROBLEM_SOLVER_RESIDUAL_EVALUATE")
1635  RETURN
1636 999 errorsexits("PROBLEM_SOLVER_RESIDUAL_EVALUATE",err,error)
1637  RETURN 1
1638 
1639  END SUBROUTINE problem_solver_residual_evaluate
1640 
1641  !
1642  !================================================================================================================================
1643  !
1644 
1646  SUBROUTINE problem_pre_residual_evaluate(SOLVER,ERR,ERROR,*)
1647 
1648  !Argument variables
1649  TYPE(solver_type), POINTER :: solver
1650  INTEGER(INTG), INTENT(OUT) :: err
1651  TYPE(varying_string), INTENT(OUT) :: error
1652  !Local Variables
1653  INTEGER(INTG) :: equations_set_idx
1654  TYPE(equations_set_type), POINTER :: equations_set
1655  TYPE(equations_type), POINTER :: equations
1656  TYPE(solver_equations_type), POINTER :: solver_equations
1657  TYPE(solver_mapping_type), POINTER :: solver_mapping
1658  TYPE(varying_string) :: local_error
1659 
1660  enters("PROBLEM_PRE_RESIDUAL_EVALUATE",err,error,*999)
1661 
1662  IF(ASSOCIATED(solver)) THEN
1663  IF(solver%SOLVER_FINISHED) THEN
1664  solver_equations=>solver%SOLVER_EQUATIONS
1665  IF(ASSOCIATED(solver_equations)) THEN
1666  solver_mapping=>solver_equations%SOLVER_MAPPING
1667  IF(ASSOCIATED(solver_mapping)) THEN
1668  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
1669  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
1670  IF(ASSOCIATED(equations_set)) THEN
1671  equations=>equations_set%EQUATIONS
1672  IF(ASSOCIATED(equations)) THEN
1673  IF(equations%EQUATIONS_FINISHED) THEN
1674  SELECT CASE(equations%LINEARITY)
1675  CASE(equations_linear)
1676  CALL flagerror("Can not pre-evaluate a residual for linear equations.",err,error,*999)
1677  CASE(equations_nonlinear)
1678  SELECT CASE(equations%TIME_DEPENDENCE)
1679  CASE(equations_static,equations_quasistatic,equations_first_order_dynamic) ! quasistatic handled like static
1680  SELECT CASE(equations_set%SOLUTION_METHOD)
1681  CASE(equations_set_fem_solution_method)
1682  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
1683  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
1684  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<1) THEN
1685  CALL flagerror("Equations set specification must have at least one entry.",err,error,*999)
1686  ENDIF
1687  SELECT CASE(equations_set%specification(1))
1688  CASE(equations_set_elasticity_class)
1689  CALL elasticity_finiteelementpreresidualevaluate(equations_set,err,error,*999)
1690  CASE(equations_set_fluid_mechanics_class)
1691  CALL fluidmechanics_finiteelementpreresidualevaluate(equations_set,err,error,*999)
1692  CASE(equations_set_electromagnetics_class)
1693  !Pre residual evaluate not used
1694  CASE(equations_set_classical_field_class)
1695  !Pre residual evaluate not used
1696  CASE(equations_set_bioelectrics_class)
1697  !Pre residual evaluate not used
1698  CASE(equations_set_modal_class)
1699  !Pre residual evaluate not used
1700  CASE(equations_set_multi_physics_class)
1701  !Pre residual evaluate not used
1702  CASE DEFAULT
1703  local_error="The first equations set specification of "// &
1704  & trim(numbertovstring(equations_set%specification(1),"*",err,error))//" is not valid."
1705  CALL flagerror(local_error,err,error,*999)
1706  END SELECT !EQUATIONS_SET%SPECIFICATION(1)
1707  CASE(equations_set_nodal_solution_method)
1708  SELECT CASE(equations_set%SPECIFICATION(1))
1709  CASE(equations_set_fluid_mechanics_class)
1710  !Pre residual evaluate not used
1711  CASE DEFAULT
1712  local_error="The first equations set specification of "// &
1713  & trim(numbertovstring(equations_set%SPECIFICATION(1),"*",err,error))//" is not valid."
1714  CALL flag_error(local_error,err,error,*999)
1715  END SELECT !EQUATIONS_SET%SPECIFICATION(1)
1716  CASE(equations_set_bem_solution_method)
1717  CALL flagerror("Not implemented.",err,error,*999)
1718  CASE(equations_set_fd_solution_method)
1719  CALL flagerror("Not implemented.",err,error,*999)
1720  CASE(equations_set_fv_solution_method)
1721  CALL flagerror("Not implemented.",err,error,*999)
1722  CASE(equations_set_gfem_solution_method)
1723  CALL flagerror("Not implemented.",err,error,*999)
1724  CASE(equations_set_gfv_solution_method)
1725  CALL flagerror("Not implemented.",err,error,*999)
1726  CASE DEFAULT
1727  local_error="The equations set solution method of "// &
1728  & trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1729  & " is invalid."
1730  CALL flagerror(local_error,err,error,*999)
1731  END SELECT !EQUATIONS_SET%SOLUTION_METHOD
1732  CASE(equations_second_order_dynamic)
1733  CALL flagerror("Not implemented.",err,error,*999)
1734  CASE(equations_time_stepping)
1735  CALL flagerror("Not implemented.",err,error,*999)
1736  CASE DEFAULT
1737  local_error="The equations set time dependence type of "// &
1738  & trim(number_to_vstring(equations%TIME_DEPENDENCE,"*",err,error))//" is invalid."
1739  CALL flagerror(local_error,err,error,*999)
1740  END SELECT
1741  CASE(equations_nonlinear_bcs)
1742  CALL flagerror("Not implemented.",err,error,*999)
1743  CASE DEFAULT
1744  local_error="The equations linearity of "// &
1745  & trim(number_to_vstring(equations%LINEARITY,"*",err,error))//" is invalid."
1746  CALL flagerror(local_error,err,error,*999)
1747  END SELECT
1748  ELSE
1749  CALL flagerror("Equations have not been finished.",err,error,*999)
1750  ENDIF
1751  ELSE
1752  CALL flagerror("Equations set equations is not associated.",err,error,*999)
1753  ENDIF
1754  ELSE
1755  CALL flagerror("Equations set is not associated.",err,error,*999)
1756  ENDIF
1757  ENDDO !equations_set_idx
1758  ELSE
1759  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
1760  ENDIF
1761  ELSE
1762  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
1763  ENDIF
1764  ELSE
1765  CALL flagerror("Solver has not been finished.",err,error,*999)
1766  ENDIF
1767  ELSE
1768  CALL flagerror("Solver is not associated.",err,error,*999)
1769  ENDIF
1770 
1771  exits("PROBLEM_PRE_RESIDUAL_EVALUATE")
1772  RETURN
1773 999 errorsexits("PROBLEM_PRE_RESIDUAL_EVALUATE",err,error)
1774  RETURN 1
1775 
1776  END SUBROUTINE problem_pre_residual_evaluate
1777 
1778  !
1779  !================================================================================================================================
1780  !
1781 
1783  SUBROUTINE problem_post_residual_evaluate(SOLVER,ERR,ERROR,*)
1784 
1785  !Argument variables
1786  TYPE(solver_type), POINTER :: solver
1787  INTEGER(INTG), INTENT(OUT) :: err
1788  TYPE(varying_string), INTENT(OUT) :: error
1789  !Local Variables
1790  INTEGER(INTG) :: equations_set_idx
1791  TYPE(equations_set_type), POINTER :: equations_set
1792  TYPE(equations_type), POINTER :: equations
1793  TYPE(solver_equations_type), POINTER :: solver_equations
1794  TYPE(solver_mapping_type), POINTER :: solver_mapping
1795  TYPE(varying_string) :: local_error
1796 
1797  enters("PROBLEM_POST_RESIDUAL_EVALUATE",err,error,*999)
1798 
1799  IF(ASSOCIATED(solver)) THEN
1800  IF(solver%SOLVER_FINISHED) THEN
1801  solver_equations=>solver%SOLVER_EQUATIONS
1802  IF(ASSOCIATED(solver_equations)) THEN
1803  solver_mapping=>solver_equations%SOLVER_MAPPING
1804  IF(ASSOCIATED(solver_mapping)) THEN
1805  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
1806  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
1807  IF(ASSOCIATED(equations_set)) THEN
1808  equations=>equations_set%EQUATIONS
1809  IF(ASSOCIATED(equations)) THEN
1810  IF(equations%EQUATIONS_FINISHED) THEN
1811  SELECT CASE(equations%LINEARITY)
1812  CASE(equations_linear)
1813  CALL flagerror("Can not post-evaluate a residual for linear equations.",err,error,*999)
1814  CASE(equations_nonlinear)
1815  SELECT CASE(equations%TIME_DEPENDENCE)
1816  CASE(equations_static,equations_quasistatic,equations_first_order_dynamic) ! quasistatic handled like static
1817  SELECT CASE(equations_set%SOLUTION_METHOD)
1818  CASE(equations_set_fem_solution_method)
1819  IF(.NOT.ALLOCATED(equations_set%SPECIFICATION)) THEN
1820  CALL flagerror("Equations set specification is not allocated.",err,error,*999)
1821  ELSE IF(SIZE(equations_set%SPECIFICATION,1)<1) THEN
1822  CALL flagerror("Equations set specification must have at least one entry.",err,error,*999)
1823  END IF
1824  SELECT CASE(equations_set%SPECIFICATION(1))
1825  CASE(equations_set_elasticity_class)
1826  CALL elasticity_finiteelementpostresidualevaluate(equations_set,err,error,*999)
1827  CASE(equations_set_fluid_mechanics_class)
1828  !Post residual evaluate not used
1829  CASE(equations_set_electromagnetics_class)
1830  !Post residual evaluate not used
1831  CASE(equations_set_classical_field_class)
1832  !Post residual evaluate not used
1833  CASE(equations_set_bioelectrics_class)
1834  !Post residual evaluate not used
1835  CASE(equations_set_modal_class)
1836  !Post residual evaluate not used
1837  CASE(equations_set_multi_physics_class)
1838  !Post residual evaluate not used
1839  CASE DEFAULT
1840  local_error="The first equations set specification of "// &
1841  & trim(numbertovstring(equations_set%SPECIFICATION(1),"*",err,error))//" is not valid."
1842  CALL flag_error(local_error,err,error,*999)
1843  END SELECT !EQUATIONS_SET%SPECIFICATION(1)
1844  CASE(equations_set_nodal_solution_method)
1845  SELECT CASE(equations_set%SPECIFICATION(1))
1846  CASE(equations_set_fluid_mechanics_class)
1847  !Post residual evaluate not used
1848  CASE DEFAULT
1849  local_error="The first equations set specification of "// &
1850  & trim(numbertovstring(equations_set%specification(1),"*",err,error))// &
1851  & " is not valid with the nodal solution method."
1852  CALL flag_error(local_error,err,error,*999)
1853  END SELECT !EQUATIONS_SET%SPECIFICATION(1)
1854  CASE(equations_set_bem_solution_method)
1855  CALL flagerror("Not implemented.",err,error,*999)
1856  CASE(equations_set_fd_solution_method)
1857  CALL flagerror("Not implemented.",err,error,*999)
1858  CASE(equations_set_fv_solution_method)
1859  CALL flagerror("Not implemented.",err,error,*999)
1860  CASE(equations_set_gfem_solution_method)
1861  CALL flagerror("Not implemented.",err,error,*999)
1862  CASE(equations_set_gfv_solution_method)
1863  CALL flagerror("Not implemented.",err,error,*999)
1864  CASE DEFAULT
1865  local_error="The equations set solution method of "// &
1866  & trim(number_to_vstring(equations_set%SOLUTION_METHOD,"*",err,error))// &
1867  & " is invalid."
1868  CALL flagerror(local_error,err,error,*999)
1869  END SELECT !EQUATIONS_SET%SOLUTION_METHOD
1870  CASE(equations_second_order_dynamic)
1871  CALL flagerror("Not implemented.",err,error,*999)
1872  CASE(equations_time_stepping)
1873  CALL flagerror("Not implemented.",err,error,*999)
1874  CASE DEFAULT
1875  local_error="The equations set time dependence type of "// &
1876  & trim(number_to_vstring(equations%TIME_DEPENDENCE,"*",err,error))//" is invalid."
1877  CALL flagerror(local_error,err,error,*999)
1878  END SELECT
1879  CASE(equations_nonlinear_bcs)
1880  CALL flagerror("Not implemented.",err,error,*999)
1881  CASE DEFAULT
1882  local_error="The equations linearity of "// &
1883  & trim(number_to_vstring(equations%LINEARITY,"*",err,error))//" is invalid."
1884  CALL flagerror(local_error,err,error,*999)
1885  END SELECT
1886  ELSE
1887  CALL flagerror("Equations have not been finished.",err,error,*999)
1888  ENDIF
1889  ELSE
1890  CALL flagerror("Equations set equations is not associated.",err,error,*999)
1891  ENDIF
1892  ELSE
1893  CALL flagerror("Equations set is not associated.",err,error,*999)
1894  ENDIF
1895  ENDDO !equations_set_idx
1896  ELSE
1897  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
1898  ENDIF
1899  ELSE
1900  CALL flagerror("Solver solver equations is not associated.",err,error,*999)
1901  ENDIF
1902  ELSE
1903  CALL flagerror("Solver has not been finished.",err,error,*999)
1904  ENDIF
1905  ELSE
1906  CALL flagerror("Solver is not associated.",err,error,*999)
1907  ENDIF
1908 
1909  exits("PROBLEM_POST_RESIDUAL_EVALUATE")
1910  RETURN
1911 999 errorsexits("PROBLEM_POST_RESIDUAL_EVALUATE",err,error)
1912  RETURN 1
1913 
1914  END SUBROUTINE problem_post_residual_evaluate
1915 
1916  !
1917  !================================================================================================================================
1918  !
1919 
1921  SUBROUTINE problem_solvers_create_finish(PROBLEM,ERR,ERROR,*)
1922 
1923  !Argument variables
1924  TYPE(problem_type), POINTER :: problem
1925  INTEGER(INTG), INTENT(OUT) :: err
1926  TYPE(varying_string), INTENT(OUT) :: error
1927  !Local Variables
1928  TYPE(problem_setup_type) :: problem_setup_info
1929 
1930  enters("PROBLEM_SOLVERS_CREATE_FINISH",err,error,*999)
1931 
1932  IF(ASSOCIATED(problem)) THEN
1933  !Initialise the problem setup information
1934  CALL problem_setup_initialise(problem_setup_info,err,error,*999)
1935  problem_setup_info%SETUP_TYPE=problem_setup_solvers_type
1936  problem_setup_info%ACTION_TYPE=problem_setup_finish_action
1937  !Finish the problem specific solvers setup.
1938  CALL problem_setup(problem,problem_setup_info,err,error,*999)
1939  !Finalise the problem setup information
1940  CALL problem_setup_finalise(problem_setup_info,err,error,*999)
1941  ELSE
1942  CALL flagerror("Problem is not associated.",err,error,*999)
1943  ENDIF
1944 
1945  exits("PROBLEM_SOLVERS_CREATE_FINISH")
1946  RETURN
1947 999 errorsexits("PROBLEM_SOLVERS_CREATE_FINISH",err,error)
1948  RETURN 1
1949  END SUBROUTINE problem_solvers_create_finish
1950 
1951  !
1952  !================================================================================================================================
1953  !
1954 
1956  SUBROUTINE problem_solvers_create_start(PROBLEM,ERR,ERROR,*)
1957 
1958  !Argument variables
1959  TYPE(problem_type), POINTER :: problem
1960  INTEGER(INTG), INTENT(OUT) :: err
1961  TYPE(varying_string), INTENT(OUT) :: error
1962  !Local Variables
1963  TYPE(problem_setup_type) :: problem_setup_info
1964 
1965  enters("PROBLEM_SOLVERS_CREATE_START",err,error,*999)
1966 
1967  IF(ASSOCIATED(problem)) THEN
1968  !Initialise the problem setup information
1969  CALL problem_setup_initialise(problem_setup_info,err,error,*999)
1970  problem_setup_info%SETUP_TYPE=problem_setup_solvers_type
1971  problem_setup_info%ACTION_TYPE=problem_setup_start_action
1972  !Start the problem specific solvers setup
1973  CALL problem_setup(problem,problem_setup_info,err,error,*999)
1974  !Finalise the problem setup information
1975  CALL problem_setup_finalise(problem_setup_info,err,error,*999)
1976  ELSE
1977  CALL flagerror("Problem is not associated.",err,error,*999)
1978  ENDIF
1979 
1980  exits("PROBLEM_SOLVERS_CREATE_START")
1981  RETURN
1982 999 errorsexits("PROBLEM_SOLVERS_CREATE_START",err,error)
1983  RETURN 1
1984  END SUBROUTINE problem_solvers_create_start
1985 
1986  !
1987  !================================================================================================================================
1988  !
1989 
1991  SUBROUTINE problem_solve(PROBLEM,ERR,ERROR,*)
1992 
1993  !Argument variables
1994  TYPE(problem_type), POINTER :: problem
1995  INTEGER(INTG), INTENT(OUT) :: err
1996  TYPE(varying_string), INTENT(OUT) :: error
1997  !Local Variables
1998  TYPE(control_loop_type), POINTER :: control_loop
1999 
2000  enters("PROBLEM_SOLVE",err,error,*999)
2001 
2002  IF(ASSOCIATED(problem)) THEN
2003  IF(problem%PROBLEM_FINISHED) THEN
2004  control_loop=>problem%CONTROL_LOOP
2005  IF(ASSOCIATED(control_loop)) THEN
2006  CALL problem_control_loop_solve(control_loop,err,error,*999)
2007  ELSE
2008  CALL flagerror("Problem control loop is not associated.",err,error,*999)
2009  ENDIF
2010  ELSE
2011  CALL flagerror("Problem has not been finished.",err,error,*999)
2012  ENDIF
2013  ELSE
2014  CALL flagerror("Problem is not associated",err,error,*999)
2015  ENDIF
2016 
2017  exits("PROBLEM_SOLVE")
2018  RETURN
2019 999 errorsexits("PROBLEM_SOLVE",err,error)
2020  RETURN 1
2021  END SUBROUTINE problem_solve
2022 
2023  !
2024  !================================================================================================================================
2025  !
2026 
2028  SUBROUTINE problem_solver_load_increment_apply(SOLVER_EQUATIONS,ITERATION_NUMBER,MAXIMUM_NUMBER_OF_ITERATIONS,ERR,ERROR,*)
2029 
2030  !Argument variables
2031  TYPE(solver_equations_type), POINTER :: solver_equations
2032  INTEGER(INTG), INTENT(IN) :: iteration_number
2033  INTEGER(INTG), INTENT(IN) :: maximum_number_of_iterations
2034  INTEGER(INTG), INTENT(OUT) :: err
2035  TYPE(varying_string), INTENT(OUT) :: error
2036  !Local variables
2037  TYPE(solver_mapping_type), POINTER :: solver_mapping
2038  TYPE(equations_set_type), POINTER :: equations_set
2039  INTEGER(INTG) :: equations_set_idx
2040 
2041  enters("PROBLEM_SOLVER_LOAD_INCREMENT_APPLY",err,error,*999)
2042 
2043  IF(ASSOCIATED(solver_equations)) THEN
2044  solver_mapping=>solver_equations%SOLVER_MAPPING
2045  IF(ASSOCIATED(solver_mapping)) THEN
2046  !Make sure the equations sets are up to date
2047  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
2048  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
2049  CALL equations_set_load_increment_apply(equations_set,solver_equations%BOUNDARY_CONDITIONS,iteration_number, &
2050  & maximum_number_of_iterations,err,error,*999)
2051  ENDDO !equations_set_idx
2052  ELSE
2053  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
2054  ENDIF
2055  ELSE
2056  CALL flagerror("Solver equations is not associated.",err,error,*999)
2057  ENDIF
2058 
2059  exits("PROBLEM_SOLVER_LOAD_INCREMENT_APPLY")
2060  RETURN
2061 999 errorsexits("PROBLEM_SOLVER_LOAD_INCREMENT_APPLY",err,error)
2062  RETURN 1
2063 
2064  END SUBROUTINE problem_solver_load_increment_apply
2065 
2066  !
2067  !================================================================================================================================
2068  !
2069 
2071  SUBROUTINE problem_control_loop_pre_loop(CONTROL_LOOP,ERR,ERROR,*)
2072 
2073  !Argument variables
2074  TYPE(control_loop_type), POINTER :: control_loop
2075  INTEGER(INTG), INTENT(OUT) :: err
2076  TYPE(varying_string), INTENT(OUT) :: error
2077  !Local Variables
2078  TYPE(varying_string) :: local_error
2079 
2080  enters("PROBLEM_CONTROL_LOOP_PRE_LOOP",err,error,*999)
2081 
2082  IF(ASSOCIATED(control_loop)) THEN
2083  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
2084  !For all time loops, update the previous values from the current values
2085  IF(control_loop%LOOP_TYPE==problem_control_time_loop_type) THEN
2086  CALL problem_control_loop_previous_values_update(control_loop,err,error,*999)
2087  ENDIF
2088  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
2089  CALL flagerror("Problem specification is not allocated.",err,error,*999)
2090  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<1) THEN
2091  CALL flagerror("Problem specification must have at least one entry.",err,error,*999)
2092  END IF
2093  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(1))
2094  CASE(problem_elasticity_class)
2095  CALL elasticity_control_loop_pre_loop(control_loop,err,error,*999)
2096  CASE(problem_bioelectrics_class)
2097  !do nothing
2098  CASE(problem_fluid_mechanics_class)
2099  CALL fluid_mechanics_control_loop_pre_loop(control_loop,err,error,*999)
2100  CASE(problem_electromagnetics_class)
2101  !do nothing
2102  CASE(problem_classical_field_class)
2103  !do nothing
2104  CASE(problem_fitting_class)
2105  !do nothing
2106  CASE(problem_modal_class)
2107  !do nothing
2108  CASE(problem_multi_physics_class)
2109  CALL multi_physics_control_loop_pre_loop(control_loop,err,error,*999)
2110  CASE DEFAULT
2111  local_error="Problem class "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(1),"*",err,error))//" &
2112  & is not valid."
2113  CALL flagerror(local_error,err,error,*999)
2114  END SELECT
2115  ELSE
2116  CALL flagerror("Problem is not associated.",err,error,*999)
2117  ENDIF
2118  ELSE
2119  CALL flagerror("Control loop is not associated.",err,error,*999)
2120  ENDIF
2121  exits("PROBLEM_CONTROL_LOOP_PRE_LOOP")
2122  RETURN
2123 999 errorsexits("PROBLEM_CONTROL_LOOP_PRE_LOOP",err,error)
2124  RETURN 1
2125  END SUBROUTINE problem_control_loop_pre_loop
2126 
2127  !
2128  !================================================================================================================================
2129  !
2130 
2132  SUBROUTINE problem_control_loop_post_loop(CONTROL_LOOP,ERR,ERROR,*)
2133 
2134  !Argument variables
2135  TYPE(control_loop_type), POINTER :: control_loop
2136  INTEGER(INTG), INTENT(OUT) :: err
2137  TYPE(varying_string), INTENT(OUT) :: error
2138  !Local Variables
2139  TYPE(varying_string) :: local_error
2140 
2141  enters("PROBLEM_CONTROL_LOOP_POST_LOOP",err,error,*999)
2142 
2143  IF(ASSOCIATED(control_loop)) THEN
2144  IF(ASSOCIATED(control_loop%PROBLEM)) THEN
2145  IF(.NOT.ALLOCATED(control_loop%PROBLEM%SPECIFICATION)) THEN
2146  CALL flagerror("Problem specification is not allocated.",err,error,*999)
2147  ELSE IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<1) THEN
2148  CALL flagerror("Problem specification must have at least one entry.",err,error,*999)
2149  ENDIF
2150  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(1))
2151  CASE(problem_elasticity_class)
2152  CALL elasticity_controllooppostloop(control_loop,err,error,*999)
2153  CASE(problem_bioelectrics_class)
2154  CALL bioelectric_control_loop_post_loop(control_loop,err,error,*999)
2155  CASE(problem_fluid_mechanics_class)
2156  CALL fluid_mechanics_control_loop_post_loop(control_loop,err,error,*999)
2157  CASE(problem_electromagnetics_class)
2158  !Do nothing
2159  CASE(problem_classical_field_class)
2160  IF(SIZE(control_loop%PROBLEM%SPECIFICATION,1)<2) THEN
2161  CALL flagerror("Problem specification must have at least two entries.",err,error,*999)
2162  ENDIF
2163  CALL classical_field_control_loop_post_loop(control_loop,err,error,*999)
2164  SELECT CASE(control_loop%PROBLEM%SPECIFICATION(2))
2165  CASE(problem_reaction_diffusion_equation_type)
2166  CALL reaction_diffusion_control_loop_post_loop(control_loop,err,error,*999)
2167  CASE DEFAULT
2168  !do nothing
2169  END SELECT
2170  CASE(problem_fitting_class)
2171  !Do nothing
2172  CASE(problem_modal_class)
2173  !Do nothing
2174  CASE(problem_multi_physics_class)
2175  CALL multi_physics_control_loop_post_loop(control_loop,err,error,*999)
2176  CASE DEFAULT
2177  local_error="The first problem specification of "// &
2178  & trim(numbertovstring(control_loop%problem%specification(1),"*",err,error))// &
2179  & " is not valid."
2180  CALL flagerror(local_error,err,error,*999)
2181  END SELECT
2182  ELSE
2183  CALL flagerror("Problem is not associated.",err,error,*999)
2184  ENDIF
2185  ELSE
2186  CALL flagerror("Control loop is not associated.",err,error,*999)
2187  ENDIF
2188 
2189  exits("PROBLEM_CONTROL_LOOP_POST_LOOP")
2190  RETURN
2191 999 errorsexits("PROBLEM_CONTROL_LOOP_POST_LOOP",err,error)
2192  RETURN 1
2193 
2194  END SUBROUTINE problem_control_loop_post_loop
2195 
2196  !
2197  !================================================================================================================================
2198  !
2199 
2201  SUBROUTINE problem_solver_pre_solve(SOLVER,ERR,ERROR,*)
2202 
2203  !Argument variables
2204  TYPE(solver_type), POINTER :: solver
2205  INTEGER(INTG), INTENT(OUT) :: err
2206  TYPE(varying_string), INTENT(OUT) :: error
2207  !Local Variables
2208  TYPE(control_loop_type), POINTER :: control_loop
2209  TYPE(problem_type), POINTER :: problem
2210  TYPE(solvers_type), POINTER :: solvers
2211  TYPE(varying_string) :: local_error
2212 
2213  enters("PROBLEM_SOLVER_PRE_SOLVE",err,error,*999)
2214 
2215  IF(ASSOCIATED(solver)) THEN
2216  solvers=>solver%SOLVERS
2217  IF(ASSOCIATED(solvers)) THEN
2218  control_loop=>solvers%CONTROL_LOOP
2219  IF(ASSOCIATED(control_loop)) THEN
2220  problem=>control_loop%PROBLEM
2221  IF(ASSOCIATED(problem)) THEN
2222  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
2223  CALL flagerror("Problem specification is not allocated.",err,error,*999)
2224  ELSE IF(SIZE(problem%SPECIFICATION,1)<1) THEN
2225  CALL flagerror("Problem specification must have at least one entry.",err,error,*999)
2226  END IF
2227  SELECT CASE(problem%SPECIFICATION(1))
2228  CASE(problem_elasticity_class)
2229  CALL elasticity_pre_solve(control_loop,solver,err,error,*999)
2230  CASE(problem_bioelectrics_class)
2231  CALL bioelectric_pre_solve(solver,err,error,*999)
2232  CASE(problem_fluid_mechanics_class)
2233  CALL fluid_mechanics_pre_solve(control_loop,solver,err,error,*999)
2234  CASE(problem_electromagnetics_class)
2235  !Do nothing???
2236  CASE(problem_classical_field_class)
2237  CALL classical_field_pre_solve(control_loop,solver,err,error,*999)
2238  CASE(problem_fitting_class)
2239  CALL fitting_pre_solve(control_loop,solver,err,error,*999)
2240  CASE(problem_modal_class)
2241  !Do nothing???
2242  CASE(problem_multi_physics_class)
2243  CALL multi_physics_pre_solve(control_loop,solver,err,error,*999)
2244  CASE DEFAULT
2245  local_error="The problem class of "//trim(number_to_vstring(problem%SPECIFICATION(1),"*",err,error))//" &
2246  & is invalid."
2247  CALL flagerror(local_error,err,error,*999)
2248  END SELECT
2249  ELSE
2250  CALL flagerror("Control loop problem is not associated.",err,error,*999)
2251  ENDIF
2252  ELSE
2253  CALL flagerror("Solvers control loop is not associated.",err,error,*999)
2254  ENDIF
2255  ELSE
2256  CALL flagerror("Solver solvers is not associated.",err,error,*999)
2257  ENDIF
2258  ELSE
2259  CALL flagerror("Solver is not associated.",err,error,*999)
2260  ENDIF
2261 
2262  exits("PROBLEM_SOLVER_PRE_SOLVE")
2263  RETURN
2264 999 errorsexits("PROBLEM_SOLVER_PRE_SOLVE",err,error)
2265  RETURN 1
2266  END SUBROUTINE problem_solver_pre_solve
2267 
2268  !
2269  !================================================================================================================================
2270  !
2271 
2273  SUBROUTINE problem_solver_post_solve(SOLVER,ERR,ERROR,*)
2274 
2275  !Argument variables
2276  TYPE(solver_type), POINTER :: solver
2277  INTEGER(INTG), INTENT(OUT) :: err
2278  TYPE(varying_string), INTENT(OUT) :: error
2279  !Local Variables
2280  TYPE(control_loop_type), POINTER :: control_loop
2281  TYPE(problem_type), POINTER :: problem
2282  TYPE(solvers_type), POINTER :: solvers
2283  TYPE(varying_string) :: local_error
2284 
2285  enters("PROBLEM_SOLVER_POST_SOLVE",err,error,*999)
2286 
2287  IF(ASSOCIATED(solver)) THEN
2288  solvers=>solver%SOLVERS
2289  IF(ASSOCIATED(solvers)) THEN
2290  control_loop=>solvers%CONTROL_LOOP
2291  IF(ASSOCIATED(control_loop)) THEN
2292  problem=>control_loop%PROBLEM
2293  IF(ASSOCIATED(problem)) THEN
2294  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
2295  CALL flagerror("Problem specification is not allocated.",err,error,*999)
2296  ELSE IF(SIZE(problem%SPECIFICATION,1)<1) THEN
2297  CALL flagerror("Problem specification must have at least one entry.",err,error,*999)
2298  END IF
2299  SELECT CASE(problem%SPECIFICATION(1))
2300  CASE(problem_elasticity_class)
2301  CALL elasticity_post_solve(control_loop,solver,err,error,*999)
2302  CASE(problem_bioelectrics_class)
2303  CALL bioelectric_post_solve(solver,err,error,*999)
2304  CASE(problem_fluid_mechanics_class)
2305  CALL fluid_mechanics_post_solve(control_loop,solver,err,error,*999)
2306  CASE(problem_electromagnetics_class)
2307  !Do nothing???
2308  CASE(problem_classical_field_class)
2309 
2310  CALL classical_field_post_solve(control_loop,solver,err,error,*999)
2311  CASE(problem_fitting_class)
2312  CALL fitting_post_solve(control_loop,solver,err,error,*999)
2313  CASE(problem_modal_class)
2314  !Do nothing???
2315  CASE(problem_multi_physics_class)
2316  CALL multi_physics_post_solve(control_loop,solver,err,error,*999)
2317  CASE DEFAULT
2318  local_error="The problem class of "//trim(number_to_vstring(control_loop%PROBLEM%SPECIFICATION(1),"*",err,error))//" &
2319  & is invalid."
2320  CALL flagerror(local_error,err,error,*999)
2321  END SELECT
2322  ELSE
2323  CALL flagerror("Control loop problem is not associated.",err,error,*999)
2324  ENDIF
2325  ELSE
2326  CALL flagerror("Solvers control loop is not associated.",err,error,*999)
2327  ENDIF
2328  ELSE
2329  CALL flagerror("Solver solvers is not associated.",err,error,*999)
2330  ENDIF
2331  ELSE
2332  CALL flagerror("Solver is not associated.",err,error,*999)
2333  ENDIF
2334 
2335  exits("PROBLEM_SOLVER_POST_SOLVE")
2336  RETURN
2337 999 errorsexits("PROBLEM_SOLVER_POST_SOLVE",err,error)
2338  RETURN 1
2339 
2340  END SUBROUTINE problem_solver_post_solve
2341 
2342  !
2343  !================================================================================================================================
2344  !
2345 
2347  SUBROUTINE problem_solver_equations_solve(SOLVER_EQUATIONS,ERR,ERROR,*)
2348 
2349  !Argument variables
2350  TYPE(solver_equations_type), POINTER :: solver_equations
2351  INTEGER(INTG), INTENT(OUT) :: err
2352  TYPE(varying_string), INTENT(OUT) :: error
2353  !Local Variables
2354  TYPE(varying_string) :: local_error
2355 
2356  enters("PROBLEM_SOLVER_EQUATIONS_SOLVE",err,error,*999)
2357 
2358  IF(ASSOCIATED(solver_equations)) THEN
2359  IF(solver_equations%SOLVER_EQUATIONS_FINISHED) THEN
2360  SELECT CASE(solver_equations%TIME_DEPENDENCE)
2361  CASE(solver_equations_static)
2362  SELECT CASE(solver_equations%LINEARITY)
2363  CASE(solver_equations_linear)
2364  CALL problem_solverequationsstaticlinearsolve(solver_equations,err,error,*999)
2365  CASE(solver_equations_nonlinear)
2366  CALL problem_solverequationsstaticnonlinearsolve(solver_equations,err,error,*999)
2367  CASE DEFAULT
2368  local_error="The solver equations linearity of "//trim(number_to_vstring(solver_equations%LINEARITY,"*",err,error))// &
2369  & " is invalid."
2370  CALL flagerror(local_error,err,error,*999)
2371  END SELECT
2372  CASE(solver_equations_quasistatic)
2373  SELECT CASE(solver_equations%LINEARITY)
2374  CASE(solver_equations_linear)
2375  CALL problem_solverequationsquasistaticlinearsolve(solver_equations,err,error,*999)
2376  CASE(solver_equations_nonlinear)
2377  CALL problem_solverequationsquasistaticnonlinearsolve(solver_equations,err,error,*999)
2378  CASE DEFAULT
2379  local_error="The solver equations linearity of "//trim(number_to_vstring(solver_equations%LINEARITY,"*",err,error))// &
2380  & " is invalid."
2381  CALL flagerror(local_error,err,error,*999)
2382  END SELECT
2383  CASE(solver_equations_first_order_dynamic,solver_equations_second_order_dynamic)
2384  SELECT CASE(solver_equations%LINEARITY)
2385  CASE(solver_equations_linear)
2386  CALL problem_solverequationsdynamiclinearsolve(solver_equations,err,error,*999)
2387  CASE(solver_equations_nonlinear)
2388  CALL problem_solverequationsdynamicnonlinearsolve(solver_equations,err,error,*999)
2389  CASE DEFAULT
2390  local_error="The solver equations linearity of "//trim(number_to_vstring(solver_equations%LINEARITY,"*",err,error))// &
2391  & " is invalid."
2392  CALL flagerror(local_error,err,error,*999)
2393  END SELECT
2394  CASE DEFAULT
2395  local_error="The solver equations time dependence type of "// &
2396  & trim(number_to_vstring(solver_equations%TIME_DEPENDENCE,"*",err,error))//" is invalid."
2397  CALL flagerror(local_error,err,error,*999)
2398  END SELECT
2399  ELSE
2400  CALL flagerror("Solver equations have not been finished.",err,error,*999)
2401  ENDIF
2402  ELSE
2403  CALL flagerror("Solver equations is not associated.",err,error,*999)
2404  ENDIF
2405 
2406  exits("PROBLEM_SOLVER_EQUATIONS_SOLVE")
2407  RETURN
2408 999 errorsexits("PROBLEM_SOLVER_EQUATIONS_SOLVE",err,error)
2409  RETURN 1
2410  END SUBROUTINE problem_solver_equations_solve
2411 
2412  !
2413  !================================================================================================================================
2414  !
2415 
2417  SUBROUTINE problem_solverequationsdynamiclinearsolve(SOLVER_EQUATIONS,ERR,ERROR,*)
2418 
2419  !Argument variables
2420  TYPE(solver_equations_type), POINTER :: solver_equations
2421  INTEGER(INTG), INTENT(OUT) :: err
2422  TYPE(varying_string), INTENT(OUT) :: error
2423  !Local Variables
2424  INTEGER(INTG) :: equations_set_idx,loop_idx
2425  REAL(DP) :: current_time,time_increment
2426  TYPE(control_loop_type), POINTER :: control_loop,control_time_loop
2427  TYPE(equations_set_type), POINTER :: equations_set
2428  TYPE(solver_type), POINTER :: solver
2429  TYPE(solver_mapping_type), POINTER :: solver_mapping
2430  TYPE(solvers_type), POINTER :: solvers
2431 
2432  enters("Problem_SolverEquationsDynamicLinearSolve",err,error,*999)
2433 
2434  IF(ASSOCIATED(solver_equations)) THEN
2435  solver=>solver_equations%SOLVER
2436  IF(ASSOCIATED(solver)) THEN
2437  solvers=>solver%SOLVERS
2438  IF(ASSOCIATED(solvers)) THEN
2439  control_loop=>solvers%CONTROL_LOOP
2440  IF(ASSOCIATED(control_loop)) THEN
2441  solver_mapping=>solver_equations%SOLVER_MAPPING
2442  IF(ASSOCIATED(solver_mapping)) THEN
2443  !Make sure the equations sets are up to date
2444  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
2445  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
2446  !Assemble the equations for linear problems
2447  CALL equations_set_assemble(equations_set,err,error,*999)
2448  ENDDO !equations_set_idx
2449  !Get current control loop times. The control loop may be a sub loop below a time loop, so iterate up
2450  !through loops checking for the time loop
2451  control_time_loop=>control_loop
2452  DO loop_idx=1,control_loop%CONTROL_LOOP_LEVEL
2453  IF(control_time_loop%LOOP_TYPE==problem_control_time_loop_type) THEN
2454  CALL control_loop_current_times_get(control_time_loop,current_time,time_increment,err,error,*999)
2455  EXIT
2456  ENDIF
2457  IF(ASSOCIATED(control_loop%PARENT_LOOP)) THEN
2458  control_time_loop=>control_time_loop%PARENT_LOOP
2459  ELSE
2460  CALL flagerror("Could not find a time control loop.",err,error,*999)
2461  ENDIF
2462  ENDDO
2463  !Set the solver time
2464  CALL solver_dynamic_times_set(solver,current_time,time_increment,err,error,*999)
2465  !Solve for the next time i.e., current time + time increment
2466  CALL solver_solve(solver,err,error,*999)
2467  !Back-substitute to find flux values for linear problems
2468  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
2469  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
2470  CALL equations_set_backsubstitute(equations_set,solver_equations%BOUNDARY_CONDITIONS,err,error,*999)
2471  ENDDO !equations_set_idx
2472  ELSE
2473  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
2474  ENDIF
2475  ELSE
2476  CALL flagerror("Solvers control loop is not associated.",err,error,*999)
2477  ENDIF
2478  ELSE
2479  CALL flagerror("Solver solvers is not associated.",err,error,*999)
2480  ENDIF
2481  ELSE
2482  CALL flagerror("Solver equations solver is not associated.",err,error,*999)
2483  ENDIF
2484  ELSE
2485  CALL flagerror("Solver equations is not associated.",err,error,*999)
2486  ENDIF
2487 
2488  exits("Problem_SolverEquationsDynamicLinearSolve")
2489  RETURN
2490 999 errorsexits("Problem_SolverEquationsDynamicLinearSolve",err,error)
2491  RETURN 1
2492 
2493  END SUBROUTINE problem_solverequationsdynamiclinearsolve
2494 
2495  !
2496  !================================================================================================================================
2497  !
2498 
2500  SUBROUTINE problem_solverequationsdynamicnonlinearsolve(SOLVER_EQUATIONS,ERR,ERROR,*)
2501 
2502  !Argument variables
2503  TYPE(solver_equations_type), POINTER :: solver_equations
2504  INTEGER(INTG), INTENT(OUT) :: err
2505  TYPE(varying_string), INTENT(OUT) :: error
2506  !Local Variables
2507  INTEGER(INTG) :: equations_set_idx,loop_idx,interface_condition_idx
2508  REAL(DP) :: current_time,time_increment
2509  TYPE(control_loop_type), POINTER :: control_loop,control_time_loop
2510  TYPE(equations_type), POINTER :: equations
2511  TYPE(equations_set_type), POINTER :: equations_set
2512  TYPE(interface_condition_type), POINTER :: interface_condition
2513  TYPE(solver_type), POINTER :: solver
2514  TYPE(dynamic_solver_type), POINTER :: dynamic_solver
2515  TYPE(solver_mapping_type), POINTER :: solver_mapping
2516  TYPE(solvers_type), POINTER :: solvers
2517  TYPE(varying_string) :: local_error
2518 
2519  enters("Problem_SolverEquationsDynamicNonlinearSolve",err,error,*999)
2520 
2521  IF(ASSOCIATED(solver_equations)) THEN
2522  solver=>solver_equations%SOLVER
2523  IF(ASSOCIATED(solver)) THEN
2524  dynamic_solver=>solver%DYNAMIC_SOLVER
2525  IF(ASSOCIATED(dynamic_solver)) THEN
2526  solvers=>solver%SOLVERS
2527  IF(ASSOCIATED(solver)) THEN
2528  control_loop=>solvers%CONTROL_LOOP
2529  IF(ASSOCIATED(control_loop)) THEN
2530  solver_mapping=>solver_equations%SOLVER_MAPPING
2531  IF(ASSOCIATED(solver_mapping)) THEN
2532  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
2533  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
2534  IF(dynamic_solver%RESTART.OR..NOT.dynamic_solver%SOLVER_INITIALISED) then!.OR.DYNAMIC_SOLVER%FSI) THEN
2535  !If we need to restart or we haven't initialised yet or we have an FSI scheme, make sure the equations sets are up to date
2536  equations=>equations_set%EQUATIONS
2537  IF(ASSOCIATED(equations)) THEN
2538  SELECT CASE(equations%LINEARITY)
2539  CASE(equations_linear)
2540  !Assemble the equations
2541  CALL equations_set_assemble(equations_set,err,error,*999)
2542  CASE(equations_nonlinear)
2543  !Evaluate the residuals
2544  CALL equations_set_residual_evaluate(equations_set,err,error,*999)
2545  CASE(equations_nonlinear_bcs)
2546  CALL flagerror("Not implemented.",err,error,*999)
2547  CASE DEFAULT
2548  local_error="The equations linearity type of "// &
2549  & trim(number_to_vstring(equations%LINEARITY,"*",err,error))// &
2550  & " is invalid."
2551  CALL flagerror(local_error,err,error,*999)
2552  END SELECT
2553  ELSE
2554  CALL flagerror("Equations set equations is not associated.",err,error,*999)
2555  ENDIF
2556  ENDIF
2557  ENDDO !equations_set_idx
2558  !Make sure the interface matrices are up to date
2559  DO interface_condition_idx=1,solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS
2560  interface_condition=>solver_mapping%INTERFACE_CONDITIONS(interface_condition_idx)%PTR
2561  CALL interface_condition_assemble(interface_condition,err,error,*999)
2562  ENDDO !interface_condition_idx
2563  !Get current control loop times. The control loop may be a sub loop below a time loop, so iterate up
2564  !through loops checking for the time loop
2565  control_time_loop=>control_loop
2566  DO loop_idx=1,control_loop%CONTROL_LOOP_LEVEL
2567  IF(control_time_loop%LOOP_TYPE==problem_control_time_loop_type) THEN
2568  CALL control_loop_current_times_get(control_time_loop,current_time,time_increment,err,error,*999)
2569  EXIT
2570  ENDIF
2571  IF(ASSOCIATED(control_loop%PARENT_LOOP)) THEN
2572  control_time_loop=>control_time_loop%PARENT_LOOP
2573  ELSE
2574  CALL flagerror("Could not find a time control loop.",err,error,*999)
2575  ENDIF
2576  ENDDO
2577  !Set the solver time
2578  CALL solver_dynamic_times_set(solver,current_time,time_increment,err,error,*999)
2579  !Solve for the next time i.e., current time + time increment
2580  CALL solver_solve(solver,err,error,*999)
2581  ELSE
2582  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
2583  ENDIF
2584  ELSE
2585  CALL flagerror("Solvers control loop is not associated.",err,error,*999)
2586  ENDIF
2587  ELSE
2588  CALL flagerror("Solver solvers is not associated.",err,error,*999)
2589  ENDIF
2590  ELSE
2591  CALL flagerror("Solver dynamic solver is not associated.",err,error,*999)
2592  ENDIF
2593  ELSE
2594  CALL flagerror("Solver equations solver is not associated.",err,error,*999)
2595  ENDIF
2596  ELSE
2597  CALL flagerror("Solver equations is not associated.",err,error,*999)
2598  ENDIF
2599 
2600  exits("Problem_SolverEquationsDynamicNonlinearSolve")
2601  RETURN
2602 999 errors("Problem_SolverEquationsDynamicNonlinearSolve",err,error)
2603  exits("Problem_SolverEquationsDynamicNonlinearSolve")
2604  RETURN 1
2605 
2606  END SUBROUTINE problem_solverequationsdynamicnonlinearsolve
2607 
2608  !
2609  !================================================================================================================================
2610  !
2611 
2613  SUBROUTINE problem_solverequationsquasistaticlinearsolve(SOLVER_EQUATIONS,ERR,ERROR,*)
2614 
2615  !Argument variables
2616  TYPE(solver_equations_type), POINTER :: solver_equations
2617  INTEGER(INTG), INTENT(OUT) :: err
2618  TYPE(varying_string), INTENT(OUT) :: error
2619  !Local Variables
2620  INTEGER(INTG) :: equations_set_idx
2621 ! REAL(DP) :: CURRENT_TIME,TIME_INCREMENT
2622  TYPE(control_loop_type), POINTER :: control_loop
2623  TYPE(equations_set_type), POINTER :: equations_set
2624  TYPE(solver_type), POINTER :: solver
2625  TYPE(solver_mapping_type), POINTER :: solver_mapping
2626  TYPE(solvers_type), POINTER :: solvers
2627 
2628  enters("Problem_SolverEquationsQuasistaticLinearSolve",err,error,*999)
2629 
2630  IF(ASSOCIATED(solver_equations)) THEN
2631  solver=>solver_equations%SOLVER
2632  IF(ASSOCIATED(solver)) THEN
2633  solvers=>solver%SOLVERS
2634  IF(ASSOCIATED(solvers)) THEN
2635  control_loop=>solvers%CONTROL_LOOP
2636  IF(ASSOCIATED(control_loop)) THEN
2637  solver_mapping=>solver_equations%SOLVER_MAPPING
2638  IF(ASSOCIATED(solver_mapping)) THEN
2639  !Make sure the equations sets are up to date
2640  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
2641  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
2642  !CALL EQUATIONS_SET_FIXED_CONDITIONS_APPLY(EQUATIONS_SET,ERR,ERROR,*999)
2643  !Assemble the equations for linear problems
2644  CALL equations_set_assemble(equations_set,err,error,*999)
2645  ENDDO !equations_set_idx
2646 ! !Get current control loop times
2647 ! CALL CONTROL_LOOP_CURRENT_TIMES_GET(CONTROL_LOOP,CURRENT_TIME,TIME_INCREMENT,ERR,ERROR,*999)
2648  !Solve for the current time
2649  CALL solver_solve(solver,err,error,*999)
2650  !Back-substitute to find flux values for linear problems
2651  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
2652  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
2653  CALL equations_set_backsubstitute(equations_set,solver_equations%BOUNDARY_CONDITIONS,err,error,*999)
2654  ENDDO !equations_set_idx
2655  ELSE
2656  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
2657  ENDIF
2658  ELSE
2659  CALL flagerror("Solvers control loop is not associated.",err,error,*999)
2660  ENDIF
2661  ELSE
2662  CALL flagerror("Solver solvers is not associated.",err,error,*999)
2663  ENDIF
2664  ELSE
2665  CALL flagerror("Solver equations solver is not associated.",err,error,*999)
2666  ENDIF
2667  ELSE
2668  CALL flagerror("Solver equations is not associated.",err,error,*999)
2669  ENDIF
2670 
2671  exits("Problem_SolverEquationsQuasistaticLinearSolve")
2672  RETURN
2673 999 errors("Problem_SolverEquationsQuasistaticLinearSolve",err,error)
2674  exits("Problem_SolverEquationsQuasistaticLinearSolve")
2675  RETURN 1
2676 
2677  END SUBROUTINE problem_solverequationsquasistaticlinearsolve
2678 
2679  !
2680  !================================================================================================================================
2681  !
2682 
2684  SUBROUTINE problem_solverequationsquasistaticnonlinearsolve(SOLVER_EQUATIONS,ERR,ERROR,*)
2685 
2686  !Argument variables
2687  TYPE(solver_equations_type), POINTER :: solver_equations
2688  INTEGER(INTG), INTENT(OUT) :: err
2689  TYPE(varying_string), INTENT(OUT) :: error
2690  !Local Variables
2691  INTEGER(INTG) :: equations_set_idx
2692  TYPE(control_loop_type), POINTER :: control_loop
2693  TYPE(equations_set_type), POINTER :: equations_set
2694  TYPE(solver_type), POINTER :: solver
2695  TYPE(solver_mapping_type), POINTER :: solver_mapping
2696  TYPE(solvers_type), POINTER :: solvers
2697 
2698  enters("Problem_SolverEquationsQuasistaticNonlinearSolve",err,error,*999)
2699 
2700  IF(ASSOCIATED(solver_equations)) THEN
2701  solver=>solver_equations%SOLVER
2702  IF(ASSOCIATED(solver)) THEN
2703  solvers=>solver%SOLVERS
2704  IF(ASSOCIATED(solvers)) THEN
2705  control_loop=>solvers%CONTROL_LOOP
2706  IF(ASSOCIATED(control_loop)) THEN
2707  solver_mapping=>solver_equations%SOLVER_MAPPING
2708  IF(ASSOCIATED(solver_mapping)) THEN
2709  !Make sure the equations sets are up to date
2710  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
2711  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
2712  !CALL EQUATIONS_SET_FIXED_CONDITIONS_APPLY(EQUATIONS_SET,ERR,ERROR,*999)
2713  !Assemble the equations for linear problems
2714  CALL equations_set_assemble(equations_set,err,error,*999)
2715  ENDDO !equations_set_idx
2716  ! sander - this gives an error, and current time seems to be updated without it
2717  !Get current control loop times
2718  !CALL CONTROL_LOOP_CURRENT_TIMES_GET(CONTROL_LOOP,CURRENT_TIME,TIME_INCREMENT,ERR,ERROR,*999)
2719  !Set the solver time
2720  !CALL SOLVER_DYNAMIC_TIMES_SET(SOLVER,CURRENT_TIME,TIME_INCREMENT,ERR,ERROR,*999)
2721  !Solve for the next time i.e., current time + time increment
2722  CALL solver_solve(solver,err,error,*999)
2723  ELSE
2724  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
2725  ENDIF
2726  ELSE
2727  CALL flagerror("Solvers control loop is not associated.",err,error,*999)
2728  ENDIF
2729  ELSE
2730  CALL flagerror("Solver solvers is not associated.",err,error,*999)
2731  ENDIF
2732  ELSE
2733  CALL flagerror("Solver equations solver is not associated.",err,error,*999)
2734  ENDIF
2735  ELSE
2736  CALL flagerror("Solver equations is not associated.",err,error,*999)
2737  ENDIF
2738 
2739  exits("Problem_SolverEquationsQuasistaticNonlinearSolve")
2740  RETURN
2741 999 errors("Problem_SolverEquationsQuasistaticNonlinearSolve",err,error)
2742  exits("Problem_SolverEquationsQuasistaticNonlinearSolve")
2743  RETURN 1
2744 
2745  END SUBROUTINE problem_solverequationsquasistaticnonlinearsolve
2746 
2747  !
2748  !================================================================================================================================
2749  !
2750 
2752  SUBROUTINE problem_solverequationsstaticlinearsolve(SOLVER_EQUATIONS,ERR,ERROR,*)
2753 
2754  !Argument variables
2755  TYPE(solver_equations_type), POINTER :: solver_equations
2756  INTEGER(INTG), INTENT(OUT) :: err
2757  TYPE(varying_string), INTENT(OUT) :: error
2758  !Local Variables
2759  INTEGER(INTG) :: equations_set_idx,interface_condition_idx
2760  TYPE(equations_set_type), POINTER :: equations_set
2761  TYPE(interface_condition_type), POINTER :: interface_condition
2762  TYPE(solver_type), POINTER :: solver
2763  TYPE(solver_mapping_type), POINTER :: solver_mapping
2764 
2765 #ifdef TAUPROF
2766  CHARACTER(12) :: cvar
2767  INTEGER :: phase(2) = [ 0, 0 ]
2768  SAVE phase
2769 #endif
2770 
2771  enters("Problem_SolverEquationsStaticLinearSolve",err,error,*999)
2772 
2773  IF(ASSOCIATED(solver_equations)) THEN
2774  solver=>solver_equations%SOLVER
2775  IF(ASSOCIATED(solver)) THEN
2776  solver_mapping=>solver_equations%SOLVER_MAPPING
2777  IF(ASSOCIATED(solver_mapping)) THEN
2778  !Make sure the equations sets are up to date
2779  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
2780 #ifdef TAUPROF
2781  WRITE (cvar,'(a8,i2)') 'Assemble',equations_set_idx
2782  CALL tau_phase_create_dynamic(phase,cvar)
2783  CALL tau_phase_start(phase)
2784 #endif
2785  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
2786  !CALL EQUATIONS_SET_FIXED_CONDITIONS_APPLY(EQUATIONS_SET,ERR,ERROR,*999)
2787  !Assemble the equations for linear problems
2788  CALL equations_set_assemble(equations_set,err,error,*999)
2789 #ifdef TAUPROF
2790  CALL tau_phase_stop(phase)
2791 #endif
2792  ENDDO !equations_set_idx
2793  !Make sure the interface matrices are up to date
2794  DO interface_condition_idx=1,solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS
2795 #ifdef TAUPROF
2796  WRITE (cvar,'(a8,i2)') 'Interface',interface_condition_idx
2797  CALL tau_phase_create_dynamic(phase,cvar)
2798  CALL tau_phase_start(phase)
2799 #endif
2800  interface_condition=>solver_mapping%INTERFACE_CONDITIONS(interface_condition_idx)%PTR
2801  CALL interface_condition_assemble(interface_condition,err,error,*999)
2802 #ifdef TAUPROF
2803  CALL tau_phase_stop(phase)
2804 #endif
2805  ENDDO !interface_condition_idx
2806 
2807  !Solve
2808  CALL solver_solve(solver,err,error,*999)
2809 
2810 #ifdef TAUPROF
2811  CALL tau_static_phase_start('EQUATIONS_SET_BACKSUBSTITUTE()')
2812 #endif
2813  !Back-substitute to find flux values for linear problems
2814  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
2815  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
2816  CALL equations_set_backsubstitute(equations_set,solver_equations%BOUNDARY_CONDITIONS,err,error,*999)
2817  ENDDO !equations_set_idx
2818 #ifdef TAUPROF
2819  CALL tau_static_phase_stop('EQUATIONS_SET_BACKSUBSTITUTE()')
2820 #endif
2821  ELSE
2822  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
2823  ENDIF
2824  ELSE
2825  CALL flagerror("Solver equations solver is not associated.",err,error,*999)
2826  ENDIF
2827  ELSE
2828  CALL flagerror("Solver equations is not associated.",err,error,*999)
2829  ENDIF
2830 
2831  exits("Problem_SolverEquationsStaticLinearSolve")
2832  RETURN
2833 999 errorsexits("Problem_SolverEquationsStaticLinearSolve",err,error)
2834  RETURN 1
2835 
2836  END SUBROUTINE problem_solverequationsstaticlinearsolve
2837 
2838  !
2839  !================================================================================================================================
2840  !
2841 
2843  SUBROUTINE problem_solverequationsstaticnonlinearsolve(SOLVER_EQUATIONS,ERR,ERROR,*)
2844 
2845  !Argument variables
2846  TYPE(solver_equations_type), POINTER :: solver_equations
2847  INTEGER(INTG), INTENT(OUT) :: err
2848  TYPE(varying_string), INTENT(OUT) :: error
2849  !Local Variables
2850  INTEGER(INTG) :: equations_set_idx,interface_condition_idx
2851  TYPE(equations_set_type), POINTER :: equations_set
2852  TYPE(equations_type), POINTER :: equations
2853  TYPE(interface_condition_type), POINTER :: interface_condition
2854  TYPE(solver_type), POINTER :: solver
2855  TYPE(solver_mapping_type), POINTER :: solver_mapping
2856 
2857 #ifdef TAUPROF
2858  CHARACTER(12) :: cvar
2859  INTEGER :: phase(2) = [ 0, 0 ]
2860  SAVE phase
2861 #endif
2862  enters("Problem_SolverEquationsStaticNonlinearSolve",err,error,*999)
2863 
2864  IF(ASSOCIATED(solver_equations)) THEN
2865  solver=>solver_equations%SOLVER
2866  IF(ASSOCIATED(solver)) THEN
2867  solver_mapping=>solver_equations%SOLVER_MAPPING
2868  IF(ASSOCIATED(solver_mapping)) THEN
2869  !Apply boundary conditition
2870  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
2871  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
2872  !Assemble the equations set
2873  CALL equations_set_assemble(equations_set,err,error,*999)
2874  ENDDO !equations_set_idx
2875  !Make sure the interface matrices are up to date
2876  DO interface_condition_idx=1,solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS
2877 #ifdef TAUPROF
2878  WRITE (cvar,'(a8,i2)') 'Interface',interface_condition_idx
2879  CALL tau_phase_create_dynamic(phase,cvar)
2880  CALL tau_phase_start(phase)
2881 #endif
2882  interface_condition=>solver_mapping%INTERFACE_CONDITIONS(interface_condition_idx)%PTR
2883  CALL interface_condition_assemble(interface_condition,err,error,*999)
2884 #ifdef TAUPROF
2885  CALL tau_phase_stop(phase)
2886 #endif
2887  ENDDO !interface_condition_idx
2888  !Solve
2889  CALL solver_solve(solver,err,error,*999)
2890  !Update the rhs field variable with residuals or backsubstitute for any linear
2891  !equations sets
2892  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
2893  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
2894  equations=>equations_set%EQUATIONS
2895  IF(ASSOCIATED(equations)) THEN
2896  SELECT CASE(equations%LINEARITY)
2897  CASE(equations_linear,equations_nonlinear_bcs)
2898  CALL equations_set_backsubstitute(equations_set,solver_equations%BOUNDARY_CONDITIONS,err,error,*999)
2899  CASE(equations_nonlinear)
2900  CALL equations_set_nonlinear_rhs_update(equations_set,solver_equations%BOUNDARY_CONDITIONS,err,error,*999)
2901  CASE DEFAULT
2902  CALL flagerror("Invalid linearity for equations set equations",err,error,*999)
2903  END SELECT
2904  ELSE
2905  CALL flagerror("Equations set equations is not associated.",err,error,*999)
2906  ENDIF
2907  ENDDO !equations_set_idx
2908  ELSE
2909  CALL flagerror("Solver equations solver mapping not associated.",err,error,*999)
2910  ENDIF
2911  ELSE
2912  CALL flagerror("Solver equations solver is not associated.",err,error,*999)
2913  ENDIF
2914  ELSE
2915  CALL flagerror("Solver equations is not associated.",err,error,*999)
2916  ENDIF
2917 
2918  exits("Problem_SolverEquationsStaticNonlinearSolve")
2919  RETURN
2920 999 errorsexits("Problem_SolverEquationsStaticNonlinearSolve",err,error)
2921  RETURN 1
2922 
2923  END SUBROUTINE problem_solverequationsstaticnonlinearsolve
2924 
2925  !
2926  !================================================================================================================================
2927  !
2928 
2929 
2931  SUBROUTINE problem_solver_solve(SOLVER,ERR,ERROR,*)
2932 
2933  !Argument variables
2934  TYPE(solver_type), POINTER :: solver
2935  INTEGER(INTG), INTENT(OUT) :: err
2936  TYPE(varying_string), INTENT(OUT) :: error
2937  !Local Variables
2938 
2939  enters("PROBLEM_SOLVER_SOLVE",err,error,*999)
2940 
2941  IF(ASSOCIATED(solver)) THEN
2942 
2943  IF(solver%OUTPUT_TYPE>=solver_progress_output) THEN
2944  CALL write_string(general_output_type,"",err,error,*999)
2945  CALL write_string_value(general_output_type,"Solver: ",solver%LABEL,err,error,*999)
2946  CALL write_string_value(general_output_type," Solver index = ",solver%GLOBAL_NUMBER,err,error,*999)
2947  ENDIF
2948 
2949 #ifdef TAUPROF
2950  CALL tau_static_phase_start('Pre solve')
2951 #endif
2952  CALL problem_solver_pre_solve(solver,err,error,*999)
2953 #ifdef TAUPROF
2954  CALL tau_static_phase_stop('Pre solve')
2955 
2956  CALL tau_static_phase_start('Solve')
2957 #endif
2958 
2959  IF(ASSOCIATED(solver%SOLVER_EQUATIONS)) THEN
2960  !A solver with solver equations.
2961  CALL problem_solver_equations_solve(solver%SOLVER_EQUATIONS,err,error,*999)
2962  ELSE
2963  !Check for other equations.
2964  IF(ASSOCIATED(solver%CELLML_EQUATIONS)) THEN
2965  !A solver with CellML equations.
2966  CALL problem_cellml_equations_solve(solver%CELLML_EQUATIONS,err,error,*999)
2967  ELSEIF(solver%SOLVE_TYPE==solver_geometric_transformation_type) THEN
2968  CALL problem_solvergeometrictransformationsolve(solver%geometricTransformationSolver,err,error,*999)
2969  ELSE
2970  CALL flagerror("Solver does not have any equations associated.",err,error,*999)
2971  ENDIF
2972  ENDIF
2973 
2974 #ifdef TAUPROF
2975  CALL tau_static_phase_stop('Solve')
2976 
2977  CALL tau_static_phase_start('Post solve')
2978 #endif
2979  CALL problem_solver_post_solve(solver,err,error,*999)
2980 #ifdef TAUPROF
2981  CALL tau_static_phase_stop('Post solve')
2982 #endif
2983 
2984  ELSE
2985  CALL flagerror("Solver is not associated.",err,error,*999)
2986  ENDIF
2987 
2988  exits("PROBLEM_SOLVER_SOLVE")
2989  RETURN
2990 999 errorsexits("PROBLEM_SOLVER_SOLVE",err,error)
2991  RETURN 1
2992 
2993  END SUBROUTINE problem_solver_solve
2994 
2995  !
2996  !================================================================================================================================
2997  !
2998 
3000  SUBROUTINE problem_solvers_destroy(PROBLEM,ERR,ERROR,*)
3001 
3002  !Argument variables
3003  TYPE(problem_type), POINTER :: problem
3004  INTEGER(INTG), INTENT(OUT) :: err
3005  TYPE(varying_string), INTENT(OUT) :: error
3006  !Local Variables
3007 
3008  enters("PROBLEM_SOLVERS_DESTROY",err,error,*999)
3009 
3010  IF(ASSOCIATED(problem)) THEN
3011  IF(ASSOCIATED(problem%CONTROL_LOOP)) THEN
3012  CALL control_loop_solvers_destroy(problem%CONTROL_LOOP,err,error,*999)
3013  ELSE
3014  CALL flagerror("Problem control loop is not associated.",err,error,*999)
3015  ENDIF
3016  ELSE
3017  CALL flagerror("Problem is not associated.",err,error,*999)
3018  ENDIF
3019 
3020  exits("PROBLEM_SOLVERS_DESTROY")
3021  RETURN
3022 999 errorsexits("PROBLEM_SOLVERS_DESTROY",err,error)
3023  RETURN 1
3024  END SUBROUTINE problem_solvers_destroy
3025 
3026  !
3027  !================================================================================================================================
3028  !
3029 
3031  SUBROUTINE problem_solverequationsboundaryconditionsanalytic(SOLVER_EQUATIONS,ERR,ERROR,*)
3032 
3033  !Argument variables
3034  TYPE(solver_equations_type), POINTER :: solver_equations
3035  INTEGER(INTG), INTENT(OUT) :: err
3036  TYPE(varying_string), INTENT(OUT) :: error
3037  !Local Variables
3038  INTEGER(INTG) :: equations_set_idx
3039  TYPE(boundary_conditions_type), POINTER :: boundary_conditions
3040  TYPE(solver_mapping_type), POINTER :: solver_mapping
3041  TYPE(equations_set_type), POINTER :: equations_set
3042 
3043  enters("Problem_SolverEquationsBoundaryConditionsAnalytic",err,error,*999)
3044 
3045  IF(ASSOCIATED(solver_equations)) THEN
3046  IF(solver_equations%SOLVER_EQUATIONS_FINISHED) THEN
3047  boundary_conditions=>solver_equations%BOUNDARY_CONDITIONS
3048  IF(ASSOCIATED(boundary_conditions)) THEN
3049  solver_mapping=>solver_equations%SOLVER_MAPPING
3050  IF(ASSOCIATED(solver_mapping)) THEN
3051  DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
3052  equations_set=>solver_mapping%EQUATIONS_SETS(equations_set_idx)%PTR
3053  IF(ASSOCIATED(equations_set)) THEN
3054  CALL equations_set_boundary_conditions_analytic(equations_set,boundary_conditions,err,error,*999)
3055  ELSE
3056  CALL flagerror("Equations set is not associated for index "//trim(number_to_vstring(equations_set_idx,"*", &
3057  & err,error))//".",err,error,*999)
3058  ENDIF
3059  ENDDO
3060  ELSE
3061  CALL flagerror("Solver equations solver mapping is not associated.",err,error,*999)
3062  ENDIF
3063  ELSE
3064  CALL flagerror("Solver equations boundary conditions are not associated.",err,error,*999)
3065  ENDIF
3066  ELSE
3067  CALL flagerror("Solver equations has not been finished.",err,error,*999)
3068  ENDIF
3069  ELSE
3070  CALL flagerror("Solver equations is not associated.",err,error,*999)
3071  ENDIF
3072 
3073  exits("Problem_SolverEquationsBoundaryConditionsAnalytic")
3074  RETURN
3075 999 errors("Problem_SolverEquationsBoundaryConditionsAnalytic",err,error)
3076  exits("Problem_SolverEquationsBoundaryConditionsAnalytic")
3077  RETURN 1
3078 
3079  END SUBROUTINE problem_solverequationsboundaryconditionsanalytic
3080 
3081  !
3082  !================================================================================================================================
3083  !
3084 
3086  SUBROUTINE problem_solver_equations_create_finish(PROBLEM,ERR,ERROR,*)
3087 
3088  !Argument variables
3089  TYPE(problem_type), POINTER :: problem
3090  INTEGER(INTG), INTENT(OUT) :: err
3091  TYPE(varying_string), INTENT(OUT) :: error
3092  !Local Variables
3093  TYPE(problem_setup_type) :: problem_setup_info
3094 
3095  enters("PROBLEM_SOLVER_EQUATIONS_CREATE_FINISH",err,error,*999)
3096 
3097  IF(ASSOCIATED(problem)) THEN
3098  !Initialise the problem setup information
3099  CALL problem_setup_initialise(problem_setup_info,err,error,*999)
3100  problem_setup_info%SETUP_TYPE=problem_setup_solver_equations_type
3101  problem_setup_info%ACTION_TYPE=problem_setup_finish_action
3102  !Finish problem specific startup
3103  CALL problem_setup(problem,problem_setup_info,err,error,*999)
3104  !Finalise the problem setup information
3105  CALL problem_setup_finalise(problem_setup_info,err,error,*999)
3106  ELSE
3107  CALL flagerror("Problem is not associated.",err,error,*999)
3108  ENDIF
3109 
3110  exits("PROBLEM_SOLVER_EQUATIONS_CREATE_FINISH")
3111  RETURN
3112 999 errorsexits("PROBLEM_SOLVER_EQUATIONS_CREATE_FINISH",err,error)
3113  RETURN 1
3114  END SUBROUTINE problem_solver_equations_create_finish
3115 
3116  !
3117  !================================================================================================================================
3118  !
3119 
3125  SUBROUTINE problem_solver_equations_create_start(PROBLEM,ERR,ERROR,*)
3126 
3127  !Argument variablesg
3128  TYPE(problem_type), POINTER :: problem
3129  INTEGER(INTG), INTENT(OUT) :: err
3130  TYPE(varying_string), INTENT(OUT) :: error
3131  !Local Variables
3132  TYPE(problem_setup_type) :: problem_setup_info
3133 
3134  enters("PROBLEM_SOLVER_EQUATIONS_CREATE_START",err,error,*999)
3135 
3136  IF(ASSOCIATED(problem)) THEN
3137  !Initialise the problem setup information
3138  CALL problem_setup_initialise(problem_setup_info,err,error,*999)
3139  problem_setup_info%SETUP_TYPE=problem_setup_solver_equations_type
3140  problem_setup_info%ACTION_TYPE=problem_setup_start_action
3141  !Start the problem specific control setup
3142  CALL problem_setup(problem,problem_setup_info,err,error,*999)
3143  !Finalise the problem setup information
3144  CALL problem_setup_finalise(problem_setup_info,err,error,*999)
3145  ELSE
3146  CALL flagerror("Problem is not associated.",err,error,*999)
3147  ENDIF
3148 
3149  exits("PROBLEM_SOLVER_EQUATIONS_CREATE_START")
3150  RETURN
3151 999 errorsexits("PROBLEM_SOLVER_EQUATIONS_CREATE_START",err,error)
3152  RETURN 1
3153  END SUBROUTINE problem_solver_equations_create_start
3154 
3155  !
3156  !================================================================================================================================
3157  !
3158 
3159  !!TODO: this should be removed - just call the solver equations destroy directly???
3160 
3162  SUBROUTINE problem_solver_equations_destroy(PROBLEM,ERR,ERROR,*)
3163 
3164  !Argument variables
3165  TYPE(problem_type), POINTER :: problem
3166  INTEGER(INTG), INTENT(OUT) :: err
3167  TYPE(varying_string), INTENT(OUT) :: error
3168  !Local Variables
3169  TYPE(control_loop_type), POINTER :: control_loop
3170 
3171  enters("PROBLEM_SOLVER_EQUATIONS_DESTROY",err,error,*999)
3172 
3173  IF(ASSOCIATED(problem)) THEN
3174  control_loop=>problem%CONTROL_LOOP
3175  IF(ASSOCIATED(control_loop)) THEN
3176  CALL control_loop_solver_equations_destroy(control_loop,err,error,*999)
3177  ELSE
3178  CALL flagerror("Problem control loop is not associated.",err,error,*999)
3179  ENDIF
3180  ELSE
3181  CALL flagerror("Problem is not associated.",err,error,*999)
3182  ENDIF
3183 
3184  exits("PROBLEM_SOLVER_EQUATIONS_DESTROY")
3185  RETURN
3186 999 errorsexits("PROBLEM_SOLVER_EQUATIONS_DESTROY",err,error)
3187  RETURN 1
3188  END SUBROUTINE problem_solver_equations_destroy
3189 
3190  !
3191  !================================================================================================================================
3192  !
3193 
3195  SUBROUTINE problem_solvergeometrictransformationsolve(geometricTransformationSolver,err,error,*) !\todo: Add rotation operations.
3196 
3197  !Argument variables
3198  TYPE(geometrictransformationsolvertype), POINTER :: geometrictransformationsolver
3199  INTEGER(INTG), INTENT(OUT) :: err
3200  TYPE(varying_string), INTENT(OUT) :: error
3201  !Local Variables
3202  TYPE(field_variable_type), POINTER :: fieldvariable
3203  TYPE(solver_type), POINTER :: solver
3204  TYPE(solvers_type), POINTER :: solvers
3205  TYPE(control_loop_type), POINTER :: controlloop
3206  TYPE(control_loop_load_increment_type), POINTER :: loadincrementloop
3207  TYPE(control_loop_simple_type), POINTER :: simpleloop
3208  TYPE(control_loop_fixed_type), POINTER :: fixedloop
3209  TYPE(control_loop_while_type), POINTER :: whileloop
3210  INTEGER(INTG) :: componentidx,versionidx,derivativeidx,nodeidx,nogeomcomp
3211  INTEGER(INTG) :: localnodenumber,usernodenumber,incrementidx,iterationnumber
3212  REAL(DP) :: nodalparameters(3),nodalparameterstrans(3),transformationmatrix(4,4)
3213  TYPE(domain_type), POINTER :: domain
3214  TYPE(domain_nodes_type), POINTER :: domainnodes
3215  LOGICAL :: transformbc=.false.,samebases=.true.
3216 
3217  enters("Problem_SolverGeometricTransformationSolve",err,error,*999)
3218 
3219  IF(ASSOCIATED(geometrictransformationsolver)) THEN
3220  IF(ASSOCIATED(geometrictransformationsolver%field)) THEN
3221  fieldvariable=>geometrictransformationsolver%field%VARIABLE_TYPE_MAP(geometrictransformationsolver%fieldVariableType)%PTR
3222  IF(ASSOCIATED(fieldvariable%PARAMETER_SETS%SET_TYPE(field_boundary_conditions_set_type)%PTR)) transformbc=.true. !if the BC is defined on the field variable to be transformed
3223  nogeomcomp=SIZE(geometrictransformationsolver%transformationMatrices,1)-1 ! Number of geometric components
3224  !**********************************************************************************************************************
3225  !Determine iteration/load increment number
3226  IF(geometrictransformationsolver%numberOfIncrements>1) THEN
3227  solver=>geometrictransformationsolver%solver
3228  IF(ASSOCIATED(solver)) THEN
3229  solvers=>solver%SOLVERS
3230  IF(ASSOCIATED(solvers)) THEN
3231  controlloop=>solvers%CONTROL_LOOP
3232  IF(ASSOCIATED(controlloop)) THEN
3233  SELECT CASE(controlloop%LOOP_TYPE)
3234  CASE(problem_control_simple_type)
3235  simpleloop=>controlloop%SIMPLE_LOOP
3236  IF(ASSOCIATED(simpleloop)) THEN
3237  iterationnumber=1
3238  ELSE
3239  CALL flagerror("Simple loop is not associated.",err,error,*999)
3240  ENDIF
3241  CASE(problem_control_fixed_loop_type)
3242  fixedloop=>controlloop%FIXED_LOOP
3243  IF(ASSOCIATED(fixedloop)) THEN
3244  iterationnumber=fixedloop%ITERATION_NUMBER
3245  ELSE
3246  CALL flagerror("Fixed loop is not associated.",err,error,*999)
3247  ENDIF
3248  CASE(problem_control_time_loop_type)
3249  CALL flagerror("Geometric transformation for time loop is not implemented.",err,error,*999)
3250  CASE(problem_control_while_loop_type)
3251  whileloop=>controlloop%WHILE_LOOP
3252  IF(ASSOCIATED(whileloop)) THEN
3253  iterationnumber=whileloop%ITERATION_NUMBER
3254  ELSE
3255  CALL flagerror("Simple loop is not associated.",err,error,*999)
3256  ENDIF
3257  CASE(problem_control_load_increment_loop_type)
3258  loadincrementloop=>controlloop%LOAD_INCREMENT_LOOP
3259  IF(ASSOCIATED(loadincrementloop)) THEN
3260  iterationnumber=loadincrementloop%ITERATION_NUMBER
3261  ELSE
3262  CALL flagerror("Load increment loop is not associated.",err,error,*999)
3263  ENDIF
3264  END SELECT
3265  IF(iterationnumber>geometrictransformationsolver%numberOfIncrements) THEN
3266  !If load increment is not specified for that iteration, loop around
3267  incrementidx=mod(iterationnumber-1,geometrictransformationsolver%numberOfIncrements)+1
3268  ELSE
3269  incrementidx=iterationnumber !If load increment is specified for that iteration, use that load increment
3270  ENDIF
3271  ELSE
3272  CALL flagerror("Control loop is not associated.",err,error,*999)
3273  ENDIF
3274  ELSE
3275  CALL flagerror("Solvers is not associated.",err,error,*999)
3276  ENDIF
3277  ELSE
3278  CALL flagerror("Solver is not associated.",err,error,*999)
3279  ENDIF
3280  ELSE
3281  incrementidx=1
3282  ENDIF
3283  !Determine the transformation matrix to use
3284  IF(geometrictransformationsolver%arbitraryPath .OR. geometrictransformationsolver%numberOfIncrements==1) THEN
3285  transformationmatrix(1:nogeomcomp+1,1:nogeomcomp+1)=geometrictransformationsolver%transformationMatrices &
3286  & (1:nogeomcomp+1,1:nogeomcomp+1,incrementidx)
3287  ELSE !If need to scale transformation matrix (i.e. transformation applied through several load increment.)
3288  IF(incrementidx==1) THEN ! 1st load increment, rotation is applied
3289  transformationmatrix(1:nogeomcomp,1:nogeomcomp)=geometrictransformationsolver%transformationMatrices &
3290  & (1:nogeomcomp,1:nogeomcomp,1)
3291  ELSE !No rotation operation in any other load increments
3292  DO componentidx=1,nogeomcomp
3293  transformationmatrix(componentidx,componentidx)=1.0_dp
3294  ENDDO !componentIdx
3295  ENDIF
3296  !Translation is scaled for every load increment
3297  IF(ALLOCATED(geometrictransformationsolver%scalings)) THEN
3298  transformationmatrix(1:nogeomcomp,nogeomcomp+1)=geometrictransformationsolver%transformationMatrices &
3299  & (1:nogeomcomp,nogeomcomp+1,1)*geometrictransformationsolver%scalings(incrementidx)
3300  ELSE !if no scaling just take 1/numberOfIncrements as scaling
3301  transformationmatrix(1:nogeomcomp,nogeomcomp+1)=geometrictransformationsolver%transformationMatrices &
3302  & (1:nogeomcomp,nogeomcomp+1,1)/geometrictransformationsolver%numberOfIncrements
3303  ENDIF
3304  ENDIF
3305  !**********************************************************************************************************************
3306  ! Transform the field
3307  ! Determine if the all components have the same mesh components/ bases
3308  DO componentidx=1,nogeomcomp-1
3309  IF(fieldvariable%COMPONENTS(componentidx)%MESH_COMPONENT_NUMBER/= &
3310  & fieldvariable%COMPONENTS(componentidx+1)%MESH_COMPONENT_NUMBER) samebases=.false.
3311  ENDDO
3312  IF(samebases) THEN
3313  domain=>fieldvariable%COMPONENTS(1)%DOMAIN !Use the 1st component domain since they are the same for all components
3314  IF(ASSOCIATED(domain)) THEN
3315  domainnodes=>domain%TOPOLOGY%NODES
3316  DO nodeidx=1,domainnodes%NUMBER_OF_NODES
3317  localnodenumber=domainnodes%NODES(nodeidx)%LOCAL_NUMBER
3318  usernodenumber=domainnodes%NODES(nodeidx)%USER_NUMBER
3319  DO derivativeidx=1,domainnodes%NODES(nodeidx)%NUMBER_OF_DERIVATIVES
3320  DO versionidx=1,domainnodes%NODES(nodeidx)%DERIVATIVES(derivativeidx)%numberOfVersions
3321  DO componentidx=1,nogeomcomp !Get all component for a nodal derivative
3322  CALL field_parameter_set_get_node(geometrictransformationsolver%field,geometrictransformationsolver% &
3323  & fieldvariabletype,field_values_set_type,versionidx,derivativeidx,usernodenumber,componentidx, &
3324  & nodalparameters(componentidx),err,error,*999)
3325  ENDDO !componentIdx
3326  !Rotate the nodal parameters
3327  usernodenumber=domainnodes%NODES(nodeidx)%USER_NUMBER
3328  nodalparameterstrans(1:nogeomcomp)=matmul(transformationmatrix(1:nogeomcomp,1:nogeomcomp), &
3329  & nodalparameters(1:nogeomcomp))
3330  DO componentidx=1,nogeomcomp !Update all component for a nodal derivative
3331  CALL field_parameter_set_update_node(geometrictransformationsolver%field,geometrictransformationsolver% &
3332  & fieldvariabletype,field_values_set_type,versionidx,derivativeidx,usernodenumber,componentidx, &
3333  & nodalparameterstrans(componentidx),err,error,*999)
3334  IF(derivativeidx==1) THEN ! Translate nodal coordinate
3335  CALL field_parameter_set_add_node(geometrictransformationsolver%field,geometrictransformationsolver% &
3336  & fieldvariabletype,field_values_set_type,versionidx,derivativeidx,usernodenumber,componentidx, &
3337  & transformationmatrix(componentidx,1+nogeomcomp),err,error,*999)
3338  ENDIF !derivativeIdx==1
3339  IF(transformbc) THEN
3340  CALL field_parameter_set_update_node(geometrictransformationsolver%field,geometrictransformationsolver% &
3341  & fieldvariabletype,field_boundary_conditions_set_type,versionidx,derivativeidx,usernodenumber, &
3342  & componentidx,nodalparameterstrans(componentidx),err,error,*999)
3343  IF(derivativeidx==1) THEN ! Translate nodal coordinate for BC
3344  CALL field_parameter_set_add_node(geometrictransformationsolver%field,geometrictransformationsolver% &
3345  & fieldvariabletype,field_boundary_conditions_set_type,versionidx,derivativeidx,usernodenumber, &
3346  & componentidx,transformationmatrix(componentidx,1+nogeomcomp),err,error,*999)
3347  ENDIF !derivativeIdx==1
3348  ENDIF !transformBC
3349  ENDDO !componentIdx
3350  ENDDO !versionIdx
3351  ENDDO !derivativeIdx
3352  ENDDO !nodeIdx
3353  ELSE
3354  CALL flagerror("Domain is not associated.",err,error,*999)
3355  ENDIF
3356  ELSE
3357  CALL flagerror("Transformation for different component bases not implemented.",err,error,*999)
3358  ENDIF
3359  ELSE
3360  CALL flagerror("The field of geometric transformation solver is not associated.",err,error,*999)
3361  ENDIF
3362  ELSE
3363  CALL flagerror("Geometric transformation solver is not associated.",err,error,*999)
3364  ENDIF
3365 
3366  exits("Problem_SolverGeometricTransformationSolve")
3367  RETURN
3368 999 errorsexits("Problem_SolverGeometricTransformationSolve",err,error)
3369  RETURN 1
3370  END SUBROUTINE problem_solvergeometrictransformationsolve
3371 
3372  !
3373  !================================================================================================================================
3374  !
3375 
3377  SUBROUTINE problem_solver_get_0(PROBLEM,CONTROL_LOOP_IDENTIFIER,SOLVER_INDEX,SOLVER,ERR,ERROR,*)
3378 
3379  !Argument variables
3380  TYPE(problem_type), POINTER :: problem
3381  INTEGER(INTG), INTENT(IN) :: control_loop_identifier
3382  INTEGER(INTG), INTENT(IN) :: solver_index
3383  TYPE(solver_type), POINTER :: solver
3384  INTEGER(INTG), INTENT(OUT) :: err
3385  TYPE(varying_string), INTENT(OUT) :: error
3386  !Local Variables
3387 
3388  enters("PROBLEM_SOLVER_GET_0",err,error,*999)
3389 
3390  CALL problem_solver_get_1(problem,[control_loop_identifier],solver_index,solver,err,error,*999)
3391 
3392  exits("PROBLEM_SOLVER_GET_0")
3393  RETURN
3394 999 errorsexits("PROBLEM_SOLVER_GET_0",err,error)
3395  RETURN 1
3396  END SUBROUTINE problem_solver_get_0
3397 
3398  !
3399  !================================================================================================================================
3400  !
3401 
3403  SUBROUTINE problem_solver_get_1(PROBLEM,CONTROL_LOOP_IDENTIFIER,SOLVER_INDEX,SOLVER,ERR,ERROR,*)
3404 
3405  !Argument variables
3406  TYPE(problem_type), POINTER :: problem
3407  INTEGER(INTG), INTENT(IN) :: control_loop_identifier(:)
3408  INTEGER(INTG), INTENT(IN) :: solver_index
3409  TYPE(solver_type), POINTER :: solver
3410  INTEGER(INTG), INTENT(OUT) :: err
3411  TYPE(varying_string), INTENT(OUT) :: error
3412  !Local Variables
3413  TYPE(control_loop_type), POINTER :: control_loop,control_loop_root
3414  TYPE(solvers_type), POINTER :: solvers
3415  TYPE(varying_string) :: local_error
3416 
3417  enters("PROBLEM_SOLVER_GET_1",err,error,*998)
3418 
3419  IF(ASSOCIATED(problem)) THEN
3420  IF(ASSOCIATED(solver)) THEN
3421  CALL flagerror("Solver is already associated.",err,error,*998)
3422  ELSE
3423  control_loop_root=>problem%CONTROL_LOOP
3424  IF(ASSOCIATED(control_loop_root)) THEN
3425  NULLIFY(control_loop)
3426  CALL control_loop_get(control_loop_root,control_loop_identifier,control_loop,err,error,*999)
3427  solvers=>control_loop%SOLVERS
3428  IF(ASSOCIATED(solvers)) THEN
3429  IF(solver_index>0.AND.solver_index<=solvers%NUMBER_OF_SOLVERS) THEN
3430  solver=>solvers%SOLVERS(solver_index)%PTR
3431  IF(.NOT.ASSOCIATED(solver)) CALL flagerror("Solvers solver is not associated.",err,error,*999)
3432  ELSE
3433  local_error="The specified solver index of "//trim(number_to_vstring(solver_index,"*",err,error))// &
3434  & " is invalid. The index must be > 0 and <= "// &
3435  & trim(number_to_vstring(solvers%NUMBER_OF_SOLVERS,"*",err,error))//"."
3436  CALL flagerror(local_error,err,error,*999)
3437  ENDIF
3438  ELSE
3439  CALL flagerror("Control loop solvers is not associated.",err,error,*999)
3440  ENDIF
3441  ELSE
3442  CALL flagerror("Problem control loop is not associated.",err,error,*999)
3443  ENDIF
3444  ENDIF
3445  ELSE
3446  CALL flagerror("Problem is not associated.",err,error,*998)
3447  ENDIF
3448 
3449  exits("PROBLEM_SOLVER_GET_1")
3450  RETURN
3451 999 NULLIFY(solver)
3452 998 errorsexits("PROBLEM_SOLVER_GET_1",err,error)
3453  RETURN 1
3454  END SUBROUTINE problem_solver_get_1
3455 
3456  !
3457  !================================================================================================================================
3458  !
3459 
3461  SUBROUTINE problem_solvernonlinearmonitor(solver,iterationNumber,residualNorm,err,error,*)
3462 
3463  !Argument variables
3464  TYPE(solver_type), POINTER :: solver
3465  INTEGER(INTG), INTENT(IN) :: iterationnumber
3466  REAL(DP), INTENT(IN) :: residualnorm
3467  INTEGER(INTG), INTENT(OUT) :: err
3468  TYPE(varying_string), INTENT(OUT) :: error
3469  !Local Variables
3470  INTEGER(INTG) :: interfaceconditionidx
3471  TYPE(solvers_type), POINTER :: solvers
3472  TYPE(control_loop_type), POINTER :: controlloop
3473  TYPE(problem_type), POINTER :: problem
3474  TYPE(nonlinear_solver_type), POINTER :: nonlinearsolver
3475  TYPE(solver_equations_type), POINTER :: solverequations
3476  TYPE(solver_mapping_type), POINTER :: solvermapping
3477  TYPE(interface_condition_type), POINTER :: interfacecondition
3478  TYPE(interface_type), POINTER :: interface
3479  LOGICAL :: reproject
3480  TYPE(varying_string) :: localerror
3481 
3482  enters("Problem_SolverNonlinearMonitor",err,error,*998)
3483 
3484  IF(ASSOCIATED(solver)) THEN
3485  solvers=>solver%SOLVERS
3486  IF(ASSOCIATED(solvers)) THEN
3487  controlloop=>solvers%CONTROL_LOOP
3488  IF(ASSOCIATED(controlloop)) THEN
3489  problem=>controlloop%PROBLEM
3490  IF(ASSOCIATED(problem)) THEN
3491  IF(.NOT.ALLOCATED(problem%specification)) THEN
3492  CALL flagerror("Problem specification is not allocated.",err,error,*999)
3493  ELSE IF(SIZE(problem%specification,1)<1) THEN
3494  CALL flagerror("Problem specification must have at least one entry.",err,error,*999)
3495  END IF
3496  SELECT CASE(problem%SPECIFICATION(1))
3497  CASE(problem_elasticity_class)
3498  IF(SIZE(problem%specification,1)/=3) THEN
3499  CALL flagerror("Problem specification must have three entries for an elasticity problem.",err,error,*999)
3500  END IF
3501  SELECT CASE(problem%SPECIFICATION(2))
3502  CASE(problem_linear_elasticity_type,problem_finite_elasticity_type)
3503  !Output meshes at iterations
3504  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
3505  nonlinearsolver=>solver%NONLINEAR_SOLVER
3506  IF(ASSOCIATED(nonlinearsolver)) THEN
3507  CALL problem_solvernewtonfieldsoutput(solver,iterationnumber,err,error,*999)
3508  ENDIF
3509  ENDIF
3510  CASE(problem_linear_elasticity_contact_type,problem_finite_elasticity_contact_type)
3511  SELECT CASE(problem%SPECIFICATION(3))
3512  CASE(problem_le_contact_transform_subtype,problem_fe_contact_transform_subtype) !Reproject at iteration 0 before the nonlinear solve to update xi location since the field is transformed.
3513  IF(iterationnumber==0) THEN
3514  reproject=.true.
3515  ELSE
3516  reproject=.false.
3517  ENDIF
3518  CASE(problem_le_contact_transform_reproject_subtype,problem_le_contact_reproject_subtype, &
3519  & problem_fe_contact_transform_reproject_subtype,problem_fe_contact_reproject_subtype)
3520  reproject=.true.
3521  CASE DEFAULT
3522  localerror="The problem subtype of "//trim(number_to_vstring(problem%SPECIFICATION(3),"*",err,error))//" &
3523  & is invalid."
3524  CALL flagerror(localerror,err,error,*999)
3525  END SELECT
3526  IF(reproject) THEN
3527  solverequations=>solver%SOLVER_EQUATIONS
3528  IF(ASSOCIATED(solverequations)) THEN
3529  solvermapping=>solverequations%SOLVER_MAPPING
3530  IF(ASSOCIATED(solvermapping)) THEN
3531  DO interfaceconditionidx=1,solvermapping%NUMBER_OF_INTERFACE_CONDITIONS
3532  interfacecondition=>solvermapping%INTERFACE_CONDITIONS(interfaceconditionidx)%PTR
3533  IF(ASSOCIATED(interfacecondition)) THEN
3534  IF(interfacecondition%OPERATOR==interface_condition_fls_contact_reproject_operator .OR. &
3535  & interfacecondition%OPERATOR==interface_condition_fls_contact_operator) THEN !Only reproject for contact operator
3536  IF(interfacecondition%integrationType==interface_condition_data_points_integration) THEN !Only reproject for data point interpolated field
3537  interface=>interfacecondition%INTERFACE
3538  IF(ASSOCIATED(interface)) THEN
3539  CALL write_string(general_output_type,"**************** Reproject! ****************",err,error,*999)
3540  CALL interfacepointsconnectivity_datareprojection(interface,interfacecondition,err,error,*999)
3541  CALL interface_condition_assemble(interfacecondition,err,error,*999)
3542  ELSE
3543  CALL flagerror("Interface is not associated for nonlinear solver equations mapping.", &
3544  & err,error,*999)
3545  ENDIF
3546  ENDIF
3547  ENDIF
3548  ELSE
3549  CALL flagerror("Interface condition is not associated for nonlinear solver equations mapping.", &
3550  & err,error,*999)
3551  ENDIF
3552  ENDDO !interfaceConditionIdx
3553  ELSE
3554  CALL flagerror("Nonlinear solver equations mapping is not associated.",err,error,*999)
3555  ENDIF
3556  ELSE
3557  CALL flagerror("Nonlinear solver equations is not associated.",err,error,*999)
3558  ENDIF
3559  ENDIF !Reproject
3560  !Output meshes at iterations
3561  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
3562  nonlinearsolver=>solver%NONLINEAR_SOLVER
3563  IF(ASSOCIATED(nonlinearsolver)) THEN
3564  CALL problem_solvernewtonfieldsoutput(solver,iterationnumber,err,error,*999)
3565  ENDIF
3566  ENDIF
3567  CASE DEFAULT
3568  localerror="The problem type of "//trim(number_to_vstring(problem%SPECIFICATION(2),"*",err,error))//" &
3569  & is invalid."
3570  CALL flagerror(localerror,err,error,*999)
3571  END SELECT
3572  CASE(problem_bioelectrics_class,problem_fluid_mechanics_class,problem_electromagnetics_class, &
3573  & problem_classical_field_class,problem_fitting_class,problem_modal_class,problem_multi_physics_class)
3574  !Do nothing???
3575  CASE DEFAULT
3576  localerror="The problem class of "//trim(number_to_vstring(problem%SPECIFICATION(1),"*",err,error))//" &
3577  & is invalid."
3578  CALL flagerror(localerror,err,error,*999)
3579  END SELECT
3580  ELSE
3581  CALL flagerror("Problem is not associated.",err,error,*999)
3582  ENDIF
3583  ELSE
3584  CALL flagerror("Problem control loop is not associated.",err,error,*999)
3585  ENDIF
3586  ENDIF
3587  !Nonlinear solve monitor--progress output if required
3588  IF(solver%SOLVE_TYPE==solver_nonlinear_type) THEN
3589  nonlinearsolver=>solver%NONLINEAR_SOLVER
3590  IF(ASSOCIATED(nonlinearsolver)) THEN
3591  CALL solver_nonlinear_monitor(nonlinearsolver,iterationnumber,residualnorm,err,error,*999)
3592  ELSE
3593  CALL flagerror("Nonlinear solver is not associated.",err,error,*999)
3594  ENDIF
3595  ELSE
3596  localerror="Invalid solve type. The solve type of "//trim(number_to_vstring(solver%SOLVE_TYPE,"*",err,error))// &
3597  & " does not correspond to a nonlinear solver."
3598  CALL flagerror(localerror,err,error,*999)
3599  ENDIF
3600  ELSE
3601  CALL flagerror("Solver is not associated.",err,error,*999)
3602  ENDIF
3603 
3604  exits("Problem_SolverNonlinearMonitor")
3605  RETURN
3606 999 NULLIFY(solver)
3607 998 errorsexits("Problem_SolverNonlinearMonitor",err,error)
3608  RETURN 1
3609  END SUBROUTINE problem_solvernonlinearmonitor
3610 
3611  !
3612  !================================================================================================================================
3613  !
3614 
3616  SUBROUTINE problem_solvernewtonfieldsoutput(solver,iterationNumber,err,error,*)
3617 
3618  !Argument variables
3619  TYPE(solver_type), POINTER :: solver
3620  INTEGER(INTG), INTENT(IN) :: iterationnumber
3621  INTEGER(INTG), INTENT(OUT) :: err
3622  TYPE(varying_string), INTENT(OUT) :: error
3623  !Local Variables
3624  INTEGER(INTG) :: equationssetidx,load_step
3625  LOGICAL :: direxists
3626  TYPE(region_type), POINTER :: region
3627  TYPE(solver_mapping_type), POINTER :: solvermapping
3628  TYPE(fields_type), POINTER :: fields
3629  TYPE(varying_string) :: filename,method,directory
3630 
3631  INTEGER(INTG) :: interfaceconditionidx, interfaceelementnumber, datapointidx, globaldatapointnumber, coupledmeshelementnumber, &
3632  & coupledMeshFaceLineNumber, coupledMeshIdx,component
3633  TYPE(interface_type), POINTER :: interface
3634  TYPE(interface_condition_type), POINTER :: interfacecondition
3635  TYPE(interfacepointsconnectivitytype), POINTER :: pointsconnectivity
3636  TYPE(field_type), POINTER :: coupledmeshdependentfield
3637  TYPE(field_interpolation_parameters_ptr_type), POINTER :: interpolationparameters(:)
3638  TYPE(field_interpolated_point_ptr_type), POINTER :: interpolatedpoints(:)
3639  TYPE(field_interpolated_point_type), POINTER :: interpolatedpoint
3640  TYPE(decompositionelementdatapointstype), POINTER :: decompositionelementdata
3641  TYPE(data_points_type), POINTER :: interfacedatapoints
3642  TYPE(data_projection_type), POINTER :: dataprojection
3643 
3644  TYPE(problem_type), POINTER :: problem
3645 
3646  INTEGER(INTG) :: iunit
3647  CHARACTER(LEN=100) :: filenameoutput,groupname
3648 
3649  TYPE(varying_string) :: filetocheck,localerror
3650  LOGICAL :: fileexists
3651  INTEGER(INTG) :: firstiterationnumber, solve_call, max_solve_calls
3652 
3653  enters("Problem_SolverNewtonFieldsOutput",err,error,*999)
3654 
3655  IF(ASSOCIATED(solver%SOLVER_EQUATIONS))THEN
3656  solvermapping=>solver%SOLVER_EQUATIONS%SOLVER_MAPPING
3657  problem=>solver%SOLVERS%CONTROL_LOOP%PROBLEM
3658 
3659  IF(.NOT.ALLOCATED(problem%SPECIFICATION)) THEN
3660  CALL flagerror("Problem specification is not allocated.",err,error,*999)
3661  ELSE IF(SIZE(problem%SPECIFICATION,1)<1) THEN
3662  CALL flagerror("Problem specification must have at least one entry.",err,error,*999)
3663  END IF
3664  SELECT CASE(problem%SPECIFICATION(1))
3665  CASE(problem_elasticity_class)
3666  IF(SIZE(problem%specification,1)/=3) THEN
3667  CALL flagerror("Problem specification must have three entries for an elasticity problem.",err,error,*999)
3668  END IF
3669  SELECT CASE(problem%SPECIFICATION(2))
3670  CASE(problem_linear_elasticity_type,problem_finite_elasticity_type,problem_linear_elasticity_contact_type, &
3671  & problem_finite_elasticity_contact_type)
3672 
3673  IF(diagnostics1) THEN
3674  directory="results_iter/"
3675  INQUIRE(file=char(directory),exist=direxists)
3676  IF(.NOT.direxists) THEN
3677  CALL system(char("mkdir "//directory))
3678  ENDIF
3679 
3680  ! Find how many times the problem solve command has been issued.
3681  max_solve_calls=100
3682  coupledmeshidx=1
3683  load_step=1
3684  firstiterationnumber=0
3685  DO solve_call=1,max_solve_calls
3686  filetocheck=directory// &
3687  & "mesh"//trim(number_to_vstring(coupledmeshidx,"*",err,error))// &
3688  & "_solveCall"//trim(number_to_vstring(solve_call,"*",err,error))// &
3689  & "_load"//trim(number_to_vstring(load_step,"*",err,error))// &
3690  & "_iter"//trim(number_to_vstring(firstiterationnumber,"*",err,error))//".part0.exnode"
3691  INQUIRE(file=char(filetocheck),exist=fileexists)
3692  IF(.NOT.fileexists) THEN
3693  EXIT
3694  ENDIF
3695  ENDDO
3696 
3697  load_step=solver%SOLVERS%CONTROL_LOOP%LOAD_INCREMENT_LOOP%ITERATION_NUMBER
3698 
3699  IF((iterationnumber > 0).OR.(load_step > 1))THEN
3700  solve_call = solve_call - 1
3701  ENDIF
3702 
3703  WRITE(*,'(1X,''SolveCall: '',I4)') solve_call
3704  WRITE(*,'(1X,'' LoadStep: '',I4)') load_step
3705  WRITE(*,'(1X,'' Iteration: '',I4)') iterationnumber
3706 
3707  DO equationssetidx=1,solvermapping%NUMBER_OF_EQUATIONS_SETS
3708  region=>solvermapping%EQUATIONS_SETS(equationssetidx)%PTR%REGION
3709  IF(ASSOCIATED(region))THEN
3710  NULLIFY(fields)
3711  fields=>region%FIELDS
3712  filename=directory//"mesh"//trim(number_to_vstring(equationssetidx,"*",err,error))// &
3713  & "_solveCall"//trim(number_to_vstring(solve_call,"*",err,error))// &
3714  & "_load"//trim(number_to_vstring(load_step,"*",err,error))// &
3715  & "_iter"//trim(number_to_vstring(iterationnumber,"*",err,error))
3716  method="FORTRAN"
3717  CALL field_io_elements_export(fields,filename,method,err,error,*999)
3718  CALL field_io_nodes_export(fields,filename,method,err,error,*999)
3719  ELSE
3720  CALL flagerror("Region is not associated.",err,error,*999)
3721  ENDIF
3722  ENDDO
3723  ENDIF
3724 
3725  CASE DEFAULT
3726  localerror="The problem type of "//trim(number_to_vstring(problem%SPECIFICATION(2),"*",err,error))//" &
3727  & is invalid."
3728  CALL flagerror(localerror,err,error,*999)
3729  END SELECT
3730  CASE(problem_bioelectrics_class,problem_fluid_mechanics_class,problem_electromagnetics_class, &
3731  & problem_classical_field_class,problem_fitting_class,problem_modal_class,problem_multi_physics_class)
3732  !Do nothing???
3733  CASE DEFAULT
3734  localerror="The problem class of "//trim(number_to_vstring(problem%SPECIFICATION(1),"*",err,error))//" &
3735  & is invalid."
3736  CALL flagerror(localerror,err,error,*999)
3737  END SELECT
3738 
3739  SELECT CASE(problem%SPECIFICATION(1))
3740  CASE(problem_elasticity_class)
3741  SELECT CASE(problem%SPECIFICATION(2))
3742  CASE(problem_linear_elasticity_type,problem_finite_elasticity_type)
3743  ! Pass
3744  CASE(problem_linear_elasticity_contact_type,problem_finite_elasticity_contact_type)
3745 
3746  IF(diagnostics1) THEN
3747  iunit = 300
3748  DO interfaceconditionidx=1,solvermapping%NUMBER_OF_INTERFACE_CONDITIONS
3749  interfacecondition=>solvermapping%INTERFACE_CONDITIONS(interfaceconditionidx)%PTR
3750  interface=>solvermapping%INTERFACE_CONDITIONS(interfaceconditionidx)%PTR%interface
3751  pointsconnectivity=>interface%pointsConnectivity
3752  interfacedatapoints=>interface%DATA_POINTS
3753  IF(ASSOCIATED(pointsconnectivity)) THEN
3754  DO coupledmeshidx=1,interface%NUMBER_OF_COUPLED_MESHES
3755  filenameoutput=directory//"PointsConnectivity"//trim(number_to_vstring(coupledmeshidx,"*",err,error))// &
3756  & "_solveCall"//trim(number_to_vstring(solve_call,"*",err,error))// &
3757  & "_load"//trim(number_to_vstring(load_step,"*",err,error))// &
3758  & "_iter"//trim(number_to_vstring(iterationnumber,"*",err,error))//".exdata"
3759  OPEN(unit=iunit,file=filenameoutput,status="UNKNOWN",action="WRITE",iostat=err)
3760  groupname="PointsConnectivity"//trim(number_to_vstring(coupledmeshidx,"*",err,error))
3761  WRITE(iunit,'( '' Group name: '',A)') groupname
3762  WRITE(iunit,'(1X,''#Fields=4'')')
3763  WRITE(iunit,'(1X,''1) coordinates, coordinate, rectangular cartesian, #Components=3'')')
3764  WRITE(iunit,'(1X,'' x. Value index= 1, #Derivatives=0'')')
3765  WRITE(iunit,'(1X,'' y. Value index= 2, #Derivatives=0'')')
3766  WRITE(iunit,'(1X,'' z. Value index= 3, #Derivatives=0'')')
3767  WRITE(iunit,'(1X,''2) error, field, rectangular cartesian, #Components=3'')')
3768  WRITE(iunit,'(1X,'' x. Value index= 4, #Derivatives=0'')')
3769  WRITE(iunit,'(1X,'' y. Value index= 5, #Derivatives=0'')')
3770  WRITE(iunit,'(1X,'' z. Value index= 6, #Derivatives=0'')')
3771  WRITE(iunit,'(1X,''3) projectedCoordinate, field, rectangular cartesian, #Components=3'')')
3772  WRITE(iunit,'(1X,'' x. Value index= 7, #Derivatives=0'')')
3773  WRITE(iunit,'(1X,'' y. Value index= 8, #Derivatives=0'')')
3774  WRITE(iunit,'(1X,'' z. Value index= 9, #Derivatives=0'')')
3775  WRITE(iunit,'(1X,''4) exitTag, field, rectangular cartesian, #Components=1'')')
3776  WRITE(iunit,'(1X,'' tag. Value index= 10, #Derivatives=0'')')
3777  coupledmeshdependentfield=>interfacecondition%DEPENDENT%EQUATIONS_SETS(coupledmeshidx)%PTR% &
3778  & dependent%DEPENDENT_FIELD
3779  NULLIFY(interpolationparameters)
3780  CALL field_interpolation_parameters_initialise(coupledmeshdependentfield,interpolationparameters,err,error, &
3781  & *999,field_geometric_components_type)
3782  NULLIFY(interpolatedpoints)
3783  CALL field_interpolated_points_initialise(interpolationparameters,interpolatedpoints,err,error,*999, &
3784  & field_geometric_components_type)
3785  interpolatedpoint=>interpolatedpoints(field_u_variable_type)%PTR
3786  dataprojection=>interfacedatapoints%DATA_PROJECTIONS(coupledmeshidx+1)%PTR
3787  DO interfaceelementnumber=1,SIZE(pointsconnectivity%coupledElements,1)
3788  decompositionelementdata=>interfacecondition%LAGRANGE%LAGRANGE_FIELD%DECOMPOSITION%TOPOLOGY%dataPoints% &
3789  & elementdatapoint(interfaceelementnumber)
3790  DO datapointidx=1,decompositionelementdata%numberOfProjectedData
3791  globaldatapointnumber=decompositionelementdata%dataIndices(datapointidx)%globalNumber
3792  WRITE(iunit,'(1X,''Node:'',I4)') globaldatapointnumber
3793  DO component=1,3
3794  WRITE(iunit,'(1X,3E25.15)') interfacedatapoints%DATA_POINTS(globaldatapointnumber)%position(component)
3795  ENDDO !component
3796  coupledmeshelementnumber=pointsconnectivity%pointsConnectivity(globaldatapointnumber,coupledmeshidx)% &
3797  & coupledmeshelementnumber
3798  coupledmeshfacelinenumber=coupledmeshdependentfield%DECOMPOSITION%TOPOLOGY%ELEMENTS% &
3799  & elements(coupledmeshelementnumber)% &
3800  & element_faces(pointsconnectivity%pointsConnectivity(globaldatapointnumber,coupledmeshidx)% &
3801  & elementlinefacenumber)
3802  CALL field_interpolation_parameters_face_get(field_values_set_type,coupledmeshfacelinenumber, &
3803  & interpolationparameters(field_u_variable_type)%PTR,err,error,*999,field_geometric_components_type)
3804  CALL field_interpolate_xi(no_part_deriv,pointsconnectivity%pointsConnectivity(globaldatapointnumber, &
3805  & coupledmeshidx)%reducedXi(:),interpolatedpoint,err,error,*999,field_geometric_components_type) !Interpolate contact data points on each surface
3806  DO component=1,3
3807  WRITE(iunit,'(1X,3E25.15)') interpolatedpoint%VALUES(component,no_part_deriv) - &
3808  & interfacedatapoints%DATA_POINTS(globaldatapointnumber)%position(component)
3809  ENDDO !component
3810  DO component=1,3
3811  WRITE(iunit,'(1X,3E25.15)') interpolatedpoint%VALUES(component,no_part_deriv)
3812  ENDDO !component
3813  WRITE(iunit,'(1X,I2)') dataprojection%DATA_PROJECTION_RESULTS(globaldatapointnumber)%EXIT_TAG
3814  ENDDO !dataPointIdx
3815  ENDDO !interfaceElementNumber
3816  CALL field_interpolation_parameters_finalise(interpolationparameters,err,error,*999)
3817  CALL field_interpolated_points_finalise(interpolatedpoints,err,error,*999)
3818  OPEN(unit=iunit)
3819  ENDDO !coupledMeshIdx
3820  ENDIF
3821  ENDDO !interfaceConditionIdx
3822  ENDIF
3823 
3824  CASE DEFAULT
3825  localerror="The problem type of "//trim(number_to_vstring(problem%SPECIFICATION(2),"*",err,error))//" &
3826  & is invalid."
3827  CALL flagerror(localerror,err,error,*999)
3828  END SELECT
3829  CASE(problem_bioelectrics_class,problem_fluid_mechanics_class,problem_electromagnetics_class, &
3830  & problem_classical_field_class,problem_fitting_class,problem_modal_class,problem_multi_physics_class)
3831  !Do nothing???
3832  CASE DEFAULT
3833  localerror="The problem class of "//trim(number_to_vstring(problem%SPECIFICATION(1),"*",err,error))//" &
3834  & is invalid."
3835  CALL flagerror(localerror,err,error,*999)
3836  END SELECT
3837 
3838  ELSE
3839  CALL flagerror("Solver equations is not associated.",err,error,*999)
3840  ENDIF
3841 
3842  exits("Problem_SolverNewtonFieldsOutput")
3843  RETURN
3844 999 errorsexits("Problem_SolverNewtonFieldsOutput",err,error)
3845  RETURN 1
3846  END SUBROUTINE problem_solvernewtonfieldsoutput
3847 
3848  !
3849  !================================================================================================================================
3850  !
3851 
3853  SUBROUTINE problem_specificationget(problem,problemSpecification,err,error,*)
3854 
3855  !Argument variables
3856  TYPE(problem_type), POINTER :: problem
3857  INTEGER(INTG), INTENT(INOUT) :: problemspecification(:)
3858  INTEGER(INTG), INTENT(OUT) :: err
3859  TYPE(varying_string), INTENT(OUT) :: error
3860  !Local Variables
3861  INTEGER(INTG) :: specificationlength
3862 
3863  enters("Problem_SpecificationGet",err,error,*999)
3864 
3865  IF(ASSOCIATED(problem)) THEN
3866  IF(problem%problem_finished) THEN
3867  IF(.NOT.ALLOCATED(problem%specification)) THEN
3868  CALL flagerror("Problem specification is not allocated.",err,error,*999)
3869  END IF
3870  specificationlength=SIZE(problem%specification,1)
3871  IF(SIZE(problemspecification,1)>=specificationlength) THEN
3872  problemspecification(1:specificationlength)=problem%specification(1:specificationlength)
3873  ELSE
3874  CALL flagerror("The problem specification size is "//trim(numbertovstring(specificationlength,"*",err,error))// &
3875  & " but the input array only has size "//trim(numbertovstring(SIZE(problemspecification,1),"*",err,error))//".", &
3876  & err,error,*999)
3877  ENDIF
3878  ELSE
3879  CALL flagerror("Problem has not been finished.",err,error,*999)
3880  ENDIF
3881  ELSE
3882  CALL flagerror("Problem is not associated.",err,error,*999)
3883  ENDIF
3884 
3885  exits("Problem_SpecificationGet")
3886  RETURN
3887 999 errorsexits("Problem_SpecificationGet",err,error)
3888  RETURN 1
3889 
3890  END SUBROUTINE problem_specificationget
3891 
3892  !
3893  !================================================================================================================================
3894  !
3895 
3897  SUBROUTINE problem_specificationset(problem,problemSpecification,err,error,*)
3898 
3899  !Argument variables
3900  TYPE(problem_type), POINTER :: problem
3901  INTEGER(INTG), INTENT(IN) :: problemspecification(:)
3902  INTEGER(INTG), INTENT(OUT) :: err
3903  TYPE(varying_string), INTENT(OUT) :: error
3904  !Local Variables
3905  TYPE(varying_string) :: localerror
3906  INTEGER(INTG) :: problemclass
3907 
3908  enters("Problem_SpecificationSet",err,error,*999)
3909 
3910  IF(ASSOCIATED(problem)) THEN
3911  IF(problem%problem_finished) THEN
3912  CALL flagerror("Problem has been finished.",err,error,*999)
3913  ELSE
3914  IF(SIZE(problemspecification,1)<1) THEN
3915  CALL flagerror("Problem specification array must have one or more entries.",err,error,*999)
3916  ENDIF
3917  problemclass=problemspecification(1)
3918  SELECT CASE(problemclass)
3919  CASE(problem_elasticity_class)
3920  CALL elasticity_problemspecificationset(problem,problemspecification,err,error,*999)
3921  CASE(problem_fluid_mechanics_class)
3922  CALL fluidmechanics_problemspecificationset(problem,problemspecification,err,error,*999)
3923  CASE(problem_electromagnetics_class)
3924  CALL flagerror("Not implemented.",err,error,*999)
3925  CASE(problem_classical_field_class)
3926  CALL classicalfield_problemspecificationset(problem,problemspecification,err,error,*999)
3927  CASE(problem_bioelectrics_class)
3928  CALL bioelectric_problemspecificationset(problem,problemspecification,err,error,*999)
3929  CASE(problem_modal_class)
3930  CALL flagerror("Not implemented.",err,error,*999)
3931  CASE(problem_fitting_class)
3932  CALL fitting_problemspecificationset(problem,problemspecification,err,error,*999)
3933  CASE(problem_optimisation_class)
3934  CALL flagerror("Not implemented.",err,error,*999)
3935  CASE(problem_multi_physics_class)
3936  CALL multiphysics_problemspecificationset(problem,problemspecification,err,error,*999)
3937  CASE DEFAULT
3938  localerror="The first problems specification of "//trim(numbertovstring(problemclass,"*",err,error))//" is not valid."
3939  CALL flagerror(localerror,err,error,*999)
3940  END SELECT
3941  ENDIF
3942  ELSE
3943  CALL flagerror("Problem is not associated.",err,error,*999)
3944  ENDIF
3945 
3946  exits("Problem_SpecificationSet")
3947  RETURN
3948 999 errorsexits("Problem_SpecificationSet",err,error)
3949  RETURN 1
3950 
3951  END SUBROUTINE problem_specificationset
3952 
3953  !
3954  !================================================================================================================================
3955  !
3956 
3958  SUBROUTINE problem_specificationsizeget(problem,specificationSize,err,error,*)
3959 
3960  !Argument variables
3961  TYPE(problem_type), POINTER :: problem
3962  INTEGER(INTG), INTENT(OUT) :: specificationsize
3963  INTEGER(INTG), INTENT(OUT) :: err
3964  TYPE(varying_string), INTENT(OUT) :: error
3965  !Local Variables
3966 
3967  enters("Problem_SpecificationSizeGet",err,error,*999)
3968 
3969  specificationsize=0
3970  IF(ASSOCIATED(problem)) THEN
3971  IF(problem%problem_finished) THEN
3972  IF(.NOT.ALLOCATED(problem%specification)) THEN
3973  CALL flagerror("Problem specification is not allocated.",err,error,*999)
3974  END IF
3975  specificationsize=SIZE(problem%specification,1)
3976  ELSE
3977  CALL flagerror("Problem has not been finished.",err,error,*999)
3978  ENDIF
3979  ELSE
3980  CALL flagerror("Problem is not associated.",err,error,*999)
3981  ENDIF
3982 
3983  exits("Problem_SpecificationSizeGet")
3984  RETURN
3985 999 errorsexits("Problem_SpecificationSizeGet",err,error)
3986  RETURN 1
3987 
3988  END SUBROUTINE problem_specificationsizeget
3989 
3990  !
3991  !================================================================================================================================
3992  !
3993 
3995  SUBROUTINE problem_user_number_find(USER_NUMBER,PROBLEM,ERR,ERROR,*)
3996 
3997  !Argument variables
3998  INTEGER(INTG), INTENT(IN) :: user_number
3999  TYPE(problem_type), POINTER :: problem
4000  INTEGER(INTG), INTENT(OUT) :: err
4001  TYPE(varying_string), INTENT(OUT) :: error
4002  !Local Variables
4003  INTEGER(INTG) :: problem_idx
4004 
4005  enters("PROBLEM_USER_NUMBER_FIND",err,error,*999)
4006 
4007  IF(ASSOCIATED(problem)) THEN
4008  CALL flagerror("Problem is already associated.",err,error,*999)
4009  ELSE
4010  problem_idx=1
4011  DO WHILE(problem_idx<=problems%NUMBER_OF_PROBLEMS.AND..NOT.ASSOCIATED(problem))
4012  IF(problems%PROBLEMS(problem_idx)%PTR%USER_NUMBER==user_number) THEN
4013  problem=>problems%PROBLEMS(problem_idx)%PTR
4014  ELSE
4015  problem_idx=problem_idx+1
4016  ENDIF
4017  ENDDO
4018  ENDIF
4019 
4020  exits("PROBLEM_USER_NUMBER_FIND")
4021  RETURN
4022 999 errorsexits("PROBLEM_USER_NUMBER_FIND",err,error)
4023  RETURN 1
4024  END SUBROUTINE problem_user_number_find
4025 
4026  !
4027  !================================================================================================================================
4028  !
4029 
4031  SUBROUTINE problems_finalise(ERR,ERROR,*)
4032 
4033  !Argument variables
4034  INTEGER(INTG), INTENT(OUT) :: err
4035  TYPE(varying_string), INTENT(OUT) :: error
4036  !Local Variables
4037 
4038  enters("PROBLEMS_FINALISE",err,error,*999)
4039 
4040  DO WHILE(problems%NUMBER_OF_PROBLEMS>0)
4041  CALL problem_destroy(problems%PROBLEMS(1)%PTR,err,error,*999)
4042  ENDDO !problem_idx
4043 
4044  exits("PROBLEMS_FINALISE")
4045  RETURN
4046 999 errorsexits("PROBLEMS_FINALISE",err,error)
4047  RETURN 1
4048  END SUBROUTINE problems_finalise
4049 
4050  !
4051  !================================================================================================================================
4052  !
4053 
4055  SUBROUTINE problems_initialise(ERR,ERROR,*)
4056 
4057  !Argument variables
4058  INTEGER(INTG), INTENT(OUT) :: err
4059  TYPE(varying_string), INTENT(OUT) :: error
4060  !Local Variables
4061 
4062  enters("PROBLEMS_INITIALISE",err,error,*999)
4063 
4064  problems%NUMBER_OF_PROBLEMS=0
4065  NULLIFY(problems%PROBLEMS)
4066 
4067  exits("PROBLEMS_INITIALISE")
4068  RETURN
4069 999 errorsexits("PROBLEMS_INITIALISE",err,error)
4070  RETURN 1
4071  END SUBROUTINE problems_initialise
4072 
4073  !
4074  !================================================================================================================================
4075  !
4076 
4078  RECURSIVE SUBROUTINE problem_control_loop_previous_values_update(CONTROL_LOOP,ERR,ERROR,*)
4079 
4080  !Argument variables
4081  TYPE(control_loop_type), POINTER :: control_loop
4082  INTEGER(INTG), INTENT(OUT) :: err
4083  TYPE(varying_string), INTENT(OUT) :: error
4084  !Local Variables
4085  TYPE(solvers_type), POINTER :: solvers
4086  TYPE(solver_type), POINTER :: solver
4087  INTEGER(INTG) :: solver_idx
4088 
4089  NULLIFY(solver)
4090 
4091  enters("PROBLEM_CONTROL_LOOP_PREVIOUS_VALUES_UPDATE",err,error,*999)
4092 
4093  IF(ASSOCIATED(control_loop)) THEN
4094  IF(control_loop%NUMBER_OF_SUB_LOOPS==0) THEN
4095  !If there are no sub loops then get the solvers for this loop.
4096  solvers=>control_loop%SOLVERS
4097  IF(ASSOCIATED(solvers)) THEN
4098  DO solver_idx=1,solvers%NUMBER_OF_SOLVERS
4099  solver=>solvers%SOLVERS(solver_idx)%PTR
4100  SELECT CASE(solver%SOLVE_TYPE)
4101  CASE(solver_dynamic_type)
4102  CALL solver_variablesdynamicfieldpreviousvaluesupdate(solver,err,error,*999)
4103  CASE DEFAULT
4104  !Do nothing
4105  END SELECT
4106  ENDDO !solver_idx
4107  ELSE
4108  CALL flagerror("Control loop solvers is not associated.",err,error,*999)
4109  ENDIF
4110  ENDIF
4111  ELSE
4112  CALL flagerror("Control loop is not associated.",err,error,*999)
4113  ENDIF
4114 
4115  exits("PROBLEM_CONTROL_LOOP_PREVIOUS_VALUES_UPDATE")
4116  RETURN
4117 999 errorsexits("PROBLEM_CONTROL_LOOP_PREVIOUS_VALUES_UPDATE",err,error)
4118  RETURN 1
4119 
4120  END SUBROUTINE problem_control_loop_previous_values_update
4121 
4122  !
4123  !================================================================================================================================
4124  !
4125 
4126 
4127 END MODULE problem_routines
4128 
4129 !
4130 !================================================================================================================================
4131 !
4132 
4134 SUBROUTINE problem_solverjacobianevaluatepetsc(snes,x,A,B,ctx,err)
4135 
4136  USE base_routines
4137  USE cmisspetsctypes
4138  USE distributed_matrix_vector
4139  USE iso_varying_string
4140  USE kinds
4141  USE problem_routines
4142  USE solver_routines
4143  USE solver_matrices_routines
4144  USE strings
4145  USE types
4146 
4147  IMPLICIT NONE
4148 
4149  !Argument variables
4150  TYPE(petscsnestype), INTENT(INOUT) :: snes
4151  TYPE(petscvectype), INTENT(INOUT) :: x
4152  TYPE(petscmattype), INTENT(INOUT) :: a
4153  TYPE(petscmattype), INTENT(INOUT) :: b
4154  TYPE(solver_type), POINTER :: ctx
4155  INTEGER(INTG), INTENT(INOUT) :: err
4156  !Local Variables
4157  INTEGER(INTG) :: dummyerr
4158  TYPE(distributed_vector_type), POINTER :: solvervector
4159  TYPE(newton_solver_type), POINTER :: newtonsolver
4160  TYPE(nonlinear_solver_type), POINTER :: nonlinearsolver
4161  TYPE(quasi_newton_solver_type), POINTER :: quasinewtonsolver
4162  TYPE(solver_equations_type), POINTER :: solverequations
4163  TYPE(solver_matrices_type), POINTER :: solvermatrices
4164  TYPE(solver_matrix_type), POINTER :: solvermatrix
4165  TYPE(varying_string) :: dummyerror,error,localerror
4166 
4167  IF(ASSOCIATED(ctx)) THEN
4168  solverequations=>ctx%SOLVER_EQUATIONS
4169  IF(ASSOCIATED(solverequations)) THEN
4170  solvermatrices=>solverequations%SOLVER_MATRICES
4171  IF(ASSOCIATED(solvermatrices)) THEN
4172  IF(solvermatrices%NUMBER_OF_MATRICES==1) THEN
4173  solvermatrix=>solvermatrices%matrices(1)%ptr
4174  IF(ASSOCIATED(solvermatrix)) THEN
4175  solvervector=>solvermatrix%SOLVER_VECTOR
4176  IF(ASSOCIATED(solvervector)) THEN
4177  CALL distributed_vector_override_set_on(solvervector,x,err,error,*999)
4178 
4179  CALL problem_solver_jacobian_evaluate(ctx,err,error,*999)
4180 
4181  CALL distributed_vector_override_set_off(solvervector,err,error,*999)
4182  ELSE
4183  CALL flagerror("Solver vector is not associated.",err,error,*998)
4184  ENDIF
4185  ELSE
4186  CALL flagerror("Solver matrix is not associated.",err,error,*998)
4187  ENDIF
4188  ELSE
4189  localerror="The number of solver matrices of "// &
4190  & trim(numbertovstring(solvermatrices%NUMBER_OF_MATRICES,"*",err,error))// &
4191  & " is invalid. There should be 1 solver matrix."
4192  CALL flagerror(localerror,err,error,*998)
4193  ENDIF
4194  ELSE
4195  CALL flagerror("Solver equations solver matrices is not associated.",err,error,*998)
4196  ENDIF
4197  ELSE
4198  CALL flagerror("Solver solver equations is not associated.",err,error,*998)
4199  ENDIF
4200 !!TODO: move this to PROBLEM_SOLVER_JACOBIAN_EVALUATE or elsewhere?
4201  nonlinearsolver=>ctx%NONLINEAR_SOLVER
4202  IF(ASSOCIATED(nonlinearsolver)) THEN
4203  SELECT CASE(nonlinearsolver%NONLINEAR_SOLVE_TYPE)
4204  CASE(solver_nonlinear_newton)
4205  newtonsolver=>nonlinearsolver%NEWTON_SOLVER
4206  IF(ASSOCIATED(newtonsolver)) THEN
4207  newtonsolver%TOTAL_NUMBER_OF_JACOBIAN_EVALUATIONS=newtonsolver%TOTAL_NUMBER_OF_JACOBIAN_EVALUATIONS+1
4208  ELSE
4209  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*998)
4210  ENDIF
4211  CASE(solver_nonlinear_quasi_newton)
4212  quasinewtonsolver=>nonlinearsolver%QUASI_NEWTON_SOLVER
4213  IF(ASSOCIATED(quasinewtonsolver)) THEN
4214  quasinewtonsolver%TOTAL_NUMBER_OF_JACOBIAN_EVALUATIONS=quasinewtonsolver%TOTAL_NUMBER_OF_JACOBIAN_EVALUATIONS+1
4215  ELSE
4216  CALL flagerror("Nonlinear solver Quasi-Newton solver is not associated.",err,error,*998)
4217  ENDIF
4218  CASE DEFAULT
4219  !Do nothing?
4220  END SELECT
4221  ELSE
4222  CALL flagerror("Solver nonlinear solver is not associated.",err,error,*998)
4223  ENDIF
4224  ELSE
4225  CALL flagerror("Solver context is not associated.",err,error,*998)
4226  ENDIF
4227 
4228  RETURN
4229 999 CALL distributed_vector_override_set_off(solvervector,dummyerr,dummyerror,*998)
4230 998 CALL writeerror(err,error,*997)
4231 997 CALL flagwarning("Error evaluating nonlinear Jacobian.",err,error,*996)
4232 996 RETURN
4233 END SUBROUTINE problem_solverjacobianevaluatepetsc
4234 
4235 !
4236 !================================================================================================================================
4237 !
4238 
4241 SUBROUTINE problem_solverjacobianfdcalculatepetsc(snes,x,A,B,ctx,err)
4242 
4243  USE base_routines
4244  USE cmisspetsc
4245  USE cmisspetsctypes
4246  USE distributed_matrix_vector
4247  USE iso_varying_string
4248  USE kinds
4249  USE problem_routines
4250  USE solver_matrices_routines
4251  USE solver_routines
4252  USE strings
4253  USE types
4254 
4255 
4256  IMPLICIT NONE
4257 
4258  !Argument variables
4259  TYPE(petscsnestype), INTENT(INOUT) :: snes
4260  TYPE(petscvectype), INTENT(INOUT) :: x
4261  TYPE(petscmattype), INTENT(INOUT) :: a
4262  TYPE(petscmattype), INTENT(INOUT) :: b
4263  TYPE(solver_type), POINTER :: ctx
4264  INTEGER(INTG), INTENT(INOUT) :: err
4265  !Local Variables
4266  INTEGER(INTG) :: dummyerr
4267  TYPE(newton_solver_type), POINTER :: newtonsolver
4268  TYPE(nonlinear_solver_type), POINTER :: nonlinearsolver
4269  TYPE(newton_linesearch_solver_type), POINTER :: linesearchsolver
4270  TYPE(quasi_newton_solver_type), POINTER :: quasinewtonsolver
4271  TYPE(quasi_newton_linesearch_solver_type), POINTER :: quasinewtonlinesearchsolver
4272  TYPE(solver_equations_type), POINTER :: solverequations
4273  TYPE(solver_matrices_type), POINTER :: solvermatrices
4274  TYPE(solver_matrix_type), POINTER :: solvermatrix
4275  TYPE(petscmatfdcoloringtype), POINTER :: jacobianmatfdcoloring
4276  TYPE(varying_string) :: dummyerror,error,localerror
4277 
4278  IF(ASSOCIATED(ctx)) THEN
4279  nonlinearsolver=>ctx%NONLINEAR_SOLVER
4280  IF(ASSOCIATED(nonlinearsolver)) THEN
4281  solverequations=>ctx%SOLVER_EQUATIONS
4282  IF(ASSOCIATED(solverequations)) THEN
4283  solvermatrices=>solverequations%SOLVER_MATRICES
4284  IF(ASSOCIATED(solvermatrices)) THEN
4285  IF(solvermatrices%NUMBER_OF_MATRICES==1) THEN
4286  solvermatrix=>solvermatrices%matrices(1)%ptr
4287  IF(ASSOCIATED(solvermatrix)) THEN
4288  SELECT CASE(solverequations%SPARSITY_TYPE)
4289  CASE(solver_sparse_matrices)
4290  SELECT CASE(nonlinearsolver%NONLINEAR_SOLVE_TYPE)
4291  CASE(solver_nonlinear_newton)
4292  newtonsolver=>nonlinearsolver%NEWTON_SOLVER
4293  IF(ASSOCIATED(newtonsolver)) THEN
4294  linesearchsolver=>newtonsolver%LINESEARCH_SOLVER
4295  IF(ASSOCIATED(linesearchsolver)) THEN
4296  jacobianmatfdcoloring=>linesearchsolver%jacobianMatFDColoring
4297  ELSE
4298  CALL flagerror("Newton solver linesearch solver is not associated.",err,error,*999)
4299  ENDIF
4300  ELSE
4301  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
4302  ENDIF
4303  CASE(solver_nonlinear_quasi_newton)
4304  quasinewtonsolver=>nonlinearsolver%QUASI_NEWTON_SOLVER
4305  IF(ASSOCIATED(quasinewtonsolver)) THEN
4306  quasinewtonlinesearchsolver=>quasinewtonsolver%LINESEARCH_SOLVER
4307  IF(ASSOCIATED(quasinewtonlinesearchsolver)) THEN
4308  jacobianmatfdcoloring=>quasinewtonlinesearchsolver%jacobianMatFDColoring
4309  ELSE
4310  CALL flagerror("Quasi-Newton solver linesearch solver is not associated.",err,error,*999)
4311  ENDIF
4312  ELSE
4313  CALL flagerror("Nonlinear solver quasi Newton solver is not associated.",err,error,*999)
4314  ENDIF
4315  CASE DEFAULT
4316  localerror="The nonlinear solver type of "// &
4317  & trim(numbertovstring(nonlinearsolver%NONLINEAR_SOLVE_TYPE,"*",err,error))// &
4318  & " is invalid."
4319  CALL flagerror(localerror,err,error,*999)
4320  END SELECT
4321  IF(ASSOCIATED(jacobianmatfdcoloring)) THEN
4322  CALL petsc_snescomputejacobiandefaultcolor(snes,x,a,b,jacobianmatfdcoloring,err,error,*999)
4323  ELSE
4324  CALL flagerror("Linesearch solver FD colouring is not associated.",err,error,*998)
4325  ENDIF
4326  CASE(solver_full_matrices)
4327  CALL petsc_snescomputejacobiandefault(snes,x,a,b,ctx,err,error,*999)
4328  CASE DEFAULT
4329  localerror="The specified solver equations sparsity type of "// &
4330  & trim(numbertovstring(solverequations%SPARSITY_TYPE,"*",err,error))//" is invalid."
4331  CALL flagerror(localerror,err,error,*999)
4332  END SELECT
4333  IF(ctx%OUTPUT_TYPE>=solver_matrix_output) THEN
4334  CALL distributed_matrix_override_set_on(solvermatrices%matrices(1)%ptr%matrix,a,err,error,*999)
4335  CALL solver_matrices_output(general_output_type,solver_matrices_jacobian_only,solvermatrices,err,error,*998)
4336  CALL distributed_matrix_override_set_off(solvermatrices%matrices(1)%ptr%matrix,err,error,*999)
4337  ENDIF
4338  ELSE
4339  CALL flagerror("Solver matrix is not associated.",err,error,*998)
4340  ENDIF
4341  ELSE
4342  localerror="The number of solver matrices of "// &
4343  & trim(numbertovstring(solvermatrices%NUMBER_OF_MATRICES,"*",err,error))// &
4344  & " is invalid. There should be 1 solver matrix."
4345  CALL flagerror(localerror,err,error,*998)
4346  ENDIF
4347  ELSE
4348  CALL flagerror("Solver equations solver matrices is not associated.",err,error,*998)
4349  ENDIF
4350  ELSE
4351  CALL flagerror("Solver solver equations is not associated.",err,error,*998)
4352  ENDIF
4353  ELSE
4354  CALL flagerror("Nonlinear solver is not associated.",err,error,*998)
4355  ENDIF
4356  ELSE
4357  CALL flagerror("Solver context is not associated.",err,error,*998)
4358  ENDIF
4359 
4360  RETURN
4361 999 CALL distributed_matrix_override_set_off(solvermatrix%matrix,dummyerr,dummyerror,*998)
4362 998 CALL writeerror(err,error,*997)
4363 997 CALL flagwarning("Error evaluating nonlinear Jacobian.",err,error,*996)
4364 996 RETURN
4365 
4366 END SUBROUTINE problem_solverjacobianfdcalculatepetsc
4367 
4368 !
4369 !================================================================================================================================
4370 !
4371 
4373 SUBROUTINE problem_solverresidualevaluatepetsc(snes,x,f,ctx,err)
4374 
4375  USE base_routines
4376  USE cmisspetsctypes
4377  USE distributed_matrix_vector
4378  USE iso_varying_string
4379  USE kinds
4380  USE problem_routines
4381  USE solver_routines
4382  USE strings
4383  USE types
4384 
4385  IMPLICIT NONE
4386 
4387  !Argument variables
4388  TYPE(petscsnestype), INTENT(INOUT) :: snes
4389  TYPE(petscvectype), INTENT(INOUT) :: x
4390  TYPE(petscvectype), INTENT(INOUT) :: f
4391  TYPE(solver_type), POINTER :: ctx
4392  INTEGER(INTG), INTENT(INOUT) :: err
4393  !Local Variables
4394  INTEGER(INTG) :: dummyerr
4395  TYPE(distributed_vector_type), POINTER :: residualvector,solvervector
4396  TYPE(newton_solver_type), POINTER :: newtonsolver
4397  TYPE(nonlinear_solver_type), POINTER :: nonlinearsolver
4398  TYPE(quasi_newton_solver_type), POINTER :: quasinewtonsolver
4399  TYPE(solver_equations_type), POINTER :: solverequations
4400  TYPE(solver_matrices_type), POINTER :: solvermatrices
4401  TYPE(solver_matrix_type), POINTER :: solvermatrix
4402  TYPE(varying_string) :: dummyerror,error,localerror
4403 
4404  IF(ASSOCIATED(ctx)) THEN
4405  nonlinearsolver=>ctx%NONLINEAR_SOLVER
4406  IF(ASSOCIATED(nonlinearsolver)) THEN
4407  newtonsolver=>nonlinearsolver%NEWTON_SOLVER
4408  IF(ASSOCIATED(newtonsolver)) THEN
4409  solverequations=>ctx%SOLVER_EQUATIONS
4410  IF(ASSOCIATED(solverequations)) THEN
4411  solvermatrices=>solverequations%SOLVER_MATRICES
4412  IF(ASSOCIATED(solvermatrices)) THEN
4413  IF(solvermatrices%NUMBER_OF_MATRICES==1) THEN
4414  solvermatrix=>solvermatrices%MATRICES(1)%PTR
4415  IF(ASSOCIATED(solvermatrix)) THEN
4416  solvervector=>solvermatrix%SOLVER_VECTOR
4417  IF(ASSOCIATED(solvervector)) THEN
4418  residualvector=>solvermatrices%RESIDUAL
4419  IF(ASSOCIATED(residualvector)) THEN
4420  CALL distributed_vector_override_set_on(solvervector,x,err,error,*999)
4421  CALL distributed_vector_override_set_on(residualvector,f,err,error,*999)
4422 
4423  CALL problem_solver_residual_evaluate(ctx,err,error,*999)
4424 
4425  CALL distributed_vector_override_set_off(solvervector,err,error,*999)
4426  CALL distributed_vector_override_set_off(residualvector,err,error,*999)
4427  ELSE
4428  CALL flagerror("Residual vector is not associated.",err,error,*997)
4429  ENDIF
4430  ELSE
4431  CALL flagerror("Solver vector is not associated.",err,error,*997)
4432  ENDIF
4433  ELSE
4434  CALL flagerror("Solver matrix is not associated.",err,error,*997)
4435  ENDIF
4436  ELSE
4437  localerror="The number of solver matrices of "// &
4438  & trim(numbertovstring(solvermatrices%NUMBER_OF_MATRICES,"*",err,error))// &
4439  & " is invalid. There should be 1 solver matrix."
4440  CALL flagerror(localerror,err,error,*997)
4441  ENDIF
4442  ELSE
4443  CALL flagerror("Solver equations solver matrices is not associated.",err,error,*997)
4444  ENDIF
4445  ELSE
4446  CALL flagerror("Solver solver equations is not associated.",err,error,*997)
4447  ENDIF
4448 !!TODO: move this to PROBLEM_SOLVER_RESIDUAL_EVALUATE or elsewhere?
4449  nonlinearsolver=>ctx%NONLINEAR_SOLVER
4450  IF(ASSOCIATED(nonlinearsolver)) THEN
4451  SELECT CASE(nonlinearsolver%NONLINEAR_SOLVE_TYPE)
4452  CASE(solver_nonlinear_newton)
4453  newtonsolver=>nonlinearsolver%NEWTON_SOLVER
4454  IF(ASSOCIATED(newtonsolver)) THEN
4455  newtonsolver%TOTAL_NUMBER_OF_FUNCTION_EVALUATIONS=newtonsolver%TOTAL_NUMBER_OF_FUNCTION_EVALUATIONS+1
4456  ELSE
4457  CALL flagerror("Newton solver is not associated.",err,error,*997)
4458  ENDIF
4459  CASE(solver_nonlinear_quasi_newton)
4460  quasinewtonsolver=>nonlinearsolver%QUASI_NEWTON_SOLVER
4461  IF(ASSOCIATED(quasinewtonsolver)) THEN
4462  quasinewtonsolver%TOTAL_NUMBER_OF_FUNCTION_EVALUATIONS=quasinewtonsolver%TOTAL_NUMBER_OF_FUNCTION_EVALUATIONS+1
4463  ELSE
4464  CALL flagerror("Quasi-Newton solver is not associated.",err,error,*997)
4465  ENDIF
4466  CASE DEFAULT
4467  !Do nothing?
4468  END SELECT
4469  ELSE
4470  CALL flagerror("Nonlinear solve is not associated.", err,error,*997)
4471  ENDIF
4472  ELSE
4473  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*997)
4474  ENDIF
4475  ELSE
4476  CALL flagerror("Solver nonlinear solver is not associated.",err,error,*997)
4477  ENDIF
4478  ELSE
4479  CALL flagerror("Solver context is not associated.",err,error,*997)
4480  ENDIF
4481 
4482  RETURN
4483 999 CALL distributed_vector_override_set_off(solvervector,dummyerr,dummyerror,*998)
4484 998 CALL distributed_vector_override_set_off(residualvector,dummyerr,dummyerror,*997)
4485 997 CALL writeerror(err,error,*996)
4486 996 CALL flagwarning("Error evaluating nonlinear residual.",err,error,*995)
4487 995 RETURN
4488 
4489 END SUBROUTINE problem_solverresidualevaluatepetsc
4490 
4491 !
4492 !================================================================================================================================
4493 !
4494 
4496 SUBROUTINE problem_solverconvergencetestpetsc(snes,iterationNumber,xnorm,gnorm,fnorm,reason,ctx,err)
4497 
4498  USE base_routines
4499  USE cmisspetsc
4500  USE cmisspetsctypes
4501  USE distributed_matrix_vector
4502  USE input_output
4503  USE kinds
4504  USE problem_routines
4505  USE solver_routines
4506  USE strings
4507  USE types
4508 
4509  IMPLICIT NONE
4510 
4511  !Argument variables
4512  TYPE(petscsnestype), INTENT(INOUT) :: snes
4513  INTEGER(INTG), INTENT(INOUT) :: iterationnumber
4514  REAL(DP), INTENT(INOUT) :: xnorm
4515  REAL(DP), INTENT(INOUT) :: gnorm
4516  REAL(DP), INTENT(INOUT) :: fnorm
4517  INTEGER(INTG), INTENT(INOUT) :: reason
4518  TYPE(solver_type), POINTER :: ctx
4519  INTEGER(INTG), INTENT(INOUT) :: err
4520  !Local Variables
4521  TYPE(petscvectype) :: x,f,y,w,g
4522  TYPE(newton_solver_type), POINTER :: newtonsolver
4523  TYPE(nonlinear_solver_type), POINTER :: nonlinearsolver
4524  TYPE(quasi_newton_solver_type), POINTER :: quasinewtonsolver
4525  TYPE(petscsneslinesearchtype) :: linesearch
4526  REAL(DP) :: energy,normalisedenergy
4527  TYPE(varying_string) :: error,localerror
4528 
4529  IF(ASSOCIATED(ctx)) THEN
4530  nonlinearsolver=>ctx%NONLINEAR_SOLVER
4531  IF(ASSOCIATED(nonlinearsolver)) THEN
4532  SELECT CASE(nonlinearsolver%NONLINEAR_SOLVE_TYPE)
4533  CASE(solver_nonlinear_newton)
4534  newtonsolver=>nonlinearsolver%NEWTON_SOLVER
4535  IF(ASSOCIATED(newtonsolver)) THEN
4536  reason=petsc_snes_converged_iterating
4537  SELECT CASE(newtonsolver%convergenceTestType)
4538  CASE(solver_newton_convergence_energy_norm)
4539  IF(iterationnumber>0) THEN
4540  CALL petsc_sneslinesearchinitialise(linesearch,err,error,*999)
4541  CALL petsc_snesgetlinesearch(snes,linesearch,err,error,*999)
4542  CALL petsc_vecinitialise(x,err,error,*999)
4543  CALL petsc_vecinitialise(f,err,error,*999)
4544  CALL petsc_vecinitialise(y,err,error,*999)
4545  CALL petsc_vecinitialise(w,err,error,*999)
4546  CALL petsc_vecinitialise(g,err,error,*999)
4547  CALL petsc_sneslinesearchgetvecs(linesearch,x,f,y,w,g,err,error,*999)
4548  CALL petsc_vecdot(y,g,energy,err,error,*999)
4549  IF(iterationnumber==1) THEN
4550  IF(abs(energy)<zero_tolerance) THEN
4551  reason=petsc_snes_converged_fnorm_abs
4552  ELSE
4553  newtonsolver%convergenceTest%energyFirstIter=energy
4554  newtonsolver%convergenceTest%normalisedEnergy=1.0
4555  ENDIF
4556  ELSE
4557  normalisedenergy=energy/newtonsolver%convergenceTest%energyFirstIter
4558  newtonsolver%convergenceTest%normalisedEnergy=normalisedenergy
4559  IF(abs(normalisedenergy)<newtonsolver%ABSOLUTE_TOLERANCE) THEN
4560  reason=petsc_snes_converged_fnorm_abs
4561  newtonsolver%convergenceTest%energyFirstIter=0.0_dp
4562  newtonsolver%convergenceTest%normalisedEnergy=0.0_dp
4563  ENDIF
4564  CALL writestring(general_output_type,"*********************************************",err,error,*999)
4565  CALL writestringvalue(general_output_type,"Normalised energy = ",normalisedenergy,err,error,*999)
4566  CALL writestring(general_output_type,"*********************************************",err,error,*999)
4567  ENDIF
4568  CALL petsc_sneslinesearchfinalise(linesearch,err,error,*999)
4569  ENDIF
4570  CASE(solver_newton_convergence_differentiated_ratio)
4571  CALL flagerror("Differentiated ratio convergence test not implemented.",err,error,*999)
4572  CASE DEFAULT
4573  localerror="The specified convergence test type of "//trim(number_to_vstring( &
4574  & newtonsolver%convergenceTestType,"*",err,error))//" is invalid."
4575  CALL flagerror(localerror,err,error,*999)
4576  END SELECT
4577  ELSE
4578  CALL flagerror("Nonlinear solver Newton solver is not associated.",err,error,*999)
4579  ENDIF
4580  CASE(solver_nonlinear_quasi_newton)
4581  quasinewtonsolver=>nonlinearsolver%QUASI_NEWTON_SOLVER
4582  IF(ASSOCIATED(quasinewtonsolver)) THEN
4583  reason=petsc_snes_converged_iterating
4584  SELECT CASE(quasinewtonsolver%convergenceTestType)
4585  CASE(solver_newton_convergence_energy_norm)
4586  IF(iterationnumber>0) THEN
4587  CALL petsc_sneslinesearchinitialise(linesearch,err,error,*999)
4588  CALL petsc_snesgetlinesearch(snes,linesearch,err,error,*999)
4589  CALL petsc_vecinitialise(x,err,error,*999)
4590  CALL petsc_vecinitialise(f,err,error,*999)
4591  CALL petsc_vecinitialise(y,err,error,*999)
4592  CALL petsc_vecinitialise(w,err,error,*999)
4593  CALL petsc_vecinitialise(g,err,error,*999)
4594  CALL petsc_sneslinesearchgetvecs(linesearch,x,f,y,w,g,err,error,*999)
4595  CALL petsc_vecdot(y,g,energy,err,error,*999)
4596  IF(iterationnumber==1) THEN
4597  IF(abs(energy)<zero_tolerance) THEN
4598  reason=petsc_snes_converged_fnorm_abs
4599  ELSE
4600  quasinewtonsolver%convergenceTest%energyFirstIter=energy
4601  quasinewtonsolver%convergenceTest%normalisedEnergy=1.0
4602  ENDIF
4603  ELSE
4604  normalisedenergy=energy/quasinewtonsolver%convergenceTest%energyFirstIter
4605  quasinewtonsolver%convergenceTest%normalisedEnergy=normalisedenergy
4606  IF(abs(normalisedenergy)<quasinewtonsolver%ABSOLUTE_TOLERANCE) THEN
4607  reason=petsc_snes_converged_fnorm_abs
4608  quasinewtonsolver%convergenceTest%energyFirstIter=0.0_dp
4609  quasinewtonsolver%convergenceTest%normalisedEnergy=0.0_dp
4610  ENDIF
4611  CALL writestring(general_output_type,"*********************************************",err,error,*999)
4612  CALL writestringvalue(general_output_type,"Normalised energy = ",normalisedenergy,err,error,*999)
4613  CALL writestring(general_output_type,"*********************************************",err,error,*999)
4614  ENDIF
4615  CALL petsc_sneslinesearchfinalise(linesearch,err,error,*999)
4616  ELSE
4617  quasinewtonsolver%convergenceTest%energyFirstIter=0.0_dp
4618  quasinewtonsolver%convergenceTest%normalisedEnergy=0.0_dp
4619  ENDIF
4620  CASE(solver_newton_convergence_differentiated_ratio)
4621  CALL flagerror("Differentiated ratio convergence test not implemented.",err,error,*999)
4622  CASE DEFAULT
4623  localerror="The specified convergence test type of "//trim(numbertovstring( &
4624  & quasinewtonsolver%convergenceTestType,"*",err,error))//" is invalid."
4625  CALL flagerror(localerror,err,error,*999)
4626  END SELECT
4627  ELSE
4628  CALL flagerror("Nonlinear solver quasi Newton solver is not associated.",err,error,*999)
4629  ENDIF
4630  CASE DEFAULT
4631  !Do nothing?
4632  END SELECT
4633  ELSE
4634  CALL flagerror("Solver nonlinear solver is not associated.",err,error,*999)
4635  ENDIF
4636  ELSE
4637  CALL flagerror("Solver context is not associated.",err,error,*999)
4638  ENDIF
4639 
4640  RETURN
4641 999 CALL writeerror(err,error,*998)
4642 998 CALL flagwarning("Error in convergence test.",err,error,*997)
4643 997 RETURN
4644 
4645 END SUBROUTINE problem_solverconvergencetestpetsc
4646 
4647 !
4648 !================================================================================================================================
4649 !
4650 
4651 
4653 SUBROUTINE problem_solverdaecellmlrhspetsc(ts,time,states,rates,ctx,err)
4654 
4655  USE base_routines
4656  USE cmisspetsctypes
4657  USE cmisspetsc
4658  USE problem_routines
4659  USE types
4660 
4661  IMPLICIT NONE
4662 
4663  !Argument variables
4664  TYPE(petsctstype), INTENT(INOUT) :: ts
4665  REAL(DP), INTENT(INOUT) :: time
4666  TYPE(petscvectype), INTENT(INOUT) :: states
4667  TYPE(petscvectype), INTENT(INOUT) :: rates
4668  TYPE(cellmlpetsccontexttype), POINTER :: ctx
4669  INTEGER(INTG), INTENT(INOUT) :: err
4670  !Local Variables
4671  TYPE(cellml_type), POINTER :: cellml
4672  TYPE(solver_type), POINTER :: solver
4673  TYPE(varying_string) :: error
4674  INTEGER(INTG) :: dofidx
4675  REAL(DP), POINTER :: statedata(:)
4676 
4677  NULLIFY(statedata)
4678 
4679  IF(ASSOCIATED(ctx)) THEN
4680  solver=>ctx%solver
4681  IF(ASSOCIATED(solver)) THEN
4682  cellml=>ctx%cellml
4683  IF(ASSOCIATED(cellml)) THEN
4684  dofidx=ctx%dofIdx
4685  !Get the state data
4686  NULLIFY(statedata)
4687  CALL petsc_vecgetarrayreadf90(states,statedata,err,error,*999)
4688  !Evaluate the CellML model
4689  CALL problem_solverdaecellmlrhsevaluate(cellml,time,dofidx,statedata,ctx%rates,err,error,*999)
4690  !Restore the state data
4691  CALL petsc_vecrestorearrayreadf90(states,statedata,err,error,*999)
4692  !Set the PETSc rates vector
4693  CALL petsc_vecsetvalues(rates,SIZE(statedata,1),ctx%ratesIndices,ctx%rates,petsc_insert_values,err,error,*999)
4694  CALL vecassemblybegin(rates,err,error,*999)
4695  CALL vecassemblyend(rates,err,error,*999)
4696  ELSE
4697  CALL flagerror("Context cellml is not associated.",err,error,*999)
4698  ENDIF
4699  ELSE
4700  CALL flagerror("Context solver is not associated.",err,error,*999)
4701  ENDIF
4702  ELSE
4703  CALL flagerror("Context is not associated.",err,error,*999)
4704  ENDIF
4705 
4706  RETURN
4707 999 CALL writeerror(err,error,*998)
4708 998 CALL flagwarning("Error calling Problem_SolverDAECellMLRHSPetsc routine from PETSc.",err,error,*997)
4709 997 RETURN
4710 
4711 END SUBROUTINE problem_solverdaecellmlrhspetsc
4712 
4713 
4714 !
4715 !================================================================================================================================
4716 !
4717 
4719 SUBROUTINE problem_solvernonlinearmonitorpetsc(snes,iterationNumber,residualNorm,context,err)
4720 
4721  USE base_routines
4722  USE cmisspetsctypes
4723  USE distributed_matrix_vector
4724  USE iso_varying_string
4725  USE kinds
4726  USE problem_routines
4727  USE strings
4728  USE types
4729 
4730  IMPLICIT NONE
4731 
4732  !Argument variables
4733  TYPE(petscsnestype), INTENT(INOUT) :: snes
4734  INTEGER(INTG), INTENT(INOUT) :: iterationnumber
4735  REAL(DP), INTENT(INOUT) :: residualnorm
4736  TYPE(solver_type), POINTER :: context
4737  INTEGER(INTG), INTENT(INOUT) :: err
4738  !Local Variables
4739  TYPE(nonlinear_solver_type), POINTER :: nonlinearsolver
4740  TYPE(solver_type), POINTER :: solver
4741  TYPE(varying_string) :: error
4742 
4743  IF(ASSOCIATED(context)) THEN
4744  nonlinearsolver=>context%NONLINEAR_SOLVER
4745  IF(ASSOCIATED(nonlinearsolver)) THEN
4746  solver=>nonlinearsolver%SOLVER
4747  IF(ASSOCIATED(solver)) THEN
4748  CALL problem_solvernonlinearmonitor(solver,iterationnumber,residualnorm,err,error,*999)
4749  ELSE
4750  CALL flagerror("Solver is not associated.",err,error,*999)
4751  ENDIF
4752  ELSE
4753  CALL flagerror("Solver nonlinear solver is not associated.",err,error,*999)
4754  ENDIF
4755  ELSE
4756  CALL flagerror("Solver context is not associated.",err,error,*999)
4757  ENDIF
4758 
4759  RETURN
4760 
4761 999 CALL writeerror(err,error,*998)
4762 998 CALL flagwarning("Error evaluating nonlinear residual.",err,error,*997)
4763 997 RETURN
4764 
4765 END SUBROUTINE problem_solvernonlinearmonitorpetsc
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
distributed_matrix_vector::distributed_vector_override_set_on
subroutine, public distributed_vector_override_set_on(DISTRIBUTED_VECTOR, OVERRIDE_VECTOR, ERR, ERROR,)
Sets the override vector for a distributed vector.
Definition: distributed_matrix_vector.f90:7391
types::cellml_equations_type
Contains information about the CellML equations for a solver.
Definition: types.f90:2475
solver_matrices_routines
This module handles all solver matrix and rhs routines.
Definition: solver_matrices_routines.f90:45
problem_constants
This module handles all problem wide constants.
Definition: problem_constants.f90:45
multi_physics_routines
This module handles all multi physics class routines.
Definition: multi_physics_routines.f90:46
strings::number_to_vstring
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
cmisspetsc
This module is a CMISS buffer module to the PETSc library.
Definition: cmiss_petsc.f90:45
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
cmisspetsctypes
This module contains types related to the PETSc library.
Definition: cmiss_petsc_types.f90:45
types::solver_type
Contains information on the type of solver to be used.
Definition: types.f90:2777
types::quasi_newton_linesearch_solver_type
Contains information for a Quasi-Newton line search nonlinear solver.
Definition: types.f90:2680
elasticity_routines
This module handles all elasticity class routines.
Definition: elasticity_routines.f90:45
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
base_routines::flagwarning
Flags a warning to the user.
Definition: base_routines.f90:246
types::solvers_type
Contains information on the solvers to be used in a control loop.
Definition: types.f90:2805
solver_routines::solver_full_matrices
integer(intg), parameter, public solver_full_matrices
Use fully populated solver matrices.
Definition: solver_routines.f90:361
cmisspetsc::petsc_snescomputejacobiandefault
subroutine, public petsc_snescomputejacobiandefault(snes, x, j, b, ctx, err, error,)
Buffer routine to the PETSc SNESComputeJacobianDefault routine.
Definition: cmiss_petsc.f90:4523
timer
This module contains routines for timing the program.
Definition: timer_f.f90:45
types::problems_type
Contains information on the problems defined.
Definition: types.f90:3236
types::field_type
Contains information for a field defined on a region.
Definition: types.f90:1346
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
types::control_loop_type
Contains information on a control loop.
Definition: types.f90:3185
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_sparse_matrices
integer(intg), parameter, public solver_sparse_matrices
Use sparse solver matrices.
Definition: solver_routines.f90:360
cmisspetsc::petsc_snescomputejacobiandefaultcolor
subroutine, public petsc_snescomputejacobiandefaultcolor(snes, x, j, b, ctx, err, error,)
Buffer routine to the PETSc SNESComputeJacobianDefaultColor routine.
Definition: cmiss_petsc.f90:4556
classical_field_routines
This module handles all classical field class routines.
Definition: classical_field_routines.f90:45
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::newton_solver_type
Contains information for a Newton nonlinear solver.
Definition: types.f90:2659
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
types::cellmlpetsccontexttype
Contains information on the solver, cellml, dof etc. for which cellml equations are to be evaluated b...
Definition: types.f90:2318
types::problem_setup_type
Definition: types.f90:3215
types::nonlinear_solver_type
Contains information for a nonlinear solver.
Definition: types.f90:2731
cmisspetsc::petsc_snesgetlinesearch
subroutine, public petsc_snesgetlinesearch(snes, lineSearch, err, error,)
Buffer routine to the PETSc SNESGetLineSearch routine.
Definition: cmiss_petsc.f90:4875
distributed_matrix_vector::distributed_matrix_override_set_on
subroutine, public distributed_matrix_override_set_on(DISTRIBUTED_MATRIX, OVERRIDE_MATRIX, ERR, ERROR,)
Sets the override matrix for a distributed matrix.
Definition: distributed_matrix_vector.f90:2554
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
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
base_routines::general_output_type
integer(intg), parameter, public general_output_type
General output type.
Definition: base_routines.f90:66
types::solver_matrix_type
Contains information on the solver matrix.
Definition: types.f90:2411
fluid_mechanics_routines
This module handles all fluid mechanics class routines.
Definition: fluid_mechanics_routines.f90:50
iso_varying_string::trim
Definition: iso_varying_string.f90:204
control_loop_routines::control_loop_get
Returns the specified control loop as indexed by the control loop identifier from the control loop ro...
Definition: control_loop_routines.f90:86
types::quasi_newton_solver_type
Contains information for a Quasi-Newton nonlinear solver.
Definition: types.f90:2706
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
cmisspetsc::petsc_sneslinesearchgetvecs
subroutine, public petsc_sneslinesearchgetvecs(lineSearch, x, f, y, w, g, err, error,)
Buffer routine to the PETSc SNESLineSearchGetVecs routine.
Definition: cmiss_petsc.f90:5585
cmisspetsc::petsc_vecinitialise
subroutine, public petsc_vecinitialise(x, err, error,)
Definition: cmiss_petsc.f90:6426
input_output::writestringvalue
Write a string followed by a value to a given output stream.
Definition: input_output.f90:97
cmisspetsc::petsc_vecrestorearrayreadf90
subroutine, public petsc_vecrestorearrayreadf90(x, array, err, error,)
Buffer routine to the PETSc VecRestoreArrayReadF90 routine.
Definition: cmiss_petsc.f90:7255
problem_constants::problem_setup_finish_action
integer(intg), parameter problem_setup_finish_action
Finish setup action.
Definition: problem_constants.f90:274
types::solver_equations_type
Contains information about the solver equations for a solver.
Definition: types.f90:2452
types::problem_type
Contains information for a problem.
Definition: types.f90:3221
problem_constants::problem_setup_cellml_equations_type
integer(intg), parameter problem_setup_cellml_equations_type
CellML equations setup for a problem.
Definition: problem_constants.f90:266
solver_routines::solver_nonlinear_newton
integer(intg), parameter, public solver_nonlinear_newton
Newton nonlinear solver type.
Definition: solver_routines.f90:164
base_routines::writeerror
subroutine, public writeerror(err, error,)
Writes the error string.
Definition: base_routines.f90:1402
types::distributed_vector_type
Contains the information for a vector that is distributed across a number of domains.
Definition: types.f90:786
distributed_matrix_vector::distributed_vector_override_set_off
subroutine, public distributed_vector_override_set_off(DISTRIBUTED_VECTOR, ERR, ERROR,)
Turns off the override vector for a distributed vector.
Definition: distributed_matrix_vector.f90:7438
distributed_matrix_vector
This module handles all distributed matrix vector routines.
Definition: distributed_matrix_vector.f90:45
interface_conditions_constants
This module defines all constants shared across interface condition routines.
Definition: interface_conditions_constants.f90:45
solver_routines
This module handles all solver routines.
Definition: solver_routines.f90:45
field_io_routines
Implements lists of Field IO operation.
Definition: field_IO_routines.f90:46
reaction_diffusion_equation_routines
This module handles all reaction diffusion equation routines.
Definition: reaction_diffusion_equation_routines.f90:45
solver_matrices_routines::solver_matrices_jacobian_only
integer(intg), parameter, public solver_matrices_jacobian_only
Select only the Jacobian solver matrix.
Definition: solver_matrices_routines.f90:75
types::solver_matrices_type
Contains information on the solver matrices and rhs vector.
Definition: types.f90:2427
types::field_variable_type
Contains information for a field variable defined on a field.
Definition: types.f90:1289
input_output::writestring
Write a string to a given output stream.
Definition: input_output.f90:80
fitting_routines
This module handles all Galerkin projection routines.
Definition: fitting_routines.f90:45
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
cmisspetsc::petsc_vecdot
subroutine, public petsc_vecdot(x, y, dotProduct, err, error,)
Buffer routine to the PETSc VecDot routine.
Definition: cmiss_petsc.f90:6837
problem_constants::problem_setup_start_action
integer(intg), parameter problem_setup_start_action
Start setup action.
Definition: problem_constants.f90:273
cmisspetsc::petsc_sneslinesearchinitialise
subroutine, public petsc_sneslinesearchinitialise(lineSearch, err, error,)
Definition: cmiss_petsc.f90:5470
control_loop_routines
This module handles all control loop routines.
Definition: control_loop_routines.f90:45
equations_set_constants
This module defines all constants shared across equations set routines.
Definition: equations_set_constants.f90:45
bioelectric_routines
This module handles all bioelectric class routines.
Definition: bioelectric_routines.f90:45
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
cmisspetsc::petsc_sneslinesearchfinalise
subroutine, public petsc_sneslinesearchfinalise(lineSearch, err, error,)
Definition: cmiss_petsc.f90:5445
types::newton_linesearch_solver_type
Contains information for a Newton line search nonlinear solver.
Definition: types.f90:2626
distributed_matrix_vector::distributed_matrix_override_set_off
subroutine, public distributed_matrix_override_set_off(DISTRIBUTED_MATRIX, ERR, ERROR,)
Turns off the override matrix for a distributed matrix.
Definition: distributed_matrix_vector.f90:2601
equations_set_routines
This module handles all equations set routines.
Definition: equations_set_routines.f90:45
cmisspetsc::petsc_vecgetarrayreadf90
subroutine, public petsc_vecgetarrayreadf90(x, array, err, error,)
Buffer routine to the PETSc VecGetArrayReadF90 routine.
Definition: cmiss_petsc.f90:6904
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
finite_elasticity_routines
This module handles all finite elasticity routines.
Definition: finite_elasticity_routines.f90:45
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_solve
recursive subroutine, public solver_solve(SOLVER, ERR, ERROR,)
Solve the problem.
Definition: solver_routines.f90:21269
types::cellml_type
Contains information for a CellML environment.
Definition: types.f90:2372
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
solver_matrices_routines::solver_matrices_output
subroutine, public solver_matrices_output(ID, SELECTION_TYPE, SOLVER_MATRICES, ERR, ERROR,)
Outputs the solver matrices.
Definition: solver_matrices_routines.f90:490
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45