52 USE interface_matrices_routines
95 PUBLIC interface_equations_create_finish,interface_equations_create_start
97 PUBLIC interface_equations_destroy
99 PUBLIC interfaceequations_interfaceinterpsetsnumberset
101 PUBLIC interface_equations_output_type_get,interface_equations_output_type_set
103 PUBLIC interface_equations_sparsity_type_get,interface_equations_sparsity_type_set
105 PUBLIC interfaceequations_variableinterpsetsnumberset
107 PUBLIC interface_equations_linearity_type_get,interface_equations_linearity_type_set
109 PUBLIC interfaceequations_timedependencetypeget,interfaceequationstimedependencetypeset
111 PUBLIC interface_condition_equations_get
120 SUBROUTINE interface_equations_create_finish(INTERFACE_EQUATIONS,ERR,ERROR,*)
124 INTEGER(INTG),
INTENT(OUT) :: ERR
127 INTEGER(INTG) :: variable_idx
128 TYPE(
field_type),
POINTER :: DEPENDENT_FIELD,GEOMETRIC_FIELD,LAGRANGE_FIELD,PENALTY_FIELD
134 enters(
"INTERFACE_EQUATIONS_CREATE_FINISH",err,error,*999)
136 IF(
ASSOCIATED(interface_equations))
THEN 137 IF(interface_equations%INTERFACE_EQUATIONS_FINISHED)
THEN 138 CALL flagerror(
"Interface equations have already been finished.",err,error,*999)
141 interface_condition=>interface_equations%INTERFACE_CONDITION
142 IF(
ASSOCIATED(interface_condition))
THEN 143 SELECT CASE(interface_condition%METHOD)
145 IF(
ASSOCIATED(interface_condition%LAGRANGE))
THEN 146 interface_dependent=>interface_condition%DEPENDENT
147 IF(
ASSOCIATED(interface_dependent))
THEN 148 IF(
ASSOCIATED(interface_equations%INTERPOLATION))
THEN 149 geometric_field=>interface_condition%GEOMETRY%GEOMETRIC_FIELD
150 lagrange_field=>interface_condition%LAGRANGE%LAGRANGE_FIELD
151 NULLIFY(penalty_field)
152 IF(
ASSOCIATED(interface_condition%PENALTY))
THEN 153 penalty_field=>interface_condition%PENALTY%PENALTY_FIELD
156 CALL interface_equations_domain_interface_interpolation_(interface_equations%INTERPOLATION% &
157 & interface_interpolation,geometric_field,lagrange_field,penalty_field,err,error,*999)
158 DO variable_idx=1,interface_dependent%NUMBER_OF_DEPENDENT_VARIABLES
159 dependent_variable=>interface_dependent%FIELD_VARIABLES(variable_idx)%PTR
160 IF(
ASSOCIATED(dependent_variable))
THEN 161 dependent_field=>dependent_variable%FIELD
162 IF(
ASSOCIATED(dependent_field))
THEN 163 geometric_field=>dependent_field%GEOMETRIC_FIELD
164 CALL interfaceequations_domainvariableinterpolationsetup(interface_equations%INTERPOLATION% &
165 & variable_interpolation(variable_idx),geometric_field,dependent_field,err,error,*999)
167 CALL flagerror(
"Dependent variable field is not associated.",err,error,*999)
170 local_error=
"Dependent variable is not associated for variable index "// &
172 CALL flagerror(local_error,err,error,*999)
176 CALL flagerror(
"Interface equations interpolation is not associated.",err,error,*999)
179 CALL flagerror(
"Interface condition dependent is not associated.",err,error,*999)
182 CALL flagerror(
"Interface condition Lagrange is not associated.",err,error,*999)
185 CALL flagerror(
"Not implemented.",err,error,*999)
187 CALL flagerror(
"Not implemented.",err,error,*999)
189 local_error=
"The interface condition method of "// &
192 CALL flagerror(local_error,err,error,*999)
195 interface_equations%INTERFACE_EQUATIONS_FINISHED=.true.
197 CALL flagerror(
"Interface equations interface condition is not associated.",err,error,*999)
201 CALL flagerror(
"Interface equations is not associated.",err,error,*999)
204 exits(
"INTERFACE_EQUATIONS_CREATE_FINISH")
206 999 errorsexits(
"INTERFACE_EQUATIONS_CREATE_FINISH",err,error)
209 END SUBROUTINE interface_equations_create_finish
216 SUBROUTINE interface_equations_create_start(INTERFACE_CONDITION,INTERFACE_EQUATIONS,ERR,ERROR,*)
221 INTEGER(INTG),
INTENT(OUT) :: ERR
225 enters(
"INTERFACE_EQUATIONS_CREATE_START",err,error,*999)
227 IF(
ASSOCIATED(interface_condition))
THEN 228 IF(
ASSOCIATED(interface_condition%INTERFACE_EQUATIONS))
THEN 229 CALL flagerror(
"Interface equations are already associated for the interface condition.",err,error,*999)
231 IF(
ASSOCIATED(interface_equations))
THEN 232 CALL flagerror(
"Interface equations is already associated.",err,error,*999)
235 CALL interface_equations_initialise(interface_condition,err,error,*999)
237 interface_equations=>interface_condition%INTERFACE_EQUATIONS
241 CALL flagerror(
"Interface condition is not associated.",err,error,*999)
244 exits(
"INTERFACE_EQUATIONS_CREATE_START")
246 999 errorsexits(
"INTERFACE_EQUATIONS_CREATE_START",err,error)
249 END SUBROUTINE interface_equations_create_start
256 SUBROUTINE interface_equations_destroy(INTERFACE_EQUATIONS,ERR,ERROR,*)
260 INTEGER(INTG),
INTENT(OUT) :: ERR
264 enters(
"INTERFACE_EQUATIONS_DESTROY",err,error,*999)
266 IF(
ASSOCIATED(interface_equations))
THEN 267 CALL interface_equations_finalise(interface_equations,err,error,*999)
269 CALL flagerror(
"Interface equations is not associated.",err,error,*999)
272 exits(
"INTERFACE_EQUATIONS_DESTROY")
274 999 errorsexits(
"INTERFACE_EQUATIONS_DESTROY",err,error)
277 END SUBROUTINE interface_equations_destroy
284 SUBROUTINE interfaceequations_domaininterpolationfinalise(DOMAIN_INTERPOLATION,ERR,ERROR,*)
288 INTEGER(INTG),
INTENT(OUT) :: ERR
291 INTEGER(INTG) :: interpolation_set_idx
293 enters(
"InterfaceEquations_DomainInterpolationFinalise",err,error,*999)
295 NULLIFY(domain_interpolation%GEOMETRIC_FIELD)
296 IF(
ALLOCATED(domain_interpolation%GEOMETRIC_INTERPOLATION))
THEN 297 DO interpolation_set_idx=1,
SIZE(domain_interpolation%GEOMETRIC_INTERPOLATION,1)
298 CALL interfaceequations_interpolationsetfinalise(domain_interpolation%GEOMETRIC_INTERPOLATION(interpolation_set_idx), &
301 DEALLOCATE(domain_interpolation%GEOMETRIC_INTERPOLATION)
303 domain_interpolation%NUMBER_OF_GEOMETRIC_INTERPOLATION_SETS=0
304 NULLIFY(domain_interpolation%DEPENDENT_FIELD)
305 IF(
ALLOCATED(domain_interpolation%DEPENDENT_INTERPOLATION))
THEN 306 DO interpolation_set_idx=1,
SIZE(domain_interpolation%DEPENDENT_INTERPOLATION,1)
307 CALL interfaceequations_interpolationsetfinalise(domain_interpolation%DEPENDENT_INTERPOLATION(interpolation_set_idx), &
310 DEALLOCATE(domain_interpolation%DEPENDENT_INTERPOLATION)
312 domain_interpolation%NUMBER_OF_DEPENDENT_INTERPOLATION_SETS=0
314 exits(
"InterfaceEquations_DomainInterpolationFinalise")
316 999
errors(
"InterfaceEquations_DomainInterpolationFinalise",err,error)
317 exits(
"InterfaceEquations_DomainInterpolationFinalise")
320 END SUBROUTINE interfaceequations_domaininterpolationfinalise
327 SUBROUTINE interfaceequations_domaininterpolationinitialise(DOMAIN_INTERPOLATION,ERR,ERROR,*)
331 INTEGER(INTG),
INTENT(OUT) :: ERR
335 enters(
"InterfaceEquations_DomainInterpolationInitialise",err,error,*999)
337 NULLIFY(domain_interpolation%PENALTY_FIELD)
338 domain_interpolation%NUMBER_OF_PENALTY_INTERPOLATION_SETS=1
339 NULLIFY(domain_interpolation%GEOMETRIC_FIELD)
340 domain_interpolation%NUMBER_OF_GEOMETRIC_INTERPOLATION_SETS=1
341 NULLIFY(domain_interpolation%DEPENDENT_FIELD)
342 domain_interpolation%NUMBER_OF_DEPENDENT_INTERPOLATION_SETS=1
344 exits(
"InterfaceEquations_DomainInterpolationInitialise")
346 999
errors(
"InterfaceEquations_DomainInterpolationInitialise",err,error)
347 exits(
"InterfaceEquations_DomainInterpolationInitialise")
350 END SUBROUTINE interfaceequations_domaininterpolationinitialise
357 SUBROUTINE interface_equations_domain_interface_interpolation_(DOMAIN_INTERPOLATION,GEOMETRIC_FIELD,LAGRANGE_FIELD, &
358 & penalty_field,err,error,*)
365 INTEGER(INTG),
INTENT(OUT) :: ERR
368 INTEGER(INTG) :: DUMMY_ERR,interpolation_set_idx
371 enters(
"InterfaceEquations_DomainInterpolationSet",err,error,*998)
373 IF(
ASSOCIATED(geometric_field))
THEN 374 IF(
ASSOCIATED(lagrange_field))
THEN 375 domain_interpolation%GEOMETRIC_FIELD=>geometric_field
376 ALLOCATE(domain_interpolation%GEOMETRIC_INTERPOLATION(domain_interpolation%NUMBER_OF_GEOMETRIC_INTERPOLATION_SETS), &
378 IF(err/=0)
CALL flagerror(
"Could not allocate domain interpolation geometric interpolation.",err,error,*999)
379 DO interpolation_set_idx=1,domain_interpolation%NUMBER_OF_GEOMETRIC_INTERPOLATION_SETS
380 CALL interfaceequations_interpolationsetinitialise(domain_interpolation%GEOMETRIC_INTERPOLATION( &
381 & interpolation_set_idx),err,error,*999)
382 CALL field_interpolation_parameters_initialise(domain_interpolation%GEOMETRIC_FIELD,domain_interpolation% &
383 & geometric_interpolation(interpolation_set_idx)%INTERPOLATION_PARAMETERS,err,error,*999)
384 CALL field_interpolated_points_initialise(domain_interpolation%GEOMETRIC_INTERPOLATION(interpolation_set_idx)% &
385 & interpolation_parameters,domain_interpolation%GEOMETRIC_INTERPOLATION(interpolation_set_idx)%INTERPOLATED_POINT, &
387 IF(domain_interpolation%GEOMETRIC_FIELD%TYPE==field_geometric_type.OR. &
388 & domain_interpolation%GEOMETRIC_FIELD%TYPE==field_fibre_type)
THEN 389 CALL field_interpolatedpointsmetricsinitialise(domain_interpolation%GEOMETRIC_INTERPOLATION( &
390 & interpolation_set_idx)%INTERPOLATED_POINT,domain_interpolation%GEOMETRIC_INTERPOLATION(interpolation_set_idx)% &
391 & interpolated_point_metrics,err,error,*999)
394 domain_interpolation%DEPENDENT_FIELD=>lagrange_field
395 ALLOCATE(domain_interpolation%DEPENDENT_INTERPOLATION(domain_interpolation%NUMBER_OF_DEPENDENT_INTERPOLATION_SETS), &
397 IF(err/=0)
CALL flagerror(
"Could not allocate domain interpolation dependent interpolation.",err,error,*999)
398 DO interpolation_set_idx=1,domain_interpolation%NUMBER_OF_DEPENDENT_INTERPOLATION_SETS
399 CALL interfaceequations_interpolationsetinitialise(domain_interpolation%DEPENDENT_INTERPOLATION( &
400 & interpolation_set_idx),err,error,*999)
401 CALL field_interpolation_parameters_initialise(domain_interpolation%DEPENDENT_FIELD,domain_interpolation% &
402 & dependent_interpolation(interpolation_set_idx)%INTERPOLATION_PARAMETERS,err,error,*999)
403 CALL field_interpolated_points_initialise(domain_interpolation%DEPENDENT_INTERPOLATION(interpolation_set_idx)% &
404 & interpolation_parameters,domain_interpolation%DEPENDENT_INTERPOLATION(interpolation_set_idx)%INTERPOLATED_POINT, &
407 IF(
ASSOCIATED(penalty_field))
THEN 408 domain_interpolation%PENALTY_FIELD=>penalty_field
409 ALLOCATE(domain_interpolation%PENALTY_INTERPOLATION(domain_interpolation%NUMBER_OF_PENALTY_INTERPOLATION_SETS), &
411 IF(err/=0)
CALL flagerror(
"Could not allocate domain interpolation dependent interpolation.",err,error,*999)
412 DO interpolation_set_idx=1,domain_interpolation%NUMBER_OF_PENALTY_INTERPOLATION_SETS
413 CALL interfaceequations_interpolationsetinitialise(domain_interpolation%PENALTY_INTERPOLATION( &
414 & interpolation_set_idx),err,error,*999)
415 CALL field_interpolation_parameters_initialise(domain_interpolation%PENALTY_FIELD,domain_interpolation% &
416 & penalty_interpolation(interpolation_set_idx)%INTERPOLATION_PARAMETERS,err,error,*999)
417 CALL field_interpolated_points_initialise(domain_interpolation%PENALTY_INTERPOLATION(interpolation_set_idx)% &
418 & interpolation_parameters,domain_interpolation%PENALTY_INTERPOLATION(interpolation_set_idx)%INTERPOLATED_POINT, &
423 CALL flagerror(
"Lagrange field is not associated.",err,error,*998)
426 CALL flagerror(
"Geometric field is not associated.",err,error,*998)
429 exits(
"InterfaceEquations_DomainInterpolationSet")
431 999
CALL interfaceequations_domaininterpolationfinalise(domain_interpolation,dummy_err,dummy_error,*998)
432 998 errorsexits(
"InterfaceEquations_DomainInterpolationSet",err,error)
435 END SUBROUTINE interface_equations_domain_interface_interpolation_
442 SUBROUTINE interfaceequations_domainvariableinterpolationsetup(DOMAIN_INTERPOLATION,GEOMETRIC_FIELD,DEPENDENT_FIELD, &
449 INTEGER(INTG),
INTENT(OUT) :: ERR
452 INTEGER(INTG) :: DUMMY_ERR,interpolation_set_idx
455 enters(
"InterfaceEquations_DomainVariableInterpolationSetup",err,error,*998)
457 IF(
ASSOCIATED(geometric_field))
THEN 458 IF(
ASSOCIATED(dependent_field))
THEN 459 domain_interpolation%GEOMETRIC_FIELD=>geometric_field
460 ALLOCATE(domain_interpolation%GEOMETRIC_INTERPOLATION(domain_interpolation%NUMBER_OF_GEOMETRIC_INTERPOLATION_SETS), &
462 IF(err/=0)
CALL flagerror(
"Could not allocate domain interpolation geometric interpolation.",err,error,*999)
463 DO interpolation_set_idx=1,domain_interpolation%NUMBER_OF_GEOMETRIC_INTERPOLATION_SETS
464 CALL interfaceequations_interpolationsetinitialise(domain_interpolation%GEOMETRIC_INTERPOLATION( &
465 & interpolation_set_idx),err,error,*999)
466 CALL field_interpolation_parameters_initialise(domain_interpolation%GEOMETRIC_FIELD,domain_interpolation% &
467 & geometric_interpolation(interpolation_set_idx)%INTERPOLATION_PARAMETERS,err,error,*999)
468 CALL field_interpolated_points_initialise(domain_interpolation%GEOMETRIC_INTERPOLATION(interpolation_set_idx)% &
469 & interpolation_parameters,domain_interpolation%GEOMETRIC_INTERPOLATION(interpolation_set_idx)%INTERPOLATED_POINT, &
471 IF(domain_interpolation%GEOMETRIC_FIELD%TYPE==field_geometric_type.OR. &
472 & domain_interpolation%GEOMETRIC_FIELD%TYPE==field_fibre_type)
THEN 473 CALL field_interpolatedpointsmetricsinitialise(domain_interpolation%GEOMETRIC_INTERPOLATION( &
474 & interpolation_set_idx)%INTERPOLATED_POINT,domain_interpolation%GEOMETRIC_INTERPOLATION(interpolation_set_idx)% &
475 & interpolated_point_metrics,err,error,*999)
478 domain_interpolation%DEPENDENT_FIELD=>dependent_field
479 ALLOCATE(domain_interpolation%DEPENDENT_INTERPOLATION(domain_interpolation%NUMBER_OF_DEPENDENT_INTERPOLATION_SETS), &
481 IF(err/=0)
CALL flagerror(
"Could not allocate domain interpolation dependent interpolation.",err,error,*999)
482 DO interpolation_set_idx=1,domain_interpolation%NUMBER_OF_DEPENDENT_INTERPOLATION_SETS
483 CALL interfaceequations_interpolationsetinitialise(domain_interpolation%DEPENDENT_INTERPOLATION( &
484 & interpolation_set_idx),err,error,*999)
485 CALL field_interpolation_parameters_initialise(domain_interpolation%DEPENDENT_FIELD,domain_interpolation% &
486 & dependent_interpolation(interpolation_set_idx)%INTERPOLATION_PARAMETERS,err,error,*999)
487 CALL field_interpolated_points_initialise(domain_interpolation%DEPENDENT_INTERPOLATION(interpolation_set_idx)% &
488 & interpolation_parameters,domain_interpolation%DEPENDENT_INTERPOLATION(interpolation_set_idx)%INTERPOLATED_POINT, &
490 IF(domain_interpolation%DEPENDENT_FIELD%TYPE==field_geometric_type.OR. &
491 & domain_interpolation%DEPENDENT_FIELD%TYPE==field_fibre_type)
THEN 492 CALL field_interpolatedpointsmetricsinitialise(domain_interpolation%DEPENDENT_INTERPOLATION( &
493 & interpolation_set_idx)%INTERPOLATED_POINT,domain_interpolation%DEPENDENT_INTERPOLATION(interpolation_set_idx)% &
494 & interpolated_point_metrics,err,error,*999)
498 CALL flagerror(
"Dependent field is not associated.",err,error,*998)
501 CALL flagerror(
"Geometric field is not associated.",err,error,*998)
504 exits(
"InterfaceEquations_DomainVariableInterpolationSetup")
506 999
CALL interfaceequations_domaininterpolationfinalise(domain_interpolation,dummy_err,dummy_error,*998)
507 998
errors(
"InterfaceEquations_DomainVariableInterpolationSetup",err,error)
508 exits(
"InterfaceEquations_DomainVariableInterpolationSetup")
511 END SUBROUTINE interfaceequations_domainvariableinterpolationsetup
517 SUBROUTINE interfaceequations_interfaceinterpsetsnumberset(INTERFACE_EQUATIONS,NUMBER_OF_GEOMETRIC_SETS, &
518 & number_of_dependent_sets,number_of_penalty_sets,err,error,*)
522 INTEGER(INTG),
INTENT(IN) :: NUMBER_OF_GEOMETRIC_SETS
523 INTEGER(INTG),
INTENT(IN) :: NUMBER_OF_DEPENDENT_SETS
524 INTEGER(INTG),
INTENT(IN) :: NUMBER_OF_PENALTY_SETS
525 INTEGER(INTG),
INTENT(OUT) :: ERR
530 enters(
"InterfaceEquations_InterfaceInterpSetsNumberSet",err,error,*999)
532 IF(
ASSOCIATED(interface_equations))
THEN 533 IF(interface_equations%INTERFACE_EQUATIONS_FINISHED)
THEN 534 CALL flagerror(
"Interface equations have already been finished.",err,error,*999)
536 IF(
ASSOCIATED(interface_equations%INTERPOLATION))
THEN 537 IF(number_of_geometric_sets>0)
THEN 538 IF(number_of_dependent_sets>0)
THEN 539 IF(number_of_penalty_sets>=0)
THEN 540 interface_equations%INTERPOLATION%INTERFACE_INTERPOLATION%NUMBER_OF_GEOMETRIC_INTERPOLATION_SETS= &
541 & number_of_geometric_sets
542 interface_equations%INTERPOLATION%INTERFACE_INTERPOLATION%NUMBER_OF_DEPENDENT_INTERPOLATION_SETS= &
543 & number_of_dependent_sets
544 interface_equations%INTERPOLATION%INTERFACE_INTERPOLATION%NUMBER_OF_PENALTY_INTERPOLATION_SETS= &
545 & number_of_penalty_sets
547 local_error=
"The specified number of penalty sets of "// &
549 &
" is invalid. The number of penalty sets must be > 0." 550 CALL flagerror(local_error,err,error,*999)
553 local_error=
"The specified number of dependent sets of "// &
555 &
" is invalid. The number of dependent sets must be > 0." 556 CALL flagerror(local_error,err,error,*999)
559 local_error=
"The specified number of geometric sets of "// &
561 &
" is invalid. The number of geometric sets must be > 0." 562 CALL flagerror(local_error,err,error,*999)
565 CALL flagerror(
"Interface equations interpolation is not associated.",err,error,*999)
569 CALL flagerror(
"Interface equations is not associated.",err,error,*999)
572 exits(
"InterfaceEquations_InterfaceInterpSetsNumberSet")
574 999
errors(
"InterfaceEquations_InterfaceInterpSetsNumberSet",err,error)
575 exits(
"InterfaceEquations_InterfaceInterpSetsNumberSet")
578 END SUBROUTINE interfaceequations_interfaceinterpsetsnumberset
585 SUBROUTINE interface_equations_finalise(INTERFACE_EQUATIONS,ERR,ERROR,*)
589 INTEGER(INTG),
INTENT(OUT) :: ERR
593 enters(
"INTERFACE_EQUATIONS_FINALISE",err,error,*999)
595 IF(
ASSOCIATED(interface_equations))
THEN 596 CALL interface_equations_interpolation_finalise(interface_equations%INTERPOLATION,err,error,*999)
597 IF(
ASSOCIATED(interface_equations%INTERFACE_MAPPING)) &
598 &
CALL interface_mapping_destroy(interface_equations%INTERFACE_MAPPING,err,error,*999)
599 IF(
ASSOCIATED(interface_equations%INTERFACE_MATRICES)) &
600 &
CALL interface_matrices_destroy(interface_equations%INTERFACE_MATRICES,err,error,*999)
601 DEALLOCATE(interface_equations)
604 exits(
"INTERFACE_EQUATIONS_FINALISE")
606 999 errorsexits(
"INTERFACE_EQUATIONS_FINALISE",err,error)
608 END SUBROUTINE interface_equations_finalise
615 SUBROUTINE interface_equations_initialise(INTERFACE_CONDITION,ERR,ERROR,*)
619 INTEGER(INTG),
INTENT(OUT) :: ERR
622 INTEGER(INTG) :: DUMMY_ERR
625 enters(
"INTERFACE_EQUATIONS_INITIALISE",err,error,*998)
627 IF(
ASSOCIATED(interface_condition))
THEN 628 IF(
ASSOCIATED(interface_condition%INTERFACE_EQUATIONS))
THEN 629 CALL flagerror(
"Interface equations is already associated for this interface condition.",err,error,*998)
631 ALLOCATE(interface_condition%INTERFACE_EQUATIONS,stat=err)
632 IF(err/=0)
CALL flagerror(
"Could not allocate interface equations.",err,error,*999)
633 interface_condition%INTERFACE_EQUATIONS%INTERFACE_CONDITION=>interface_condition
638 NULLIFY(interface_condition%INTERFACE_EQUATIONS%INTERPOLATION)
639 NULLIFY(interface_condition%INTERFACE_EQUATIONS%INTERFACE_MAPPING)
640 NULLIFY(interface_condition%INTERFACE_EQUATIONS%INTERFACE_MATRICES)
641 interface_condition%INTERFACE_EQUATIONS%INTERFACE_EQUATIONS_FINISHED=.false.
642 CALL interfaceequations_interpolationinitialise(interface_condition%INTERFACE_EQUATIONS,err,error,*999)
645 CALL flagerror(
"Interface condition is not associated.",err,error,*998)
648 exits(
"INTERFACE_EQUATIONS_INITIALISE")
650 999
CALL interface_equations_finalise(interface_condition%INTERFACE_EQUATIONS,dummy_err,dummy_error,*998)
651 998 errorsexits(
"INTERFACE_EQUATIONS_INITIALISE",err,error)
654 END SUBROUTINE interface_equations_initialise
661 SUBROUTINE interface_equations_interpolation_finalise(INTERFACE_EQUATIONS_INTERPOLATION,ERR,ERROR,*)
665 INTEGER(INTG),
INTENT(OUT) :: ERR
668 INTEGER(INTG) :: variable_idx
670 enters(
"INTERFACE_EQUATIONS_INTERPOLATION_FINALISE",err,error,*999)
672 IF(
ASSOCIATED(interface_equations_interpolation))
THEN 673 CALL interfaceequations_domaininterpolationfinalise(interface_equations_interpolation%INTERFACE_INTERPOLATION, &
675 IF(
ALLOCATED(interface_equations_interpolation%VARIABLE_INTERPOLATION))
THEN 676 DO variable_idx=1,
SIZE(interface_equations_interpolation%VARIABLE_INTERPOLATION,1)
677 CALL interfaceequations_domaininterpolationfinalise(interface_equations_interpolation% &
678 & variable_interpolation(variable_idx),err,error,*999)
680 DEALLOCATE(interface_equations_interpolation%VARIABLE_INTERPOLATION)
684 exits(
"INTERFACE_EQUATIONS_INTERPOLATION_FINALISE")
686 999 errorsexits(
"INTERFACE_EQUATIONS_INTERPOLATION_FINALISE",err,error)
689 END SUBROUTINE interface_equations_interpolation_finalise
696 SUBROUTINE interfaceequations_interpolationinitialise(INTERFACE_EQUATIONS,ERR,ERROR,*)
700 INTEGER(INTG),
INTENT(OUT) :: ERR
703 INTEGER(INTG) :: DUMMY_ERR,variable_idx
708 enters(
"InterfaceEquations_InterpolationInitialise",err,error,*998)
710 IF(
ASSOCIATED(interface_equations))
THEN 711 interface_condition=>interface_equations%INTERFACE_CONDITION
712 IF(
ASSOCIATED(interface_condition))
THEN 713 IF(
ASSOCIATED(interface_equations%INTERPOLATION))
THEN 714 CALL flagerror(
"Interface equations interpolation is already associated.",err,error,*998)
716 interface_dependent=>interface_condition%DEPENDENT
717 IF(
ASSOCIATED(interface_dependent))
THEN 718 ALLOCATE(interface_equations%INTERPOLATION,stat=err)
719 IF(err/=0)
CALL flagerror(
"Could not allocate interface equations interpolation.",err,error,*999)
720 interface_equations%INTERPOLATION%INTERFACE_EQUATIONS=>interface_equations
721 CALL interfaceequations_domaininterpolationinitialise(interface_equations%INTERPOLATION%INTERFACE_INTERPOLATION, &
723 interface_equations%INTERPOLATION%INTERFACE_INTERPOLATION%INTERPOLATION=>interface_equations%INTERPOLATION
724 ALLOCATE(interface_equations%INTERPOLATION%VARIABLE_INTERPOLATION(interface_dependent%NUMBER_OF_DEPENDENT_VARIABLES), &
726 IF(err/=0)
CALL flagerror(
"Could not allocate interface equations interpolation mesh interpolation.",err,error,*999)
727 DO variable_idx=1,interface_dependent%NUMBER_OF_DEPENDENT_VARIABLES
728 CALL interfaceequations_domaininterpolationinitialise(interface_equations%INTERPOLATION% &
729 & variable_interpolation(variable_idx),err,error,*999)
730 interface_equations%INTERPOLATION%VARIABLE_INTERPOLATION(variable_idx)%INTERPOLATION=> &
731 & interface_equations%INTERPOLATION
734 CALL flagerror(
"Interface condition dependent is not associated.",err,error,*999)
738 CALL flagerror(
"Interface equations interface condition is not associated.",err,error,*998)
741 CALL flagerror(
"Interface equations is not associated.",err,error,*998)
744 exits(
"InterfaceEquations_InterpolationInitialise")
746 999
CALL interface_equations_interpolation_finalise(interface_equations%INTERPOLATION,dummy_err,dummy_error,*998)
747 998 errorsexits(
"InterfaceEquations_InterpolationInitialise",err,error)
750 END SUBROUTINE interfaceequations_interpolationinitialise
757 SUBROUTINE interfaceequations_interpolationsetfinalise(INTERPOLATION_SET,ERR,ERROR,*)
761 INTEGER(INTG),
INTENT(OUT) :: ERR
765 enters(
"InterfaceEquations_InterpolationSetFinalise",err,error,*999)
767 CALL field_interpolation_parameters_finalise(interpolation_set%INTERPOLATION_PARAMETERS,err,error,*999)
768 CALL field_interpolated_points_finalise(interpolation_set%INTERPOLATED_POINT,err,error,*999)
769 CALL field_interpolatedpointsmetricsfinalise(interpolation_set%INTERPOLATED_POINT_METRICS,err,error,*999)
771 exits(
"InterfaceEquations_InterpolationSetFinalise")
773 999 errorsexits(
"InterfaceEquations_InterpolationSetFinalise",err,error)
776 END SUBROUTINE interfaceequations_interpolationsetfinalise
783 SUBROUTINE interfaceequations_interpolationsetinitialise(INTERPOLATION_SET,ERR,ERROR,*)
787 INTEGER(INTG),
INTENT(OUT) :: ERR
791 enters(
"InterfaceEquations_InterpolationSetInitialise",err,error,*999)
793 NULLIFY(interpolation_set%INTERPOLATION_PARAMETERS)
794 NULLIFY(interpolation_set%INTERPOLATED_POINT)
795 NULLIFY(interpolation_set%INTERPOLATED_POINT_METRICS)
797 exits(
"InterfaceEquations_InterpolationSetInitialise")
799 999
errors(
"InterfaceEquations_InterpolationSetInitialise",err,error)
800 exits(
"InterfaceEquations_InterpolationSetInitialise")
803 END SUBROUTINE interfaceequations_interpolationsetinitialise
810 SUBROUTINE interface_equations_output_type_get(INTERFACE_EQUATIONS,OUTPUT_TYPE,ERR,ERROR,*)
814 INTEGER(INTG),
INTENT(OUT) :: OUTPUT_TYPE
815 INTEGER(INTG),
INTENT(OUT) :: ERR
819 enters(
"INTERFACE_EQUATIONS_OUTPUT_TYPE_GET",err,error,*999)
821 IF(
ASSOCIATED(interface_equations))
THEN 822 IF(interface_equations%INTERFACE_EQUATIONS_FINISHED)
THEN 823 output_type=interface_equations%OUTPUT_TYPE
825 CALL flagerror(
"Interface equations has not been finished.",err,error,*999)
828 CALL flagerror(
"Interface equations is not associated.",err,error,*999)
831 exits(
"INTERFACE_EQUATIONS_OUTPUT_TYPE_GET")
833 999 errorsexits(
"INTERFACE_EQUATIONS_OUTPUT_TYPE_GET",err,error)
835 END SUBROUTINE interface_equations_output_type_get
842 SUBROUTINE interface_equations_output_type_set(INTERFACE_EQUATIONS,OUTPUT_TYPE,ERR,ERROR,*)
846 INTEGER(INTG),
INTENT(IN) :: OUTPUT_TYPE
847 INTEGER(INTG),
INTENT(OUT) :: ERR
852 enters(
"INTERFACE_EQUATIONS_OUTPUT_TYPE_SET",err,error,*999)
854 IF(
ASSOCIATED(interface_equations))
THEN 855 IF(interface_equations%INTERFACE_EQUATIONS_FINISHED)
THEN 856 CALL flagerror(
"Interface equations has already been finished.",err,error,*999)
858 SELECT CASE(output_type)
868 local_error=
"The specified output type of "//
trim(
number_to_vstring(output_type,
"*",err,error))//
" is invalid" 869 CALL flagerror(local_error,err,error,*999)
873 CALL flagerror(
"Interface equations is not associated.",err,error,*999)
876 exits(
"INTERFACE_EQUATIONS_OUTPUT_TYPE_SET")
878 999 errorsexits(
"INTERFACE_EQUATIONS_OUTPUT_TYPE_SET",err,error)
881 END SUBROUTINE interface_equations_output_type_set
888 SUBROUTINE interface_equations_sparsity_type_get(INTERFACE_EQUATIONS,SPARSITY_TYPE,ERR,ERROR,*)
892 INTEGER(INTG),
INTENT(OUT) :: SPARSITY_TYPE
893 INTEGER(INTG),
INTENT(OUT) :: ERR
897 enters(
"INTERFACE_EQUATIONS_SPARSITY_TYPE_GET",err,error,*999)
899 IF(
ASSOCIATED(interface_equations))
THEN 900 IF(interface_equations%INTERFACE_EQUATIONS_FINISHED)
THEN 901 sparsity_type=interface_equations%SPARSITY_TYPE
903 CALL flagerror(
"Interface equations has not been finished.",err,error,*999)
906 CALL flagerror(
"Interface equations is not associated.",err,error,*999)
909 exits(
"INTERFACE_EQUATIONS_SPARSITY_TYPE_GET")
911 999 errorsexits(
"INTERFACE_EQUATIONS_SPARSITY_TYPE_GET",err,error)
913 END SUBROUTINE interface_equations_sparsity_type_get
920 SUBROUTINE interface_equations_sparsity_type_set(INTERFACE_EQUATIONS,SPARSITY_TYPE,ERR,ERROR,*)
924 INTEGER(INTG),
INTENT(IN) :: SPARSITY_TYPE
925 INTEGER(INTG),
INTENT(OUT) :: ERR
930 enters(
"INTERFACE_EQUATIONS_SPARSITY_TYPE_SET",err,error,*999)
932 IF(
ASSOCIATED(interface_equations))
THEN 933 IF(interface_equations%INTERFACE_EQUATIONS_FINISHED)
THEN 934 CALL flagerror(
"Interface equations has already been finished.",err,error,*999)
936 SELECT CASE(sparsity_type)
942 local_error=
"The specified sparsity type of "//
trim(
number_to_vstring(sparsity_type,
"*",err,error))// &
944 CALL flagerror(local_error,err,error,*999)
948 CALL flagerror(
"Interface equations is not associated.",err,error,*999)
951 exits(
"INTERFACE_EQUATIONS_SPARSITY_TYPE_SET")
953 999 errorsexits(
"INTERFACE_EQUATIONS_SPARSITY_TYPE_SET",err,error)
955 END SUBROUTINE interface_equations_sparsity_type_set
962 SUBROUTINE interface_equations_linearity_type_get(INTERFACE_EQUATIONS,LINEARITY_TYPE,ERR,ERROR,*)
966 INTEGER(INTG),
INTENT(OUT) :: LINEARITY_TYPE
967 INTEGER(INTG),
INTENT(OUT) :: ERR
971 enters(
"INTERFACE_EQUATIONS_LINEARITY_TYPE_GET",err,error,*999)
973 IF(
ASSOCIATED(interface_equations))
THEN 974 IF(interface_equations%INTERFACE_EQUATIONS_FINISHED)
THEN 975 linearity_type=interface_equations%LINEARITY
977 CALL flagerror(
"Interface equations has not been finished.",err,error,*999)
980 CALL flagerror(
"Interface equations is not associated.",err,error,*999)
983 exits(
"INTERFACE_EQUATIONS_LINEARITY_TYPE_GET")
985 999 errorsexits(
"INTERFACE_EQUATIONS_LINEARITY_TYPE_GET",err,error)
987 END SUBROUTINE interface_equations_linearity_type_get
994 SUBROUTINE interface_equations_linearity_type_set(INTERFACE_EQUATIONS,LINEARITY_TYPE,ERR,ERROR,*)
998 INTEGER(INTG),
INTENT(IN) :: LINEARITY_TYPE
999 INTEGER(INTG),
INTENT(OUT) :: ERR
1004 enters(
"INTERFACE_EQUATIONS_LINEARITY_TYPE_SET",err,error,*999)
1006 IF(
ASSOCIATED(interface_equations))
THEN 1007 IF(interface_equations%INTERFACE_EQUATIONS_FINISHED)
THEN 1008 CALL flagerror(
"Interface equations has already been finished.",err,error,*999)
1010 SELECT CASE(linearity_type)
1018 local_error=
"The specified linearity type of "//
trim(
number_to_vstring(linearity_type,
"*",err,error))// &
1020 CALL flagerror(local_error,err,error,*999)
1024 CALL flagerror(
"Interface equations is not associated.",err,error,*999)
1027 exits(
"INTERFACE_EQUATIONS_LINEARITY_TYPE_SET")
1029 999 errorsexits(
"INTERFACE_EQUATIONS_LINEARITY_TYPE_SET",err,error)
1031 END SUBROUTINE interface_equations_linearity_type_set
1038 SUBROUTINE interfaceequations_timedependencetypeget(INTERFACE_EQUATIONS,TIME_DEPENDENCE_TYPE,ERR,ERROR,*)
1042 INTEGER(INTG),
INTENT(OUT) :: TIME_DEPENDENCE_TYPE
1043 INTEGER(INTG),
INTENT(OUT) :: ERR
1047 enters(
"InterfaceEquations_TimeDependenceTypeGet",err,error,*999)
1049 IF(
ASSOCIATED(interface_equations))
THEN 1050 IF(interface_equations%INTERFACE_EQUATIONS_FINISHED)
THEN 1051 time_dependence_type=interface_equations%TIME_DEPENDENCE
1053 CALL flagerror(
"Interface equations has not been finished.",err,error,*999)
1056 CALL flagerror(
"Interface equations is not associated.",err,error,*999)
1059 exits(
"InterfaceEquations_TimeDependenceTypeGet")
1061 999 errorsexits(
"InterfaceEquations_TimeDependenceTypeGet",err,error)
1064 END SUBROUTINE interfaceequations_timedependencetypeget
1071 SUBROUTINE interfaceequationstimedependencetypeset(INTERFACE_EQUATIONS,TIME_DEPENDENCE_TYPE,ERR,ERROR,*)
1075 INTEGER(INTG),
INTENT(IN) :: TIME_DEPENDENCE_TYPE
1076 INTEGER(INTG),
INTENT(OUT) :: ERR
1081 enters(
"InterfaceEquationsTimeDependenceTypeSet",err,error,*999)
1083 IF(
ASSOCIATED(interface_equations))
THEN 1084 IF(interface_equations%INTERFACE_EQUATIONS_FINISHED)
THEN 1085 CALL flagerror(
"Interface equations has already been finished.",err,error,*999)
1087 SELECT CASE(time_dependence_type)
1097 local_error=
"The specified time dependence type of "//
trim(
number_to_vstring(time_dependence_type,
"*",err,error))// &
1099 CALL flagerror(local_error,err,error,*999)
1103 CALL flagerror(
"Interface equations is not associated.",err,error,*999)
1106 exits(
"InterfaceEquationsTimeDependenceTypeSet")
1108 999 errorsexits(
"InterfaceEquationsTimeDependenceTypeSet",err,error)
1111 END SUBROUTINE interfaceequationstimedependencetypeset
1117 SUBROUTINE interfaceequations_variableinterpsetsnumberset(INTERFACE_EQUATIONS,VARIABLE_INDEX, &
1118 & number_of_geometric_sets,number_of_dependent_sets,number_of_penalty_sets,err,error,*)
1122 INTEGER(INTG),
INTENT(IN) :: VARIABLE_INDEX
1123 INTEGER(INTG),
INTENT(IN) :: NUMBER_OF_GEOMETRIC_SETS
1124 INTEGER(INTG),
INTENT(IN) :: NUMBER_OF_DEPENDENT_SETS
1125 INTEGER(INTG),
INTENT(IN) :: NUMBER_OF_PENALTY_SETS
1126 INTEGER(INTG),
INTENT(OUT) :: ERR
1133 enters(
"InterfaceEquations_VariableInterpSetsNumberSet",err,error,*999)
1135 IF(
ASSOCIATED(interface_equations))
THEN 1136 IF(interface_equations%INTERFACE_EQUATIONS_FINISHED)
THEN 1137 CALL flagerror(
"Interface equations have already been finished.",err,error,*999)
1139 IF(
ASSOCIATED(interface_equations%INTERPOLATION))
THEN 1140 IF(
ALLOCATED(interface_equations%INTERPOLATION%VARIABLE_INTERPOLATION))
THEN 1141 interface_condition=>interface_equations%INTERFACE_CONDITION
1142 IF(
ASSOCIATED(interface_condition))
THEN 1143 interface_dependent=>interface_condition%DEPENDENT
1144 IF(
ASSOCIATED(interface_dependent))
THEN 1145 IF(variable_index>0.AND.variable_index<=interface_dependent%NUMBER_OF_DEPENDENT_VARIABLES)
THEN 1146 IF(number_of_geometric_sets>0)
THEN 1147 IF(number_of_dependent_sets>0)
THEN 1148 interface_equations%INTERPOLATION%VARIABLE_INTERPOLATION(variable_index)% &
1149 & number_of_geometric_interpolation_sets=number_of_geometric_sets
1150 interface_equations%INTERPOLATION%VARIABLE_INTERPOLATION(variable_index)% &
1151 & number_of_dependent_interpolation_sets=number_of_dependent_sets
1152 interface_equations%INTERPOLATION%VARIABLE_INTERPOLATION(variable_index)% &
1153 & number_of_penalty_interpolation_sets=number_of_penalty_sets
1155 local_error=
"The specified number of dependent sets of "// &
1157 &
" is invalid. The number of dependent sets must be > 0." 1158 CALL flagerror(local_error,err,error,*999)
1161 local_error=
"The specified number of geometric sets of "// &
1163 &
" is invalid. The number of geometric sets must be > 0." 1164 CALL flagerror(local_error,err,error,*999)
1167 local_error=
"The specified variable index of "//
trim(
number_to_vstring(variable_index,
"*",err,error))// &
1168 &
" is invalid. The index needs to be > 0 and <= "// &
1170 CALL flagerror(local_error,err,error,*999)
1173 CALL flagerror(
"Interface condition dependent is not associated.",err,error,*999)
1176 CALL flagerror(
"Interface equations interface condition is not associated.",err,error,*999)
1179 CALL flagerror(
"Interface equations interpolation variable interpolation is not allocated.",err,error,*999)
1182 CALL flagerror(
"Interface equations interpolation is not associated.",err,error,*999)
1186 CALL flagerror(
"Interface equations is not associated.",err,error,*999)
1189 exits(
"InterfaceEquations_VariableInterpSetsNumberSet")
1191 999
errors(
"InterfaceEquations_VariableInterpSetsNumberSet",err,error)
1192 exits(
"InterfaceEquations_VariableInterpSetsNumberSet")
1195 END SUBROUTINE interfaceequations_variableinterpsetsnumberset
1202 SUBROUTINE interface_condition_equations_get(INTERFACE_CONDITION,INTERFACE_EQUATIONS,ERR,ERROR,*)
1207 INTEGER(INTG),
INTENT(OUT) :: ERR
1211 enters(
"INTERFACE_CONDITION_EQUATIONS_GET",err,error,*999)
1213 IF(
ASSOCIATED(interface_condition))
THEN 1214 IF(interface_condition%INTERFACE_CONDITION_FINISHED)
THEN 1215 IF(
ASSOCIATED(interface_equations))
THEN 1216 CALL flagerror(
"Interface equations is already associated.",err,error,*999)
1218 interface_equations=>interface_condition%INTERFACE_EQUATIONS
1219 IF(.NOT.
ASSOCIATED(interface_equations)) &
1220 &
CALL flagerror(
"Interface equations set equations is not associated.",err,error,*999)
1223 CALL flagerror(
"Interface equations set has not been finished.",err,error,*999)
1226 CALL flagerror(
"Interface equations set is not associated.",err,error,*999)
1229 exits(
"INTERFACE_CONDITION_EQUATIONS_GET")
1231 999 errorsexits(
"INTERFACE_CONDITION_EQUATIONS_GET",err,error)
1234 END SUBROUTINE interface_condition_equations_get
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Contains information on the interpolation for the interface equations.
Converts a number to its equivalent varying string representation.
integer(intg), parameter interface_condition_lagrange_multipliers_method
Lagrange multipliers interface condition method.
This module handles all equations routines.
integer(intg), parameter interface_condition_linear
The interface conditions are linear.
This module contains all string manipulation and transformation routines.
Contains information for the interface condition data.
Contains information for a field defined on a region.
integer(intg), parameter, public interface_equations_full_matrices
Use fully populated matrices for the interface equations.
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
integer(intg), parameter interface_condition_augmented_lagrange_method
Augmented Lagrange multiplers interface condition method.
This module contains all interface mapping routines.
integer(intg), parameter, public interface_equations_sparse_matrices
Use sparse matrices for the interface equations.
Contains information about the dependent field information for an interface condition.
integer(intg), parameter, public interface_equations_timing_output
Timing information output.
subroutine, public exits(NAME)
Records the exit out of the named procedure.
integer(intg), parameter interface_condition_quasistatic
The interface conditions are quasi-static.
This module contains all type definitions in order to avoid cyclic module references.
Contains information about the interpolation for a parameter set in interface equations.
integer(intg), parameter, public interface_equations_element_matrix_output
All below and element matrices output .
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
integer(intg), parameter interface_condition_penalty_method
Penalty interface condition method.
integer(intg), parameter interface_condition_first_order_dynamic
The interface conditions are first order dynamic.
Contains information about the interpolation for a domain (interface or coupled mesh) in the interfac...
This module defines all constants shared across interface condition routines.
integer(intg), parameter interface_condition_point_to_point_method
Point to point interface condition method.
This module handles all interface equations routines.
integer(intg), parameter, public interface_equations_no_output
No output.
Contains information for a field variable defined on a field.
integer(intg), parameter interface_condition_nonlinear_bcs
The interface conditions have non-linear boundary conditions.
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
integer(intg), parameter interface_condition_second_order_dynamic
The interface conditions are a second order dynamic.
integer(intg), parameter interface_condition_nonlinear
The interface conditions are non-linear.
Flags an error condition.
integer(intg), parameter, public interface_equations_matrix_output
All below and equation matrices output.
This module contains all kind definitions.
integer(intg), parameter interface_condition_static
The interface conditions are static and have no time dependence.
Contains information about the interface equations for an interface condition.