170 INTEGER(INTG),
INTENT(OUT) :: ERR
176 enters(
"EQUATIONS_SET_ANALYTIC_CREATE_FINISH",err,error,*999)
178 IF(
ASSOCIATED(equations_set))
THEN 179 IF(
ASSOCIATED(equations_set%ANALYTIC))
THEN 180 IF(equations_set%ANALYTIC%ANALYTIC_FINISHED)
THEN 181 CALL flagerror(
"Equations set analytic has already been finished.",err,error,*999)
187 analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
188 IF(
ASSOCIATED(analytic_field))
THEN 189 equations_set_setup_info%FIELD_USER_NUMBER=analytic_field%USER_NUMBER
190 equations_set_setup_info%FIELD=>analytic_field
197 equations_set%ANALYTIC%ANALYTIC_FINISHED=.true.
200 CALL flagerror(
"The equations set analytic is not associated.",err,error,*999)
203 CALL flagerror(
"Equations set is not associated.",err,error,*999)
206 exits(
"EQUATIONS_SET_ANALYTIC_CREATE_FINISH")
208 999 errorsexits(
"EQUATIONS_SET_ANALYTIC_CREATE_FINISH",err,error)
222 INTEGER(INTG),
INTENT(IN) :: ANALYTIC_FUNCTION_TYPE
223 INTEGER(INTG),
INTENT(IN) :: ANALYTIC_FIELD_USER_NUMBER
225 INTEGER(INTG),
INTENT(OUT) :: ERR
228 INTEGER(INTG) :: DUMMY_ERR
230 TYPE(
field_type),
POINTER :: FIELD,GEOMETRIC_FIELD
231 TYPE(
region_type),
POINTER :: REGION,ANALYTIC_FIELD_REGION
234 enters(
"EQUATIONS_SET_ANALYTIC_CREATE_START",err,error,*998)
236 IF(
ASSOCIATED(equations_set))
THEN 237 IF(
ASSOCIATED(equations_set%ANALYTIC))
THEN 238 CALL flagerror(
"The equations set analytic is already associated.",err,error,*998)
240 region=>equations_set%REGION
241 IF(
ASSOCIATED(region))
THEN 242 IF(
ASSOCIATED(analytic_field))
THEN 244 IF(analytic_field%FIELD_FINISHED)
THEN 246 IF(analytic_field_user_number/=analytic_field%USER_NUMBER)
THEN 247 local_error=
"The specified analytic field user number of "// &
249 &
" does not match the user number of the specified analytic field of "// &
251 CALL flagerror(local_error,err,error,*999)
253 analytic_field_region=>analytic_field%REGION
254 IF(
ASSOCIATED(analytic_field_region))
THEN 256 IF(analytic_field_region%USER_NUMBER/=region%USER_NUMBER)
THEN 257 local_error=
"Invalid region setup. The specified analytic field has been created on region number "// &
259 &
" and the specified equations set has been created on region number "// &
261 CALL flagerror(local_error,err,error,*999)
264 geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
265 IF(
ASSOCIATED(geometric_field))
THEN 266 IF(.NOT.
ASSOCIATED(geometric_field%DECOMPOSITION,analytic_field%DECOMPOSITION))
THEN 267 CALL flagerror(
"The specified analytic field does not have the same decomposition as the geometric "// &
268 &
"field for the specified equations set.",err,error,*999)
271 CALL flagerror(
"The geometric field is not associated for the specified equations set.",err,error,*999)
274 CALL flagerror(
"The specified analytic field region is not associated.",err,error,*999)
277 CALL flagerror(
"The specified analytic field has not been finished.",err,error,*999)
282 CALL field_user_number_find(analytic_field_user_number,region,field,err,error,*999)
283 IF(
ASSOCIATED(field))
THEN 284 local_error=
"The specified analytic field user number of "// &
286 &
"has already been used to create a field on region number "// &
288 CALL flagerror(local_error,err,error,*999)
293 IF(.NOT.
ASSOCIATED(analytic_field)) equations_set%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED=.true.
298 equations_set_setup_info%FIELD_USER_NUMBER=analytic_field_user_number
299 equations_set_setup_info%FIELD=>analytic_field
300 equations_set_setup_info%ANALYTIC_FUNCTION_TYPE=analytic_function_type
306 IF(equations_set%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED)
THEN 307 analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
309 equations_set%ANALYTIC%ANALYTIC_FIELD=>analytic_field
312 CALL flagerror(
"Equations set region is not associated.",err,error,*999)
316 CALL flagerror(
"Equations set is not associated.",err,error,*998)
319 exits(
"EQUATIONS_SET_ANALYTIC_CREATE_START")
322 998 errorsexits(
"EQUATIONS_SET_ANALYTIC_CREATE_START",err,error)
335 INTEGER(INTG),
INTENT(OUT) :: ERR
339 enters(
"EQUATIONS_SET_ANALYTIC_DESTROY",err,error,*999)
341 IF(
ASSOCIATED(equations_set))
THEN 342 IF(
ASSOCIATED(equations_set%ANALYTIC))
THEN 345 CALL flagerror(
"Equations set analytic is not associated.",err,error,*999)
348 CALL flagerror(
"Equations set is not associated.",err,error,*999)
351 exits(
"EQUATIONS_SET_ANALYTIC_DESTROY")
353 999 errorsexits(
"EQUATIONS_SET_ANALYTIC_DESTROY",err,error)
366 INTEGER(INTG),
INTENT(OUT) :: ERR
369 INTEGER(INTG) :: component_idx,derivative_idx,element_idx,Gauss_idx,GLOBAL_DERIV_INDEX,local_ny,node_idx, &
370 & NUMBER_OF_ANALYTIC_COMPONENTS,NUMBER_OF_DIMENSIONS,variable_idx, &
371 & variable_type,version_idx
372 REAL(DP) :: NORMAL(3),POSITION(3),TANGENTS(3,3),VALUE
373 REAL(DP) :: ANALYTIC_DUMMY_VALUES(1)=0.0_dp
374 REAL(DP) :: MATERIALS_DUMMY_VALUES(1)=0.0_dp
375 LOGICAL :: reverseNormal=.false.
380 TYPE(
field_type),
POINTER :: ANALYTIC_FIELD,DEPENDENT_FIELD,GEOMETRIC_FIELD,MATERIALS_FIELD
382 & MATERIALS_INTERP_PARAMETERS(:)
384 & MATERIALS_INTERP_POINT(:)
390 enters(
"EQUATIONS_SET_ANALYTIC_EVALUATE",err,error,*999)
392 IF(
ASSOCIATED(equations_set))
THEN 393 IF(
ASSOCIATED(equations_set%ANALYTIC))
THEN 394 IF(equations_set%ANALYTIC%ANALYTIC_FINISHED)
THEN 395 dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
396 IF(
ASSOCIATED(dependent_field))
THEN 397 geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
398 IF(
ASSOCIATED(geometric_field))
THEN 399 CALL field_numberofcomponentsget(geometric_field,field_u_variable_type,number_of_dimensions,err,error,*999)
400 CALL field_interpolationparametersinitialise(geometric_field,geometric_interp_parameters,err,error,*999)
401 CALL field_interpolatedpointsinitialise(geometric_interp_parameters,geometric_interp_point,err,error,*999)
402 CALL field_interpolatedpointsmetricsinitialise(geometric_interp_point,geometric_interpolated_point_metrics, &
404 analytic_field=>equations_set%ANALYTIC%ANALYTIC_FIELD
405 IF(
ASSOCIATED(analytic_field))
THEN 406 CALL field_numberofcomponentsget(analytic_field,field_u_variable_type,number_of_analytic_components, &
408 CALL field_interpolationparametersinitialise(analytic_field,analytic_interp_parameters,err,error,*999)
409 CALL field_interpolatedpointsinitialise(analytic_interp_parameters,analytic_interp_point,err,error,*999)
410 CALL field_physicalpointsinitialise(analytic_interp_point,geometric_interp_point,analytic_physical_point, &
413 NULLIFY(materials_field)
414 IF(
ASSOCIATED(equations_set%MATERIALS))
THEN 415 materials_field=>equations_set%MATERIALS%MATERIALS_FIELD
416 CALL field_numberofcomponentsget(materials_field,field_u_variable_type,number_of_analytic_components, &
418 CALL field_interpolationparametersinitialise(materials_field,materials_interp_parameters,err,error,*999)
419 CALL field_interpolatedpointsinitialise(materials_interp_parameters,materials_interp_point,err,error,*999)
420 CALL field_physicalpointsinitialise(materials_interp_point,geometric_interp_point,materials_physical_point, &
423 DO variable_idx=1,dependent_field%NUMBER_OF_VARIABLES
424 variable_type=dependent_field%VARIABLES(variable_idx)%VARIABLE_TYPE
425 field_variable=>dependent_field%VARIABLE_TYPE_MAP(variable_type)%PTR
426 IF(
ASSOCIATED(field_variable))
THEN 427 DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
428 domain=>field_variable%COMPONENTS(component_idx)%DOMAIN
429 IF(
ASSOCIATED(domain))
THEN 430 IF(
ASSOCIATED(domain%TOPOLOGY))
THEN 431 SELECT CASE(field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE)
432 CASE(field_constant_interpolation)
433 CALL flagerror(
"Cannot evaluate an analytic solution for a constant interpolation components.", &
435 CASE(field_element_based_interpolation)
436 domain_elements=>domain%TOPOLOGY%ELEMENTS
437 IF(
ASSOCIATED(domain_elements))
THEN 439 DO element_idx=1,domain_elements%NUMBER_OF_ELEMENTS
440 basis=>domain_elements%ELEMENTS(element_idx)%BASIS
441 CALL field_interpolationparameterselementget(field_values_set_type,element_idx, &
442 & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
443 IF(
ASSOCIATED(analytic_field))
THEN 444 CALL field_interpolationparameterselementget(field_values_set_type,element_idx, &
445 & analytic_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
447 IF(
ASSOCIATED(materials_field))
THEN 448 CALL field_interpolationparameterselementget(field_values_set_type,element_idx, &
449 & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
452 & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
454 & geometric_interpolated_point_metrics(field_u_variable_type)%PTR,err,error,*999)
455 CALL field_positionnormaltangentscalculateintptmetric( &
456 & geometric_interpolated_point_metrics(field_u_variable_type)%PTR,reversenormal, &
457 & position,normal,tangents,err,error,*999)
458 IF(
ASSOCIATED(analytic_field))
THEN 459 CALL field_interpolate_xi(
no_part_deriv,[0.5_dp,0.5_dp,0.5_dp], &
460 & analytic_interp_point(field_u_variable_type)%PTR,err,error,*999)
462 IF(
ASSOCIATED(materials_field))
THEN 463 CALL field_interpolate_xi(
no_part_deriv,[0.5_dp,0.5_dp,0.5_dp], &
464 & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
467 IF(
ASSOCIATED(analytic_field))
THEN 468 IF(
ASSOCIATED(materials_field))
THEN 470 & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
471 & variable_type,global_deriv_index,component_idx, &
472 & analytic_interp_point(field_u_variable_type)%PTR%VALUES(:,
no_part_deriv), &
473 & materials_interp_point(field_u_variable_type)%PTR%VALUES(:,
no_part_deriv), &
474 &
VALUE,err,error,*999)
477 & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
478 & variable_type,global_deriv_index,component_idx, &
479 & analytic_interp_point(field_u_variable_type)%PTR%VALUES(:,
no_part_deriv), &
480 & materials_dummy_values,
VALUE,err,error,*999)
483 IF(
ASSOCIATED(materials_field))
THEN 485 & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
486 & variable_type,global_deriv_index,component_idx,analytic_dummy_values, &
487 & materials_interp_point(field_u_variable_type)%PTR%VALUES(:,
no_part_deriv), &
488 &
VALUE,err,error,*999)
491 & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
492 & variable_type,global_deriv_index,component_idx,analytic_dummy_values, &
493 & materials_dummy_values,
VALUE,err,error,*999)
496 local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
497 & element_param2dof_map%ELEMENTS(element_idx)
498 CALL field_parametersetupdatelocaldof(dependent_field,variable_type, &
499 & field_analytic_values_set_type,local_ny,
VALUE,err,error,*999)
502 CALL flagerror(
"Domain topology elements is not associated.",err,error,*999)
504 CASE(field_node_based_interpolation)
505 domain_nodes=>domain%TOPOLOGY%NODES
506 IF(
ASSOCIATED(domain_nodes))
THEN 508 DO node_idx=1,domain_nodes%NUMBER_OF_NODES
509 CALL field_positionnormaltangentscalculatenode(dependent_field,variable_type,component_idx, &
510 & node_idx,position,normal,tangents,err,error,*999)
511 IF(
ASSOCIATED(analytic_field))
THEN 512 CALL field_interpolate_field_node(
no_physical_deriv,field_values_set_type,analytic_field, &
513 & field_u_variable_type,component_idx,node_idx,analytic_physical_point( &
514 & field_u_variable_type)%PTR,err,error,*999)
516 IF(
ASSOCIATED(materials_field))
THEN 517 CALL field_interpolate_field_node(
no_physical_deriv,field_values_set_type,materials_field, &
518 & field_u_variable_type,component_idx,node_idx,materials_physical_point( &
519 & field_u_variable_type)%PTR,err,error,*999)
522 DO derivative_idx=1,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
523 global_deriv_index=domain_nodes%NODES(node_idx)%DERIVATIVES(derivative_idx)% &
524 & global_derivative_index
526 IF(
ASSOCIATED(analytic_field))
THEN 527 IF(
ASSOCIATED(materials_field))
THEN 529 & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
530 & variable_type,global_deriv_index,component_idx, &
531 & analytic_physical_point(field_u_variable_type)%PTR%VALUES, &
532 & materials_physical_point(field_u_variable_type)%PTR%VALUES,
VALUE,err,error,*999)
535 & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
536 & variable_type,global_deriv_index,component_idx, &
537 & analytic_physical_point(field_u_variable_type)%PTR%VALUES, &
538 & materials_dummy_values,
VALUE,err,error,*999)
541 IF(
ASSOCIATED(materials_field))
THEN 543 & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
544 & variable_type,global_deriv_index,component_idx,analytic_dummy_values, &
545 & materials_physical_point(field_u_variable_type)%PTR%VALUES,
VALUE,err,error,*999)
548 & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
549 & variable_type,global_deriv_index,component_idx,analytic_dummy_values, &
550 & materials_dummy_values,
VALUE,err,error,*999)
554 DO version_idx=1,domain_nodes%NODES(node_idx)%DERIVATIVES(derivative_idx)%numberOfVersions
555 local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
556 & node_param2dof_map%NODES(node_idx)%DERIVATIVES(derivative_idx)%VERSIONS(version_idx)
557 CALL field_parametersetupdatelocaldof(dependent_field,variable_type, &
558 & field_analytic_values_set_type,local_ny,
VALUE,err,error,*999)
563 CALL flagerror(
"Domain topology nodes is not associated.",err,error,*999)
565 CASE(field_grid_point_based_interpolation)
566 CALL flagerror(
"Not implemented.",err,error,*999)
567 CASE(field_gauss_point_based_interpolation)
568 domain_elements=>domain%TOPOLOGY%ELEMENTS
569 IF(
ASSOCIATED(domain_elements))
THEN 571 DO element_idx=1,domain_elements%NUMBER_OF_ELEMENTS
572 basis=>domain_elements%ELEMENTS(element_idx)%BASIS
573 CALL field_interpolationparameterselementget(field_values_set_type,element_idx, &
574 & geometric_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
575 IF(
ASSOCIATED(analytic_field))
THEN 576 CALL field_interpolationparameterselementget(field_values_set_type,element_idx, &
577 & analytic_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
579 IF(
ASSOCIATED(materials_field))
THEN 580 CALL field_interpolationparameterselementget(field_values_set_type,element_idx, &
581 & materials_interp_parameters(field_u_variable_type)%PTR,err,error,*999)
587 & geometric_interp_point(field_u_variable_type)%PTR,err,error,*999)
589 & geometric_interpolated_point_metrics(field_u_variable_type)%PTR,err,error,*999)
590 CALL field_positionnormaltangentscalculateintptmetric( &
591 & geometric_interpolated_point_metrics(field_u_variable_type)%PTR,reversenormal, &
592 & position,normal,tangents,err,error,*999)
593 IF(
ASSOCIATED(analytic_field))
THEN 595 & analytic_interp_point(field_u_variable_type)%PTR,err,error,*999)
597 IF(
ASSOCIATED(materials_field))
THEN 599 & materials_interp_point(field_u_variable_type)%PTR,err,error,*999)
602 IF(
ASSOCIATED(analytic_field))
THEN 603 IF(
ASSOCIATED(materials_field))
THEN 605 & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
606 & variable_type,global_deriv_index,component_idx, &
607 & analytic_interp_point(field_u_variable_type)%PTR%VALUES(:,
no_part_deriv), &
608 & materials_interp_point(field_u_variable_type)%PTR%VALUES(:,
no_part_deriv), &
609 &
VALUE,err,error,*999)
612 & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
613 & variable_type,global_deriv_index,component_idx, &
614 & analytic_interp_point(field_u_variable_type)%PTR%VALUES(:,
no_part_deriv), &
615 & materials_dummy_values,
VALUE,err,error,*999)
618 IF(
ASSOCIATED(materials_field))
THEN 620 & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
621 & variable_type,global_deriv_index,component_idx,analytic_dummy_values, &
622 & materials_interp_point(field_u_variable_type)%PTR%VALUES(:,
no_part_deriv), &
623 &
VALUE,err,error,*999)
626 & analytic_function_type,position,tangents,normal,equations_set%ANALYTIC%ANALYTIC_TIME, &
627 & variable_type,global_deriv_index,component_idx,analytic_dummy_values, &
628 & materials_dummy_values,
VALUE,err,error,*999)
631 local_ny=field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP% &
632 & gauss_point_param2dof_map%GAUSS_POINTS(gauss_idx,element_idx)
633 CALL field_parametersetupdatelocaldof(dependent_field,variable_type, &
634 & field_analytic_values_set_type,local_ny,
VALUE,err,error,*999)
638 CALL flagerror(
"Domain topology elements is not associated.",err,error,*999)
642 & components(component_idx)%INTERPOLATION_TYPE,
"*",err,error))// &
645 CALL flagerror(local_error,err,error,*999)
648 CALL flagerror(
"Domain topology is not associated.",err,error,*999)
651 CALL flagerror(
"Domain is not associated.",err,error,*999)
654 CALL field_parametersetupdatestart(dependent_field,variable_type, &
655 & field_analytic_values_set_type,err,error,*999)
656 CALL field_parametersetupdatefinish(dependent_field,variable_type, &
657 & field_analytic_values_set_type,err,error,*999)
659 CALL flagerror(
"Field variable is not associated.",err,error,*999)
662 IF(
ASSOCIATED(materials_field))
THEN 663 CALL field_physical_points_finalise(materials_physical_point,err,error,*999)
664 CALL field_interpolated_points_finalise(materials_interp_point,err,error,*999)
665 CALL field_interpolation_parameters_finalise(materials_interp_parameters,err,error,*999)
667 IF(
ASSOCIATED(analytic_field))
THEN 668 CALL field_physical_points_finalise(analytic_physical_point,err,error,*999)
669 CALL field_interpolated_points_finalise(analytic_interp_point,err,error,*999)
670 CALL field_interpolation_parameters_finalise(analytic_interp_parameters,err,error,*999)
672 CALL field_interpolatedpointsmetricsfinalise(geometric_interpolated_point_metrics,err,error,*999)
673 CALL field_interpolated_points_finalise(geometric_interp_point,err,error,*999)
674 CALL field_interpolation_parameters_finalise(geometric_interp_parameters,err,error,*999)
677 CALL flagerror(
"Equations set geometric field is not associated.",err,error,*999)
680 CALL flagerror(
"Equations set dependent field is not associated.",err,error,*999)
683 CALL flagerror(
"Equations set analytic has not been finished.",err,error,*999)
686 CALL flagerror(
"Equations set analytic is not associated.",err,error,*999)
689 CALL flagerror(
"Equations set is not associated.",err,error,*999)
692 exits(
"EQUATIONS_SET_ANALYTIC_EVALUATE")
694 999 errorsexits(
"EQUATIONS_SET_ANALYTIC_EVALUATE",err,error)
708 INTEGER(INTG),
INTENT(OUT) :: ERR
712 enters(
"EQUATIONS_SET_ANALYTIC_FINALISE",err,error,*999)
714 IF(
ASSOCIATED(equations_set_analytic))
THEN 715 DEALLOCATE(equations_set_analytic)
718 exits(
"EQUATIONS_SET_ANALYTIC_FINALISE")
720 999 errorsexits(
"EQUATIONS_SET_ANALYTIC_FINALISE",err,error)
730 & variable_type,global_derivative,component_number,analytic_parameters,materials_parameters,
VALUE,err,error,*)
734 INTEGER(INTG),
INTENT(IN) :: ANALYTIC_FUNCTION_TYPE
735 REAL(DP),
INTENT(IN) :: POSITION(:)
736 REAL(DP),
INTENT(IN) :: TANGENTS(:,:)
737 REAL(DP),
INTENT(IN) :: NORMAL(:)
738 REAL(DP),
INTENT(IN) :: TIME
739 INTEGER(INTG),
INTENT(IN) :: VARIABLE_TYPE
740 INTEGER(INTG),
INTENT(IN) :: GLOBAL_DERIVATIVE
741 INTEGER(INTG),
INTENT(IN) :: COMPONENT_NUMBER
742 REAL(DP),
INTENT(IN) :: ANALYTIC_PARAMETERS(:)
743 REAL(DP),
INTENT(IN) :: MATERIALS_PARAMETERS(:)
744 REAL(DP),
INTENT(OUT) ::
VALUE 745 INTEGER(INTG),
INTENT(OUT) :: ERR
750 enters(
"EQUATIONS_SET_ANALYTIC_FUNCTIONS_EVALUATE",err,error,*999)
752 IF(
ASSOCIATED(equations_set))
THEN 753 IF(.NOT.
ALLOCATED(equations_set%SPECIFICATION))
THEN 754 CALL flagerror(
"Equations set specification is not allocated.",err,error,*999)
755 ELSE IF(
SIZE(equations_set%SPECIFICATION,1)<1)
THEN 756 CALL flagerror(
"Equations set specification must have at least one entry.",err,error,*999)
758 SELECT CASE(equations_set%SPECIFICATION(1))
760 CALL flagerror(
"Not implemented.",err,error,*999)
762 CALL flagerror(
"Not implemented.",err,error,*999)
764 CALL flagerror(
"Not implemented.",err,error,*999)
766 IF(
SIZE(equations_set%SPECIFICATION,1)<2)
THEN 767 CALL flagerror(
"Equations set specification must have at least two entries for a "// &
768 &
"classical field equations set.",err,error,*999)
771 & analytic_function_type,position,tangents,normal,time,variable_type,global_derivative, &
772 & component_number,analytic_parameters,materials_parameters,
VALUE,err,error,*999)
774 CALL flagerror(
"Not implemented.",err,error,*999)
776 CALL flagerror(
"Not implemented.",err,error,*999)
778 CALL flagerror(
"Not implemented.",err,error,*999)
780 CALL flagerror(
"Not implemented.",err,error,*999)
782 local_error=
"The first equations set specification of "// &
787 CALL flagerror(
"Equations set is not associated.",err,error,*999)
790 exits(
"EQUATIONS_SET_ANALYTIC_FUNCTIONS_EVALUATE")
792 999 errorsexits(
"EQUATIONS_SET_ANALYTIC_FUNCTIONS_EVALUATE",err,error)
806 INTEGER(INTG),
INTENT(OUT) :: ERR
809 INTEGER(INTG) :: DUMMY_ERR
812 enters(
"EQUATIONS_SET_ANALYTIC_INITIALISE",err,error,*998)
814 IF(
ASSOCIATED(equations_set))
THEN 815 IF(
ASSOCIATED(equations_set%ANALYTIC))
THEN 816 CALL flagerror(
"Analytic is already associated for this equations set.",err,error,*998)
818 ALLOCATE(equations_set%ANALYTIC,stat=err)
819 IF(err/=0)
CALL flagerror(
"Could not allocate equations set analytic.",err,error,*999)
820 equations_set%ANALYTIC%EQUATIONS_SET=>equations_set
821 equations_set%ANALYTIC%ANALYTIC_FINISHED=.false.
822 equations_set%ANALYTIC%ANALYTIC_FIELD_AUTO_CREATED=.false.
823 NULLIFY(equations_set%ANALYTIC%ANALYTIC_FIELD)
824 equations_set%ANALYTIC%ANALYTIC_TIME=0.0_dp
827 CALL flagerror(
"Equations set is not associated.",err,error,*998)
830 exits(
"EQUATIONS_SET_ANALYTIC_INITIALISE")
833 998 errorsexits(
"EQUATIONS_SET_ANALYTIC_INITIALISE",err,error)
847 REAL(DP),
INTENT(OUT) :: TIME
848 INTEGER(INTG),
INTENT(OUT) :: ERR
852 enters(
"EQUATIONS_SET_ANALYTIC_TIME_GET",err,error,*999)
854 IF(
ASSOCIATED(equations_set))
THEN 855 IF(
ASSOCIATED(equations_set%ANALYTIC))
THEN 856 time=equations_set%ANALYTIC%ANALYTIC_TIME
858 CALL flagerror(
"Equations set analytic is not associated.",err,error,*999)
861 CALL flagerror(
"Equations set is not associated.",err,error,*999)
864 exits(
"EQUATIONS_SET_ANALYTIC_TIME_GET")
866 999 errorsexits(
"EQUATIONS_SET_ANALYTIC_TIME_GET",err,error)
880 REAL(DP),
INTENT(IN) :: TIME
881 INTEGER(INTG),
INTENT(OUT) :: ERR
885 enters(
"EQUATIONS_SET_ANALYTIC_TIME_SET",err,error,*999)
887 IF(
ASSOCIATED(equations_set))
THEN 888 IF(
ASSOCIATED(equations_set%ANALYTIC))
THEN 889 equations_set%ANALYTIC%ANALYTIC_TIME=time
891 CALL flagerror(
"Equations set analytic is not associated.",err,error,*999)
894 CALL flagerror(
"Equations set is not associated.",err,error,*999)
897 exits(
"EQUATIONS_SET_ANALYTIC_TIME_SET")
899 999 errorsexits(
"EQUATIONS_SET_ANALYTIC_TIME_SET",err,error)
912 INTEGER(INTG),
INTENT(IN) :: PARAM_IDX
913 REAL(DP),
INTENT(IN) :: PARAM
914 INTEGER(INTG),
INTENT(OUT) :: ERR
919 enters(
"EQUATIONS_SET_ANALYTIC_USER_PARAM_SET",err,error,*999)
921 IF(
ASSOCIATED(equations_set))
THEN 922 analytic=>equations_set%ANALYTIC
923 IF(
ASSOCIATED(analytic))
THEN 924 IF(param_idx>0.AND.param_idx<=
SIZE(analytic%ANALYTIC_USER_PARAMS))
THEN 926 analytic%ANALYTIC_USER_PARAMS(param_idx)=param
928 CALL flagerror(
"Invalid parameter index.",err,error,*999)
931 CALL flagerror(
"Equations set analytic is not associated.",err,error,*999)
934 CALL flagerror(
"Equations set is not associated.",err,error,*999)
937 exits(
"EQUATIONS_SET_ANALYTIC_USER_PARAM_SET")
939 999 errorsexits(
"EQUATIONS_SET_ANALYTIC_USER_PARAM_SET",err,error)
951 INTEGER(INTG),
INTENT(IN) :: PARAM_IDX
952 REAL(DP),
INTENT(OUT) :: PARAM
953 INTEGER(INTG),
INTENT(OUT) :: ERR
958 enters(
"EQUATIONS_SET_ANALYTIC_USER_PARAM_GET",err,error,*999)
960 IF(
ASSOCIATED(equations_set))
THEN 961 analytic=>equations_set%ANALYTIC
962 IF(
ASSOCIATED(analytic))
THEN 963 IF(param_idx>0.AND.param_idx<=
SIZE(analytic%ANALYTIC_USER_PARAMS))
THEN 965 param=analytic%ANALYTIC_USER_PARAMS(param_idx)
967 CALL flagerror(
"Invalid parameter index.",err,error,*999)
970 CALL flagerror(
"Equations set analytic is not associated.",err,error,*999)
973 CALL flagerror(
"Equations set is not associated.",err,error,*999)
976 exits(
"EQUATIONS_SET_ANALYTIC_USER_PARAM_GET")
978 999 errorsexits(
"EQUATIONS_SET_ANALYTIC_USER_PARAM_GET",err,error)
991 INTEGER(INTG),
INTENT(OUT) :: ERR
997 enters(
"EQUATIONS_SET_ASSEMBLE",err,error,*999)
999 IF(
ASSOCIATED(equations_set))
THEN 1000 equations=>equations_set%EQUATIONS
1001 IF(
ASSOCIATED(equations))
THEN 1002 IF(equations%EQUATIONS_FINISHED)
THEN 1003 SELECT CASE(equations%TIME_DEPENDENCE)
1005 SELECT CASE(equations%LINEARITY)
1007 SELECT CASE(equations_set%SOLUTION_METHOD)
1011 CALL flagerror(
"Not implemented.",err,error,*999)
1013 CALL flagerror(
"Not implemented.",err,error,*999)
1015 CALL flagerror(
"Not implemented.",err,error,*999)
1017 CALL flagerror(
"Not implemented.",err,error,*999)
1019 CALL flagerror(
"Not implemented.",err,error,*999)
1021 CALL flagerror(
"Not implemented.",err,error,*999)
1023 local_error=
"The equations set solution method of "// &
1026 CALL flagerror(local_error,err,error,*999)
1029 SELECT CASE(equations_set%SOLUTION_METHOD)
1035 CALL flagerror(
"Not implemented.",err,error,*999)
1037 CALL flagerror(
"Not implemented.",err,error,*999)
1039 CALL flagerror(
"Not implemented.",err,error,*999)
1041 CALL flagerror(
"Not implemented.",err,error,*999)
1043 CALL flagerror(
"Not implemented.",err,error,*999)
1045 local_error=
"The equations set solution method of "// &
1048 CALL flagerror(local_error,err,error,*999)
1051 CALL flagerror(
"Not implemented.",err,error,*999)
1053 local_error=
"The equations linearity of "// &
1055 CALL flagerror(local_error,err,error,*999)
1059 SELECT CASE(equations%LINEARITY)
1061 SELECT CASE(equations_set%SOLUTION_METHOD)
1065 CALL flagerror(
"Not implemented.",err,error,*999)
1067 CALL flagerror(
"Not implemented.",err,error,*999)
1069 CALL flagerror(
"Not implemented.",err,error,*999)
1071 CALL flagerror(
"Not implemented.",err,error,*999)
1073 CALL flagerror(
"Not implemented.",err,error,*999)
1075 local_error=
"The equations set solution method of "// &
1078 CALL flagerror(local_error,err,error,*999)
1083 CALL flagerror(
"Not implemented.",err,error,*999)
1085 local_error=
"The equations linearity of "// &
1087 CALL flagerror(local_error,err,error,*999)
1090 SELECT CASE(equations%LINEARITY)
1092 SELECT CASE(equations_set%SOLUTION_METHOD)
1096 CALL flagerror(
"Not implemented.",err,error,*999)
1098 CALL flagerror(
"Not implemented.",err,error,*999)
1100 CALL flagerror(
"Not implemented.",err,error,*999)
1102 CALL flagerror(
"Not implemented.",err,error,*999)
1104 CALL flagerror(
"Not implemented.",err,error,*999)
1106 local_error=
"The equations set solution method of "// &
1109 CALL flagerror(local_error,err,error,*999)
1112 CALL flagerror(
"Not implemented.",err,error,*999)
1114 CALL flagerror(
"Not implemented.",err,error,*999)
1116 local_error=
"The equations set linearity of "// &
1118 CALL flagerror(local_error,err,error,*999)
1121 CALL flagerror(
"Time stepping equations are not assembled.",err,error,*999)
1123 local_error=
"The equations time dependence type of "// &
1125 CALL flagerror(local_error,err,error,*999)
1128 CALL flagerror(
"Equations have not been finished.",err,error,*999)
1131 CALL flagerror(
"Equations set equations is not associated.",err,error,*999)
1134 CALL flagerror(
"Equations set is not associated.",err,error,*999)
1137 exits(
"EQUATIONS_SET_ASSEMBLE")
1139 999 errorsexits(
"EQUATIONS_SET_ASSEMBLE",err,error)
1152 INTEGER(INTG),
INTENT(OUT) :: ERR
1155 INTEGER(INTG) :: element_idx,ne,NUMBER_OF_TIMES
1156 REAL(SP) :: ELEMENT_USER_ELAPSED,ELEMENT_SYSTEM_ELAPSED,USER_ELAPSED,USER_TIME1(1),USER_TIME2(1),USER_TIME3(1),USER_TIME4(1), &
1157 & USER_TIME5(1),USER_TIME6(1),SYSTEM_ELAPSED,SYSTEM_TIME1(1),SYSTEM_TIME2(1),SYSTEM_TIME3(1),SYSTEM_TIME4(1), &
1158 & SYSTEM_TIME5(1),SYSTEM_TIME6(1)
1164 enters(
"EQUATIONS_SET_ASSEMBLE_DYNAMIC_LINEAR_FEM",err,error,*999)
1166 IF(
ASSOCIATED(equations_set))
THEN 1167 dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
1168 IF(
ASSOCIATED(dependent_field))
THEN 1169 equations=>equations_set%EQUATIONS
1170 IF(
ASSOCIATED(equations))
THEN 1171 equations_matrices=>equations%EQUATIONS_MATRICES
1172 IF(
ASSOCIATED(equations_matrices))
THEN 1182 elements_mapping=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
1188 user_elapsed=user_time2(1)-user_time1(1)
1189 system_elapsed=system_time2(1)-system_time1(1)
1195 element_user_elapsed=0.0_sp
1196 element_system_elapsed=0.0_sp
1200 DO element_idx=elements_mapping%INTERNAL_START,elements_mapping%INTERNAL_FINISH
1201 ne=elements_mapping%DOMAIN_LIST(element_idx)
1202 number_of_times=number_of_times+1
1211 user_elapsed=user_time3(1)-user_time2(1)
1212 system_elapsed=system_time3(1)-system_time2(1)
1213 element_user_elapsed=user_elapsed
1214 element_system_elapsed=system_elapsed
1225 user_elapsed=user_time4(1)-user_time3(1)
1226 system_elapsed=system_time4(1)-system_time3(1)
1233 DO element_idx=elements_mapping%BOUNDARY_START,elements_mapping%GHOST_FINISH
1234 ne=elements_mapping%DOMAIN_LIST(element_idx)
1235 number_of_times=number_of_times+1
1244 user_elapsed=user_time5(1)-user_time4(1)
1245 system_elapsed=system_time5(1)-system_time4(1)
1246 element_user_elapsed=element_user_elapsed+user_elapsed
1247 element_system_elapsed=element_system_elapsed+user_elapsed
1252 IF(number_of_times>0)
THEN 1254 & element_user_elapsed/number_of_times,err,error,*999)
1256 & element_system_elapsed/number_of_times,err,error,*999)
1269 user_elapsed=user_time6(1)-user_time1(1)
1270 system_elapsed=system_time6(1)-system_time1(1)
1278 CALL flagerror(
"Equations matrices is not associated",err,error,*999)
1281 CALL flagerror(
"Equations is not associated",err,error,*999)
1284 CALL flagerror(
"Dependent field is not associated",err,error,*999)
1287 CALL flagerror(
"Equations set is not associated",err,error,*999)
1290 exits(
"EQUATIONS_SET_ASSEMBLE_DYNAMIC_LINEAR_FEM")
1292 999 errorsexits(
"EQUATIONS_SET_ASSEMBLE_DYNAMIC_LINEAR_FEM",err,error)
1305 INTEGER(INTG),
INTENT(OUT) :: ERR
1308 INTEGER(INTG) :: element_idx,ne,NUMBER_OF_TIMES
1309 REAL(SP) :: ELEMENT_USER_ELAPSED,ELEMENT_SYSTEM_ELAPSED,USER_ELAPSED,USER_TIME1(1),USER_TIME2(1),USER_TIME3(1),USER_TIME4(1), &
1310 & USER_TIME5(1),USER_TIME6(1),SYSTEM_ELAPSED,SYSTEM_TIME1(1),SYSTEM_TIME2(1),SYSTEM_TIME3(1),SYSTEM_TIME4(1), &
1311 & SYSTEM_TIME5(1),SYSTEM_TIME6(1)
1323 enters(
"EQUATIONS_SET_ASSEMBLE_STATIC_LINEAR_FEM",err,error,*999)
1325 IF(
ASSOCIATED(equations_set))
THEN 1326 dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
1327 IF(
ASSOCIATED(dependent_field))
THEN 1328 equations=>equations_set%EQUATIONS
1329 IF(
ASSOCIATED(equations))
THEN 1330 equations_matrices=>equations%EQUATIONS_MATRICES
1331 IF(
ASSOCIATED(equations_matrices))
THEN 1338 CALL tau_static_phase_start(
"EQUATIONS_MATRICES_VALUES_INITIALISE()")
1342 CALL tau_static_phase_stop(
"EQUATIONS_MATRICES_VALUES_INITIALISE()")
1347 CALL tau_static_phase_start(
"EQUATIONS_MATRICES_ELEMENT_INITIALISE()")
1350 elements_mapping=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
1353 CALL tau_static_phase_stop(
"EQUATIONS_MATRICES_ELEMENT_INITIALISE()")
1359 user_elapsed=user_time2(1)-user_time1(1)
1360 system_elapsed=system_time2(1)-system_time1(1)
1365 element_user_elapsed=0.0_sp
1366 element_system_elapsed=0.0_sp
1372 CALL tau_static_phase_start(
"Internal Elements Loop")
1374 DO element_idx=elements_mapping%INTERNAL_START,elements_mapping%INTERNAL_FINISH
1380 ne=elements_mapping%DOMAIN_LIST(element_idx)
1381 number_of_times=number_of_times+1
1390 CALL tau_static_phase_stop(
"Internal Elements Loop")
1397 user_elapsed=user_time3(1)-user_time2(1)
1398 system_elapsed=system_time3(1)-system_time2(1)
1399 element_user_elapsed=user_elapsed
1400 element_system_elapsed=system_elapsed
1411 user_elapsed=user_time4(1)-user_time3(1)
1412 system_elapsed=system_time4(1)-system_time3(1)
1420 CALL tau_static_phase_start(
"Boundary and Ghost Elements Loop")
1422 DO element_idx=elements_mapping%BOUNDARY_START,elements_mapping%GHOST_FINISH
1423 ne=elements_mapping%DOMAIN_LIST(element_idx)
1424 number_of_times=number_of_times+1
1430 CALL tau_static_phase_stop(
"Boundary and Ghost Elements Loop")
1436 user_elapsed=user_time5(1)-user_time4(1)
1437 system_elapsed=system_time5(1)-system_time4(1)
1438 element_user_elapsed=element_user_elapsed+user_elapsed
1439 element_system_elapsed=element_system_elapsed+user_elapsed
1444 IF(number_of_times>0)
THEN 1446 & element_user_elapsed/number_of_times,err,error,*999)
1448 & element_system_elapsed/number_of_times,err,error,*999)
1453 CALL tau_static_phase_start(
"EQUATIONS_MATRICES_ELEMENT_FINALISE()")
1457 CALL tau_static_phase_stop(
"EQUATIONS_MATRICES_ELEMENT_FINALISE()")
1467 user_elapsed=user_time6(1)-user_time1(1)
1468 system_elapsed=system_time6(1)-system_time1(1)
1476 CALL flagerror(
"Equations matrices is not associated",err,error,*999)
1479 CALL flagerror(
"Equations is not associated",err,error,*999)
1482 CALL flagerror(
"Dependent field is not associated",err,error,*999)
1485 CALL flagerror(
"Equations set is not associated",err,error,*999)
1488 exits(
"EQUATIONS_SET_ASSEMBLE_STATIC_LINEAR_FEM")
1490 999 errorsexits(
"EQUATIONS_SET_ASSEMBLE_STATIC_LINEAR_FEM",err,error)
1503 INTEGER(INTG),
INTENT(OUT) :: ERR
1506 INTEGER(INTG) :: element_idx,ne,NUMBER_OF_TIMES
1507 REAL(SP) :: ELEMENT_USER_ELAPSED,ELEMENT_SYSTEM_ELAPSED,USER_ELAPSED,USER_TIME1(1),USER_TIME2(1),USER_TIME3(1),USER_TIME4(1), &
1508 & USER_TIME5(1),USER_TIME6(1),SYSTEM_ELAPSED,SYSTEM_TIME1(1),SYSTEM_TIME2(1),SYSTEM_TIME3(1),SYSTEM_TIME4(1), &
1509 & SYSTEM_TIME5(1),SYSTEM_TIME6(1)
1515 enters(
"EQUATIONS_SET_ASSEMBLE_STATIC_NONLINEAR_FEM",err,error,*999)
1517 IF(
ASSOCIATED(equations_set))
THEN 1518 dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
1519 IF(
ASSOCIATED(dependent_field))
THEN 1520 equations=>equations_set%EQUATIONS
1521 IF(
ASSOCIATED(equations))
THEN 1522 equations_matrices=>equations%EQUATIONS_MATRICES
1523 IF(
ASSOCIATED(equations_matrices))
THEN 1533 elements_mapping=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
1539 user_elapsed=user_time2(1)-user_time1(1)
1540 system_elapsed=system_time2(1)-system_time1(1)
1545 element_user_elapsed=0.0_sp
1546 element_system_elapsed=0.0_sp
1550 DO element_idx=elements_mapping%INTERNAL_START,elements_mapping%INTERNAL_FINISH
1551 ne=elements_mapping%DOMAIN_LIST(element_idx)
1552 number_of_times=number_of_times+1
1561 user_elapsed=user_time3(1)-user_time2(1)
1562 system_elapsed=system_time3(1)-system_time2(1)
1563 element_user_elapsed=user_elapsed
1564 element_system_elapsed=system_elapsed
1575 user_elapsed=user_time4(1)-user_time3(1)
1576 system_elapsed=system_time4(1)-system_time3(1)
1583 DO element_idx=elements_mapping%BOUNDARY_START,elements_mapping%GHOST_FINISH
1584 ne=elements_mapping%DOMAIN_LIST(element_idx)
1585 number_of_times=number_of_times+1
1594 user_elapsed=user_time5(1)-user_time4(1)
1595 system_elapsed=system_time5(1)-system_time4(1)
1596 element_user_elapsed=element_user_elapsed+user_elapsed
1597 element_system_elapsed=element_system_elapsed+user_elapsed
1602 IF(number_of_times>0)
THEN 1604 & element_user_elapsed/number_of_times,err,error,*999)
1606 & element_system_elapsed/number_of_times,err,error,*999)
1619 user_elapsed=user_time6(1)-user_time1(1)
1620 system_elapsed=system_time6(1)-system_time1(1)
1628 CALL flagerror(
"Equations matrices is not associated",err,error,*999)
1631 CALL flagerror(
"Equations is not associated",err,error,*999)
1634 CALL flagerror(
"Dependent field is not associated",err,error,*999)
1637 CALL flagerror(
"Equations set is not associated",err,error,*999)
1640 exits(
"EQUATIONS_SET_ASSEMBLE_STATIC_NONLINEAR_FEM")
1642 999 errorsexits(
"EQUATIONS_SET_ASSEMBLE_STATIC_NONLINEAR_FEM",err,error)
1655 INTEGER(INTG),
INTENT(OUT) :: ERR
1658 enters(
"EquationsSet_AssembleQuasistaticNonlinearFEM",err,error,*999)
1664 999
errors(
"EquationsSet_AssembleQuasistaticNonlinearFEM",err,error)
1665 exits(
"EquationsSet_AssembleQuasistaticNonlinearFEM")
1679 INTEGER(INTG),
INTENT(OUT) :: ERR
1682 INTEGER(INTG) :: element_idx,ne,NUMBER_OF_TIMES
1683 REAL(SP) :: ELEMENT_USER_ELAPSED,ELEMENT_SYSTEM_ELAPSED,USER_ELAPSED,USER_TIME1(1),USER_TIME2(1),USER_TIME3(1),USER_TIME4(1), &
1684 & USER_TIME5(1),USER_TIME6(1),SYSTEM_ELAPSED,SYSTEM_TIME1(1),SYSTEM_TIME2(1),SYSTEM_TIME3(1),SYSTEM_TIME4(1), &
1685 & SYSTEM_TIME5(1),SYSTEM_TIME6(1)
1691 enters(
"EquationsSet_AssembleQuasistaticLinearFEM",err,error,*999)
1693 IF(
ASSOCIATED(equations_set))
THEN 1694 dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
1695 IF(
ASSOCIATED(dependent_field))
THEN 1696 equations=>equations_set%EQUATIONS
1697 IF(
ASSOCIATED(equations))
THEN 1698 equations_matrices=>equations%EQUATIONS_MATRICES
1699 IF(
ASSOCIATED(equations_matrices))
THEN 1709 elements_mapping=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
1715 user_elapsed=user_time2(1)-user_time1(1)
1716 system_elapsed=system_time2(1)-system_time1(1)
1721 element_user_elapsed=0.0_sp
1722 element_system_elapsed=0.0_sp
1726 DO element_idx=elements_mapping%INTERNAL_START,elements_mapping%INTERNAL_FINISH
1727 ne=elements_mapping%DOMAIN_LIST(element_idx)
1728 number_of_times=number_of_times+1
1737 user_elapsed=user_time3(1)-user_time2(1)
1738 system_elapsed=system_time3(1)-system_time2(1)
1739 element_user_elapsed=user_elapsed
1740 element_system_elapsed=system_elapsed
1751 user_elapsed=user_time4(1)-user_time3(1)
1752 system_elapsed=system_time4(1)-system_time3(1)
1759 DO element_idx=elements_mapping%BOUNDARY_START,elements_mapping%GHOST_FINISH
1760 ne=elements_mapping%DOMAIN_LIST(element_idx)
1761 number_of_times=number_of_times+1
1770 user_elapsed=user_time5(1)-user_time4(1)
1771 system_elapsed=system_time5(1)-system_time4(1)
1772 element_user_elapsed=element_user_elapsed+user_elapsed
1773 element_system_elapsed=element_system_elapsed+user_elapsed
1778 IF(number_of_times>0)
THEN 1780 & element_user_elapsed/number_of_times,err,error,*999)
1782 & element_system_elapsed/number_of_times,err,error,*999)
1795 user_elapsed=user_time6(1)-user_time1(1)
1796 system_elapsed=system_time6(1)-system_time1(1)
1804 CALL flagerror(
"Equations matrices is not associated",err,error,*999)
1807 CALL flagerror(
"Equations is not associated",err,error,*999)
1810 CALL flagerror(
"Dependent field is not associated",err,error,*999)
1813 CALL flagerror(
"Equations set is not associated",err,error,*999)
1816 exits(
"EquationsSet_AssembleQuasistaticLinearFEM")
1818 999 errorsexits(
"EquationsSet_AssembleQuasistaticLinearFEM",err,error)
1832 INTEGER(INTG),
INTENT(OUT) :: ERR
1835 INTEGER(INTG) :: equations_column_idx,equations_column_number,equations_matrix_idx,equations_row_number, &
1836 & EQUATIONS_STORAGE_TYPE,rhs_boundary_condition,rhs_global_dof,rhs_variable_dof,RHS_VARIABLE_TYPE,variable_dof,VARIABLE_TYPE
1837 INTEGER(INTG),
POINTER :: COLUMN_INDICES(:),ROW_INDICES(:)
1838 REAL(DP) :: DEPENDENT_VALUE,MATRIX_VALUE,RHS_VALUE,SOURCE_VALUE
1839 REAL(DP),
POINTER :: DEPENDENT_PARAMETERS(:),EQUATIONS_MATRIX_DATA(:),SOURCE_VECTOR_DATA(:)
1858 NULLIFY(dependent_parameters)
1859 NULLIFY(equations_matrix_data)
1860 NULLIFY(source_vector_data)
1862 enters(
"EQUATIONS_SET_BACKSUBSTITUTE",err,error,*999)
1864 IF(
ASSOCIATED(equations_set))
THEN 1865 IF(equations_set%EQUATIONS_SET_FINISHED)
THEN 1866 dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
1867 IF(
ASSOCIATED(dependent_field))
THEN 1868 equations=>equations_set%EQUATIONS
1869 IF(
ASSOCIATED(equations))
THEN 1870 equations_matrices=>equations%EQUATIONS_MATRICES
1871 IF(
ASSOCIATED(equations_matrices))
THEN 1872 dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
1873 IF(
ASSOCIATED(dynamic_matrices))
THEN 1876 linear_matrices=>equations_matrices%LINEAR_MATRICES
1877 IF(
ASSOCIATED(linear_matrices))
THEN 1878 equations_mapping=>equations%EQUATIONS_MAPPING
1879 IF(
ASSOCIATED(equations_mapping))
THEN 1880 linear_mapping=>equations_mapping%LINEAR_MAPPING
1881 IF(
ASSOCIATED(linear_mapping))
THEN 1882 rhs_mapping=>equations_mapping%RHS_MAPPING
1883 source_mapping=>equations_mapping%SOURCE_MAPPING
1884 IF(
ASSOCIATED(rhs_mapping))
THEN 1885 IF(
ASSOCIATED(boundary_conditions))
THEN 1886 IF(
ASSOCIATED(source_mapping))
THEN 1887 source_vector=>equations_matrices%SOURCE_VECTOR
1888 IF(
ASSOCIATED(source_vector))
THEN 1889 source_distributed_vector=>source_vector%VECTOR
1890 IF(
ASSOCIATED(source_distributed_vector))
THEN 1893 CALL flagerror(
"Source distributed vector is not associated.",err,error,*999)
1896 CALL flagerror(
"Source vector is not associated.",err,error,*999)
1899 rhs_variable=>rhs_mapping%RHS_VARIABLE
1900 IF(
ASSOCIATED(rhs_variable))
THEN 1901 rhs_variable_type=rhs_variable%VARIABLE_TYPE
1902 rhs_domain_mapping=>rhs_variable%DOMAIN_MAPPING
1903 IF(
ASSOCIATED(rhs_domain_mapping))
THEN 1906 IF(
ASSOCIATED(rhs_boundary_conditions))
THEN 1908 DO equations_matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
1909 dependent_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(equations_matrix_idx)%VARIABLE
1910 IF(
ASSOCIATED(dependent_variable))
THEN 1911 variable_type=dependent_variable%VARIABLE_TYPE
1913 CALL field_parametersetdataget(dependent_field,variable_type,field_values_set_type, &
1914 & dependent_parameters,err,error,*999)
1915 equations_matrix=>linear_matrices%MATRICES(equations_matrix_idx)%PTR
1916 IF(
ASSOCIATED(equations_matrix))
THEN 1917 column_domain_mapping=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(equations_matrix_idx)% &
1918 & column_dofs_mapping
1919 IF(
ASSOCIATED(column_domain_mapping))
THEN 1920 equations_distributed_matrix=>equations_matrix%MATRIX
1921 IF(
ASSOCIATED(equations_distributed_matrix))
THEN 1923 & equations_storage_type,err,error,*999)
1926 SELECT CASE(equations_storage_type)
1929 DO equations_row_number=1,equations_mapping%NUMBER_OF_ROWS
1931 rhs_variable_dof=rhs_mapping%EQUATIONS_ROW_TO_RHS_DOF_MAP(equations_row_number)
1932 rhs_global_dof=rhs_domain_mapping%LOCAL_TO_GLOBAL_MAP(rhs_variable_dof)
1933 rhs_boundary_condition=rhs_boundary_conditions%DOF_TYPES(rhs_global_dof)
1936 SELECT CASE(rhs_boundary_condition)
1940 DO equations_column_idx=1,column_domain_mapping%TOTAL_NUMBER_OF_LOCAL
1941 equations_column_number=column_domain_mapping%LOCAL_TO_GLOBAL_MAP( &
1942 & equations_column_idx)
1943 variable_dof=equations_column_idx
1944 matrix_value=equations_matrix_data(equations_row_number+ &
1945 & (equations_column_number-1)*equations_matrices%TOTAL_NUMBER_OF_ROWS)
1946 dependent_value=dependent_parameters(variable_dof)
1947 rhs_value=rhs_value+matrix_value*dependent_value
1953 CALL flagerror(
"Not implemented.",err,error,*999)
1955 local_error=
"The RHS variable boundary condition of "// &
1957 &
" for RHS variable dof number "// &
1959 CALL flagerror(local_error,err,error,*999)
1961 IF(
ASSOCIATED(source_mapping))
THEN 1962 source_value=source_vector_data(equations_row_number)
1963 rhs_value=rhs_value-source_value
1965 CALL field_parametersetupdatelocaldof(dependent_field,rhs_variable_type, &
1966 & field_values_set_type,rhs_variable_dof,rhs_value,err,error,*999)
1969 CALL flagerror(
"Not implemented.",err,error,*999)
1971 CALL flagerror(
"Not implemented.",err,error,*999)
1973 CALL flagerror(
"Not implemented.",err,error,*999)
1976 & row_indices,column_indices,err,error,*999)
1978 DO equations_row_number=1,equations_mapping%NUMBER_OF_ROWS
1980 rhs_variable_dof=rhs_mapping%EQUATIONS_ROW_TO_RHS_DOF_MAP(equations_row_number)
1981 rhs_global_dof=rhs_domain_mapping%LOCAL_TO_GLOBAL_MAP(rhs_variable_dof)
1982 rhs_boundary_condition=rhs_boundary_conditions%DOF_TYPES(rhs_global_dof)
1983 SELECT CASE(rhs_boundary_condition)
1987 DO equations_column_idx=row_indices(equations_row_number), &
1988 row_indices(equations_row_number+1)-1
1989 equations_column_number=column_indices(equations_column_idx)
1990 variable_dof=equations_column_idx-row_indices(equations_row_number)+1
1991 matrix_value=equations_matrix_data(equations_column_idx)
1992 dependent_value=dependent_parameters(variable_dof)
1993 rhs_value=rhs_value+matrix_value*dependent_value
1999 CALL flagerror(
"Not implemented.",err,error,*999)
2001 local_error=
"The global boundary condition of "// &
2003 &
" for RHS variable dof number "// &
2005 CALL flagerror(local_error,err,error,*999)
2007 IF(
ASSOCIATED(source_mapping))
THEN 2008 source_value=source_vector_data(equations_row_number)
2009 rhs_value=rhs_value-source_value
2011 CALL field_parametersetupdatelocaldof(dependent_field,rhs_variable_type, &
2012 & field_values_set_type,rhs_variable_dof,rhs_value,err,error,*999)
2015 CALL flagerror(
"Not implemented.",err,error,*999)
2017 CALL flagerror(
"Not implemented.",err,error,*999)
2019 local_error=
"The matrix storage type of "// &
2021 CALL flagerror(local_error,err,error,*999)
2026 CALL flagerror(
"Equations matrix distributed matrix is not associated.",err,error,*999)
2029 CALL flagerror(
"Equations column domain mapping is not associated.",err,error,*999)
2032 CALL flagerror(
"Equations equations matrix is not associated.",err,error,*999)
2035 CALL field_parametersetdatarestore(dependent_field,variable_type,field_values_set_type, &
2036 & dependent_parameters,err,error,*999)
2038 CALL flagerror(
"Dependent variable is not associated.",err,error,*999)
2042 CALL field_parametersetupdatestart(dependent_field,rhs_variable_type,field_values_set_type, &
2045 CALL field_parametersetupdatefinish(dependent_field,rhs_variable_type,field_values_set_type, &
2048 CALL flagerror(
"RHS boundary conditions variable is not associated.",err,error,*999)
2051 CALL flagerror(
"RHS variable domain mapping is not associated.",err,error,*999)
2054 CALL flagerror(
"RHS variable is not associated.",err,error,*999)
2056 IF(
ASSOCIATED(source_mapping))
THEN 2060 CALL flagerror(
"Boundary conditions are not associated.",err,error,*999)
2063 CALL flagerror(
"Equations mapping RHS mappings is not associated.",err,error,*999)
2066 CALL flagerror(
"Equations mapping linear mapping is not associated.",err,error,*999)
2069 CALL flagerror(
"Equations mapping is not associated.",err,error,*999)
2072 CALL flagerror(
"Equations matrices linear matrices is not associated.",err,error,*999)
2076 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
2079 CALL flagerror(
"Equations is not associated.",err,error,*999)
2082 CALL flagerror(
"Dependent field is not associated.",err,error,*999)
2085 CALL flagerror(
"Equations set has not been finished.",err,error,*999)
2088 CALL flagerror(
"Equations set is not associated",err,error,*999)
2091 exits(
"EQUATIONS_SET_BACKSUBSTITUTE")
2093 999 errorsexits(
"EQUATIONS_SET_BACKSUBSTITUTE",err,error)
2108 INTEGER(INTG),
INTENT(OUT) :: ERR
2111 INTEGER(INTG) :: variable_dof,row_idx,VARIABLE_TYPE,rhs_global_dof,rhs_boundary_condition,equations_matrix_idx
2126 enters(
"EQUATIONS_SET_NONLINEAR_RHS_UPDATE",err,error,*999)
2128 IF(
ASSOCIATED(equations_set))
THEN 2129 equations=>equations_set%EQUATIONS
2130 IF(
ASSOCIATED(equations))
THEN 2131 equations_mapping=>equations%EQUATIONS_MAPPING
2132 IF(
ASSOCIATED(equations_mapping))
THEN 2133 rhs_mapping=>equations_mapping%RHS_MAPPING
2134 IF(
ASSOCIATED(rhs_mapping))
THEN 2135 rhs_variable=>rhs_mapping%RHS_VARIABLE
2136 IF(
ASSOCIATED(rhs_variable))
THEN 2138 rhs_field=>rhs_variable%FIELD
2139 variable_type=rhs_variable%VARIABLE_TYPE
2141 CALL flagerror(
"RHS mapping RHS variable is not associated.",err,error,*999)
2144 CALL flagerror(
"Equations mapping RHS mapping is not associated.",err,error,*999)
2146 IF(
ASSOCIATED(rhs_field))
THEN 2147 IF(
ASSOCIATED(boundary_conditions))
THEN 2148 rhs_domain_mapping=>rhs_variable%DOMAIN_MAPPING
2149 IF(
ASSOCIATED(rhs_domain_mapping))
THEN 2152 IF(
ASSOCIATED(rhs_boundary_conditions))
THEN 2154 equations_matrices=>equations%EQUATIONS_MATRICES
2155 IF(
ASSOCIATED(equations_matrices))
THEN 2156 nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
2157 IF(
ASSOCIATED(nonlinear_matrices))
THEN 2158 residual_vector=>nonlinear_matrices%RESIDUAL
2159 IF(
ASSOCIATED(residual_vector))
THEN 2161 nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
2162 IF(
ASSOCIATED(nonlinear_mapping))
THEN 2163 DO equations_matrix_idx=1,nonlinear_mapping%NUMBER_OF_RESIDUAL_VARIABLES
2164 residual_variable=>nonlinear_mapping%JACOBIAN_TO_VAR_MAP(equations_matrix_idx)%VARIABLE
2165 IF(
ASSOCIATED(residual_variable))
THEN 2166 DO row_idx=1,equations_mapping%NUMBER_OF_ROWS
2167 variable_dof=rhs_mapping%EQUATIONS_ROW_TO_RHS_DOF_MAP(row_idx)
2168 rhs_global_dof=rhs_domain_mapping%LOCAL_TO_GLOBAL_MAP(variable_dof)
2169 rhs_boundary_condition=rhs_boundary_conditions%DOF_TYPES(rhs_global_dof)
2170 SELECT CASE(rhs_boundary_condition)
2174 CALL field_parametersetupdatelocaldof(rhs_field,variable_type,field_values_set_type, &
2175 & variable_dof,
VALUE,err,error,*999)
2179 CALL flagerror(
"Not implemented.",err,error,*999)
2181 local_error=
"The RHS variable boundary condition of "// &
2183 &
" for RHS variable dof number "// &
2185 CALL flagerror(local_error,err,error,*999)
2189 CALL flagerror(
"Residual variable is not associated.",err,error,*999)
2193 CALL flagerror(
"Nonlinear mapping is not associated.",err,error,*999)
2196 CALL flagerror(
"Residual vector is not associated.",err,error,*999)
2199 CALL flagerror(
"Nonlinear matrices is not associated.",err,error,*999)
2202 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
2205 CALL flagerror(
"RHS boundary conditions variable is not associated.",err,error,*999)
2208 CALL flagerror(
"RHS variable domain mapping is not associated.",err,error,*999)
2211 CALL flagerror(
"Boundary conditions are not associated.",err,error,*999)
2213 CALL field_parametersetupdatestart(rhs_field,variable_type,field_values_set_type,err,error,*999)
2214 CALL field_parametersetupdatefinish(rhs_field,variable_type,field_values_set_type,err,error,*999)
2216 CALL flagerror(
"RHS variable field is not associated.",err,error,*999)
2219 CALL flagerror(
"Equations mapping is not associated.",err,error,*999)
2222 CALL flagerror(
"Equations set equations is not associated.",err,error,*999)
2225 CALL flagerror(
"Equations set is not associated.",err,error,*999)
2228 exits(
"EQUATIONS_SET_NONLINEAR_RHS_UPDATE")
2230 999 errorsexits(
"EQUATIONS_SET_NONLINEAR_RHS_UPDATE",err,error)
2245 INTEGER(INTG),
INTENT(OUT) :: ERR
2250 enters(
"EQUATIONS_SET_BOUNDARY_CONDITIONS_ANALYTIC",err,error,*999)
2252 IF(
ASSOCIATED(equations_set))
THEN 2253 IF(.NOT.
ALLOCATED(equations_set%SPECIFICATION))
THEN 2254 CALL flagerror(
"Equations set specification is not allocated.",err,error,*999)
2255 ELSE IF(
SIZE(equations_set%SPECIFICATION,1)<1)
THEN 2256 CALL flagerror(
"Equations set specification must have at least one entry.",err,error,*999)
2258 IF(equations_set%DEPENDENT%DEPENDENT_FINISHED)
THEN 2259 IF(
ASSOCIATED(equations_set%ANALYTIC))
THEN 2260 IF(equations_set%ANALYTIC%ANALYTIC_FINISHED)
THEN 2261 SELECT CASE(equations_set%SPECIFICATION(1))
2267 CALL flagerror(
"Not implemented.",err,error,*999)
2271 CALL flagerror(
"Not implemented.",err,error,*999)
2273 CALL flagerror(
"Not implemented.",err,error,*999)
2275 CALL flagerror(
"Not implemented.",err,error,*999)
2277 local_error=
"The first equations set specification of "//
trim(
number_to_vstring(equations_set%SPECIFICATION(1),
"*", &
2278 & err,error))//
" is invalid." 2279 CALL flagerror(local_error,err,error,*999)
2282 CALL flagerror(
"Equations set analytic has not been finished.",err,error,*999)
2285 CALL flagerror(
"Equations set analytic is not associated.",err,error,*999)
2288 CALL flagerror(
"Equations set dependent has not been finished.",err,error,*999)
2291 CALL flagerror(
"Equations set is not associated.",err,error,*999)
2294 exits(
"EQUATIONS_SET_BOUNDARY_CONDITIONS_ANALYTIC")
2296 999 errorsexits(
"EQUATIONS_SET_BOUNDARY_CONDITIONS_ANALYTIC",err,error)
2309 INTEGER(INTG),
INTENT(OUT) :: ERR
2314 enters(
"EQUATIONS_SET_CREATE_FINISH",err,error,*999)
2316 IF(
ASSOCIATED(equations_set))
THEN 2317 IF(equations_set%EQUATIONS_SET_FINISHED)
THEN 2318 CALL flagerror(
"Equations set has already been finished.",err,error,*999)
2331 equations_set%EQUATIONS_SET_FINISHED=.true.
2334 CALL flagerror(
"Equations set is not associated.",err,error,*999)
2337 exits(
"EQUATIONS_SET_CREATE_FINISH")
2339 999 errorsexits(
"EQUATIONS_SET_CREATE_FINISH",err,error)
2361 & equations_set_field_user_number,equations_set_field_field,equations_set,err,error,*)
2364 INTEGER(INTG),
INTENT(IN) :: USER_NUMBER
2366 TYPE(
field_type),
POINTER :: GEOM_FIBRE_FIELD
2367 INTEGER(INTG),
INTENT(IN) :: EQUATIONS_SET_SPECIFICATION(:)
2368 INTEGER(INTG),
INTENT(IN) :: EQUATIONS_SET_FIELD_USER_NUMBER
2369 TYPE(
field_type),
POINTER :: EQUATIONS_SET_FIELD_FIELD
2371 INTEGER(INTG),
INTENT(OUT) :: ERR
2374 INTEGER(INTG) :: DUMMY_ERR,equations_set_idx
2378 TYPE(
region_type),
POINTER :: GEOM_FIBRE_FIELD_REGION,EQUATIONS_SET_FIELD_REGION
2383 NULLIFY(new_equations_set)
2384 NULLIFY(new_equations_sets)
2385 NULLIFY(equations_equations_set_field)
2387 enters(
"EQUATIONS_SET_CREATE_START",err,error,*997)
2389 IF(
ASSOCIATED(region))
THEN 2390 IF(
ASSOCIATED(region%EQUATIONS_SETS))
THEN 2392 IF(
ASSOCIATED(new_equations_set))
THEN 2394 &
" has already been created on region number "//
trim(
number_to_vstring(region%USER_NUMBER,
"*",err,error))//
"." 2395 CALL flagerror(local_error,err,error,*997)
2397 NULLIFY(new_equations_set)
2398 IF(
ASSOCIATED(geom_fibre_field))
THEN 2399 IF(geom_fibre_field%FIELD_FINISHED)
THEN 2400 IF(geom_fibre_field%TYPE==field_geometric_type.OR.geom_fibre_field%TYPE==field_fibre_type)
THEN 2401 geom_fibre_field_region=>geom_fibre_field%REGION
2402 IF(
ASSOCIATED(geom_fibre_field_region))
THEN 2403 IF(geom_fibre_field_region%USER_NUMBER==region%USER_NUMBER)
THEN 2404 IF(
ASSOCIATED(equations_set_field_field))
THEN 2406 IF(equations_set_field_field%FIELD_FINISHED.eqv..true.)
THEN 2408 IF(equations_set_field_user_number/=equations_set_field_field%USER_NUMBER)
THEN 2409 local_error=
"The specified equations set field user number of "// &
2411 &
" does not match the user number of the specified equations set field of "// &
2413 CALL flagerror(local_error,err,error,*999)
2415 equations_set_field_region=>equations_set_field_field%REGION
2416 IF(
ASSOCIATED(equations_set_field_region))
THEN 2418 IF(equations_set_field_region%USER_NUMBER/=region%USER_NUMBER)
THEN 2419 local_error=
"Invalid region setup. The specified equations set field was created on region no. "// &
2421 &
" and the specified equations set has been created on region number "// &
2423 CALL flagerror(local_error,err,error,*999)
2426 IF(
ASSOCIATED(geom_fibre_field))
THEN 2427 IF(.NOT.
ASSOCIATED(geom_fibre_field%DECOMPOSITION,equations_set_field_field%DECOMPOSITION))
THEN 2428 CALL flagerror(
"The specified equations set field does not have the same decomposition "// &
2429 &
"as the geometric field for the specified equations set.",err,error,*999)
2432 CALL flagerror(
"The geom. field is not associated for the specified equations set.",err,error,*999)
2436 CALL flagerror(
"The specified equations set field region is not associated.",err,error,*999)
2439 CALL flagerror(
"The specified equations set field has not been finished.",err,error,*999)
2444 CALL field_user_number_find(equations_set_field_user_number,region,field,err,error,*999)
2445 IF(
ASSOCIATED(field))
THEN 2446 local_error=
"The specified equations set field user number of "// &
2448 &
"has already been used to create a field on region number "// &
2450 CALL flagerror(local_error,err,error,*999)
2456 new_equations_set%USER_NUMBER=user_number
2457 new_equations_set%GLOBAL_NUMBER=region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS+1
2458 new_equations_set%EQUATIONS_SETS=>region%EQUATIONS_SETS
2459 new_equations_set%REGION=>region
2462 new_equations_set%EQUATIONS_SET_FINISHED=.false.
2468 equations_set_setup_info%FIELD_USER_NUMBER=equations_set_field_user_number
2469 equations_set_setup_info%FIELD=>equations_set_field_field
2475 IF(geom_fibre_field%TYPE==field_geometric_type)
THEN 2476 new_equations_set%GEOMETRY%GEOMETRIC_FIELD=>geom_fibre_field
2477 NULLIFY(new_equations_set%GEOMETRY%FIBRE_FIELD)
2479 new_equations_set%GEOMETRY%GEOMETRIC_FIELD=>geom_fibre_field%GEOMETRIC_FIELD
2480 new_equations_set%GEOMETRY%FIBRE_FIELD=>geom_fibre_field
2484 equations_set_setup_info%FIELD_USER_NUMBER=geom_fibre_field%USER_NUMBER
2485 equations_set_setup_info%FIELD=>geom_fibre_field
2491 ALLOCATE(new_equations_sets(region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS+1),stat=err)
2492 IF(err/=0)
CALL flagerror(
"Could not allocate new equations sets.",err,error,*999)
2493 DO equations_set_idx=1,region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS
2494 new_equations_sets(equations_set_idx)%PTR=>region%EQUATIONS_SETS%EQUATIONS_SETS(equations_set_idx)%PTR
2496 new_equations_sets(region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS+1)%PTR=>new_equations_set
2497 IF(
ASSOCIATED(region%EQUATIONS_SETS%EQUATIONS_SETS))
DEALLOCATE(region%EQUATIONS_SETS%EQUATIONS_SETS)
2498 region%EQUATIONS_SETS%EQUATIONS_SETS=>new_equations_sets
2499 region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS=region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS+1
2500 equations_set=>new_equations_set
2501 equations_equations_set_field=>equations_set%EQUATIONS_SET_FIELD
2503 IF(equations_equations_set_field%EQUATIONS_SET_FIELD_AUTO_CREATED)
THEN 2504 equations_set_field_field=>equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD
2506 equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD=>equations_set_field_field
2509 local_error=
"The geometric field region and the specified region do not match. "// &
2510 &
"The geometric field was created on region number "// &
2512 &
" and the specified region number is "// &
2514 CALL flagerror(local_error,err,error,*997)
2517 CALL flagerror(
"The specified geometric fields region is not associated.",err,error,*997)
2520 CALL flagerror(
"The specified geometric field is not a geometric or fibre field.",err,error,*997)
2523 CALL flagerror(
"The specified geometric field is not finished.",err,error,*997)
2526 CALL flagerror(
"The specified geometric field is not associated.",err,error,*997)
2530 local_error=
"The equations sets on region number "//
trim(
number_to_vstring(region%USER_NUMBER,
"*",err,error))// &
2531 &
" are not associated." 2532 CALL flagerror(local_error,err,error,*997)
2535 CALL flagerror(
"Region is not associated.",err,error,*997)
2538 exits(
"EQUATIONS_SET_CREATE_START")
2540 999
IF(
ASSOCIATED(new_equations_set))
CALL equations_set_finalise(new_equations_set,dummy_err,dummy_error,*998)
2541 998
IF(
ASSOCIATED(new_equations_sets))
DEALLOCATE(new_equations_sets)
2542 997 errorsexits(
"EQUATIONS_SET_CREATE_START",err,error)
2554 INTEGER(INTG),
INTENT(IN) :: USER_NUMBER
2556 INTEGER(INTG),
INTENT(OUT) :: ERR
2559 INTEGER(INTG) :: equations_set_idx,equations_set_position
2565 NULLIFY(new_equations_sets)
2567 enters(
"EQUATIONS_SET_DESTROY_NUMBER",err,error,*999)
2569 IF(
ASSOCIATED(region))
THEN 2570 IF(
ASSOCIATED(region%EQUATIONS_SETS))
THEN 2574 equations_set_position=0
2575 DO WHILE(equations_set_position<region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS.AND..NOT.found)
2576 equations_set_position=equations_set_position+1
2577 IF(region%EQUATIONS_SETS%EQUATIONS_SETS(equations_set_position)%PTR%USER_NUMBER==user_number)found=.true.
2582 equations_set=>region%EQUATIONS_SETS%EQUATIONS_SETS(equations_set_position)%PTR
2588 IF(region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS>1)
THEN 2589 ALLOCATE(new_equations_sets(region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS-1),stat=err)
2590 IF(err/=0)
CALL flagerror(
"Could not allocate new equations sets.",err,error,*999)
2591 DO equations_set_idx=1,region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS
2592 IF(equations_set_idx<equations_set_position)
THEN 2593 new_equations_sets(equations_set_idx)%PTR=>region%EQUATIONS_SETS%EQUATIONS_SETS(equations_set_idx)%PTR
2594 ELSE IF(equations_set_idx>equations_set_position)
THEN 2595 region%EQUATIONS_SETS%EQUATIONS_SETS(equations_set_idx)%PTR%GLOBAL_NUMBER=region%EQUATIONS_SETS% &
2596 & equations_sets(equations_set_idx)%PTR%GLOBAL_NUMBER-1
2597 new_equations_sets(equations_set_idx-1)%PTR=>region%EQUATIONS_SETS%EQUATIONS_SETS(equations_set_idx)%PTR
2600 IF(
ASSOCIATED(region%EQUATIONS_SETS%EQUATIONS_SETS))
DEALLOCATE(region%EQUATIONS_SETS%EQUATIONS_SETS)
2601 region%EQUATIONS_SETS%EQUATIONS_SETS=>new_equations_sets
2602 region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS=region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS-1
2604 DEALLOCATE(region%EQUATIONS_SETS%EQUATIONS_SETS)
2605 region%EQUATIONS_SETS%NUMBER_OF_EQUATIONS_SETS=0
2610 &
" has not been created on region number "//
trim(
number_to_vstring(region%USER_NUMBER,
"*",err,error))//
"." 2611 CALL flagerror(local_error,err,error,*999)
2614 local_error=
"The equations sets on region number "//
trim(
number_to_vstring(region%USER_NUMBER,
"*",err,error))// &
2615 &
" are not associated." 2616 CALL flagerror(local_error,err,error,*999)
2619 CALL flagerror(
"Region is not associated.",err,error,*998)
2622 exits(
"EQUATIONS_SET_DESTROY_NUMBER")
2624 999
IF(
ASSOCIATED(new_equations_sets))
DEALLOCATE(new_equations_sets)
2625 998 errorsexits(
"EQUATIONS_SET_DESTROY_NUMBER",err,error)
2638 INTEGER(INTG),
INTENT(OUT) :: ERR
2641 INTEGER(INTG) :: equations_set_idx,equations_set_position
2645 NULLIFY(new_equations_sets)
2647 enters(
"EQUATIONS_SET_DESTROY",err,error,*999)
2649 IF(
ASSOCIATED(equations_set))
THEN 2650 equations_sets=>equations_set%EQUATIONS_SETS
2651 IF(
ASSOCIATED(equations_sets))
THEN 2652 equations_set_position=equations_set%GLOBAL_NUMBER
2658 IF(equations_sets%NUMBER_OF_EQUATIONS_SETS>1)
THEN 2659 ALLOCATE(new_equations_sets(equations_sets%NUMBER_OF_EQUATIONS_SETS-1),stat=err)
2660 IF(err/=0)
CALL flagerror(
"Could not allocate new equations sets.",err,error,*999)
2661 DO equations_set_idx=1,equations_sets%NUMBER_OF_EQUATIONS_SETS
2662 IF(equations_set_idx<equations_set_position)
THEN 2663 new_equations_sets(equations_set_idx)%PTR=>equations_sets%EQUATIONS_SETS(equations_set_idx)%PTR
2664 ELSE IF(equations_set_idx>equations_set_position)
THEN 2665 equations_sets%EQUATIONS_SETS(equations_set_idx)%PTR%GLOBAL_NUMBER=equations_sets% &
2666 & equations_sets(equations_set_idx)%PTR%GLOBAL_NUMBER-1
2667 new_equations_sets(equations_set_idx-1)%PTR=>equations_sets%EQUATIONS_SETS(equations_set_idx)%PTR
2670 IF(
ASSOCIATED(equations_sets%EQUATIONS_SETS))
DEALLOCATE(equations_sets%EQUATIONS_SETS)
2671 equations_sets%EQUATIONS_SETS=>new_equations_sets
2672 equations_sets%NUMBER_OF_EQUATIONS_SETS=equations_sets%NUMBER_OF_EQUATIONS_SETS-1
2674 DEALLOCATE(equations_sets%EQUATIONS_SETS)
2675 equations_sets%NUMBER_OF_EQUATIONS_SETS=0
2679 CALL flagerror(
"Equations set equations set is not associated.",err,error,*999)
2682 CALL flagerror(
"Equations set is not associated.",err,error,*998)
2685 exits(
"EQUATIONS_SET_DESTROY")
2687 999
IF(
ASSOCIATED(new_equations_sets))
DEALLOCATE(new_equations_sets)
2688 998 errorsexits(
"EQUATIONS_SET_DESTROY",err,error)
2702 INTEGER(INTG),
INTENT(OUT) :: ERR
2706 enters(
"EQUATIONS_SET_FINALISE",err,error,*999)
2708 IF(
ASSOCIATED(equations_set))
THEN 2717 IF(
ASSOCIATED(equations_set%EQUATIONS))
CALL equations_destroy(equations_set%EQUATIONS,err,error,*999)
2718 IF(
ALLOCATED(equations_set%SPECIFICATION))
DEALLOCATE(equations_set%SPECIFICATION)
2719 DEALLOCATE(equations_set)
2722 exits(
"EQUATIONS_SET_FINALISE")
2724 999 errorsexits(
"EQUATIONS_SET_FINALISE",err,error)
2738 INTEGER(INTG),
INTENT(IN) :: ELEMENT_NUMBER
2739 INTEGER(INTG),
INTENT(OUT) :: ERR
2742 INTEGER(INTG) :: matrix_idx
2754 CALL tau_static_phase_start(
"EQUATIONS_SET_FINITE_ELEMENT_CALCULATE()")
2757 enters(
"EQUATIONS_SET_FINITE_ELEMENT_CALCULATE",err,error,*999)
2759 IF(
ASSOCIATED(equations_set))
THEN 2760 IF(.NOT.
ALLOCATED(equations_set%SPECIFICATION))
THEN 2761 CALL flagerror(
"Equations set specification is not allocated.",err,error,*999)
2762 ELSE IF(
SIZE(equations_set%SPECIFICATION,1)<1)
THEN 2763 CALL flagerror(
"Equations set specification must have at least one entry.",err,error,*999)
2765 SELECT CASE(equations_set%SPECIFICATION(1))
2771 CALL flagerror(
"Not implemented.",err,error,*999)
2777 IF(
SIZE(equations_set%SPECIFICATION,1)<2)
THEN 2778 CALL flagerror(
"Equations set specification must have at least two entries for a bioelectrics equation class.", &
2782 CALL monodomain_finiteelementcalculate(equations_set,element_number,err,error,*999)
2787 CALL flagerror(
"Not implemented.",err,error,*999)
2789 CALL multi_physics_finite_element_calculate(equations_set,element_number,err,error,*999)
2791 local_error=
"The first equations set specification of "// &
2793 CALL flagerror(local_error,err,error,*999)
2795 equations=>equations_set%EQUATIONS
2796 IF(
ASSOCIATED(equations))
THEN 2798 equations_matrices=>equations%EQUATIONS_MATRICES
2799 IF(
ASSOCIATED(equations_matrices))
THEN 2802 dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
2803 IF(
ASSOCIATED(dynamic_matrices))
THEN 2806 & number_of_dynamic_matrices,err,error,*999)
2807 DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
2810 & update_matrix,err,error,*999)
2811 IF(dynamic_matrices%MATRICES(matrix_idx)%PTR%UPDATE_MATRIX)
THEN 2812 element_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR%ELEMENT_MATRIX
2819 & max_number_of_columns,err,error,*999)
2821 &
'(" Row dofs :",8(X,I13))',
'(16X,8(X,I13))',err,error,*999)
2823 & column_dofs,
'(" Column dofs :",8(X,I13))',
'(16X,8(X,I13))',err,error,*999)
2825 & number_of_columns,8,8,element_matrix%MATRIX(1:element_matrix%NUMBER_OF_ROWS,1:element_matrix% &
2826 & number_of_columns),
write_string_matrix_name_and_indices,
'(" Matrix',
'(",I2,",:)',
' :",8(X,E13.6))', &
2827 &
'(16X,8(X,E13.6))',err,error,*999)
2831 linear_matrices=>equations_matrices%LINEAR_MATRICES
2832 IF(
ASSOCIATED(linear_matrices))
THEN 2835 & number_of_linear_matrices,err,error,*999)
2836 DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
2839 & update_matrix,err,error,*999)
2840 IF(linear_matrices%MATRICES(matrix_idx)%PTR%UPDATE_MATRIX)
THEN 2841 element_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR%ELEMENT_MATRIX
2848 & max_number_of_columns,err,error,*999)
2850 &
'(" Row dofs :",8(X,I13))',
'(16X,8(X,I13))',err,error,*999)
2852 & column_dofs,
'(" Column dofs :",8(X,I13))',
'(16X,8(X,I13))',err,error,*999)
2854 & number_of_columns,8,8,element_matrix%MATRIX(1:element_matrix%NUMBER_OF_ROWS,1:element_matrix% &
2855 & number_of_columns),
write_string_matrix_name_and_indices,
'(" Matrix',
'(",I2,",:)',
' :",8(X,E13.6))', &
2856 &
'(16X,8(X,E13.6))',err,error,*999)
2860 rhs_vector=>equations_matrices%RHS_VECTOR
2861 IF(
ASSOCIATED(rhs_vector))
THEN 2864 IF(rhs_vector%UPDATE_VECTOR)
THEN 2865 element_vector=>rhs_vector%ELEMENT_VECTOR
2870 &
'(" Row dofs :",8(X,I13))',
'(16X,8(X,I13))',err,error,*999)
2872 &
'(" Vector(:):",8(X,E13.6))',
'(16X,8(X,E13.6))',err,error,*999)
2875 source_vector=>equations_matrices%SOURCE_VECTOR
2876 IF(
ASSOCIATED(source_vector))
THEN 2879 IF(source_vector%UPDATE_VECTOR)
THEN 2880 element_vector=>source_vector%ELEMENT_VECTOR
2885 &
'(" Row dofs :",8(X,I13))',
'(16X,8(X,I13))',err,error,*999)
2887 &
'(" Vector(:):",8(X,E13.6))',
'(16X,8(X,E13.6))',err,error,*999)
2891 CALL flagerror(
"Equation matrices is not associated.",err,error,*999)
2895 CALL flagerror(
"Equations is not associated.",err,error,*999)
2898 CALL flagerror(
"Equations set is not associated.",err,error,*999)
2902 CALL tau_static_phase_stop(
"EQUATIONS_SET_FINITE_ELEMENT_CALCULATE()")
2905 exits(
"EQUATIONS_SET_FINITE_ELEMENT_CALCULATE")
2907 999 errorsexits(
"EQUATIONS_SET_FINITE_ELEMENT_CALCULATE",err,error)
2921 INTEGER(INTG),
INTENT(IN) :: ELEMENT_NUMBER
2922 INTEGER(INTG),
INTENT(OUT) :: ERR
2925 INTEGER(INTG) :: matrix_idx
2932 enters(
"EquationsSet_FiniteElementJacobianEvaluate",err,error,*999)
2934 IF(
ASSOCIATED(equations_set))
THEN 2935 IF(.NOT.
ALLOCATED(equations_set%SPECIFICATION))
THEN 2936 CALL flagerror(
"Equations set specification is not allocated.",err,error,*999)
2937 ELSE IF(
SIZE(equations_set%SPECIFICATION,1)<1)
THEN 2938 CALL flagerror(
"Equations set specification must have at least one entry.",err,error,*999)
2940 equations=>equations_set%EQUATIONS
2941 IF(
ASSOCIATED(equations))
THEN 2942 equations_matrices=>equations%EQUATIONS_MATRICES
2943 IF(
ASSOCIATED(equations_matrices))
THEN 2944 nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
2945 IF(
ASSOCIATED(nonlinear_matrices))
THEN 2946 DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
2947 SELECT CASE(nonlinear_matrices%JACOBIANS(matrix_idx)%PTR%JACOBIAN_CALCULATION_TYPE)
2951 IF(matrix_idx>1)
THEN 2952 CALL flagerror(
"Analytic off-diagonal Jacobian calculation not implemented.",err,error,*999)
2954 SELECT CASE(equations_set%SPECIFICATION(1))
2960 CALL flagerror(
"Not implemented.",err,error,*999)
2964 CALL flagerror(
"Not implemented.",err,error,*999)
2966 CALL flagerror(
"Not implemented.",err,error,*999)
2968 CALL multiphysics_finiteelementjacobianevaluate(equations_set,element_number,err,error,*999)
2970 local_error=
"The first equations set specification of"// &
2972 & err,error))//
" is not valid." 2973 CALL flagerror(local_error,err,error,*999)
2978 local_error=
"Jacobian calculation type "//
trim(
number_to_vstring(nonlinear_matrices%JACOBIANS(matrix_idx)%PTR% &
2979 & jacobian_calculation_type,
"*",err,error))//
" is not valid." 2980 CALL flagerror(local_error,err,error,*999)
2984 CALL flagerror(
"Equations nonlinear matrices is not associated.",err,error,*999)
2987 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
2994 DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
2997 & update_jacobian,err,error,*999)
2998 IF(nonlinear_matrices%JACOBIANS(matrix_idx)%PTR%UPDATE_JACOBIAN)
THEN 2999 element_matrix=>nonlinear_matrices%JACOBIANS(matrix_idx)%PTR%ELEMENT_JACOBIAN
3006 & max_number_of_columns,err,error,*999)
3008 &
'(" Row dofs :",8(X,I13))',
'(16X,8(X,I13))',err,error,*999)
3010 & column_dofs,
'(" Column dofs :",8(X,I13))',
'(16X,8(X,I13))',err,error,*999)
3012 & number_of_columns,8,8,element_matrix%MATRIX(1:element_matrix%NUMBER_OF_ROWS,1:element_matrix% &
3013 & number_of_columns),
write_string_matrix_name_and_indices,
'(" Matrix',
'(",I2,",:)',
' :",8(X,E13.6))', &
3014 &
'(16X,8(X,E13.6))',err,error,*999)
3020 CALL flagerror(
"Equations is not associated.",err,error,*999)
3023 CALL flagerror(
"Equations set is not associated.",err,error,*999)
3026 exits(
"EquationsSet_FiniteElementJacobianEvaluate")
3028 999 errorsexits(
"EquationsSet_FiniteElementJacobianEvaluate",err,error)
3042 INTEGER(INTG),
INTENT(IN) :: elementNumber
3043 INTEGER(INTG),
INTENT(IN) :: jacobianNumber
3044 INTEGER(INTG),
INTENT(OUT) :: err
3056 INTEGER(INTG) :: componentIdx,localNy,version,derivativeIdx,derivative,nodeIdx,node,column
3057 INTEGER(INTG) :: componentInterpolationType
3058 INTEGER(INTG) :: numberOfRows
3059 REAL(DP) :: delta,origDepVar
3061 enters(
"EquationsSet_FiniteElementJacobianEvaluateFD",err,error,*999)
3063 IF(
ASSOCIATED(equationsset))
THEN 3064 equations=>equationsset%EQUATIONS
3065 IF(
ASSOCIATED(equations))
THEN 3066 equationsmatrices=>equations%EQUATIONS_MATRICES
3067 nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
3068 nonlinearmapping=>equations%EQUATIONS_MAPPING%NONLINEAR_MAPPING
3071 rowvariable=>nonlinearmapping%RESIDUAL_VARIABLES(1)%PTR
3075 IF(nonlinearmatrices%ELEMENT_RESIDUAL_CALCULATED/=elementnumber)
THEN 3079 elementvector=nonlinearmatrices%ELEMENT_RESIDUAL
3080 IF(jacobiannumber<=nonlinearmatrices%NUMBER_OF_JACOBIANS)
THEN 3085 columnvariable=>nonlinearmapping%RESIDUAL_VARIABLES(jacobiannumber)%PTR
3086 parameters=>columnvariable%PARAMETER_SETS%PARAMETER_SETS(field_values_set_type)%PTR%PARAMETERS
3087 numberofrows=nonlinearmatrices%JACOBIANS(jacobiannumber)%PTR%ELEMENT_JACOBIAN%NUMBER_OF_ROWS
3088 IF(numberofrows/=nonlinearmatrices%ELEMENT_RESIDUAL%NUMBER_OF_ROWS)
THEN 3089 CALL flagerror(
"Element matrix number of rows does not match element residual vector size.",err,error,*999)
3093 delta=(1.0_dp+delta)*1e-6
3098 DO componentidx=1,columnvariable%NUMBER_OF_COMPONENTS
3099 elementstopology=>columnvariable%COMPONENTS(componentidx)%DOMAIN%TOPOLOGY%ELEMENTS
3100 componentinterpolationtype=columnvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE
3101 SELECT CASE (componentinterpolationtype)
3102 CASE (field_node_based_interpolation)
3103 basis=>elementstopology%ELEMENTS(elementnumber)%BASIS
3104 DO nodeidx=1,basis%NUMBER_OF_NODES
3105 node=elementstopology%ELEMENTS(elementnumber)%ELEMENT_NODES(nodeidx)
3106 DO derivativeidx=1,basis%NUMBER_OF_DERIVATIVES(nodeidx)
3107 derivative=elementstopology%ELEMENTS(elementnumber)%ELEMENT_DERIVATIVES(derivativeidx,nodeidx)
3108 version=elementstopology%ELEMENTS(elementnumber)%elementVersions(derivativeidx,nodeidx)
3109 localny=columnvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node)% &
3110 & derivatives(derivative)%VERSIONS(version)
3114 nonlinearmatrices%ELEMENT_RESIDUAL%VECTOR=0.0_dp
3118 nonlinearmatrices%JACOBIANS(jacobiannumber)%PTR%ELEMENT_JACOBIAN%MATRIX(1:numberofrows,column)= &
3119 & (nonlinearmatrices%ELEMENT_RESIDUAL%VECTOR(1:numberofrows)-elementvector%VECTOR(1:numberofrows))/delta
3122 CASE (field_element_based_interpolation)
3123 localny=columnvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%ELEMENT_PARAM2DOF_MAP%ELEMENTS(elementnumber)
3127 nonlinearmatrices%ELEMENT_RESIDUAL%VECTOR=0.0_dp
3131 nonlinearmatrices%JACOBIANS(jacobiannumber)%PTR%ELEMENT_JACOBIAN%MATRIX(1:numberofrows,column)= &
3132 & (nonlinearmatrices%ELEMENT_RESIDUAL%VECTOR(1:numberofrows)-elementvector%VECTOR(1:numberofrows))/delta
3134 CALL flagerror(
"Unsupported type of interpolation.",err,error,*999)
3138 nonlinearmatrices%ELEMENT_RESIDUAL=elementvector
3141 &
". The number should be <= "//
trim(
number_to_vstring(nonlinearmatrices%NUMBER_OF_JACOBIANS,
"*",err,error))// &
3142 &
".",err,error,*999)
3145 CALL flagerror(
"Equations set equations is not associated.",err,error,*999)
3148 CALL flagerror(
"Equations set is not associated.",err,error,*999)
3151 exits(
"EquationsSet_FiniteElementJacobianEvaluateFD")
3153 999
errors(
"EquationsSet_FiniteElementJacobianEvaluateFD",err,error)
3154 exits(
"EquationsSet_FiniteElementJacobianEvaluateFD")
3167 INTEGER(INTG),
INTENT(IN) :: ELEMENT_NUMBER
3168 INTEGER(INTG),
INTENT(OUT) :: ERR
3171 INTEGER(INTG) :: matrix_idx
3183 enters(
"EquationsSet_FiniteElementResidualEvaluate",err,error,*999)
3185 IF(
ASSOCIATED(equations_set))
THEN 3186 IF(.NOT.
ALLOCATED(equations_set%SPECIFICATION))
THEN 3187 CALL flagerror(
"Equations set specification is not allocated.",err,error,*999)
3188 ELSE IF(
SIZE(equations_set%SPECIFICATION,1)<1)
THEN 3189 CALL flagerror(
"Equations set specification must have at least one entry.",err,error,*999)
3191 SELECT CASE(equations_set%SPECIFICATION(1))
3197 CALL flagerror(
"Not implemented.",err,error,*999)
3201 CALL flagerror(
"Not implemented.",err,error,*999)
3203 CALL flagerror(
"Not implemented.",err,error,*999)
3205 CALL multiphysics_finiteelementresidualevaluate(equations_set,element_number,err,error,*999)
3207 local_error=
"The first equations set specification of "// &
3209 CALL flagerror(local_error,err,error,*999)
3211 equations=>equations_set%EQUATIONS
3212 IF(
ASSOCIATED(equations))
THEN 3213 equations_matrices=>equations%EQUATIONS_MATRICES
3214 IF(
ASSOCIATED(equations_matrices))
THEN 3215 nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
3216 IF(
ASSOCIATED(nonlinear_matrices))
THEN 3217 nonlinear_matrices%ELEMENT_RESIDUAL_CALCULATED=element_number
3222 linear_matrices=>equations_matrices%LINEAR_MATRICES
3223 IF(
ASSOCIATED(linear_matrices))
THEN 3226 & number_of_linear_matrices,err,error,*999)
3227 DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
3230 & update_matrix,err,error,*999)
3231 IF(linear_matrices%MATRICES(matrix_idx)%PTR%UPDATE_MATRIX)
THEN 3232 element_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR%ELEMENT_MATRIX
3239 & max_number_of_columns,err,error,*999)
3241 &
'(" Row dofs :",8(X,I13))',
'(16X,8(X,I13))',err,error,*999)
3243 & column_dofs,
'(" Column dofs :",8(X,I13))',
'(16X,8(X,I13))',err,error,*999)
3245 & number_of_columns,8,8,element_matrix%MATRIX(1:element_matrix%NUMBER_OF_ROWS,1:element_matrix% &
3246 & number_of_columns),
write_string_matrix_name_and_indices,
'(" Matrix',
'(",I2,",:)',
' :",8(X,E13.6))', &
3247 &
'(16X,8(X,E13.6))',err,error,*999)
3251 dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
3252 IF(
ASSOCIATED(dynamic_matrices))
THEN 3255 & number_of_dynamic_matrices,err,error,*999)
3256 DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
3259 & update_matrix,err,error,*999)
3260 IF(dynamic_matrices%MATRICES(matrix_idx)%PTR%UPDATE_MATRIX)
THEN 3261 element_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR%ELEMENT_MATRIX
3268 & max_number_of_columns,err,error,*999)
3270 &
'(" Row dofs :",8(X,I13))',
'(16X,8(X,I13))',err,error,*999)
3272 & column_dofs,
'(" Column dofs :",8(X,I13))',
'(16X,8(X,I13))',err,error,*999)
3274 & number_of_columns,8,8,element_matrix%MATRIX(1:element_matrix%NUMBER_OF_ROWS,1:element_matrix% &
3275 & number_of_columns),
write_string_matrix_name_and_indices,
'(" Matrix',
'(",I2,",:)',
' :",8(X,E13.6))', &
3276 &
'(16X,8(X,E13.6))',err,error,*999)
3282 IF(nonlinear_matrices%UPDATE_RESIDUAL)
THEN 3283 element_vector=>nonlinear_matrices%ELEMENT_RESIDUAL
3288 &
'(" Row dofs :",8(X,I13))',
'(16X,8(X,I13))',err,error,*999)
3290 &
'(" Vector(:):",8(X,E13.6))',
'(16X,8(X,E13.6))',err,error,*999)
3292 rhs_vector=>equations_matrices%RHS_VECTOR
3293 IF(
ASSOCIATED(rhs_vector))
THEN 3296 IF(rhs_vector%UPDATE_VECTOR)
THEN 3297 element_vector=>rhs_vector%ELEMENT_VECTOR
3302 &
'(" Row dofs :",8(X,I13))',
'(16X,8(X,I13))',err,error,*999)
3304 &
'(" Vector(:) :",8(X,E13.6))',
'(16X,8(X,E13.6))',err,error,*999)
3307 source_vector=>equations_matrices%SOURCE_VECTOR
3308 IF(
ASSOCIATED(source_vector))
THEN 3311 IF(source_vector%UPDATE_VECTOR)
THEN 3312 element_vector=>source_vector%ELEMENT_VECTOR
3317 &
'(" Row dofs :",8(X,I13))',
'(16X,8(X,I13))',err,error,*999)
3319 &
'(" Vector(:) :",8(X,E13.6))',
'(16X,8(X,E13.6))',err,error,*999)
3324 CALL flagerror(
"Equation nonlinear matrices not associated.",err,error,*999)
3327 CALL flagerror(
"Equation matrices is not associated.",err,error,*999)
3330 CALL flagerror(
"Equations is not associated.",err,error,*999)
3333 CALL flagerror(
"Equations set is not associated.",err,error,*999)
3336 exits(
"EquationsSet_FiniteElementResidualEvaluate")
3338 999 errorsexits(
"EquationsSet_FiniteElementResidualEvaluate",err,error)
3352 INTEGER(INTG),
INTENT(OUT) :: ERR
3356 TYPE(
field_type),
POINTER :: INDEPENDENT_FIELD
3358 enters(
"EQUATIONS_SET_INDEPENDENT_CREATE_FINISH",err,error,*999)
3360 IF(
ASSOCIATED(equations_set))
THEN 3361 IF(
ASSOCIATED(equations_set%INDEPENDENT))
THEN 3362 IF(equations_set%INDEPENDENT%INDEPENDENT_FINISHED)
THEN 3363 CALL flagerror(
"Equations set independent field has already been finished.",err,error,*999)
3369 independent_field=>equations_set%INDEPENDENT%INDEPENDENT_FIELD
3370 IF(
ASSOCIATED(independent_field))
THEN 3371 equations_set_setup_info%FIELD_USER_NUMBER=independent_field%USER_NUMBER
3372 equations_set_setup_info%FIELD=>independent_field
3376 CALL flagerror(
"Equations set independent independent field is not associated.",err,error,*999)
3381 equations_set%INDEPENDENT%INDEPENDENT_FINISHED=.true.
3384 CALL flagerror(
"The equations set independent is not associated",err,error,*999)
3387 CALL flagerror(
"Equations set is not associated",err,error,*999)
3390 exits(
"EQUATIONS_SET_INDEPENDENT_CREATE_FINISH")
3392 999 errorsexits(
"EQUATIONS_SET_INDEPENDENT_CREATE_FINISH",err,error)
3405 INTEGER(INTG),
INTENT(IN) :: INDEPENDENT_FIELD_USER_NUMBER
3406 TYPE(
field_type),
POINTER :: INDEPENDENT_FIELD
3407 INTEGER(INTG),
INTENT(OUT) :: ERR
3410 INTEGER(INTG) :: DUMMY_ERR
3412 TYPE(
field_type),
POINTER :: FIELD,GEOMETRIC_FIELD
3413 TYPE(
region_type),
POINTER :: REGION,INDEPENDENT_FIELD_REGION
3416 enters(
"EQUATIONS_SET_INDEPENDENT_CREATE_START",err,error,*998)
3418 IF(
ASSOCIATED(equations_set))
THEN 3419 IF(
ASSOCIATED(equations_set%INDEPENDENT))
THEN 3420 CALL flagerror(
"The equations set independent is already associated",err,error,*998)
3422 region=>equations_set%REGION
3423 IF(
ASSOCIATED(region))
THEN 3424 IF(
ASSOCIATED(independent_field))
THEN 3426 IF(independent_field%FIELD_FINISHED)
THEN 3428 IF(independent_field_user_number/=independent_field%USER_NUMBER)
THEN 3429 local_error=
"The specified independent field user number of "// &
3431 &
" does not match the user number of the specified independent field of "// &
3433 CALL flagerror(local_error,err,error,*999)
3435 independent_field_region=>independent_field%REGION
3436 IF(
ASSOCIATED(independent_field_region))
THEN 3438 IF(independent_field_region%USER_NUMBER/=region%USER_NUMBER)
THEN 3439 local_error=
"Invalid region setup. The specified independent field has been created on region number "// &
3441 &
" and the specified equations set has been created on region number "// &
3443 CALL flagerror(local_error,err,error,*999)
3446 geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
3447 IF(
ASSOCIATED(geometric_field))
THEN 3448 IF(.NOT.
ASSOCIATED(geometric_field%DECOMPOSITION,independent_field%DECOMPOSITION))
THEN 3449 CALL flagerror(
"The specified independent field does not have the same decomposition as the geometric "// &
3450 &
"field for the specified equations set.",err,error,*999)
3453 CALL flagerror(
"The geometric field is not associated for the specified equations set.",err,error,*999)
3456 CALL flagerror(
"The specified independent field region is not associated.",err,error,*999)
3459 CALL flagerror(
"The specified independent field has not been finished.",err,error,*999)
3464 CALL field_user_number_find(independent_field_user_number,region,field,err,error,*999)
3465 IF(
ASSOCIATED(field))
THEN 3466 local_error=
"The specified independent field user number of "// &
3468 &
"has already been used to create a field on region number "// &
3470 CALL flagerror(local_error,err,error,*999)
3475 IF(.NOT.
ASSOCIATED(independent_field)) equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED=.true.
3480 equations_set_setup_info%FIELD_USER_NUMBER=independent_field_user_number
3481 equations_set_setup_info%FIELD=>independent_field
3487 IF(equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED)
THEN 3488 independent_field=>equations_set%INDEPENDENT%INDEPENDENT_FIELD
3490 equations_set%INDEPENDENT%INDEPENDENT_FIELD=>independent_field
3493 CALL flagerror(
"Equation set region is not associated.",err,error,*999)
3497 CALL flagerror(
"Equations set is not associated",err,error,*998)
3500 exits(
"EQUATIONS_SET_INDEPENDENT_CREATE_START")
3503 998 errorsexits(
"EQUATIONS_SET_INDEPENDENT_CREATE_START",err,error)
3516 INTEGER(INTG),
INTENT(OUT) :: ERR
3520 enters(
"EQUATIONS_SET_INDEPENDENT_DESTROY",err,error,*999)
3522 IF(
ASSOCIATED(equations_set))
THEN 3523 IF(
ASSOCIATED(equations_set%INDEPENDENT))
THEN 3526 CALL flagerror(
"Equations set indpendent is not associated.",err,error,*999)
3529 CALL flagerror(
"Equations set is not associated.",err,error,*999)
3532 exits(
"EQUATIONS_SET_INDEPENDENT_DESTROY")
3534 999 errorsexits(
"EQUATIONS_SET_INDEPENDENT_DESTROY",err,error)
3547 INTEGER(INTG),
INTENT(OUT) :: ERR
3551 enters(
"EQUATIONS_SET_INDEPENDENT_FINALISE",err,error,*999)
3553 IF(
ASSOCIATED(equations_set_independent))
THEN 3554 DEALLOCATE(equations_set_independent)
3557 exits(
"EQUATIONS_SET_INDEPENDENT_FINALISE")
3559 999 errorsexits(
"EQUATIONS_SET_INDEPENDENT_FINALISE",err,error)
3572 INTEGER(INTG),
INTENT(OUT) :: ERR
3575 INTEGER(INTG) :: DUMMY_ERR
3578 enters(
"EQUATIONS_SET_INDEPENDENT_INITIALISE",err,error,*998)
3580 IF(
ASSOCIATED(equations_set))
THEN 3581 IF(
ASSOCIATED(equations_set%INDEPENDENT))
THEN 3582 CALL flagerror(
"Independent field is already associated for these equations sets.",err,error,*998)
3584 ALLOCATE(equations_set%INDEPENDENT,stat=err)
3585 IF(err/=0)
CALL flagerror(
"Could not allocate equations set independent field.",err,error,*999)
3586 equations_set%INDEPENDENT%EQUATIONS_SET=>equations_set
3587 equations_set%INDEPENDENT%INDEPENDENT_FINISHED=.false.
3588 equations_set%INDEPENDENT%INDEPENDENT_FIELD_AUTO_CREATED=.false.
3589 NULLIFY(equations_set%INDEPENDENT%INDEPENDENT_FIELD)
3592 CALL flagerror(
"Equations set is not associated.",err,error,*998)
3595 exits(
"EQUATIONS_SET_INDEPENDENT_INITIALISE")
3598 998 errorsexits(
"EQUATIONS_SET_INDEPENDENT_INITIALISE",err,error)
3611 INTEGER(INTG),
INTENT(OUT) :: ERR
3614 INTEGER(INTG) :: DUMMY_ERR
3617 enters(
"EQUATIONS_SET_INITIALISE",err,error,*998)
3619 IF(
ASSOCIATED(equations_set))
THEN 3620 CALL flagerror(
"Equations set is already associated.",err,error,*998)
3622 ALLOCATE(equations_set,stat=err)
3623 IF(err/=0)
CALL flagerror(
"Could not allocate equations set.",err,error,*999)
3624 equations_set%USER_NUMBER=0
3625 equations_set%GLOBAL_NUMBER=0
3626 equations_set%EQUATIONS_SET_FINISHED=.false.
3627 NULLIFY(equations_set%EQUATIONS_SETS)
3628 NULLIFY(equations_set%REGION)
3629 equations_set%SOLUTION_METHOD=0
3633 NULLIFY(equations_set%INDEPENDENT)
3634 NULLIFY(equations_set%MATERIALS)
3635 NULLIFY(equations_set%SOURCE)
3636 NULLIFY(equations_set%ANALYTIC)
3637 NULLIFY(equations_set%derived)
3638 NULLIFY(equations_set%EQUATIONS)
3639 NULLIFY(equations_set%BOUNDARY_CONDITIONS)
3642 exits(
"EQUATIONS_SET_INITIALISE")
3645 998 errorsexits(
"EQUATIONS_SET_INITIALISE",err,error)
3658 INTEGER(INTG),
INTENT(OUT) :: ERR
3662 enters(
"EQUATIONS_SET_GEOMETRY_FINALISE",err,error,*999)
3664 NULLIFY(equations_set_geometry%GEOMETRIC_FIELD)
3665 NULLIFY(equations_set_geometry%FIBRE_FIELD)
3667 exits(
"EQUATIONS_SET_GEOMETRY_FINALISE")
3669 999 errorsexits(
"EQUATIONS_SET_GEOMETRY_FINALISE",err,error)
3682 INTEGER(INTG),
INTENT(OUT) :: ERR
3686 enters(
"EQUATIONS_SET_GEOMETRY_INITIALISE",err,error,*999)
3688 IF(
ASSOCIATED(equations_set))
THEN 3689 equations_set%GEOMETRY%EQUATIONS_SET=>equations_set
3690 NULLIFY(equations_set%GEOMETRY%GEOMETRIC_FIELD)
3691 NULLIFY(equations_set%GEOMETRY%FIBRE_FIELD)
3693 CALL flagerror(
"Equations set is not associated.",err,error,*999)
3696 exits(
"EQUATIONS_SET_GEOMETRY_INITIALISE")
3698 999 errorsexits(
"EQUATIONS_SET_GEOMETRY_INITIALISE",err,error)
3711 INTEGER(INTG),
INTENT(OUT) :: ERR
3717 enters(
"EQUATIONS_SET_MATERIALS_CREATE_FINISH",err,error,*999)
3719 IF(
ASSOCIATED(equations_set))
THEN 3720 IF(
ASSOCIATED(equations_set%MATERIALS))
THEN 3721 IF(equations_set%MATERIALS%MATERIALS_FINISHED)
THEN 3722 CALL flagerror(
"Equations set materials has already been finished.",err,error,*999)
3728 materials_field=>equations_set%MATERIALS%MATERIALS_FIELD
3729 IF(
ASSOCIATED(materials_field))
THEN 3730 equations_set_setup_info%FIELD_USER_NUMBER=materials_field%USER_NUMBER
3731 equations_set_setup_info%FIELD=>materials_field
3735 CALL flagerror(
"Equations set materials materials field is not associated.",err,error,*999)
3740 equations_set%MATERIALS%MATERIALS_FINISHED=.true.
3743 CALL flagerror(
"The equations set materials is not associated",err,error,*999)
3746 CALL flagerror(
"Equations set is not associated",err,error,*999)
3749 exits(
"EQUATIONS_SET_MATERIALS_CREATE_FINISH")
3751 999 errorsexits(
"EQUATIONS_SET_MATERIALS_CREATE_FINISH",err,error)
3764 INTEGER(INTG),
INTENT(IN) :: MATERIALS_FIELD_USER_NUMBER
3766 INTEGER(INTG),
INTENT(OUT) :: ERR
3769 INTEGER(INTG) :: DUMMY_ERR
3771 TYPE(
field_type),
POINTER :: FIELD,GEOMETRIC_FIELD
3772 TYPE(
region_type),
POINTER :: REGION,MATERIALS_FIELD_REGION
3775 enters(
"EQUATIONS_SET_MATERIALS_CREATE_START",err,error,*998)
3777 IF(
ASSOCIATED(equations_set))
THEN 3778 IF(
ASSOCIATED(equations_set%MATERIALS))
THEN 3779 CALL flagerror(
"The equations set materials is already associated",err,error,*998)
3781 region=>equations_set%REGION
3782 IF(
ASSOCIATED(region))
THEN 3783 IF(
ASSOCIATED(materials_field))
THEN 3785 IF(materials_field%FIELD_FINISHED)
THEN 3787 IF(materials_field_user_number/=materials_field%USER_NUMBER)
THEN 3788 local_error=
"The specified materials field user number of "// &
3790 &
" does not match the user number of the specified materials field of "// &
3792 CALL flagerror(local_error,err,error,*999)
3794 materials_field_region=>materials_field%REGION
3795 IF(
ASSOCIATED(materials_field_region))
THEN 3797 IF(materials_field_region%USER_NUMBER/=region%USER_NUMBER)
THEN 3798 local_error=
"Invalid region setup. The specified materials field has been created on region number "// &
3800 &
" and the specified equations set has been created on region number "// &
3802 CALL flagerror(local_error,err,error,*999)
3805 geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
3806 IF(
ASSOCIATED(geometric_field))
THEN 3807 IF(.NOT.
ASSOCIATED(geometric_field%DECOMPOSITION,materials_field%DECOMPOSITION))
THEN 3808 CALL flagerror(
"The specified materials field does not have the same decomposition as the geometric "// &
3809 &
"field for the specified equations set.",err,error,*999)
3812 CALL flagerror(
"The geometric field is not associated for the specified equations set.",err,error,*999)
3815 CALL flagerror(
"The specified materials field region is not associated.",err,error,*999)
3818 CALL flagerror(
"The specified materials field has not been finished.",err,error,*999)
3823 CALL field_user_number_find(materials_field_user_number,region,field,err,error,*999)
3824 IF(
ASSOCIATED(field))
THEN 3825 local_error=
"The specified materials field user number of "// &
3827 &
"has already been used to create a field on region number "// &
3829 CALL flagerror(local_error,err,error,*999)
3834 IF(.NOT.
ASSOCIATED(materials_field)) equations_set%MATERIALS%MATERIALS_FIELD_AUTO_CREATED=.true.
3839 equations_set_setup_info%FIELD_USER_NUMBER=materials_field_user_number
3840 equations_set_setup_info%FIELD=>materials_field
3846 IF(equations_set%MATERIALS%MATERIALS_FIELD_AUTO_CREATED)
THEN 3847 materials_field=>equations_set%MATERIALS%MATERIALS_FIELD
3849 equations_set%MATERIALS%MATERIALS_FIELD=>materials_field
3852 CALL flagerror(
"Equation set region is not associated.",err,error,*999)
3856 CALL flagerror(
"Equations set is not associated",err,error,*998)
3859 exits(
"EQUATIONS_SET_MATERIALS_CREATE_START")
3862 998 errorsexits(
"EQUATIONS_SET_MATERIALS_CREATE_START",err,error)
3875 INTEGER(INTG),
INTENT(OUT) :: ERR
3879 enters(
"EQUATIONS_SET_MATERIALS_DESTROY",err,error,*999)
3881 IF(
ASSOCIATED(equations_set))
THEN 3882 IF(
ASSOCIATED(equations_set%MATERIALS))
THEN 3885 CALL flagerror(
"Equations set materials is not associated.",err,error,*999)
3888 CALL flagerror(
"Equations set is not associated.",err,error,*999)
3891 exits(
"EQUATIONS_SET_MATERIALS_DESTROY")
3893 999 errorsexits(
"EQUATIONS_SET_MATERIALS_DESTROY",err,error)
3906 INTEGER(INTG),
INTENT(OUT) :: ERR
3910 enters(
"EQUATIONS_SET_MATERIALS_FINALISE",err,error,*999)
3912 IF(
ASSOCIATED(equations_set_materials))
THEN 3913 DEALLOCATE(equations_set_materials)
3916 exits(
"EQUATIONS_SET_MATERIALS_FINALISE")
3918 999 errorsexits(
"EQUATIONS_SET_MATERIALS_FINALISE",err,error)
3931 INTEGER(INTG),
INTENT(OUT) :: ERR
3934 INTEGER(INTG) :: DUMMY_ERR
3937 enters(
"EQUATIONS_SET_MATERIALS_INITIALISE",err,error,*998)
3939 IF(
ASSOCIATED(equations_set))
THEN 3940 IF(
ASSOCIATED(equations_set%MATERIALS))
THEN 3941 CALL flagerror(
"Materials is already associated for these equations sets.",err,error,*998)
3943 ALLOCATE(equations_set%MATERIALS,stat=err)
3944 IF(err/=0)
CALL flagerror(
"Could not allocate equations set materials.",err,error,*999)
3945 equations_set%MATERIALS%EQUATIONS_SET=>equations_set
3946 equations_set%MATERIALS%MATERIALS_FINISHED=.false.
3947 equations_set%MATERIALS%MATERIALS_FIELD_AUTO_CREATED=.false.
3948 NULLIFY(equations_set%MATERIALS%MATERIALS_FIELD)
3951 CALL flagerror(
"Equations set is not associated",err,error,*998)
3954 exits(
"EQUATIONS_SET_MATERIALS_INITIALISE")
3957 998 errorsexits(
"EQUATIONS_SET_MATERIALS_INITIALISE",err,error)
3971 INTEGER(INTG),
INTENT(OUT) :: ERR
3977 enters(
"EQUATIONS_SET_DEPENDENT_CREATE_FINISH",err,error,*999)
3979 IF(
ASSOCIATED(equations_set))
THEN 3980 IF(equations_set%DEPENDENT%DEPENDENT_FINISHED)
THEN 3981 CALL flagerror(
"Equations set dependent has already been finished",err,error,*999)
3987 dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
3988 IF(
ASSOCIATED(dependent_field))
THEN 3989 equations_set_setup_info%FIELD_USER_NUMBER=dependent_field%USER_NUMBER
3990 equations_set_setup_info%FIELD=>dependent_field
3994 CALL flagerror(
"Equations set dependent dependent field is not associated.",err,error,*999)
3999 equations_set%DEPENDENT%DEPENDENT_FINISHED=.true.
4002 CALL flagerror(
"Equations set is not associated",err,error,*999)
4005 exits(
"EQUATIONS_SET_DEPENDENT_CREATE_FINISH")
4007 999 errorsexits(
"EQUATIONS_SET_DEPENDENT_CREATE_FINISH",err,error)
4020 INTEGER(INTG),
INTENT(IN) :: DEPENDENT_FIELD_USER_NUMBER
4022 INTEGER(INTG),
INTENT(OUT) :: ERR
4025 INTEGER(INTG) :: DUMMY_ERR
4027 TYPE(
field_type),
POINTER :: FIELD,GEOMETRIC_FIELD
4028 TYPE(
region_type),
POINTER :: REGION,DEPENDENT_FIELD_REGION
4031 enters(
"EQUATIONS_SET_DEPENDENT_CREATE_START",err,error,*998)
4033 IF(
ASSOCIATED(equations_set))
THEN 4034 IF(equations_set%DEPENDENT%DEPENDENT_FINISHED)
THEN 4035 CALL flagerror(
"The equations set dependent has been finished.",err,error,*999)
4037 region=>equations_set%REGION
4038 IF(
ASSOCIATED(region))
THEN 4039 IF(
ASSOCIATED(dependent_field))
THEN 4041 IF(dependent_field%FIELD_FINISHED)
THEN 4043 IF(dependent_field_user_number/=dependent_field%USER_NUMBER)
THEN 4044 local_error=
"The specified dependent field user number of "// &
4046 &
" does not match the user number of the specified dependent field of "// &
4048 CALL flagerror(local_error,err,error,*999)
4050 dependent_field_region=>dependent_field%REGION
4051 IF(
ASSOCIATED(dependent_field_region))
THEN 4053 IF(dependent_field_region%USER_NUMBER/=region%USER_NUMBER)
THEN 4054 local_error=
"Invalid region setup. The specified dependent field has been created on region number "// &
4056 &
" and the specified equations set has been created on region number "// &
4058 CALL flagerror(local_error,err,error,*999)
4061 geometric_field=>equations_set%GEOMETRY%GEOMETRIC_FIELD
4062 IF(
ASSOCIATED(geometric_field))
THEN 4063 IF(.NOT.
ASSOCIATED(geometric_field%DECOMPOSITION,dependent_field%DECOMPOSITION))
THEN 4064 CALL flagerror(
"The specified dependent field does not have the same decomposition as the geometric "// &
4065 &
"field for the specified equations set.",err,error,*999)
4068 CALL flagerror(
"The geometric field is not associated for the specified equations set.",err,error,*999)
4071 CALL flagerror(
"The specified dependent field region is not associated.",err,error,*999)
4074 CALL flagerror(
"The specified dependent field has not been finished.",err,error,*999)
4079 CALL field_user_number_find(dependent_field_user_number,region,field,err,error,*999)
4080 IF(
ASSOCIATED(field))
THEN 4081 local_error=
"The specified dependent field user number of "// &
4083 &
" has already been used to create a field on region number "// &
4085 CALL flagerror(local_error,err,error,*999)
4087 equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED=.true.
4093 equations_set_setup_info%FIELD_USER_NUMBER=dependent_field_user_number
4094 equations_set_setup_info%FIELD=>dependent_field
4100 IF(equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED)
THEN 4101 dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
4103 equations_set%DEPENDENT%DEPENDENT_FIELD=>dependent_field
4106 CALL flagerror(
"Equation set region is not associated.",err,error,*999)
4110 CALL flagerror(
"Equations_set is not associated.",err,error,*998)
4113 exits(
"EQUATIONS_SET_DEPENDENT_CREATE_START")
4116 998 errorsexits(
"EQUATIONS_SET_DEPENDENT_CREATE_START",err,error)
4129 INTEGER(INTG),
INTENT(OUT) :: ERR
4133 enters(
"EQUATIONS_SET_DEPENDENT_DESTROY",err,error,*999)
4135 IF(
ASSOCIATED(equations_set))
THEN 4138 CALL flagerror(
"Equations set is not associated",err,error,*999)
4141 exits(
"EQUATIONS_SET_DEPENDENT_DESTROY")
4143 999 errorsexits(
"EQUATIONS_SET_DEPENDENT_DESTROY",err,error)
4156 INTEGER(INTG),
INTENT(OUT) :: ERR
4160 enters(
"EQUATIONS_SET_DEPENDENT_FINALISE",err,error,*999)
4162 NULLIFY(equations_set_dependent%EQUATIONS_SET)
4163 equations_set_dependent%DEPENDENT_FINISHED=.false.
4164 equations_set_dependent%DEPENDENT_FIELD_AUTO_CREATED=.false.
4165 NULLIFY(equations_set_dependent%DEPENDENT_FIELD)
4167 exits(
"EQUATIONS_SET_DEPENDENT_FINALISE")
4169 999 errorsexits(
"EQUATIONS_SET_DEPENDENT_FINALISE",err,error)
4182 INTEGER(INTG),
INTENT(OUT) :: ERR
4186 enters(
"EQUATIONS_SET_DEPENDENT_INITIALISE",err,error,*999)
4188 IF(
ASSOCIATED(equations_set))
THEN 4189 equations_set%DEPENDENT%EQUATIONS_SET=>equations_set
4190 equations_set%DEPENDENT%DEPENDENT_FINISHED=.false.
4191 equations_set%DEPENDENT%DEPENDENT_FIELD_AUTO_CREATED=.false.
4192 NULLIFY(equations_set%DEPENDENT%DEPENDENT_FIELD)
4194 CALL flagerror(
"Equations set is not associated.",err,error,*999)
4197 exits(
"EQUATIONS_SET_DEPENDENT_INITIALISE")
4199 999 errorsexits(
"EQUATIONS_SET_DEPENDENT_INITIALISE",err,error)
4212 INTEGER(INTG),
INTENT(OUT) :: err
4218 enters(
"EquationsSet_DerivedCreateFinish",err,error,*999)
4220 IF(
ASSOCIATED(equationsset))
THEN 4221 IF(
ASSOCIATED(equationsset%derived))
THEN 4222 IF(equationsset%derived%derivedFinished)
THEN 4223 CALL flagerror(
"Equations set derived field information has already been finished",err,error,*999)
4229 derivedfield=>equationsset%derived%derivedField
4230 IF(
ASSOCIATED(derivedfield))
THEN 4231 equationssetsetupinfo%FIELD_USER_NUMBER=derivedfield%USER_NUMBER
4232 equationssetsetupinfo%field=>derivedfield
4236 CALL flagerror(
"Equations set derived field is not associated.",err,error,*999)
4241 equationsset%derived%derivedFinished=.true.
4244 CALL flagerror(
"Equations set derived is not associated",err,error,*999)
4247 CALL flagerror(
"Equations set is not associated",err,error,*999)
4250 exits(
"EquationsSet_DerivedCreateFinish")
4252 999 errorsexits(
"EquationsSet_DerivedCreateFinish",err,error)
4265 INTEGER(INTG),
INTENT(IN) :: derivedFieldUserNumber
4267 INTEGER(INTG),
INTENT(OUT) :: err
4270 INTEGER(INTG) :: dummyErr
4272 TYPE(
field_type),
POINTER :: field,geometricField
4273 TYPE(
region_type),
POINTER :: region,derivedFieldRegion
4276 enters(
"EquationsSet_DerivedCreateStart",err,error,*998)
4278 IF(
ASSOCIATED(equationsset))
THEN 4279 IF(
ASSOCIATED(equationsset%derived))
THEN 4280 CALL flagerror(
"Equations set derived is already associated.",err,error,*998)
4282 region=>equationsset%REGION
4283 IF(
ASSOCIATED(region))
THEN 4284 IF(
ASSOCIATED(derivedfield))
THEN 4286 IF(derivedfield%FIELD_FINISHED)
THEN 4288 IF(derivedfieldusernumber/=derivedfield%USER_NUMBER)
THEN 4289 localerror=
"The specified derived field user number of "// &
4291 &
" does not match the user number of the specified derived field of "// &
4293 CALL flagerror(localerror,err,error,*999)
4295 derivedfieldregion=>derivedfield%REGION
4296 IF(
ASSOCIATED(derivedfieldregion))
THEN 4298 IF(derivedfieldregion%USER_NUMBER/=region%USER_NUMBER)
THEN 4299 localerror=
"Invalid region setup. The specified derived field has been created on region number "// &
4301 &
" and the specified equations set has been created on region number "// &
4303 CALL flagerror(localerror,err,error,*999)
4306 geometricfield=>equationsset%GEOMETRY%GEOMETRIC_FIELD
4307 IF(
ASSOCIATED(geometricfield))
THEN 4308 IF(.NOT.
ASSOCIATED(geometricfield%DECOMPOSITION,derivedfield%DECOMPOSITION))
THEN 4309 CALL flagerror(
"The specified derived field does not have the same decomposition as the geometric "// &
4310 &
"field for the specified equations set.",err,error,*999)
4313 CALL flagerror(
"The geometric field is not associated for the specified equations set.",err,error,*999)
4316 CALL flagerror(
"The specified derived field region is not associated.",err,error,*999)
4319 CALL flagerror(
"The specified derived field has not been finished.",err,error,*999)
4324 CALL field_user_number_find(derivedfieldusernumber,region,field,err,error,*999)
4325 IF(
ASSOCIATED(field))
THEN 4326 localerror=
"The specified derived field user number of "// &
4328 &
" has already been used to create a field on region number "// &
4330 CALL flagerror(localerror,err,error,*999)
4332 equationsset%derived%derivedFieldAutoCreated=.true.
4339 equationssetsetupinfo%FIELD_USER_NUMBER=derivedfieldusernumber
4340 equationssetsetupinfo%FIELD=>derivedfield
4346 IF(.NOT.equationsset%derived%derivedFieldAutoCreated)
THEN 4347 equationsset%derived%derivedField=>derivedfield
4350 CALL flagerror(
"Equation set region is not associated.",err,error,*999)
4354 CALL flagerror(
"Equations set is not associated.",err,error,*998)
4357 exits(
"EquationsSet_DerivedCreateStart")
4360 998 errorsexits(
"EquationsSet_DerivedCreateStart",err,error)
4373 INTEGER(INTG),
INTENT(OUT) :: err
4377 enters(
"EquationsSet_DerivedDestroy",err,error,*999)
4379 IF(
ASSOCIATED(equationsset))
THEN 4382 CALL flagerror(
"Equations set is not associated",err,error,*999)
4385 exits(
"EquationsSet_DerivedDestroy")
4387 999 errorsexits(
"EquationsSet_DerivedDestroy",err,error)
4400 INTEGER(INTG),
INTENT(OUT) :: err
4403 enters(
"EquationsSet_DerivedFinalise",err,error,*999)
4405 IF(
ASSOCIATED(equationssetderived))
THEN 4406 IF(
ALLOCATED(equationssetderived%variableTypes))
DEALLOCATE(equationssetderived%variableTypes)
4407 DEALLOCATE(equationssetderived)
4410 exits(
"EquationsSet_DerivedFinalise")
4412 999 errorsexits(
"EquationsSet_DerivedFinalise",err,error)
4425 INTEGER(INTG),
INTENT(OUT) :: err
4428 enters(
"EquationsSet_DerivedInitialise",err,error,*999)
4430 IF(
ASSOCIATED(equationsset))
THEN 4431 IF(
ASSOCIATED(equationsset%derived))
THEN 4432 CALL flagerror(
"Derived information is already associated for this equations set.",err,error,*998)
4434 ALLOCATE(equationsset%derived,stat=err)
4435 IF(err/=0)
CALL flagerror(
"Could not allocate equations set derived information.",err,error,*998)
4437 IF(err/=0)
CALL flagerror(
"Could not allocate equations set derived variable types.",err,error,*999)
4438 equationsset%derived%variableTypes=0
4439 equationsset%derived%numberOfVariables=0
4440 equationsset%derived%equationsSet=>equationsset
4441 equationsset%derived%derivedFinished=.false.
4442 equationsset%derived%derivedFieldAutoCreated=.false.
4443 NULLIFY(equationsset%derived%derivedField)
4446 CALL flagerror(
"Equations set is not associated.",err,error,*999)
4449 exits(
"EquationsSet_DerivedInitialise")
4452 998 errorsexits(
"EquationsSet_DerivedInitialise",err,error)
4465 INTEGER(INTG),
INTENT(OUT) :: ERR
4469 enters(
"EQUATIONS_SET_EQUATIONS_SET_FIELD_FINALISE",err,error,*999)
4471 NULLIFY(equations_set_field%EQUATIONS_SET)
4472 equations_set_field%EQUATIONS_SET_FIELD_FINISHED=.false.
4473 equations_set_field%EQUATIONS_SET_FIELD_AUTO_CREATED=.false.
4474 NULLIFY(equations_set_field%EQUATIONS_SET_FIELD_FIELD)
4476 exits(
"EQUATIONS_SET_EQUATIONS_SET_FIELD_FINALISE")
4478 999 errorsexits(
"EQUATIONS_SET_EQUATIONS_SET_FIELD_FINALISE",err,error)
4490 INTEGER(INTG),
INTENT(OUT) :: ERR
4494 enters(
"EquationsSet_EquationsSetFieldInitialise",err,error,*999)
4496 IF(
ASSOCIATED(equations_set))
THEN 4497 equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET=>equations_set
4498 equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FINISHED=.false.
4499 equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_AUTO_CREATED=.true.
4500 NULLIFY(equations_set%EQUATIONS_SET_FIELD%EQUATIONS_SET_FIELD_FIELD)
4502 CALL flagerror(
"Equations set is not associated.",err,error,*999)
4505 exits(
"EquationsSet_EquationsSetFieldInitialise")
4507 999 errorsexits(
"EquationsSet_EquationsSetFieldInitialise",err,error)
4524 INTEGER(INTG),
INTENT(OUT) :: ERR
4529 enters(
"EQUATIONS_SET_SETUP",err,error,*999)
4531 IF(
ASSOCIATED(equations_set))
THEN 4532 IF(.NOT.
ALLOCATED(equations_set%SPECIFICATION))
THEN 4533 CALL flagerror(
"Equations set specification is not allocated.",err,error,*999)
4534 ELSE IF(
SIZE(equations_set%SPECIFICATION,1)<1)
THEN 4535 CALL flagerror(
"Equations set specification must have at least one entry.",err,error,*999)
4537 SELECT CASE(equations_set%SPECIFICATION(1))
4543 CALL flagerror(
"Not implemented.",err,error,*999)
4547 IF(
SIZE(equations_set%SPECIFICATION,1)<2)
THEN 4548 CALL flagerror(
"Equations set specification must have at least two entries for a bioelectrics equation class.", &
4552 CALL monodomain_equation_equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
4559 CALL flagerror(
"Not implemented.",err,error,*999)
4561 CALL multi_physics_equations_set_setup(equations_set,equations_set_setup_info,err,error,*999)
4563 local_error=
"The first equations set specification of "// &
4565 CALL flagerror(local_error,err,error,*999)
4568 CALL flagerror(
"Equations set is not associated.",err,error,*999)
4571 exits(
"EQUATIONS_SET_SETUP")
4573 999 errorsexits(
"EQUATIONS_SET_SETUP",err,error)
4586 INTEGER(INTG),
INTENT(OUT) :: ERR
4591 enters(
"EQUATIONS_SET_EQUATIONS_CREATE_FINISH",err,error,*999)
4593 IF(
ASSOCIATED(equations_set))
THEN 4603 CALL flagerror(
"Equations set is not associated.",err,error,*999)
4606 exits(
"EQUATIONS_SET_EQUATIONS_CREATE_FINISH")
4608 999 errorsexits(
"EQUATIONS_SET_EQUATIONS_CREATE_FINISH",err,error)
4632 INTEGER(INTG),
INTENT(OUT) :: ERR
4637 enters(
"EQUATIONS_SET_EQUATIONS_CREATE_START",err,error,*999)
4639 IF(
ASSOCIATED(equations_set))
THEN 4640 IF(
ASSOCIATED(equations))
THEN 4641 CALL flagerror(
"Equations is already associated.",err,error,*999)
4652 equations=>equations_set%EQUATIONS
4655 CALL flagerror(
"Equations set is not associated.",err,error,*999)
4658 exits(
"EQUATIONS_SET_EQUATIONS_CREATE_START")
4660 999 errorsexits(
"EQUATIONS_SET_EQUATIONS_CREATE_START",err,error)
4673 INTEGER(INTG),
INTENT(OUT) :: ERR
4677 enters(
"EQUATIONS_SET_EQUATIONS_DESTROY",err,error,*999)
4679 IF(
ASSOCIATED(equations_set))
THEN 4680 IF(
ASSOCIATED(equations_set%EQUATIONS))
THEN 4683 CALL flagerror(
"Equations set equations is not associated.",err,error,*999)
4686 CALL flagerror(
"Equations set is not associated.",err,error,*999)
4689 exits(
"EQUATIONS_SET_EQUATIONS_DESTROY")
4691 999 errorsexits(
"EQUATIONS_SET_EQUATIONS_DESTROY",err,error)
4704 INTEGER(INTG),
INTENT(OUT) :: ERR
4710 enters(
"EQUATIONS_SET_JACOBIAN_EVALUATE",err,error,*999)
4712 IF(
ASSOCIATED(equations_set))
THEN 4713 equations=>equations_set%EQUATIONS
4714 IF(
ASSOCIATED(equations))
THEN 4715 IF(equations%EQUATIONS_FINISHED)
THEN 4716 SELECT CASE(equations%LINEARITY)
4718 SELECT CASE(equations%TIME_DEPENDENCE)
4720 SELECT CASE(equations_set%SOLUTION_METHOD)
4724 CALL flagerror(
"Not implemented.",err,error,*999)
4726 CALL flagerror(
"Not implemented.",err,error,*999)
4728 CALL flagerror(
"Not implemented.",err,error,*999)
4730 CALL flagerror(
"Not implemented.",err,error,*999)
4732 CALL flagerror(
"Not implemented.",err,error,*999)
4734 local_error=
"The equations set solution method of "// &
4737 CALL flagerror(local_error,err,error,*999)
4740 SELECT CASE(equations_set%SOLUTION_METHOD)
4744 CALL flagerror(
"Not implemented.",err,error,*999)
4746 CALL flagerror(
"Not implemented.",err,error,*999)
4748 CALL flagerror(
"Not implemented.",err,error,*999)
4750 CALL flagerror(
"Not implemented.",err,error,*999)
4752 CALL flagerror(
"Not implemented.",err,error,*999)
4754 local_error=
"The equations set solution method of "// &
4757 CALL flagerror(local_error,err,error,*999)
4760 SELECT CASE(equations_set%SOLUTION_METHOD)
4764 CALL flagerror(
"Not implemented.",err,error,*999)
4766 CALL flagerror(
"Not implemented.",err,error,*999)
4768 CALL flagerror(
"Not implemented.",err,error,*999)
4770 CALL flagerror(
"Not implemented.",err,error,*999)
4772 CALL flagerror(
"Not implemented.",err,error,*999)
4774 local_error=
"The equations set solution method of "// &
4777 CALL flagerror(local_error,err,error,*999)
4780 local_error=
"The equations time dependence type of "// &
4782 CALL flagerror(local_error,err,error,*999)
4785 SELECT CASE(equations%TIME_DEPENDENCE)
4787 SELECT CASE(equations_set%SOLUTION_METHOD)
4793 CALL flagerror(
"Not implemented.",err,error,*999)
4795 CALL flagerror(
"Not implemented.",err,error,*999)
4797 CALL flagerror(
"Not implemented.",err,error,*999)
4799 CALL flagerror(
"Not implemented.",err,error,*999)
4801 CALL flagerror(
"Not implemented.",err,error,*999)
4803 local_error=
"The equations set solution method of "// &
4806 CALL flagerror(local_error,err,error,*999)
4809 SELECT CASE(equations_set%SOLUTION_METHOD)
4813 CALL flagerror(
"Not implemented.",err,error,*999)
4815 CALL flagerror(
"Not implemented.",err,error,*999)
4817 CALL flagerror(
"Not implemented.",err,error,*999)
4819 CALL flagerror(
"Not implemented.",err,error,*999)
4821 CALL flagerror(
"Not implemented.",err,error,*999)
4823 local_error=
"The equations set solution method of "// &
4826 CALL flagerror(local_error,err,error,*999)
4830 SELECT CASE(equations_set%SOLUTION_METHOD)
4834 CALL flagerror(
"Not implemented.",err,error,*999)
4836 CALL flagerror(
"Not implemented.",err,error,*999)
4838 CALL flagerror(
"Not implemented.",err,error,*999)
4840 CALL flagerror(
"Not implemented.",err,error,*999)
4842 CALL flagerror(
"Not implemented.",err,error,*999)
4844 local_error=
"The equations set solution method of "// &
4847 CALL flagerror(local_error,err,error,*999)
4850 CALL flagerror(
"Not implemented.",err,error,*999)
4852 local_error=
"The equations set time dependence type of "// &
4854 CALL flagerror(local_error,err,error,*999)
4857 CALL flagerror(
"Not implemented.",err,error,*999)
4859 local_error=
"The equations linearity of "// &
4861 CALL flagerror(local_error,err,error,*999)
4864 CALL flagerror(
"Equations have not been finished.",err,error,*999)
4867 CALL flagerror(
"Equations set equations is not associated.",err,error,*999)
4870 CALL flagerror(
"Equations set is not associated.",err,error,*999)
4873 exits(
"EQUATIONS_SET_JACOBIAN_EVALUATE")
4875 999 errorsexits(
"EQUATIONS_SET_JACOBIAN_EVALUATE",err,error)
4888 INTEGER(INTG),
INTENT(OUT) :: ERR
4891 INTEGER(INTG) :: element_idx,ne,NUMBER_OF_TIMES
4892 REAL(SP) :: ELEMENT_USER_ELAPSED,ELEMENT_SYSTEM_ELAPSED,USER_ELAPSED,USER_TIME1(1),USER_TIME2(1),USER_TIME3(1),USER_TIME4(1), &
4893 & USER_TIME5(1),USER_TIME6(1),SYSTEM_ELAPSED,SYSTEM_TIME1(1),SYSTEM_TIME2(1),SYSTEM_TIME3(1),SYSTEM_TIME4(1), &
4894 & SYSTEM_TIME5(1),SYSTEM_TIME6(1)
4900 enters(
"EQUATIONS_SET_JACOBIAN_EVALUATE_STATIC_FEM",err,error,*999)
4902 IF(
ASSOCIATED(equations_set))
THEN 4903 dependent_field=>equations_set%DEPENDENT%DEPENDENT_FIELD
4904 IF(
ASSOCIATED(dependent_field))
THEN 4905 equations=>equations_set%EQUATIONS
4906 IF(
ASSOCIATED(equations))
THEN 4907 equations_matrices=>equations%EQUATIONS_MATRICES
4908 IF(
ASSOCIATED(equations_matrices))
THEN 4919 elements_mapping=>dependent_field%DECOMPOSITION%DOMAIN(dependent_field%DECOMPOSITION%MESH_COMPONENT_NUMBER)%PTR% &
4925 user_elapsed=user_time2(1)-user_time1(1)
4926 system_elapsed=system_time2(1)-system_time1(1)
4931 element_user_elapsed=0.0_sp
4932 element_system_elapsed=0.0_sp
4936 DO element_idx=elements_mapping%INTERNAL_START,elements_mapping%INTERNAL_FINISH
4937 ne=elements_mapping%DOMAIN_LIST(element_idx)
4938 number_of_times=number_of_times+1
4947 user_elapsed=user_time3(1)-user_time2(1)
4948 system_elapsed=system_time3(1)-system_time2(1)
4949 element_user_elapsed=user_elapsed
4950 element_system_elapsed=system_elapsed
4961 user_elapsed=user_time4(1)-user_time3(1)
4962 system_elapsed=system_time4(1)-system_time3(1)
4969 DO element_idx=elements_mapping%BOUNDARY_START,elements_mapping%GHOST_FINISH
4970 ne=elements_mapping%DOMAIN_LIST(element_idx)
4971 number_of_times=number_of_times+1
4980 user_elapsed=user_time5(1)-user_time4(1)
4981 system_elapsed=system_time5(1)-system_time4(1)
4982 element_user_elapsed=element_user_elapsed+user_elapsed
4983 element_system_elapsed=element_system_elapsed+user_elapsed
4988 IF(number_of_times>0)
THEN 4990 & element_user_elapsed/number_of_times,err,error,*999)
4992 & element_system_elapsed/number_of_times,err,error,*999)
5005 user_elapsed=user_time6(1)-user_time1(1)
5006 system_elapsed=system_time6(1)-system_time1(1)
5014 CALL flagerror(
"Equations matrices is not associated",err,error,*999)
5017 CALL flagerror(
"Equations is not associated",err,error,*999)
5020 CALL flagerror(
"Dependent field is not associated",err,error,*999)
5023 CALL flagerror(
"Equations set is not associated.",err,error,*999)
5026 exits(
"EQUATIONS_SET_JACOBIAN_EVALUATE_STATIC_FEM")
5028 999 errorsexits(
"EQUATIONS_SET_JACOBIAN_EVALUATE_STATIC_FEM",err,error)