OpenCMISS-Iron Internal API Documentation
interface_routines.f90
Go to the documentation of this file.
1 
43 
45 MODULE interface_routines
46 
47  USE base_routines
48  USE data_point_routines
50  USE field_routines
51  USE generated_mesh_routines
52  USE input_output
53  USE interface_conditions_routines
55  USE kinds
56  USE lists
57  USE mesh_routines
58  USE node_routines
59  USE strings
60  USE types
61 
62 #include "macros.h"
63 
64  IMPLICIT NONE
65 
66  PRIVATE
67 
68  !Module parameters
69 
70  !Module types
71 
72  !Module variables
73 
74  !Interfaces
75 
76  INTERFACE interface_label_get
77  MODULE PROCEDURE interface_label_get_c
78  MODULE PROCEDURE interface_label_get_vs
79  END INTERFACE !INTERFACE_LABEL_GET
80 
81  INTERFACE interface_label_set
82  MODULE PROCEDURE interface_label_set_c
83  MODULE PROCEDURE interface_label_set_vs
84  END INTERFACE !INTERFACE_LABEL_SET
85 
86  PUBLIC interface_mesh_add
87 
88  PUBLIC interface_create_start, interface_create_finish
89 
90  PUBLIC interface_coordinate_system_set,interface_coordinate_system_get
91 
92  PUBLIC interface_data_points_get
93 
94  PUBLIC interface_destroy, interface_mesh_connectivity_destroy, interfacepointsconnectivity_destroy
95 
96  PUBLIC interface_label_get,interface_label_set
97 
98  PUBLIC interface_nodes_get
99 
100  PUBLIC interface_mesh_connectivity_create_start, interface_mesh_connectivity_create_finish
101 
102  PUBLIC interface_user_number_find
103 
104  PUBLIC interfaces_finalise,interfaces_initialise
105 
106  PUBLIC interface_mesh_connectivity_element_xi_set,interfacemeshconnectivity_elementnumberset
107 
108  PUBLIC interface_mesh_connectivity_node_number_set
109 
110  PUBLIC interface_mesh_connectivity_basis_set
111 
112  PUBLIC interfacepointsconnectivity_createstart,interfacepointsconnectivity_createfinish
113 
114  PUBLIC interfacepointsconnectivity_datareprojection
115 
116  PUBLIC interfacepointsconnectivity_elementnumberget,interfacepointsconnectivity_elementnumberset
117 
118  PUBLIC interfacepointsconnectivity_pointxiget,interfacepointsconnectivity_pointxiset
119 
120  PUBLIC interfacepointsconnectivity_updatefromprojection
121 
122 CONTAINS
123 
124  !
125  !================================================================================================================================
126  !
127 
128  SUBROUTINE interface_mesh_add(INTERFACE,MESH,MESH_INDEX,ERR,ERROR,*)
129 
130  !Argument variables
131  TYPE(interface_type), POINTER :: interface
132  TYPE(mesh_type), POINTER :: mesh
133  INTEGER(INTG), INTENT(OUT) :: mesh_index
134  INTEGER(INTG), INTENT(OUT) :: err
135  TYPE(varying_string), INTENT(OUT) :: error
136  !Local Variables
137  INTEGER(INTG) :: mesh_idx
138  LOGICAL :: mesh_already_coupled
139  TYPE(mesh_type), POINTER :: coupled_mesh
140  TYPE(mesh_ptr_type), POINTER :: new_coupled_meshes(:)
141  TYPE(region_type), POINTER :: coupled_mesh_region,mesh_region
142  TYPE(varying_string) :: local_error
143 
144  NULLIFY(new_coupled_meshes)
145 
146  enters("INTERFACE_MESH_ADD",err,error,*999)
147 
148  IF(ASSOCIATED(interface)) THEN
149  IF(interface%INTERFACE_FINISHED) THEN
150  CALL flagerror("Interface has already been finished.",err,error,*999)
151  ELSE
152  IF(ASSOCIATED(mesh)) THEN
153  IF(mesh%MESH_FINISHED) THEN
154  mesh_region=>mesh%REGION
155  IF(ASSOCIATED(mesh_region)) THEN
156  ALLOCATE(new_coupled_meshes(interface%NUMBER_OF_COUPLED_MESHES+1),stat=err)
157  IF(err/=0) CALL flagerror("Could not allocate new coupled meshes.",err,error,*999)
158  !Check that the mesh is not already in the list of meshes for the interface.
159  IF(interface%NUMBER_OF_COUPLED_MESHES>0) THEN
160  IF(ASSOCIATED(interface%COUPLED_MESHES)) THEN
161  mesh_already_coupled=.false.
162  DO mesh_idx=1,interface%NUMBER_OF_COUPLED_MESHES
163  coupled_mesh=>interface%COUPLED_MESHES(mesh_idx)%PTR
164  IF(ASSOCIATED(coupled_mesh)) THEN
165  coupled_mesh_region=>coupled_mesh%REGION
166  IF(ASSOCIATED(coupled_mesh_region)) THEN
167  IF(mesh_region%USER_NUMBER==coupled_mesh_region%USER_NUMBER) THEN
168  IF(mesh%USER_NUMBER==coupled_mesh%USER_NUMBER) THEN
169  mesh_already_coupled=.true.
170  EXIT
171  ENDIF
172  ENDIF
173  ELSE
174  local_error="Coupled interface mesh region for mesh index "// &
175  & trim(number_to_vstring(mesh_idx,"*",err,error))//" is not associated."
176  CALL flagerror(local_error,err,error,*999)
177  ENDIF
178  ELSE
179  local_error="Coupled interface mesh for mesh index "//trim(number_to_vstring(mesh_idx,"*",err,error))// &
180  & " is not associated."
181  CALL flagerror(local_error,err,error,*999)
182  ENDIF
183  new_coupled_meshes(mesh_idx)%PTR=>interface%COUPLED_MESHES(mesh_idx)%PTR
184  ENDDO !mesh_idx
185  IF(mesh_already_coupled) THEN
186  local_error="The supplied mesh has already been added to the list of coupled meshes at mesh index "// &
187  & trim(number_to_vstring(mesh_idx,"*",err,error))//"."
188  CALL flagerror(local_error,err,error,*999)
189  ENDIF
190  DEALLOCATE(interface%COUPLED_MESHES)
191  ELSE
192  CALL flagerror("Interface coupled meshes is not associated.",err,error,*999)
193  ENDIF
194  ENDIF
195  !Add the mesh to the list of coupled meshes
196  new_coupled_meshes(interface%NUMBER_OF_COUPLED_MESHES+1)%PTR=>mesh
197  interface%COUPLED_MESHES=>new_coupled_meshes
198  !Increment the number of coupled meshes and return the index
199  interface%NUMBER_OF_COUPLED_MESHES=interface%NUMBER_OF_COUPLED_MESHES+1
200  mesh_index=interface%NUMBER_OF_COUPLED_MESHES
201  ELSE
202  CALL flagerror("Mesh region is not associated.",err,error,*999)
203  ENDIF
204  ELSE
205  CALL flagerror("Mesh has not been finished.",err,error,*999)
206  ENDIF
207  ELSE
208  CALL flagerror("Mesh is not associated.",err,error,*999)
209  ENDIF
210  ENDIF
211  ELSE
212  CALL flagerror("Interface is not associated.",err,error,*999)
213  ENDIF
214 
215  exits("INTERFACE_MESH_ADD")
216  RETURN
217 999 IF(ASSOCIATED(new_coupled_meshes)) DEALLOCATE(new_coupled_meshes)
218  errorsexits("INTERFACE_MESH_ADD",err,error)
219  RETURN 1
220 
221  END SUBROUTINE interface_mesh_add
222 
223  !
224  !================================================================================================================================
225  !
226 
228  SUBROUTINE interface_create_finish(INTERFACE,ERR,ERROR,*)
229 
230  !Argument variables
231  TYPE(interface_type), POINTER :: interface
232  INTEGER(INTG), INTENT(OUT) :: err
233  TYPE(varying_string), INTENT(OUT) :: error
234  !Local Variables
235  TYPE(varying_string) :: local_error
236 
237  enters("INTERFACE_CREATE_FINISH",err,error,*999)
238 
239  IF(ASSOCIATED(interface)) THEN
240  IF(interface%INTERFACE_FINISHED) THEN
241  CALL flagerror("Interface has already been finished.",err,error,*999)
242  ELSE
243  IF(interface%NUMBER_OF_COUPLED_MESHES<2) THEN
244  local_error="Invalid mesh coupling. Only "//trim(number_to_vstring(interface%NUMBER_OF_COUPLED_MESHES,"*",err,error))// &
245  & " have been coupled. The number of coupled meshes must be >= 2."
246  CALL flagerror(local_error,err,error,*999)
247  ENDIF
248  interface%INTERFACE_FINISHED=.true.
249  ENDIF
250  ELSE
251  CALL flagerror("Interface is not associated.",err,error,*999)
252  ENDIF
253 
254  IF(diagnostics1) THEN
255  CALL write_string(diagnostic_output_type,"Interface :",err,error,*999)
256  CALL write_string_value(diagnostic_output_type," User number = ",interface%USER_NUMBER,err,error,*999)
257  CALL write_string_value(diagnostic_output_type," Global number = ",interface%GLOBAL_NUMBER,err,error,*999)
258  CALL write_string_value(diagnostic_output_type," Label = ",interface%LABEL,err,error,*999)
259  IF(ASSOCIATED(interface%INTERFACES)) THEN
260  IF(ASSOCIATED(interface%INTERFACES%PARENT_REGION)) THEN
261  CALL write_string_value(diagnostic_output_type," Parent region user number = ",interface%INTERFACES% &
262  & parent_region%USER_NUMBER,err,error,*999)
263  CALL write_string_value(diagnostic_output_type," Parent region label = ",interface%INTERFACES% &
264  & parent_region%LABEL,err,error,*999)
265  ELSE
266  CALL flagerror("Interfaces parent region is not associated.",err,error,*999)
267  ENDIF
268  ELSE
269  CALL flagerror("Interface interfaces is not associated.",err,error,*999)
270  ENDIF
271  ENDIF
272 
273  exits("INTERFACE_CREATE_FINISH")
274  RETURN
275 999 errorsexits("INTERFACE_CREATE_FINISH",err,error)
276  RETURN 1
277  END SUBROUTINE interface_create_finish
278 
279  !
280  !================================================================================================================================
281  !
282 
284  SUBROUTINE interface_create_start(USER_NUMBER,PARENT_REGION,INTERFACE,ERR,ERROR,*)
285 
286  !Argument variables
287  INTEGER(INTG), INTENT(IN) :: user_number
288  TYPE(region_type), POINTER :: parent_region
289  TYPE(interface_type), POINTER :: interface
290  INTEGER(INTG), INTENT(OUT) :: err
291  TYPE(varying_string), INTENT(OUT) :: error
292  !Local Variables
293  INTEGER(INTG) :: interface_idx
294  TYPE(interface_type), POINTER :: new_interface
295  TYPE(interface_ptr_type), POINTER :: new_interfaces(:)
296  TYPE(varying_string) :: local_error,local_string
297 
298  NULLIFY(new_interface)
299  NULLIFY(new_interfaces)
300 
301  enters("INTERFACE_CREATE_START",err,error,*998)
302 
303  IF(ASSOCIATED(parent_region)) THEN
304  IF(ASSOCIATED(interface)) THEN
305  CALL flagerror("Interface is already associated.",err,error,*998)
306  ELSE
307  NULLIFY(interface)
308  CALL interface_user_number_find(user_number,parent_region,interface,err,error,*998)
309  IF(ASSOCIATED(interface)) THEN
310  local_error="Interface number "//trim(number_to_vstring(user_number,"*",err,error))// &
311  & " has already been created on region number "//trim(number_to_vstring(parent_region%USER_NUMBER,"*",err,error))//"."
312  CALL flagerror(local_error,err,error,*998)
313  ELSE
314  NULLIFY(interface)
315  !Allocate and set default interface properties.
316  CALL interface_initialise(new_interface,err,error,*999)
317  new_interface%USER_NUMBER=user_number
318  new_interface%GLOBAL_NUMBER=parent_region%INTERFACES%NUMBER_OF_INTERFACES+1
319  local_string="Interface_"//number_to_vstring(user_number,"*",err,error)
320  new_interface%LABEL=char(local_string)
321  IF(err/=0) GOTO 999
322  new_interface%INTERFACES=>parent_region%INTERFACES
323  new_interface%PARENT_REGION=>parent_region
324  !Add new initerface into list of interfaces in the parent region
325  ALLOCATE(new_interfaces(parent_region%INTERFACES%NUMBER_OF_INTERFACES+1),stat=err)
326  IF(err/=0) CALL flagerror("Could not allocate new interfaces.",err,error,*999)
327  DO interface_idx=1,parent_region%INTERFACES%NUMBER_OF_INTERFACES
328  new_interfaces(interface_idx)%PTR=>parent_region%INTERFACES%INTERFACES(interface_idx)%PTR
329  ENDDO !interface_idx
330  new_interfaces(parent_region%INTERFACES%NUMBER_OF_INTERFACES+1)%PTR=>new_interface
331  IF(ASSOCIATED(parent_region%INTERFACES%INTERFACES)) DEALLOCATE(parent_region%INTERFACES%INTERFACES)
332  parent_region%INTERFACES%INTERFACES=>new_interfaces
333  parent_region%INTERFACES%NUMBER_OF_INTERFACES=parent_region%INTERFACES%NUMBER_OF_INTERFACES+1
334  interface=>new_interface
335  ENDIF
336  ENDIF
337  ELSE
338  CALL flagerror("Parent region is not associated.",err,error,*998)
339  ENDIF
340 
341  exits("INTERFACE_CREATE_START")
342  RETURN
343 999 IF(ASSOCIATED(new_interfaces)) DEALLOCATE(new_interfaces)
344  CALL interface_finalise(interface,err,error,*998)
345 998 errorsexits("INTERFACE_CREATE_START",err,error)
346  RETURN 1
347  END SUBROUTINE interface_create_start
348 
349  !
350  !================================================================================================================================
351  !
352 
354  SUBROUTINE interface_coordinate_system_get(INTERFACE,COORDINATE_SYSTEM,ERR,ERROR,*)
355 
356  !Argument variables
357  TYPE(interface_type), POINTER :: interface
358  TYPE(coordinate_system_type), POINTER :: coordinate_system
359  INTEGER(INTG), INTENT(OUT) :: err
360  TYPE(varying_string), INTENT(OUT) :: error
361  !Local Variables
362 
363  enters("INTERFACE_COORDINATE_SYSTEM_GET",err,error,*999)
364 
365  IF(ASSOCIATED(interface)) THEN
366  IF(interface%INTERFACE_FINISHED) THEN
367  IF(ASSOCIATED(coordinate_system)) THEN
368  CALL flagerror("Coordinate system is already associated.",err,error,*999)
369  ELSE
370  coordinate_system=>interface%COORDINATE_SYSTEM
371  ENDIF
372  ELSE
373  CALL flagerror("Interface has not been finished.",err,error,*999)
374  ENDIF
375  ELSE
376  CALL flagerror("Interface is not associated.",err,error,*999)
377  ENDIF
378 
379  exits("INTERFACE_COORDINATE_SYSTEM_GET")
380  RETURN
381 999 errorsexits("INTERFACE_COORDINATE_SYSTEM_GET",err,error)
382  RETURN 1
383  END SUBROUTINE interface_coordinate_system_get
384 
385 
386  !
387  !================================================================================================================================
388  !
389 
391  SUBROUTINE interface_coordinate_system_set(INTERFACE,COORDINATE_SYSTEM,ERR,ERROR,*)
392 
393  !Argument variables
394  TYPE(interface_type), POINTER :: interface
395  TYPE(coordinate_system_type), POINTER :: coordinate_system
396  INTEGER(INTG), INTENT(OUT) :: err
397  TYPE(varying_string), INTENT(OUT) :: error
398  !Local Variables
399 
400  enters("INTERFACE_COORDINATE_SYSTEM_SET",err,error,*999)
401 
402  IF(ASSOCIATED(interface)) THEN
403  IF(interface%INTERFACE_FINISHED) THEN
404  CALL flagerror("Interface has been finished.",err,error,*999)
405  ELSE
406  IF(ASSOCIATED(coordinate_system)) THEN
407  IF(coordinate_system%COORDINATE_SYSTEM_FINISHED) THEN
408  interface%COORDINATE_SYSTEM=>coordinate_system
409  ELSE
410  CALL flagerror("Coordinate system has not been finished.",err,error,*999)
411  ENDIF
412  ELSE
413  CALL flagerror("Coordinate system is not associated.",err,error,*999)
414  ENDIF
415  ENDIF
416  ELSE
417  CALL flagerror("Interface is not associated.",err,error,*999)
418  ENDIF
419 
420  exits("INTERFACE_COORDINATE_SYSTEM_SET")
421  RETURN
422 999 errorsexits("INTERFACE_COORDINATE_SYSTEM_SET",err,error)
423  RETURN 1
424  END SUBROUTINE interface_coordinate_system_set
425 
426  !
427  !================================================================================================================================
428  !
429 
431  SUBROUTINE interface_data_points_get(INTERFACE,DATA_POINTS,ERR,ERROR,*)
432 
433  !Argument variables
434  TYPE(interface_type), POINTER :: interface
435  TYPE(data_points_type), POINTER :: data_points
436  INTEGER(INTG), INTENT(OUT) :: err
437  TYPE(varying_string), INTENT(OUT) :: error
438  !Local Variables
439 
440  enters("REGION_DATA_POINTS_GET",err,error,*998)
441 
442  IF(ASSOCIATED(interface)) THEN
443  IF(interface%INTERFACE_FINISHED) THEN
444  IF(ASSOCIATED(data_points)) THEN
445  CALL flagerror("Data points is already associated.",err,error,*998)
446  ELSE
447  data_points=>interface%DATA_POINTS
448  IF(.NOT.ASSOCIATED(data_points)) CALL flagerror("Data points is not associated.",err,error,*999)
449  ENDIF
450  ELSE
451  CALL flagerror("Interface has not been finished.",err,error,*998)
452  ENDIF
453  ELSE
454  CALL flagerror("Interface is not associated.",err,error,*998)
455  ENDIF
456 
457  exits("INTERFACE_DATA_POINTS_GET")
458  RETURN
459 999 NULLIFY(data_points)
460 998 errorsexits("INTERFACE_DATA_POINTS_GET",err,error)
461  RETURN 1
462 
463  END SUBROUTINE interface_data_points_get
464 
465  !
466  !================================================================================================================================
467  !
468 
470  SUBROUTINE interface_destroy(INTERFACE,ERR,ERROR,*)
471 
472  !Argument variables
473  TYPE(interface_type), POINTER :: interface
474  INTEGER(INTG), INTENT(OUT) :: err
475  TYPE(varying_string), INTENT(OUT) :: error
476  !Local Variables
477  INTEGER(INTG) :: interface_idx,interface_position
478  TYPE(interface_ptr_type), POINTER :: new_interfaces(:)
479  TYPE(interfaces_type), POINTER :: interfaces
480 
481  NULLIFY(new_interfaces)
482 
483  enters("INTERFACE_DESTROY",err,error,*999)
484 
485  IF(ASSOCIATED(interface)) THEN
486  interfaces=>interface%INTERFACES
487  IF(ASSOCIATED(interfaces)) THEN
488  interface_position=interface%GLOBAL_NUMBER
489 
490  !Destroy all the interface condition components
491  CALL interface_finalise(interface,err,error,*999)
492 
493  !Remove the interface from the list of interfaces
494  IF(interfaces%NUMBER_OF_INTERFACES>1) THEN
495  ALLOCATE(new_interfaces(interfaces%NUMBER_OF_INTERFACES-1),stat=err)
496  IF(err/=0) CALL flagerror("Could not allocate new interface conditions.",err,error,*999)
497  DO interface_idx=1,interfaces%NUMBER_OF_INTERFACES
498  IF(interface_idx<interface_position) THEN
499  new_interfaces(interface_idx)%PTR=>interfaces%INTERFACES(interface_idx)%PTR
500  ELSE IF(interface_idx>interface_position) THEN
501  interfaces%INTERFACES(interface_idx)%PTR%GLOBAL_NUMBER=interfaces%INTERFACES(interface_idx)%PTR%GLOBAL_NUMBER-1
502  new_interfaces(interface_idx-1)%PTR=>interfaces%INTERFACES(interface_idx)%PTR
503  ENDIF
504  ENDDO !interface_idx
505  IF(ASSOCIATED(interfaces%INTERFACES)) DEALLOCATE(interfaces%INTERFACES)
506  interfaces%INTERFACES=>new_interfaces
507  interfaces%NUMBER_OF_INTERFACES=interfaces%NUMBER_OF_INTERFACES-1
508  ELSE
509  DEALLOCATE(interfaces%INTERFACES)
510  interfaces%NUMBER_OF_INTERFACES=0
511  ENDIF
512 
513  ELSE
514  CALL flagerror("Interface interfaces is not associated.",err,error,*999)
515  ENDIF
516  ELSE
517  CALL flagerror("Interface is not associated.",err,error,*999)
518  ENDIF
519 
520  exits("INTERFACE_DESTROY")
521  RETURN
522 999 errorsexits("INTERFACE_DESTROY",err,error)
523  RETURN 1
524  END SUBROUTINE interface_destroy
525 
526  !
527  !================================================================================================================================
528  !
529 
531  SUBROUTINE interface_finalise(INTERFACE,ERR,ERROR,*)
532 
533  !Argument variables
534  TYPE(interface_type), POINTER :: interface
535  INTEGER(INTG), INTENT(OUT) :: err
536  TYPE(varying_string), INTENT(OUT) :: error
537  !Local Variables
538 
539  enters("INTERFACE_FINALISE",err,error,*999)
540 
541  IF(ASSOCIATED(interface)) THEN
542  IF(ASSOCIATED(interface%COUPLED_MESHES)) DEALLOCATE(interface%COUPLED_MESHES)
543  IF(ASSOCIATED(interface%MESH_CONNECTIVITY)) &
544  & CALL interface_mesh_connectivity_finalise(interface%MESH_CONNECTIVITY,err,error,*999)
545  IF(ASSOCIATED(interface%pointsConnectivity)) &
546  & CALL interfacepointsconnectivity_finalise(interface%pointsConnectivity,err,error,*999)
547  IF(ASSOCIATED(interface%NODES)) CALL nodes_destroy(interface%NODES,err,error,*999)
548  CALL meshes_finalise(interface%MESHES,err,error,*999)
549  CALL fields_finalise(interface%FIELDS,err,error,*999)
550  CALL interface_conditions_finalise(interface%INTERFACE_CONDITIONS,err,error,*999)
551  DEALLOCATE(interface)
552  ENDIF
553 
554  exits("INTERFACE_FINALISE")
555  RETURN
556 999 errorsexits("INTERFACE_FINALISE",err,error)
557  RETURN 1
558  END SUBROUTINE interface_finalise
559 
560  !
561  !================================================================================================================================
562  !
563 
565  SUBROUTINE interface_initialise(INTERFACE,ERR,ERROR,*)
566 
567  !Argument variables
568  TYPE(interface_type), POINTER :: interface
569  INTEGER(INTG), INTENT(OUT) :: err
570  TYPE(varying_string), INTENT(OUT) :: error
571  !Local Variables
572 
573  enters("INTERFACE_INITIALISE",err,error,*999)
574 
575  IF(ASSOCIATED(interface)) THEN
576  CALL flagerror("Interface is already associated.",err,error,*999)
577  ELSE
578  ALLOCATE(interface,stat=err)
579  IF(err/=0) CALL flagerror("Could not allocate interface.",err,error,*999)
580  interface%USER_NUMBER=0
581  interface%GLOBAL_NUMBER=0
582  interface%INTERFACE_FINISHED=.false.
583  interface%LABEL=""
584  NULLIFY(interface%INTERFACES)
585  NULLIFY(interface%PARENT_REGION)
586  interface%NUMBER_OF_COUPLED_MESHES=0
587  NULLIFY(interface%COUPLED_MESHES)
588  NULLIFY(interface%MESH_CONNECTIVITY)
589  NULLIFY(interface%pointsConnectivity)
590  NULLIFY(interface%NODES)
591  NULLIFY(interface%MESHES)
592  NULLIFY(interface%GENERATED_MESHES)
593  NULLIFY(interface%FIELDS)
594  NULLIFY(interface%INTERFACE_CONDITIONS)
595  NULLIFY(interface%COORDINATE_SYSTEM)
596  NULLIFY(interface%DATA_POINTS)
597  CALL meshes_initialise(interface,err,error,*999)
598  CALL generated_meshes_initialise(interface,err,error,*999)
599  CALL fields_initialise(interface,err,error,*999)
600  CALL interface_conditions_initialise(interface,err,error,*999)
601  ENDIF
602 
603  exits("INTERFACE_INITIALISE")
604  RETURN
605 999 errorsexits("INTERFACE_INITIALISE",err,error)
606  RETURN 1
607  END SUBROUTINE interface_initialise
608 
609  !
610  !================================================================================================================================
611  !
612 
614  SUBROUTINE interface_label_get_c(INTERFACE,LABEL,ERR,ERROR,*)
615 
616  !Argument variables
617  TYPE(interface_type), POINTER :: interface
618  CHARACTER(LEN=*), INTENT(OUT) :: label
619  INTEGER(INTG), INTENT(OUT) :: err
620  TYPE(varying_string), INTENT(OUT) :: error
621  !Local Variables
622  INTEGER(INTG) :: c_length,vs_length
623 
624  enters("INTERFACE_LABEL_GET_C",err,error,*999)
625 
626  IF(ASSOCIATED(interface)) THEN
627  c_length=len(label)
628  vs_length=len_trim(interface%LABEL)
629  IF(c_length>vs_length) THEN
630  label=char(interface%LABEL,vs_length)
631  ELSE
632  label=char(interface%LABEL,c_length)
633  ENDIF
634  ELSE
635  CALL flagerror("Interface is not associated.",err,error,*999)
636  ENDIF
637 
638  exits("INTERFACE_LABEL_GET_C")
639  RETURN
640 999 errorsexits("INTERFACE_LABEL_GET_C",err,error)
641  RETURN 1
642 
643  END SUBROUTINE interface_label_get_c
644 
645  !
646  !================================================================================================================================
647  !
648 
650  SUBROUTINE interface_label_get_vs(INTERFACE,LABEL,ERR,ERROR,*)
651 
652  !Argument variables
653  TYPE(interface_type), POINTER :: interface
654  TYPE(varying_string), INTENT(OUT) :: label
655  INTEGER(INTG), INTENT(OUT) :: err
656  TYPE(varying_string), INTENT(OUT) :: error
657  !Local Variables
658 
659  enters("INTERFACE_LABEL_GET_VS",err,error,*999)
660 
661  IF(ASSOCIATED(interface)) THEN
662  !\todo The following line crashes the AIX compiler unless it has a VAR_STR(CHAR()) around it
663  label=var_str(char(interface%LABEL))
664  ELSE
665  CALL flagerror("Interface is not associated.",err,error,*999)
666  ENDIF
667 
668  exits("INTERFACE_LABEL_GET_VS")
669  RETURN
670 999 errorsexits("INTERFACE_LABEL_GET_VS",err,error)
671  RETURN 1
672 
673  END SUBROUTINE interface_label_get_vs
674 
675  !
676  !================================================================================================================================
677  !
678 
680  SUBROUTINE interface_label_set_c(INTERFACE,LABEL,ERR,ERROR,*)
681 
682  !Argument variables
683  TYPE(interface_type), POINTER :: interface
684  CHARACTER(LEN=*), INTENT(IN) :: label
685  INTEGER(INTG), INTENT(OUT) :: err
686  TYPE(varying_string), INTENT(OUT) :: error
687  !Local Variables
688 
689  enters("INTERFACE_LABEL_SET_C",err,error,*999)
690 
691  IF(ASSOCIATED(interface)) THEN
692  IF(interface%INTERFACE_FINISHED) THEN
693  CALL flagerror("Interface has been finished.",err,error,*999)
694  ELSE
695  interface%LABEL=label
696  ENDIF
697  ELSE
698  CALL flagerror("Interface is not associated.",err,error,*999)
699  ENDIF
700 
701  exits("INTERFACE_LABEL_SET_C")
702  RETURN
703 999 errorsexits("INTERFACE_LABEL_SET_C",err,error)
704  RETURN 1
705  END SUBROUTINE interface_label_set_c
706 
707  !
708  !================================================================================================================================
709  !
710 
712  SUBROUTINE interface_label_set_vs(INTERFACE,LABEL,ERR,ERROR,*)
713 
714  !Argument variables
715  TYPE(interface_type), POINTER :: interface
716  TYPE(varying_string), INTENT(IN) :: label
717  INTEGER(INTG), INTENT(OUT) :: err
718  TYPE(varying_string), INTENT(OUT) :: error
719  !Local Variables
720 
721  enters("INTERFACE_LABEL_SET_VS",err,error,*999)
722 
723  IF(ASSOCIATED(interface)) THEN
724  IF(interface%INTERFACE_FINISHED) THEN
725  CALL flagerror("Interface has been finished.",err,error,*999)
726  ELSE
727  interface%LABEL=label
728  ENDIF
729  ELSE
730  CALL flagerror("Interface is not associated.",err,error,*999)
731  ENDIF
732 
733  exits("INTERFACE_LABEL_SET_VS")
734  RETURN
735 999 errorsexits("INTERFACE_LABEL_SET_VS",err,error)
736  RETURN 1
737  END SUBROUTINE interface_label_set_vs
738 
739  !
740  !================================================================================================================================
741  !
742 
744  SUBROUTINE interface_nodes_get(INTERFACE,NODES,ERR,ERROR,*)
745 
746  !Argument variables
747  TYPE(interface_type), POINTER :: interface
748  TYPE(nodes_type), POINTER :: nodes
749  INTEGER(INTG), INTENT(OUT) :: err
750  TYPE(varying_string), INTENT(OUT) :: error
751  !Local Variables
752 
753  enters("INTERFACE_NODES_GET",err,error,*998)
754 
755  IF(ASSOCIATED(interface)) THEN
756  IF(interface%INTERFACE_FINISHED) THEN
757  IF(ASSOCIATED(nodes)) THEN
758  CALL flagerror("Nodes is already associated.",err,error,*998)
759  ELSE
760  nodes=>interface%NODES
761  IF(.NOT.ASSOCIATED(nodes)) CALL flagerror("Nodes is not associated.",err,error,*999)
762  ENDIF
763  ELSE
764  CALL flagerror("Interface has not been finished.",err,error,*998)
765  ENDIF
766  ELSE
767  CALL flagerror("Interface is not associated.",err,error,*998)
768  ENDIF
769 
770  exits("INTERFACE_NODES_GET")
771  RETURN
772 999 NULLIFY(nodes)
773 998 errorsexits("INTERFACE_NODES_GET",err,error)
774  RETURN 1
775 
776  END SUBROUTINE interface_nodes_get
777 
778  !
779  !================================================================================================================================
780  !
781 
783  SUBROUTINE interface_mesh_connectivity_create_finish(INTERFACE_MESH_CONNECTIVITY,ERR,ERROR,*)
784 
785  !Argument variables
786  TYPE(interface_mesh_connectivity_type), POINTER :: interface_mesh_connectivity
787  INTEGER(INTG), INTENT(OUT) :: err
788  TYPE(varying_string), INTENT(OUT) :: error
789  !Local Variables
790  INTEGER(INTG) :: interfaceelementidx,coupledmeshidx
791  TYPE(varying_string) :: local_error
792 
793  enters("INTERFACE_MESH_CONNECTIVITY_CREATE_FINISH",err,error,*999)
794 
795  IF(ASSOCIATED(interface_mesh_connectivity)) THEN
796  IF(interface_mesh_connectivity%MESH_CONNECTIVITY_FINISHED) THEN
797  CALL flagerror("Interface meshes connectivity has already been finished.",err,error,*999)
798  ELSE
799  !Check if connectivity from each interface element to an appropriate element in the coupled meshes has been setup
800  DO interfaceelementidx=1,interface_mesh_connectivity%NUMBER_OF_INTERFACE_ELEMENTS
801  DO coupledmeshidx=1,interface_mesh_connectivity%NUMBER_OF_COUPLED_MESHES
802  IF (interface_mesh_connectivity%ELEMENT_CONNECTIVITY(interfaceelementidx,coupledmeshidx)% &
803  & coupled_mesh_element_number==0) THEN
804  local_error="The connectivity from interface element " &
805  //trim(number_to_vstring(interfaceelementidx,"*",err,error))//" to an element in coupled mesh " &
806  //trim(number_to_vstring(coupledmeshidx,"*",err,error))//" has not been defined."
807  CALL flagerror(local_error,err,error,*999)
808  ENDIF
809  ENDDO !CoupledMeshIdx
810  ENDDO !InterfaceElementIdx
811  !Calculate line or face numbers for coupled mesh elements that are connected to the interface mesh
812  CALL interfacemeshconnectivity_connectedlinescalculate(interface_mesh_connectivity,err,error,*999)
813  interface_mesh_connectivity%MESH_CONNECTIVITY_FINISHED=.true.
814  ENDIF
815  ELSE
816  CALL flagerror("Interface meshes connectivity is not associated.",err,error,*999)
817  ENDIF
818 
819  exits("INTERFACE_MESH_CONNECTIVITY_CREATE_FINISH")
820  RETURN
821 999 errorsexits("INTERFACE_MESH_CONNECTIVITY_CREATE_FINISH",err,error)
822  RETURN 1
823  END SUBROUTINE interface_mesh_connectivity_create_finish
824 
825  !
826  !================================================================================================================================
827  !
828 
830  SUBROUTINE interface_mesh_connectivity_create_start(INTERFACE,MESH,INTERFACE_MESH_CONNECTIVITY,ERR,ERROR,*)
831 
832  !Argument variables
833  TYPE(interface_type), POINTER :: interface
834  TYPE(mesh_type), POINTER :: mesh
835  TYPE(interface_mesh_connectivity_type), POINTER :: interface_mesh_connectivity
836  INTEGER(INTG), INTENT(OUT) :: err
837  TYPE(varying_string), INTENT(OUT) :: error
838  !Local Variables
839 
840  enters("INTERFACE_MESH_CONNECTIVITY_CREATE_START",err,error,*999)
841 
842  IF(ASSOCIATED(interface)) THEN
843  IF(interface%INTERFACE_FINISHED) THEN
844  IF(ASSOCIATED(interface%MESH_CONNECTIVITY)) THEN
845  CALL flagerror("The interface already has a meshes connectivity associated.",err,error,*999)
846  ELSE
847  !Initialise the meshes connectivity
848  CALL interface_mesh_connectivity_initialise(interface,mesh,err,error,*999)
849  !Return the pointer
850  interface_mesh_connectivity=>interface%MESH_CONNECTIVITY
851  ENDIF
852  ELSE
853  CALL flagerror("Interface has not been finished.",err,error,*999)
854  ENDIF
855  ELSE
856  CALL flagerror("Interface is not associated.",err,error,*999)
857  ENDIF
858 
859  exits("INTERFACE_MESH_CONNECTIVITY_CREATE_START")
860  RETURN
861 999 errorsexits("INTERFACE_MESH_CONNECTIVITY_CREATE_START",err,error)
862  RETURN 1
863 
864  END SUBROUTINE interface_mesh_connectivity_create_start
865 
866  !
867  !================================================================================================================================
868  !
869 
871  SUBROUTINE interface_mesh_connectivity_destroy(INTERFACE_MESH_CONNECTIVITY,ERR,ERROR,*)
872 
873  !Argument variables
874  TYPE(interface_mesh_connectivity_type), POINTER :: interface_mesh_connectivity
875  INTEGER(INTG), INTENT(OUT) :: err
876  TYPE(varying_string), INTENT(OUT) :: error
877  !Local Variables
878 
879  enters("INTERFACE_MESH_CONNECTIVITY_DESTROY",err,error,*999)
880 
881  IF(ASSOCIATED(interface_mesh_connectivity)) THEN
882  CALL interface_mesh_connectivity_finalise(interface_mesh_connectivity,err,error,*999)
883  ELSE
884  CALL flagerror("Interface meshes connectivity is not associated.",err,error,*999)
885  ENDIF
886 
887  exits("INTERFACE_MESH_CONNECTIVITY_DESTROY")
888  RETURN
889 999 errorsexits("INTERFACE_MESH_CONNECTIVITY_DESTROY",err,error)
890  RETURN 1
891  END SUBROUTINE interface_mesh_connectivity_destroy
892 
893  !
894  !================================================================================================================================
895  !
896 
898  SUBROUTINE interface_mesh_connectivity_basis_set(INTERFACE_MESH_CONNECTIVITY,BASIS,ERR,ERROR,*)
899 
900  !Argument variables
901  TYPE(interface_mesh_connectivity_type), POINTER :: interface_mesh_connectivity
902  TYPE(basis_type), POINTER :: basis
903  INTEGER(INTG), INTENT(OUT) :: err
904  TYPE(varying_string), INTENT(OUT) :: error
905  !Local Variables
906  TYPE(interface_element_connectivity_type), POINTER :: element_connectivity
907  INTEGER(INTG) :: interfaceelementidx,coupledmeshidx,numberofinterfaceelementnodes,numberofcoupledmeshxidirections
908 
909  enters("INTERFACE_MESH_CONNECTIVITY_BASIS_SET",err,error,*999)
910 
911  IF(ASSOCIATED(interface_mesh_connectivity)) THEN
912  IF(interface_mesh_connectivity%MESH_CONNECTIVITY_FINISHED) THEN
913  CALL flagerror("Interface mesh connectivity already been finished.",err,error,*999)
914  ELSE
915  IF(ASSOCIATED(interface_mesh_connectivity%BASIS)) THEN
916  CALL flagerror("Mesh connectivity basis already associated.",err,error,*999)
917  ELSE
918  IF(ASSOCIATED(basis)) THEN
919  interface_mesh_connectivity%BASIS=>basis
920  !Now that the mesh connectivity basis is set the number of interface element nodes can be determined and now MESH_CONNECTIVITY%ELEMENT_CONNECTIVITY(InterfaceElementIdx,CoupledMeshIdx)%XI can be allocated
921  !\todo NumberOfCoupledMeshXiDirections currently set to the number of interface mesh xi directions + 1. Restructure ELEMENT_CONNECTIVITY type see below
922  numberofcoupledmeshxidirections=interface_mesh_connectivity%INTERFACE_MESH%NUMBER_OF_DIMENSIONS+1
923  numberofinterfaceelementnodes=interface_mesh_connectivity%BASIS%NUMBER_OF_NODES
924  DO interfaceelementidx=1,interface_mesh_connectivity%NUMBER_OF_INTERFACE_ELEMENTS
925  DO coupledmeshidx=1,interface_mesh_connectivity%NUMBER_OF_COUPLED_MESHES
926  element_connectivity=>interface_mesh_connectivity%ELEMENT_CONNECTIVITY(interfaceelementidx,coupledmeshidx)
927  !\todo Update mesh component index to look at the number of mesh components in each element.
928  !\todo Currently this defaults to the first mesh component ie %XI(NumberOfInterfaceMeshXi,1,NumberOfInterfaceElementNodes)).
929  !\todo The interface mesh types will also need to be restructured.
930  !eg. INTERFACE%MESH_CONNECTIVITY%ELEMENT_CONNECTIVITY(InterfaceElementIdx,CoupledMeshIdx)%MESH_COMPONENT(MeshComponentIdx)%XI(NumberOfCoupledMeshXiDirections,NumberOfInterfaceElementNodes) and adding appropriate initialize/finialize routines
931  ALLOCATE(element_connectivity%XI(numberofcoupledmeshxidirections,1,numberofinterfaceelementnodes),stat=err)
932  IF(err/=0) CALL flagerror("Could not allocate interface element connectivity.",err,error,*999)
933  element_connectivity%XI=0.0_dp
934  ENDDO !CoupledMeshIdx
935  ENDDO !InterfaceElementIdx
936  ELSE
937  CALL flagerror("Basis to set mesh connectivity not associated.",err,error,*999)
938  ENDIF
939  ENDIF
940  ENDIF
941  ELSE
942  CALL flagerror("Interface mesh connectivity is not associated.",err,error,*999)
943  ENDIF
944 
945  exits("INTERFACE_MESH_CONNECTIVITY_BASIS_SET")
946  RETURN
947 999 errorsexits("INTERFACE_MESH_CONNECTIVITY_BASIS_SET",err,error)
948  RETURN 1
949 
950  END SUBROUTINE interface_mesh_connectivity_basis_set
951 
952  !
953  !================================================================================================================================
954  !
955 
957  SUBROUTINE interface_mesh_connectivity_element_xi_set(INTERFACE_MESH_CONNECTIVITY,INTERFACE_MESH_ELEMENT_NUMBER, &
958  & coupled_mesh_index,coupled_mesh_element_number,interface_mesh_local_node_number,interface_mesh_component_number,xi, &
959  & err,error,*)
960 
961  !Argument variables
962  TYPE(interface_mesh_connectivity_type), POINTER :: interface_mesh_connectivity
963  INTEGER(INTG), INTENT(IN) :: interface_mesh_element_number
964  INTEGER(INTG), INTENT(IN) :: coupled_mesh_index
965  INTEGER(INTG), INTENT(IN) :: coupled_mesh_element_number
966  INTEGER(INTG), INTENT(IN) :: interface_mesh_local_node_number
967  INTEGER(INTG), INTENT(IN) :: interface_mesh_component_number
968  REAL(DP), INTENT(IN) :: xi(:)
969  INTEGER(INTG), INTENT(OUT) :: err
970  TYPE(varying_string), INTENT(OUT) :: error
971  !Local Variables
972  INTEGER(INTG) :: coupled_mesh_number_of_xi
973  TYPE(interface_element_connectivity_type), POINTER :: element_connectivity
974 
975  enters("INTERFACE_MESH_CONNECTIVITY_ELEMENT_XI_SET",err,error,*999)
976 
977  IF(ASSOCIATED(interface_mesh_connectivity)) THEN
978  IF(interface_mesh_connectivity%MESH_CONNECTIVITY_FINISHED) THEN
979  CALL flagerror("Interface mesh connectivity already been finished.",err,error,*999)
980  ELSE
981  IF(ALLOCATED(interface_mesh_connectivity%ELEMENT_CONNECTIVITY)) THEN
982  IF((interface_mesh_element_number>0).AND. &
983  & (interface_mesh_element_number<=interface_mesh_connectivity%NUMBER_OF_INTERFACE_ELEMENTS)) THEN
984  IF((coupled_mesh_index>0).AND.(coupled_mesh_index<=interface_mesh_connectivity%NUMBER_OF_COUPLED_MESHES)) THEN
985  IF((coupled_mesh_element_number>0).AND.(coupled_mesh_element_number<= &
986  & interface_mesh_connectivity%INTERFACE%COUPLED_MESHES(coupled_mesh_index)%PTR%NUMBER_OF_ELEMENTS))THEN
987  IF((interface_mesh_component_number>0).AND. &
988  & (interface_mesh_component_number<=interface_mesh_connectivity%INTERFACE_MESH%NUMBER_OF_COMPONENTS)) THEN
989  IF((interface_mesh_local_node_number>0).AND.(interface_mesh_local_node_number<= &
990  & interface_mesh_connectivity%BASIS%NUMBER_OF_NODES))THEN
991  element_connectivity=>interface_mesh_connectivity% &
992  & element_connectivity(interface_mesh_element_number,coupled_mesh_index)
993  IF(element_connectivity%COUPLED_MESH_ELEMENT_NUMBER==coupled_mesh_element_number)THEN
994  coupled_mesh_number_of_xi = interface_mesh_connectivity%INTERFACE%COUPLED_MESHES(coupled_mesh_index)%PTR% &
995  & topology(1)%PTR%ELEMENTS%ELEMENTS(coupled_mesh_element_number)%BASIS%NUMBER_OF_XI
996  IF(SIZE(xi)==coupled_mesh_number_of_xi) THEN
997  !\todo the ELEMENT_CONNECTIVITY%XI array needs to be restructured to efficiently utilize memory when coupling bodies with 2xi directions to bodies with 3xi directions using an interface.
998  element_connectivity%XI(1:coupled_mesh_number_of_xi,interface_mesh_component_number, &
999  & interface_mesh_local_node_number)=xi(1:coupled_mesh_number_of_xi)
1000  ELSE
1001  CALL flagerror("The size of the xi array provided does not match the coupled mesh element's' number"// &
1002  & " of xi.",err,error,*999)
1003  ENDIF
1004  ELSE
1005  CALL flagerror("Coupled mesh element number doesn't match that set to the interface.",err,error,*999)
1006  ENDIF
1007  ELSE
1008  CALL flagerror("Interface local node number is out of range.",err,error,*999)
1009  ENDIF
1010  ELSE
1011  CALL flagerror("Interface component number is out of range.",err,error,*999)
1012  ENDIF
1013  ELSE
1014  CALL flagerror("Coupled mesh element number out of range.",err,error,*999)
1015  ENDIF
1016  ELSE
1017  CALL flagerror("Interface coupled mesh index number out of range.",err,error,*999)
1018  ENDIF
1019  ELSE
1020  CALL flagerror("Interface mesh element number out of range.",err,error,*999)
1021  ENDIF
1022  ELSE
1023  CALL flagerror("Interface elements connectivity array not allocated.",err,error,*999)
1024  ENDIF
1025  ENDIF
1026  ELSE
1027  CALL flagerror("Interface mesh connectivity is not associated.",err,error,*999)
1028  ENDIF
1029 
1030  exits("INTERFACE_MESH_CONNECTIVITY_ELEMENT_XI_SET")
1031  RETURN
1032 999 errorsexits("INTERFACE_MESH_CONNECTIVITY_ELEMENT_XI_SET",err,error)
1033  RETURN 1
1034 
1035  END SUBROUTINE interface_mesh_connectivity_element_xi_set
1036 
1037  !
1038  !================================================================================================================================
1039  !
1040 
1042  SUBROUTINE interfacemeshconnectivity_elementnumberset(INTERFACE_MESH_CONNECTIVITY,INTERFACE_MESH_ELEMENT_NUMBER, &
1043  & coupled_mesh_index,coupled_mesh_element_number,err,error,*)
1044 
1045  !Argument variables
1046  TYPE(interface_mesh_connectivity_type), POINTER :: interface_mesh_connectivity
1047  INTEGER(INTG), INTENT(IN) :: interface_mesh_element_number
1048  INTEGER(INTG), INTENT(IN) :: coupled_mesh_index
1049  INTEGER(INTG), INTENT(IN) :: coupled_mesh_element_number
1050  INTEGER(INTG), INTENT(OUT) :: err
1051  TYPE(varying_string), INTENT(OUT) :: error
1052  !Local Variables
1053  TYPE(interface_element_connectivity_type), POINTER :: element_connectivity
1054 
1055  enters("InterfaceMeshConnectivity_ElementNumberSet",err,error,*999)
1056 
1057  IF(ASSOCIATED(interface_mesh_connectivity)) THEN
1058  IF(interface_mesh_connectivity%MESH_CONNECTIVITY_FINISHED) THEN
1059  CALL flagerror("Interface mesh connectivity has already been finished.",err,error,*999)
1060  ELSE
1061  IF((interface_mesh_element_number>0).AND.(interface_mesh_element_number<= &
1062  & interface_mesh_connectivity%NUMBER_OF_INTERFACE_ELEMENTS)) THEN
1063  IF((coupled_mesh_index>0).AND.(coupled_mesh_index<=interface_mesh_connectivity%NUMBER_OF_COUPLED_MESHES)) THEN
1064  IF (ALLOCATED(interface_mesh_connectivity%ELEMENT_CONNECTIVITY)) THEN
1065  element_connectivity=>interface_mesh_connectivity% &
1066  & element_connectivity(interface_mesh_element_number,coupled_mesh_index)
1067  element_connectivity%COUPLED_MESH_ELEMENT_NUMBER=coupled_mesh_element_number
1068  ELSE
1069  CALL flagerror("Interface elements connectivity array not allocated.",err,error,*999)
1070  ENDIF
1071  ELSE
1072  CALL flagerror("Interface coupled mesh index number out of range.",err,error,*999)
1073  ENDIF
1074  ELSE
1075  CALL flagerror("Interface mesh element number out of range.",err,error,*999)
1076  ENDIF
1077  ENDIF
1078  ELSE
1079  CALL flagerror("Interface mesh connectivity is not associated.",err,error,*999)
1080  ENDIF
1081 
1082  exits("InterfaceMeshConnectivity_ElementNumberSet")
1083  RETURN
1084 999 errorsexits("InterfaceMeshConnectivity_ElementNumberSet",err,error)
1085  RETURN 1
1086 
1087  END SUBROUTINE interfacemeshconnectivity_elementnumberset
1088 
1089  !
1090  !================================================================================================================================
1091  !
1092 
1094  SUBROUTINE interface_mesh_connectivity_node_number_set(NODES,INTERFACE_MESH_NODE_NUMBERS, &
1095  & first_coupled_mesh_index,first_coupled_mesh_node_numbers,second_coupled_mesh_index,second_coupled_mesh_node_numbers, &
1096  & err,error,*)
1097 
1098  !Argument variables
1099  TYPE(nodes_type), POINTER :: nodes
1100  INTEGER(INTG), INTENT(IN) :: interface_mesh_node_numbers(:)
1101  INTEGER(INTG), INTENT(IN) :: first_coupled_mesh_index,second_coupled_mesh_index
1102  INTEGER(INTG), INTENT(IN) :: first_coupled_mesh_node_numbers(:),second_coupled_mesh_node_numbers(:)
1103  INTEGER(INTG), INTENT(OUT) :: err
1104  TYPE(varying_string), INTENT(OUT) :: error
1105  !Local Variables
1106  INTEGER(INTG) :: nodeindex
1107 
1108  enters("INTERFACE_MESH_CONNECTIVITY_NODE_NUMBER_SET",err,error,*999)
1109 
1110  IF(ASSOCIATED(nodes)) THEN
1111  IF(nodes%INTERFACE%MESH_CONNECTIVITY%MESH_CONNECTIVITY_FINISHED) THEN
1112  print *, 'CHECK how to circumvent! interface_routines.f90:1133'
1113  CALL flagerror("Interface mesh connectivity has already been finished.",err,error,*999)
1114  ELSE
1115  !Default to two coupled meshes
1116  ALLOCATE(nodes%COUPLED_NODES(2,SIZE(interface_mesh_node_numbers(:))))
1117  DO nodeindex=1,SIZE(interface_mesh_node_numbers(:))
1118  nodes%COUPLED_NODES(first_coupled_mesh_index,nodeindex)=first_coupled_mesh_node_numbers(nodeindex)
1119  nodes%COUPLED_NODES(second_coupled_mesh_index,nodeindex)=second_coupled_mesh_node_numbers(nodeindex)
1120  ENDDO
1121  ENDIF
1122  ELSE
1123  CALL flagerror("Nodes are not associated.",err,error,*999)
1124  ENDIF
1125 
1126  exits("INTERFACE_MESH_CONNECTIVITY_NODE_NUMBER_SET")
1127  RETURN
1128 999 errorsexits("INTERFACE_MESH_CONNECTIVITY_NODE_NUMBER_SET",err,error)
1129  RETURN 1
1130 
1131  END SUBROUTINE interface_mesh_connectivity_node_number_set
1132 
1133  !
1134  !================================================================================================================================
1135  !
1136 
1138  SUBROUTINE interfacemeshconnectivity_connectedlinescalculate(INTERFACE_MESH_CONNECTIVITY,ERR,ERROR,*)
1139 
1140  !Argument variables
1141  TYPE(interface_mesh_connectivity_type), POINTER :: interface_mesh_connectivity
1142  INTEGER(INTG), INTENT(OUT) :: err
1143  TYPE(varying_string), INTENT(OUT) :: error
1144  !Local variables
1145  REAL(DP) :: xidifference
1146  INTEGER(INTG) :: coupledmeshidx,interfaceelementidx,coupledmeshxiidx,numberofinterfaceelementnodes,numberofinterfacemeshxi
1147  TYPE(interface_element_connectivity_type), POINTER :: element_connectivity
1148  TYPE(varying_string) :: local_error
1149 
1150  enters("InterfaceMeshConnectivity_ConnectedLinesCalculate",err,error,*999)
1151 
1152  DO coupledmeshidx=1,interface_mesh_connectivity%NUMBER_OF_COUPLED_MESHES
1153  DO interfaceelementidx=1,interface_mesh_connectivity%NUMBER_OF_INTERFACE_ELEMENTS
1154  element_connectivity=>interface_mesh_connectivity%ELEMENT_CONNECTIVITY(interfaceelementidx,coupledmeshidx)
1155  numberofinterfaceelementnodes=interface_mesh_connectivity%BASIS%NUMBER_OF_NODES
1156  numberofinterfacemeshxi=interface_mesh_connectivity%INTERFACE_MESH%NUMBER_OF_DIMENSIONS
1157  SELECTCASE(numberofinterfacemeshxi)
1158  CASE(1) !Lines
1159  DO coupledmeshxiidx=1,interface_mesh_connectivity%INTERFACE%COUPLED_MESHES(coupledmeshidx)%PTR%NUMBER_OF_DIMENSIONS
1160  ! Calculate difference between first node and last node of an element
1161  xidifference=element_connectivity%XI(coupledmeshxiidx,1,1)- &
1162  & element_connectivity%XI(coupledmeshxiidx,1,numberofinterfaceelementnodes)
1163  IF(abs(xidifference)<zero_tolerance) THEN
1164  IF(abs(element_connectivity%XI(coupledmeshxiidx,1,numberofinterfaceelementnodes))<zero_tolerance) THEN
1165  element_connectivity%CONNECTED_LINE=3-(coupledmeshxiidx-1)*2
1166  ELSE
1167  element_connectivity%CONNECTED_LINE=4-(coupledmeshxiidx-1)*2
1168  ENDIF
1169  ENDIF
1170  ENDDO
1171  CASE(2) !Faces
1172  DO coupledmeshxiidx=1,interface_mesh_connectivity%INTERFACE%COUPLED_MESHES(coupledmeshidx)%PTR%NUMBER_OF_DIMENSIONS
1173  xidifference=element_connectivity%XI(coupledmeshxiidx,1,1)- &
1174  & element_connectivity%XI(coupledmeshxiidx,1,numberofinterfaceelementnodes)
1175  IF(abs(xidifference)<zero_tolerance) THEN
1176  IF(abs(element_connectivity%XI(coupledmeshxiidx,1,numberofinterfaceelementnodes))<zero_tolerance) THEN
1177  element_connectivity%CONNECTED_FACE=(coupledmeshxiidx-1)*2+2
1178  ELSE
1179  element_connectivity%CONNECTED_FACE=(coupledmeshxiidx-1)*2+1
1180  ENDIF
1181  ENDIF
1182  ENDDO
1183  CASE DEFAULT
1184  local_error="Number of interface mesh dimension of "//trim(number_to_vstring(numberofinterfacemeshxi,"*",err,error))// &
1185  & "is invalid"
1186  CALL flagerror(local_error,err,error,*999)
1187  ENDSELECT
1188  ENDDO
1189  ENDDO
1190 
1191  exits("InterfaceMeshConnectivity_ConnectedLinesCalculate")
1192  RETURN
1193 999 errors("InterfaceMeshConnectivity_ConnectedLinesCalculate",err,error)
1194  exits("InterfaceMeshConnectivity_ConnectedLinesCalculate")
1195  RETURN 1
1196 
1197  END SUBROUTINE interfacemeshconnectivity_connectedlinescalculate
1198 
1199  !
1200  !================================================================================================================================
1201  !
1202 
1204  SUBROUTINE interface_mesh_connectivity_finalise(INTERFACE_MESH_CONNECTIVITY,ERR,ERROR,*)
1205 
1206  !Argument variables
1207  TYPE(interface_mesh_connectivity_type) :: interface_mesh_connectivity
1208  INTEGER(INTG), INTENT(OUT) :: err
1209  TYPE(varying_string), INTENT(OUT) :: error
1210  !Local Variables
1211 
1212  enters("INTERFACE_MESH_CONNECTIVITY_FINALISE",err,error,*999)
1213 
1214  CALL interfacemeshconnectivity_elementfinalise(interface_mesh_connectivity,err,error,*999)
1215  NULLIFY(interface_mesh_connectivity%INTERFACE)
1216  NULLIFY(interface_mesh_connectivity%INTERFACE_MESH)
1217  NULLIFY(interface_mesh_connectivity%BASIS)
1218  interface_mesh_connectivity%NUMBER_OF_INTERFACE_ELEMENTS=0
1219  interface_mesh_connectivity%NUMBER_OF_COUPLED_MESHES=0
1220 
1221  exits("INTERFACE_MESH_CONNECTIVITY_FINALISE")
1222  RETURN
1223 999 errorsexits("INTERFACE_MESH_CONNECTIVITY_FINALISE",err,error)
1224  RETURN 1
1225 
1226  END SUBROUTINE interface_mesh_connectivity_finalise
1227 
1228  !
1229  !================================================================================================================================
1230  !
1231 
1233  SUBROUTINE interface_mesh_connectivity_initialise(INTERFACE,MESH,ERR,ERROR,*)
1234 
1235  !Argument variables
1236  TYPE(interface_type), POINTER :: interface
1237  TYPE(mesh_type), POINTER :: mesh
1238  INTEGER(INTG), INTENT(OUT) :: err
1239  TYPE(varying_string), INTENT(OUT) :: error
1240  !Local Variables
1241 
1242  enters("INTERFACE_MESH_CONNECTIVITY_INITIALISE",err,error,*999)
1243 
1244  IF(ASSOCIATED(interface)) THEN
1245  IF(ASSOCIATED(interface%MESH_CONNECTIVITY)) THEN
1246  CALL flagerror("Interface mesh connectivity is already associated.",err,error,*999)
1247  ELSE
1248  ALLOCATE(interface%MESH_CONNECTIVITY,stat=err)
1249  IF(err/=0) CALL flagerror("Could not allocate interface mesh connectivity.",err,error,*999)
1250  interface%MESH_CONNECTIVITY%INTERFACE=>INTERFACE
1251  interface%MESH_CONNECTIVITY%MESH_CONNECTIVITY_FINISHED=.false.
1252  interface%MESH_CONNECTIVITY%INTERFACE_MESH=>mesh
1253  NULLIFY(interface%MESH_CONNECTIVITY%BASIS)
1254  CALL interfacemeshconnectivity_elementinitialise(interface,err,error,*999)
1255  ENDIF
1256  ELSE
1257  CALL flagerror("Interface is not associated.",err,error,*999)
1258  ENDIF
1259 
1260  exits("INTERFACE_MESH_CONNECTIVITY_INITIALISE")
1261  RETURN
1262 999 errorsexits("INTERFACE_MESH_CONNECTIVITY_INITIALISE",err,error)
1263  RETURN 1
1264  END SUBROUTINE interface_mesh_connectivity_initialise
1265 
1266  !
1267  !================================================================================================================================
1268  !
1269 
1271  SUBROUTINE interfacepointsconnectivity_coupledelementscalculate(interfacePointsConnectivity,coupledMeshIdx,err,error,*)
1272 
1273  !Argument variables
1274  TYPE(interfacepointsconnectivitytype), POINTER :: interfacepointsconnectivity
1275  INTEGER(INTG), INTENT(IN) :: coupledmeshidx
1276  INTEGER(INTG), INTENT(OUT) :: err
1277  TYPE(varying_string), INTENT(OUT) :: error
1278  !Local Variables
1279  TYPE(list_type), POINTER :: elementnumberslist
1280  INTEGER(INTG) :: elementidx,datapointidx,globaldatapointnumber,globalelementnumber,numberofelementdatapoints, &
1281  & numberOfCoupledElements,coupledElementIdx
1282  INTEGER(INTG), ALLOCATABLE :: elementnumbers(:)
1283 
1284  enters("InterfacePointsConnectivity_CoupledElementsCalculate",err,error,*999)
1285 
1286  IF(ASSOCIATED(interfacepointsconnectivity)) THEN
1287  IF(ALLOCATED(interfacepointsconnectivity%coupledElements)) THEN
1288  interfacepointsconnectivity%maxNumberOfCoupledElements(coupledmeshidx)=0; !Initialise the number of coupled mesh elements
1289  DO elementidx=1,SIZE(interfacepointsconnectivity%coupledElements,1) !Number of interface elements
1290  numberofelementdatapoints=interfacepointsconnectivity%interfaceMesh%TOPOLOGY(1)%PTR%dataPoints% &
1291  & elementdatapoint(elementidx)%numberOfProjectedData !Get the number of data points in interface mesh element
1292  !Set up list
1293  NULLIFY(elementnumberslist)
1294  CALL list_create_start(elementnumberslist,err,error,*999)
1295  CALL list_data_type_set(elementnumberslist,list_intg_type,err,error,*999)
1296  CALL list_initial_size_set(elementnumberslist,numberofelementdatapoints,err,error,*999)
1297  CALL list_create_finish(elementnumberslist,err,error,*999)
1298  DO datapointidx=1,numberofelementdatapoints
1299  globaldatapointnumber=interfacepointsconnectivity%interfaceMesh%TOPOLOGY(1)%PTR%dataPoints% &
1300  & elementdatapoint(elementidx)%dataIndices(datapointidx)%globalNumber
1301  globalelementnumber=interfacepointsconnectivity%pointsConnectivity(globaldatapointnumber,coupledmeshidx)% &
1302  & coupledmeshelementnumber
1303  CALL list_item_add(elementnumberslist,globalelementnumber,err,error,*999)
1304  ENDDO !dataPointIdx
1305  CALL list_remove_duplicates(elementnumberslist,err,error,*999)
1306  CALL list_detach_and_destroy(elementnumberslist,numberofcoupledelements,elementnumbers, &
1307  & err,error,*999)
1308  IF(ALLOCATED(interfacepointsconnectivity%coupledElements(elementidx,coupledmeshidx)%elementNumbers)) &
1309  & DEALLOCATE(interfacepointsconnectivity%coupledElements(elementidx,coupledmeshidx)%elementNumbers) !for updating coupledElements after projection
1310  ALLOCATE(interfacepointsconnectivity%coupledElements(elementidx,coupledmeshidx)% &
1311  & elementnumbers(numberofcoupledelements),stat=err)
1312  IF(err/=0) CALL flagerror("Could not allocate coupled mesh element numbers.",err,error,*999)
1313  DO coupledelementidx=1,numberofcoupledelements
1314  interfacepointsconnectivity%coupledElements(elementidx,coupledmeshidx)%elementNumbers(coupledelementidx)= &
1315  & elementnumbers(coupledelementidx)
1316  ENDDO
1317  interfacepointsconnectivity%coupledElements(elementidx,coupledmeshidx)%numberOfCoupledElements=numberofcoupledelements
1318  IF(ALLOCATED(elementnumbers)) DEALLOCATE(elementnumbers)
1319  IF(interfacepointsconnectivity%maxNumberOfCoupledElements(coupledmeshidx)<numberofcoupledelements) THEN
1320  interfacepointsconnectivity%maxNumberOfCoupledElements(coupledmeshidx)=numberofcoupledelements
1321  ENDIF
1322  ENDDO !elementIdx
1323  ELSE
1324  CALL flagerror("Interface points connectivity coupled elements is not allocated.",err,error,*999)
1325  ENDIF
1326  ELSE
1327  CALL flagerror("Interface points connectivity is not associated.",err,error,*999)
1328  ENDIF
1329 
1330  exits("InterfacePointsConnectivity_CoupledElementsCalculate")
1331  RETURN
1332 999 errors("InterfacePointsConnectivity_CoupledElementsCalculate",err,error)
1333  exits("InterfacePointsConnectivity_CoupledElementsCalculate")
1334  RETURN 1
1335 
1336  END SUBROUTINE interfacepointsconnectivity_coupledelementscalculate
1337 
1338  !
1339  !================================================================================================================================
1340  !
1341 
1343  SUBROUTINE interfacepointsconnectivity_coupledelementsfinalise(interfacePointsConnectivity,err,error,*)
1344 
1345  !Argument variables
1346  TYPE(interfacepointsconnectivitytype), POINTER :: interfacepointsconnectivity
1347  INTEGER(INTG), INTENT(OUT) :: err
1348  TYPE(varying_string), INTENT(OUT) :: error
1349  !Local Variables
1350  INTEGER(INTG) :: elementidx,coupledmeshidx
1351 
1352  enters("InterfacePointsConnectivity_CoupledElementsFinalise",err,error,*999)
1353 
1354  IF(ASSOCIATED(interfacepointsconnectivity)) THEN
1355  IF(ALLOCATED(interfacepointsconnectivity%coupledElements)) THEN
1356  DO coupledmeshidx=1,SIZE(interfacepointsconnectivity%coupledElements,2)
1357  DO elementidx=1,SIZE(interfacepointsconnectivity%coupledElements,1)
1358  interfacepointsconnectivity%coupledElements(elementidx,coupledmeshidx)%numberOfCoupledElements=0
1359  IF(ALLOCATED(interfacepointsconnectivity%coupledElements(elementidx,coupledmeshidx)%elementNumbers)) &
1360  & DEALLOCATE(interfacepointsconnectivity%coupledElements(elementidx,coupledmeshidx)%elementNumbers)
1361  ENDDO
1362  ENDDO
1363  DEALLOCATE(interfacepointsconnectivity%coupledElements)
1364  END IF
1365  IF(ALLOCATED(interfacepointsconnectivity%maxNumberOfCoupledElements)) &
1366  & DEALLOCATE(interfacepointsconnectivity%maxNumberOfCoupledElements)
1367  ELSE
1368  CALL flagerror("Interface points connectivity is not associated.",err,error,*999)
1369  ENDIF
1370 
1371  exits("InterfacePointsConnectivity_CoupledElementsFinalise")
1372  RETURN
1373 999 errors("InterfacePointsConnectivity_CoupledElementsFinalise",err,error)
1374  exits("InterfacePointsConnectivity_CoupledElementsFinalise")
1375  RETURN 1
1376 
1377  END SUBROUTINE interfacepointsconnectivity_coupledelementsfinalise
1378 
1379  !
1380  !================================================================================================================================
1381  !
1382 
1384  SUBROUTINE interfacepointsconnectivity_coupledelementsinitialise(interfacePointsConnectivity,err,error,*)
1385 
1386  !Argument variables
1387  TYPE(interfacepointsconnectivitytype), POINTER :: interfacepointsconnectivity
1388  INTEGER(INTG), INTENT(OUT) :: err
1389  TYPE(varying_string), INTENT(OUT) :: error
1390  !Local Variables
1391  INTEGER(INTG) :: numberofinterfaceelements,numberofcoupledmeshes,coupledmeshidx,elementidx
1392  INTEGER(INTG) :: dummyerr
1393  TYPE(varying_string) :: dummyerror
1394 
1395  enters("InterfacePointsConnectivity_CoupledElementsInitialise",err,error,*999)
1396 
1397  IF(ASSOCIATED(interfacepointsconnectivity)) THEN
1398  IF(ALLOCATED(interfacepointsconnectivity%coupledElements)) THEN
1399  CALL flagerror("Interface points connectivity coupled elements is already allocated.",err,error,*999)
1400  ELSE
1401  IF(ASSOCIATED(interfacepointsconnectivity%interface)) THEN
1402  IF(ASSOCIATED(interfacepointsconnectivity%interfaceMesh)) THEN
1403  numberofinterfaceelements=interfacepointsconnectivity%interfaceMesh%NUMBER_OF_ELEMENTS
1404  numberofcoupledmeshes=interfacepointsconnectivity%interface%NUMBER_OF_COUPLED_MESHES
1405  ALLOCATE(interfacepointsconnectivity%coupledElements(numberofinterfaceelements,numberofcoupledmeshes),stat=err)
1406  IF(err/=0) CALL flagerror("Could not allocate points connectivity coupled element.",err,error,*999)
1407  DO coupledmeshidx=1,numberofcoupledmeshes
1408  DO elementidx=1,numberofinterfaceelements
1409  interfacepointsconnectivity%coupledElements(elementidx,coupledmeshidx)%numberOfCoupledElements=0
1410  ENDDO !elementIdx
1411  ENDDO !coupledMeshIdx
1412  ELSE
1413  CALL flagerror("Interface mesh is not associated.",err,error,*999)
1414  ENDIF
1415  ELSE
1416  CALL flagerror("Interface is not associated.",err,error,*999)
1417  ENDIF
1418  ENDIF
1419  ELSE
1420  CALL flagerror("Interface points connectivity is not associated.",err,error,*999)
1421  ENDIF
1422 
1423  exits("InterfacePointsConnectivity_CoupledElementsInitialise")
1424  RETURN
1425 999 CALL interfacepointsconnectivity_coupledelementsfinalise(interfacepointsconnectivity,dummyerr,dummyerror,*998)
1426 998 errors("InterfacePointsConnectivity_CoupledElementsInitialise",err,error)
1427  exits("InterfacePointsConnectivity_CoupledElementsInitialise")
1428  RETURN 1
1429 
1430  END SUBROUTINE interfacepointsconnectivity_coupledelementsinitialise
1431 
1432  !
1433  !================================================================================================================================
1434  !
1435 
1437  SUBROUTINE interfacepointsconnectivity_createfinish(interfacePointsConnectivity,err,error,*)
1438 
1439  !Argument variables
1440  TYPE(interfacepointsconnectivitytype), POINTER :: interfacepointsconnectivity
1441  INTEGER(INTG), INTENT(OUT) :: err
1442  TYPE(varying_string), INTENT(OUT) :: error
1443  !Local Variables
1444  TYPE(interface_type), POINTER :: interface
1445  INTEGER(INTG) :: coupledmeshidx
1446 
1447  enters("InterfacePointsConnectivity_CreateFinish",err,error,*999)
1448 
1449  IF(ASSOCIATED(interfacepointsconnectivity)) THEN
1450  IF(interfacepointsconnectivity%pointsConnectivityFinished) THEN
1451  CALL flagerror("Interface points connectivity has already been finished.",err,error,*999)
1452  ELSE
1453  CALL interfacepointsconnectivity_reducedxicalculate(interfacepointsconnectivity,err,error,*999)
1454  interface=>interfacepointsconnectivity%interface
1455  IF(ASSOCIATED(interface)) THEN
1456  CALL interfacepointsconnectivity_coupledelementsinitialise(interfacepointsconnectivity,err,error,*999)
1457  DO coupledmeshidx=1,interfacepointsconnectivity%interface%NUMBER_OF_COUPLED_MESHES
1458  CALL interfacepointsconnectivity_coupledelementscalculate(interfacepointsconnectivity,coupledmeshidx,err,error,*999)
1459  ENDDO
1460  ELSE
1461  CALL flagerror("Interface is not associated.",err,error,*999)
1462  ENDIF
1463  interfacepointsconnectivity%pointsConnectivityFinished=.true.
1464  ENDIF
1465  ELSE
1466  CALL flagerror("Interface points connectivity is not associated.",err,error,*999)
1467  ENDIF
1468 
1469  exits("InterfacePointsConnectivity_CreateFinish")
1470  RETURN
1471 999 errorsexits("InterfacePointsConnectivity_CreateFinish",err,error)
1472  RETURN 1
1473  END SUBROUTINE interfacepointsconnectivity_createfinish
1474 
1475  !
1476  !================================================================================================================================
1477  !
1478 
1480  SUBROUTINE interfacepointsconnectivity_createstart(interface,interfaceMesh,interfacePointsConnectivity,err,error,*)
1481 
1482  !Argument variables
1483  TYPE(interface_type), POINTER :: interface
1484  TYPE(mesh_type), POINTER :: interfacemesh
1485  TYPE(interfacepointsconnectivitytype), POINTER :: interfacepointsconnectivity
1486  INTEGER(INTG), INTENT(OUT) :: err
1487  TYPE(varying_string), INTENT(OUT) :: error
1488  !Local Variables
1489 
1490  enters("InterfacePointsConnectivity_CreateStart",err,error,*999)
1491 
1492  IF(ASSOCIATED(interface)) THEN
1493  IF(interface%INTERFACE_FINISHED) THEN
1494  IF(ASSOCIATED(interface%pointsConnectivity)) THEN
1495  CALL flagerror("The interface already has a points connectivity associated.",err,error,*999)
1496  ELSE
1497  IF(ASSOCIATED(interfacemesh)) THEN
1498  CALL interfacepointsconnectivity_initialise(interface,interfacemesh,err,error,*999)
1499  !Return the pointer
1500  interfacepointsconnectivity=>interface%pointsConnectivity
1501  ELSE
1502  CALL flagerror("Interface mesh is not associated.",err,error,*999)
1503  ENDIF
1504  ENDIF
1505  ELSE
1506  CALL flagerror("Interface has not been finished.",err,error,*999)
1507  ENDIF
1508  ELSE
1509  CALL flagerror("Interface is not associated.",err,error,*999)
1510  ENDIF
1511 
1512  exits("InterfacePointsConnectivity_CreateStart")
1513  RETURN
1514 999 errorsexits("InterfacePointsConnectivity_CreateStart",err,error)
1515  RETURN 1
1516 
1517  END SUBROUTINE interfacepointsconnectivity_createstart
1518 
1519  !
1520  !================================================================================================================================
1521  !
1522 
1524  SUBROUTINE interfacepointsconnectivity_datareprojection(interface,interfaceCondition,err,error,*)
1525 
1526  !Argument variables
1527  TYPE(interface_type), POINTER :: interface
1528  TYPE(interface_condition_type), POINTER :: interfacecondition
1529  INTEGER(INTG), INTENT(OUT) :: err
1530  TYPE(varying_string), INTENT(OUT) :: error
1531  !Local Variables
1532  TYPE(interfacepointsconnectivitytype), POINTER :: interfacepointsconnectivity
1533  TYPE(field_type), POINTER :: dependentfieldfixed,dependentfieldprojection
1534  TYPE(data_points_type), POINTER :: datapoints
1535  TYPE(data_projection_type), POINTER :: dataprojection
1536  TYPE(field_interpolated_point_ptr_type), POINTER :: interpolatedpoints(:)
1537  TYPE(field_interpolated_point_type), POINTER :: interpolatedpoint
1538  TYPE(field_interpolation_parameters_ptr_type), POINTER :: interpolationparameters(:)
1539  INTEGER(INTG) :: fixedbodyidx,projectionbodyidx,datapointidx
1540  INTEGER(INTG) :: elementnumber,numberofgeometriccomponents
1541  INTEGER(INTG) :: coupledmeshfacelinenumber,component
1542 
1543  enters("InterfacePointsConnectivity_DataReprojection",err,error,*999)
1544 
1545  NULLIFY(interpolatedpoints)
1546  NULLIFY(interpolationparameters)
1547  fixedbodyidx=2 !\todo: need to generalise
1548  projectionbodyidx=1
1549 
1550  IF(ASSOCIATED(interface)) THEN
1551  IF(ASSOCIATED(interfacecondition)) THEN
1552  interfacepointsconnectivity=>interface%pointsConnectivity
1553  IF(ASSOCIATED(interfacepointsconnectivity)) THEN
1554  datapoints=>interface%DATA_POINTS
1555  IF(ASSOCIATED(datapoints)) THEN
1556 
1557  !Evaluate data points positions
1558  dependentfieldfixed=>interfacecondition%DEPENDENT%FIELD_VARIABLES(fixedbodyidx)%PTR%FIELD
1559  IF(ASSOCIATED(dependentfieldfixed)) THEN
1560  numberofgeometriccomponents=dependentfieldfixed%GEOMETRIC_FIELD%VARIABLES(1)%NUMBER_OF_COMPONENTS
1561  CALL field_interpolation_parameters_initialise(dependentfieldfixed,interpolationparameters,err,error,*999, &
1562  & field_geometric_components_type)
1563  CALL field_interpolated_points_initialise(interpolationparameters,interpolatedpoints,err,error,*999, &
1564  & field_geometric_components_type)
1565  interpolatedpoint=>interpolatedpoints(field_u_variable_type)%PTR
1566  DO datapointidx=1,datapoints%NUMBER_OF_DATA_POINTS
1567  elementnumber=interfacepointsconnectivity%pointsConnectivity(datapointidx,fixedbodyidx)% &
1568  & coupledmeshelementnumber
1569  coupledmeshfacelinenumber=dependentfieldfixed%DECOMPOSITION%TOPOLOGY%ELEMENTS% &
1570  & elements(elementnumber)% &
1571  & element_faces(interfacepointsconnectivity%pointsConnectivity(datapointidx,fixedbodyidx)% &
1572  & elementlinefacenumber)
1573  CALL field_interpolation_parameters_face_get(field_values_set_type,coupledmeshfacelinenumber, &
1574  & interpolationparameters(field_u_variable_type)%PTR,err,error,*999,field_geometric_components_type)
1575  CALL field_interpolate_xi(no_part_deriv,interfacepointsconnectivity%pointsConnectivity(datapointidx, &
1576  & fixedbodyidx)%reducedXi(:),interpolatedpoint,err,error,*999,field_geometric_components_type) !Interpolate contact data points on each surface
1577  DO component=1,numberofgeometriccomponents
1578  datapoints%DATA_POINTS(datapointidx)%position(component) = interpolatedpoint%VALUES(component,no_part_deriv)
1579  ENDDO !component
1580  ENDDO !dataPointIdx
1581  ELSE
1582  CALL flagerror("Fixed dependent field is not associated.",err,error,*999)
1583  ENDIF
1584 
1585  !Data reprojection and update points connectivity information with the projection results
1586  dataprojection=>datapoints%DATA_PROJECTIONS(projectionbodyidx+1)%PTR
1587  CALL write_string(general_output_type,"ProjectedBodyDataProjectionLabel",err,error,*999)
1588  CALL write_string(general_output_type,dataprojection%label,err,error,*999)
1589  IF(ASSOCIATED(dataprojection)) THEN
1590  dependentfieldprojection=>interfacecondition%DEPENDENT%FIELD_VARIABLES(projectionbodyidx)%PTR%FIELD
1591  IF(ASSOCIATED(dependentfieldprojection)) THEN
1592  !Projection the data points (with know spatial positions) on the projection dependent field
1593  CALL dataprojection_datapointsprojectionevaluate(dataprojection,dependentfieldprojection,err,error,*999)
1594  CALL interfacepointsconnectivity_updatefromprojection(interfacepointsconnectivity,dataprojection, &
1595  & projectionbodyidx,err,error,*999)
1596  ELSE
1597  CALL flagerror("Projection dependent field is not associated.",err,error,*999)
1598  ENDIF
1599  ELSE
1600  CALL flagerror("Interface data projection is not associated.",err,error,*999)
1601  ENDIF
1602  ELSE
1603  CALL flagerror("Interface data points is not associated.",err,error,*999)
1604  ENDIF
1605  ELSE
1606  CALL flagerror("Interface points connectivity is not associated.",err,error,*999)
1607  ENDIF
1608  ELSE
1609  CALL flagerror("Interface condition is not associated.",err,error,*999)
1610  ENDIF
1611  ELSE
1612  CALL flagerror("Interface is not associated.",err,error,*999)
1613  ENDIF
1614 
1615  exits("InterfacePointsConnectivity_DataReprojection")
1616  RETURN
1617 999 errors("InterfacePointsConnectivity_DataReprojection",err,error)
1618  exits("InterfacePointsConnectivity_DataReprojection")
1619  RETURN 1
1620 
1621  END SUBROUTINE interfacepointsconnectivity_datareprojection
1622 
1623  !
1624  !================================================================================================================================
1625  !
1626 
1628  SUBROUTINE interfacepointsconnectivity_destroy(interfacePointsConnectivity,err,error,*)
1629 
1630  !Argument variables
1631  TYPE(interfacepointsconnectivitytype), POINTER :: interfacepointsconnectivity
1632  INTEGER(INTG), INTENT(OUT) :: err
1633  TYPE(varying_string), INTENT(OUT) :: error
1634  !Local Variables
1635 
1636  enters("InterfacePointsConnectivity_Destroy",err,error,*999)
1637 
1638  IF(ASSOCIATED(interfacepointsconnectivity)) THEN
1639  CALL interfacepointsconnectivity_finalise(interfacepointsconnectivity,err,error,*999)
1640  ELSE
1641  CALL flagerror("Interface points connectivity is not associated.",err,error,*999)
1642  ENDIF
1643 
1644  exits("InterfacePointsConnectivity_Destroy")
1645  RETURN
1646 999 errorsexits("InterfacePointsConnectivity_Destroy",err,error)
1647  RETURN 1
1648 
1649  END SUBROUTINE interfacepointsconnectivity_destroy
1650 
1651  !
1652  !================================================================================================================================
1653  !
1654 
1656  SUBROUTINE interfacepointsconnectivity_elementnumberget(pointsConnectivity,dataPointUserNumber,coupledMeshIndexNumber, &
1657  & meshcomponentnumber,coupledmeshuserelementnumber,err,error,*)
1658 
1659  !Argument variables
1660  TYPE(interfacepointsconnectivitytype), POINTER :: pointsconnectivity
1661  INTEGER(INTG), INTENT(IN) :: datapointusernumber
1662  INTEGER(INTG), INTENT(IN) :: coupledmeshindexnumber
1663  INTEGER(INTG), INTENT(OUT) :: coupledmeshuserelementnumber
1664  INTEGER(INTG), INTENT(IN) :: meshcomponentnumber
1665  INTEGER(INTG), INTENT(OUT) :: err
1666  TYPE(varying_string), INTENT(OUT) :: error
1667  !Local Variables
1668  TYPE(mesh_type), POINTER :: interfacemesh
1669  INTEGER(INTG) :: datapointglobalnumber
1670  LOGICAL :: datapointexists
1671 
1672  enters("InterfacePointsConnectivity_ElementNumberGet",err,error,*999)
1673 
1674  IF(ASSOCIATED(pointsconnectivity)) THEN
1675  CALL data_point_check_exists(pointsconnectivity%interface%DATA_POINTS,datapointusernumber,datapointexists, &
1676  & datapointglobalnumber,err,error,*999)
1677  IF(datapointexists) THEN
1678  interfacemesh=>pointsconnectivity%interfaceMesh
1679  coupledmeshuserelementnumber=pointsconnectivity%pointsConnectivity(datapointglobalnumber,coupledmeshindexnumber)% &
1680  & coupledmeshelementnumber
1681  ELSE
1682  CALL flagerror("Data point with user number ("//trim(number_to_vstring &
1683  & (datapointusernumber,"*",err,error))//") does not exist.",err,error,*999)
1684  ENDIF
1685  ELSE
1686  CALL flagerror("Interface points connectivity is not associated.",err,error,*999)
1687  ENDIF
1688 
1689  exits("InterfacePointsConnectivity_ElementNumberGet")
1690  RETURN
1691 999 errors("InterfacePointsConnectivity_ElementNumberGet",err,error)
1692  exits("InterfacePointsConnectivity_ElementNumberGet")
1693  RETURN 1
1694 
1695  END SUBROUTINE interfacepointsconnectivity_elementnumberget
1696 
1697  !
1698  !================================================================================================================================
1699  !
1700 
1702  SUBROUTINE interfacepointsconnectivity_elementnumberset(pointsConnectivity,dataPointUserNumber,coupledMeshIndexNumber, &
1703  & coupledmeshuserelementnumber,meshcomponentnumber,err,error,*)
1704 
1705  !Argument variables
1706  TYPE(interfacepointsconnectivitytype), POINTER :: pointsconnectivity
1707  INTEGER(INTG), INTENT(IN) :: datapointusernumber
1708  INTEGER(INTG), INTENT(IN) :: coupledmeshindexnumber
1709  INTEGER(INTG), INTENT(IN) :: coupledmeshuserelementnumber
1710  INTEGER(INTG), INTENT(IN) :: meshcomponentnumber
1711  INTEGER(INTG), INTENT(OUT) :: err
1712  TYPE(varying_string), INTENT(OUT) :: error
1713  !Local Variables
1714  INTEGER(INTG) :: datapointglobalnumber,elementmeshnumber
1715  LOGICAL :: datapointexists,elementexists
1716 
1717  enters("InterfacePointsConnectivity_ElementNumberSet",err,error,*999)
1718 
1719  IF(ASSOCIATED(pointsconnectivity)) THEN
1720  IF(pointsconnectivity%pointsConnectivityFinished) THEN
1721  CALL flagerror("Interface points connectivity has already been finished.",err,error,*999)
1722  ELSE
1723  CALL data_point_check_exists(pointsconnectivity%interface%DATA_POINTS,datapointusernumber,datapointexists, &
1724  & datapointglobalnumber,err,error,*999)
1725  IF(datapointexists) THEN
1726  IF ((coupledmeshindexnumber<=pointsconnectivity%interface%DATA_POINTS%NUMBER_OF_DATA_POINTS).OR. &
1727  & (coupledmeshindexnumber>0)) THEN
1728  IF (ALLOCATED(pointsconnectivity%pointsConnectivity)) THEN
1729  CALL meshtopologyelementcheckexists(pointsconnectivity%INTERFACE%COUPLED_MESHES(coupledmeshindexnumber)%PTR, &
1730  & meshcomponentnumber,coupledmeshuserelementnumber,elementexists,elementmeshnumber,err,error,*999) !Make sure user element exists
1731  IF(elementexists) THEN
1732  pointsconnectivity%pointsConnectivity(datapointglobalnumber,coupledmeshindexnumber)%coupledMeshElementNumber= &
1733  & elementmeshnumber
1734  ELSE
1735  CALL flagerror("Element with user number ("//trim(number_to_vstring &
1736  & (coupledmeshuserelementnumber,"*",err,error))//") does not exist.",err,error,*999)
1737  ENDIF
1738  ELSE
1739  CALL flagerror("Interface points connectivity array not allocated.",err,error,*999)
1740  END IF
1741  ELSE
1742  CALL flagerror("Interface coupled mesh index number out of range.",err,error,*999)
1743  ENDIF
1744  ELSE
1745  CALL flagerror("Data point with user number ("//trim(number_to_vstring &
1746  & (datapointusernumber,"*",err,error))//") does not exist.",err,error,*999)
1747  ENDIF
1748  ENDIF
1749  ELSE
1750  CALL flagerror("Interface points connectivity is not associated.",err,error,*999)
1751  ENDIF
1752 
1753  exits("InterfacePointsConnectivity_ElementNumberSet")
1754  RETURN
1755 999 errors("InterfacePointsConnectivity_ElementNumberSet",err,error)
1756  exits("InterfacePointsConnectivity_ElementNumberSet")
1757  RETURN 1
1758 
1759  END SUBROUTINE interfacepointsconnectivity_elementnumberset
1760 
1761  !
1762  !================================================================================================================================
1763  !
1764 
1766  SUBROUTINE interfacepointsconnectivity_finalise(interfacePointsConnectivity,err,error,*)
1767 
1768  !Argument variables
1769  TYPE(interfacepointsconnectivitytype), POINTER :: interfacepointsconnectivity
1770  INTEGER(INTG), INTENT(OUT) :: err
1771  TYPE(varying_string), INTENT(OUT) :: error
1772  !Local Variables
1773  INTEGER(INTG) :: coupledmeshidx,datapointidx
1774 
1775  enters("InterfacePointsConnectivity_Finalise",err,error,*999)
1776 
1777  IF(ASSOCIATED(interfacepointsconnectivity)) THEN
1778  IF(ALLOCATED(interfacepointsconnectivity%PointsConnectivity)) THEN
1779  DO coupledmeshidx=1,size(interfacepointsconnectivity%pointsConnectivity,2)
1780  DO datapointidx=1,size(interfacepointsconnectivity%pointsConnectivity,1) !Deallocate memory for each data point
1781  CALL interfacepointsconnectivity_pointfinalise(interfacepointsconnectivity%pointsConnectivity(datapointidx, &
1782  & coupledmeshidx),err,error,*999)
1783  ENDDO
1784  ENDDO
1785  DEALLOCATE(interfacepointsconnectivity%pointsConnectivity)
1786  ENDIF
1787  CALL interfacepointsconnectivity_coupledelementsfinalise(interfacepointsconnectivity,err,error,*999)
1788  NULLIFY(interfacepointsconnectivity%interface)
1789  NULLIFY(interfacepointsconnectivity%interfaceMesh)
1790  IF(ALLOCATED(interfacepointsconnectivity%coupledElements)) DEALLOCATE(interfacepointsconnectivity%coupledElements)
1791  IF(ALLOCATED(interfacepointsconnectivity%maxNumberOfCoupledElements)) &
1792  & DEALLOCATE(interfacepointsconnectivity%maxNumberOfCoupledElements)
1793  DEALLOCATE(interfacepointsconnectivity)
1794  ENDIF
1795 
1796  exits("InterfacePointsConnectivity_Finalise")
1797  RETURN
1798 999 errorsexits("InterfacePointsConnectivity_Finalise",err,error)
1799  RETURN 1
1800 
1801  END SUBROUTINE interfacepointsconnectivity_finalise
1802 
1803  !
1804  !================================================================================================================================
1805  !
1806 
1808  SUBROUTINE interfacepointsconnectivity_pointfinalise(interfacePointConnectivity,err,error,*)
1809 
1810  !Argument variables
1811  TYPE(interfacepointconnectivitytype) :: interfacepointconnectivity
1812  INTEGER(INTG), INTENT(OUT) :: err
1813  TYPE(varying_string), INTENT(OUT) :: error
1814  !Local Variables
1815 
1816  enters("InterfacePointsConnectivity_PointFinalise",err,error,*999)
1817 
1818  interfacepointconnectivity%coupledMeshElementNumber=0
1819  interfacepointconnectivity%elementLineFaceNumber=0
1820  IF(ALLOCATED(interfacepointconnectivity%xi)) DEALLOCATE(interfacepointconnectivity%xi)
1821  IF(ALLOCATED(interfacepointconnectivity%reducedXi)) DEALLOCATE(interfacepointconnectivity%reducedXi)
1822 
1823  exits("InterfacePointsConnectivity_PointFinalise")
1824  RETURN
1825 999 errorsexits("InterfacePointsConnectivity_PointFinalise",err,error)
1826  RETURN 1
1827 
1828  END SUBROUTINE interfacepointsconnectivity_pointfinalise
1829 
1830  !
1831  !================================================================================================================================
1832  !
1833 
1835  SUBROUTINE interfacepointsconnectivity_fullxicalculate(InterfacePointsConnectivity,coupledMeshIdx,err,error,*)
1836 
1837  !Argument variables
1838  TYPE(interfacepointsconnectivitytype), POINTER :: interfacepointsconnectivity
1839  INTEGER(INTG), INTENT(IN) :: coupledmeshidx
1840  INTEGER(INTG), INTENT(OUT) :: err
1841  TYPE(varying_string), INTENT(OUT) :: error
1842  !Local Variables
1843  INTEGER(INTG) :: datapointidx,interfacemeshdimensions,coupledmeshdimensions
1844  TYPE(interface_type), POINTER :: interface
1845  TYPE(interfacepointconnectivitytype), POINTER :: pointconnectivity
1846  TYPE(mesh_type), POINTER :: interfacemesh,coupledmesh
1847  TYPE(varying_string) :: localerror
1848 
1849  enters("InterfacePointsConnectivity_FullXiCalculate",err,error,*999)
1850 
1851  IF(ASSOCIATED(interfacepointsconnectivity)) THEN
1852  interfacemesh=>interfacepointsconnectivity%interfaceMesh
1853  IF(ASSOCIATED(interfacemesh)) THEN
1854  interfacemeshdimensions=interfacepointsconnectivity%interfaceMesh%NUMBER_OF_DIMENSIONS
1855  interface=>interfacepointsconnectivity%interface
1856  IF(ASSOCIATED(interface)) THEN
1857  coupledmesh=>interface%COUPLED_MESHES(coupledmeshidx)%PTR
1858  IF(ASSOCIATED(coupledmesh)) THEN
1859  coupledmeshdimensions=coupledmesh%NUMBER_OF_DIMENSIONS
1860  IF(interfacemeshdimensions==coupledmeshdimensions) THEN !e.g. If 1D-2D, 2D-3D coupling, interface dimension is 1D and 2D respectively for 1st body
1861  DO datapointidx=1,interface%DATA_POINTS%NUMBER_OF_DATA_POINTS
1862  interfacepointsconnectivity%pointsConnectivity(datapointidx,coupledmeshidx)%xi(:)= &
1863  & interfacepointsconnectivity%pointsConnectivity(datapointidx,coupledmeshidx)%reducedXi(:)
1864  ENDDO !dataPointIdx
1865  ELSE
1866  !Update full xi location from reduced xi and element face/line number
1867  SELECT CASE(coupledmeshdimensions)
1868  CASE(2)
1869  DO datapointidx=1,interface%DATA_POINTS%NUMBER_OF_DATA_POINTS
1870  pointconnectivity=>interfacepointsconnectivity%pointsConnectivity(datapointidx,coupledmeshidx)
1871  SELECT CASE(pointconnectivity%elementLineFaceNumber)
1872  CASE(1)
1873  pointconnectivity%xi(1)=pointconnectivity%reducedXi(1)
1874  pointconnectivity%xi(2)=0.0_dp
1875  CASE(2)
1876  pointconnectivity%xi(1)=pointconnectivity%reducedXi(1)
1877  pointconnectivity%xi(2)=1.0_dp
1878  CASE(3)
1879  pointconnectivity%xi(1)=0.0_dp
1880  pointconnectivity%xi(2)=pointconnectivity%reducedXi(1)
1881  CASE(4)
1882  pointconnectivity%xi(1)=1.0_dp
1883  pointconnectivity%xi(2)=pointconnectivity%reducedXi(1)
1884  CASE DEFAULT
1885  localerror="Invalid local line number "// &
1886  & trim(number_to_vstring(pointconnectivity%elementLineFaceNumber,"*",err,error))//" ."
1887  CALL flagerror(localerror,err,error,*999)
1888  END SELECT
1889  ENDDO !dataPointIdx
1890  CASE(3)
1891  DO datapointidx=1,interface%DATA_POINTS%NUMBER_OF_DATA_POINTS
1892  pointconnectivity=>interfacepointsconnectivity%pointsConnectivity(datapointidx,coupledmeshidx)
1893  SELECT CASE(pointconnectivity%elementLineFaceNumber)
1894  CASE(1)
1895  pointconnectivity%xi(1)=1.0_dp
1896  pointconnectivity%xi(2)=pointconnectivity%reducedXi(1)
1897  pointconnectivity%xi(3)=pointconnectivity%reducedXi(2)
1898  CASE(2)
1899  pointconnectivity%xi(1)=0.0_dp
1900  pointconnectivity%xi(2)=pointconnectivity%reducedXi(1)
1901  pointconnectivity%xi(3)=pointconnectivity%reducedXi(2)
1902  CASE(3)
1903  pointconnectivity%xi(1)=pointconnectivity%reducedXi(1)
1904  pointconnectivity%xi(2)=1.0_dp
1905  pointconnectivity%xi(3)=pointconnectivity%reducedXi(2)
1906  CASE(4)
1907  pointconnectivity%xi(1)=pointconnectivity%reducedXi(1)
1908  pointconnectivity%xi(2)=0.0_dp
1909  pointconnectivity%xi(3)=pointconnectivity%reducedXi(2)
1910  CASE(5)
1911  pointconnectivity%xi(1)=pointconnectivity%reducedXi(1)
1912  pointconnectivity%xi(2)=pointconnectivity%reducedXi(2)
1913  pointconnectivity%xi(3)=1.0_dp
1914  CASE(6)
1915  pointconnectivity%xi(1)=pointconnectivity%reducedXi(1)
1916  pointconnectivity%xi(2)=pointconnectivity%reducedXi(2)
1917  pointconnectivity%xi(3)=0.0_dp
1918  CASE DEFAULT
1919  localerror="Invalid local face number "// &
1920  & trim(number_to_vstring(pointconnectivity%elementLineFaceNumber,"*",err,error))//" ."
1921  CALL flagerror(localerror,err,error,*999)
1922  END SELECT
1923  ENDDO !dataPointIdx
1924  CASE DEFAULT
1925  localerror="Invalid coupled mesh dimension "// &
1926  & trim(number_to_vstring(coupledmeshdimensions,"*",err,error))//" ."
1927  CALL flagerror(localerror,err,error,*999)
1928  END SELECT
1929  ENDIF
1930  ELSE
1931  CALL flagerror("Coupled mesh is not associated.",err,error,*999)
1932  ENDIF
1933  ELSE
1934  CALL flagerror("Interface is not associated.",err,error,*999)
1935  ENDIF
1936  ELSE
1937  CALL flagerror("Interface mesh is not associated.",err,error,*999)
1938  ENDIF
1939  ELSE
1940  CALL flagerror("Interface points connectivity is not associated.",err,error,*999)
1941  ENDIF
1942 
1943  exits("InterfacePointsConnectivity_FullXiCalculate")
1944  RETURN
1945 999 errorsexits("InterfacePointsConnectivity_FullXiCalculate",err,error)
1946  RETURN 1
1947 
1948  END SUBROUTINE interfacepointsconnectivity_fullxicalculate
1949 
1950  !
1951  !================================================================================================================================
1952  !
1953 
1955  SUBROUTINE interfacepointsconnectivity_initialise(interface,interfaceMesh,err,error,*)
1956 
1957  !Argument variables
1958  TYPE(interface_type), POINTER :: interface
1959  TYPE(mesh_type), POINTER :: interfacemesh
1960  INTEGER(INTG), INTENT(OUT) :: err
1961  TYPE(varying_string), INTENT(OUT) :: error
1962  !Local Variables
1963  INTEGER(INTG) :: datapointidx,meshidx,coupledmeshdimension,interfacemeshdimension
1964  INTEGER(INTG) :: dummyerr
1965  TYPE(varying_string) :: dummyerror
1966 
1967  enters("InterfacePointsConnectivity_Initialise",err,error,*999)
1968 
1969  IF(ASSOCIATED(interface)) THEN
1970  IF(ASSOCIATED(interface%pointsConnectivity)) THEN
1971  CALL flagerror("Interface has already got points connectivity associated.",err,error,*998)
1972  ELSE
1973  !Initialise the poins connectivity
1974  ALLOCATE(interface%pointsConnectivity,stat=err)
1975  IF(err/=0) CALL flagerror("Could not allocate interface points connectivity.",err,error,*998)
1976  interface%pointsConnectivity%interface=>interface
1977  interface%pointsConnectivity%pointsConnectivityFinished=.false.
1978  interface%pointsConnectivity%interfaceMesh=>interfacemesh
1979  interfacemeshdimension=interfacemesh%NUMBER_OF_DIMENSIONS
1980  IF(interface%NUMBER_OF_COUPLED_MESHES>0) THEN
1981  IF(ASSOCIATED(interface%DATA_POINTS)) THEN
1982  IF(interface%DATA_POINTS%NUMBER_OF_DATA_POINTS>0) THEN
1983  ALLOCATE(interface%pointsConnectivity%pointsConnectivity(interface%DATA_POINTS%NUMBER_OF_DATA_POINTS, &
1984  & interface%NUMBER_OF_COUPLED_MESHES),stat=err)
1985  IF(err/=0) CALL flagerror("Could not allocate interface point connectivity.",err,error,*999)
1986  DO datapointidx=1,interface%DATA_POINTS%NUMBER_OF_DATA_POINTS
1987  DO meshidx=1,interface%NUMBER_OF_COUPLED_MESHES
1988  coupledmeshdimension=interface%COUPLED_MESHES(meshidx)%PTR%NUMBER_OF_DIMENSIONS
1989  CALL interfacepointsconnectivity_pointinitialise(interface%pointsConnectivity%pointsConnectivity(datapointidx, &
1990  & meshidx),coupledmeshdimension,interfacemeshdimension,err,error,*999)
1991  ENDdo!meshIdx
1992  ENDdo!dataPointIdx
1993  ELSE
1994  CALL flagerror("Number of interface data points must be > 0.",err,error,*999)
1995  ENDIF
1996  ELSE
1997  CALL flagerror("Interface data points are not associated.",err,error,*999)
1998  ENDIF
1999  ELSE
2000  CALL flagerror("Number of coupled meshes in the interface must be > 0.",err,error,*999)
2001  ENDIF
2002  ALLOCATE(interface%pointsConnectivity%maxNumberOfCoupledElements(interface%NUMBER_OF_COUPLED_MESHES),stat=err)
2003  IF(err/=0) CALL flagerror("Could not allocate interface max number of coupled mesh elements.",err,error,*999)
2004  interface%pointsConnectivity%maxNumberOfCoupledElements=0
2005  ENDIF
2006  ELSE
2007  CALL flagerror("Interface is not associated.",err,error,*999)
2008  ENDIF
2009 
2010  exits("InterfacePointsConnectivity_Initialise")
2011  RETURN
2012 999 CALL interfacepointsconnectivity_finalise(interface%pointsConnectivity,dummyerr,dummyerror,*998)
2013 998 errorsexits("InterfacePointsConnectivity_Initialise",err,error)
2014  RETURN 1
2015  END SUBROUTINE interfacepointsconnectivity_initialise
2016 
2017  !
2018  !================================================================================================================================
2019  !
2020 
2022  SUBROUTINE interfacepointsconnectivity_pointinitialise(interfacePointConnectivity,coupledMeshDimension,interfaceMeshDimension, &
2023  & err,error,*)
2024 
2025  !Argument variables
2026  TYPE(interfacepointconnectivitytype) :: interfacepointconnectivity
2027  INTEGER(INTG), INTENT(IN) :: coupledmeshdimension,interfacemeshdimension
2028  INTEGER(INTG), INTENT(OUT) :: err
2029  TYPE(varying_string), INTENT(OUT) :: error
2030  !Local Variables
2031  INTEGER(INTG) :: dummyerr
2032  TYPE(varying_string) :: dummyerror
2033 
2034  enters("InterfacePointsConnectivity_PointInitialise",err,error,*999)
2035 
2036  interfacepointconnectivity%coupledMeshElementNumber=0
2037  interfacepointconnectivity%elementLineFaceNumber=0
2038  !Allocate memory for coupled mesh full and reduced xi location
2039  ALLOCATE(interfacepointconnectivity%xi(coupledmeshdimension),stat=err)
2040  IF(err/=0) CALL flagerror("Could not allocate interface point connectivity full xi.",err,error,*999)
2041  interfacepointconnectivity%xi=0.0_dp
2042  ALLOCATE(interfacepointconnectivity%reducedXi(interfacemeshdimension),stat=err)
2043  IF(err/=0) CALL flagerror("Could not allocate interface point connectivity reduced xi.",err,error,*999)
2044  interfacepointconnectivity%reducedXi=0.0_dp
2045 
2046  exits("InterfacePointsConnectivity_PointInitialise")
2047  RETURN
2048 999 CALL interfacepointsconnectivity_pointfinalise(interfacepointconnectivity,dummyerr,dummyerror,*998)
2049 998 errorsexits("InterfacePointsConnectivity_PointInitialise",err,error)
2050  RETURN 1
2051  END SUBROUTINE interfacepointsconnectivity_pointinitialise
2052 
2053  !
2054  !================================================================================================================================
2055  !
2056 
2058  SUBROUTINE interfacepointsconnectivity_pointxiget(pointsConnectivity,dataPointUserNumber,coupledMeshIndexNumber, &
2059  & xi,err,error,*)
2060 
2061  !Argument variables
2062  TYPE(interfacepointsconnectivitytype), POINTER :: pointsconnectivity
2063  INTEGER(INTG), INTENT(IN) :: datapointusernumber
2064  INTEGER(INTG), INTENT(IN) :: coupledmeshindexnumber
2065  REAL(DP), INTENT(OUT) :: xi(:)
2066  INTEGER(INTG), INTENT(OUT) :: err
2067  TYPE(varying_string), INTENT(OUT) :: error
2068  !Local Variables
2069  INTEGER(INTG) :: datapointglobalnumber
2070  LOGICAL :: datapointexists
2071 
2072  enters("InterfacePointsConnectivity_PointXiGet",err,error,*999)
2073 
2074  ! Preliminary error checks to verify user input information
2075  IF(ASSOCIATED(pointsconnectivity)) THEN
2076  IF (ALLOCATED(pointsconnectivity%pointsConnectivity)) THEN
2077  CALL data_point_check_exists(pointsconnectivity%INTERFACE%DATA_POINTS,datapointusernumber,datapointexists, &
2078  & datapointglobalnumber,err,error,*999)
2079  IF(datapointexists) THEN
2080  IF(SIZE(xi)>=SIZE(pointsconnectivity%pointsConnectivity(datapointusernumber,coupledmeshindexnumber)%xi,1)) THEN
2081  xi=pointsconnectivity%pointsConnectivity(datapointusernumber,coupledmeshindexnumber)%xi(:)
2082  ELSE
2083  CALL flagerror("Input xi array size is smaller than points connectivity xi array.",err,error,*999)
2084  ENDIF
2085  ELSE
2086  CALL flagerror("Data point with user number ("//trim(number_to_vstring &
2087  & (datapointusernumber,"*",err,error))//") does not exist.",err,error,*999)
2088  ENDIF
2089  ELSE
2090  CALL flagerror("Interface points connectivity array not allocated.",err,error,*999)
2091  ENDIF
2092  ELSE
2093  CALL flagerror("Interface points connectivity is not associated.",err,error,*999)
2094  ENDIF
2095 
2096  exits("InterfacePointsConnectivity_PointXiGet")
2097  RETURN
2098 999 errorsexits("InterfacePointsConnectivity_PointXiGet",err,error)
2099  RETURN 1
2100 
2101  END SUBROUTINE interfacepointsconnectivity_pointxiget
2102 
2103  !
2104  !================================================================================================================================
2105  !
2106 
2108  SUBROUTINE interfacepointsconnectivity_pointxiset(pointsConnectivity,dataPointUserNumber,coupledMeshIndexNumber, &
2109  & xi,err,error,*)
2110 
2111  !Argument variables
2112  TYPE(interfacepointsconnectivitytype), POINTER :: pointsconnectivity
2113  INTEGER(INTG), INTENT(IN) :: datapointusernumber
2114  INTEGER(INTG), INTENT(IN) :: coupledmeshindexnumber
2115  REAL(DP), INTENT(IN) :: xi(:)
2116  INTEGER(INTG), INTENT(OUT) :: err
2117  TYPE(varying_string), INTENT(OUT) :: error
2118  !Local Variables
2119  INTEGER(INTG) :: datapointglobalnumber
2120  LOGICAL :: datapointexists
2121 
2122  enters("InterfacePointsConnectivity_PointXiSet",err,error,*999)
2123 
2124  ! Preliminary error checks to verify user input information
2125  IF(ASSOCIATED(pointsconnectivity)) THEN
2126  IF(pointsconnectivity%pointsConnectivityFinished) THEN
2127  CALL flagerror("Interface mesh connectivity already been finished.",err,error,*999)
2128  ELSE
2129  IF (ALLOCATED(pointsconnectivity%pointsConnectivity)) THEN
2130  CALL data_point_check_exists(pointsconnectivity%INTERFACE%DATA_POINTS,datapointusernumber,datapointexists, &
2131  & datapointglobalnumber,err,error,*999)
2132  IF(datapointexists) THEN
2133  IF ((coupledmeshindexnumber>pointsconnectivity%interface%NUMBER_OF_COUPLED_MESHES).OR.(coupledmeshindexnumber<0)) THEN
2134  CALL flagerror("Interface coupled mesh index number out of range.",err,error,*999)
2135  ELSE
2136  IF(SIZE(pointsconnectivity%pointsConnectivity(datapointglobalnumber,coupledmeshindexnumber)%xi,1)== &
2137  & SIZE(xi,1)) THEN
2138  pointsconnectivity%pointsConnectivity(datapointglobalnumber,coupledmeshindexnumber)% &
2139  & xi(:)=xi(:)
2140  ELSE
2141  CALL flagerror("Input xi dimension does not match full coupled mesh xi dimension.",err,error,*999)
2142  ENDIF
2143  ENDIF
2144  ELSE
2145  CALL flagerror("Data point with user number ("//trim(number_to_vstring &
2146  & (datapointusernumber,"*",err,error))//") does not exist.",err,error,*999)
2147  ENDIF
2148  ELSE
2149  CALL flagerror("Interface points connectivity array not allocated.",err,error,*999)
2150  ENDIF
2151  ENDIF
2152  ELSE
2153  CALL flagerror("Interface points connectivity is not associated.",err,error,*999)
2154  ENDIF
2155 
2156  exits("InterfacePointsConnectivity_PointXiSet")
2157  RETURN
2158 999 errorsexits("InterfacePointsConnectivity_PointXiSet",err,error)
2159  RETURN 1
2160 
2161  END SUBROUTINE interfacepointsconnectivity_pointxiset
2162 
2163  !
2164  !================================================================================================================================
2165  !
2166 
2168  SUBROUTINE interfacepointsconnectivity_updatefromprojection(InterfacePointsConnectivity,dataProjection, &
2169  & coupledmeshindex,err,error,*)
2170 
2171  !Argument variables
2172  TYPE(interfacepointsconnectivitytype), POINTER :: interfacepointsconnectivity
2173  TYPE(data_projection_type), POINTER :: dataprojection
2174  INTEGER(INTG), INTENT(IN) :: coupledmeshindex
2175  INTEGER(INTG), INTENT(OUT) :: err
2176  TYPE(varying_string), INTENT(OUT) :: error
2177  !Local Variables
2178  INTEGER(INTG) :: datapointidx
2179  TYPE(data_projection_result_type), POINTER :: dataprojectionresult
2180 
2181  enters("InterfacePointsConnectivity_UpdateFromProjection",err,error,*999)
2182 
2183  IF(ASSOCIATED(interfacepointsconnectivity)) THEN
2184  IF(ASSOCIATED(dataprojection)) THEN
2185  IF(dataprojection%DATA_PROJECTION_FINISHED) THEN
2186  WRITE(*,*) "InterfacePointsConnectivity_UpdateFromProjection"
2187  DO datapointidx=1,SIZE(dataprojection%DATA_PROJECTION_RESULTS,1) !Update reduced xi location, projection element number and element face/line number with projection result
2188  dataprojectionresult=>dataprojection%DATA_PROJECTION_RESULTS(datapointidx)
2189  interfacepointsconnectivity%pointsConnectivity(datapointidx,coupledmeshindex)%reducedXi(:)= &
2190  & dataprojectionresult%XI
2191  interfacepointsconnectivity%pointsConnectivity(datapointidx,coupledmeshindex)%coupledMeshElementNumber= &
2192  & dataprojectionresult%ELEMENT_NUMBER
2193  IF(dataprojectionresult%ELEMENT_LINE_NUMBER/=0) THEN
2194  interfacepointsconnectivity%pointsConnectivity(datapointidx,coupledmeshindex)%elementLineFaceNumber= &
2195  & dataprojectionresult%ELEMENT_LINE_NUMBER
2196  ELSEIF(dataprojectionresult%ELEMENT_FACE_NUMBER/=0) THEN
2197  interfacepointsconnectivity%pointsConnectivity(datapointidx,coupledmeshindex)%elementLineFaceNumber= &
2198  & dataprojectionresult%ELEMENT_FACE_NUMBER
2199  ENDIF
2200  ENDDO
2201  CALL interfacepointsconnectivity_fullxicalculate(interfacepointsconnectivity,coupledmeshindex, &
2202  & err,error,*999)
2203  !Update points connectivity coupledElement information
2204  CALL interfacepointsconnectivity_coupledelementscalculate(interfacepointsconnectivity,coupledmeshindex,err,error,*999)
2205  ELSE
2206  CALL flagerror("Data projection is not finished.",err,error,*999)
2207  ENDIF
2208  ELSE
2209  CALL flagerror("Interface points connectivity is not associated.",err,error,*999)
2210  ENDIF
2211  ELSE
2212  CALL flagerror("Interface points connectivity is not associated.",err,error,*999)
2213  ENDIF
2214 
2215  exits("InterfacePointsConnectivity_UpdateFromProjection")
2216  RETURN
2217 999 errors("InterfacePointsConnectivity_UpdateFromProjection",err,error)
2218  exits("InterfacePointsConnectivity_UpdateFromProjection")
2219  RETURN 1
2220 
2221  END SUBROUTINE interfacepointsconnectivity_updatefromprojection
2222 
2223  !
2224  !================================================================================================================================
2225  !
2226 
2228  SUBROUTINE interfacepointsconnectivity_reducedxicalculate(InterfacePointsConnectivity,err,error,*)
2229 
2230  !Argument variables
2231  TYPE(interfacepointsconnectivitytype), POINTER :: interfacepointsconnectivity
2232  INTEGER(INTG), INTENT(OUT) :: err
2233  TYPE(varying_string), INTENT(OUT) :: error
2234  !Local Variables
2235  INTEGER(INTG) :: meshidx,datapointidx,xiidx,interfacemeshdimensions,coupledmeshdimensions
2236  TYPE(interface_type), POINTER :: interface
2237 
2238  enters("InterfacePointsConnectivity_ReducedXiCalculate",err,error,*999)
2239 
2240  IF(ASSOCIATED(interfacepointsconnectivity)) THEN
2241  IF(interfacepointsconnectivity%pointsConnectivityFinished) THEN
2242  CALL flagerror("Interface points connectivity has already been finished.",err,error,*999)
2243  ELSE
2244  interface=>interfacepointsconnectivity%interface
2245  interfacemeshdimensions=interfacepointsconnectivity%interfaceMesh%NUMBER_OF_DIMENSIONS
2246  IF(ASSOCIATED(interface)) THEN
2247  DO meshidx=1,interface%NUMBER_OF_COUPLED_MESHES
2248  coupledmeshdimensions=interface%COUPLED_MESHES(meshidx)%PTR%NUMBER_OF_DIMENSIONS
2249  IF(interfacemeshdimensions==coupledmeshdimensions) THEN !e.g. If 1D-2D, 2D-3D coupling, interface dimension is 1D and 2D respectively for 1st body
2250  DO datapointidx=1,interface%DATA_POINTS%NUMBER_OF_DATA_POINTS
2251  interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%reducedXi(:)= &
2252  & interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%xi(:)
2253  interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%elementLineFaceNumber=1 !The only local face/line for the body with lower dimension
2254  ENDDO !dataPointIdx
2255  ELSE
2256  SELECT CASE(coupledmeshdimensions)
2257  CASE(2)
2258  DO datapointidx=1,interface%DATA_POINTS%NUMBER_OF_DATA_POINTS
2259  DO xiidx=1,coupledmeshdimensions
2260  IF(abs(interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%xi(xiidx)) &
2261  & < zero_tolerance) THEN
2262  interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%elementLineFaceNumber=4-(xiidx-1)*2 !Calculate line number
2263  EXIT
2264  ELSEIF(abs(interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%xi(xiidx)-1.0_dp) &
2265  & < zero_tolerance) THEN
2266  interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%elementLineFaceNumber=3-(xiidx-1)*2 !Calculate line number
2267  EXIT
2268  ENDIF
2269  ENDDO !xiIdx
2270  interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%reducedXi= &
2271  & interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)% &
2272  & xi(other_xi_directions2(xiidx)) !Populate reducedXi
2273  ENDDO !dataPointIdx
2274  CASE(3)
2275  DO datapointidx=1,interface%DATA_POINTS%NUMBER_OF_DATA_POINTS
2276  DO xiidx=1,coupledmeshdimensions
2277  IF(abs(interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%xi(xiidx)) &
2278  & < zero_tolerance) THEN
2279  interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%elementLineFaceNumber=(xiidx-1)*2+2 !Calculate face number
2280  EXIT
2281  ELSE IF(abs(interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%xi(xiidx)-1.0_dp) &
2282  & > zero_tolerance) THEN
2283  interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%elementLineFaceNumber=(xiidx-1)*2+1 !Calculate face number
2284  EXIT
2285  ENDIF
2286  ENDDO !xiIdx
2287  SELECT CASE(xiidx) !Populate reducedXi
2288  CASE(1)
2289  interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%reducedXi(1)= &
2290  & interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%xi(2)
2291  interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%reducedXi(2)= &
2292  & interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%xi(3)
2293  CASE(2)
2294  interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%reducedXi(1)= &
2295  & interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%xi(1)
2296  interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%reducedXi(2)= &
2297  & interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%xi(3)
2298  CASE(3)
2299  interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%reducedXi(1)= &
2300  & interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%xi(1)
2301  interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%reducedXi(2)= &
2302  & interfacepointsconnectivity%pointsConnectivity(datapointidx,meshidx)%xi(2)
2303  END SELECT
2304  ENDDO !dataPointIdx
2305  CASE DEFAULT
2306  ! Do nothing
2307  END SELECT
2308  ENDIF
2309  ENDDO !meshIdx
2310  ELSE
2311  CALL flagerror("Interface is not associated.",err,error,*999)
2312  ENDIF
2313  ENDIF
2314  ELSE
2315  CALL flagerror("Interface points connectivity is not associated.",err,error,*999)
2316  ENDIF
2317 
2318  exits("InterfacePointsConnectivity_ReducedXiCalculate")
2319  RETURN
2320 999 errors("InterfacePointsConnectivity_ReducedXiCalculate",err,error)
2321  exits("InterfacePointsConnectivity_ReducedXiCalculate")
2322  RETURN 1
2323 
2324  END SUBROUTINE interfacepointsconnectivity_reducedxicalculate
2325 
2326  !
2327  !================================================================================================================================
2328  !
2329 
2331  SUBROUTINE interface_user_number_find(USER_NUMBER,PARENT_REGION,INTERFACE,ERR,ERROR,*)
2332 
2333  !Argument variables
2334  INTEGER(INTG), INTENT(IN) :: user_number
2335  TYPE(region_type), POINTER :: parent_region
2336  TYPE(interface_type), POINTER :: interface
2337  INTEGER(INTG), INTENT(OUT) :: err
2338  TYPE(varying_string), INTENT(OUT) :: error
2339  !Local Variables
2340  INTEGER(INTG) :: interface_idx
2341  TYPE(varying_string) :: local_error
2342 
2343  enters("INTERFACE_USER_NUMBER_FIND",err,error,*999)
2344 
2345  IF(ASSOCIATED(parent_region)) THEN
2346  IF(ASSOCIATED(interface)) THEN
2347  CALL flagerror("Interface is already associated.",err,error,*999)
2348  ELSE
2349  NULLIFY(interface)
2350  IF(ASSOCIATED(parent_region%INTERFACES)) THEN
2351  interface_idx=1
2352  DO WHILE(interface_idx<=parent_region%INTERFACES%NUMBER_OF_INTERFACES.AND..NOT.ASSOCIATED(interface))
2353  IF(parent_region%INTERFACES%INTERFACES(interface_idx)%PTR%USER_NUMBER==user_number) THEN
2354  interface=>parent_region%INTERFACES%INTERFACES(interface_idx)%PTR
2355  ELSE
2356  interface_idx=interface_idx+1
2357  ENDIF
2358  ENDDO
2359  ELSE
2360  local_error="The interfaces on parent region number "// &
2361  & trim(number_to_vstring(parent_region%USER_NUMBER,"*",err,error))//" are not associated."
2362  CALL flagerror(local_error,err,error,*999)
2363  ENDIF
2364  ENDIF
2365  ELSE
2366  CALL flagerror("Parent region is not associated.",err,error,*999)
2367  ENDIF
2368 
2369  exits("INTERFACE_USER_NUMBER_FIND")
2370  RETURN
2371 999 errorsexits("INTERFACE_USER_NUMBER_FIND",err,error)
2372  RETURN 1
2373  END SUBROUTINE interface_user_number_find
2374 
2375  !
2376  !================================================================================================================================
2377  !
2378 
2380  SUBROUTINE interfaces_finalise(INTERFACES,ERR,ERROR,*)
2381 
2382  !Argument variables
2383  TYPE(interfaces_type), POINTER :: interfaces
2384  INTEGER(INTG), INTENT(OUT) :: err
2385  TYPE(varying_string), INTENT(OUT) :: error
2386  !Local Variables
2387  TYPE(interface_type), POINTER :: interface
2388 
2389  enters("INTERFACES_FINALISE",err,error,*999)
2390 
2391  IF(ASSOCIATED(interfaces)) THEN
2392  DO WHILE(interfaces%NUMBER_OF_INTERFACES>0)
2393  interface=>interfaces%INTERFACES(1)%PTR
2394  CALL interface_destroy(interface,err,error,*999)
2395  ENDDO
2396  IF(ASSOCIATED(interfaces%INTERFACES)) DEALLOCATE(interfaces%INTERFACES)
2397  DEALLOCATE(interfaces)
2398  ENDIF
2399 
2400  exits("INTERFACES_FINALISE")
2401  RETURN
2402 999 errorsexits("INTERFACES_FINALISE",err,error)
2403  RETURN 1
2404  END SUBROUTINE interfaces_finalise
2405 
2406  !
2407  !================================================================================================================================
2408  !
2409 
2411  SUBROUTINE interfaces_initialise(REGION,ERR,ERROR,*)
2412 
2413  !Argument variables
2414  TYPE(region_type), POINTER :: region
2415  INTEGER(INTG), INTENT(OUT) :: err
2416  TYPE(varying_string), INTENT(OUT) :: error
2417  !Local Variables
2418  TYPE(varying_string) :: local_error
2419 
2420  enters("INTERFACES_INITIALISE",err,error,*998)
2421 
2422  IF(ASSOCIATED(region)) THEN
2423  IF(ASSOCIATED(region%INTERFACES)) THEN
2424  local_error="Region number "//trim(number_to_vstring(region%USER_NUMBER,"*",err,error))// &
2425  & " already has interfaces associated."
2426  CALL flagerror(local_error,err,error,*999)
2427  ELSE
2428  ALLOCATE(region%INTERFACES,stat=err)
2429  IF(err/=0) CALL flagerror("Could not allocate region interfaces.",err,error,*999)
2430  region%INTERFACES%PARENT_REGION=>region
2431  region%INTERFACES%NUMBER_OF_INTERFACES=0
2432  NULLIFY(region%INTERFACES%INTERFACES)
2433  ENDIF
2434  ELSE
2435  CALL flagerror("Region is not associated.",err,error,*999)
2436  ENDIF
2437 
2438  exits("INTERFACES_INITIALISE")
2439  RETURN
2440 999 CALL interfaces_finalise(region%INTERFACES,err,error,*998)
2441 998 errorsexits("INTERFACES_INITIALISE",err,error)
2442  RETURN 1
2443  END SUBROUTINE interfaces_initialise
2444 
2445  !
2446  !================================================================================================================================
2447  !
2448 
2450  SUBROUTINE interfacemeshconnectivity_elementinitialise(INTERFACE,ERR,ERROR,*)
2451 
2452  !Argument variables
2453  TYPE(interface_type), POINTER :: interface
2454  INTEGER(INTG), INTENT(OUT) :: err
2455  TYPE(varying_string), INTENT(OUT) :: error
2456  !Local Variables
2457  INTEGER(INTG) :: interfaceelementidx,coupledmeshidx
2458  TYPE(interface_element_connectivity_type), POINTER :: element_connectivity
2459 
2460  enters("InterfaceMeshConnectivity_ElementInitialise",err,error,*999)
2461 
2462  IF(ASSOCIATED(interface)) THEN
2463  IF(ASSOCIATED(interface%MESH_CONNECTIVITY)) THEN
2464  IF(ALLOCATED(interface%MESH_CONNECTIVITY%ELEMENT_CONNECTIVITY)) THEN
2465  CALL flagerror("Interface mesh element connectivity is already allocated.",err,error,*999)
2466  ELSE
2467  IF(interface%NUMBER_OF_COUPLED_MESHES>0) THEN
2468  IF(interface%MESH_CONNECTIVITY%INTERFACE_MESH%NUMBER_OF_ELEMENTS>0) THEN
2469  interface%MESH_CONNECTIVITY%NUMBER_OF_INTERFACE_ELEMENTS=interface%MESHES%MESHES(1)%PTR%NUMBER_OF_ELEMENTS
2470  interface%MESH_CONNECTIVITY%NUMBER_OF_COUPLED_MESHES=interface%NUMBER_OF_COUPLED_MESHES
2471  ALLOCATE(interface%MESH_CONNECTIVITY%ELEMENT_CONNECTIVITY(interface%MESH_CONNECTIVITY%NUMBER_OF_INTERFACE_ELEMENTS, &
2472  & interface%MESH_CONNECTIVITY%NUMBER_OF_COUPLED_MESHES),stat=err)
2473  IF(err/=0) CALL flagerror("Could not allocate interface element connectivity.",err,error,*999)
2474  DO interfaceelementidx=1,interface%MESH_CONNECTIVITY%NUMBER_OF_INTERFACE_ELEMENTS
2475  DO coupledmeshidx=1,interface%MESH_CONNECTIVITY%NUMBER_OF_COUPLED_MESHES
2476  element_connectivity=>interface%MESH_CONNECTIVITY%ELEMENT_CONNECTIVITY(interfaceelementidx,coupledmeshidx)
2477  element_connectivity%COUPLED_MESH_ELEMENT_NUMBER=0
2478  element_connectivity%CONNECTED_FACE=0
2479  element_connectivity%CONNECTED_LINE=0
2480  ! Note that ELEMENT_CONNECTIVITY%XI(NumberOfCoupledMeshXiDirections,1,NumberOfInterfaceElementNodes) is allocated after the basis for the mesh connectivity has been specified in INTERFACE_MESH_CONNECTIVITY_BASIS_SET where the number of NumberOfInterfaceElementNodes can be determined.
2481  !\todo see corresponding todo in regarding updating the structure of ELEMENT_CONNECTIVITY%XI
2482  ENDDO !CoupledMeshIdx
2483  ENDDO !InterfaceElementIdx
2484  ELSE
2485  CALL flagerror("Interface coupled meshes are not associated.",err,error,*999)
2486  ENDIF
2487  ELSE
2488  CALL flagerror("Interface coupled meshes are not associated.",err,error,*999)
2489  ENDIF
2490  ENDIF
2491  ELSE
2492  CALL flagerror("Interface mesh connectivity is not associated.",err,error,*999)
2493  ENDIF
2494  ELSE
2495  CALL flagerror("Interface is not associated.",err,error,*999)
2496  ENDIF
2497 
2498  exits("InterfaceMeshConnectivity_ElementInitialise")
2499  RETURN
2500 999 errorsexits("InterfaceMeshConnectivity_ElementInitialise",err,error)
2501  RETURN 1
2502 
2503  END SUBROUTINE interfacemeshconnectivity_elementinitialise
2504 
2505  !
2506  !================================================================================================================================
2507  !
2508 
2510  SUBROUTINE interfacemeshconnectivity_elementfinalise(INTERFACE_MESH_CONNECTIVITY,ERR,ERROR,*)
2511 
2512  !Argument variables
2513  TYPE(interface_mesh_connectivity_type) :: interface_mesh_connectivity
2514  INTEGER(INTG), INTENT(OUT) :: err
2515  TYPE(varying_string), INTENT(OUT) :: error
2516  !Local Variables
2517  INTEGER(INTG) :: interfaceelementidx,coupledmeshidx
2518 
2519  enters("InterfaceMeshConnectivity_ElementFinalise",err,error,*999)
2520 
2521  DO interfaceelementidx=1,interface_mesh_connectivity%NUMBER_OF_INTERFACE_ELEMENTS
2522  DO coupledmeshidx=1,interface_mesh_connectivity%NUMBER_OF_COUPLED_MESHES
2523  IF(ALLOCATED(interface_mesh_connectivity%ELEMENT_CONNECTIVITY)) THEN
2524  interface_mesh_connectivity%ELEMENT_CONNECTIVITY(interfaceelementidx,coupledmeshidx)%COUPLED_MESH_ELEMENT_NUMBER=0
2525  IF(ALLOCATED(interface_mesh_connectivity%ELEMENT_CONNECTIVITY(interfaceelementidx,coupledmeshidx)%XI)) THEN
2526  DEALLOCATE(interface_mesh_connectivity%ELEMENT_CONNECTIVITY(interfaceelementidx,coupledmeshidx)%XI)
2527  ENDIF
2528  ELSE
2529  CALL flagerror("Interface mesh connectivity element connectivity is being deallocated before allocation.", &
2530  & err,error,*999)
2531  ENDIF
2532  ENDDO !InterfaceElementIdx
2533  ENDDO !CoupledMeshIdx
2534 
2535  DEALLOCATE(interface_mesh_connectivity%ELEMENT_CONNECTIVITY)
2536 
2537  exits("InterfaceMeshConnectivity_ElementFinalise")
2538  RETURN
2539 999 errorsexits("InterfaceMeshConnectivity_ElementFinalise",err,error)
2540  RETURN 1
2541 
2542  END SUBROUTINE interfacemeshconnectivity_elementfinalise
2543 
2544  !
2545  !================================================================================================================================
2546  !
2547 
2548 END MODULE interface_routines
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Write a string followed by a value to a given output stream.
integer(intg), dimension(2) other_xi_directions2
OTHER_XI_DIRECTIONS2(ni) gives the other xi direction for direction ni for a two dimensional element...
Definition: constants.f90:273
Contains information for a region.
Definition: types.f90:3252
Contains information for interfaces on a parent region.
Definition: types.f90:2254
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
integer(intg), parameter no_part_deriv
No partial derivative i.e., u.
Definition: constants.f90:177
Contains information on the coupling between meshes in an interface.
Definition: types.f90:2193
Contains information on the data points defined on a region.
Definition: types.f90:333
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
subroutine, public dataprojection_datapointsprojectionevaluate(DATA_PROJECTION, PROJECTION_FIELD, ERR, ERROR,)
Evaluates data projection.
Contains information for the interface condition data.
Definition: types.f90:2155
integer(intg), parameter, public list_intg_type
Integer data type for a list.
Definition: lists.f90:67
Contains information for a field defined on a region.
Definition: types.f90:1346
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
subroutine, public list_remove_duplicates(LIST, ERR, ERROR,)
Removes duplicate entries from a list. A side effect of this is that the list is sorted.
Definition: lists.f90:2648
Contains information on a coordinate system.
Definition: types.f90:255
Detaches the list values from a list and returns them as a pointer to a array of base type before des...
Definition: lists.f90:113
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Contains information about a data projection result.
Definition: types.f90:278
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
This module handles all data projection routines.
Write a string to a given output stream.
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
integer(intg), parameter, public general_output_type
General output type.
subroutine, public list_create_finish(LIST, ERR, ERROR,)
Finishes the creation of a list created with LIST_CREATE_START.
Definition: lists.f90:419
Contains information on a list.
Definition: types.f90:113
Contains information on a mesh defined on a region.
Definition: types.f90:503
logical, save, public diagnostics1
.TRUE. if level 1 diagnostic output is active in the current routine
Contains the interpolated value (and the derivatives wrt xi) of a field at a point. Old CMISS name XG.
Definition: types.f90:1129
integer(intg), parameter, public diagnostic_output_type
Diagnostic output type.
Contains information on a data connectivity point.
Definition: types.f90:2204
Contains information on the nodes defined on a region.
Definition: types.f90:359
subroutine, public list_create_start(LIST, ERR, ERROR,)
Starts the creation of a list and returns a pointer to the created list.
Definition: lists.f90:486
A buffer type to allow for an array of pointers to a INTERFACE_TYPE.
Definition: types.f90:2249
Contains information on the data point coupling/points connectivity between meshes in the an interfac...
Definition: types.f90:2218
Contains information on the mesh connectivity for a given coupled mesh element.
Definition: types.f90:2185
A buffer type to allow for an array of pointers to a MESH_TYPE.
Definition: types.f90:524
Adds an item to the end of a list.
Definition: lists.f90:133
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
Contains information for the interface data.
Definition: types.f90:2228
Implements lists of base types.
Definition: lists.f90:46
subroutine, public list_data_type_set(LIST, DATA_TYPE, ERR, ERROR,)
Sets/changes the data type for a list.
Definition: lists.f90:579
Contains all information about a basis .
Definition: types.f90:184
Flags an error condition.
subroutine, public list_initial_size_set(LIST, INITIAL_SIZE, ERR, ERROR,)
Sets/changes the initial size for a list.
Definition: lists.f90:863
real(dp), parameter zero_tolerance
Definition: constants.f90:70
This module contains all kind definitions.
Definition: kinds.f90:45
This module handles all formating and input and output.