OpenCMISS-Iron Internal API Documentation
generated_mesh_routines.f90
Go to the documentation of this file.
1 
43 
45 MODULE generated_mesh_routines
46 
47  USE base_routines
48  USE basis_routines
49  USE comp_environment
50  USE constants
51  USE coordinate_routines
52  USE field_routines
53  USE input_output
54  USE iso_varying_string
55  USE kinds
56  USE maths
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 
74  INTEGER(INTG), PARAMETER :: generated_mesh_regular_mesh_type=1
75  INTEGER(INTG), PARAMETER :: generated_mesh_polar_mesh_type=2
76  INTEGER(INTG), PARAMETER :: generated_mesh_fractal_tree_mesh_type=3
77  INTEGER(INTG), PARAMETER :: generated_mesh_cylinder_mesh_type=4
78  INTEGER(INTG), PARAMETER :: generated_mesh_ellipsoid_mesh_type=5
80 
84  INTEGER(INTG), PARAMETER :: generated_mesh_cylinder_inner_surface=1
85  INTEGER(INTG), PARAMETER :: generated_mesh_cylinder_outer_surface=2
86  INTEGER(INTG), PARAMETER :: generated_mesh_cylinder_top_surface=3
87  INTEGER(INTG), PARAMETER :: generated_mesh_cylinder_bottom_surface=4
89 
93  INTEGER(INTG), PARAMETER :: generated_mesh_ellipsoid_inner_surface=5
94  INTEGER(INTG), PARAMETER :: generated_mesh_ellipsoid_outer_surface=6
95  INTEGER(INTG), PARAMETER :: generated_mesh_ellipsoid_top_surface=7
97 
101  INTEGER(INTG), PARAMETER :: generated_mesh_regular_left_surface=8
102  INTEGER(INTG), PARAMETER :: generated_mesh_regular_right_surface=9
103  INTEGER(INTG), PARAMETER :: generated_mesh_regular_top_surface=10
104  INTEGER(INTG), PARAMETER :: generated_mesh_regular_bottom_surface=11
105  INTEGER(INTG), PARAMETER :: generated_mesh_regular_front_surface=12
106  INTEGER(INTG), PARAMETER :: generated_mesh_regular_back_surface=13
108 
109  !Module types
110 
111  !Interfaces
112 
114  INTERFACE generated_mesh_create_start
115  MODULE PROCEDURE generated_mesh_create_start_interface
116  MODULE PROCEDURE generated_mesh_create_start_region
117  END INTERFACE !GENERATED_MESH_CREATE_START
118 
120  INTERFACE generated_meshes_initialise
121  MODULE PROCEDURE generated_meshes_initialise_interface
122  MODULE PROCEDURE generated_meshes_initialise_region
123  END INTERFACE !GENERATED_MESHES_INITIALISE
124 
126  INTERFACE generated_mesh_user_number_find
127  MODULE PROCEDURE generated_mesh_user_number_find_interface
128  MODULE PROCEDURE generated_mesh_user_number_find_region
129  END INTERFACE generated_mesh_user_number_find
130 
131  PUBLIC generated_mesh_regular_mesh_type,generated_mesh_polar_mesh_type
132  PUBLIC generated_mesh_fractal_tree_mesh_type,generated_mesh_cylinder_mesh_type
133  PUBLIC generated_mesh_ellipsoid_mesh_type
134  PUBLIC generated_mesh_cylinder_inner_surface,generated_mesh_cylinder_outer_surface
135  PUBLIC generated_mesh_cylinder_top_surface,generated_mesh_cylinder_bottom_surface
136  PUBLIC generated_mesh_ellipsoid_inner_surface,generated_mesh_ellipsoid_outer_surface
137  PUBLIC generated_mesh_ellipsoid_top_surface
138  PUBLIC generated_mesh_regular_left_surface,generated_mesh_regular_right_surface
139  PUBLIC generated_mesh_regular_top_surface,generated_mesh_regular_bottom_surface
140  PUBLIC generated_mesh_regular_front_surface,generated_mesh_regular_back_surface
141  PUBLIC generated_meshes_initialise,generated_meshes_finalise
142 
143  PUBLIC generated_mesh_base_vectors_set
144 
145  PUBLIC generated_mesh_coordinate_system_get
146 
147  PUBLIC generated_mesh_create_start,generated_mesh_create_finish
148 
149  PUBLIC generated_mesh_destroy
150 
151  PUBLIC generated_mesh_basis_set,generated_mesh_extent_set,generated_mesh_number_of_elements_set,generated_mesh_origin_set, &
152  & generated_mesh_type_set,generatedmesh_geometricparameterscalculate
153 
154  PUBLIC generated_mesh_basis_get,generated_mesh_extent_get,generated_mesh_number_of_elements_get,generated_mesh_origin_get,&
155  & generated_mesh_type_get
156 
157  PUBLIC generated_mesh_region_get
158 
159  PUBLIC generated_mesh_user_number_find
160  PUBLIC generated_mesh_surface_get
161 
162 CONTAINS
163 
164  !
165  !================================================================================================================================
166  !
167 
169  SUBROUTINE generated_mesh_basis_get(GENERATED_MESH,BASES,ERR,ERROR,*)
170 
171  !Argument variables
172  TYPE(generated_mesh_type), POINTER :: generated_mesh
173  TYPE(basis_ptr_type), POINTER :: bases(:)
174  INTEGER(INTG), INTENT(OUT) :: err
175  TYPE(varying_string), INTENT(OUT) :: error
176  !Local Variables
177  TYPE(varying_string) :: local_error
178  INTEGER(INTG) :: basis_idx,num_bases
179 
180  enters("GENERATED_MESH_BASIS_GET",err,error,*999)
181 
182  IF(ASSOCIATED(generated_mesh)) THEN
183  IF(generated_mesh%GENERATED_MESH_FINISHED) THEN
184  SELECT CASE(generated_mesh%GENERATED_TYPE)
185  CASE(generated_mesh_regular_mesh_type)
186  IF(ASSOCIATED(generated_mesh%REGULAR_MESH)) THEN
187  IF(ALLOCATED(generated_mesh%REGULAR_MESH%BASES)) THEN
188  num_bases=SIZE(generated_mesh%REGULAR_MESH%BASES)
189  ALLOCATE(bases(num_bases),stat=err)
190  IF(err/=0) CALL flagerror("Could not allocate bases.",err,error,*999)
191  DO basis_idx=1,num_bases
192  bases(basis_idx)%PTR=>generated_mesh%REGULAR_MESH%BASES(basis_idx)%PTR
193  ENDDO
194  ELSE
195  CALL flagerror("Generated mesh bases are not allocated.",err,error,*999)
196  ENDIF
197  ELSE
198  CALL flagerror("Generated mesh regular mesh is not associated.",err,error,*999)
199  ENDIF
200  CASE(generated_mesh_polar_mesh_type)
201  CALL flagerror("Not implemented.",err,error,*999)
202  CASE(generated_mesh_fractal_tree_mesh_type)
203  CALL flagerror("Not implemented.",err,error,*999)
204  CASE(generated_mesh_cylinder_mesh_type)
205  IF(ASSOCIATED(generated_mesh%CYLINDER_MESH)) THEN
206  IF(ALLOCATED(generated_mesh%REGULAR_MESH%BASES)) THEN
207  num_bases=SIZE(generated_mesh%CYLINDER_MESH%BASES)
208  ALLOCATE(bases(num_bases),stat=err)
209  IF(err/=0) CALL flagerror("Could not allocate bases.",err,error,*999)
210  DO basis_idx=1,num_bases
211  bases(basis_idx)%PTR=>generated_mesh%CYLINDER_MESH%BASES(basis_idx)%PTR
212  ENDDO
213  ELSE
214  CALL flagerror("Generated mesh bases are not allocated.",err,error,*999)
215  ENDIF
216  ELSE
217  CALL flagerror("Generated mesh cylinder mesh is not associated.",err,error,*999)
218  ENDIF
219  CASE(generated_mesh_ellipsoid_mesh_type)
220  IF(ASSOCIATED(generated_mesh%ELLIPSOID_MESH)) THEN
221  IF(ALLOCATED(generated_mesh%REGULAR_MESH%BASES)) THEN
222  num_bases=SIZE(generated_mesh%ELLIPSOID_MESH%BASES)
223  ALLOCATE(bases(num_bases),stat=err)
224  IF(err/=0) CALL flagerror("Could not allocate bases.",err,error,*999)
225  DO basis_idx=1,num_bases
226  bases(basis_idx)%PTR=>generated_mesh%ELLIPSOID_MESH%BASES(basis_idx)%PTR
227  ENDDO
228  ELSE
229  CALL flagerror("Generated mesh bases are not allocated.",err,error,*999)
230  ENDIF
231  ELSE
232  CALL flagerror("Generated mesh ellipsoid mesh is not associated.",err,error,*999)
233  ENDIF
234  CASE DEFAULT
235  local_error="The generated mesh generated type of "// &
236  & trim(number_to_vstring(generated_mesh%GENERATED_TYPE,"*",err,error))//" is invalid."
237  CALL flagerror(local_error,err,error,*999)
238  END SELECT
239  ELSE
240  CALL flagerror("Generated mesh has not been finished.",err,error,*999)
241  ENDIF
242  ELSE
243  CALL flagerror("Generated mesh is already associated.",err,error,*999)
244  ENDIF
245 
246  exits("GENERATED_MESH_BASIS_GET")
247  RETURN
248 999 errorsexits("GENERATED_MESH_BASIS_GET",err,error)
249  RETURN 1
250  END SUBROUTINE generated_mesh_basis_get
251 
252  !
253  !================================================================================================================================
254  !
255 
257  SUBROUTINE generated_mesh_basis_set(GENERATED_MESH,BASES,ERR,ERROR,*)
258 
259  !Argument variables
260  TYPE(generated_mesh_type), POINTER :: generated_mesh
261  TYPE(basis_ptr_type) :: bases(:)
262  INTEGER(INTG), INTENT(OUT) :: err
263  TYPE(varying_string), INTENT(OUT) :: error
264  !Local Variables
265  INTEGER(INTG) :: coordinate_dimension,basis_idx, num_bases, num_xi, basis_type
266  TYPE(coordinate_system_type), POINTER :: coordinate_system
267  TYPE(varying_string) :: local_error
268 
269  enters("GENERATED_MESH_BASIS_SET",err,error,*999)
270 
271  IF(ASSOCIATED(generated_mesh)) THEN
272  IF(generated_mesh%GENERATED_MESH_FINISHED) THEN
273  CALL flagerror("Generated mesh has been finished.",err,error,*999)
274  ELSE
275  NULLIFY(coordinate_system)
276  CALL generated_mesh_coordinate_system_get(generated_mesh,coordinate_system,err,error,*999)
277  CALL coordinate_system_dimension_get(coordinate_system,coordinate_dimension,err,error,*999)
278  num_bases=SIZE(bases)
279  num_xi=bases(1)%PTR%NUMBER_OF_XI
280  basis_type=bases(1)%PTR%TYPE
281  DO basis_idx=2,num_bases
282  IF(bases(basis_idx)%PTR%NUMBER_OF_XI /= num_xi) THEN
283  CALL flagerror("All bases must have the same number of xi.",err,error,*999)
284  ENDIF
285  IF(bases(basis_idx)%PTR%TYPE /= basis_type) THEN
286  CALL flagerror("Using different basis types is not supported for generated meshes.",err,error,*999)
287  ENDIF
288  ENDDO
289  SELECT CASE(generated_mesh%GENERATED_TYPE)
290  CASE(generated_mesh_regular_mesh_type)
291  IF(ASSOCIATED(generated_mesh%REGULAR_MESH)) THEN
292  IF(ALLOCATED(generated_mesh%REGULAR_MESH%BASE_VECTORS)) THEN
293  CALL flagerror("Can not reset the basis if base vectors have been specified.",err,error,*999)
294  ELSE
295  IF(ALLOCATED(generated_mesh%REGULAR_MESH%BASES)) DEALLOCATE(generated_mesh%REGULAR_MESH%BASES)
296  ALLOCATE(generated_mesh%REGULAR_MESH%BASES(num_bases),stat=err)
297  IF(err/=0) CALL flagerror("Could not allocate bases.",err,error,*999)
298  DO basis_idx=1,num_bases
299  IF(ASSOCIATED(bases(basis_idx)%PTR)) THEN
300  IF(bases(basis_idx)%PTR%NUMBER_OF_XI<=coordinate_dimension) THEN
301  generated_mesh%REGULAR_MESH%BASES(basis_idx)%PTR=>bases(basis_idx)%PTR
302  ELSE
303  local_error="The basis number of xi dimensions of "// &
304  & trim(number_to_vstring(bases(basis_idx)%PTR%NUMBER_OF_XI,"*",err,error))// &
305  & " is invalid. The number of xi dimensions must be <= the number of coordinate dimensions of "// &
306  & trim(number_to_vstring(coordinate_dimension,"*",err,error))
307  CALL flagerror(local_error,err,error,*999)
308  ENDIF
309  ELSE
310  local_error="The basis with index "//trim(number_to_vstring(basis_idx,"*",err,error))// &
311  & " is not associated."
312  CALL flagerror(local_error,err,error,*999)
313  ENDIF
314  ENDDO
315  ENDIF
316  ELSE
317  CALL flagerror("Regular generated mesh is not associated.",err,error,*999)
318  ENDIF
319  CASE(generated_mesh_polar_mesh_type)
320  CALL flagerror("Not implemented.",err,error,*999)
321  CASE(generated_mesh_fractal_tree_mesh_type)
322  CALL flagerror("Not implemented.",err,error,*999)
323  CASE(generated_mesh_cylinder_mesh_type)
324  IF(ASSOCIATED(generated_mesh%CYLINDER_MESH)) THEN
325  IF(ALLOCATED(generated_mesh%CYLINDER_MESH%BASES)) DEALLOCATE(generated_mesh%CYLINDER_MESH%BASES)
326  ALLOCATE(generated_mesh%CYLINDER_MESH%BASES(num_bases),stat=err)
327  IF(err/=0) CALL flagerror("Could not allocate bases.",err,error,*999)
328  DO basis_idx=1,num_bases
329  IF(ASSOCIATED(bases(basis_idx)%PTR)) THEN
330  generated_mesh%CYLINDER_MESH%BASES(basis_idx)%PTR=>bases(basis_idx)%PTR
331  ELSE
332  local_error="The basis with index "//trim(number_to_vstring(basis_idx,"*",err,error))// &
333  & " is not associated."
334  CALL flagerror(local_error,err,error,*999)
335  ENDIF
336  ENDDO
337  ELSE
338  CALL flagerror("Cylinder generated mesh is not associated.",err,error,*999)
339  ENDIF
340  CASE(generated_mesh_ellipsoid_mesh_type)
341  IF(ASSOCIATED(generated_mesh%ELLIPSOID_MESH)) THEN
342  IF(ALLOCATED(generated_mesh%ELLIPSOID_MESH%BASES)) DEALLOCATE(generated_mesh%ELLIPSOID_MESH%BASES)
343  ALLOCATE(generated_mesh%ELLIPSOID_MESH%BASES(num_bases),stat=err)
344  IF(err/=0) CALL flagerror("Could not allocate bases.",err,error,*999)
345  DO basis_idx=1,num_bases
346  IF(ASSOCIATED(bases(basis_idx)%PTR)) THEN
347  generated_mesh%ELLIPSOID_MESH%BASES(basis_idx)%PTR=>bases(basis_idx)%PTR
348  ELSE
349  local_error="The basis with index "//trim(number_to_vstring(basis_idx,"*",err,error))// &
350  & " is not associated."
351  CALL flagerror(local_error,err,error,*999)
352  ENDIF
353  ENDDO
354  ELSE
355  CALL flagerror("Ellpsoid generated mesh is not associated.",err,error,*999)
356  ENDIF
357  CASE DEFAULT
358  local_error="The generated mesh type of "//trim(number_to_vstring(generated_mesh%GENERATED_TYPE,"*",err,error))// &
359  & " is invalid."
360  CALL flagerror(local_error,err,error,*999)
361  END SELECT
362  ENDIF
363  ELSE
364  CALL flagerror("Generated mesh is already associated.",err,error,*999)
365  ENDIF
366 
367  exits("GENERATED_MESH_BASIS_SET")
368  RETURN
369 999 errorsexits("GENERATED_MESH_BASIS_SET",err,error)
370  RETURN 1
371  END SUBROUTINE generated_mesh_basis_set
372 
373  !
374  !================================================================================================================================
375  !
376 
378  SUBROUTINE generated_mesh_base_vectors_set(GENERATED_MESH,BASE_VECTORS,ERR,ERROR,*)
379 
380  !Argument variables
381  TYPE(generated_mesh_type), POINTER :: generated_mesh
382  REAL(DP), INTENT(IN) :: base_vectors(:,:)
383  INTEGER(INTG), INTENT(OUT) :: err
384  TYPE(varying_string), INTENT(OUT) :: error
385  !Local Variables
386  INTEGER(INTG) :: coordinate_dimension
387  TYPE(basis_type), POINTER :: basis
388  TYPE(basis_ptr_type), POINTER :: bases(:)
389  TYPE(coordinate_system_type), POINTER :: coordinate_system
390  TYPE(varying_string) :: local_error
391 
392  enters("GENERATED_MESH_BASE_VECTORS_SET",err,error,*999)
393 
394  IF(ASSOCIATED(generated_mesh)) THEN
395  IF(generated_mesh%GENERATED_MESH_FINISHED) THEN
396  CALL flagerror("Generated mesh has been finished.",err,error,*999)
397  ELSE
398  NULLIFY(coordinate_system)
399  CALL generated_mesh_coordinate_system_get(generated_mesh,coordinate_system,err,error,*999)
400  CALL coordinate_system_dimension_get(coordinate_system,coordinate_dimension,err,error,*999)
401  IF(SIZE(base_vectors,1)==coordinate_dimension) THEN
402  SELECT CASE(generated_mesh%GENERATED_TYPE)
403  CASE(generated_mesh_regular_mesh_type)
404  IF(ASSOCIATED(generated_mesh%REGULAR_MESH)) THEN
405  bases=>generated_mesh%REGULAR_MESH%BASES
406  IF(ASSOCIATED(bases)) THEN
407  basis=>bases(1)%PTR !Bases should all have same number of xi
408  IF(ASSOCIATED(basis)) THEN
409  IF(SIZE(base_vectors,2)==basis%NUMBER_OF_XI) THEN
410  IF(ALLOCATED(generated_mesh%REGULAR_MESH%BASE_VECTORS)) DEALLOCATE(generated_mesh%REGULAR_MESH%BASE_VECTORS)
411  ALLOCATE(generated_mesh%REGULAR_MESH%BASE_VECTORS(SIZE(base_vectors,1),SIZE(base_vectors,2)),stat=err)
412  IF(err/=0) CALL flagerror("Could not allocate base vectors.",err,error,*999)
413  generated_mesh%REGULAR_MESH%BASE_VECTORS=base_vectors
414  ELSE
415  local_error="The size of the second dimension of base vectors of "// &
416  & trim(number_to_vstring(SIZE(base_vectors,2),"*",err,error))// &
417  & " is invalid. The second dimension size must match the number of mesh dimensions of "// &
418  & trim(number_to_vstring(basis%NUMBER_OF_XI,"*",err,error))//"."
419  CALL flagerror(local_error,err,error,*999)
420  ENDIF
421  ELSE
422  CALL flagerror("Bases are not associated.",err,error,*999)
423  ENDIF
424  ELSE
425  CALL flagerror("You must set the generated mesh basis before setting base vectors.",err,error,*999)
426  ENDIF
427  ELSE
428  CALL flagerror("Regular generated mesh is not associated.",err,error,*999)
429  ENDIF
430  CASE(generated_mesh_polar_mesh_type)
431  CALL flagerror("Not implemented.",err,error,*999)
432  CASE(generated_mesh_fractal_tree_mesh_type)
433  CALL flagerror("Not implemented.",err,error,*999)
434  CASE(generated_mesh_cylinder_mesh_type)
435  CALL flagerror("Not implemented.",err,error,*999)
436  CASE DEFAULT
437  local_error="The generated mesh mesh type of "//trim(number_to_vstring(generated_mesh%GENERATED_TYPE,"*",err,error))// &
438  & " is invalid."
439  CALL flagerror(local_error,err,error,*999)
440  END SELECT
441  ELSE
442  local_error="The size of the first dimension of base vectors of "// &
443  & trim(number_to_vstring(SIZE(base_vectors,1),"*",err,error))// &
444  & " is invalid. The first dimension size must match the coordinate system dimension of "// &
445  & trim(number_to_vstring(coordinate_dimension,"*",err,error))//"."
446  CALL flagerror(local_error,err,error,*999)
447  ENDIF
448  ENDIF
449  ELSE
450  CALL flagerror("Generated mesh is not associated.",err,error,*999)
451  ENDIF
452 
453  exits("GENERATED_MESH_BASE_VECTORS_SET")
454  RETURN
455 999 errorsexits("GENERATED_MESH_BASE_VECTORS_SET",err,error)
456  RETURN 1
457  END SUBROUTINE generated_mesh_base_vectors_set
458 
459  !
460  !================================================================================================================================
461  !
462 
464  SUBROUTINE generated_mesh_coordinate_system_get(GENERATED_MESH,COORDINATE_SYSTEM,ERR,ERROR,*)
465 
466  !Argument variables
467  TYPE(generated_mesh_type), POINTER :: generated_mesh
468  TYPE(coordinate_system_type), POINTER :: coordinate_system
469  INTEGER(INTG), INTENT(OUT) :: err
470  TYPE(varying_string), INTENT(OUT) :: error
471  !Local Variables
472  TYPE(interface_type), POINTER :: interface
473  TYPE(region_type), POINTER :: region
474  TYPE(varying_string) :: local_error
475 
476  enters("GENERATED_MESH_COORDINATE_SYSTEM_GET",err,error,*999)
477 
478  IF(ASSOCIATED(generated_mesh)) THEN
479  IF(ASSOCIATED(coordinate_system)) THEN
480  CALL flagerror("Coordinate system is already associated.",err,error,*999)
481  ELSE
482  NULLIFY(coordinate_system)
483  region=>generated_mesh%REGION
484  IF(ASSOCIATED(region)) THEN
485  coordinate_system=>region%COORDINATE_SYSTEM
486  IF(.NOT.ASSOCIATED(coordinate_system)) THEN
487  local_error="The coordinate system is not associated for generated mesh number "// &
488  & trim(number_to_vstring(generated_mesh%USER_NUMBER,"*",err,error))//" of region number "// &
489  & trim(number_to_vstring(region%USER_NUMBER,"*",err,error))//"."
490  CALL flagerror(local_error,err,error,*999)
491  ENDIF
492  ELSE
493  NULLIFY(interface)
494  interface=>generated_mesh%INTERFACE
495  IF(ASSOCIATED(interface)) THEN
496  coordinate_system=>interface%COORDINATE_SYSTEM
497  IF(.NOT.ASSOCIATED(coordinate_system)) THEN
498  local_error="The coordinate system is not associated for generated mesh number "// &
499  & trim(number_to_vstring(generated_mesh%USER_NUMBER,"*",err,error))//" of interface number "// &
500  & trim(number_to_vstring(interface%USER_NUMBER,"*",err,error))//"."
501  CALL flagerror(local_error,err,error,*999)
502  ENDIF
503  ELSE
504  local_error="The interface is not associated for generated mesh number "// &
505  & trim(number_to_vstring(generated_mesh%USER_NUMBER,"*",err,error))//"."
506  CALL flagerror(local_error,err,error,*999)
507  ENDIF
508  ENDIF
509  ENDIF
510  ELSE
511  CALL flagerror("Generated mesh is not associated.",err,error,*999)
512  ENDIF
513 
514  exits("GENERATED_MESH_COORDINATE_SYSTEM_GET")
515  RETURN
516 999 errorsexits("GENERATED_MESH_COORDINATE_SYSTEM_GET",err,error)
517  RETURN 1
518  END SUBROUTINE generated_mesh_coordinate_system_get
519 
520  !
521  !================================================================================================================================
522  !
523 
525  SUBROUTINE generated_mesh_create_finish(GENERATED_MESH,MESH_USER_NUMBER,MESH,ERR,ERROR,*)
526 
527  !Argument variables
528  TYPE(generated_mesh_type), POINTER :: generated_mesh
529  INTEGER(INTG), INTENT(IN) :: mesh_user_number
530  TYPE(mesh_type), POINTER :: mesh
531  INTEGER(INTG), INTENT(OUT) :: err
532  TYPE(varying_string), INTENT(OUT) :: error
533  !Local Variables
534  TYPE(varying_string) :: local_error
535 
536  enters("GENERATED_MESH_CREATE_FINISH",err,error,*999)
537 
538  IF(ASSOCIATED(generated_mesh)) THEN
539  IF(generated_mesh%GENERATED_MESH_FINISHED) THEN
540  CALL flagerror("Generated mesh has already been finished.",err,error,*999)
541  ELSE
542  IF(ASSOCIATED(mesh)) THEN
543  CALL flagerror("Mesh is already associated.",err,error,*999)
544  ELSE
545  SELECT CASE(generated_mesh%GENERATED_TYPE)
546  CASE(generated_mesh_regular_mesh_type)
547  CALL generated_mesh_regular_create_finish(generated_mesh,mesh_user_number,err,error,*999)
548  CASE(generated_mesh_cylinder_mesh_type)
549  CALL generated_mesh_cylinder_create_finish(generated_mesh,mesh_user_number,err,error,*999)
550  CASE(generated_mesh_ellipsoid_mesh_type)
551  CALL generated_mesh_ellipsoid_create_finish(generated_mesh,mesh_user_number,err,error,*999)
552  CASE(generated_mesh_polar_mesh_type)
553  CALL flagerror("Not implmented.",err,error,*999)
554  CASE(generated_mesh_fractal_tree_mesh_type)
555  CALL flagerror("Not implemented.",err,error,*999)
556  CASE DEFAULT
557  local_error="The generated mesh mesh type of "// &
558  & trim(number_to_vstring(generated_mesh%GENERATED_TYPE,"*",err,error))//" is invalid."
559  CALL flagerror(local_error,err,error,*999)
560  END SELECT
561  !Return the pointers
562  mesh=>generated_mesh%MESH
563  mesh%GENERATED_MESH=>generated_mesh
564  generated_mesh%GENERATED_MESH_FINISHED=.true.
565  ENDIF
566  ENDIF
567  ELSE
568  CALL flagerror("Generated mesh is not associated.",err,error,*999)
569  ENDIF
570 
571  exits("GENERATED_MESH_CREATE_FINISH")
572  RETURN
573 999 errorsexits("GENERATED_MESH_CREATE_FINISH",err,error)
574  RETURN 1
575  END SUBROUTINE generated_mesh_create_finish
576 
577  !
578  !================================================================================================================================
579  !
580 
582  SUBROUTINE generated_mesh_create_start_generic(GENERATED_MESHES,USER_NUMBER,GENERATED_MESH,ERR,ERROR,*)
583 
584  !Argument variables
585  TYPE(generated_meshes_type), POINTER :: generated_meshes
586  INTEGER(INTG), INTENT(IN) :: user_number
587  TYPE(generated_mesh_type), POINTER :: generated_mesh
588  INTEGER(INTG), INTENT(OUT) :: err
589  TYPE(varying_string), INTENT(OUT) :: error
590  !Local Variables
591  INTEGER(INTG) :: dummy_err,generated_mesh_idx
592  TYPE(generated_mesh_type), POINTER :: new_generated_mesh
593  TYPE(generated_mesh_ptr_type), POINTER :: new_generated_meshes(:)
594  TYPE(varying_string) :: dummy_error
595 
596  NULLIFY(new_generated_mesh)
597  NULLIFY(new_generated_meshes)
598 
599  enters("GENERATED_MESH_CREATE_START_GENERIC",err,error,*997)
600 
601  IF(ASSOCIATED(generated_meshes)) THEN
602  IF(ASSOCIATED(generated_mesh)) THEN
603  CALL flagerror("Generated mesh is already associated.",err,error,*997)
604  ELSE
605  !Initialise generated mesh
606  CALL generated_mesh_initialise(new_generated_mesh,err,error,*999)
607  !Set default generated mesh values
608  new_generated_mesh%USER_NUMBER=user_number
609  new_generated_mesh%GLOBAL_NUMBER=generated_meshes%NUMBER_OF_GENERATED_MESHES+1
610  new_generated_mesh%GENERATED_MESHES=>generated_meshes
611  !Add new generated mesh into list of generated meshes
612  ALLOCATE(new_generated_meshes(generated_meshes%NUMBER_OF_GENERATED_MESHES+1),stat=err)
613  IF(err/=0) CALL flagerror("Could not allocate new generated meshes.",err,error,*999)
614  DO generated_mesh_idx=1,generated_meshes%NUMBER_OF_GENERATED_MESHES
615  new_generated_meshes(generated_mesh_idx)%PTR=>generated_meshes%GENERATED_MESHES(generated_mesh_idx)%PTR
616  ENDDO !generated_mesh_idx
617  new_generated_meshes(generated_meshes%NUMBER_OF_GENERATED_MESHES+1)%PTR=>new_generated_mesh
618  IF(ASSOCIATED(generated_meshes%GENERATED_MESHES)) DEALLOCATE(generated_meshes%GENERATED_MESHES)
619  generated_meshes%GENERATED_MESHES=>new_generated_meshes
620  generated_meshes%NUMBER_OF_GENERATED_MESHES=generated_meshes%NUMBER_OF_GENERATED_MESHES+1
621  !Return the pointer
622  generated_mesh=>new_generated_mesh
623  ENDIF
624  ELSE
625  CALL flagerror("Generated meshes is not associated.",err,error,*997)
626  ENDIF
627 
628  exits("GENERATED_MESH_CREATE_START_GENERIC")
629  RETURN
630 999 CALL generated_mesh_finalise(new_generated_mesh,dummy_err,dummy_error,*998)
631 998 IF(ASSOCIATED(new_generated_meshes)) DEALLOCATE(new_generated_meshes)
632  NULLIFY(generated_mesh)
633 997 errorsexits("GENERATED_MESH_CREATE_START_GENERIC",err,error)
634  RETURN 1
635 
636  END SUBROUTINE generated_mesh_create_start_generic
637 
638  !
639  !================================================================================================================================
640  !
641 
643  SUBROUTINE generated_mesh_create_start_interface(USER_NUMBER,INTERFACE,GENERATED_MESH,ERR,ERROR,*)
644 
645  !Argument variables
646  INTEGER(INTG), INTENT(IN) :: user_number
647  TYPE(interface_type), POINTER :: interface
648  TYPE(generated_mesh_type), POINTER :: generated_mesh
649  INTEGER(INTG), INTENT(OUT) :: err
650  TYPE(varying_string), INTENT(OUT) :: error
651  !Local Variables
652  TYPE(varying_string) :: local_error
653 
654  enters("GENERATED_MESH_CREATE_START_INTERFACE",err,error,*999)
655 
656  IF(ASSOCIATED(interface)) THEN
657  IF(ASSOCIATED(generated_mesh)) THEN
658  CALL flagerror("Generated mesh is already associated.",err,error,*999)
659  ELSE
660  NULLIFY(generated_mesh)
661  CALL generated_mesh_user_number_find(user_number,interface,generated_mesh,err,error,*999)
662  IF(ASSOCIATED(generated_mesh)) THEN
663  local_error="The specified user number of "//trim(number_to_vstring(user_number,"*",err,error))// &
664  & " has already been used for a generated mesh."
665  CALL flagerror(local_error,err,error,*999)
666  ELSE
667  IF(ASSOCIATED(interface%GENERATED_MESHES)) THEN
668  CALL generated_mesh_create_start_generic(interface%GENERATED_MESHES,user_number,generated_mesh,err,error,*999)
669  generated_mesh%INTERFACE=>INTERFACE
670  ELSE
671  CALL flagerror("Interface generated meshes is not associated.",err,error,*999)
672  ENDIF
673  ENDIF
674  ENDIF
675  ELSE
676  CALL flagerror("Interface is not associated.",err,error,*999)
677  ENDIF
678 
679  exits("GENERATED_MESH_CREATE_START_INTERFACE")
680  RETURN
681 999 errorsexits("GENERATED_MESH_CREATE_START_INTERFACE",err,error)
682  RETURN 1
683  END SUBROUTINE generated_mesh_create_start_interface
684 
685  !
686  !================================================================================================================================
687  !
688 
690  SUBROUTINE generated_mesh_create_start_region(USER_NUMBER,REGION,GENERATED_MESH,ERR,ERROR,*)
691 
692  !Argument variables
693  INTEGER(INTG), INTENT(IN) :: user_number
694  TYPE(region_type), POINTER :: region
695  TYPE(generated_mesh_type), POINTER :: generated_mesh
696  INTEGER(INTG), INTENT(OUT) :: err
697  TYPE(varying_string), INTENT(OUT) :: error
698  !Local Variables
699  TYPE(varying_string) :: local_error
700 
701  enters("GENERATED_MESH_CREATE_START_REGION",err,error,*999)
702 
703  IF(ASSOCIATED(region)) THEN
704  IF(ASSOCIATED(generated_mesh)) THEN
705  CALL flagerror("Generated mesh is already associated.",err,error,*999)
706  ELSE
707  NULLIFY(generated_mesh)
708  CALL generated_mesh_user_number_find(user_number,region,generated_mesh,err,error,*999)
709  IF(ASSOCIATED(generated_mesh)) THEN
710  local_error="The specified user number of "//trim(number_to_vstring(user_number,"*",err,error))// &
711  & " has already been used for a generated mesh."
712  CALL flagerror(local_error,err,error,*999)
713  ELSE
714  IF(ASSOCIATED(region%GENERATED_MESHES)) THEN
715  CALL generated_mesh_create_start_generic(region%GENERATED_MESHES,user_number,generated_mesh,err,error,*999)
716  generated_mesh%REGION=>region
717  ELSE
718  CALL flagerror("Region generated meshes is not associated.",err,error,*999)
719  ENDIF
720  ENDIF
721  ENDIF
722  ELSE
723  CALL flagerror("Region is not associated.",err,error,*999)
724  ENDIF
725 
726  exits("GENERATED_MESH_CREATE_START_REGION")
727  RETURN
728 999 errorsexits("GENERATED_MESH_CREATE_START_REGION",err,error)
729  RETURN 1
730  END SUBROUTINE generated_mesh_create_start_region
731 
732  !
733  !================================================================================================================================
734  !
735 
737  SUBROUTINE generated_mesh_destroy(GENERATED_MESH,ERR,ERROR,*)
738 
739  !Argument variables
740  TYPE(generated_mesh_type), POINTER :: generated_mesh
741  INTEGER(INTG), INTENT(OUT) :: err
742  TYPE(varying_string), INTENT(OUT) :: error
743  !Local Variables
744  INTEGER(INTG) :: generated_mesh_idx,generated_mesh_position
745  TYPE(generated_mesh_ptr_type), POINTER :: new_generated_meshes(:)
746  TYPE(generated_meshes_type), POINTER :: generated_meshes
747 
748  enters("GENERATED_MESH_DESTROY",err,error,*998)
749 
750  IF(ASSOCIATED(generated_mesh)) THEN
751  generated_meshes=>generated_mesh%GENERATED_MESHES
752  IF(ASSOCIATED(generated_meshes)) THEN
753  IF(ASSOCIATED(generated_meshes%GENERATED_MESHES)) THEN
754  generated_mesh_position=generated_mesh%GLOBAL_NUMBER
755  CALL generated_mesh_finalise(generated_mesh,err,error,*999)
756  !Remove the generated mesh from the list of generated meshes
757  IF(generated_meshes%NUMBER_OF_GENERATED_MESHES>1) THEN
758  ALLOCATE(new_generated_meshes(generated_meshes%NUMBER_OF_GENERATED_MESHES-1),stat=err)
759  IF(err/=0) CALL flagerror("Could not allocate new generated meshes.",err,error,*999)
760  DO generated_mesh_idx=1,generated_meshes%NUMBER_OF_GENERATED_MESHES
761  IF(generated_mesh_idx<generated_mesh_position) THEN
762  new_generated_meshes(generated_mesh_idx)%PTR=>generated_meshes%GENERATED_MESHES(generated_mesh_idx)%PTR
763  ELSE IF(generated_mesh_idx>generated_mesh_position) THEN
764  generated_meshes%GENERATED_MESHES(generated_mesh_idx)%PTR%GLOBAL_NUMBER=generated_meshes% &
765  & generated_meshes(generated_mesh_idx)%PTR%GLOBAL_NUMBER-1
766  new_generated_meshes(generated_mesh_idx-1)%PTR=>generated_meshes%GENERATED_MESHES(generated_mesh_idx)%PTR
767  ENDIF
768  ENDDO !generated_mesh_idx
769  DEALLOCATE(generated_meshes%GENERATED_MESHES)
770  generated_meshes%GENERATED_MESHES=>new_generated_meshes
771  generated_meshes%NUMBER_OF_GENERATED_MESHES=generated_meshes%NUMBER_OF_GENERATED_MESHES-1
772  ELSE
773  DEALLOCATE(generated_meshes%GENERATED_MESHES)
774  generated_meshes%NUMBER_OF_GENERATED_MESHES=0
775  ENDIF
776  ELSE
777  CALL flagerror("Generated meshes are not associated",err,error,*998)
778  ENDIF
779  ELSE
780  CALL flagerror("Generated mesh generated meshes is not associated.",err,error,*998)
781  ENDIF
782  ELSE
783  CALL flagerror("Generated mesh is not associated",err,error,*998)
784  END IF
785 
786  exits("GENERATED_MESH_DESTROY")
787  RETURN
788 999 IF(ASSOCIATED(new_generated_meshes)) DEALLOCATE(new_generated_meshes)
789 998 errorsexits("GENERATED_MESH_DESTROY",err,error)
790  RETURN 1
791  END SUBROUTINE generated_mesh_destroy
792 
793  !
794  !================================================================================================================================
795  !
796 
798  SUBROUTINE generated_mesh_extent_get(GENERATED_MESH,EXTENT,ERR,ERROR,*)
799 
800  !Argument variables
801  TYPE(generated_mesh_type), POINTER :: generated_mesh
802  REAL(DP), INTENT(OUT) :: extent(:)
803  INTEGER(INTG), INTENT(OUT) :: err
804  TYPE(varying_string), INTENT(OUT) :: error
805  !Local Variables
806  TYPE(varying_string) :: local_error
807 
808  enters("GENERATED_MESH_EXTENT_GET",err,error,*999)
809 
810  IF(ASSOCIATED(generated_mesh)) THEN
811  SELECT CASE(generated_mesh%GENERATED_TYPE)
812  CASE(generated_mesh_regular_mesh_type)
813  IF(SIZE(extent,1)>=SIZE(generated_mesh%REGULAR_MESH%MAXIMUM_EXTENT,1)) THEN
814  extent=generated_mesh%REGULAR_MESH%MAXIMUM_EXTENT
815  ELSE
816  local_error="The size of EXTENT is too small. The supplied size is "// &
817  & trim(number_to_vstring(SIZE(extent,1),"*",err,error))//" and it needs to be >= "// &
818  & trim(number_to_vstring(SIZE(generated_mesh%REGULAR_MESH%MAXIMUM_EXTENT,1),"*",err,error))//"."
819  CALL flagerror(local_error,err,error,*999)
820  ENDIF
821  CASE(generated_mesh_polar_mesh_type)
822  CALL flagerror("Not implemented.",err,error,*999)
823  CASE(generated_mesh_fractal_tree_mesh_type)
824  CALL flagerror("Not implemented.",err,error,*999)
825  CASE(generated_mesh_cylinder_mesh_type)
826  IF(SIZE(extent,1)>=3) THEN
827  extent=generated_mesh%CYLINDER_MESH%CYLINDER_EXTENT
828  ELSE
829  local_error="The size of EXTENT is too small. The supplied size is "// &
830  & trim(number_to_vstring(SIZE(extent,1),"*",err,error))//" and it needs to be 3."
831  CALL flagerror(local_error,err,error,*999)
832  ENDIF
833  CASE(generated_mesh_ellipsoid_mesh_type)
834  extent=generated_mesh%ELLIPSOID_MESH%ELLIPSOID_EXTENT
835  CASE DEFAULT
836  local_error="The generated mesh mesh type of "//trim(number_to_vstring(generated_mesh%GENERATED_TYPE,"*",err,error))// &
837  & " is invalid."
838  CALL flagerror(local_error,err,error,*999)
839  END SELECT
840  ELSE
841  CALL flagerror("Generated mesh is not associated",err,error,*999)
842  ENDIF
843 
844  exits("GENERATED_MESH_EXTENT_GET")
845  RETURN
846 999 errorsexits("GENERATED_MESH_EXTENT_GET",err,error)
847  RETURN
848  END SUBROUTINE generated_mesh_extent_get
849  !
850  !================================================================================================================================
851  !
852 
854  SUBROUTINE generated_mesh_extent_set(GENERATED_MESH,EXTENT,ERR,ERROR,*)
855 
856  !Argument variables
857  TYPE(generated_mesh_type), POINTER :: generated_mesh
858  REAL(DP), INTENT(IN) :: extent(:)
859  INTEGER(INTG), INTENT(OUT) :: err
860  TYPE(varying_string), INTENT(OUT) :: error
861  !Local Variables
862  INTEGER(INTG) :: coordinate_dimension
863  TYPE(coordinate_system_type), POINTER :: coordinate_system
864  TYPE(varying_string) :: local_error
865 
866  enters("GENERATED_MESH_EXTENT_SET",err,error,*999)
867 
868  IF(ASSOCIATED(generated_mesh)) THEN
869  IF(generated_mesh%GENERATED_MESH_FINISHED) THEN
870  CALL flagerror("Generated mesh has been finished.",err,error,*999)
871  ELSE
872  NULLIFY(coordinate_system)
873  CALL generated_mesh_coordinate_system_get(generated_mesh,coordinate_system,err,error,*999)
874  CALL coordinate_system_dimension_get(coordinate_system,coordinate_dimension,err,error,*999)
875  SELECT CASE(generated_mesh%GENERATED_TYPE)
876  CASE(generated_mesh_regular_mesh_type)
877  IF(SIZE(extent,1)==coordinate_dimension) THEN
878  IF(ASSOCIATED(generated_mesh%REGULAR_MESH)) THEN
879  IF(l2norm(extent)>zero_tolerance) THEN
880  IF(ALLOCATED(generated_mesh%REGULAR_MESH%MAXIMUM_EXTENT)) &
881  & DEALLOCATE(generated_mesh%REGULAR_MESH%MAXIMUM_EXTENT)
882  ALLOCATE(generated_mesh%REGULAR_MESH%MAXIMUM_EXTENT(coordinate_dimension),stat=err)
883  IF(err/=0) CALL flagerror("Could not allocate maximum extent.",err,error,*999)
884  generated_mesh%REGULAR_MESH%MAXIMUM_EXTENT=extent
885  ELSE
886  CALL flagerror("The norm of the mesh extent is zero.",err,error,*999)
887  ENDIF
888  ELSE
889  CALL flagerror("Regular generated mesh is not associated.",err,error,*999)
890  ENDIF
891  ELSE
892  local_error="The extent size of "//trim(number_to_vstring(SIZE(extent,1),"*",err,error))// &
893  & " is invalid. The extent size must match the coordinate system dimension of "// &
894  & trim(number_to_vstring(coordinate_dimension,"*",err,error))//"."
895  CALL flagerror(local_error,err,error,*999)
896  ENDIF
897  CASE(generated_mesh_polar_mesh_type)
898  CALL flagerror("Not implemented.",err,error,*999)
899  CASE(generated_mesh_fractal_tree_mesh_type)
900  CALL flagerror("Not implemented.",err,error,*999)
901  CASE(generated_mesh_cylinder_mesh_type)
902  IF(SIZE(extent,1)==coordinate_dimension) THEN
903  IF(ASSOCIATED(generated_mesh%CYLINDER_MESH)) THEN
904  ALLOCATE(generated_mesh%CYLINDER_MESH%CYLINDER_EXTENT(SIZE(extent)),stat=err)
905  IF(err/=0) CALL flagerror("Could not allocate maximum extent.",err,error,*999)
906  generated_mesh%CYLINDER_MESH%CYLINDER_EXTENT=extent
907  ELSE
908  CALL flagerror("Cylinder generated mesh is not associated.",err,error,*999)
909  ENDIF
910  ELSE
911  local_error="The extent size of "//trim(number_to_vstring(SIZE(extent,1),"*",err,error))// &
912  & " is invalid. The extent size must match the coordinate system dimension of "// &
913  & trim(number_to_vstring(coordinate_dimension,"*",err,error))//"."
914  CALL flagerror(local_error,err,error,*999)
915  ENDIF
916  CASE(generated_mesh_ellipsoid_mesh_type)
917  IF((SIZE(extent,1)-1)==coordinate_dimension) THEN
918  IF(ASSOCIATED(generated_mesh%ELLIPSOID_MESH)) THEN
919  ALLOCATE(generated_mesh%ELLIPSOID_MESH%ELLIPSOID_EXTENT(SIZE(extent)),stat=err)
920  IF(err/=0) CALL flagerror("Could not allocate maximum extent.",err,error,*999)
921  generated_mesh%ELLIPSOID_MESH%ELLIPSOID_EXTENT=extent
922  ELSE
923  CALL flagerror("Ellipsoid generated mesh is not associated.",err,error,*999)
924  ENDIF
925  ELSE
926  local_error="The extent size of "//trim(number_to_vstring(SIZE(extent,1),"*",err,error))// &
927  & " is invalid. The extent size must be equal one plus the coordinate system dimension of "// &
928  & trim(number_to_vstring(coordinate_dimension,"*",err,error))//"."
929  CALL flagerror(local_error,err,error,*999)
930  ENDIF
931  CASE DEFAULT
932  local_error="The generated mesh mesh type of "// &
933  & trim(number_to_vstring(generated_mesh%GENERATED_TYPE,"*",err,error))// &
934  & " is invalid."
935  CALL flagerror(local_error,err,error,*999)
936  END SELECT
937  ENDIF
938  ELSE
939  CALL flagerror("Generated mesh is not associated.",err,error,*999)
940  ENDIF
941 
942  exits("GENERATED_MESH_EXTENT_SET")
943  RETURN
944 999 errorsexits("GENERATED_MESH_EXTENT_SET",err,error)
945  RETURN 1
946  END SUBROUTINE generated_mesh_extent_set
947 
948  !
949  !================================================================================================================================
950  !
951 
953  SUBROUTINE generated_mesh_surface_get(GENERATED_MESH,MESH_COMPONENT,SURFACE_TYPE,SURFACE_NODES,NORMAL_XI,ERR,ERROR,*)
954 
955  !Argument variables
956  TYPE(generated_mesh_type), POINTER :: generated_mesh
957  INTEGER(INTG), INTENT(IN) :: mesh_component
958  INTEGER(INTG), INTENT(IN) :: surface_type
959  INTEGER(INTG), ALLOCATABLE, INTENT(OUT) :: surface_nodes (:)
960  INTEGER(INTG), INTENT(OUT) :: normal_xi
961  INTEGER(INTG), INTENT(OUT) :: err
962  TYPE(varying_string), INTENT(OUT) :: error
963  !Local Variables
964  TYPE(generated_mesh_ellipsoid_type), POINTER :: ellipsoid_mesh
965  TYPE(generated_mesh_cylinder_type), POINTER :: cylinder_mesh
966  TYPE(generated_mesh_regular_type), POINTER :: regular_mesh
967  TYPE(varying_string) :: local_error
968 ! INTEGER(INTG), ALLOCATABLE :: NODES(:)
969 
970 
971  enters("GENERATED_MESH_SURFACE_GET",err,error,*999)
972 
973  IF(ASSOCIATED(generated_mesh)) THEN
974  SELECT CASE(generated_mesh%GENERATED_TYPE)
975  CASE(generated_mesh_regular_mesh_type)
976  regular_mesh=>generated_mesh%REGULAR_MESH
977  CALL generated_mesh_regular_surface_get(regular_mesh,mesh_component,surface_type,surface_nodes,normal_xi,err,error,*999)
978  CASE(generated_mesh_polar_mesh_type)
979  CALL flagerror("Not implemented.",err,error,*999)
980  CASE(generated_mesh_fractal_tree_mesh_type)
981  CALL flagerror("Not implemented.",err,error,*999)
982  CASE(generated_mesh_cylinder_mesh_type)
983  cylinder_mesh=>generated_mesh%CYLINDER_MESH
984  CALL generated_mesh_cylinder_surface_get(cylinder_mesh,mesh_component,surface_type,surface_nodes,normal_xi,err,error,*999)
985  CASE(generated_mesh_ellipsoid_mesh_type)
986  ellipsoid_mesh=>generated_mesh%ELLIPSOID_MESH
987  CALL generated_mesh_ellipsoid_surface_get(ellipsoid_mesh,mesh_component,surface_type,surface_nodes,normal_xi, &
988  & err,error,*999)
989  CASE DEFAULT
990  local_error="The generated mesh mesh type of "//trim(number_to_vstring(generated_mesh%GENERATED_TYPE,"*",err,error))// &
991  & " is invalid."
992  CALL flagerror(local_error,err,error,*999)
993  END SELECT
994  ELSE
995  CALL flagerror("Generated mesh is not associated",err,error,*999)
996  ENDIF
997 
998  exits("GENERATED_MESH_SURFACE_GET")
999  RETURN
1000 999 errorsexits("GENERATED_MESH_SURFACE_GET",err,error)
1001  RETURN
1002  END SUBROUTINE generated_mesh_surface_get
1003 
1004  !
1005  !================================================================================================================================
1006  !
1007 
1009  SUBROUTINE generated_mesh_finalise(GENERATED_MESH,ERR,ERROR,*)
1010 
1011  !Argument variables
1012  TYPE(generated_mesh_type), POINTER :: generated_mesh
1013  INTEGER(INTG), INTENT(OUT) :: err
1014  TYPE(varying_string), INTENT(OUT) :: error
1015  !Local Variables
1016 
1017  enters("GENERATED_MESH_FINALISE",err,error,*999)
1018 
1019  IF(ASSOCIATED(generated_mesh)) THEN
1020  CALL generated_mesh_regular_finalise(generated_mesh%REGULAR_MESH,err,error,*999)
1021  CALL generated_mesh_cylinder_finalise(generated_mesh%CYLINDER_MESH,err,error,*999)
1022  CALL generated_mesh_ellipsoid_finalise(generated_mesh%ELLIPSOID_MESH,err,error,*999)
1023  DEALLOCATE(generated_mesh)
1024  ENDIF
1025 
1026  exits("GENERATED_MESH_FINALISE")
1027  RETURN
1028 999 errorsexits("GENERATED_MESH_FINALISE",err,error)
1029  RETURN 1
1030  END SUBROUTINE generated_mesh_finalise
1031 
1032  !
1033  !================================================================================================================================
1034  !
1035 
1037  SUBROUTINE generated_mesh_initialise(GENERATED_MESH,ERR,ERROR,*)
1038 
1039  !Argument variables
1040  TYPE(generated_mesh_type), POINTER :: generated_mesh
1041  INTEGER(INTG), INTENT(OUT) :: err
1042  TYPE(varying_string), INTENT(OUT) :: error
1043  !Local Variables
1044 
1045  enters("GENERATED_MESH_INITIALISE",err,error,*999)
1046 
1047  IF(ASSOCIATED(generated_mesh)) THEN
1048  CALL flagerror("Generated mesh is already associated.",err,error,*999)
1049  ELSE
1050  ALLOCATE(generated_mesh,stat=err)
1051  IF(err/=0) CALL flagerror("Could not allocate generated mesh.",err,error,*999)
1052  generated_mesh%USER_NUMBER=0
1053  generated_mesh%GLOBAL_NUMBER=0
1054  generated_mesh%GENERATED_MESH_FINISHED=.false.
1055  NULLIFY(generated_mesh%REGION)
1056  NULLIFY(generated_mesh%INTERFACE)
1057  generated_mesh%GENERATED_TYPE=0
1058  NULLIFY(generated_mesh%REGULAR_MESH)
1059  NULLIFY(generated_mesh%CYLINDER_MESH)
1060  NULLIFY(generated_mesh%ELLIPSOID_MESH)
1061  NULLIFY(generated_mesh%MESH)
1062  !Default to a regular mesh.
1063  CALL generated_mesh_regular_initialise(generated_mesh,err,error,*999)
1064  ENDIF
1065 
1066  exits("GENERATED_MESH_INITIALISE")
1067  RETURN
1068 999 errorsexits("GENERATED_MESH_INITIALISE",err,error)
1069  RETURN 1
1070  END SUBROUTINE generated_mesh_initialise
1071 
1072  !
1073  !================================================================================================================================
1074  !
1075 
1077  SUBROUTINE generated_mesh_number_of_elements_get(GENERATED_MESH,NUMBER_OF_ELEMENTS,ERR,ERROR,*)
1078 
1079  !Argument variables
1080  TYPE(generated_mesh_type), POINTER :: generated_mesh
1081  INTEGER(INTG), INTENT(OUT) :: number_of_elements(:)
1082  INTEGER(INTG), INTENT(OUT) :: err
1083  TYPE(varying_string), INTENT(OUT) :: error
1084  !Local Variables
1085  TYPE(varying_string) :: local_error
1086 
1087  enters("GENERATED_MESH_NUMBER_OF_ELEMENTS_GET",err,error,*999)
1088 
1089  IF(ASSOCIATED(generated_mesh)) THEN
1090  SELECT CASE(generated_mesh%GENERATED_TYPE)
1091  CASE(generated_mesh_regular_mesh_type)
1092  IF(SIZE(number_of_elements,1)>=SIZE(generated_mesh%REGULAR_MESH%NUMBER_OF_ELEMENTS_XI,1)) THEN
1093  number_of_elements=generated_mesh%REGULAR_MESH%NUMBER_OF_ELEMENTS_XI
1094  ELSE
1095  local_error="The size of NUMBER_OF_ELEMENTS is too small. The supplied size is "// &
1096  & trim(number_to_vstring(SIZE(number_of_elements,1),"*",err,error))//" and it needs to be >= "// &
1097  & trim(number_to_vstring(SIZE(generated_mesh%REGULAR_MESH%NUMBER_OF_ELEMENTS_XI,1),"*",err,error))//"."
1098  CALL flagerror(local_error,err,error,*999)
1099  ENDIF
1100  CASE(generated_mesh_polar_mesh_type)
1101  CALL flagerror("Not implemented.",err,error,*999)
1102  CASE(generated_mesh_fractal_tree_mesh_type)
1103  CALL flagerror("Not implemented.",err,error,*999)
1104  CASE(generated_mesh_cylinder_mesh_type)
1105  IF(SIZE(number_of_elements,1)>=SIZE(generated_mesh%CYLINDER_MESH%NUMBER_OF_ELEMENTS_XI,1)) THEN
1106  number_of_elements=generated_mesh%CYLINDER_MESH%NUMBER_OF_ELEMENTS_XI
1107  ELSE
1108  local_error="The size of NUMBER_OF_ELEMENTS is too small. The supplied size is "// &
1109  & trim(number_to_vstring(SIZE(number_of_elements,1),"*",err,error))//" and it needs to be >= "// &
1110  & trim(number_to_vstring(SIZE(generated_mesh%CYLINDER_MESH%NUMBER_OF_ELEMENTS_XI,1),"*",err,error))//"."
1111  CALL flagerror(local_error,err,error,*999)
1112  ENDIF
1113  CASE(generated_mesh_ellipsoid_mesh_type)
1114  IF(SIZE(number_of_elements,1)>=SIZE(generated_mesh%ELLIPSOID_MESH%NUMBER_OF_ELEMENTS_XI,1)) THEN
1115  number_of_elements=generated_mesh%ELLIPSOID_MESH%NUMBER_OF_ELEMENTS_XI
1116  ELSE
1117  local_error="The size of NUMBER_OF_ELEMENTS is too small. The supplied size is "// &
1118  & trim(number_to_vstring(SIZE(number_of_elements,1),"*",err,error))//" and it needs to be >= "// &
1119  & trim(number_to_vstring(SIZE(generated_mesh%ELLIPSOID_MESH%NUMBER_OF_ELEMENTS_XI,1),"*",err,error))//"."
1120  CALL flagerror(local_error,err,error,*999)
1121  ENDIF
1122  CASE DEFAULT
1123  local_error="The generated mesh mesh type of "//trim(number_to_vstring(generated_mesh%GENERATED_TYPE,"*",err,error))// &
1124  & " is invalid."
1125  CALL flagerror(local_error,err,error,*999)
1126  END SELECT
1127  ELSE
1128  CALL flagerror("Generated mesh is not associated.",err,error,*999)
1129  ENDIF
1130 
1131  exits("GENERATED_MESH_NUMBER_OF_ELEMENTS_GET")
1132  RETURN
1133 999 errorsexits("GENERATED_MESH_NUMBER_OF_ELEMENTS_GET",err,error)
1134  RETURN 1
1135  END SUBROUTINE generated_mesh_number_of_elements_get
1136 
1137  !
1138  !================================================================================================================================
1139  !
1140 
1142  SUBROUTINE generated_mesh_number_of_elements_set(GENERATED_MESH,NUMBER_OF_ELEMENTS_XI,ERR,ERROR,*)
1143 
1144  !Argument variables
1145  TYPE(generated_mesh_type), POINTER :: generated_mesh
1146  INTEGER(INTG), INTENT(IN) :: number_of_elements_xi(:)
1147  INTEGER(INTG), INTENT(OUT) :: err
1148  TYPE(varying_string), INTENT(OUT) :: error
1149  !Local Variables
1150  TYPE(basis_type), POINTER :: basis
1151  TYPE(generated_mesh_regular_type), POINTER :: regular_mesh
1152  TYPE(varying_string) :: local_error
1153 
1154  enters("GENERATED_MESH_NUMBER_OF_ELEMENTS_SET",err,error,*999)
1155 
1156  IF(ASSOCIATED(generated_mesh)) THEN
1157  IF(generated_mesh%GENERATED_MESH_FINISHED) THEN
1158  CALL flagerror("Generated mesh has been finished.",err,error,*999)
1159  ELSE
1160  SELECT CASE(generated_mesh%GENERATED_TYPE)
1161  CASE(generated_mesh_regular_mesh_type)
1162  regular_mesh=>generated_mesh%REGULAR_MESH
1163  IF(ASSOCIATED(regular_mesh)) THEN
1164  IF(ALLOCATED(regular_mesh%BASES)) THEN
1165  basis=>regular_mesh%BASES(1)%PTR !Number of xi will be the same for all bases
1166  IF(ASSOCIATED(basis)) THEN
1167  IF(SIZE(number_of_elements_xi,1)==basis%NUMBER_OF_XI) THEN
1168  IF(all(number_of_elements_xi>0)) THEN
1169  IF(ALLOCATED(regular_mesh%NUMBER_OF_ELEMENTS_XI)) DEALLOCATE(regular_mesh%NUMBER_OF_ELEMENTS_XI)
1170  ALLOCATE(regular_mesh%NUMBER_OF_ELEMENTS_XI(basis%NUMBER_OF_XI),stat=err)
1171  IF(err/=0) CALL flagerror("Could not allocate number of elements xi.",err,error,*999)
1172  regular_mesh%NUMBER_OF_ELEMENTS_XI(1:basis%NUMBER_OF_XI)=number_of_elements_xi(1:basis%NUMBER_OF_XI)
1173  ELSE
1174  CALL flagerror("Must have 1 or more elements in all directions.",err,error,*999)
1175  ENDIF
1176  ELSE
1177  local_error="The number of elements xi size of "// &
1178  & trim(number_to_vstring(SIZE(number_of_elements_xi,1),"*",err,error))// &
1179  & " is invalid. The number of elements xi size must match the basis number of xi dimensions of "// &
1180  & trim(number_to_vstring(basis%NUMBER_OF_XI,"*",err,error))//"."
1181  CALL flagerror(local_error,err,error,*999)
1182  ENDIF
1183  ELSE
1184  CALL flagerror("Must set the generated mesh basis before setting the number of elements.",err,error,*999)
1185  ENDIF
1186  ELSE
1187  CALL flagerror("Must set the generated mesh basis before setting the number of elements.",err,error,*999)
1188  ENDIF
1189  ELSE
1190  CALL flagerror("Regular generated mesh is not associated.",err,error,*999)
1191  ENDIF
1192  CASE(generated_mesh_polar_mesh_type)
1193  CALL flagerror("Not implemented.",err,error,*999)
1194  CASE(generated_mesh_fractal_tree_mesh_type)
1195  CALL flagerror("Not implemented.",err,error,*999)
1196  CASE(generated_mesh_cylinder_mesh_type)
1197  IF(ASSOCIATED(generated_mesh%CYLINDER_MESH)) THEN
1198  ALLOCATE(generated_mesh%CYLINDER_MESH%NUMBER_OF_ELEMENTS_XI(SIZE(number_of_elements_xi)),stat=err)
1199  generated_mesh%CYLINDER_MESH%NUMBER_OF_ELEMENTS_XI=number_of_elements_xi
1200  ELSE
1201  CALL flagerror("Cylinder generated mesh is not associated.",err,error,*999)
1202  ENDIF
1203  CASE(generated_mesh_ellipsoid_mesh_type)
1204  IF(ASSOCIATED(generated_mesh%ELLIPSOID_MESH)) THEN
1205  ALLOCATE(generated_mesh%ELLIPSOID_MESH%NUMBER_OF_ELEMENTS_XI(SIZE(number_of_elements_xi)),stat=err)
1206  generated_mesh%ELLIPSOID_MESH%NUMBER_OF_ELEMENTS_XI=number_of_elements_xi
1207  ELSE
1208  CALL flagerror("Ellipsoid generated mesh is not associated.",err,error,*999)
1209  ENDIF
1210  CASE DEFAULT
1211  local_error="The generated mesh mesh type of "//trim(number_to_vstring(generated_mesh%GENERATED_TYPE,"*",err,error))// &
1212  & " is invalid."
1213  CALL flagerror(local_error,err,error,*999)
1214  END SELECT
1215  ENDIF
1216  ELSE
1217  CALL flagerror("Generated mesh is not associated.",err,error,*999)
1218  ENDIF
1219 
1220  exits("GENERATED_MESH_NUMBER_OF_ELEMENTS_SET")
1221  RETURN
1222 999 errorsexits("GENERATED_MESH_NUMBER_OF_ELEMENTS_SET",err,error)
1223  RETURN 1
1224  END SUBROUTINE generated_mesh_number_of_elements_set
1225 
1226  !
1227  !================================================================================================================================
1228  !
1229 
1231  SUBROUTINE generated_mesh_origin_get(GENERATED_MESH,ORIGIN,ERR,ERROR,*)
1232 
1233  !Argument variables
1234  TYPE(generated_mesh_type), POINTER :: generated_mesh
1235  REAL(DP), INTENT(OUT) :: origin(:)
1236  INTEGER(INTG), INTENT(OUT) :: err
1237  TYPE(varying_string), INTENT(OUT) :: error
1238  !Local Variables
1239  TYPE(varying_string) :: local_error
1240 
1241  enters("GENERATED_MESH_ORIGIN_GET",err,error,*999)
1242 
1243  IF(ASSOCIATED(generated_mesh)) THEN
1244  SELECT CASE(generated_mesh%GENERATED_TYPE)
1245  CASE(generated_mesh_regular_mesh_type)
1246  IF(SIZE(origin,1)>=SIZE(generated_mesh%REGULAR_MESH%ORIGIN,1)) THEN
1247  origin=generated_mesh%REGULAR_MESH%ORIGIN
1248  ELSE
1249  local_error="The size of ORIGIN is too small. The supplied size is "// &
1250  & trim(number_to_vstring(SIZE(origin,1),"*",err,error))//" and it needs to be >= "// &
1251  & trim(number_to_vstring(SIZE(generated_mesh%REGULAR_MESH%ORIGIN,1),"*",err,error))//"."
1252  CALL flagerror(local_error,err,error,*999)
1253  ENDIF
1254  CASE(generated_mesh_polar_mesh_type)
1255  CALL flagerror("Not implemented.",err,error,*999)
1256  CASE(generated_mesh_fractal_tree_mesh_type)
1257  CALL flagerror("Not implemented.",err,error,*999)
1258  CASE(generated_mesh_cylinder_mesh_type)
1259  IF(SIZE(origin,1)>=SIZE(generated_mesh%CYLINDER_MESH%ORIGIN,1)) THEN
1260  origin=generated_mesh%CYLINDER_MESH%ORIGIN
1261  ELSE
1262  local_error="The size of ORIGIN is too small. The supplied size is "// &
1263  & trim(number_to_vstring(SIZE(origin,1),"*",err,error))//" and it needs to be 3."
1264  CALL flagerror(local_error,err,error,*999)
1265  ENDIF
1266  CASE(generated_mesh_ellipsoid_mesh_type)
1267  IF(SIZE(origin,1)>=SIZE(generated_mesh%ELLIPSOID_MESH%ORIGIN,1)) THEN
1268  origin=generated_mesh%ELLIPSOID_MESH%ORIGIN
1269  ELSE
1270  local_error="The size of ORIGIN is too small. The supplied size is "// &
1271  & trim(number_to_vstring(SIZE(origin,1),"*",err,error))//" and it needs to be 3."
1272  CALL flagerror(local_error,err,error,*999)
1273  ENDIF
1274  CASE DEFAULT
1275  local_error="The generated mesh mesh type of "//trim(number_to_vstring(generated_mesh%GENERATED_TYPE,"*",err,error))// &
1276  & " is invalid."
1277  CALL flagerror(local_error,err,error,*999)
1278  END SELECT
1279  ELSE
1280  CALL flagerror("Generated mesh is not associated",err,error,*999)
1281  ENDIF
1282 
1283  exits("GENERATED_MESH_ORIGIN_GET")
1284  RETURN
1285 999 errorsexits("GENERATED_MESH_ORIGIN_GET",err,error)
1286  RETURN 1
1287  END SUBROUTINE generated_mesh_origin_get
1288 
1289  !
1290  !================================================================================================================================
1291  !
1292 
1294  SUBROUTINE generated_mesh_origin_set(GENERATED_MESH,ORIGIN,ERR,ERROR,*)
1295 
1296  !Argument variables
1297  TYPE(generated_mesh_type), POINTER :: generated_mesh
1298  REAL(DP), INTENT(IN) :: origin(:)
1299  INTEGER(INTG), INTENT(OUT) :: err
1300  TYPE(varying_string), INTENT(OUT) :: error
1301  !Local Variables
1302  INTEGER(INTG) :: coordinate_dimension
1303  TYPE(coordinate_system_type), POINTER :: coordinate_system
1304  TYPE(varying_string) :: local_error
1305 
1306  enters("GENERATED_MESH_ORIGIN_SET",err,error,*999)
1307 
1308  IF(ASSOCIATED(generated_mesh)) THEN
1309  IF(generated_mesh%GENERATED_MESH_FINISHED) THEN
1310  CALL flagerror("Generated mesh has been finished.",err,error,*999)
1311  ELSE
1312  NULLIFY(coordinate_system)
1313  CALL generated_mesh_coordinate_system_get(generated_mesh,coordinate_system,err,error,*999)
1314  CALL coordinate_system_dimension_get(coordinate_system,coordinate_dimension,err,error,*999)
1315  IF(SIZE(origin,1)==coordinate_dimension) THEN
1316  SELECT CASE(generated_mesh%GENERATED_TYPE)
1317  CASE(generated_mesh_regular_mesh_type)
1318  IF(ASSOCIATED(generated_mesh%REGULAR_MESH)) THEN
1319  IF(.NOT.ALLOCATED(generated_mesh%REGULAR_MESH%ORIGIN)) THEN
1320  ALLOCATE(generated_mesh%REGULAR_MESH%ORIGIN(SIZE(origin)),stat=err)
1321  IF(err/=0) CALL flagerror("Could not allocate origin.",err,error,*999)
1322  ENDIF
1323  generated_mesh%REGULAR_MESH%ORIGIN=origin
1324  ELSE
1325  CALL flagerror("Regular generated mesh is not associated.",err,error,*999)
1326  ENDIF
1327  CASE(generated_mesh_polar_mesh_type)
1328  CALL flagerror("Not implemented.",err,error,*999)
1329  CASE(generated_mesh_fractal_tree_mesh_type)
1330  CALL flagerror("Not implemented.",err,error,*999)
1331  CASE(generated_mesh_cylinder_mesh_type)
1332  IF(ASSOCIATED(generated_mesh%CYLINDER_MESH)) THEN
1333  IF(SIZE(origin,1)==3) THEN
1334  IF(.NOT.ALLOCATED(generated_mesh%CYLINDER_MESH%ORIGIN)) THEN
1335  ALLOCATE(generated_mesh%CYLINDER_MESH%ORIGIN(SIZE(origin)),stat=err)
1336  IF(err/=0) CALL flagerror("Could not allocate origin.",err,error,*999)
1337  ENDIF
1338  ELSE
1339  CALL flagerror("Cylinder generated mesh is only supported for 3D.",err,error,*999)
1340  ENDIF
1341  generated_mesh%CYLINDER_MESH%ORIGIN=origin
1342  ELSE
1343  CALL flagerror("Cylinder generated mesh is not associated.",err,error,*999)
1344  END IF
1345  CASE(generated_mesh_ellipsoid_mesh_type)
1346  IF(ASSOCIATED(generated_mesh%ELLIPSOID_MESH)) THEN
1347  IF(SIZE(origin,1)==3) THEN
1348  IF(.NOT.ALLOCATED(generated_mesh%ELLIPSOID_MESH%ORIGIN)) THEN
1349  ALLOCATE(generated_mesh%ELLIPSOID_MESH%ORIGIN(SIZE(origin)),stat=err)
1350  IF(err/=0) CALL flagerror("Could not allocate origin.",err,error,*999)
1351  ENDIF
1352  ELSE
1353  CALL flagerror("Ellipsoid generated mesh is only supported for 3D.",err,error,*999)
1354  ENDIF
1355  generated_mesh%ELLIPSOID_MESH%ORIGIN=origin
1356  ELSE
1357  CALL flagerror("Ellipsoid generated mesh is not associated.",err,error,*999)
1358  END IF
1359  CASE DEFAULT
1360  local_error="The generated mesh mesh type of "//trim(number_to_vstring(generated_mesh%GENERATED_TYPE,"*",err,error))// &
1361  & " is invalid."
1362  CALL flagerror(local_error,err,error,*999)
1363  END SELECT
1364  ELSE
1365  local_error="The origin size of "//trim(number_to_vstring(SIZE(origin,1),"*",err,error))// &
1366  & " is invalid. The extent size must match the coordinate system dimension of "// &
1367  & trim(number_to_vstring(coordinate_dimension,"*",err,error))//"."
1368  CALL flagerror(local_error,err,error,*999)
1369  ENDIF
1370  ENDIF
1371  ELSE
1372  CALL flagerror("Generated mesh is not associated.",err,error,*999)
1373  ENDIF
1374 
1375  exits("GENERATED_MESH_ORIGIN_SET")
1376  RETURN
1377 999 errorsexits("GENERATED_MESH_ORIGIN_SET",err,error)
1378  RETURN 1
1379  END SUBROUTINE generated_mesh_origin_set
1380 
1381  !
1382  !================================================================================================================================
1383  !
1384 
1386  SUBROUTINE generated_mesh_regular_create_finish(GENERATED_MESH,MESH_USER_NUMBER,ERR,ERROR,*)
1387 
1388  !Argument variables
1389  TYPE(generated_mesh_type), POINTER :: generated_mesh
1390  INTEGER(INTG), INTENT(IN) :: mesh_user_number
1391  INTEGER(INTG), INTENT(OUT) :: err
1392  TYPE(varying_string), INTENT(OUT) :: error
1393  !Local Variables
1394  INTEGER(INTG) :: coordinate_idx,count,element_factor,grid_ne,grid_number_of_elements,ni,ne,ne1,ne2,ne3,nn,nn1,nn2,nn3,np, &
1395  & NUMBER_OF_ELEMENTS_XI(3),TOTAL_NUMBER_OF_NODES_XI(3),TOTAL_NUMBER_OF_NODES,NUMBER_OF_CORNER_NODES, &
1396  & TOTAL_NUMBER_OF_ELEMENTS,xi_idx,NUM_BASES,basis_idx,BASIS_NUMBER_OF_NODES(10)
1397  INTEGER(INTG), ALLOCATABLE :: element_nodes(:),element_nodes_user_numbers(:)
1398  TYPE(basis_type), POINTER :: basis
1399  TYPE(coordinate_system_type), POINTER :: coordinate_system
1400  TYPE(generated_mesh_regular_type), POINTER :: regular_mesh
1401  TYPE(interface_type), POINTER :: interface
1402  TYPE(meshelementstype), POINTER :: mesh_elements
1403  TYPE(nodes_type), POINTER :: nodes
1404  TYPE(region_type), POINTER :: region
1405  TYPE(varying_string) :: local_error
1406 
1407  enters("GENERATED_MESH_REGULAR_CREATE_FINISH",err,error,*999)
1408 
1409  IF(ASSOCIATED(generated_mesh)) THEN
1410  NULLIFY(coordinate_system)
1411  CALL generated_mesh_coordinate_system_get(generated_mesh,coordinate_system,err,error,*999)
1412  region=>generated_mesh%REGION
1413  interface=>generated_mesh%INTERFACE
1414  regular_mesh=>generated_mesh%REGULAR_MESH
1415  IF(ASSOCIATED(regular_mesh)) THEN
1416  SELECT CASE(coordinate_system%TYPE)
1417  CASE(coordinate_rectangular_cartesian_type)
1418  IF(ALLOCATED(regular_mesh%BASES)) THEN
1419  !Use first basis to get number of xi
1420  basis=>regular_mesh%BASES(1)%PTR
1421  SELECT CASE(basis%TYPE)
1422  CASE(basis_lagrange_hermite_tp_type,basis_simplex_type)
1423  IF(.NOT.all(basis%COLLAPSED_XI==basis_not_collapsed)) &
1424  & CALL flagerror("Degenerate (collapsed) basis not implemented.",err,error,*999)
1425  !Determine the coordinate system and create the regular mesh for that system
1426  regular_mesh%COORDINATE_DIMENSION=coordinate_system%NUMBER_OF_DIMENSIONS
1427  regular_mesh%MESH_DIMENSION=basis%NUMBER_OF_XI
1428  IF(.NOT.ALLOCATED(regular_mesh%ORIGIN)) THEN
1429  ALLOCATE(regular_mesh%ORIGIN(regular_mesh%COORDINATE_DIMENSION),stat=err)
1430  IF(err/=0) CALL flagerror("Could not allocate origin.",err,error,*999)
1431  regular_mesh%ORIGIN=0.0_dp
1432  ENDIF
1433  IF(.NOT.ALLOCATED(regular_mesh%MAXIMUM_EXTENT)) THEN
1434  ALLOCATE(regular_mesh%MAXIMUM_EXTENT(regular_mesh%COORDINATE_DIMENSION),stat=err)
1435  IF(err/=0) CALL flagerror("Could not allocate maximum extent.",err,error,*999)
1436  regular_mesh%MAXIMUM_EXTENT=1.0_dp
1437  ENDIF
1438  IF(.NOT.ALLOCATED(regular_mesh%NUMBER_OF_ELEMENTS_XI)) THEN
1439  ALLOCATE(regular_mesh%NUMBER_OF_ELEMENTS_XI(regular_mesh%MESH_DIMENSION),stat=err)
1440  IF(err/=0) CALL flagerror("Could not allocate number of elements xi.",err,error,*999)
1441  regular_mesh%NUMBER_OF_ELEMENTS_XI=1
1442  ENDIF
1443  IF(ALLOCATED(regular_mesh%BASE_VECTORS)) THEN
1444  !!TODO: Check base vectors
1445  ELSE
1446  !Calculate base vectors
1447  ALLOCATE(regular_mesh%BASE_VECTORS(regular_mesh%COORDINATE_DIMENSION,regular_mesh%MESH_DIMENSION),stat=err)
1448  IF(err/=0) CALL flagerror("Could not allocate number of elements xi.",err,error,*999)
1449  regular_mesh%BASE_VECTORS=0.0_dp
1450  IF(regular_mesh%MESH_DIMENSION==1) THEN
1451  !The base vector is just the extent vector
1452  regular_mesh%BASE_VECTORS(:,1)=regular_mesh%MAXIMUM_EXTENT
1453  ELSE
1454  IF(regular_mesh%MESH_DIMENSION<regular_mesh%COORDINATE_DIMENSION) THEN
1455  !Find the first number of mesh dimensions for which the extent is non-zero.
1456  count=0
1457  coordinate_idx=1
1458  DO xi_idx=1,regular_mesh%MESH_DIMENSION
1459  DO WHILE(abs(regular_mesh%MAXIMUM_EXTENT(coordinate_idx))<=zero_tolerance)
1460  coordinate_idx=coordinate_idx+1
1461  ENDDO
1462  regular_mesh%BASE_VECTORS(coordinate_idx,xi_idx)=regular_mesh%MAXIMUM_EXTENT(coordinate_idx)
1463  coordinate_idx=coordinate_idx+1
1464  count=count+1
1465  ENDDO !xi_idx
1466  IF(count/=regular_mesh%MESH_DIMENSION) &
1467  & CALL flagerror("Invalid mesh extent. There number of non-zero components is < the mesh dimension.", &
1468  & err,error,*999)
1469  ELSE IF(regular_mesh%MESH_DIMENSION==regular_mesh%COORDINATE_DIMENSION) THEN
1470  !The default base vectors are aligned with the coordinate vectors
1471  DO coordinate_idx=1,regular_mesh%COORDINATE_DIMENSION
1472  regular_mesh%BASE_VECTORS(coordinate_idx,coordinate_idx)=regular_mesh%MAXIMUM_EXTENT(coordinate_idx)
1473  ENDDO !coordinate_idx
1474  ELSE
1475  CALL flagerror("The mesh dimension is greater than the coordinate dimension.",err,error,*999)
1476  ENDIF
1477  ENDIF
1478  ENDIF
1479  !Calculate the sizes of a regular grid of elements with the appropriate number of basis nodes in each dimension of
1480  !the grid element
1481  total_number_of_nodes=1
1482  grid_number_of_elements=1
1483  number_of_elements_xi=1
1484  num_bases=SIZE(regular_mesh%BASES)
1485  DO ni=1,regular_mesh%MESH_DIMENSION
1486  !Set total number of nodes to corner nodes only
1487  total_number_of_nodes=total_number_of_nodes*(regular_mesh%NUMBER_OF_ELEMENTS_XI(ni)+1)
1488  number_of_elements_xi(ni)=regular_mesh%NUMBER_OF_ELEMENTS_XI(ni)
1489  grid_number_of_elements=grid_number_of_elements*regular_mesh%NUMBER_OF_ELEMENTS_XI(ni)
1490  ENDDO
1491  number_of_corner_nodes=total_number_of_nodes
1492  !Add extra nodes for each basis
1493  !Will end up with some duplicate nodes if bases have the same interpolation in one direction
1494  basis_number_of_nodes=0
1495  DO basis_idx=1,num_bases
1496  basis=>regular_mesh%BASES(basis_idx)%PTR
1497  basis_number_of_nodes(basis_idx)=1
1498  DO ni=1,regular_mesh%MESH_DIMENSION
1499  basis_number_of_nodes(basis_idx)=basis_number_of_nodes(basis_idx)*((basis%NUMBER_OF_NODES_XIC(ni)-1)* &
1500  & regular_mesh%NUMBER_OF_ELEMENTS_XI(ni)+1)
1501  ENDDO
1502  basis_number_of_nodes(basis_idx)=total_number_of_nodes+basis_number_of_nodes(basis_idx)-number_of_corner_nodes
1503  ! BASIS_NUMBER_OF_NODES=1
1504  ! DO ni=1,REGULAR_MESH%MESH_DIMENSION
1505  ! BASIS_NUMBER_OF_NODES=BASIS_NUMBER_OF_NODES*((BASIS%NUMBER_OF_NODES_XIC(ni)-1)* &
1506  ! & REGULAR_MESH%NUMBER_OF_ELEMENTS_XI(ni)+1)
1507  ! ENDDO
1508  ! TOTAL_NUMBER_OF_NODES=TOTAL_NUMBER_OF_NODES+BASIS_NUMBER_OF_NODES-NUMBER_OF_CORNER_NODES
1509  ENDDO
1510  total_number_of_nodes=maxval(basis_number_of_nodes)
1511  !Compute the element factor i.e., the number of sub elements each grid element will be split into.
1512  IF(basis%TYPE==basis_lagrange_hermite_tp_type) THEN
1513  element_factor=1
1514  ELSE
1515  SELECT CASE(regular_mesh%MESH_DIMENSION)
1516  CASE(1)
1517  element_factor=1
1518  CASE(2)
1519  element_factor=2
1520  CASE(3)
1521  element_factor=6
1522  CASE DEFAULT
1523  local_error="The mesh dimension dimension of "// &
1524  & trim(number_to_vstring(regular_mesh%MESH_DIMENSION,"*",err,error))//" is invalid."
1525  CALL flagerror(local_error,err,error,*999)
1526  END SELECT
1527  ENDIF
1528  total_number_of_elements=element_factor*grid_number_of_elements
1529  !Create the default node set
1530  NULLIFY(nodes)
1531  IF(ASSOCIATED(region)) THEN
1532  CALL nodes_create_start(region,total_number_of_nodes,nodes,err,error,*999)
1533  ELSE
1534  CALL nodes_create_start(interface,total_number_of_nodes,nodes,err,error,*999)
1535  ENDIF
1536  !Finish the nodes creation
1537  CALL nodes_create_finish(nodes,err,error,*999)
1538  !Create the mesh
1539  IF(ASSOCIATED(region)) THEN
1540  CALL mesh_create_start(mesh_user_number,region,regular_mesh%MESH_DIMENSION,generated_mesh%MESH, &
1541  & err,error,*999)
1542  ELSE
1543  CALL mesh_create_start(mesh_user_number,interface,regular_mesh%MESH_DIMENSION,generated_mesh%MESH, &
1544  & err,error,*999)
1545  ENDIF
1546  !Set the number of mesh components
1547  CALL mesh_number_of_components_set(generated_mesh%MESH,num_bases,err,error,*999)
1548  !Create the elements
1549  CALL mesh_number_of_elements_set(generated_mesh%MESH,total_number_of_elements,err,error,*999)
1550  DO basis_idx=1,num_bases
1551  basis=>regular_mesh%BASES(basis_idx)%PTR
1552  !Get number of nodes in each xi direction for this basis
1553  DO ni=1,regular_mesh%MESH_DIMENSION
1554  total_number_of_nodes_xi(ni)=(basis%NUMBER_OF_NODES_XIC(ni)-1)*regular_mesh%NUMBER_OF_ELEMENTS_XI(ni)+1
1555  ENDDO
1556  NULLIFY(mesh_elements)
1557  CALL mesh_topology_elements_create_start(generated_mesh%MESH,basis_idx,basis,mesh_elements,err,error,*999)
1558  !Set the elements for the regular mesh
1559  IF (ALLOCATED(element_nodes)) DEALLOCATE(element_nodes)
1560  ALLOCATE(element_nodes(basis%NUMBER_OF_NODES),stat=err)
1561  IF (ALLOCATED(element_nodes_user_numbers)) DEALLOCATE(element_nodes_user_numbers)
1562  ALLOCATE(element_nodes_user_numbers(basis%NUMBER_OF_NODES),stat=err)
1563  IF(err/=0) CALL flagerror("Could not allocate element nodes.",err,error,*999)
1564  !Step in the xi(3) direction
1565  DO ne3=1,number_of_elements_xi(3)+1
1566  DO ne2=1,number_of_elements_xi(2)+1
1567  DO ne1=1,number_of_elements_xi(1)+1
1568  IF(basis%NUMBER_OF_XI<3.OR.ne3<=number_of_elements_xi(3)) THEN
1569  IF(basis%NUMBER_OF_XI<2.OR.ne2<=number_of_elements_xi(2)) THEN
1570  IF(ne1<=number_of_elements_xi(1)) THEN
1571  grid_ne=ne1
1572  np=1+(ne1-1)*(basis%NUMBER_OF_NODES_XIC(1)-1)
1573  IF(basis%NUMBER_OF_XI>1) THEN
1574  grid_ne=grid_ne+(ne2-1)*number_of_elements_xi(1)
1575  np=np+(ne2-1)*total_number_of_nodes_xi(1)*(basis%NUMBER_OF_NODES_XIC(2)-1)
1576  IF(basis%NUMBER_OF_XI>2) THEN
1577  grid_ne=grid_ne+(ne3-1)*number_of_elements_xi(1)*number_of_elements_xi(2)
1578  np=np+(ne3-1)*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)* &
1579  & (basis%NUMBER_OF_NODES_XIC(3)-1)
1580  ENDIF
1581  ENDIF
1582  IF(basis%TYPE==basis_lagrange_hermite_tp_type) THEN
1583  !Lagrange Hermite TP elements
1584  ne=grid_ne
1585  nn=0
1586  DO nn1=1,basis%NUMBER_OF_NODES_XIC(1)
1587  nn=nn+1
1588  element_nodes(nn)=np+(nn1-1)
1589  ENDDO !nn1
1590  IF(basis%NUMBER_OF_XI>1) THEN
1591  DO nn2=2,basis%NUMBER_OF_NODES_XIC(2)
1592  DO nn1=1,basis%NUMBER_OF_NODES_XIC(1)
1593  nn=nn+1
1594  element_nodes(nn)=np+(nn1-1)+(nn2-1)*total_number_of_nodes_xi(1)
1595  ENDDO !nn1
1596  ENDDO !nn2
1597  IF(basis%NUMBER_OF_XI>2) THEN
1598  DO nn3=2,basis%NUMBER_OF_NODES_XIC(3)
1599  DO nn2=1,basis%NUMBER_OF_NODES_XIC(2)
1600  DO nn1=1,basis%NUMBER_OF_NODES_XIC(1)
1601  nn=nn+1
1602  element_nodes(nn)=np+(nn1-1)+(nn2-1)*total_number_of_nodes_xi(1)+ &
1603  & (nn3-1)*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
1604  ENDDO !nn1
1605  ENDDO !nn2
1606  ENDDO !nn3
1607  ENDIF
1608  ENDIF
1609  CALL generatedmesh_regularcomponentnodestousernumbers(regular_mesh%GENERATED_MESH, &
1610  & basis_idx,element_nodes,element_nodes_user_numbers,err,error,*999)
1611  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1612  & element_nodes_user_numbers,err,error,*999)
1613  ELSE
1614  !Simplex elements
1615  SELECT CASE(basis%NUMBER_OF_XI)
1616  CASE(1)
1617  !Line element
1618  ne=grid_ne
1619  nn=0
1620  DO nn1=1,basis%NUMBER_OF_NODES_XIC(1)
1621  nn=nn+1
1622  element_nodes(nn)=np+(nn1-1)
1623  ENDDO !nn1
1624  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1625  & element_nodes_user_numbers,err,error,*999)
1626  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1627  & element_nodes_user_numbers,err,error,*999)
1628  CASE(2)
1629  !Triangular element
1630  !Break the grid square element into 2 triangles. The 2 triangles are
1631  !Element 1: vertices {(0,0);(1,0);(1,1)}
1632  !Element 2: vertices {(0,0);(1,1);(0,1)}
1633  SELECT CASE(basis%INTERPOLATION_ORDER(1))
1634  CASE(basis_linear_interpolation_order)
1635  !First sub-element
1636  ne=(grid_ne-1)*element_factor+1
1637  element_nodes(1)=np
1638  element_nodes(2)=np+1
1639  element_nodes(3)=np+1+total_number_of_nodes_xi(1)
1640  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1641  & element_nodes_user_numbers,err,error,*999)
1642  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1643  & element_nodes_user_numbers,err,error,*999)
1644  !Second sub-element
1645  ne=(grid_ne-1)*element_factor+2
1646  element_nodes(1)=np
1647  element_nodes(2)=np+1+total_number_of_nodes_xi(1)
1648  element_nodes(3)=np+total_number_of_nodes_xi(1)
1649  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1650  & element_nodes_user_numbers,err,error,*999)
1651  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1652  & element_nodes_user_numbers,err,error,*999)
1653  CASE(basis_quadratic_interpolation_order)
1654  !First sub-element
1655  ne=(grid_ne-1)*element_factor+1
1656  element_nodes(1)=np
1657  element_nodes(2)=np+2
1658  element_nodes(3)=np+2+2*total_number_of_nodes_xi(1)
1659  element_nodes(4)=np+1
1660  element_nodes(5)=np+2+total_number_of_nodes_xi(1)
1661  element_nodes(6)=np+1+total_number_of_nodes_xi(1)
1662  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1663  & element_nodes_user_numbers,err,error,*999)
1664  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1665  & element_nodes_user_numbers,err,error,*999)
1666  !Second sub-element
1667  ne=(grid_ne-1)*element_factor+2
1668  element_nodes(1)=np
1669  element_nodes(2)=np+2+2*total_number_of_nodes_xi(1)
1670  element_nodes(3)=np+2*total_number_of_nodes_xi(1)
1671  element_nodes(4)=np+1+total_number_of_nodes_xi(1)
1672  element_nodes(5)=np+1+2*total_number_of_nodes_xi(1)
1673  element_nodes(6)=np+total_number_of_nodes_xi(1)
1674  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1675  & element_nodes_user_numbers,err,error,*999)
1676  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1677  & element_nodes_user_numbers,err,error,*999)
1678  CASE(basis_cubic_interpolation_order)
1679  !First sub-element
1680  ne=(grid_ne-1)*element_factor+1
1681  element_nodes(1)=np
1682  element_nodes(2)=np+3
1683  element_nodes(3)=np+3+3*total_number_of_nodes_xi(1)
1684  element_nodes(4)=np+1
1685  element_nodes(5)=np+2
1686  element_nodes(6)=np+3+total_number_of_nodes_xi(1)
1687  element_nodes(7)=np+3+2*total_number_of_nodes_xi(1)
1688  element_nodes(8)=np+2+2*total_number_of_nodes_xi(1)
1689  element_nodes(9)=np+1+total_number_of_nodes_xi(1)
1690  element_nodes(10)=np+2+total_number_of_nodes_xi(1)
1691  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1692  & element_nodes_user_numbers,err,error,*999)
1693  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1694  & element_nodes_user_numbers,err,error,*999)
1695  !Second sub-element
1696  ne=(grid_ne-1)*element_factor+2
1697  element_nodes(1)=np
1698  element_nodes(2)=np+3+3*total_number_of_nodes_xi(1)
1699  element_nodes(3)=np+3*total_number_of_nodes_xi(1)
1700  element_nodes(4)=np+2+2*total_number_of_nodes_xi(1)
1701  element_nodes(5)=np+1+total_number_of_nodes_xi(1)
1702  element_nodes(6)=np+2+3*total_number_of_nodes_xi(1)
1703  element_nodes(7)=np+1+3*total_number_of_nodes_xi(1)
1704  element_nodes(8)=np+total_number_of_nodes_xi(1)
1705  element_nodes(9)=np+2*total_number_of_nodes_xi(1)
1706  element_nodes(10)=np+1+2*total_number_of_nodes_xi(1)
1707  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1708  & element_nodes_user_numbers,err,error,*999)
1709  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1710  & element_nodes_user_numbers,err,error,*999)
1711  CASE DEFAULT
1712  local_error="The simplex basis interpolation order of "// &
1713  & trim(number_to_vstring(basis%INTERPOLATION_ORDER(1),"*",err,error))// &
1714  & " is invalid."
1715  CALL flagerror(local_error,err,error,*999)
1716  END SELECT
1717  CASE(3)
1718  !Tetrahedra element
1719  !Break the grid cube element into 6 tetrahedra (so that we have a break down the main diagonal of the
1720  !cube in order to allow for the middle node in quadratics to be included). The 6 tetrahedra are
1721  !Element 1: vertices {(0,0,0);(1,0,0);(1,1,0);(1,1,1)}
1722  !Element 2: vertices {(0,0,0);(1,1,0);(0,1,0);(1,1,1)}
1723  !Element 3: vertices {(0,0,0);(1,0,1);(1,0,0);(1,1,1)}
1724  !Element 4: vertices {(0,0,0);(0,0,1);(1,0,1);(1,1,1)}
1725  !Element 5: vertices {(0,0,0);(0,1,0);(0,1,1);(1,1,1)}
1726  !Element 6: vertices {(0,0,0);(0,1,1);(0,0,1);(1,1,1)}
1727  SELECT CASE(basis%INTERPOLATION_ORDER(1))
1728  CASE(basis_linear_interpolation_order)
1729  !First sub-element
1730  ne=(grid_ne-1)*element_factor+1
1731  element_nodes(1)=np
1732  element_nodes(2)=np+1
1733  element_nodes(3)=np+1+total_number_of_nodes_xi(1)
1734  element_nodes(4)=np+1+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1735  & total_number_of_nodes_xi(2)
1736  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1737  & element_nodes_user_numbers,err,error,*999)
1738  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1739  & element_nodes_user_numbers,err,error,*999)
1740  !Second sub-element
1741  ne=(grid_ne-1)*element_factor+2
1742  element_nodes(1)=np
1743  element_nodes(2)=np+1+total_number_of_nodes_xi(1)
1744  element_nodes(3)=np+total_number_of_nodes_xi(1)
1745  element_nodes(4)=np+1+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1746  & total_number_of_nodes_xi(2)
1747  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1748  & element_nodes_user_numbers,err,error,*999)
1749  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1750  & element_nodes_user_numbers,err,error,*999)
1751  !Third sub-element
1752  ne=(grid_ne-1)*element_factor+3
1753  element_nodes(1)=np
1754  element_nodes(2)=np+1+total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
1755  element_nodes(3)=np+1
1756  element_nodes(4)=np+1+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1757  & total_number_of_nodes_xi(2)
1758  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1759  & element_nodes_user_numbers,err,error,*999)
1760  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1761  & element_nodes_user_numbers,err,error,*999)
1762  !Fourth sub-element
1763  ne=(grid_ne-1)*element_factor+4
1764  element_nodes(1)=np
1765  element_nodes(2)=np+total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
1766  element_nodes(3)=np+1+total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
1767  element_nodes(4)=np+1+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1768  & total_number_of_nodes_xi(2)
1769  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1770  & element_nodes_user_numbers,err,error,*999)
1771  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1772  & element_nodes_user_numbers,err,error,*999)
1773  !Fifth sub-element
1774  ne=(grid_ne-1)*element_factor+5
1775  element_nodes(1)=np
1776  element_nodes(2)=np+total_number_of_nodes_xi(1)
1777  element_nodes(3)=np+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1778  & total_number_of_nodes_xi(2)
1779  element_nodes(4)=np+1+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1780  & total_number_of_nodes_xi(2)
1781  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1782  & element_nodes_user_numbers,err,error,*999)
1783  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1784  & element_nodes_user_numbers,err,error,*999)
1785  !Sixth sub-element
1786  ne=(grid_ne-1)*element_factor+6
1787  element_nodes(1)=np
1788  element_nodes(2)=np+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1789  & total_number_of_nodes_xi(2)
1790  element_nodes(3)=np+total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
1791  element_nodes(4)=np+1+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1792  & total_number_of_nodes_xi(2)
1793  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1794  & element_nodes_user_numbers,err,error,*999)
1795  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1796  & element_nodes_user_numbers,err,error,*999)
1797  CASE(basis_quadratic_interpolation_order)
1798  !First sub-element
1799  ne=(grid_ne-1)*element_factor+1
1800  element_nodes(1)=np
1801  element_nodes(2)=np+2
1802  element_nodes(3)=np+2+2*total_number_of_nodes_xi(1)
1803  element_nodes(4)=np+2+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1804  & total_number_of_nodes_xi(2)
1805  element_nodes(5)=np+1
1806  element_nodes(6)=np+1+total_number_of_nodes_xi(1)
1807  element_nodes(7)=np+1+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1808  & total_number_of_nodes_xi(2)
1809  element_nodes(8)=np+2+total_number_of_nodes_xi(1)
1810  element_nodes(9)=np+2+2*total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1811  & total_number_of_nodes_xi(2)
1812  element_nodes(10)=np+2+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1813  & total_number_of_nodes_xi(2)
1814  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1815  & element_nodes_user_numbers,err,error,*999)
1816  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1817  & element_nodes_user_numbers,err,error,*999)
1818  !Second sub-element
1819  ne=(grid_ne-1)*element_factor+2
1820  element_nodes(1)=np
1821  element_nodes(2)=np+2+2*total_number_of_nodes_xi(1)
1822  element_nodes(3)=np+2*total_number_of_nodes_xi(1)
1823  element_nodes(4)=np+2+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1824  & total_number_of_nodes_xi(2)
1825  element_nodes(5)=np+1+total_number_of_nodes_xi(1)
1826  element_nodes(6)=np+total_number_of_nodes_xi(1)
1827  element_nodes(7)=np+1+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1828  & total_number_of_nodes_xi(2)
1829  element_nodes(8)=np+1+2*total_number_of_nodes_xi(1)
1830  element_nodes(9)=np+1+2*total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1831  & total_number_of_nodes_xi(2)
1832  element_nodes(10)=np+2+2*total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1833  & total_number_of_nodes_xi(2)
1834  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1835  & element_nodes_user_numbers,err,error,*999)
1836  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1837  & element_nodes_user_numbers,err,error,*999)
1838  !Third sub-element
1839  ne=(grid_ne-1)*element_factor+3
1840  element_nodes(1)=np
1841  element_nodes(2)=np+2+2*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
1842  element_nodes(3)=np+2
1843  element_nodes(4)=np+2+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1844  & total_number_of_nodes_xi(2)
1845  element_nodes(5)=np+1+total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
1846  element_nodes(6)=np+1
1847  element_nodes(7)=np+1+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1848  & total_number_of_nodes_xi(2)
1849  element_nodes(8)=np+2+total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
1850  element_nodes(9)=np+2+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1851  & total_number_of_nodes_xi(2)
1852  element_nodes(10)=np+2+total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1853  & total_number_of_nodes_xi(2)
1854  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1855  & element_nodes_user_numbers,err,error,*999)
1856  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1857  & element_nodes_user_numbers,err,error,*999)
1858  !Fourth sub-element
1859  ne=(grid_ne-1)*element_factor+4
1860  element_nodes(1)=np
1861  element_nodes(2)=np+2*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
1862  element_nodes(3)=np+2+2*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
1863  element_nodes(4)=np+2+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1864  & total_number_of_nodes_xi(2)
1865  element_nodes(5)=np+total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
1866  element_nodes(6)=np+1+total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
1867  element_nodes(7)=np+1+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1868  & total_number_of_nodes_xi(2)
1869  element_nodes(8)=np+1+2*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
1870  element_nodes(9)=np+2+total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1871  & total_number_of_nodes_xi(2)
1872  element_nodes(10)=np+1+total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1873  & total_number_of_nodes_xi(2)
1874  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1875  & element_nodes_user_numbers,err,error,*999)
1876  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1877  & element_nodes_user_numbers,err,error,*999)
1878  !Fifth sub-element
1879  ne=(grid_ne-1)*element_factor+5
1880  element_nodes(1)=np
1881  element_nodes(2)=np+2*total_number_of_nodes_xi(1)
1882  element_nodes(3)=np+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1883  & total_number_of_nodes_xi(2)
1884  element_nodes(4)=np+2+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1885  & total_number_of_nodes_xi(2)
1886  element_nodes(5)=np+total_number_of_nodes_xi(1)
1887  element_nodes(6)=np+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1888  & total_number_of_nodes_xi(2)
1889  element_nodes(7)=np+1+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1890  & total_number_of_nodes_xi(2)
1891  element_nodes(8)=np+2*total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1892  & total_number_of_nodes_xi(2)
1893  element_nodes(9)=np+1+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1894  & total_number_of_nodes_xi(2)
1895  element_nodes(10)=np+1+2*total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1896  & total_number_of_nodes_xi(2)
1897  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1898  & element_nodes_user_numbers,err,error,*999)
1899  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1900  & element_nodes_user_numbers,err,error,*999)
1901  !Sixth sub-element
1902  ne=(grid_ne-1)*element_factor+6
1903  element_nodes(1)=np
1904  element_nodes(2)=np+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1905  & total_number_of_nodes_xi(2)
1906  element_nodes(3)=np+2*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
1907  element_nodes(4)=np+2+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1908  & total_number_of_nodes_xi(2)
1909  element_nodes(5)=np+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1910  & total_number_of_nodes_xi(2)
1911  element_nodes(6)=np+total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
1912  element_nodes(7)=np+1+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1913  & total_number_of_nodes_xi(2)
1914  element_nodes(8)=np+total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1915  & total_number_of_nodes_xi(2)
1916  element_nodes(9)=np+1+total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1917  & total_number_of_nodes_xi(2)
1918  element_nodes(10)=np+1+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1919  & total_number_of_nodes_xi(2)
1920  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1921  & element_nodes_user_numbers,err,error,*999)
1922  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1923  & element_nodes_user_numbers,err,error,*999)
1924  CASE(basis_cubic_interpolation_order)
1925  !First sub-element
1926  ne=(grid_ne-1)*element_factor+1
1927  element_nodes(1)=np
1928  element_nodes(2)=np+3
1929  element_nodes(3)=np+3+3*total_number_of_nodes_xi(1)
1930  element_nodes(4)=np+3+3*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
1931  & total_number_of_nodes_xi(2)
1932  element_nodes(5)=np+1
1933  element_nodes(6)=np+2
1934  element_nodes(7)=np+1+total_number_of_nodes_xi(1)
1935  element_nodes(8)=np+2+2*total_number_of_nodes_xi(1)
1936  element_nodes(9)=np+1+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1937  & total_number_of_nodes_xi(2)
1938  element_nodes(10)=np+2+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1939  & total_number_of_nodes_xi(2)
1940  element_nodes(11)=np+3+total_number_of_nodes_xi(1)
1941  element_nodes(12)=np+3+2*total_number_of_nodes_xi(1)
1942  element_nodes(13)=np+3+3*total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1943  & total_number_of_nodes_xi(2)
1944  element_nodes(14)=np+3+3*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1945  & total_number_of_nodes_xi(2)
1946  element_nodes(15)=np+3+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1947  & total_number_of_nodes_xi(2)
1948  element_nodes(16)=np+3+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1949  & total_number_of_nodes_xi(2)
1950  element_nodes(17)=np+2+total_number_of_nodes_xi(1)
1951  element_nodes(18)=np+2*total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1952  & total_number_of_nodes_xi(2)
1953  element_nodes(19)=np+2+2*total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1954  & total_number_of_nodes_xi(2)
1955  element_nodes(20)=np+3+2*total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1956  & total_number_of_nodes_xi(2)
1957  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1958  & element_nodes_user_numbers,err,error,*999)
1959  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1960  & element_nodes_user_numbers,err,error,*999)
1961  !Second sub-element
1962  ne=(grid_ne-1)*element_factor+2
1963  element_nodes(1)=np
1964  element_nodes(2)=np+3+3*total_number_of_nodes_xi(1)
1965  element_nodes(3)=np+3*total_number_of_nodes_xi(1)
1966  element_nodes(4)=np+3+3*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
1967  & total_number_of_nodes_xi(2)
1968  element_nodes(5)=np+1+total_number_of_nodes_xi(1)
1969  element_nodes(6)=np+2+2*total_number_of_nodes_xi(1)
1970  element_nodes(7)=np+total_number_of_nodes_xi(1)
1971  element_nodes(8)=np+2*total_number_of_nodes_xi(1)
1972  element_nodes(9)=np+1+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1973  & total_number_of_nodes_xi(2)
1974  element_nodes(10)=np+2+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1975  & total_number_of_nodes_xi(2)
1976  element_nodes(11)=np+2+3*total_number_of_nodes_xi(1)
1977  element_nodes(12)=np+1+3*total_number_of_nodes_xi(1)
1978  element_nodes(13)=np+1+3*total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1979  & total_number_of_nodes_xi(2)
1980  element_nodes(14)=np+2+3*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1981  & total_number_of_nodes_xi(2)
1982  element_nodes(15)=np+3+3*total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1983  & total_number_of_nodes_xi(2)
1984  element_nodes(16)=np+3+3*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
1985  & total_number_of_nodes_xi(2)
1986  element_nodes(17)=np+1+2*total_number_of_nodes_xi(1)
1987  element_nodes(18)=np+2+2*total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1988  & total_number_of_nodes_xi(2)
1989  element_nodes(19)=np+1+2*total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1990  & total_number_of_nodes_xi(2)
1991  element_nodes(20)=np+2+3*total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
1992  & total_number_of_nodes_xi(2)
1993  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
1994  & element_nodes_user_numbers,err,error,*999)
1995  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
1996  & element_nodes_user_numbers,err,error,*999)
1997  !Third sub-element
1998  ne=(grid_ne-1)*element_factor+3
1999  element_nodes(1)=np
2000  element_nodes(2)=np+3+3*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
2001  element_nodes(3)=np+3
2002  element_nodes(4)=np+3+3*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2003  & total_number_of_nodes_xi(2)
2004  element_nodes(5)=np+1+total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
2005  element_nodes(6)=np+2+2*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
2006  element_nodes(7)=np+1
2007  element_nodes(8)=np+2
2008  element_nodes(9)=np+1+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
2009  & total_number_of_nodes_xi(2)
2010  element_nodes(10)=np+2+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
2011  & total_number_of_nodes_xi(2)
2012  element_nodes(11)=np+3+2*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
2013  element_nodes(12)=np+3+total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
2014  element_nodes(13)=np+3+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
2015  & total_number_of_nodes_xi(2)
2016  element_nodes(14)=np+3+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
2017  & total_number_of_nodes_xi(2)
2018  element_nodes(15)=np+3+total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2019  & total_number_of_nodes_xi(2)
2020  element_nodes(16)=np+3+2*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2021  & total_number_of_nodes_xi(2)
2022  element_nodes(17)=np+2+2*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2023  & total_number_of_nodes_xi(2)
2024  element_nodes(18)=np+2+total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
2025  & total_number_of_nodes_xi(2)
2026  element_nodes(19)=np+2+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
2027  & total_number_of_nodes_xi(2)
2028  element_nodes(20)=np+3+total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
2029  & total_number_of_nodes_xi(2)
2030  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
2031  & element_nodes_user_numbers,err,error,*999)
2032  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
2033  & element_nodes_user_numbers,err,error,*999)
2034  !Fourth sub-element
2035  ne=(grid_ne-1)*element_factor+4
2036  element_nodes(1)=np
2037  element_nodes(2)=np+3*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
2038  element_nodes(3)=np+3+3*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
2039  element_nodes(4)=np+3+3*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2040  & total_number_of_nodes_xi(2)
2041  element_nodes(5)=np+total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
2042  element_nodes(6)=np+2*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
2043  element_nodes(7)=np+1+total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
2044  element_nodes(8)=np+2+2*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
2045  element_nodes(9)=np+1+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
2046  & total_number_of_nodes_xi(2)
2047  element_nodes(10)=np+2+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
2048  & total_number_of_nodes_xi(2)
2049  element_nodes(11)=np+1+3*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
2050  element_nodes(12)=np+2+3*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
2051  element_nodes(13)=np+3+total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2052  & total_number_of_nodes_xi(2)
2053  element_nodes(14)=np+3+2*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2054  & total_number_of_nodes_xi(2)
2055  element_nodes(15)=np+1+total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2056  & total_number_of_nodes_xi(2)
2057  element_nodes(16)=np+2+2*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2058  & total_number_of_nodes_xi(2)
2059  element_nodes(17)=np+1+2*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
2060  element_nodes(18)=np+1+total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
2061  & total_number_of_nodes_xi(2)
2062  element_nodes(19)=np+2+total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
2063  & total_number_of_nodes_xi(2)
2064  element_nodes(20)=np+2+total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2065  & total_number_of_nodes_xi(2)
2066  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
2067  & element_nodes_user_numbers,err,error,*999)
2068  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
2069  & element_nodes_user_numbers,err,error,*999)
2070  !Fifth sub-element
2071  ne=(grid_ne-1)*element_factor+5
2072  element_nodes(1)=np
2073  element_nodes(2)=np+3*total_number_of_nodes_xi(1)
2074  element_nodes(3)=np+3*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2075  & total_number_of_nodes_xi(2)
2076  element_nodes(4)=np+3+3*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2077  & total_number_of_nodes_xi(2)
2078  element_nodes(5)=np+total_number_of_nodes_xi(1)
2079  element_nodes(6)=np+2*total_number_of_nodes_xi(1)
2080  element_nodes(7)=np+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
2081  & total_number_of_nodes_xi(2)
2082  element_nodes(8)=np+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
2083  & total_number_of_nodes_xi(2)
2084  element_nodes(9)=np+1+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
2085  & total_number_of_nodes_xi(2)
2086  element_nodes(10)=np+2+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
2087  & total_number_of_nodes_xi(2)
2088  element_nodes(11)=np+3*total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
2089  & total_number_of_nodes_xi(2)
2090  element_nodes(12)=np+3*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
2091  & total_number_of_nodes_xi(2)
2092  element_nodes(13)=np+1+3*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2093  & total_number_of_nodes_xi(2)
2094  element_nodes(14)=np+2+3*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2095  & total_number_of_nodes_xi(2)
2096  element_nodes(15)=np+1+3*total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
2097  & total_number_of_nodes_xi(2)
2098  element_nodes(16)=np+2+3*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
2099  & total_number_of_nodes_xi(2)
2100  element_nodes(17)=np+2*total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
2101  & total_number_of_nodes_xi(2)
2102  element_nodes(18)=np+1+2*total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
2103  & total_number_of_nodes_xi(2)
2104  element_nodes(19)=np+1+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
2105  & total_number_of_nodes_xi(2)
2106  element_nodes(20)=np+1+3*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
2107  & total_number_of_nodes_xi(2)
2108  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
2109  & element_nodes_user_numbers,err,error,*999)
2110  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
2111  & element_nodes_user_numbers,err,error,*999)
2112  !Sixth sub-element
2113  ne=(grid_ne-1)*element_factor+6
2114  element_nodes(1)=np
2115  element_nodes(2)=np+3*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2116  & total_number_of_nodes_xi(2)
2117  element_nodes(3)=np+3*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
2118  element_nodes(4)=np+3+3*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2119  & total_number_of_nodes_xi(2)
2120  element_nodes(5)=np+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
2121  & total_number_of_nodes_xi(2)
2122  element_nodes(6)=np+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
2123  & total_number_of_nodes_xi(2)
2124  element_nodes(7)=np+total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
2125  element_nodes(8)=np+2*total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)
2126  element_nodes(9)=np+1+total_number_of_nodes_xi(1)+total_number_of_nodes_xi(1)* &
2127  & total_number_of_nodes_xi(2)
2128  element_nodes(10)=np+2+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
2129  & total_number_of_nodes_xi(2)
2130  element_nodes(11)=np+2*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2131  & total_number_of_nodes_xi(2)
2132  element_nodes(12)=np+total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2133  & total_number_of_nodes_xi(2)
2134  element_nodes(13)=np+1+total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2135  & total_number_of_nodes_xi(2)
2136  element_nodes(14)=np+2+2*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2137  & total_number_of_nodes_xi(2)
2138  element_nodes(15)=np+1+3*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2139  & total_number_of_nodes_xi(2)
2140  element_nodes(16)=np+2+3*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2141  & total_number_of_nodes_xi(2)
2142  element_nodes(17)=np+total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
2143  & total_number_of_nodes_xi(2)
2144  element_nodes(18)=np+1+2*total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
2145  & total_number_of_nodes_xi(2)
2146  element_nodes(19)=np+1+total_number_of_nodes_xi(1)+2*total_number_of_nodes_xi(1)* &
2147  & total_number_of_nodes_xi(2)
2148  element_nodes(20)=np+1+2*total_number_of_nodes_xi(1)+3*total_number_of_nodes_xi(1)* &
2149  & total_number_of_nodes_xi(2)
2150  CALL component_nodes_to_user_numbers(regular_mesh%GENERATED_MESH,basis_idx,element_nodes, &
2151  & element_nodes_user_numbers,err,error,*999)
2152  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
2153  & element_nodes_user_numbers,err,error,*999)
2154  CASE DEFAULT
2155  local_error="The simplex basis interpolation order of "// &
2156  & trim(number_to_vstring(basis%INTERPOLATION_ORDER(1),"*",err,error))// &
2157  & " is invalid."
2158  CALL flagerror(local_error,err,error,*999)
2159  END SELECT
2160  CASE DEFAULT
2161  local_error="The simplex number of xi directions of "// &
2162  & trim(number_to_vstring(basis%NUMBER_OF_XI,"*",err,error))// &
2163  & " is invalid."
2164  CALL flagerror(local_error,err,error,*999)
2165  END SELECT
2166  ENDIF
2167  ENDIF
2168  ENDIF
2169  ENDIF
2170  ENDDO !ne1
2171  ENDDO !ne2
2172  ENDDO !ne3
2173  CALL mesh_topology_elements_create_finish(mesh_elements,err,error,*999)
2174  ENDDO !basis_idx
2175  !Finish the mesh
2176  CALL mesh_create_finish(generated_mesh%MESH,err,error,*999)
2177  CASE DEFAULT
2178  CALL flagerror("Basis type is either invalid or not implemented.",err,error,*999)
2179  END SELECT
2180  ELSE
2181  CALL flagerror("Bases are not allocated.",err,error,*999)
2182  ENDIF
2183  CASE(coordinate_cylindrical_polar_type)
2184  CALL flagerror("Not implemented.",err,error,*999)
2185  CASE(coordinate_spherical_polar_type)
2186  CALL flagerror("Not implemented.",err,error,*999)
2187  CASE(coordinate_prolate_spheroidal_type)
2188  CALL flagerror("Not implemented.",err,error,*999)
2189  CASE(coordinate_oblate_spheroidal_type)
2190  CALL flagerror("Not implemented.",err,error,*999)
2191  CASE DEFAULT
2192  local_error="The coordinate system type of "//trim(number_to_vstring(coordinate_system%TYPE,"*",err,error))// &
2193  & " is invalid."
2194  CALL flagerror(local_error,err,error,*999)
2195  END SELECT
2196  ELSE
2197  CALL flagerror("Regular mesh is not associated.",err,error,*999)
2198  ENDIF
2199  ELSE
2200  CALL flagerror("Generated Mesh is not associated.",err,error,*999)
2201  ENDIF
2202 
2203  IF(ALLOCATED(element_nodes)) DEALLOCATE(element_nodes)
2204 
2205  exits("GENERATED_MESH_REGULAR_CREATE_FINISH")
2206  RETURN
2207  ! TODO invalidate other associations
2208 999 IF(ALLOCATED(element_nodes)) DEALLOCATE(element_nodes)
2209  errorsexits("GENERATED_MESH_REGULAR_CREATE_FINISH",err,error)
2210  RETURN 1
2211  END SUBROUTINE generated_mesh_regular_create_finish
2212 
2213  !
2214  !================================================================================================================================
2215  !
2216 
2218  SUBROUTINE generated_mesh_ellipsoid_create_finish(GENERATED_MESH,MESH_USER_NUMBER,ERR,ERROR,*)
2219 
2220  !Argument variables
2221  TYPE(generated_mesh_type), POINTER :: generated_mesh
2222  INTEGER(INTG), INTENT(IN) :: mesh_user_number
2223  INTEGER(INTG), INTENT(OUT) :: err
2224  TYPE(varying_string), INTENT(OUT) :: error
2225  !Local Variables
2226  TYPE(generated_mesh_ellipsoid_type), POINTER :: ellipsoid_mesh
2227  TYPE(basis_type), POINTER :: basis1,basis2
2228  INTEGER(INTG), ALLOCATABLE :: number_elements_xi(:)!,NUMBER_OF_NODES_XIC(:)
2229  TYPE(region_type), POINTER :: region
2230  TYPE(nodes_type), POINTER :: nodes
2231  INTEGER(INTG) :: total_number_of_nodes,total_number_of_elements,number_of_dimensions
2232  INTEGER(INTG) :: basis_number_of_nodes,corner_number_of_nodes
2233  INTEGER(INTG) :: ne1,ne2,ne3,nn1,nn2,nn3,from1,from2,from3,nn,ne,mc
2234  INTEGER(INTG), ALLOCATABLE :: apex_element_nodes(:), wall_element_nodes(:)
2235  INTEGER(INTG), ALLOCATABLE :: apex_element_nodes_user_numbers(:), wall_element_nodes_user_numbers(:)
2236  INTEGER(INTG), ALLOCATABLE :: nidx(:,:,:),corner_nodes(:,:,:),eidx(:,:,:)
2237  REAL(DP) :: delta(3),deltai(3)
2238  TYPE(meshelementstype), POINTER :: mesh_elements
2239 
2240  enters("GENERATED_MESH_ELLIPSOID_CREATE_FINISH",err,error,*999)
2241 
2242  IF(ASSOCIATED(generated_mesh)) THEN
2243  ellipsoid_mesh=>generated_mesh%ELLIPSOID_MESH
2244  IF(ASSOCIATED(ellipsoid_mesh)) THEN
2245  region=>generated_mesh%REGION
2246  IF(ASSOCIATED(region)) THEN
2247  IF(ASSOCIATED(region%COORDINATE_SYSTEM)) THEN
2248  SELECT CASE(region%COORDINATE_SYSTEM%TYPE)
2249  CASE(coordinate_rectangular_cartesian_type)
2250  !Determine the coordinate system and create the regular mesh for that system
2251  ellipsoid_mesh%MESH_DIMENSION=region%COORDINATE_SYSTEM%NUMBER_OF_DIMENSIONS
2252  number_of_dimensions=ellipsoid_mesh%MESH_DIMENSION
2253  IF(number_of_dimensions==3) THEN ! hard-coded for 3D only
2254  IF(.NOT.ALLOCATED(ellipsoid_mesh%ORIGIN)) THEN
2255  ALLOCATE(ellipsoid_mesh%ORIGIN(number_of_dimensions),stat=err)
2256  IF(err/=0) CALL flagerror("Could not allocate origin.",err,error,*999)
2257  ellipsoid_mesh%ORIGIN=0.0_dp
2258  ENDIF
2259  IF(SIZE(ellipsoid_mesh%ORIGIN)==ellipsoid_mesh%MESH_DIMENSION) THEN
2260  IF(SIZE(ellipsoid_mesh%ELLIPSOID_EXTENT)==4) THEN
2261  IF(ALLOCATED(ellipsoid_mesh%BASES)) THEN
2262  IF(mod(SIZE(ellipsoid_mesh%BASES),2)==0) THEN
2263  ALLOCATE(number_elements_xi(SIZE(ellipsoid_mesh%NUMBER_OF_ELEMENTS_XI)),stat=err)
2264  IF(err/=0) CALL flagerror("Could not allocate number of elements xi.",err,error,*999)
2265  number_elements_xi(1:SIZE(ellipsoid_mesh%NUMBER_OF_ELEMENTS_XI))= &
2266  & ellipsoid_mesh%NUMBER_OF_ELEMENTS_XI(1:SIZE(ellipsoid_mesh%NUMBER_OF_ELEMENTS_XI))
2267  !Calculate total number of nodes from all bases and start mesh
2268  corner_number_of_nodes=number_elements_xi(1)*(number_elements_xi(2)+1)*(number_elements_xi(3)+1)- &
2269  & (number_elements_xi(1)-1)*(number_elements_xi(3)+1)
2270  total_number_of_nodes=corner_number_of_nodes
2271  DO mc=1,SIZE(ellipsoid_mesh%BASES),2
2272  basis1=>ellipsoid_mesh%BASES(mc)%PTR
2273  basis_number_of_nodes=number_elements_xi(1)*(basis1%NUMBER_OF_NODES_XIC(1)-1)* &
2274  & (number_elements_xi(2)*(basis1%NUMBER_OF_NODES_XIC(2)-1)+1)* &
2275  & (number_elements_xi(3)*(basis1%NUMBER_OF_NODES_XIC(3)-1)+1)- &
2276  & (number_elements_xi(1)*(basis1%NUMBER_OF_NODES_XIC(1)-1)-1)* &
2277  & (number_elements_xi(3)*(basis1%NUMBER_OF_NODES_XIC(3)-1)+1)
2278  total_number_of_nodes=total_number_of_nodes+basis_number_of_nodes-corner_number_of_nodes
2279  ENDDO
2280  NULLIFY(nodes)
2281  CALL nodes_create_start(region,total_number_of_nodes,nodes,err,error,*999)
2282  !Finish the nodes creation
2283  CALL nodes_create_finish(nodes,err,error,*999)
2284  !Create the mesh
2285  CALL mesh_create_start(mesh_user_number,generated_mesh%REGION, &
2286  & SIZE(number_elements_xi,1), generated_mesh%MESH,err,error,*999)
2287  !Create the elements
2288  CALL mesh_number_of_components_set(generated_mesh%MESH,SIZE(ellipsoid_mesh%BASES)/2,err,error,*999)
2289  DO mc=1,SIZE(ellipsoid_mesh%BASES),2
2290  IF((ellipsoid_mesh%BASES(mc)%PTR%NUMBER_OF_COLLAPSED_XI==0).AND. &
2291  & (ellipsoid_mesh%BASES(mc+1)%PTR%NUMBER_OF_COLLAPSED_XI>0))THEN
2292  !test for collapsed nodes and force non collapsed to wall elements and collapsed to apex elements
2293  basis1=>ellipsoid_mesh%BASES(mc)%PTR
2294  basis2=>ellipsoid_mesh%BASES(mc+1)%PTR
2295  ELSE
2296  CALL flagerror("For each basis, one non collapsed version (basis1) and one collapsed "// &
2297  "version (basis2) is needed.",err,error,*999)
2298  ENDIF
2299  SELECT CASE(basis1%TYPE)
2300  !should also test for basis2
2301  CASE(basis_lagrange_hermite_tp_type)
2302  IF(basis1%NUMBER_OF_XI==SIZE(number_elements_xi,1).AND. &
2303  & basis2%NUMBER_OF_XI==SIZE(number_elements_xi,1)) THEN
2304  IF(.NOT.all(number_elements_xi>0)) &
2305  & CALL flagerror("Must have 1 or more elements in all directions.",err,error,*999)
2306  IF(number_elements_xi(1)<3) &
2307  & CALL flagerror("Need >2 elements around the circumferential direction.", &
2308  & err,error,*999)
2309  !IF(.NOT.ALL(BASIS%COLLAPSED_XI==BASIS_NOT_COLLAPSED)) &
2310  ! & CALL FlagError("Degenerate (collapsed) basis not implemented.",ERR,ERROR,*999)
2311  IF(ALLOCATED(nidx)) DEALLOCATE(nidx)
2312  IF(ALLOCATED(eidx)) DEALLOCATE(eidx)
2313  IF(ALLOCATED(corner_nodes)) DEALLOCATE(corner_nodes)
2314  CALL generated_mesh_ellipsoid_build_node_indices(number_elements_xi,basis1% &
2315  number_of_nodes_xic, ellipsoid_mesh%ELLIPSOID_EXTENT, total_number_of_nodes, &
2316  total_number_of_elements, nidx,corner_nodes,eidx,delta,deltai,err,error,*999)
2317  IF(mc==1) THEN
2318  CALL mesh_number_of_elements_set(generated_mesh%MESH,total_number_of_elements, &
2319  & err,error,*999)
2320  ENDIF
2321 
2322  !Create the default node set
2323  !TODO we finish create after the nodes are initialised?
2324 
2325  NULLIFY(mesh_elements)
2326  CALL mesh_topology_elements_create_start(generated_mesh%MESH,mc/2+1,basis1,mesh_elements, &
2327  err, error,*999)
2328  !Set the elements for the ellipsoid mesh
2329  IF(ALLOCATED(wall_element_nodes)) DEALLOCATE(wall_element_nodes)
2330  IF(ALLOCATED(apex_element_nodes)) DEALLOCATE(apex_element_nodes)
2331  IF(ALLOCATED(wall_element_nodes_user_numbers)) DEALLOCATE(wall_element_nodes_user_numbers)
2332  IF(ALLOCATED(apex_element_nodes_user_numbers)) DEALLOCATE(apex_element_nodes_user_numbers)
2333  ALLOCATE(wall_element_nodes(basis1%NUMBER_OF_NODES),stat=err)
2334  IF(err/=0) CALL flagerror("Could not allocate wall element nodes.",err,error,*999)
2335  ALLOCATE(apex_element_nodes(basis2%NUMBER_OF_NODES),stat=err)
2336  IF(err/=0) CALL flagerror("Could not allocate apex element nodes.",err,error,*999)
2337  ALLOCATE(wall_element_nodes_user_numbers(basis1%NUMBER_OF_NODES),stat=err)
2338  IF(err/=0) CALL flagerror("Could not allocate wall element nodes.",err,error,*999)
2339  ALLOCATE(apex_element_nodes_user_numbers(basis2%NUMBER_OF_NODES),stat=err)
2340  IF(err/=0) CALL flagerror("Could not allocate apex element nodes.",err,error,*999)
2341  ! calculate element topology (nodes per each element)
2342  ! the idea is to translate given (r,theta,z) to NIDX equivalents, which include interior nodes
2343  ne=0
2344  nn=0
2345  !fromJ=global J direction counting number of first node in element in J direction
2346  DO ne3=1,number_elements_xi(3)
2347  from3=nint(delta(3)*(ne3-1)/deltai(3)+1)
2348  ne2=1
2349  from2=nint(delta(2)*(ne2-1)/deltai(2)+1)
2350  !apex elements
2351  DO ne1=1,number_elements_xi(1)
2352  from1=nint(delta(1)*(ne1-1)/deltai(1)+1)
2353  nn=0
2354  ! number of nodes in an element is dependent on basis used
2355  DO nn3=from3,from3+basis2%NUMBER_OF_NODES_XIC(3)-1
2356  nn2=1
2357  nn1=1
2358  !central axis nodes
2359  nn=nn+1
2360  apex_element_nodes(nn)=nidx(nn1,nn2,nn3)
2361  DO nn2=from2+1,from2+basis2%NUMBER_OF_NODES_XIC(2)-1
2362  DO nn1=from1,from1+basis2%NUMBER_OF_NODES_XIC(1)-1
2363  nn=nn+1
2364  ! circumferential loop-around
2365  IF(nn1>SIZE(nidx,1)) THEN
2366  apex_element_nodes(nn)=nidx(1,nn2,nn3)
2367  ELSE
2368  apex_element_nodes(nn)=nidx(nn1,nn2,nn3)
2369  ENDIF
2370  ENDDO ! nn1
2371  ENDDO ! nn2
2372  ENDDO ! nn3
2373  ne=ne+1
2374  CALL mesh_topology_elements_element_basis_set(ne,mesh_elements,basis2,err,error,*999)
2375  CALL component_nodes_to_user_numbers(ellipsoid_mesh%GENERATED_MESH,mc,apex_element_nodes, &
2376  & apex_element_nodes_user_numbers,err,error,*999)
2377  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
2378  apex_element_nodes_user_numbers,err,error,*999)
2379  ENDDO ! ne1
2380  !wall elements
2381  DO ne2=2,number_elements_xi(2)
2382  from2=nint(delta(2)*(ne2-1)/deltai(2)+1)
2383  DO ne1=1,number_elements_xi(1)
2384  from1=nint(delta(1)*(ne1-1)/deltai(1)+1)
2385  nn=0
2386  ! number of nodes in an element is dependent on basis used
2387  DO nn3=from3,from3+basis1%NUMBER_OF_NODES_XIC(3)-1
2388  DO nn2=from2,from2+basis1%NUMBER_OF_NODES_XIC(2)-1
2389  DO nn1=from1,from1+basis1%NUMBER_OF_NODES_XIC(1)-1
2390  nn=nn+1
2391  ! circumferential loop-around
2392  IF(nn1>SIZE(nidx,1)) THEN
2393  wall_element_nodes(nn)=nidx(1,nn2,nn3)
2394  ELSE
2395  wall_element_nodes(nn)=nidx(nn1,nn2,nn3)
2396  ENDIF
2397  ENDDO ! nn1
2398  ENDDO ! nn2
2399  ENDDO ! nn3
2400  ne=ne+1
2401  CALL component_nodes_to_user_numbers(ellipsoid_mesh%GENERATED_MESH,mc,wall_element_nodes, &
2402  & wall_element_nodes_user_numbers,err,error,*999)
2403  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements, &
2404  & wall_element_nodes_user_numbers,err,error,*999)
2405  ENDDO ! ne1
2406  ENDDO ! ne2
2407  ENDDO ! ne3
2408  CALL mesh_topology_elements_create_finish(mesh_elements,err,error,*999)
2409  ELSE
2410  CALL flagerror("The number of xi directions of the given basis does not match the size of &
2411  &the number of elements for the mesh.",err,error,*999)
2412  ENDIF
2413  CASE(basis_simplex_type)
2414  CALL flagerror("Ellipsoid meshes with simplex basis types is not implemented.",err,error,*999)
2415  CASE DEFAULT
2416  CALL flagerror("Basis type is either invalid or not implemented.",err,error,*999)
2417  END SELECT
2418  ENDDO
2419  !Finish the mesh
2420  CALL mesh_create_finish(generated_mesh%MESH,err,error,*999)
2421  ELSE
2422  CALL flagerror("An ellipsoid mesh requires a collapsed basis for each basis,"// &
2423  & " so there must be n*2 bases.",err,error,*999)
2424  ENDIF
2425  ELSE
2426  CALL flagerror("Bases is not allocated.",err,error,*999)
2427  ENDIF
2428  ELSE
2429  CALL flagerror("For an ellipsoid mesh the following measures need to be given: &
2430  & LONG_AXIS, SHORT_AXIS, WALL_THICKNESS and CUTOFF_ANGLE.",err,error,*999)
2431  ENDIF
2432  ELSE
2433  CALL flagerror("The number of dimensions of the given regular mesh does not match the size of &
2434  &the origin.",err,error,*999)
2435  ENDIF
2436  ELSE
2437  CALL flagerror("Ellipsoid mesh requires a 3 dimensional coordinate system.",err,error,*999)
2438  ENDIF
2439  CASE DEFAULT
2440  CALL flagerror("Coordinate type is either invalid or not implemented.",err,error,*999)
2441  END SELECT
2442  ELSE
2443  CALL flagerror("Coordiate System is not associated.",err,error,*999)
2444  ENDIF
2445  ELSE
2446  CALL flagerror("Region is not associated.",err,error,*999)
2447  ENDIF
2448  ELSE
2449  CALL flagerror("Ellipsoid mesh is not associated.",err,error,*999)
2450  ENDIF
2451  ELSE
2452  CALL flagerror("Generated Mesh is not associated.",err,error,*999)
2453  ENDIF
2454 
2455  exits("GENERATED_MESH_ELLIPSOID_CREATE_FINISH")
2456  RETURN
2457  ! TODO invalidate other associations
2458 999 IF(ALLOCATED(nidx)) DEALLOCATE(nidx)
2459  IF(ALLOCATED(eidx)) DEALLOCATE(eidx)
2460  IF(ALLOCATED(corner_nodes)) DEALLOCATE(corner_nodes)
2461  IF(ALLOCATED(number_elements_xi)) DEALLOCATE(number_elements_xi)
2462  IF(ALLOCATED(wall_element_nodes)) DEALLOCATE(wall_element_nodes)
2463  IF(ALLOCATED(apex_element_nodes)) DEALLOCATE(apex_element_nodes)
2464  errorsexits("GENERATED_MESH_ELLIPSOID_CREATE_FINISH",err,error)
2465  RETURN 1
2466  END SUBROUTINE generated_mesh_ellipsoid_create_finish
2467  !
2468  !================================================================================================================================
2469  !
2470 
2472  SUBROUTINE generated_mesh_cylinder_create_finish(GENERATED_MESH,MESH_USER_NUMBER,ERR,ERROR,*)
2473 
2474  !Argument variables
2475  TYPE(generated_mesh_type), POINTER :: generated_mesh
2476  INTEGER(INTG), INTENT(IN) :: mesh_user_number
2477  INTEGER(INTG), INTENT(OUT) :: err
2478  TYPE(varying_string), INTENT(OUT) :: error
2479  !Local Variables
2480  TYPE(generated_mesh_cylinder_type), POINTER :: cylinder_mesh
2481  TYPE(basis_type), POINTER :: basis
2482  INTEGER(INTG), ALLOCATABLE :: number_elements_xi(:)
2483  TYPE(region_type), POINTER :: region
2484  TYPE(nodes_type), POINTER :: nodes
2485  INTEGER(INTG) :: total_number_of_nodes,total_number_of_elements,number_of_dimensions
2486  INTEGER(INTG) :: corner_number_of_nodes,basis_number_of_nodes
2487  INTEGER(INTG) :: ne1,ne2,ne3,nn1,nn2,nn3,from1,from2,from3,nn,ne,basis_idx
2488  INTEGER(INTG), ALLOCATABLE :: element_nodes(:),element_nodes_user_numbers(:)
2489  INTEGER(INTG), ALLOCATABLE :: nidx(:,:,:),eidx(:,:,:)
2490  REAL(DP) :: delta(3),deltai(3)
2491  TYPE(meshelementstype), POINTER :: mesh_elements
2492 
2493  enters("GENERATED_MESH_CYLINDER_CREATE_FINISH",err,error,*999)
2494 
2495  IF(ASSOCIATED(generated_mesh)) THEN
2496  cylinder_mesh=>generated_mesh%CYLINDER_MESH
2497  IF(ASSOCIATED(cylinder_mesh)) THEN
2498  region=>generated_mesh%REGION
2499  IF(ASSOCIATED(region)) THEN
2500  IF(ASSOCIATED(region%COORDINATE_SYSTEM)) THEN
2501  !TODO is regular type only for COORDINATE_RECTANGULAR_CARTESIAN_TYPE?
2502  !If that, should we use IF rather than select?
2503  SELECT CASE(region%COORDINATE_SYSTEM%TYPE)
2504  CASE(coordinate_rectangular_cartesian_type)
2505  !Determine the coordinate system and create the regular mesh for that system
2506  cylinder_mesh%MESH_DIMENSION=region%COORDINATE_SYSTEM%NUMBER_OF_DIMENSIONS
2507  number_of_dimensions=cylinder_mesh%MESH_DIMENSION
2508  IF(number_of_dimensions==3) THEN ! hard-coded for 3D only
2509  IF(.NOT.ALLOCATED(cylinder_mesh%ORIGIN)) THEN
2510  ALLOCATE(cylinder_mesh%ORIGIN(number_of_dimensions),stat=err)
2511  IF(err/=0) CALL flagerror("Could not allocate origin.",err,error,*999)
2512  cylinder_mesh%ORIGIN=0.0_dp
2513  ENDIF
2514  IF(SIZE(cylinder_mesh%ORIGIN)==cylinder_mesh%MESH_DIMENSION) THEN
2515  IF(SIZE(cylinder_mesh%CYLINDER_EXTENT)==cylinder_mesh%MESH_DIMENSION) THEN
2516  IF(ALLOCATED(cylinder_mesh%BASES)) THEN
2517  ALLOCATE(number_elements_xi(SIZE(cylinder_mesh%NUMBER_OF_ELEMENTS_XI)),stat=err)
2518  IF(err/=0) CALL flagerror("Could not allocate number of elements xi.",err,error,*999)
2519  number_elements_xi(1:SIZE(cylinder_mesh%NUMBER_OF_ELEMENTS_XI))= &
2520  & cylinder_mesh%NUMBER_OF_ELEMENTS_XI(1:SIZE(cylinder_mesh%NUMBER_OF_ELEMENTS_XI))
2521  CALL mesh_create_start(mesh_user_number,generated_mesh%REGION,SIZE(number_elements_xi,1), &
2522  & generated_mesh%MESH,err,error,*999)
2523  CALL mesh_number_of_components_set(generated_mesh%MESH,SIZE(cylinder_mesh%BASES),err,error,*999)
2524  !Calculate number of nodes
2525  corner_number_of_nodes=(number_elements_xi(3)+1)*number_elements_xi(2)*(number_elements_xi(1)+1)
2526  total_number_of_nodes=corner_number_of_nodes
2527  DO basis_idx=1,SIZE(cylinder_mesh%BASES)
2528  basis=>cylinder_mesh%BASES(basis_idx)%PTR
2529  IF(ASSOCIATED(basis)) THEN
2530  basis_number_of_nodes=((basis%NUMBER_OF_NODES_XIC(3)-1)*number_elements_xi(3)+1)* &
2531  & ((basis%NUMBER_OF_NODES_XIC(2)-1)*number_elements_xi(2))* &
2532  & ((basis%NUMBER_OF_NODES_XIC(1)-1)*number_elements_xi(1)+1)
2533  total_number_of_nodes=total_number_of_nodes+basis_number_of_nodes-corner_number_of_nodes
2534  ELSE
2535  CALL flagerror("Basis is not associated.",err,error,*999)
2536  ENDIF
2537  ENDDO
2538  NULLIFY(nodes)
2539  CALL nodes_create_start(region,total_number_of_nodes,nodes,err,error,*999)
2540  !Finish the nodes creation
2541  CALL nodes_create_finish(nodes,err,error,*999)
2542  !Set the total number of elements
2543  total_number_of_elements=number_elements_xi(1)*number_elements_xi(2)*number_elements_xi(3)
2544  CALL mesh_number_of_elements_set(generated_mesh%MESH,total_number_of_elements,err,error,*999)
2545  DO basis_idx=1,SIZE(cylinder_mesh%BASES)
2546  basis=>cylinder_mesh%BASES(basis_idx)%PTR
2547  IF(ASSOCIATED(basis)) THEN
2548  SELECT CASE(basis%TYPE)
2549  CASE(basis_lagrange_hermite_tp_type)
2550  IF(basis%NUMBER_OF_XI==SIZE(number_elements_xi,1)) THEN
2551  IF(.NOT.all(number_elements_xi>0)) &
2552  & CALL flagerror("Must have 1 or more elements in all directions.",err,error,*999)
2553  IF(number_elements_xi(2)<3) &
2554  CALL flagerror("Need >2 elements around the circumferential direction.",err,error,*999)
2555  IF(.NOT.all(basis%COLLAPSED_XI==basis_not_collapsed)) &
2556  & CALL flagerror("Degenerate (collapsed) basis not implemented.",err,error,*999)
2557  !Calculate nodes and element sizes
2558  IF(ALLOCATED(nidx)) DEALLOCATE(nidx)
2559  IF(ALLOCATED(eidx)) DEALLOCATE(eidx)
2560  CALL generated_mesh_cylinder_build_node_indices(number_elements_xi,basis%NUMBER_OF_NODES_XIC, &
2561  & cylinder_mesh%CYLINDER_EXTENT, total_number_of_nodes,total_number_of_elements, &
2562  & nidx,eidx,delta,deltai,err,error,*999)
2563  !Set the elements for the cylinder mesh
2564  IF(ALLOCATED(element_nodes)) DEALLOCATE(element_nodes)
2565  IF(ALLOCATED(element_nodes_user_numbers)) DEALLOCATE(element_nodes_user_numbers)
2566  ALLOCATE(element_nodes_user_numbers(basis%NUMBER_OF_NODES),stat=err)
2567  ALLOCATE(element_nodes(basis%NUMBER_OF_NODES),stat=err)
2568  IF(err/=0) CALL flagerror("Could not allocate element nodes.",err,error,*999)
2569  !Create the elements
2570  NULLIFY(mesh_elements)
2571  CALL mesh_topology_elements_create_start(generated_mesh%MESH,basis_idx,basis,mesh_elements, &
2572  & err,error,*999)
2573  ! calculate element topology (nodes per each element)
2574  ! the idea is to translate given (r,theta,z) to NIDX equivalents, which include interior nodes
2575  ne=0
2576  DO ne3=1,number_elements_xi(3)
2577  from3=nint(delta(3)*(ne3-1)/deltai(3)+1)
2578  DO ne2=1,number_elements_xi(2)
2579  from2=nint(delta(2)*(ne2-1)/deltai(2)+1)
2580  DO ne1=1,number_elements_xi(1)
2581  from1=nint(delta(1)*(ne1-1)/deltai(1)+1)
2582  nn=0
2583  ! number of nodes in an element is dependent on basis used
2584  DO nn3=from3,from3+basis%NUMBER_OF_NODES_XIC(3)-1
2585  DO nn2=from2,from2+basis%NUMBER_OF_NODES_XIC(2)-1
2586  DO nn1=from1,from1+basis%NUMBER_OF_NODES_XIC(1)-1
2587  nn=nn+1
2588  ! compensate for circumferential loop-around
2589  IF(nn2>SIZE(nidx,2)) THEN
2590  ! DEBUG: little check here
2591  IF(nn2>SIZE(nidx,2)+1) CALL flagerror("NIDX needs debugging",err,error,*999)
2592  element_nodes(nn)=nidx(nn1,1,nn3)
2593  ELSE
2594  element_nodes(nn)=nidx(nn1,nn2,nn3)
2595  ENDIF
2596  ENDDO ! nn1
2597  ENDDO ! nn2
2598  ENDDO ! nn3
2599  ne=ne+1
2600  CALL component_nodes_to_user_numbers(cylinder_mesh%GENERATED_MESH,basis_idx,element_nodes, &
2601  & element_nodes_user_numbers,err,error,*999)
2602  CALL mesh_topology_elements_element_nodes_set(ne,mesh_elements,element_nodes_user_numbers, &
2603  & err,error,*999)
2604  ENDDO ! ne1
2605  ENDDO ! ne2
2606  ENDDO ! ne3
2607  CALL mesh_topology_elements_create_finish(mesh_elements,err,error,*999)
2608  ELSE
2609  CALL flagerror("The number of xi directions of the given basis does not match the size of &
2610  &the number of elements for the mesh.",err,error,*999)
2611  ENDIF
2612  CASE(basis_simplex_type)
2613  CALL flagerror("Cylinder meshes with simplex basis types is not implemented.",err,error,*999)
2614  CASE DEFAULT
2615  CALL flagerror("Basis type is either invalid or not implemented.",err,error,*999)
2616  END SELECT
2617  ELSE
2618  CALL flagerror("Basis is not associated.",err,error,*999)
2619  ENDIF
2620  ENDDO
2621  !Finish the mesh
2622  CALL mesh_create_finish(generated_mesh%MESH,err,error,*999)
2623  ELSE
2624  CALL flagerror("Bases are not allocated.",err,error,*999)
2625  ENDIF
2626  ELSE
2627  CALL flagerror("The number of dimensions of the given regular mesh does not match the size of &
2628  &the maximum extent.",err,error,*999)
2629  ENDIF
2630  ELSE
2631  CALL flagerror("The number of dimensions of the given regular mesh does not match the size of &
2632  &the origin.",err,error,*999)
2633  ENDIF
2634  ELSE
2635  CALL flagerror("Cylinder mesh requires a 3 dimensional coordinate system.",err,error,*999)
2636  ENDIF
2637  CASE DEFAULT
2638  CALL flagerror("Coordinate type is either invalid or not implemented.",err,error,*999)
2639  END SELECT
2640  ELSE
2641  CALL flagerror("Coordiate System is not associated.",err,error,*999)
2642  ENDIF
2643  ELSE
2644  CALL flagerror("Region is not associated.",err,error,*999)
2645  ENDIF
2646  ELSE
2647  CALL flagerror("Regular mesh is not associated.",err,error,*999)
2648  ENDIF
2649  ELSE
2650  CALL flagerror("Generated Mesh is not associated.",err,error,*999)
2651  ENDIF
2652 
2653  exits("GENERATED_MESH_CYLINDER_CREATE_FINISH")
2654  RETURN
2655  ! TODO invalidate other associations
2656 999 IF(ALLOCATED(nidx)) DEALLOCATE(nidx)
2657  IF(ALLOCATED(eidx)) DEALLOCATE(eidx)
2658  IF(ALLOCATED(number_elements_xi)) DEALLOCATE(number_elements_xi)
2659  IF(ALLOCATED(element_nodes)) DEALLOCATE(element_nodes)
2660  errorsexits("GENERATED_MESH_CYLINDER_CREATE_FINISH",err,error)
2661  RETURN 1
2662  END SUBROUTINE generated_mesh_cylinder_create_finish
2663 
2664  !
2665  !================================================================================================================================
2666  !
2667 
2669  SUBROUTINE generated_mesh_cylinder_finalise(CYLINDER_MESH,ERR,ERROR,*)
2670 
2671  !Argument variables
2672  TYPE(generated_mesh_cylinder_type), POINTER :: cylinder_mesh
2673  INTEGER(INTG), INTENT(OUT) :: err
2674  TYPE(varying_string), INTENT(OUT) :: error
2675  !Local Variables
2676 
2677  enters("GENERATED_MESH_CYLINDER_FINALISE",err,error,*999)
2678 
2679  IF(ASSOCIATED(cylinder_mesh)) THEN
2680  IF(ALLOCATED(cylinder_mesh%ORIGIN)) DEALLOCATE(cylinder_mesh%ORIGIN)
2681  IF(ALLOCATED(cylinder_mesh%CYLINDER_EXTENT)) DEALLOCATE(cylinder_mesh%CYLINDER_EXTENT)
2682  IF(ALLOCATED(cylinder_mesh%NUMBER_OF_ELEMENTS_XI)) DEALLOCATE(cylinder_mesh%NUMBER_OF_ELEMENTS_XI)
2683  IF(ALLOCATED(cylinder_mesh%BASES)) DEALLOCATE(cylinder_mesh%BASES)
2684  DEALLOCATE(cylinder_mesh)
2685  ENDIF
2686 
2687  exits("GENERATED_MESH_CYLINDER_FINALISE")
2688  RETURN
2689  ! TODO invalidate other associations
2690 999 errorsexits("GENERATED_MESH_CYLINDER_FINALISE",err,error)
2691  RETURN 1
2692  END SUBROUTINE generated_mesh_cylinder_finalise
2693 
2694  !
2695  !================================================================================================================================
2696  !
2697 
2699  SUBROUTINE generated_mesh_cylinder_initialise(GENERATED_MESH,ERR,ERROR,*)
2700 
2701  !Argument variables
2702  TYPE(generated_mesh_type), POINTER :: generated_mesh
2703  INTEGER(INTG), INTENT(OUT) :: err
2704  TYPE(varying_string), INTENT(OUT) :: error
2705  !Local Variables
2706  INTEGER(INTG) :: dummy_err
2707  TYPE(varying_string) :: dummy_error
2708 
2709  enters("GENERATED_MESH_CYLINDER_INITIALISE",err,error,*999)
2710 
2711  IF(ASSOCIATED(generated_mesh)) THEN
2712  IF(ASSOCIATED(generated_mesh%CYLINDER_MESH)) THEN
2713  CALL flagerror("Cylinder mesh is already associated for this generated mesh.",err,error,*998)
2714  ELSE
2715  ALLOCATE(generated_mesh%CYLINDER_MESH,stat=err)
2716  IF(err/=0) CALL flagerror("Could not allocate cylinder generated mesh.",err,error,*999)
2717  generated_mesh%CYLINDER_MESH%GENERATED_MESH=>generated_mesh
2718  generated_mesh%GENERATED_TYPE=generated_mesh_cylinder_mesh_type
2719  ENDIF
2720  ELSE
2721  CALL flagerror("Generated mesh is not associated.",err,error,*998)
2722  ENDIF
2723 
2724  exits("GENERATED_MESH_CYLINDER_INITIALISE")
2725  RETURN
2726 999 CALL generated_mesh_cylinder_finalise(generated_mesh%CYLINDER_MESH,dummy_err,dummy_error,*998)
2727 998 errorsexits("GENERATED_MESH_CYLINDER_INITIALISE",err,error)
2728  RETURN 1
2729  END SUBROUTINE generated_mesh_cylinder_initialise
2730 
2731  !
2732  !================================================================================================================================
2733  !
2734 
2736  SUBROUTINE generated_mesh_regular_finalise(REGULAR_MESH,ERR,ERROR,*)
2737 
2738  !Argument variables
2739  TYPE(generated_mesh_regular_type), POINTER :: regular_mesh
2740  INTEGER(INTG), INTENT(OUT) :: err
2741  TYPE(varying_string), INTENT(OUT) :: error
2742  !Local Variables
2743 
2744  enters("GENERATED_MESH_REGULAR_FINALISE",err,error,*999)
2745 
2746  IF(ASSOCIATED(regular_mesh)) THEN
2747  IF(ALLOCATED(regular_mesh%ORIGIN)) DEALLOCATE(regular_mesh%ORIGIN)
2748  IF(ALLOCATED(regular_mesh%MAXIMUM_EXTENT)) DEALLOCATE(regular_mesh%MAXIMUM_EXTENT)
2749  IF(ALLOCATED(regular_mesh%NUMBER_OF_ELEMENTS_XI)) DEALLOCATE(regular_mesh%NUMBER_OF_ELEMENTS_XI)
2750  IF(ALLOCATED(regular_mesh%BASE_VECTORS)) DEALLOCATE(regular_mesh%BASE_VECTORS)
2751  IF(ALLOCATED(regular_mesh%BASES)) DEALLOCATE(regular_mesh%BASES)
2752  DEALLOCATE(regular_mesh)
2753  ENDIF
2754 
2755  exits("GENERATED_MESH_REGULAR_FINALISE")
2756  RETURN
2757  ! TODO invalidate other associations
2758 999 errorsexits("GENERATED_MESH_REGULAR_FINALISE",err,error)
2759  RETURN 1
2760  END SUBROUTINE generated_mesh_regular_finalise
2761 
2762  !
2763  !================================================================================================================================
2764  !
2765 
2767  SUBROUTINE generated_mesh_regular_initialise(GENERATED_MESH,ERR,ERROR,*)
2768 
2769  !Argument variables
2770  TYPE(generated_mesh_type), POINTER :: generated_mesh
2771  INTEGER(INTG), INTENT(OUT) :: err
2772  TYPE(varying_string), INTENT(OUT) :: error
2773  !Local Variables
2774  INTEGER(INTG) :: dummy_err
2775  TYPE(varying_string) :: dummy_error
2776 
2777  enters("GENERATED_MESH_REGULAR_INITIALISE",err,error,*998)
2778 
2779  IF(ASSOCIATED(generated_mesh)) THEN
2780  IF(ASSOCIATED(generated_mesh%REGULAR_MESH)) THEN
2781  CALL flagerror("Regular mesh is already associated for this generated mesh.",err,error,*998)
2782  ELSE
2783  ALLOCATE(generated_mesh%REGULAR_MESH,stat=err)
2784  IF(err/=0) CALL flagerror("Could not allocate regular generated mesh.",err,error,*999)
2785  generated_mesh%REGULAR_MESH%GENERATED_MESH=>generated_mesh
2786  generated_mesh%GENERATED_TYPE=generated_mesh_regular_mesh_type
2787  ENDIF
2788  ELSE
2789  CALL flagerror("Generated mesh is not associated.",err,error,*998)
2790  ENDIF
2791 
2792  exits("GENERATED_MESH_REGULAR_INITIALISE")
2793  RETURN
2794 999 CALL generated_mesh_regular_finalise(generated_mesh%REGULAR_MESH,dummy_err,dummy_error,*998)
2795 998 errorsexits("GENERATED_MESH_REGULAR_INITIALISE",err,error)
2796  RETURN 1
2797  END SUBROUTINE generated_mesh_regular_initialise
2798 
2799  !
2800  !================================================================================================================================
2801  !
2802 
2804  SUBROUTINE generated_mesh_ellipsoid_finalise(ELLIPSOID_MESH,ERR,ERROR,*)
2805 
2806  !Argument variables
2807  TYPE(generated_mesh_ellipsoid_type), POINTER :: ellipsoid_mesh
2808  INTEGER(INTG), INTENT(OUT) :: err
2809  TYPE(varying_string), INTENT(OUT) :: error
2810  !Local Variables
2811 
2812  enters("GENERATED_MESH_ELLIPSOID_FINALISE",err,error,*999)
2813 
2814  IF(ASSOCIATED(ellipsoid_mesh)) THEN
2815  IF(ALLOCATED(ellipsoid_mesh%ORIGIN)) DEALLOCATE(ellipsoid_mesh%ORIGIN)
2816  IF(ALLOCATED(ellipsoid_mesh%ELLIPSOID_EXTENT)) DEALLOCATE(ellipsoid_mesh%ELLIPSOID_EXTENT)
2817  IF(ALLOCATED(ellipsoid_mesh%NUMBER_OF_ELEMENTS_XI)) DEALLOCATE(ellipsoid_mesh%NUMBER_OF_ELEMENTS_XI)
2818  IF(ALLOCATED(ellipsoid_mesh%BASES)) DEALLOCATE(ellipsoid_mesh%BASES)
2819  DEALLOCATE(ellipsoid_mesh)
2820  ENDIF
2821 
2822  exits("GENERATED_MESH_ELLIPSOID_FINALISE")
2823  RETURN
2824  ! TODO invalidate other associations
2825 999 errorsexits("GENERATED_MESH_ELLIPSOID_FINALISE",err,error)
2826  RETURN 1
2827  END SUBROUTINE generated_mesh_ellipsoid_finalise
2828 
2829  !
2830  !================================================================================================================================
2831  !
2832 
2834  SUBROUTINE generated_mesh_ellipsoid_initialise(GENERATED_MESH,ERR,ERROR,*)
2835 
2836  !Argument variables
2837  TYPE(generated_mesh_type), POINTER :: generated_mesh
2838  INTEGER(INTG), INTENT(OUT) :: err
2839  TYPE(varying_string), INTENT(OUT) :: error
2840  !Local Variables
2841  INTEGER(INTG) :: dummy_err
2842  TYPE(varying_string) :: dummy_error
2843 
2844  enters("GENERATED_MESH_ELLIPSOID_INITIALISE",err,error,*999)
2845 
2846  IF(ASSOCIATED(generated_mesh)) THEN
2847  IF(ASSOCIATED(generated_mesh%ELLIPSOID_MESH)) THEN
2848  CALL flagerror("Ellipsoid mesh is already associated for this generated mesh.",err,error,*998)
2849  ELSE
2850  ALLOCATE(generated_mesh%ELLIPSOID_MESH,stat=err)
2851  IF(err/=0) CALL flagerror("Could not allocate ellipsoid generated mesh.",err,error,*999)
2852  generated_mesh%ELLIPSOID_MESH%GENERATED_MESH=>generated_mesh
2853  generated_mesh%GENERATED_TYPE=generated_mesh_ellipsoid_mesh_type
2854  ENDIF
2855  ELSE
2856  CALL flagerror("Generated mesh is not associated.",err,error,*998)
2857  ENDIF
2858 
2859  exits("GENERATED_MESH_ELLIPSOID_INITIALISE")
2860  RETURN
2861 999 CALL generated_mesh_ellipsoid_finalise(generated_mesh%ELLIPSOID_MESH,dummy_err,dummy_error,*998)
2862 998 errorsexits("GENERATED_MESH_ELLIPSOID_INITIALISE",err,error)
2863  RETURN 1
2864  END SUBROUTINE generated_mesh_ellipsoid_initialise
2865 
2866  !
2867  !================================================================================================================================
2868  !
2869 
2871  SUBROUTINE generated_mesh_type_get(GENERATED_MESH,TYPE,ERR,ERROR,*)
2872 
2873  !Argument variables
2874  TYPE(generated_mesh_type), POINTER :: generated_mesh
2875  INTEGER(INTG), INTENT(OUT) :: TYPE
2876  INTEGER(INTG), INTENT(OUT) :: err
2877  TYPE(varying_string), INTENT(OUT) :: error
2878  !Local Variables
2879 
2880  enters("GENERATED_MESH_TYPE_GET",err,error,*999)
2881 
2882  IF(ASSOCIATED(generated_mesh)) THEN
2883  TYPE=generated_mesh%GENERATED_TYPE
2884  ELSE
2885  CALL flagerror("Generated mesh is not associated.",err,error,*999)
2886  ENDIF
2887 
2888  exits("GENERATED_MESH_TYPE_GET")
2889  RETURN
2890 999 errorsexits("GENERATED_MESH_TYPE_GET",err,error)
2891  RETURN 1
2892  END SUBROUTINE generated_mesh_type_get
2893 
2894  !
2895  !================================================================================================================================
2896  !
2897 
2899  SUBROUTINE generated_mesh_type_set(GENERATED_MESH,GENERATED_TYPE,ERR,ERROR,*)
2900 
2901  !Argument variables
2902  TYPE(generated_mesh_type), POINTER :: generated_mesh
2903  INTEGER(INTG), INTENT(IN) :: generated_type
2904  INTEGER(INTG), INTENT(OUT) :: err
2905  TYPE(varying_string), INTENT(OUT) :: error
2906  !Local Variables
2907  INTEGER(INTG) :: old_generated_type
2908  TYPE(varying_string) :: local_error
2909 
2910  enters("GENERATED_MESH_TYPE_SET",err,error,*999)
2911 
2912  IF(ASSOCIATED(generated_mesh)) THEN
2913  IF(generated_mesh%GENERATED_MESH_FINISHED) THEN
2914  CALL flagerror("Generated mesh has already been finished.",err,error,*999)
2915  ELSE
2916  old_generated_type=generated_mesh%GENERATED_TYPE
2917  IF(old_generated_type/=generated_type) THEN
2918  !Initialise the new generated mesh type
2919  SELECT CASE(generated_type)
2920  CASE(generated_mesh_regular_mesh_type)
2921  CALL generated_mesh_regular_initialise(generated_mesh,err,error,*999)
2922  CASE(generated_mesh_polar_mesh_type)
2923  CALL flagerror("Not implemented.",err,error,*999)
2924  CASE(generated_mesh_fractal_tree_mesh_type)
2925  CALL flagerror("Not implemented.",err,error,*999)
2926  CASE(generated_mesh_cylinder_mesh_type)
2927  CALL generated_mesh_cylinder_initialise(generated_mesh,err,error,*999)
2928  CASE(generated_mesh_ellipsoid_mesh_type)
2929  CALL generated_mesh_ellipsoid_initialise(generated_mesh,err,error,*999)
2930  CASE DEFAULT
2931  local_error="The specified generated mesh mesh type of "//trim(number_to_vstring(generated_type,"*",err,error))// &
2932  & " is invalid."
2933  CALL flagerror(local_error,err,error,*999)
2934  END SELECT
2935  !Finalise the new generated mesh type
2936  SELECT CASE(old_generated_type)
2937  CASE(generated_mesh_regular_mesh_type)
2938  CALL generated_mesh_regular_finalise(generated_mesh%REGULAR_MESH,err,error,*999)
2939  CASE(generated_mesh_polar_mesh_type)
2940  CALL flagerror("Not implemented.",err,error,*999)
2941  CASE(generated_mesh_fractal_tree_mesh_type)
2942  CALL flagerror("Not implemented.",err,error,*999)
2943  CASE(generated_mesh_cylinder_mesh_type)
2944  CALL generated_mesh_cylinder_finalise(generated_mesh%CYLINDER_MESH,err,error,*999)
2945  CASE(generated_mesh_ellipsoid_mesh_type)
2946  CALL generated_mesh_ellipsoid_finalise(generated_mesh%ELLIPSOID_MESH,err,error,*999)
2947  CASE DEFAULT
2948  local_error="The generated mesh mesh type of "//trim(number_to_vstring(old_generated_type,"*",err,error))// &
2949  & " is invalid."
2950  CALL flagerror(local_error,err,error,*999)
2951  END SELECT
2952  ENDIF
2953  ENDIF
2954  ELSE
2955  CALL flagerror("Generated mesh is not associated.",err,error,*999)
2956  ENDIF
2957 
2958  exits("GENERATED_MESH_TYPE_SET")
2959  RETURN
2960 999 errorsexits("GENERATED_MESH_TYPE_SET",err,error)
2961  RETURN 1
2962  END SUBROUTINE generated_mesh_type_set
2963 
2964  !
2965  !================================================================================================================================
2966  !
2967 
2970  SUBROUTINE generated_mesh_user_number_find_generic(USER_NUMBER,GENERATED_MESHES,GENERATED_MESH,ERR,ERROR,*)
2971 
2972  !Argument variables
2973  INTEGER(INTG), INTENT(IN) :: user_number
2974  TYPE(generated_meshes_type), POINTER :: generated_meshes
2975  TYPE(generated_mesh_type), POINTER :: generated_mesh
2976  INTEGER(INTG), INTENT(OUT) :: err
2977  TYPE(varying_string), INTENT(OUT) :: error
2978  !Local Variables
2979  INTEGER(INTG) :: generated_mesh_idx
2980 
2981  enters("GENERATED_MESH_USER_NUMBER_FIND_GENERIC",err,error,*999)
2982 
2983  IF(ASSOCIATED(generated_meshes)) THEN
2984  IF(ASSOCIATED(generated_mesh)) THEN
2985  CALL flagerror("Generated mesh is already associated.",err,error,*999)
2986  ELSE
2987  NULLIFY(generated_mesh)
2988  generated_mesh_idx=1
2989  DO WHILE(generated_mesh_idx<=generated_meshes%NUMBER_OF_GENERATED_MESHES.AND..NOT.ASSOCIATED(generated_mesh))
2990  IF(generated_meshes%GENERATED_MESHES(generated_mesh_idx)%PTR%USER_NUMBER==user_number) THEN
2991  generated_mesh=>generated_meshes%GENERATED_MESHES(generated_mesh_idx)%PTR
2992  EXIT
2993  ELSE
2994  generated_mesh_idx=generated_mesh_idx+1
2995  ENDIF
2996  ENDDO
2997  ENDIF
2998  ELSE
2999  CALL flagerror("Generated meshes is not associated.",err,error,*999)
3000  ENDIF
3001 
3002  exits("GENERATED_MESH_USER_NUMBER_FIND_GENERIC")
3003  RETURN
3004 999 errorsexits("GENERATED_MESH_USER_NUMBER_FIND_GENERIC",err,error)
3005  RETURN 1
3006  END SUBROUTINE generated_mesh_user_number_find_generic
3007 
3008  !
3009  !================================================================================================================================
3010  !
3011 
3014  SUBROUTINE generated_mesh_user_number_find_interface(USER_NUMBER,INTERFACE,GENERATED_MESH,ERR,ERROR,*)
3015 
3016  !Argument variables
3017  INTEGER(INTG), INTENT(IN) :: user_number
3018  TYPE(interface_type), POINTER :: interface
3019  TYPE(generated_mesh_type), POINTER :: generated_mesh
3020  INTEGER(INTG), INTENT(OUT) :: err
3021  TYPE(varying_string), INTENT(OUT) :: error
3022  !Local Variables
3023 
3024  enters("GENERATED_MESH_USER_NUMBER_FIND_INTERFACE",err,error,*999)
3025 
3026  IF(ASSOCIATED(interface)) THEN
3027  CALL generated_mesh_user_number_find_generic(user_number,interface%GENERATED_MESHES,generated_mesh,err,error,*999)
3028  ELSE
3029  CALL flagerror("Interface is not associated.",err,error,*999)
3030  ENDIF
3031 
3032  exits("GENERATED_MESH_USER_NUMBER_FIND_INTERFACE")
3033  RETURN
3034 999 errorsexits("GENERATED_MESH_USER_NUMBER_FIND_INTERFACE",err,error)
3035  RETURN 1
3036  END SUBROUTINE generated_mesh_user_number_find_interface
3037 
3038  !
3039  !================================================================================================================================
3040  !
3041 
3044  SUBROUTINE generated_mesh_user_number_find_region(USER_NUMBER,REGION,GENERATED_MESH,ERR,ERROR,*)
3045 
3046  !Argument variables
3047  INTEGER(INTG), INTENT(IN) :: user_number
3048  TYPE(region_type), POINTER :: region
3049  TYPE(generated_mesh_type), POINTER :: generated_mesh
3050  INTEGER(INTG), INTENT(OUT) :: err
3051  TYPE(varying_string), INTENT(OUT) :: error
3052  !Local Variables
3053 
3054  enters("GENERATED_MESH_USER_NUMBER_FIND_REGION",err,error,*999)
3055 
3056  IF(ASSOCIATED(region)) THEN
3057  CALL generated_mesh_user_number_find_generic(user_number,region%GENERATED_MESHES,generated_mesh,err,error,*999)
3058  ELSE
3059  CALL flagerror("Region is not associated.",err,error,*999)
3060  ENDIF
3061 
3062  exits("GENERATED_MESH_USER_NUMBER_FIND_REGION")
3063  RETURN
3064 999 errorsexits("GENERATED_MESH_USER_NUMBER_FIND_REGION",err,error)
3065  RETURN 1
3066 
3067  END SUBROUTINE generated_mesh_user_number_find_region
3068 
3069  !
3070  !================================================================================================================================
3071  !
3072 
3074  SUBROUTINE generated_meshes_finalise(GENERATED_MESHES,ERR,ERROR,*)
3075 
3076  !Argument variables
3077  TYPE(generated_meshes_type), POINTER :: generated_meshes
3078  INTEGER(INTG), INTENT(OUT) :: err
3079  TYPE(varying_string), INTENT(OUT) :: error
3080  !Local Variables
3081  TYPE(generated_mesh_type), POINTER :: generated_mesh
3082 
3083  enters("GENERATED_MESHES_FINALISE",err,error,*999)
3084 
3085  IF(ASSOCIATED(generated_meshes)) THEN
3086  DO WHILE(generated_meshes%NUMBER_OF_GENERATED_MESHES>0)
3087  generated_mesh=>generated_meshes%GENERATED_MESHES(1)%PTR
3088  CALL generated_mesh_destroy(generated_mesh,err,error,*999)
3089  ENDDO !generated_mesh_idx
3090  DEALLOCATE(generated_meshes)
3091  ENDIF
3092 
3093  exits("GENERATED_MESHES_FINALISE")
3094  RETURN
3095 999 errorsexits("GENERATED_MESHES_FINALISE",err,error)
3096  RETURN 1
3097 
3098  END SUBROUTINE generated_meshes_finalise
3099 
3100  !
3101  !================================================================================================================================
3102  !
3103 
3105  SUBROUTINE generated_meshes_initialise_generic(GENERATED_MESHES,ERR,ERROR,*)
3106 
3107  !Argument variables
3108  TYPE(generated_meshes_type), POINTER :: generated_meshes
3109  INTEGER(INTG), INTENT(OUT) :: err
3110  TYPE(varying_string), INTENT(OUT) :: error
3111  !Local Variables
3112  INTEGER(INTG) :: dummy_err
3113  TYPE(varying_string) :: dummy_error
3114 
3115  enters("GENERATED_MESHES_INITIALISE_GENERIC",err,error,*998)
3116 
3117  IF(ASSOCIATED(generated_meshes)) THEN
3118  CALL flagerror("Generated meshes is already associated.",err,error,*998)
3119  ELSE
3120  ALLOCATE(generated_meshes,stat=err)
3121  IF(err/=0) CALL flagerror("Generated meshes is not associated.",err,error,*999)
3122  generated_meshes%NUMBER_OF_GENERATED_MESHES=0
3123  NULLIFY(generated_meshes%GENERATED_MESHES)
3124  NULLIFY(generated_meshes%REGION)
3125  NULLIFY(generated_meshes%INTERFACE)
3126  ENDIF
3127 
3128  exits("GENERATED_MESHES_INITIALISE_GENERIC")
3129  RETURN
3130 999 CALL generated_meshes_finalise(generated_meshes,dummy_err,dummy_error,*998)
3131 998 errorsexits("GENERATED_MESHES_INITIALISE_GENERIC",err,error)
3132  RETURN 1
3133  END SUBROUTINE generated_meshes_initialise_generic
3134 
3135  !
3136  !================================================================================================================================
3137  !
3138 
3140  SUBROUTINE generated_meshes_initialise_interface(INTERFACE,ERR,ERROR,*)
3141 
3142  !Argument variables
3143  TYPE(interface_type), POINTER :: interface
3144  INTEGER(INTG), INTENT(OUT) :: err
3145  TYPE(varying_string), INTENT(OUT) :: error
3146  !Local Variables
3147 
3148  enters("GENERATED_MESHES_INITIALISE_INTERFACE",err,error,*999)
3149 
3150  IF(ASSOCIATED(interface)) THEN
3151  IF(ASSOCIATED(interface%GENERATED_MESHES)) THEN
3152  CALL flagerror("Interface generated meshes is already associated.",err,error,*999)
3153  ELSE
3154  CALL generated_meshes_initialise_generic(interface%GENERATED_MESHES,err,error,*999)
3155  interface%GENERATED_MESHES%INTERFACE=>INTERFACE
3156  ENDIF
3157  ELSE
3158  CALL flagerror("Interface is not associated.",err,error,*999)
3159  ENDIF
3160 
3161  exits("GENERATED_MESHES_INITIALISE_INTERFACE")
3162  RETURN
3163 999 errorsexits("GENERATED_MESHES_INITIALISE_INTERFACE",err,error)
3164  RETURN 1
3165  END SUBROUTINE generated_meshes_initialise_interface
3166 
3167  !
3168  !================================================================================================================================
3169  !
3170 
3172  SUBROUTINE generated_meshes_initialise_region(REGION,ERR,ERROR,*)
3173 
3174  !Argument variables
3175  TYPE(region_type), POINTER :: region
3176  INTEGER(INTG), INTENT(OUT) :: err
3177  TYPE(varying_string), INTENT(OUT) :: error
3178  !Local Variables
3179 
3180  enters("GENERATED_MESHES_INITIALISE_REGION",err,error,*999)
3181 
3182  IF(ASSOCIATED(region)) THEN
3183  IF(ASSOCIATED(region%GENERATED_MESHES)) THEN
3184  CALL flagerror("Region generated meshes is already associated.",err,error,*999)
3185  ELSE
3186  CALL generated_meshes_initialise_generic(region%GENERATED_MESHES,err,error,*999)
3187  region%GENERATED_MESHES%REGION=>region
3188  ENDIF
3189  ELSE
3190  CALL flagerror("Region is not associated.",err,error,*999)
3191  ENDIF
3192 
3193  exits("GENERATED_MESHES_INITIALISE_REGION")
3194  RETURN
3195 999 errorsexits("GENERATED_MESHES_INITIALISE_REGION",err,error)
3196  RETURN 1
3197  END SUBROUTINE generated_meshes_initialise_region
3198 
3199  !
3200  !================================================================================================================================
3201  !
3202 
3204  SUBROUTINE generatedmesh_geometricparameterscalculate(FIELD,GENERATED_MESH,ERR,ERROR,*)
3205 
3206  !Argument variables
3207  TYPE(field_type), POINTER :: field
3208  TYPE(generated_mesh_type), POINTER :: generated_mesh
3209  INTEGER(INTG), INTENT(OUT) :: err
3210  TYPE(varying_string), INTENT(OUT) :: error
3211  !Local Variables
3212  TYPE(varying_string) :: local_error
3213 
3214  enters("GeneratedMesh_GeometricParametersCalculate",err,error,*999)
3215 
3216  IF(ASSOCIATED(field)) THEN
3217  IF(field%FIELD_FINISHED) THEN
3218  IF(ASSOCIATED(generated_mesh)) THEN
3219  SELECT CASE(generated_mesh%GENERATED_TYPE)
3220  CASE(generated_mesh_regular_mesh_type)
3221  CALL generatedmesh_regulargeometricparameterscalculate(generated_mesh%REGULAR_MESH, &
3222  & field,err,error,*999)
3223  CASE(generated_mesh_polar_mesh_type)
3224  CALL flagerror("Not implemented.",err,error,*999)
3225  CASE(generated_mesh_fractal_tree_mesh_type)
3226  CALL flagerror("Not implemented.",err,error,*999)
3227  CASE(generated_mesh_cylinder_mesh_type)
3228  CALL generatedmesh_cylindergeometricparameterscalculate(generated_mesh%CYLINDER_MESH, &
3229  & field,err,error,*999)
3230  CASE(generated_mesh_ellipsoid_mesh_type)
3231  CALL generatedmesh_ellipsoidgeometricparameterscalculate(generated_mesh%ELLIPSOID_MESH, &
3232  & field,err,error,*999)
3233  CASE DEFAULT
3234  local_error="The generated mesh mesh type of "// &
3235  & trim(number_to_vstring(generated_mesh%GENERATED_TYPE,"*",err,error))// &
3236  & " is invalid."
3237  CALL flagerror(local_error,err,error,*999)
3238  CALL flagerror("Generated mesh type is either invalid or not implemented.",err,error,*999)
3239  END SELECT
3240  ELSE
3241  CALL flagerror("Generated mesh is not associated.",err,error,*999)
3242  ENDIF
3243  ELSE
3244  local_error="Field number "//trim(number_to_vstring(field%USER_NUMBER,"*",err,error))//" has not been finished."
3245  CALL flagerror(local_error,err,error,*999)
3246  ENDIF
3247  ELSE
3248  CALL flagerror("Field is not associated.",err,error,*999)
3249  ENDIF
3250 
3251  exits("GeneratedMesh_GeometricParametersCalculate")
3252  RETURN
3253 999 errorsexits("GeneratedMesh_GeometricParametersCalculate",err,error)
3254  RETURN 1
3255 
3256  END SUBROUTINE generatedmesh_geometricparameterscalculate
3257 
3258  !
3259  !================================================================================================================================
3260  !
3261 
3263  SUBROUTINE generated_mesh_region_get(GENERATED_MESH,REGION,ERR,ERROR,*)
3264 
3265  !Argument variables
3266  TYPE(generated_mesh_type), POINTER :: generated_mesh
3267  TYPE(region_type), POINTER :: region
3268  INTEGER(INTG), INTENT(OUT) :: err
3269  TYPE(varying_string), INTENT(OUT) :: error
3270  !Local Variables
3271  TYPE(interface_type), POINTER :: interface
3272  TYPE(region_type), POINTER :: parent_region
3273  TYPE(varying_string) :: local_error
3274 
3275  enters("GENERATED_MESH_REGION_GET",err,error,*999)
3276 
3277  IF(ASSOCIATED(generated_mesh)) THEN
3278  IF(ASSOCIATED(region)) THEN
3279  CALL flagerror("Region is already associated.",err,error,*999)
3280  ELSE
3281  NULLIFY(region)
3282  NULLIFY(interface)
3283  region=>generated_mesh%REGION
3284  IF(.NOT.ASSOCIATED(region)) THEN
3285  interface=>generated_mesh%INTERFACE
3286  IF(ASSOCIATED(interface)) THEN
3287  parent_region=>interface%PARENT_REGION
3288  IF(ASSOCIATED(parent_region)) THEN
3289  region=>parent_region
3290  ELSE
3291  local_error="The parent region not associated for generated mesh number "// &
3292  & trim(number_to_vstring(generated_mesh%USER_NUMBER,"*",err,error))//" of interface number "// &
3293  & trim(number_to_vstring(interface%USER_NUMBER,"*",err,error))//"."
3294  CALL flagerror(local_error,err,error,*999)
3295  ENDIF
3296  ELSE
3297  local_error="The region or interface is not associated for generated mesh number "// &
3298  & trim(number_to_vstring(generated_mesh%USER_NUMBER,"*",err,error))//"."
3299  CALL flagerror(local_error,err,error,*999)
3300  ENDIF
3301  ENDIF
3302  ENDIF
3303  ELSE
3304  CALL flagerror("Generated mesh is not associated.",err,error,*999)
3305  ENDIF
3306 
3307  exits("GENERATED_MESH_REGION_GET")
3308  RETURN
3309 999 errorsexits("GENERATED_MESH_REGION_GET",err,error)
3310  RETURN 1
3311  END SUBROUTINE generated_mesh_region_get
3312 
3313  !
3314  !
3315  !================================================================================================================================
3316  !
3317 
3319  SUBROUTINE generatedmesh_regulargeometricparameterscalculate(REGULAR_MESH,FIELD,ERR,ERROR,*)
3320 
3321  !Argument variables
3322  TYPE(generated_mesh_regular_type), POINTER :: regular_mesh
3323  TYPE(field_type), POINTER :: field
3324  INTEGER(INTG), INTENT(OUT) :: err
3325  TYPE(varying_string), INTENT(OUT) :: error
3326 
3327  !Local variables
3328  INTEGER(INTG) :: component_idx,derivative_idx, &
3329  & component_node,MESH_COMPONENT, &
3330  & node_idx,node_position_idx(3), &
3331  & TOTAL_NUMBER_OF_NODES_XI(3),xi_idx,NODE_USER_NUMBER
3332  REAL(DP) :: delta_coord(3,3),my_origin(3),value
3333  REAL(DP) :: derivative_values(maximum_global_deriv_number)
3334  TYPE(coordinate_system_type), POINTER :: coordinate_system
3335  TYPE(domain_type), POINTER :: domain
3336  TYPE(domain_nodes_type), POINTER :: domain_nodes
3337  TYPE(field_variable_component_type), POINTER :: field_variable_component
3338  TYPE(field_variable_type), POINTER :: field_variable
3339  TYPE(varying_string) :: local_error
3340  LOGICAL :: node_exists,ghost_node
3341 
3342  enters("GeneratedMesh_RegularGeometricParametersCalculate",err,error,*999)
3343 
3344  IF(ASSOCIATED(regular_mesh)) THEN
3345  IF(ASSOCIATED(field)) THEN
3346  NULLIFY(coordinate_system)
3347  CALL field_coordinate_system_get(field,coordinate_system,err,error,*999)
3348  IF(coordinate_system%TYPE==coordinate_rectangular_cartesian_type) THEN
3349 
3350  my_origin=0.0_dp
3351  my_origin(1:regular_mesh%COORDINATE_DIMENSION)=regular_mesh%ORIGIN(1:regular_mesh%COORDINATE_DIMENSION)
3352  delta_coord=0.0_dp
3353  total_number_of_nodes_xi=1
3354  IF(field%TYPE==field_geometric_type) THEN
3355  field_variable=>field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
3356  IF(ASSOCIATED(field_variable)) THEN
3357  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
3358  field_variable_component=>field_variable%COMPONENTS(component_idx)
3359  mesh_component=field_variable_component%MESH_COMPONENT_NUMBER
3360  IF(field_variable_component%INTERPOLATION_TYPE==field_node_based_interpolation) THEN
3361  DO xi_idx=1,regular_mesh%MESH_DIMENSION
3362  total_number_of_nodes_xi(xi_idx)=(regular_mesh%BASES(mesh_component)% &
3363  & ptr%NUMBER_OF_NODES_XIC(xi_idx)-2)*regular_mesh%NUMBER_OF_ELEMENTS_XI(xi_idx)+ &
3364  & regular_mesh%NUMBER_OF_ELEMENTS_XI(xi_idx)+1
3365  ENDDO !xi_idx
3366  DO xi_idx=1,regular_mesh%MESH_DIMENSION
3367  delta_coord(1:regular_mesh%COORDINATE_DIMENSION,xi_idx)= &
3368  & regular_mesh%BASE_VECTORS(1:regular_mesh%COORDINATE_DIMENSION,xi_idx)/ &
3369  & REAL(total_number_of_nodes_xi(xi_idx)-1,dp)
3370  ENDDO !xi_idx
3371  SELECT CASE(field%SCALINGS%SCALING_TYPE)
3372  CASE(field_no_scaling,field_unit_scaling)
3373  derivative_values=0.0_dp
3374  IF(regular_mesh%NUMBER_OF_ELEMENTS_XI(1)>0) THEN
3375  derivative_values(global_deriv_s1)= &
3376  & regular_mesh%BASE_VECTORS(component_idx,1)/regular_mesh%NUMBER_OF_ELEMENTS_XI(1)
3377  END IF
3378  IF(regular_mesh%MESH_DIMENSION>1) THEN
3379  IF(regular_mesh%NUMBER_OF_ELEMENTS_XI(2)>0) THEN
3380  derivative_values(global_deriv_s2)= &
3381  & regular_mesh%BASE_VECTORS(component_idx,2)/regular_mesh%NUMBER_OF_ELEMENTS_XI(2)
3382  END IF
3383  ENDIF
3384  IF(regular_mesh%MESH_DIMENSION>2) THEN
3385  IF(regular_mesh%NUMBER_OF_ELEMENTS_XI(3)>0) THEN
3386  derivative_values(global_deriv_s3)= &
3387  & regular_mesh%BASE_VECTORS(component_idx,3)/regular_mesh%NUMBER_OF_ELEMENTS_XI(3)
3388  END IF
3389  ENDIF
3390  CASE DEFAULT
3391  !Arc length or arithmetic mean scaling
3392  derivative_values=0.0_dp
3393  IF(regular_mesh%NUMBER_OF_ELEMENTS_XI(1)>0) THEN
3394  derivative_values(global_deriv_s1)=regular_mesh%BASE_VECTORS(component_idx,1)/ &
3395  & l2norm(regular_mesh%BASE_VECTORS(:,1))
3396  END IF
3397  IF(regular_mesh%MESH_DIMENSION>1) THEN
3398  IF(regular_mesh%NUMBER_OF_ELEMENTS_XI(2)>0) THEN
3399  derivative_values(global_deriv_s2)=regular_mesh%BASE_VECTORS(component_idx,2)/ &
3400  & l2norm(regular_mesh%BASE_VECTORS(:,2))
3401  END IF
3402  ENDIF
3403  IF(regular_mesh%MESH_DIMENSION>2) THEN
3404  IF(regular_mesh%NUMBER_OF_ELEMENTS_XI(3)>0) THEN
3405  derivative_values(global_deriv_s3)=regular_mesh%BASE_VECTORS(component_idx,3)/ &
3406  & l2norm(regular_mesh%BASE_VECTORS(:,3))
3407  END IF
3408  ENDIF
3409  END SELECT
3410  !Update geometric parameters in this computational domain only
3411  domain=>field_variable_component%DOMAIN
3412  domain_nodes=>domain%TOPOLOGY%NODES
3413  DO component_node=1,total_number_of_nodes_xi(1)*total_number_of_nodes_xi(2)*total_number_of_nodes_xi(3)
3414  !Regular meshes with Lagrange/Hermite elements use different node numberings to other mesh types
3415  IF(regular_mesh%BASES(mesh_component)%PTR%TYPE==basis_lagrange_hermite_tp_type) THEN
3416  CALL generatedmesh_regularcomponentnodetousernumber(regular_mesh%GENERATED_MESH,mesh_component, &
3417  & component_node,node_user_number,err,error,*999)
3418  ELSE
3419  node_user_number=component_node_to_user_number(regular_mesh%GENERATED_MESH,mesh_component, &
3420  & component_node,err,error)
3421  END IF
3422  CALL domain_topology_node_check_exists(field_variable_component%DOMAIN%TOPOLOGY, &
3423  & node_user_number,node_exists,node_idx,ghost_node,err,error,*999)
3424  IF(node_exists.AND..NOT.ghost_node) THEN
3425  node_position_idx(3)=(component_node-1)/(total_number_of_nodes_xi(2)*total_number_of_nodes_xi(1))+1
3426  node_position_idx(2)=mod(component_node-1,total_number_of_nodes_xi(2)*total_number_of_nodes_xi(1))/ &
3427  & total_number_of_nodes_xi(1)+1
3428  node_position_idx(1)=mod(mod(component_node-1,total_number_of_nodes_xi(2)*total_number_of_nodes_xi(1)), &
3429  & total_number_of_nodes_xi(1))+1
3430  VALUE=0.0_dp
3431  DO xi_idx=1,regular_mesh%MESH_DIMENSION
3432  VALUE=VALUE+REAL(node_position_idx(xi_idx)-1,dp)*delta_coord(component_idx,xi_idx)
3433  ENDDO !xi_idx
3434  VALUE=my_origin(component_idx)+VALUE
3435  CALL field_parameter_set_update_node(field,field_u_variable_type,field_values_set_type, &
3436  & 1,1,node_user_number,component_idx,VALUE,err,error,*999)
3437  !Set derivatives
3438  DO derivative_idx=2,domain_nodes%NODES(node_idx)%NUMBER_OF_DERIVATIVES
3439  CALL field_parameter_set_update_node(field,field_u_variable_type,field_values_set_type, &
3440  & 1,derivative_idx,node_user_number,component_idx,derivative_values(derivative_idx),err,error,*999)
3441  END DO !derivative_idx
3442  ENDIF !node_exists
3443  ENDDO !node_idx
3444  ELSE
3445  local_error="Component number "//trim(number_to_vstring(component_idx,"*",err,error))// &
3446  & " of field number "//trim(number_to_vstring(field%USER_NUMBER,"*",err,error))// &
3447  & " does not have node based interpolation."
3448  CALL flagerror(local_error,err,error,*999)
3449  ENDIF
3450  ENDDO !component_idx
3451 !!TODO: do boundary nodes first then start the update to overlap computation and computation.
3452  CALL field_parameter_set_update_start(field,field_u_variable_type,field_values_set_type,err,error,*999)
3453  CALL field_parameter_set_update_finish(field,field_u_variable_type,field_values_set_type,err,error,*999)
3454  ELSE
3455  local_error="The standard field variable is not associated for field number "// &
3456  & trim(number_to_vstring(field%USER_NUMBER,"*",err,error))//"."
3457  CALL flagerror(local_error,err,error,*999)
3458  ENDIF
3459  ELSE
3460  local_error="Field number "//trim(number_to_vstring(field%USER_NUMBER,"*",err,error))//" is not a geometric field."
3461  CALL flagerror(local_error,err,error,*999)
3462  ENDIF
3463  ELSE
3464  CALL flagerror("Non rectangular Cartesian coordinate systems are not implemented.",err,error,*999)
3465  ENDIF
3466  ELSE
3467  CALL flagerror("Field is not associated.",err,error,*999)
3468  ENDIF
3469  ELSE
3470  CALL flagerror("Regular mesh is not associated.",err,error,*999)
3471  ENDIF
3472 
3473  exits("GeneratedMesh_RegularGeometricParametersCalculate")
3474  RETURN
3475 999 errors("GeneratedMesh_RegularGeometricParametersCalculate",err,error)
3476  exits("GeneratedMesh_RegularGeometricParametersCalculate")
3477  RETURN 1
3478 
3479  END SUBROUTINE generatedmesh_regulargeometricparameterscalculate
3480 
3481  !
3482  !================================================================================================================================
3483  !
3484 
3486  SUBROUTINE generatedmesh_cylindergeometricparameterscalculate(CYLINDER_MESH,FIELD,ERR,ERROR,*)
3487 
3488  ! Argument variables
3489  TYPE(generated_mesh_cylinder_type), POINTER :: cylinder_mesh
3490  TYPE(field_type), POINTER :: field
3491  INTEGER(INTG), INTENT(OUT) :: err
3492  TYPE(varying_string), INTENT(OUT) :: error
3493  ! Local variables
3494  TYPE(basis_type), POINTER :: basis
3495  TYPE(domain_type),POINTER :: domain
3496  TYPE(domain_nodes_type), POINTER :: domain_nodes
3497  TYPE(field_variable_type), POINTER :: field_variable
3498  TYPE(field_variable_component_type), POINTER :: field_variable_component
3499  INTEGER(INTG) :: number_elements_xi(3),number_of_nodes_xic(3)
3500  INTEGER(INTG) :: total_number_nodes_xi(3),interpolation_types(3)
3501  INTEGER(INTG) :: component_idx,xi_idx
3502  INTEGER(INTG) :: np,global_np,component_np,ny,nk
3503  INTEGER(INTG) :: number_of_planar_nodes,scaling_type,mesh_component
3504  INTEGER(INTG), ALLOCATABLE :: nidx(:,:,:),eidx(:,:,:)
3505  INTEGER(INTG) :: node_idx(3) ! holds r,theta,z indices
3506  REAL(DP) :: delta(3),deltai(3),polar_coords(3),rect_coords(3)
3507  REAL(DP) :: cylinder_extent(3),deriv
3508  TYPE(varying_string) :: local_error
3509 
3510  enters("GeneratedMesh_CylinderGeometricParametersCalculate",err,error,*999)
3511 
3512  ! assign to the field
3513  IF(field%TYPE==field_geometric_type) THEN
3514  field_variable=>field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
3515  IF(ASSOCIATED(field_variable)) THEN
3516  IF(field_variable%NUMBER_OF_COMPONENTS==3) THEN
3517  CALL field_scaling_type_get(field,scaling_type,err,error,*999)
3518  IF(scaling_type/=field_unit_scaling) &
3519  & CALL write_string(general_output_type," Note: If the cylinder looks wonky, set field scaling to&
3520  & unit scaling type.",err,error,*999)
3521  DO component_idx=1,3
3522  interpolation_types(component_idx)=field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE
3523  ENDDO
3524  IF(all(interpolation_types==field_node_based_interpolation)) THEN
3525  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
3526  field_variable_component=>field_variable%COMPONENTS(component_idx)
3527  mesh_component=field_variable_component%MESH_COMPONENT_NUMBER
3528  ! calculate the total number of nodes in each xi direction
3529  basis=>cylinder_mesh%BASES(mesh_component)%PTR
3530  number_elements_xi=cylinder_mesh%NUMBER_OF_ELEMENTS_XI
3531  number_of_nodes_xic=basis%NUMBER_OF_NODES_XIC
3532  DO xi_idx=1,3
3533  total_number_nodes_xi(xi_idx)=(number_of_nodes_xic(xi_idx)-1)*number_elements_xi(xi_idx)+1
3534  ENDDO
3535  total_number_nodes_xi(2)=total_number_nodes_xi(2)-1 ! theta loops around so slightly different
3536  number_of_planar_nodes=total_number_nodes_xi(1)*total_number_nodes_xi(2)
3537  domain=>field_variable%COMPONENTS(mesh_component)%DOMAIN
3538  domain_nodes=>domain%TOPOLOGY%NODES
3539  ! calculate DELTAi now
3540  cylinder_extent=cylinder_mesh%CYLINDER_EXTENT
3541  delta(1)=(cylinder_extent(2)-cylinder_extent(1))/number_elements_xi(1)
3542  delta(2)=twopi/number_elements_xi(2)
3543  delta(3)=cylinder_extent(3)/number_elements_xi(3)
3544  DO xi_idx=1,3
3545  deltai(xi_idx)=delta(xi_idx)/(number_of_nodes_xic(xi_idx)-1)
3546  ENDDO
3547  DO np=1,domain_nodes%NUMBER_OF_NODES
3548  global_np=domain_nodes%NODES(np)%GLOBAL_NUMBER
3549  component_np=user_number_to_component_node(cylinder_mesh%GENERATED_MESH, &
3550  & mesh_component,global_np,err,error)
3551  ! calculate node_idx which will be used to calculate (r,theta,z) then (x,y,z)
3552  component_np=component_np-1 ! let's go 0-based index for a bit
3553  node_idx(3)=component_np/number_of_planar_nodes
3554  node_idx(2)=(component_np-(node_idx(3))*number_of_planar_nodes)/total_number_nodes_xi(1)
3555  node_idx(1)=mod(component_np-(node_idx(3))*number_of_planar_nodes,total_number_nodes_xi(1))
3556  DO xi_idx=1,3
3557  polar_coords(xi_idx)=node_idx(xi_idx)*deltai(xi_idx)
3558  ENDDO
3559  polar_coords(1)=node_idx(1)*deltai(1)+cylinder_extent(1) ! add the inner radius
3560  rect_coords(1)=polar_coords(1)*cos(polar_coords(2))
3561  rect_coords(2)=polar_coords(1)*sin(polar_coords(2))
3562  rect_coords(3)=polar_coords(3)
3563  rect_coords=rect_coords+cylinder_mesh%ORIGIN
3564  !Default to version 1 of each node derivative
3565  ny=field_variable_component%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(np)%DERIVATIVES(1)%VERSIONS(1)
3566  CALL field_parameter_set_update_local_dof(field,field_u_variable_type,field_values_set_type,ny, &
3567  & rect_coords(component_idx),err,error,*999)
3568  ! Do derivatives: if there are derivatives, we can assume it's cubic hermite
3569  ! given that quadratic hermites are only used for collapsed hex elements,
3570  ! but NB mixed bases have to be handled (e.g. CH-CH-linear combinations)
3571  IF(domain_nodes%NODES(np)%NUMBER_OF_DERIVATIVES>1) THEN
3572  ! Since I decided how xi 1,2,3 line up with the cylinder polar coordinates,
3573  ! we know a priori that only some of the derivatives are nonzero (analytically).
3574  ! NOTE: if hermite type used, should assign FIELD_UNIT_SCALING type for this to work
3575  DO nk=2,field_variable_component%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(np)%NUMBER_OF_DERIVATIVES
3576  SELECT CASE(domain_nodes%NODES(np)%DERIVATIVES(nk)%GLOBAL_DERIVATIVE_INDEX)
3577  CASE(global_deriv_s1)
3578  SELECT CASE(component_idx)
3579  CASE(1)
3580  deriv=cos(polar_coords(2))*delta(1)
3581  CASE(2)
3582  deriv=sin(polar_coords(2))*delta(1)
3583  CASE DEFAULT
3584  deriv=0.0_dp
3585  END SELECT
3586  CASE(global_deriv_s2)
3587  SELECT CASE(component_idx)
3588  CASE(1)
3589  deriv=-polar_coords(1)*sin(polar_coords(2))*delta(2)
3590  CASE(2)
3591  deriv=polar_coords(1)*cos(polar_coords(2))*delta(2)
3592  CASE DEFAULT
3593  deriv=0.0_dp
3594  END SELECT
3595  CASE(global_deriv_s3)
3596  IF(component_idx==3) THEN
3597  deriv=delta(3)
3598  ELSE
3599  deriv=0.0_dp
3600  ENDIF
3601  CASE(global_deriv_s1_s2)
3602  SELECT CASE(component_idx)
3603  CASE(1)
3604  deriv=-sin(polar_coords(2))*delta(1)*delta(2)
3605  CASE(2)
3606  deriv=cos(polar_coords(2))*delta(1)*delta(2)
3607  CASE DEFAULT
3608  deriv=0.0_dp
3609  END SELECT
3610  CASE DEFAULT ! all other non-xy-planar cross derivatives
3611  deriv=0.0_dp
3612  END SELECT
3613  ! assign derivative
3614  !Default to version 1 of each node derivative
3615  ny=field_variable_component%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(np)%DERIVATIVES(nk)% &
3616  & versions(1)
3617  CALL field_parameter_set_update_local_dof(field,field_u_variable_type,field_values_set_type, &
3618  & ny,deriv,err,error,*999)
3619  ENDDO !nk
3620  ENDIF !derivatives
3621  ENDDO !np
3622  ENDDO !component_idx
3623  ELSE
3624  CALL flagerror("All field variable components must have node-based interpolation.",err,error,*999)
3625  ENDIF
3626  CALL field_parameter_set_update_start(field,field_u_variable_type,field_values_set_type,err,error,*999)
3627  CALL field_parameter_set_update_finish(field,field_u_variable_type,field_values_set_type,err,error,*999)
3628  ELSE
3629  CALL flagerror("Geometric field must be three dimensional.",err,error,*999)
3630  ENDIF
3631  ELSE
3632  local_error="The standard field variable is not associated for field number "// &
3633  & trim(number_to_vstring(field%USER_NUMBER,"*",err,error))//"."
3634  CALL flagerror(local_error,err,error,*999)
3635  ENDIF
3636  ELSE
3637  local_error="Field number "//trim(number_to_vstring(field%USER_NUMBER,"*",err,error))//" is not a geometric field."
3638  CALL flagerror(local_error,err,error,*999)
3639  ENDIF
3640 
3641  ! all done
3642  IF(ALLOCATED(nidx)) DEALLOCATE(nidx)
3643  IF(ALLOCATED(eidx)) DEALLOCATE(eidx)
3644 
3645  exits("GeneratedMesh_CylinderGeometricParametersCalculate")
3646  RETURN
3647 999 IF(ALLOCATED(nidx)) DEALLOCATE(nidx)
3648  IF(ALLOCATED(eidx)) DEALLOCATE(eidx)
3649  errors("GeneratedMesh_CylinderGeometricParametersCalculate",err,error)
3650  exits("GeneratedMesh_CylinderGeometricParametersCalculate")
3651  RETURN 1
3652 
3653  END SUBROUTINE generatedmesh_cylindergeometricparameterscalculate
3654 
3655  !
3656  !================================================================================================================================
3657  !
3658 
3661  SUBROUTINE generatedmesh_ellipsoidgeometricparameterscalculate(ELLIPSOID_MESH,FIELD,ERR,ERROR,*)
3662 
3663  ! Argument variables
3664  TYPE(generated_mesh_ellipsoid_type), POINTER :: ellipsoid_mesh
3665  TYPE(field_type), POINTER :: field
3666  INTEGER(INTG), INTENT(OUT) :: err
3667  TYPE(varying_string), INTENT(OUT) :: error
3668  ! Local variables
3669  TYPE(basis_type), POINTER :: basis
3670  TYPE(domain_type),POINTER :: domain
3671  TYPE(decomposition_type), POINTER :: decomposition
3672  TYPE(domain_nodes_type), POINTER :: domain_nodes
3673  TYPE(field_variable_type), POINTER :: field_variable
3674  TYPE(field_variable_component_type), POINTER :: field_variable_component
3675  INTEGER(INTG) :: my_computational_node,domain_number,mesh_component,basis_idx
3676  INTEGER(INTG) :: number_elements_xi(3),number_of_nodes_xic(3)
3677  INTEGER(INTG) :: total_number_nodes_xi(3),interpolation_types(3)
3678  INTEGER(INTG) :: component_idx,xi_idx
3679  INTEGER(INTG) :: np,npg,i,j,k, local_node
3680  INTEGER(INTG) :: scaling_type!,NUMBER_OF_PLANAR_NODES
3681  INTEGER(INTG), ALLOCATABLE :: nidx(:,:,:),eidx(:,:,:)
3682  !INTEGER(INTG) :: node_idx(3) ! holds r,theta,z indices
3683  REAL(DP) :: delta(3),deltai(3),rect_coords(3),t,phi,alpha,xi,nu,x,y,z
3684  REAL(DP) :: ellipsoid_extent(4)
3685  TYPE(varying_string) :: local_error
3686 
3687  NULLIFY(basis,domain,decomposition,domain_nodes,field_variable,field_variable_component)
3688 
3689  enters("GeneratedMesh_EllipsoidGeometricParametersCalculate",err,error,*999)
3690 
3691  my_computational_node=computational_node_number_get(err,error)
3692 
3693  ! assign to the field
3694  np=0
3695  IF(field%TYPE==field_geometric_type) THEN
3696  field_variable=>field%VARIABLE_TYPE_MAP(field_u_variable_type)%PTR
3697  IF(ASSOCIATED(field_variable)) THEN
3698  IF(field_variable%NUMBER_OF_COMPONENTS==3) THEN
3699  mesh_component=field_variable%COMPONENTS(1)%MESH_COMPONENT_NUMBER
3700  DO component_idx=2,3
3701  IF(field_variable%COMPONENTS(component_idx)%MESH_COMPONENT_NUMBER/=mesh_component) THEN
3702  CALL flagerror("Multiple mesh components for geometric components is not implemented.",err,error,*999)
3703  ENDIF
3704  ENDDO
3705  basis_idx=mesh_component*2-1
3706 
3707  ! calculate the total number of nodes in each xi direction
3708  IF(ALLOCATED(ellipsoid_mesh%BASES)) THEN
3709  !Check that the all geometric bases use the same mesh component
3710  basis=>ellipsoid_mesh%BASES(basis_idx)%PTR
3711  number_elements_xi=ellipsoid_mesh%NUMBER_OF_ELEMENTS_XI
3712  number_of_nodes_xic=basis%NUMBER_OF_NODES_XIC
3713  DO xi_idx=1,3
3714  total_number_nodes_xi(xi_idx)=(number_of_nodes_xic(xi_idx)-1)*number_elements_xi(xi_idx)+1
3715  ENDDO
3716  total_number_nodes_xi(1)=total_number_nodes_xi(1)-1 ! theta loops around so slightly different
3717  ! calculate DELTAi now
3718  ellipsoid_extent=ellipsoid_mesh%ELLIPSOID_EXTENT
3719  delta(1)=twopi/number_elements_xi(1)
3720  delta(2)=(pi-ellipsoid_extent(4))/number_elements_xi(2)
3721  delta(3)=ellipsoid_extent(3)/number_elements_xi(3)
3722  DO xi_idx=1,3
3723  deltai(xi_idx)=delta(xi_idx)/(number_of_nodes_xic(xi_idx)-1)
3724  ENDDO
3725  ELSE
3726  CALL flagerror("Ellipsoid mesh does not have bases allocated.",err,error,*999)
3727  ENDIF
3728  CALL field_scaling_type_get(field,scaling_type,err,error,*999)
3729  IF(scaling_type/=field_unit_scaling) &
3730  & CALL write_string(general_output_type," Note: If the ellipsoid looks wonky, set field scaling to &
3731  & unit scaling type.",err,error,*999)
3732  ! NUMBER_OF_PLANAR_NODES=TOTAL_NUMBER_NODES_XI(1)*TOTAL_NUMBER_NODES_XI(2)
3733  DO component_idx=1,3
3734  interpolation_types(component_idx)=field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE
3735  ENDDO
3736  IF(all(interpolation_types==field_node_based_interpolation)) THEN
3737  domain=>field_variable%COMPONENTS(1)%DOMAIN ! just grab the first one
3738  domain_nodes=>domain%TOPOLOGY%NODES
3739  !DECOMPOSITION=>DOMAIN%DECOMPOSITION !\todo: test all these pointers
3740  decomposition=>field%DECOMPOSITION !\todo: test all these pointers
3741  IF (ellipsoid_extent(1)>ellipsoid_extent(2)) THEN
3742  !Prolate spheroid
3743  k=1
3744  !inner surface
3745  alpha=sqrt((ellipsoid_extent(1))**2-(ellipsoid_extent(2))**2)
3746  !xi=log(ELLIPSOID_EXTENT(1)/alpha+sqrt((ELLIPSOID_EXTENT(1)/alpha)**2+1))
3747  xi=acosh(ellipsoid_extent(1)/alpha)
3748 
3749  j=1
3750  !apex node
3751  np=1
3752  npg=component_node_to_user_number(ellipsoid_mesh%GENERATED_MESH,basis_idx,np,err,error)
3753  CALL decomposition_node_domain_get(decomposition,npg,mesh_component,domain_number,err,error,*999)
3754  IF(domain_number==my_computational_node) THEN
3755  rect_coords(1)=0
3756  rect_coords(2)=0
3757  rect_coords(3)=-ellipsoid_extent(1)
3758  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
3759  !Default to version 1 of each node derivative
3760  CALL field_parameter_set_update_node(field,field_u_variable_type,field_values_set_type,1,1,npg, &
3761  & component_idx,rect_coords(component_idx),err,error,*999)
3762  local_node=domain%MAPPINGS%NODES%GLOBAL_TO_LOCAL_MAP(npg)%local_number(1)
3763  IF(domain_nodes%NODES(local_node)%NUMBER_OF_DERIVATIVES>1) THEN
3764  CALL flagerror("Not generalized to hermittean elements.",err,error,*999)
3765  ENDIF !derivatives
3766  ENDDO
3767  ENDIF
3768 
3769  DO j=2,total_number_nodes_xi(2)
3770  !longitudinal loop
3771  nu=pi-deltai(2)*(j-1)
3772  DO i=1,total_number_nodes_xi(1)
3773  !circumferential loop
3774  phi=deltai(1)*(i-1)
3775  rect_coords(1)=alpha*(sinh(xi)*sin(nu)*cos(phi))
3776  rect_coords(2)=alpha*(sinh(xi)*sin(nu)*sin(phi))
3777  rect_coords(3)=alpha*(cosh(xi)*cos(nu))
3778  np=np+1
3779  npg=component_node_to_user_number(ellipsoid_mesh%GENERATED_MESH,basis_idx,np,err,error)
3780  CALL decomposition_node_domain_get(decomposition,npg,mesh_component,domain_number,err,error,*999)
3781  IF(domain_number==my_computational_node) THEN
3782  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
3783  CALL field_parameter_set_update_node(field,field_u_variable_type,field_values_set_type,1,1,npg, &
3784  & component_idx,rect_coords(component_idx),err,error,*999)
3785  local_node=domain%MAPPINGS%NODES%GLOBAL_TO_LOCAL_MAP(npg)%local_number(1)
3786  IF(domain_nodes%NODES(local_node)%NUMBER_OF_DERIVATIVES>1) THEN
3787  CALL flagerror("Not generalized to hermittean elements.",err,error,*999)
3788  ENDIF !derivatives
3789  ENDDO
3790  ENDIF
3791  ENDDO
3792  ENDDO
3793 
3794  DO k=2,total_number_nodes_xi(3)
3795  !transmural loop
3796  j=1
3797  !apex nodes
3798  rect_coords(1)=0
3799  rect_coords(2)=0
3800  rect_coords(3)=-ellipsoid_extent(1)-(k-1)*(deltai(3))
3801  np=np+1
3802  npg=component_node_to_user_number(ellipsoid_mesh%GENERATED_MESH,basis_idx,np,err,error)
3803  CALL decomposition_node_domain_get(decomposition,npg,mesh_component,domain_number,err,error,*999)
3804  IF(domain_number==my_computational_node) THEN
3805  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
3806  CALL field_parameter_set_update_node(field,field_u_variable_type,field_values_set_type,1,1,npg, &
3807  & component_idx,rect_coords(component_idx),err,error,*999)
3808  local_node=domain%MAPPINGS%NODES%GLOBAL_TO_LOCAL_MAP(npg)%local_number(1)
3809  IF(domain_nodes%NODES(local_node)%NUMBER_OF_DERIVATIVES>1) THEN
3810  CALL flagerror("Not generalized to hermittean elements.",err,error,*999)
3811  ENDIF !derivatives
3812  ENDDO
3813  ENDIF
3814 
3815  DO j=2,total_number_nodes_xi(2)
3816  !longitudinal loop
3817  nu=pi-deltai(2)*(j-1)
3818  DO i=1,total_number_nodes_xi(1)
3819  !circumferential loop
3820  phi=deltai(1)*(i-1)
3821  x=alpha*(sinh(xi)*sin(nu)*cos(phi))
3822  y=alpha*(sinh(xi)*sin(nu)*sin(phi))
3823  z=alpha*(cosh(xi)*cos(nu))
3824  !Normal vector from inner surface with length DELTAi(3)(k-1)
3825  ! Finney&Thomas: Calculus, second edition, Addison-Wesley Publishing Company, 1994, page 847
3826  !X=x(1+2t/a^2) Y=y(1+2t/a^2) Z=z(1+2t/c^2)
3827  t=(deltai(3)*(k-1))/sqrt((4*x**2/(ellipsoid_extent(2))**4)+ &
3828  & (4*y**2/(ellipsoid_extent(2))**4)+(4*z**2/(ellipsoid_extent(1))**4))
3829  rect_coords(1)=x*(1+2*t/(ellipsoid_extent(2))**2)
3830  rect_coords(2)=y*(1+2*t/(ellipsoid_extent(2))**2)
3831  rect_coords(3)=z*(1+2*t/(ellipsoid_extent(1))**2)
3832  np=np+1
3833  npg=component_node_to_user_number(ellipsoid_mesh%GENERATED_MESH,basis_idx,np,err,error)
3834  CALL decomposition_node_domain_get(decomposition,npg,mesh_component,domain_number,err,error,*999)
3835  IF(domain_number==my_computational_node) THEN
3836  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
3837  CALL field_parameter_set_update_node(field,field_u_variable_type,field_values_set_type,1,1,npg, &
3838  & component_idx,rect_coords(component_idx),err,error,*999)
3839  local_node=domain%MAPPINGS%NODES%GLOBAL_TO_LOCAL_MAP(npg)%local_number(1)
3840  IF(domain_nodes%NODES(local_node)%NUMBER_OF_DERIVATIVES>1) THEN
3841  CALL flagerror("Not generalized to hermittean elements.",err,error,*999)
3842  ENDIF !derivatives
3843  ENDDO
3844  ENDIF
3845  ENDDO
3846  ENDDO
3847  ENDDO
3848  ELSEIF (abs(ellipsoid_extent(1)-ellipsoid_extent(2))<zero_tolerance) THEN
3849  !Sphere
3850  np=0
3851  DO k=1,total_number_nodes_xi(3)
3852  !transmural loop
3853  alpha=ellipsoid_extent(1)+(k-1)*(deltai(3))
3854  j=1
3855  !apex nodes
3856  rect_coords(1)=0
3857  rect_coords(2)=0
3858  rect_coords(3)=-alpha
3859  np=np+1
3860  npg=component_node_to_user_number(ellipsoid_mesh%GENERATED_MESH,basis_idx,np,err,error)
3861  CALL decomposition_node_domain_get(decomposition,npg,mesh_component,domain_number,err,error,*999)
3862  IF(domain_number==my_computational_node) THEN
3863  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
3864  CALL field_parameter_set_update_node(field,field_u_variable_type,field_values_set_type,1,1,npg, &
3865  & component_idx,rect_coords(component_idx),err,error,*999)
3866  local_node=domain%MAPPINGS%NODES%GLOBAL_TO_LOCAL_MAP(npg)%local_number(1)
3867  IF(domain_nodes%NODES(local_node)%NUMBER_OF_DERIVATIVES>1) THEN
3868  CALL flagerror("Not generalized to hermittean elements.",err,error,*999)
3869  ENDIF !derivatives
3870  ENDDO
3871  ENDIF
3872 
3873  DO j=2,total_number_nodes_xi(2)
3874  !longitudinal loop
3875  nu=pi-deltai(2)*(j-1)
3876  DO i=1,total_number_nodes_xi(1)
3877  !circumferential loop
3878  phi=deltai(1)*(i-1)
3879  rect_coords(1)=alpha*sin(nu)*cos(phi)
3880  rect_coords(2)=alpha*sin(nu)*sin(phi)
3881  rect_coords(3)=alpha*cos(nu)
3882  np=np+1
3883  npg=component_node_to_user_number(ellipsoid_mesh%GENERATED_MESH,basis_idx,np,err,error)
3884  CALL decomposition_node_domain_get(decomposition,npg,mesh_component,domain_number,err,error,*999)
3885  IF(domain_number==my_computational_node) THEN
3886  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
3887  CALL field_parameter_set_update_node(field,field_u_variable_type,field_values_set_type,1,1,npg, &
3888  & component_idx,rect_coords(component_idx),err,error,*999)
3889  local_node=domain%MAPPINGS%NODES%GLOBAL_TO_LOCAL_MAP(npg)%local_number(1)
3890  IF(domain_nodes%NODES(local_node)%NUMBER_OF_DERIVATIVES>1) THEN
3891  CALL flagerror("Not generalized to hermittean elements.",err,error,*999)
3892  ENDIF !derivatives
3893  ENDDO
3894  ENDIF
3895  ENDDO
3896  ENDDO
3897  ENDDO
3898 
3899  ELSEIF (ellipsoid_extent(1)<ellipsoid_extent(2)) THEN
3900  !Oblate spheroid
3901  k=1
3902  !inner surface
3903  alpha=sqrt((ellipsoid_extent(2))**2-(ellipsoid_extent(1))**2)
3904  !xi=log(ELLIPSOID_EXTENT(1)/alpha+sqrt((ELLIPSOID_EXTENT(1)/alpha)**2+1))
3905  xi=acosh(ellipsoid_extent(2)/alpha)
3906 
3907  j=1
3908  !apex node
3909  np=1
3910  npg=component_node_to_user_number(ellipsoid_mesh%GENERATED_MESH,basis_idx,np,err,error)
3911  CALL decomposition_node_domain_get(decomposition,npg,mesh_component,domain_number,err,error,*999)
3912  IF(domain_number==my_computational_node) THEN
3913  rect_coords(1)=0
3914  rect_coords(2)=0
3915  rect_coords(3)=-ellipsoid_extent(1)
3916  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
3917  CALL field_parameter_set_update_node(field,field_u_variable_type,field_values_set_type,1,1,npg, &
3918  & component_idx,rect_coords(component_idx),err,error,*999)
3919  local_node=domain%MAPPINGS%NODES%GLOBAL_TO_LOCAL_MAP(npg)%local_number(1)
3920  IF(domain_nodes%NODES(local_node)%NUMBER_OF_DERIVATIVES>1) THEN
3921  CALL flagerror("Not generalized to hermittean elements.",err,error,*999)
3922  ENDIF !derivatives
3923  ENDDO
3924  ENDIF
3925 
3926  DO j=2,total_number_nodes_xi(2)
3927  !longitudinal loop
3928  nu=-pi/2+deltai(2)*(j-1)
3929  DO i=1,total_number_nodes_xi(1)
3930  !circumferential loop
3931  phi=deltai(1)*(i-1)
3932  rect_coords(1)=alpha*(cosh(xi)*cos(nu)*cos(phi))
3933  rect_coords(2)=alpha*(cosh(xi)*cos(nu)*sin(phi))
3934  rect_coords(3)=alpha*(sinh(xi)*sin(nu))
3935  np=np+1
3936  npg=component_node_to_user_number(ellipsoid_mesh%GENERATED_MESH,basis_idx,np,err,error)
3937  CALL decomposition_node_domain_get(decomposition,npg,mesh_component,domain_number,err,error,*999)
3938  IF(domain_number==my_computational_node) THEN
3939  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
3940  CALL field_parameter_set_update_node(field,field_u_variable_type,field_values_set_type,1,1,npg, &
3941  & component_idx,rect_coords(component_idx),err,error,*999)
3942  local_node=domain%MAPPINGS%NODES%GLOBAL_TO_LOCAL_MAP(npg)%local_number(1)
3943  IF(domain_nodes%NODES(local_node)%NUMBER_OF_DERIVATIVES>1) THEN
3944  CALL flagerror("Not generalized to hermittean elements.",err,error,*999)
3945  ENDIF !derivatives
3946  ENDDO
3947  ENDIF
3948  ENDDO
3949  ENDDO
3950 
3951  DO k=2,total_number_nodes_xi(3)
3952  !transmural loop
3953  j=1
3954  !apex nodes
3955  rect_coords(1)=0
3956  rect_coords(2)=0
3957  rect_coords(3)=-ellipsoid_extent(1)-(k-1)*(deltai(3))
3958  np=np+1
3959  npg=component_node_to_user_number(ellipsoid_mesh%GENERATED_MESH,basis_idx,np,err,error)
3960  CALL decomposition_node_domain_get(decomposition,npg,mesh_component,domain_number,err,error,*999)
3961  IF(domain_number==my_computational_node) THEN
3962  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
3963  CALL field_parameter_set_update_node(field,field_u_variable_type,field_values_set_type,1,1,npg, &
3964  & component_idx,rect_coords(component_idx),err,error,*999)
3965  local_node=domain%MAPPINGS%NODES%GLOBAL_TO_LOCAL_MAP(npg)%local_number(1)
3966  IF(domain_nodes%NODES(local_node)%NUMBER_OF_DERIVATIVES>1) THEN
3967  CALL flagerror("Not generalized to hermittean elements.",err,error,*999)
3968  ENDIF !derivatives
3969  ENDDO
3970  ENDIF
3971 
3972  DO j=2,total_number_nodes_xi(2)
3973  !longitudinal loop
3974  nu=-pi/2+deltai(2)*(j-1)
3975  DO i=1,total_number_nodes_xi(1)
3976  !circumferential loop
3977  phi=deltai(1)*(i-1)
3978  x=alpha*(cosh(xi)*cos(nu)*cos(phi))
3979  y=alpha*(cosh(xi)*cos(nu)*sin(phi))
3980  z=alpha*(sinh(xi)*sin(nu))
3981  !Normal vector from inner surface with length DELTAi(3)(k-1)
3982  ! Finney&Thomas: Calculus, second edition, Addison-Wesley Publishing Company, 1994, page 847
3983  !X=x(1+2t/a^2) Y=y(1+2t/a^2) Z=z(1+2t/c^2)
3984  t=(deltai(3)*(k-1))/sqrt((4*x**2/(ellipsoid_extent(2))**4)+ &
3985  & (4*y**2/(ellipsoid_extent(2))**4)+(4*z**2/(ellipsoid_extent(1))**4))
3986  rect_coords(1)=x*(1+2*t/(ellipsoid_extent(2))**2)
3987  rect_coords(2)=y*(1+2*t/(ellipsoid_extent(2))**2)
3988  rect_coords(3)=z*(1+2*t/(ellipsoid_extent(1))**2)
3989  np=np+1
3990  npg=component_node_to_user_number(ellipsoid_mesh%GENERATED_MESH,basis_idx,np,err,error)
3991  CALL decomposition_node_domain_get(decomposition,npg,mesh_component,domain_number,err,error,*999)
3992  IF(domain_number==my_computational_node) THEN
3993  DO component_idx=1,field_variable%NUMBER_OF_COMPONENTS
3994  CALL field_parameter_set_update_node(field,field_u_variable_type,field_values_set_type,1,1,npg, &
3995  & component_idx,rect_coords(component_idx),err,error,*999)
3996  local_node=domain%MAPPINGS%NODES%GLOBAL_TO_LOCAL_MAP(npg)%local_number(1)
3997  IF(domain_nodes%NODES(local_node)%NUMBER_OF_DERIVATIVES>1) THEN
3998  CALL flagerror("Not generalized to hermittean elements.",err,error,*999)
3999  ENDIF !derivatives
4000  ENDDO
4001  ENDIF
4002  ENDDO
4003  ENDDO
4004  ENDDO
4005  ELSE
4006  CALL flagerror("Not valid long axis - short axis relation",err,error,*999)
4007  ENDIF
4008  ELSE
4009  CALL flagerror("All field variable components must have node-based interpolation.",err,error,*999)
4010  ENDIF
4011  CALL field_parameter_set_update_start(field,field_u_variable_type,field_values_set_type,err,error,*999)
4012  CALL field_parameter_set_update_finish(field,field_u_variable_type,field_values_set_type,err,error,*999)
4013  ELSE
4014  CALL flagerror("Geometric field must be three dimensional.",err,error,*999)
4015  ENDIF
4016  ELSE
4017  local_error="The standard field variable is not associated for field number "// &
4018  & trim(number_to_vstring(field%USER_NUMBER,"*",err,error))//"."
4019  CALL flagerror(local_error,err,error,*999)
4020  ENDIF
4021  ELSE
4022  local_error="Field number "//trim(number_to_vstring(field%USER_NUMBER,"*",err,error))//" is not a geometric field."
4023  CALL flagerror(local_error,err,error,*999)
4024  ENDIF
4025 
4026  ! all done
4027  IF(ALLOCATED(nidx)) DEALLOCATE(nidx)
4028  IF(ALLOCATED(eidx)) DEALLOCATE(eidx)
4029 
4030  exits("GeneratedMesh_EllipsoidGeometricParametersCalculate")
4031  RETURN
4032 999 IF(ALLOCATED(nidx)) DEALLOCATE(nidx)
4033  IF(ALLOCATED(eidx)) DEALLOCATE(eidx)
4034  errors("GeneratedMesh_EllipsoidGeometricParametersCalculate",err,error)
4035  exits("GeneratedMesh_EllipsoidGeometricParametersCalculate")
4036  RETURN 1
4037 
4038  END SUBROUTINE generatedmesh_ellipsoidgeometricparameterscalculate
4039 
4040  !
4041  !================================================================================================================================
4042  !
4043 
4045  SUBROUTINE generated_mesh_regular_surface_get(REGULAR_MESH,MESH_COMPONENT,SURFACE_TYPE,SURFACE_NODES,NORMAL_XI,ERR,ERROR,*)
4046 
4047  ! Argument variables
4048  TYPE(generated_mesh_regular_type), POINTER :: regular_mesh
4049  INTEGER(INTG), INTENT(IN) :: mesh_component
4050  INTEGER(INTG), INTENT(IN) :: surface_type
4051  INTEGER(INTG), ALLOCATABLE, INTENT(OUT) :: surface_nodes(:)
4052  INTEGER(INTG), INTENT(OUT) :: normal_xi
4053  INTEGER(INTG), INTENT(OUT) :: err
4054  TYPE(varying_string), INTENT(OUT) :: error
4055  ! Local variables
4056  TYPE(basis_type), POINTER :: basis
4057  INTEGER(INTG),ALLOCATABLE :: nidx(:,:,:),eidx(:,:,:)
4058  INTEGER(INTG) :: number_of_elements_xi(3) !Specified number of elements in each xi direction
4059  INTEGER(INTG) :: number_of_nodes_xi(3) ! Number of nodes per element in each xi direction (basis property)
4060  INTEGER(INTG) :: num_dims,total_number_of_nodes,total_number_of_elements,node_user_number
4061  REAL(DP) :: delta(3),deltai(3)
4062  TYPE(varying_string) :: local_error
4063  INTEGER(INTG) :: node_counter,i,j,k
4064 
4065  enters("GENERATED_MESH_REGULAR_SURFACE_GET",err,error,*999)
4066 
4067  IF(ALLOCATED(regular_mesh%NUMBER_OF_ELEMENTS_XI)) THEN
4068  num_dims=SIZE(regular_mesh%NUMBER_OF_ELEMENTS_XI)
4069  IF(num_dims==2) THEN
4070  number_of_elements_xi(1:2)=regular_mesh%NUMBER_OF_ELEMENTS_XI(1:2)
4071  number_of_elements_xi(3)=1
4072  ELSE IF (num_dims==1) THEN
4073  number_of_elements_xi(1)=regular_mesh%NUMBER_OF_ELEMENTS_XI(1)
4074  number_of_elements_xi(2)=1
4075  number_of_elements_xi(3)=1
4076  ELSE
4077  number_of_elements_xi=regular_mesh%NUMBER_OF_ELEMENTS_XI
4078  ENDIF
4079  IF(ASSOCIATED(regular_mesh%BASES(mesh_component)%PTR)) THEN
4080  basis=>regular_mesh%BASES(mesh_component)%PTR
4081  IF(.NOT.ALLOCATED(surface_nodes)) THEN
4082  !Node that simplex bases have an extra area coordinate so size of number_of_nodes_xic=num_dims+1
4083  number_of_nodes_xi(1:num_dims)=basis%NUMBER_OF_NODES_XIC(1:num_dims)
4084  number_of_nodes_xi(num_dims+1:3)=1
4085 
4086  ! build indices first (some of these are dummy arguments)
4087  CALL generated_mesh_regular_build_node_indices(number_of_elements_xi,number_of_nodes_xi, &
4088  & regular_mesh%MAXIMUM_EXTENT,total_number_of_nodes,total_number_of_elements,nidx,eidx,delta,deltai,err,error,*999)
4089  node_counter=0
4090  SELECT CASE(surface_type)
4091  CASE(generated_mesh_regular_left_surface)
4092  ALLOCATE(surface_nodes((SIZE(nidx,2))*(SIZE(nidx,3))),stat=err)
4093  IF(err/=0) CALL flagerror("Could not allocate NODES array.",err,error,*999)
4094  DO k=1,SIZE(nidx,3)
4095  DO j=1,SIZE(nidx,2)
4096  node_counter=node_counter+1
4097  surface_nodes(node_counter)=nidx(1,j,k)
4098  ENDDO
4099  ENDDO
4100  normal_xi=-1
4101  CASE(generated_mesh_regular_right_surface)
4102  ALLOCATE(surface_nodes((SIZE(nidx,2))*(SIZE(nidx,3))),stat=err)
4103  IF(err/=0) CALL flagerror("Could not allocate NODES array.",err,error,*999)
4104  DO k=1,SIZE(nidx,3)
4105  DO j=1,SIZE(nidx,2)
4106  node_counter=node_counter+1
4107  surface_nodes(node_counter)=nidx(SIZE(nidx,1),j,k)
4108  ENDDO
4109  ENDDO
4110  normal_xi=1
4111  CASE(generated_mesh_regular_top_surface)
4112  ALLOCATE(surface_nodes((SIZE(nidx,1))*(SIZE(nidx,2))),stat=err)
4113  IF(err/=0) CALL flagerror("Could not allocate NODES array.",err,error,*999)
4114  DO j=1,SIZE(nidx,2)
4115  DO i=1,SIZE(nidx,1)
4116  node_counter=node_counter+1
4117  surface_nodes(node_counter)=nidx(i,j,SIZE(nidx,3))
4118  ENDDO
4119  ENDDO
4120  normal_xi=3
4121  CASE(generated_mesh_regular_bottom_surface)
4122  ALLOCATE(surface_nodes((SIZE(nidx,1))*(SIZE(nidx,2))),stat=err)
4123  IF(err/=0) CALL flagerror("Could not allocate NODES array.",err,error,*999)
4124  DO j=1,SIZE(nidx,2)
4125  DO i=1,SIZE(nidx,1)
4126  node_counter=node_counter+1
4127  surface_nodes(node_counter)=nidx(i,j,1)
4128  ENDDO
4129  ENDDO
4130  normal_xi=-3
4131  CASE(generated_mesh_regular_front_surface)
4132  ALLOCATE(surface_nodes((SIZE(nidx,1))*(SIZE(nidx,3))),stat=err)
4133  IF(err/=0) CALL flagerror("Could not allocate NODES array.",err,error,*999)
4134  DO j=1,SIZE(nidx,3)
4135  DO i=1,SIZE(nidx,1)
4136  node_counter=node_counter+1
4137  surface_nodes(node_counter)=nidx(i,1,j)
4138  ENDDO
4139  ENDDO
4140  normal_xi=-2
4141  CASE(generated_mesh_regular_back_surface)
4142  ALLOCATE(surface_nodes((SIZE(nidx,1))*(SIZE(nidx,3))),stat=err)
4143  IF(err/=0) CALL flagerror("Could not allocate NODES array.",err,error,*999)
4144  DO j=1,SIZE(nidx,3)
4145  DO i=1,SIZE(nidx,1)
4146  node_counter=node_counter+1
4147  surface_nodes(node_counter)=nidx(i,SIZE(nidx,2),j)
4148  ENDDO
4149  ENDDO
4150  normal_xi=2
4151  CASE DEFAULT
4152  local_error="The specified surface type of "//trim(number_to_vstring(surface_type,"*",err,error))// &
4153  & " is invalid for a regular mesh."
4154  CALL flagerror(local_error,err,error,*999)
4155  END SELECT
4156  !Now convert the component node numbering to user numbers if a mesh has multiple components
4157  DO node_counter=1,SIZE(surface_nodes,1)
4158  SELECT CASE(regular_mesh%BASES(mesh_component)%PTR%TYPE)
4159  CASE(basis_lagrange_hermite_tp_type)
4160  CALL generatedmesh_regularcomponentnodetousernumber(regular_mesh%GENERATED_MESH,mesh_component, &
4161  & surface_nodes(node_counter),node_user_number,err,error,*999)
4162  surface_nodes(node_counter)=node_user_number
4163  CASE(basis_simplex_type)
4164  surface_nodes(node_counter)=component_node_to_user_number(regular_mesh%GENERATED_MESH,mesh_component, &
4165  & surface_nodes(node_counter),err,error)
4166  IF(err/=0) GOTO 999
4167  CASE DEFAULT
4168  CALL flagerror("The basis type of "//trim(number_to_vstring(regular_mesh%BASES(mesh_component)%PTR%TYPE, &
4169  & "*",err,error))//" is not implemented when getting a regular mesh surface.",err,error,*999)
4170  END SELECT
4171  END DO
4172  ELSE
4173  CALL flagerror("Output SURFACE_NODES array is already allocated.",err,error,*999)
4174  ENDIF
4175  ELSE
4176  CALL flagerror("Regular mesh object does not have a basis associated.",err,error,*999)
4177  ENDIF
4178  ELSE
4179  CALL flagerror("Regular mesh object does not have number of elements property specified.",err,error,*999)
4180  ENDIF
4181 
4182  exits("GENERATED_MESH_REGULAR_SURFACE_GET")
4183  RETURN
4184 999 errorsexits("GENERATED_MESH_REGULAR_SURFACE_GET",err,error)
4185  RETURN 1
4186  END SUBROUTINE generated_mesh_regular_surface_get
4187 
4188  !
4189  !================================================================================================================================
4190  !
4191 
4193  SUBROUTINE generated_mesh_cylinder_surface_get(CYLINDER_MESH,MESH_COMPONENT,SURFACE_TYPE,SURFACE_NODES,NORMAL_XI,ERR,ERROR,*)
4194 
4195  ! Argument variables
4196  TYPE(generated_mesh_cylinder_type), POINTER :: cylinder_mesh
4197  INTEGER(INTG), INTENT(IN) :: mesh_component
4198  INTEGER(INTG), INTENT(IN) :: surface_type
4199  INTEGER(INTG), ALLOCATABLE, INTENT(OUT) :: surface_nodes(:)
4200  INTEGER(INTG), INTENT(OUT) :: normal_xi
4201  INTEGER(INTG), INTENT(OUT) :: err
4202  TYPE(varying_string), INTENT(OUT) :: error
4203  ! Local variables
4204  TYPE(basis_type), POINTER :: basis
4205  INTEGER(INTG),ALLOCATABLE :: nidx(:,:,:),eidx(:,:,:)
4206  INTEGER(INTG) :: number_of_elements_xi(3) !Specified number of elements in each xi direction
4207  INTEGER(INTG) :: number_of_nodes_xi(3) ! Number of nodes per element in each xi direction (basis property)
4208  INTEGER(INTG) :: total_number_of_nodes,total_number_of_elements
4209  REAL(DP) :: delta(3),deltai(3)
4210  TYPE(varying_string) :: local_error
4211  INTEGER(INTG) :: node_counter,i, j, k
4212 
4213  enters("GENERATED_MESH_CYLINDER_SURFACE_GET",err,error,*999)
4214 
4215  ! let's go
4216  IF(ALLOCATED(cylinder_mesh%NUMBER_OF_ELEMENTS_XI)) THEN
4217  number_of_elements_xi=cylinder_mesh%NUMBER_OF_ELEMENTS_XI
4218  IF(ASSOCIATED(cylinder_mesh%BASES(mesh_component)%PTR)) THEN
4219  basis=>cylinder_mesh%BASES(mesh_component)%PTR
4220  IF(.NOT.ALLOCATED(surface_nodes)) THEN
4221  number_of_nodes_xi=basis%NUMBER_OF_NODES_XIC
4222  ! build indices first (some of these are dummy arguments)
4223  CALL generated_mesh_cylinder_build_node_indices(number_of_elements_xi,number_of_nodes_xi, &
4224  & cylinder_mesh%cylinder_extent,total_number_of_nodes,total_number_of_elements,nidx,eidx, &
4225  & delta,deltai,err,error,*999)
4226  node_counter=0
4227  SELECT CASE(surface_type)
4228  CASE(generated_mesh_cylinder_inner_surface)
4229  ALLOCATE(surface_nodes((SIZE(nidx,2))*(SIZE(nidx,3))),stat=err)
4230  IF(err/=0) CALL flagerror("Could not allocate NODES array.",err,error,*999)
4231  DO k=1,SIZE(nidx,3)
4232  DO j=1,SIZE(nidx,2)
4233  node_counter=node_counter+1
4234  surface_nodes(node_counter)=component_node_to_user_number(cylinder_mesh%GENERATED_MESH,mesh_component, &
4235  & nidx(1,j,k),err,error)
4236  ENDDO
4237  ENDDO
4238  normal_xi=-1
4239  CASE(generated_mesh_cylinder_outer_surface)
4240  ALLOCATE(surface_nodes((SIZE(nidx,2))*(SIZE(nidx,3))),stat=err)
4241  IF(err/=0) CALL flagerror("Could not allocate NODES array.",err,error,*999)
4242  DO k=1,SIZE(nidx,3)
4243  DO j=1,SIZE(nidx,2)
4244  node_counter=node_counter+1
4245  surface_nodes(node_counter)=component_node_to_user_number(cylinder_mesh%GENERATED_MESH,mesh_component, &
4246  & nidx(SIZE(nidx,1),j,k),err,error)
4247  ENDDO
4248  ENDDO
4249  normal_xi=1
4250  CASE(generated_mesh_cylinder_top_surface)
4251  ALLOCATE(surface_nodes((SIZE(nidx,1))*(SIZE(nidx,2))),stat=err)
4252  IF(err/=0) CALL flagerror("Could not allocate NODES array.",err,error,*999)
4253  DO j=1,SIZE(nidx,2)
4254  DO i=1,SIZE(nidx,1)
4255  node_counter=node_counter+1
4256  surface_nodes(node_counter)=component_node_to_user_number(cylinder_mesh%GENERATED_MESH,mesh_component, &
4257  & nidx(i,j,SIZE(nidx,3)),err,error)
4258  ENDDO
4259  ENDDO
4260  normal_xi=3
4261  CASE(generated_mesh_cylinder_bottom_surface)
4262  ALLOCATE(surface_nodes((SIZE(nidx,1))*(SIZE(nidx,2))),stat=err)
4263  IF(err/=0) CALL flagerror("Could not allocate NODES array.",err,error,*999)
4264  DO j=1,SIZE(nidx,2)
4265  DO i=1,SIZE(nidx,1)
4266  node_counter=node_counter+1
4267  surface_nodes(node_counter)=component_node_to_user_number(cylinder_mesh%GENERATED_MESH,mesh_component, &
4268  & nidx(i,j,1),err,error)
4269  ENDDO
4270  ENDDO
4271  normal_xi=-3
4272  CASE DEFAULT
4273  local_error="The specified surface type of "//trim(number_to_vstring(surface_type,"*",err,error))//" is invalid."
4274  CALL flagerror(local_error,err,error,*999)
4275  END SELECT
4276  ELSE
4277  CALL flagerror("Output SURFACE_NODES array is already allocated.",err,error,*999)
4278  ENDIF
4279  ELSE
4280  CALL flagerror("Cylinder mesh object does not have a basis associated.",err,error,*999)
4281  ENDIF
4282  ELSE
4283  CALL flagerror("Cylinder mesh object does not have number of elements property specified.",err,error,*999)
4284  ENDIF
4285 
4286  exits("GENERATED_MESH_CYLINDER_SURFACE_GET")
4287  RETURN
4288 999 errorsexits("GENERATED_MESH_CYLINDER_SURFACE_GET",err,error)
4289  RETURN 1
4290  END SUBROUTINE generated_mesh_cylinder_surface_get
4291  !
4292  !================================================================================================================================
4293  !
4294 
4296  SUBROUTINE generated_mesh_ellipsoid_surface_get(ELLIPSOID_MESH,MESH_COMPONENT,SURFACE_TYPE,SURFACE_NODES,NORMAL_XI,ERR,ERROR,*)
4297 
4298  ! Argument variables
4299  TYPE(generated_mesh_ellipsoid_type), POINTER :: ellipsoid_mesh
4300  INTEGER(INTG), INTENT(IN) :: mesh_component
4301  INTEGER(INTG), INTENT(IN) :: surface_type
4302  INTEGER(INTG), ALLOCATABLE, INTENT(OUT) :: surface_nodes(:)
4303  INTEGER(INTG), INTENT(OUT) :: normal_xi
4304  INTEGER(INTG), INTENT(OUT) :: err
4305  TYPE(varying_string), INTENT(OUT) :: error
4306  ! Local variables
4307  TYPE(basis_type), POINTER :: basis
4308  INTEGER(INTG),ALLOCATABLE :: nidx(:,:,:),eidx(:,:,:),corner_nodes(:,:,:)
4309  INTEGER(INTG) :: number_of_elements_xi(3) !Specified number of elements in each xi direction
4310  INTEGER(INTG) :: number_of_nodes_xi(3) ! Number of nodes per element in each xi direction (basis property)
4311  INTEGER(INTG) :: total_number_of_nodes,total_number_of_elements
4312  REAL(DP) :: delta(3),deltai(3)
4313  TYPE(varying_string) :: local_error
4314  INTEGER(INTG) :: node_counter,i, j, k
4315 
4316  enters("GENERATED_MESH_ELLIPSOID_SURFACE_GET",err,error,*999)
4317 
4318  ! let's go
4319  IF(ALLOCATED(ellipsoid_mesh%NUMBER_OF_ELEMENTS_XI)) THEN
4320  number_of_elements_xi=ellipsoid_mesh%NUMBER_OF_ELEMENTS_XI
4321  IF(ALLOCATED(ellipsoid_mesh%BASES)) THEN
4322 
4323 ! !Below, there is an issue:
4324 ! ! BASIS=>ELLIPSOID_MESH%BASES(MESH_COMPONENT)%PTR does not account for the fact that:
4325 ! ! in 'GENERATED_MESH_ELLIPSOID_CREATE_FINISH' the following is done:
4326 ! ! CALL MESH_NUMBER_OF_COMPONENTS_SET(GENERATED_MESH%MESH,SIZE(ELLIPSOID_MESH%BASES)/2,ERR,ERROR,*999)
4327 ! !A temporary work around is the following (although this bug may need to be fixed in several places):
4328 !
4329 ! IF(MESH_COMPONENT==2) THEN
4330 ! BASIS_COMPONENT = MESH_COMPONENT + 1
4331 ! ELSE
4332 ! BASIS_COMPONENT = MESH_COMPONENT
4333 ! ENDIF
4334 !
4335 ! IF(ASSOCIATED(ELLIPSOID_MESH%BASES(BASIS_COMPONENT)%PTR)) THEN
4336 ! BASIS=>ELLIPSOID_MESH%BASES(BASIS_COMPONENT)%PTR
4337 
4338  IF(ASSOCIATED(ellipsoid_mesh%BASES(mesh_component)%PTR)) THEN
4339  basis=>ellipsoid_mesh%BASES(mesh_component)%PTR
4340  IF(.NOT.ALLOCATED(surface_nodes)) THEN
4341  number_of_nodes_xi=basis%NUMBER_OF_NODES_XIC
4342  ! build indices first (some of these are dummy arguments)
4343  CALL generated_mesh_ellipsoid_build_node_indices(number_of_elements_xi,number_of_nodes_xi, &
4344  & ellipsoid_mesh%ellipsoid_extent,total_number_of_nodes,total_number_of_elements,nidx, &
4345  & corner_nodes,eidx,delta,deltai,err,error,*999)
4346  node_counter=0
4347 
4348  SELECT CASE(surface_type)
4349 
4350  CASE(generated_mesh_ellipsoid_inner_surface)
4351  ALLOCATE(surface_nodes((SIZE(nidx,1))*(SIZE(nidx,2)-1)+1),stat=err)
4352  IF(err/=0) CALL flagerror("Could not allocate NODES array.",err,error,*999)
4353  j=1
4354  i=1
4355  node_counter=node_counter+1
4356  surface_nodes(node_counter)=component_node_to_user_number(ellipsoid_mesh%GENERATED_MESH,mesh_component, &
4357  nidx(i,j,1),err,error)
4358  DO j=2,SIZE(nidx,2)
4359  DO i=1, SIZE(nidx,1)
4360  node_counter=node_counter+1
4361  IF (nidx(i,j,1)/=0) THEN
4362  surface_nodes(node_counter)=component_node_to_user_number(ellipsoid_mesh%GENERATED_MESH,mesh_component, &
4363  & nidx(i,j,1),err,error)
4364  ELSE
4365  node_counter=node_counter-1
4366  ENDIF
4367  ENDDO
4368  ENDDO
4369  normal_xi=-3
4370 
4371  CASE(generated_mesh_ellipsoid_outer_surface)
4372  ALLOCATE(surface_nodes((SIZE(nidx,1))*(SIZE(nidx,2)-1)+1),stat=err)
4373  IF(err/=0) CALL flagerror("Could not allocate NODES array.",err,error,*999)
4374  j=1
4375  i=1
4376  node_counter=node_counter+1
4377  surface_nodes(node_counter)=component_node_to_user_number(ellipsoid_mesh%GENERATED_MESH,mesh_component, &
4378  & nidx(i,j,SIZE(nidx,3)),err,error)
4379  DO j=2,SIZE(nidx,2)
4380  DO i=1, SIZE(nidx,1)
4381  node_counter=node_counter+1
4382  IF (nidx(i,j,SIZE(nidx,3))/=0) THEN
4383  surface_nodes(node_counter)=component_node_to_user_number(ellipsoid_mesh%GENERATED_MESH,mesh_component, &
4384  & nidx(i,j,SIZE(nidx,3)),err,error)
4385  ELSE
4386  node_counter=node_counter-1
4387  ENDIF
4388  ENDDO
4389  ENDDO
4390  normal_xi=3
4391 
4392  CASE(generated_mesh_ellipsoid_top_surface)
4393  ALLOCATE(surface_nodes((SIZE(nidx,1))*(SIZE(nidx,3))),stat=err)
4394  IF(err/=0) CALL flagerror("Could not allocate NODES array.",err,error,*999)
4395  DO k=1,SIZE(nidx,3)
4396  DO i=1, SIZE(nidx,1)
4397  node_counter=node_counter+1
4398  IF (nidx(i,SIZE(nidx,2),k)/=0) THEN
4399  surface_nodes(node_counter)=component_node_to_user_number(ellipsoid_mesh%GENERATED_MESH,mesh_component, &
4400  & nidx(i,SIZE(nidx,2),k),err,error)
4401  ELSE
4402  node_counter=node_counter-1
4403  ENDIF
4404  ENDDO
4405  ENDDO
4406  normal_xi=2
4407  CASE DEFAULT
4408  local_error="The specified surface type of "//trim(number_to_vstring(surface_type,"*",err,error))//" is invalid."
4409  CALL flagerror(local_error,err,error,*999)
4410  END SELECT
4411  ELSE
4412  CALL flagerror("Output SURFACE_NODES array is already allocated.",err,error,*999)
4413  ENDIF
4414  ELSE
4415  CALL flagerror("Ellipsoid mesh object does not have the first basis associated.",err,error,*999)
4416  ENDIF
4417  ELSE
4418  CALL flagerror("Ellipsoid mesh object does not have bases allocated.",err,error,*999)
4419  ENDIF
4420  ELSE
4421  CALL flagerror("Ellipsoid mesh object does not have number of elements property specified.",err,error,*999)
4422  ENDIF
4423 
4424  exits("GENERATED_MESH_ELLIPSOID_SURFACE_GET")
4425  RETURN
4426 999 errorsexits("GENERATED_MESH_ELLIPSOID_SURFACE_GET",err,error)
4427  RETURN 1
4428  END SUBROUTINE generated_mesh_ellipsoid_surface_get
4429 
4430  !
4431  !================================================================================================================================
4432  !
4433 
4435  SUBROUTINE generated_mesh_regular_build_node_indices(NUMBER_ELEMENTS_XI,NUMBER_OF_NODES_XIC,MAXIMUM_EXTENT, &
4436  & total_number_of_nodes,total_number_of_elements,nidx,eidx,delta,deltai,err,error,*)
4437 
4438  ! Argument variables
4439  INTEGER(INTG),INTENT(IN) :: number_elements_xi(3)
4440  INTEGER(INTG),INTENT(IN) :: number_of_nodes_xic(3)
4441  REAL(DP),INTENT(IN) :: maximum_extent(3)
4442  INTEGER(INTG),INTENT(OUT) :: total_number_of_nodes
4443  INTEGER(INTG),INTENT(OUT) :: total_number_of_elements
4444  INTEGER(INTG),ALLOCATABLE,INTENT(OUT) :: nidx(:,:,:)
4445  INTEGER(INTG),ALLOCATABLE,INTENT(OUT) :: eidx(:,:,:)
4446  REAL(DP),INTENT(OUT) :: delta(3)
4447  REAL(DP),INTENT(OUT) :: deltai(3)
4448  INTEGER(INTG) :: err
4449  TYPE(varying_string) :: error
4450 
4451  ! Local variables
4452  INTEGER(INTG) :: xi_idx,ne1,ne2,ne3,nn1,nn2,nn3,nn,ne
4453  INTEGER(INTG) :: total_number_nodes_xi(3)
4454 
4455  enters("GENERATED_MESH_REGULAR_BUILD_NODE_INDICES",err,error,*999)
4456 
4457  IF(.NOT.ALLOCATED(nidx)) THEN
4458  IF(.NOT.ALLOCATED(eidx)) THEN
4459  ! calculate DELTA and DELTAi
4460  delta(1)=maximum_extent(1)/number_elements_xi(1)
4461  delta(2)=maximum_extent(2)/number_elements_xi(2)
4462  delta(3)=maximum_extent(3)/number_elements_xi(3)
4463  DO xi_idx=1,3
4464  IF(number_of_nodes_xic(xi_idx)>1) deltai(xi_idx)=delta(xi_idx)/(number_of_nodes_xic(xi_idx)-1)
4465  ENDDO
4466 
4467  ! calculate total elements and nodes
4468  DO xi_idx=1,3
4469  total_number_nodes_xi(xi_idx)=(number_of_nodes_xic(xi_idx)-1)*number_elements_xi(xi_idx)+1
4470  ENDDO
4471  total_number_of_elements=product(number_elements_xi)
4472 
4473  ! calculate NIDX first
4474  ALLOCATE(nidx(total_number_nodes_xi(1),total_number_nodes_xi(2),total_number_nodes_xi(3)),stat=err)
4475  IF(err/=0) CALL flagerror("Could not allocate NIDX array.",err,error,*999)
4476  nn=0
4477  DO nn3=1,total_number_nodes_xi(3)
4478  DO nn2=1,total_number_nodes_xi(2)
4479  DO nn1=1,total_number_nodes_xi(1)
4480  nn=nn+1
4481  nidx(nn1,nn2,nn3)=nn
4482  ENDDO ! nn1
4483  ENDDO ! nn2
4484  ENDDO ! nn3
4485  total_number_of_nodes=nn
4486 
4487  ! now do EIDX
4488  ALLOCATE(eidx(number_elements_xi(1),number_elements_xi(2),number_elements_xi(3)),stat=err)
4489  IF(err/=0) CALL flagerror("Could not allocate EIDX array.",err,error,*999)
4490  ne=0
4491  DO ne3=1,number_elements_xi(3)
4492  DO ne2=1,number_elements_xi(2)
4493  DO ne1=1,number_elements_xi(1)
4494  ne=ne+1
4495  eidx(ne1,ne2,ne3)=ne
4496  ENDDO
4497  ENDDO
4498  ENDDO
4499  total_number_of_elements=ne
4500 
4501  ELSE
4502  CALL flagerror("NIDX array is already allocated.",err,error,*999)
4503  ENDIF
4504  ELSE
4505  CALL flagerror("EIDX array is already allocated.",err,error,*999)
4506  ENDIF
4507 
4508  exits("GENERATED_MESH_REGULAR_BUILD_NODE_INDICES")
4509  RETURN
4510 999 errorsexits("GENERATED_MESH_REGULAR_BUILD_NODE_INDICES",err,error)
4511  RETURN 1
4512  END SUBROUTINE generated_mesh_regular_build_node_indices
4513 
4514  !
4515  !================================================================================================================================
4516  !
4517 
4519  SUBROUTINE generated_mesh_cylinder_build_node_indices(NUMBER_ELEMENTS_XI,NUMBER_OF_NODES_XIC,CYLINDER_EXTENT, &
4520  & total_number_of_nodes,total_number_of_elements,nidx,eidx,delta,deltai,err,error,*)
4521 
4522  ! Argument variables
4523  INTEGER(INTG),INTENT(IN) :: number_elements_xi(3)
4524  INTEGER(INTG),INTENT(IN) :: number_of_nodes_xic(3)
4525  REAL(DP),INTENT(IN) :: cylinder_extent(3)
4526  INTEGER(INTG),INTENT(OUT) :: total_number_of_nodes
4527  INTEGER(INTG),INTENT(OUT) :: total_number_of_elements
4528  INTEGER(INTG),ALLOCATABLE,INTENT(OUT) :: nidx(:,:,:)
4529  INTEGER(INTG),ALLOCATABLE,INTENT(OUT) :: eidx(:,:,:)
4530  REAL(DP),INTENT(OUT) :: delta(3)
4531  REAL(DP),INTENT(OUT) :: deltai(3)
4532  INTEGER(INTG) :: err
4533  TYPE(varying_string) :: error
4534 
4535  ! Local variables
4536  INTEGER(INTG) :: xi_idx,ne1,ne2,ne3,nn1,nn2,nn3,nn,ne
4537  INTEGER(INTG) :: total_number_nodes_xi(3) ! total number of nodes in each xi direction
4538 
4539  enters("GENERATED_MESH_CYLINDER_BUILD_NODE_INDICES",err,error,*999)
4540 
4541  ! Can skip most of the testing as this subroutine is only to be called by
4542  ! GENERATED_MESH_CYLINDER_CREATE_FINISH, which tests the input params.
4543  IF(.NOT.ALLOCATED(nidx)) THEN
4544  IF(.NOT.ALLOCATED(eidx)) THEN
4545  ! calculate DELTA and DELTAi
4546  delta(1)=(cylinder_extent(2)-cylinder_extent(1))/number_elements_xi(1)
4547  delta(2)=twopi/number_elements_xi(2)
4548  delta(3)=cylinder_extent(3)/number_elements_xi(3)
4549  DO xi_idx=1,3
4550  deltai(xi_idx)=delta(xi_idx)/(number_of_nodes_xic(xi_idx)-1)
4551  ENDDO
4552 
4553  ! calculate total elements and nodes
4554  DO xi_idx=1,3
4555  total_number_nodes_xi(xi_idx)=(number_of_nodes_xic(xi_idx)-1)*number_elements_xi(xi_idx)+1
4556  ENDDO
4557  total_number_nodes_xi(2)=total_number_nodes_xi(2)-1 ! theta loops around so slightly different
4558  !TOTAL_NUMBER_OF_ELEMENTS=PRODUCT(NUMBER_ELEMENTS_XI)
4559 
4560  ! calculate NIDX first
4561  ALLOCATE(nidx(total_number_nodes_xi(1),total_number_nodes_xi(2),total_number_nodes_xi(3)),stat=err)
4562  IF(err/=0) CALL flagerror("Could not allocate NIDX array.",err,error,*999)
4563  nn=0
4564  DO nn3=1,total_number_nodes_xi(3)
4565  DO nn2=1,total_number_nodes_xi(2)
4566  DO nn1=1,total_number_nodes_xi(1)
4567  nn=nn+1
4568  nidx(nn1,nn2,nn3)=nn
4569  ENDDO ! nn1
4570  ENDDO ! nn2
4571  ENDDO ! nn3
4572  total_number_of_nodes=nn
4573 
4574  ! now do EIDX
4575  ALLOCATE(eidx(number_elements_xi(1),number_elements_xi(2),number_elements_xi(3)),stat=err)
4576  IF(err/=0) CALL flagerror("Could not allocate EIDX array.",err,error,*999)
4577  ne=0
4578  DO ne3=1,number_elements_xi(3)
4579  DO ne2=1,number_elements_xi(2)
4580  DO ne1=1,number_elements_xi(1)
4581  ne=ne+1
4582  eidx(ne1,ne2,ne3)=ne
4583  ENDDO
4584  ENDDO
4585  ENDDO
4586  total_number_of_elements=ne
4587 
4588  ELSE
4589  CALL flagerror("NIDX array is already allocated.",err,error,*999)
4590  ENDIF
4591  ELSE
4592  CALL flagerror("EIDX array is already allocated.",err,error,*999)
4593  ENDIF
4594 
4595  exits("GENERATED_MESH_CYLINDER_BUILD_NODE_INDICES")
4596  RETURN
4597 999 errorsexits("GENERATED_MESH_CYLINDER_BUILD_NODE_INDICES",err,error)
4598  RETURN 1
4599  END SUBROUTINE generated_mesh_cylinder_build_node_indices
4600 
4601  !
4602  !================================================================================================================================
4603  !
4604 
4606  SUBROUTINE generated_mesh_ellipsoid_build_node_indices(NUMBER_ELEMENTS_XI,NUMBER_OF_NODES_XI,ELLIPSOID_EXTENT, &
4607  & total_number_of_nodes,total_number_of_elements,nidx,corner_nodes,eidx,delta,deltai,err,error,*)
4608 
4609  ! Argument variables
4610  INTEGER(INTG),INTENT(IN) :: number_elements_xi(3)
4611  INTEGER(INTG),INTENT(IN) :: number_of_nodes_xi(3)
4612  REAL(DP),INTENT(IN) :: ellipsoid_extent(4)
4613  INTEGER(INTG),INTENT(OUT) :: total_number_of_nodes
4614  INTEGER(INTG),INTENT(OUT) :: total_number_of_elements
4615  INTEGER(INTG),ALLOCATABLE,INTENT(OUT) :: nidx(:,:,:)
4616  INTEGER(INTG),ALLOCATABLE,INTENT(OUT) :: corner_nodes(:,:,:) ! Returns the array of corner nodes numbered
4617  INTEGER(INTG),ALLOCATABLE,INTENT(OUT) :: eidx(:,:,:)
4618  REAL(DP),INTENT(OUT) :: delta(3)
4619  REAL(DP),INTENT(OUT) :: deltai(3)
4620  INTEGER(INTG) :: err
4621  TYPE(varying_string) :: error
4622 
4623  ! Local variables
4624  INTEGER(INTG) :: xi_idx,ne1,ne2,ne3,nn1,nn2,nn3,tn1,tn2,tn3,nn,ne
4625  INTEGER(INTG) :: total_number_nodes_xi(3) ! total number of nodes in each xi direction
4626 
4627  enters("GENERATED_MESH_ELLIPSOID_BUILD_NODE_INDICES",err,error,*999)
4628 
4629  ! Can skip most of the testing as this subroutine is only to be called by
4630  ! GENERATED_MESH_ELLIPSOID_CREATE_FINISH, which tests the input params.
4631  IF(.NOT.ALLOCATED(nidx)) THEN
4632  IF(.NOT.ALLOCATED(eidx)) THEN
4633  ! calculate DELTA and DELTAi
4634  delta(1)=twopi/number_elements_xi(1)
4635  delta(2)=(pi-ellipsoid_extent(4))/number_elements_xi(2)
4636  delta(3)=ellipsoid_extent(3)/number_elements_xi(3)
4637  DO xi_idx=1,3
4638  deltai(xi_idx)=delta(xi_idx)/(number_of_nodes_xi(xi_idx)-1)
4639  ENDDO
4640 
4641  ! calculate total elements and nodes
4642  DO xi_idx=1,3
4643  total_number_nodes_xi(xi_idx)=(number_of_nodes_xi(xi_idx)-1)*number_elements_xi(xi_idx)+1
4644  ENDDO
4645  total_number_nodes_xi(1)=total_number_nodes_xi(1)-1 ! circumferential loops around so slightly different
4646  total_number_of_elements=product(number_elements_xi)
4647 
4648  ! calculate NIDX first
4649  ALLOCATE(nidx(total_number_nodes_xi(1),total_number_nodes_xi(2),total_number_nodes_xi(3)),stat=err)
4650  IF(err/=0) CALL flagerror("Could not allocate NIDX array.",err,error,*999)
4651  ALLOCATE(corner_nodes(number_elements_xi(1),number_elements_xi(2)+1,number_elements_xi(3)+1),stat=err)
4652  IF(err/=0) CALL flagerror("Could not allocate NIDX array.",err,error,*999)
4653 
4654  !nn: node number inside element in certain direction
4655  !ne: element number in certain direction
4656  !tn: global node number in certain direction
4657  !NN: Node counter
4658  !Due to one more corner node than elements in transmural direction, first shell is taken separatly
4659  nn=0
4660  ne3=1
4661  nn3=1
4662  !Due to one more corner node than elements in longitudinal direction, apex elements are taken separatly
4663  ne2=1
4664  nn2=1
4665  ne1=1
4666  nn1=1
4667  !apex nodes
4668  nn=nn+1
4669  tn3=1
4670  tn2=1
4671  tn1=1
4672  nidx(tn1,tn2,tn3)=nn
4673  corner_nodes(ne1,ne2,ne3)=nn
4674  DO ne2=1,number_elements_xi(2)
4675  DO nn2=2,(number_of_nodes_xi(2))
4676  tn2=tn2+1
4677  tn1=0
4678  DO ne1=1,number_elements_xi(1)
4679  DO nn1=1,(number_of_nodes_xi(1)-1)
4680  tn1=tn1+1
4681  nn=nn+1
4682  nidx(tn1,tn2,tn3)=nn
4683  IF ((nn1==1).AND.(nn2==number_of_nodes_xi(2))) THEN
4684  corner_nodes(ne1,ne2+1,ne3)=nn
4685  ENDIF
4686  ENDDO
4687  ENDDO
4688  ENDDO
4689  ENDDO
4690  DO ne3=1,number_elements_xi(3)
4691  DO nn3=2,number_of_nodes_xi(3)
4692  ne2=1
4693  nn2=1
4694  ne1=1
4695  nn1=1
4696  !apex nodes
4697  nn=nn+1
4698  tn3=tn3+1
4699  tn2=1
4700  tn1=1
4701  nidx(tn1,tn2,tn3)=nn
4702  IF (nn3==number_of_nodes_xi(3)) THEN
4703  corner_nodes(ne1,ne2,ne3+1)=nn
4704  ENDIF
4705  DO ne2=1,number_elements_xi(2)
4706  DO nn2=2,(number_of_nodes_xi(2))
4707  tn2=tn2+1
4708  tn1=0
4709  DO ne1=1,number_elements_xi(1)
4710  DO nn1=1,(number_of_nodes_xi(1)-1)
4711  tn1=tn1+1
4712  nn=nn+1
4713  nidx(tn1,tn2,tn3)=nn
4714  IF ((nn1==1).AND.(nn3==number_of_nodes_xi(3)).AND.(nn2==number_of_nodes_xi(2))) THEN
4715  corner_nodes(ne1,ne2+1,ne3+1)=nn
4716  ENDIF
4717  ENDDO
4718  ENDDO
4719  ENDDO
4720  ENDDO
4721  ENDDO
4722  ENDDO
4723  total_number_of_nodes=nn
4724 
4725  ! now do EIDX
4726  ALLOCATE(eidx(number_elements_xi(1),number_elements_xi(2),number_elements_xi(3)),stat=err)
4727  IF(err/=0) CALL flagerror("Could not allocate EIDX array.",err,error,*999)
4728  ne=0
4729  DO ne3=1,number_elements_xi(3)
4730  DO ne2=1,number_elements_xi(2)
4731  DO ne1=1,number_elements_xi(1)
4732  ne=ne+1
4733  eidx(ne1,ne2,ne3)=ne
4734  ENDDO
4735  ENDDO
4736  ENDDO
4737  total_number_of_elements=ne
4738 
4739  ELSE
4740  CALL flagerror("NIDX array is already allocated.",err,error,*999)
4741  ENDIF
4742  ELSE
4743  CALL flagerror("EIDX array is already allocated.",err,error,*999)
4744  ENDIF
4745 
4746  exits("GENERATED_MESH_ELLIPSOID_BUILD_NODE_INDICES")
4747  RETURN
4748 999 errorsexits("GENERATED_MESH_ELLIPSOID_BUILD_NODE_INDICES",err,error)
4749  RETURN 1
4750  END SUBROUTINE generated_mesh_ellipsoid_build_node_indices
4751 
4752  !
4753  !================================================================================================================================
4754  !
4755 
4757  SUBROUTINE component_nodes_to_user_numbers(GENERATED_MESH,BASIS_INDEX,NODE_COMPONENT_NUMBERS, &
4758  & node_user_numbers,err,error,*)
4759 
4760  TYPE(generated_mesh_type), POINTER :: generated_mesh
4761  INTEGER(INTG),INTENT(IN) :: basis_index
4762  INTEGER(INTG),INTENT(IN) :: node_component_numbers(:)
4763  INTEGER(INTG),INTENT(INOUT) :: node_user_numbers(:)
4764  INTEGER(INTG) :: err
4765  TYPE(varying_string) :: error
4766  !local variables
4767  INTEGER(INTG) :: node_idx
4768 
4769  enters("COMPONENT_NODES_TO_USER_NUMBERS",err,error,*999)
4770 
4771  IF(SIZE(node_user_numbers)==SIZE(node_component_numbers)) THEN
4772  DO node_idx=1,SIZE(node_component_numbers)
4773  node_user_numbers(node_idx)=component_node_to_user_number(generated_mesh,basis_index, &
4774  node_component_numbers(node_idx),err,error)
4775  ENDDO
4776  ELSE
4777  CALL flagerror("NODE_COMPONENT_NUMBERS and NODE_USER_NUMBERS arrays have different sizes.",err,error,*999)
4778  ENDIF
4779 
4780  exits("COMPONENT_NODES_TO_USER_NUMBERS")
4781  RETURN
4782 999 errorsexits("COMPONENT_NODES_TO_USER_NUMBERS",err,error)
4783  RETURN 1
4784  END SUBROUTINE component_nodes_to_user_numbers
4785 
4786  !
4787  !================================================================================================================================
4788  !
4789 
4791  FUNCTION component_node_to_user_number(GENERATED_MESH,BASIS_INDEX,NODE_COMPONENT_NUMBER,ERR,ERROR)
4792  TYPE(generated_mesh_type), POINTER :: generated_mesh
4793  INTEGER(INTG),INTENT(IN) :: basis_index
4794  INTEGER(INTG),INTENT(IN) :: node_component_number
4795  INTEGER(INTG) :: err
4796  TYPE(varying_string) :: error
4797  !function variable
4798  INTEGER(INTG) :: component_node_to_user_number
4799 
4800  !local variables
4801  INTEGER(INTG) :: num_bases,num_dims,basis_idx,ni,remainder,remainder2,temp_term,num_corner_nodes,node_offset,basis_num_nodes
4802  INTEGER(INTG) :: pos(3),pos2(3),corner_node_factor(3),basis_node_factor(3),basis_element_factor(3),num_previous_corners,step
4803  INTEGER(INTG), POINTER :: number_of_elements_xi(:)
4804  TYPE(basis_type), POINTER :: basis
4805  TYPE(basis_ptr_type), POINTER :: bases(:)
4806  LOGICAL :: corner_node,finished_count
4807  TYPE(varying_string) :: local_error
4808 
4809  enters("COMPONENT_NODE_TO_USER_NUMBER",err,error,*999)
4810 
4811  NULLIFY(basis)
4812  NULLIFY(bases)
4813  num_corner_nodes=1
4814  remainder=node_component_number-1 !use zero based numbering
4815  remainder2=node_component_number-1
4816  component_node_to_user_number=0
4817  pos=0
4818  pos2=0
4819 
4820  IF(ASSOCIATED(generated_mesh)) THEN
4821  SELECT CASE(generated_mesh%GENERATED_TYPE)
4822  CASE(generated_mesh_regular_mesh_type)
4823  IF(ASSOCIATED(generated_mesh%REGULAR_MESH)) THEN
4824  num_bases=SIZE(generated_mesh%REGULAR_MESH%BASES)
4825  num_dims=generated_mesh%REGULAR_MESH%MESH_DIMENSION
4826  bases=>generated_mesh%REGULAR_MESH%BASES
4827  number_of_elements_xi=>generated_mesh%REGULAR_MESH%NUMBER_OF_ELEMENTS_XI
4828  ELSE
4829  CALL flagerror("The regular mesh for this generated mesh is not associated.",err,error,*999)
4830  ENDIF
4831  CASE(generated_mesh_polar_mesh_type)
4832  CALL flagerror("Not implemented.",err,error,*999)
4833  CASE(generated_mesh_fractal_tree_mesh_type)
4834  CALL flagerror("Not implemented.",err,error,*999)
4835  CASE(generated_mesh_cylinder_mesh_type)
4836  IF(ASSOCIATED(generated_mesh%CYLINDER_MESH)) THEN
4837  num_bases=SIZE(generated_mesh%CYLINDER_MESH%BASES)
4838  num_dims=generated_mesh%CYLINDER_MESH%MESH_DIMENSION
4839  bases=>generated_mesh%CYLINDER_MESH%BASES
4840  number_of_elements_xi=>generated_mesh%CYLINDER_MESH%NUMBER_OF_ELEMENTS_XI
4841  ELSE
4842  CALL flagerror("The cylinder mesh for this generated mesh is not associated.",err,error,*999)
4843  ENDIF
4844  CASE(generated_mesh_ellipsoid_mesh_type)
4845  IF(ASSOCIATED(generated_mesh%ELLIPSOID_MESH)) THEN
4846  num_bases=SIZE(generated_mesh%ELLIPSOID_MESH%BASES)
4847  num_dims=generated_mesh%ELLIPSOID_MESH%MESH_DIMENSION
4848  bases=>generated_mesh%ELLIPSOID_MESH%BASES
4849  number_of_elements_xi=>generated_mesh%ELLIPSOID_MESH%NUMBER_OF_ELEMENTS_XI
4850  ELSE
4851  CALL flagerror("The ellipsoid mesh for this generated mesh is not associated.",err,error,*999)
4852  ENDIF
4853  CASE DEFAULT
4854  local_error="The generated mesh generated type of "// &
4855  & trim(number_to_vstring(generated_mesh%GENERATED_TYPE,"*",err,error))//" is invalid."
4856  CALL flagerror(local_error,err,error,*999)
4857  END SELECT
4858  IF(basis_index<=num_bases) THEN
4859  IF(num_bases==1) THEN
4860  !If is the only basis, don't do anything
4861  component_node_to_user_number=node_component_number
4862  ELSE
4863  temp_term=1
4864  num_corner_nodes=1
4865  DO ni=1,num_dims
4866  num_corner_nodes=num_corner_nodes*(number_of_elements_xi(ni)+1)
4867  corner_node_factor(ni)=1
4868  IF(ni>1) THEN
4869  temp_term=temp_term*(number_of_elements_xi(ni-1)+1)
4870  corner_node_factor(ni)=corner_node_factor(ni)*temp_term
4871  ENDIF
4872  ENDDO
4873  !Adjust for other mesh types
4874  IF(generated_mesh%GENERATED_TYPE==generated_mesh_cylinder_mesh_type) THEN
4875  corner_node_factor(3)=corner_node_factor(3)-number_of_elements_xi(1)-1
4876  num_corner_nodes=num_corner_nodes-(number_of_elements_xi(1)+1)*(number_of_elements_xi(3)+1)
4877  ELSE IF(generated_mesh%GENERATED_TYPE==generated_mesh_ellipsoid_mesh_type) THEN
4878  corner_node_factor(3)=corner_node_factor(3)-number_of_elements_xi(1)-number_of_elements_xi(2)
4879  corner_node_factor(2)=corner_node_factor(2)-1
4880  num_corner_nodes=num_corner_nodes-(number_of_elements_xi(2)+1)*(number_of_elements_xi(3)+1)- &
4881  & (number_of_elements_xi(1)-1)*(number_of_elements_xi(3)+1)
4882  ENDIF
4883  node_offset=num_corner_nodes
4884  IF(generated_mesh%GENERATED_TYPE==generated_mesh_ellipsoid_mesh_type) THEN
4885  !Every second mesh component is the collapsed node version
4886  step=2
4887  ELSE
4888  step=1
4889  ENDIF
4890  DO basis_idx=1,basis_index-1,step
4891  basis=>bases(basis_idx)%PTR
4892  basis_num_nodes=1
4893  DO ni=1,num_dims
4894  basis_num_nodes=basis_num_nodes*(number_of_elements_xi(ni)*(basis%NUMBER_OF_NODES_XIC(ni)-1)+1)
4895  ENDDO
4896  !Adjust for other mesh types
4897  IF(generated_mesh%GENERATED_TYPE==generated_mesh_cylinder_mesh_type) THEN
4898  basis_num_nodes=basis_num_nodes-(number_of_elements_xi(1)+1)*(basis%NUMBER_OF_nodes_xic(1)-1)* &
4899  & (number_of_elements_xi(3)+1)*(basis%NUMBER_OF_nodes_xic(3)-1)
4900  ELSE IF(generated_mesh%GENERATED_TYPE==generated_mesh_ellipsoid_mesh_type) THEN
4901  basis_num_nodes=basis_num_nodes-(number_of_elements_xi(2)*(basis%NUMBER_OF_NODES_XIC(2)-1)+1)* &
4902  & (number_of_elements_xi(3)*(basis%NUMBER_OF_NODES_XIC(3)-1)+1)- &
4903  & (number_of_elements_xi(1)*(basis%NUMBER_OF_NODES_XIC(1)-1)-1)* &
4904  & (number_of_elements_xi(3)*(basis%NUMBER_OF_NODES_XIC(3)-1)+1)
4905  ENDIF
4906  node_offset=node_offset+basis_num_nodes-num_corner_nodes
4907  ENDDO
4908  basis=>bases(basis_index)%PTR
4909  temp_term=1
4910  DO ni=1,num_dims
4911  basis_node_factor(ni)=1
4912  basis_element_factor(ni)=basis%NUMBER_OF_NODES_XIC(ni)-1
4913  IF(ni>1) THEN
4914  temp_term=temp_term*((basis%NUMBER_OF_NODES_XIC(ni-1)-1)*number_of_elements_xi(ni-1)+1)
4915  basis_node_factor(ni)=basis_node_factor(ni)*temp_term
4916  basis_element_factor(ni)=basis_element_factor(ni)*temp_term
4917  ENDIF
4918  ENDDO
4919  !Adjust for other mesh types
4920  IF(generated_mesh%GENERATED_TYPE==generated_mesh_cylinder_mesh_type) THEN
4921  !subtract nodes along line where y wraps around
4922  basis_node_factor(3)=basis_node_factor(3)-number_of_elements_xi(1)*(basis%NUMBER_OF_NODES_XIC(1)-1)-1
4923  basis_element_factor(3)=basis_element_factor(3)-(number_of_elements_xi(1)* &
4924  & (basis%NUMBER_OF_NODES_XIC(1)-1)+1)*(basis%NUMBER_OF_NODES_XIC(3)-1)
4925  ELSE IF(generated_mesh%GENERATED_TYPE==generated_mesh_ellipsoid_mesh_type) THEN
4926  !subtract missing nodes at apex
4927  basis_node_factor(3)=basis_node_factor(3)-number_of_elements_xi(1)*(basis%NUMBER_OF_NODES_XIC(1)-1)+1
4928  basis_element_factor(3)=basis_element_factor(3)-(number_of_elements_xi(1)* &
4929  & (basis%NUMBER_OF_NODES_XIC(1)-1)+1)*(basis%NUMBER_OF_NODES_XIC(3)-1)
4930  !subtract nodes along line where x wraps around
4931  basis_node_factor(3)=basis_node_factor(3)-number_of_elements_xi(2)*(basis%NUMBER_OF_NODES_XIC(2)-1)-1
4932  basis_element_factor(3)=basis_element_factor(3)-(number_of_elements_xi(2)*(basis%NUMBER_OF_NODES_XIC(2)-1)-1)* &
4933  & (basis%NUMBER_OF_NODES_XIC(3)-1)
4934  basis_node_factor(2)=basis_node_factor(2)-1
4935  basis_element_factor(2)=basis_element_factor(2)-(basis%NUMBER_OF_NODES_XIC(2)-1)
4936  ENDIF
4937  !Work out if we have a corner node, otherwise add node numbers used by corners and
4938  !previous basis interpolations and subtract number of corner nodes used before the
4939  !given component node number to get the user number
4940  corner_node=.true.
4941  IF(num_dims>2) THEN
4942  pos(3)=remainder/basis_node_factor(3)
4943  pos2(3)=remainder2/basis_element_factor(3)
4944  remainder=mod(remainder,basis_node_factor(3))
4945  remainder2=mod(remainder2,basis_element_factor(3))
4946  IF(mod(pos(3),basis%NUMBER_OF_NODES_XIC(3)-1)/=0) corner_node=.false.
4947  ENDIF
4948  IF(num_dims>1) THEN
4949  IF(generated_mesh%GENERATED_TYPE==generated_mesh_ellipsoid_mesh_type) THEN
4950  !Need to account for missing nodes at apex
4951  IF(remainder>0) THEN
4952  remainder=remainder+number_of_elements_xi(1)*(basis%NUMBER_OF_NODES_XIC(1)-1)-1
4953  remainder2=remainder2+number_of_elements_xi(1)*(basis%NUMBER_OF_NODES_XIC(1)-1)-1
4954  ENDIF
4955  ENDIF
4956  pos(2)=remainder/basis_node_factor(2)
4957  pos2(2)=remainder2/basis_element_factor(2)
4958  remainder=mod(remainder,basis_node_factor(2))
4959  remainder2=mod(remainder2,basis_element_factor(2))
4960  IF(mod(pos(2),basis%NUMBER_OF_NODES_XIC(2)-1)/=0) corner_node=.false.
4961  ENDIF
4962  pos(1)=remainder/basis_node_factor(1)
4963  pos2(1)=remainder2/basis_element_factor(1)
4964  IF(mod(pos(1),basis%NUMBER_OF_NODES_XIC(1)-1)/=0) corner_node=.false.
4965  IF(corner_node) THEN
4966  component_node_to_user_number=pos2(1)*corner_node_factor(1)+pos2(2)*corner_node_factor(2)+ &
4967  & pos2(3)*corner_node_factor(3)
4968  IF(generated_mesh%GENERATED_TYPE==generated_mesh_ellipsoid_mesh_type.AND.pos2(2)/=0) THEN
4969  !Subtract off non-existent nodes at apex
4970  component_node_to_user_number=component_node_to_user_number-(number_of_elements_xi(1)-1)
4971  ENDIF
4972  component_node_to_user_number=component_node_to_user_number+1
4973  ELSE
4974  !subtract previous corner nodes from node offset
4975  num_previous_corners=0
4976  finished_count=.false.
4977  IF(num_dims>2) THEN
4978  IF(mod(pos(3),basis%NUMBER_OF_NODES_XIC(3)-1)/=0) THEN
4979  num_previous_corners=num_previous_corners+corner_node_factor(3)*(pos2(3)+1)
4980  finished_count=.true.
4981  ELSE
4982  num_previous_corners=num_previous_corners+corner_node_factor(3)*pos2(3)
4983  ENDIF
4984  ENDIF
4985  IF((num_dims>1) .AND. (finished_count.NEQV..true.)) THEN
4986  IF(mod(pos(2),basis%NUMBER_OF_NODES_XIC(2)-1)/=0) THEN
4987  num_previous_corners=num_previous_corners+corner_node_factor(2)*(pos2(2)+1)
4988  finished_count=.true.
4989  ELSE
4990  num_previous_corners=num_previous_corners+corner_node_factor(2)*pos2(2)
4991  ENDIF
4992  IF(generated_mesh%GENERATED_TYPE==generated_mesh_ellipsoid_mesh_type) THEN
4993  num_previous_corners=num_previous_corners-(number_of_elements_xi(1)-1)
4994  ENDIF
4995  ENDIF
4996  IF(finished_count.NEQV..true.) THEN
4997  IF(mod(pos(1),basis%NUMBER_OF_NODES_XIC(1)-1)/=0) THEN
4998  num_previous_corners=num_previous_corners+corner_node_factor(1)*(pos2(1)+1)
4999  ELSE
5000  num_previous_corners=num_previous_corners+corner_node_factor(1)*pos2(1)
5001  ENDIF
5002  ENDIF
5003  node_offset=node_offset-num_previous_corners
5004  component_node_to_user_number=node_offset+node_component_number
5005  ENDIF
5006  ENDIF
5007  ELSE
5008  local_error="Mesh component must be less than or equal to "//(number_to_vstring(num_bases,"*",err,error))// &
5009  & " but it is "//(number_to_vstring(basis_index,"*",err,error))//"."
5010  CALL flagerror(local_error,err,error,*999)
5011  ENDIF
5012  ELSE
5013  CALL flagerror("Generated mesh is not associated",err,error,*999)
5014  ENDIF
5015 
5016  exits("COMPONENT_NODE_TO_USER_NUMBER")
5017  RETURN
5018 999 errorsexits("COMPONENT_NODE_TO_USER_NUMBER",err,error)
5019  RETURN
5020  END FUNCTION component_node_to_user_number
5021 
5022  !
5023  !================================================================================================================================
5024  !
5026 
5027  !1. For the current mesh component/basis, search previous basis to see if the
5028  !current basis has occurred.
5029  !2(1). If occurred, reuse user node number (i.e. same mesh topology)--> finish.
5030  !2(2). If not occurred (i.e. different mesh topology), reuse corner nodes
5031  !3. Search previous basis to see if current interpolation scheme in xi1/2/3
5032  !direction has occurred in the same xi direction if previous basis.
5033  !4(1). If occurred in xi1/2/3 direction, reuse node user numbers on
5034  !corresponding edges/faces. e.g. linear-quadratic scheme v.s. biquadratic
5035  !scheme, then node user numbers on edges alone xi2 direction can be reused.
5036  !4(2). If never occurred (i.e. completely different basis. e.g. biquadratic v.s.
5037  !bicubic), do nothing.
5038  !5. Search previous basis to find the largest node user number, any new node
5039  !user number will increment based on the current largest.
5040  !6. Give node user numbers to nodes that have never appeared in previous
5041  !basis.--> finish.
5042 
5043  SUBROUTINE generatedmesh_regularcomponentnodestousernumbers(GENERATED_MESH,BASIS_INDEX, &
5044  & node_component_numbers,node_user_numbers,err,error,*)
5045 
5046  !Argument variables
5047  TYPE(generated_mesh_type), POINTER :: generated_mesh
5048  INTEGER(INTG),INTENT(IN) :: basis_index
5049  INTEGER(INTG),INTENT(IN) :: node_component_numbers(:)
5050  INTEGER(INTG),INTENT(INOUT) :: node_user_numbers(:)
5051  INTEGER(INTG) :: err
5052  TYPE(varying_string) :: error
5053  !Local variables
5054 
5055  TYPE(basis_ptr_type), POINTER :: bases(:)
5056  TYPE(basis_type), POINTER :: basis_first_comp,basis_pre
5057  INTEGER(INTG) :: num_bases,num_dims,node_offset_last_basis,last_elem_no,node_offset_elem,offset_unit,element_no
5058  INTEGER(INTG) :: node_offset_xi2_accum,node_offset_xi2,node_offset,node_offset_xi3_accum
5059  INTEGER(INTG) :: node_idx_cur,node_idx_first,node_idx_pre
5060  INTEGER(INTG) :: node_idx,nn1,nn2,nn3,xi_idx,basis_idx
5061  INTEGER(INTG) :: elem_idx(3),same_basis(3),number_of_nodes_xic(3),number_of_elements_xi(3),reminder_temp
5062  INTEGER(INTG) :: number_of_nodes_temp,node_index_temp,node_count,index_count,zero_count_xi1(16)
5063  INTEGER(INTG) :: zero_count_xi12(4),edge_node(16),total_zero_node,node_offset_elem_xi12
5064  INTEGER(INTG) :: number_of_nodes_layer
5065  LOGICAL::basis_appeared
5066 
5067  enters("GeneratedMesh_RegularComponentNodesToUserNumbers",err,error,*999)
5068 
5069  IF(SIZE(node_user_numbers)==SIZE(node_component_numbers)) THEN
5070  node_user_numbers=0
5071  IF(ASSOCIATED(generated_mesh)) THEN
5072  IF(ASSOCIATED(generated_mesh%REGULAR_MESH)) THEN
5073  num_bases=SIZE(generated_mesh%REGULAR_MESH%BASES)
5074  num_dims=generated_mesh%REGULAR_MESH%MESH_DIMENSION
5075  bases=>generated_mesh%REGULAR_MESH%BASES
5076  number_of_elements_xi=1
5077  DO xi_idx=1,num_dims
5078  number_of_elements_xi(xi_idx)=generated_mesh%REGULAR_MESH%NUMBER_OF_ELEMENTS_XI(xi_idx)
5079  ENDDO
5080  ELSE
5081  CALL flagerror("The regular mesh for this generated mesh is not associated.",err,error,*999)
5082  ENDIF
5083 
5084  !Number of nodes in each xi direction
5085  number_of_nodes_xic=1
5086  DO xi_idx=1,num_dims
5087  number_of_nodes_xic(xi_idx)=bases(basis_index)%PTR%NUMBER_OF_NODES_XIC(xi_idx)
5088  ENDDO
5089 
5090  !Calculate current element indices and number
5091  reminder_temp=0;
5092  elem_idx=1;
5093  SELECT CASE(num_dims)
5094  CASE(1)
5095  !Calculate xi1 element index
5096  elem_idx(1)=(node_component_numbers(1)-1)/(number_of_nodes_xic(1)-1)+1
5097  !Calculate element number
5098  element_no=elem_idx(1)
5099  CASE(2)
5100  !Calculate xi2 element index
5101  number_of_nodes_layer=((number_of_nodes_xic(1)-1)*number_of_elements_xi(1)+1)*(number_of_nodes_xic(2)-1)
5102  elem_idx(2)=node_component_numbers(1)/number_of_nodes_layer+1
5103  reminder_temp=mod(node_component_numbers(1),number_of_nodes_layer)
5104  !Calculate xi1 element index
5105  elem_idx(1)=(reminder_temp-1)/(number_of_nodes_xic(1)-1)+1
5106  !Calculate element number
5107  element_no=(elem_idx(2)-1)*number_of_elements_xi(1)+elem_idx(1)
5108  CASE(3)
5109  !Calculate xi3 element index
5110  number_of_nodes_layer=((number_of_nodes_xic(1)-1)*number_of_elements_xi(1)+1)*((number_of_nodes_xic(2)-1)* &
5111  & number_of_elements_xi(2)+1)*(number_of_nodes_xic(3)-1)
5112  elem_idx(3)=node_component_numbers(1)/number_of_nodes_layer+1
5113  reminder_temp=mod(node_component_numbers(1),number_of_nodes_layer)
5114  !Calculate xi2 element index
5115  number_of_nodes_layer=((number_of_nodes_xic(1)-1)*number_of_elements_xi(1)+1)*(number_of_nodes_xic(2)-1)
5116  elem_idx(2)=reminder_temp/number_of_nodes_layer+1
5117  reminder_temp=mod(reminder_temp,number_of_nodes_layer)
5118  !Calculate xi1 element index
5119  elem_idx(1)=(reminder_temp-1)/(number_of_nodes_xic(1)-1)+1
5120  !Calculate element number
5121  element_no=(elem_idx(3)-1)*number_of_elements_xi(1)*number_of_elements_xi(2)+ &
5122  & (elem_idx(2)-1)*number_of_elements_xi(1)+elem_idx(1)
5123  END SELECT
5124 
5125 
5126  !If not the first basis, check if previous basis have same interpolation order in each xi direction
5127  !SAME_BASIS(3) is initialised to have zeros in all entries. If an interpolation scheme has been
5128  !found to have appeared in previous basis, then record the basis number in the corresponding
5129  !xi direction. e.g. First basis: bi-quadratic, Second basis: quadratic-cubic, then SAME_BASIS(3)
5130  !for the second basis will be [1,0,0]
5131  same_basis=0
5132  DO xi_idx=1,num_dims
5133  DO basis_idx=1,basis_index-1
5134  IF(bases(basis_index)%PTR%NUMBER_OF_NODES_XIC(xi_idx)== &
5135  & bases(basis_idx)%PTR%NUMBER_OF_NODES_XIC(xi_idx)) THEN
5136  same_basis(xi_idx)=basis_idx
5137  ENDIF
5138  ENDDO
5139  ENDDO
5140  !Check if the interpolation scheme has appeared in previous basis
5141  basis_appeared=.false.
5142  IF(same_basis(1)/=0) THEN
5143  SELECT CASE(num_dims)
5144  CASE(1)
5145  basis_appeared=.true.
5146  CASE(2)
5147  IF(same_basis(1)==same_basis(2)) basis_appeared=.true.
5148  CASE(3)
5149  IF(same_basis(1)==same_basis(2) .AND. same_basis(1)==same_basis(3)) THEN
5150  basis_appeared=.true.
5151  ENDIF
5152  END SELECT
5153  ENDIF
5154  IF(basis_index==1) THEN
5155  !If this is the first basis, don't do anything
5156  DO node_idx=1,SIZE(node_component_numbers)
5157  node_user_numbers(node_idx)=node_component_numbers(node_idx)
5158  ENDDO
5159  ELSEIF(basis_appeared) THEN
5160  !If the basis has appeared before, reuse node user numbers
5161  DO node_idx=1,SIZE(node_component_numbers)
5162  node_user_numbers(node_idx)=generated_mesh%MESH%TOPOLOGY(same_basis(1))% &
5163  & ptr%ELEMENTS%ELEMENTS(element_no)%USER_ELEMENT_NODES(node_idx)
5164  ENDDO
5165  ELSE
5166  !If the basis has never appeared exactly in previous basis
5167 
5168  !Find corner node user number from the first basis
5169  basis_first_comp=>bases(1)%PTR
5170  DO nn3=1,2
5171  DO nn2=1,2
5172  DO nn1=1,2
5173  node_idx_cur=nn1
5174  node_idx_first=nn1
5175  IF(nn1==2) THEN
5176  node_idx_cur=number_of_nodes_xic(1)
5177  node_idx_first=basis_first_comp%NUMBER_OF_NODES_XIC(1)
5178  ENDIF
5179  IF(num_dims>1 .AND. nn2==2) THEN
5180  node_idx_cur=node_idx_cur+(number_of_nodes_xic(2)-1)*number_of_nodes_xic(1)
5181  node_idx_first=node_idx_first+(basis_first_comp%NUMBER_OF_NODES_XIC(2)-1)* &
5182  & basis_first_comp%NUMBER_OF_NODES_XIC(1)
5183  ENDIF
5184  IF(num_dims>2 .AND. nn3==2) THEN
5185  node_idx_cur=node_idx_cur+number_of_nodes_xic(1)* &
5186  & number_of_nodes_xic(2)*(number_of_nodes_xic(3)-1)
5187  node_idx_first=node_idx_first+basis_first_comp%NUMBER_OF_NODES_XIC(1)* &
5188  & basis_first_comp%NUMBER_OF_NODES_XIC(2)*(basis_first_comp%NUMBER_OF_NODES_XIC(3)-1)
5189  ENDIF
5190  node_user_numbers(node_idx_cur)=generated_mesh%MESH%TOPOLOGY(1)%PTR%ELEMENTS% &
5191  & elements(element_no)%GLOBAL_ELEMENT_NODES(node_idx_first)
5192  ENDDO
5193  ENDDO
5194  ENDDO
5195 
5196  !Find edge node user number from previous basis
5197  IF(same_basis(1)/=0 .AND. num_dims>1) THEN !Do not consider 1D since it's a complete new basis
5198  basis_pre=>bases(same_basis(1))%PTR
5199  DO nn3=1,2
5200  DO nn2=1,2
5201  DO nn1=2,number_of_nodes_xic(1)-1
5202  node_idx_cur=nn1
5203  node_idx_pre=nn1
5204  IF(nn2==2) THEN
5205  node_idx_cur=node_idx_cur+(number_of_nodes_xic(2)-1)*number_of_nodes_xic(1)
5206  node_idx_pre=node_idx_pre+(basis_pre%NUMBER_OF_NODES_XIC(2)-1)*basis_pre%NUMBER_OF_NODES_XIC(1)
5207  ENDIF
5208  IF(num_dims>2 .AND. nn3==2) THEN
5209  node_idx_cur=node_idx_cur+number_of_nodes_xic(1)*number_of_nodes_xic(2)* &
5210  & (number_of_nodes_xic(3)-1)
5211  node_idx_pre=node_idx_pre+basis_pre%NUMBER_OF_NODES_XIC(1)*basis_pre% &
5212  & number_of_nodes_xic(2)*(basis_pre%NUMBER_OF_NODES_XIC(3)-1)
5213  ENDIF
5214  node_user_numbers(node_idx_cur)=generated_mesh%MESH%TOPOLOGY(same_basis(1))% &
5215  & ptr%ELEMENTS%ELEMENTS(element_no)%GLOBAL_ELEMENT_NODES(node_idx_pre)
5216  ENDDO
5217  ENDDO
5218  ENDDO
5219  ENDIF
5220  IF(same_basis(2)/=0) THEN
5221  basis_pre=>bases(same_basis(2))%PTR
5222  DO nn3=1,2
5223  DO nn2=2,number_of_nodes_xic(2)-1
5224  DO nn1=1,2
5225  IF(nn1==1) THEN
5226  node_idx_cur=nn1+(nn2-1)*number_of_nodes_xic(1)
5227  node_idx_pre=nn1+(nn2-1)*basis_pre%NUMBER_OF_NODES_XIC(1)
5228  ELSE
5229  node_idx_cur=nn2*number_of_nodes_xic(1)
5230  node_idx_pre=nn2*basis_pre%NUMBER_OF_NODES_XIC(1)
5231  ENDIF
5232  IF(num_dims>2 .AND. nn3==2) THEN
5233  node_idx_cur=node_idx_cur+number_of_nodes_xic(1)*number_of_nodes_xic(2)* &
5234  & (number_of_nodes_xic(3)-1)
5235  node_idx_pre=node_idx_pre+basis_pre%NUMBER_OF_NODES_XIC(1)*basis_pre% &
5236  & number_of_nodes_xic(2)*(basis_pre%NUMBER_OF_NODES_XIC(3)-1)
5237  ENDIF
5238  node_user_numbers(node_idx_cur)=generated_mesh%MESH%TOPOLOGY(same_basis(2))% &
5239  & ptr%ELEMENTS%ELEMENTS(element_no)%GLOBAL_ELEMENT_NODES(node_idx_pre)
5240  ENDDO
5241  ENDDO
5242  ENDDO
5243  ENDIF
5244  IF(same_basis(3)/=0) THEN !Must be 3D
5245  basis_pre=>bases(same_basis(3))%PTR
5246  node_idx_cur=0
5247  node_idx_pre=0
5248  DO nn3=2,number_of_nodes_xic(3)-1
5249  DO nn2=1,2
5250  IF(nn2==2) THEN
5251  node_idx_cur=(number_of_nodes_xic(2)-1)*number_of_nodes_xic(1)+number_of_nodes_xic(1)* &
5252  & number_of_nodes_xic(2)*(number_of_nodes_xic(3)-1)
5253  node_idx_pre=(basis_pre%NUMBER_OF_NODES_XIC(1)-1)*basis_pre%NUMBER_OF_NODES_XIC(1)+ &
5254  & basis_pre%NUMBER_OF_NODES_XIC(1)*basis_pre%NUMBER_OF_NODES_XIC(2)* &
5255  & (basis_pre%NUMBER_OF_NODES_XIC(3)-1)
5256  ENDIF
5257  DO nn1=1,2
5258  IF(nn1==1) THEN
5259  node_idx_cur=1+node_idx_cur
5260  node_idx_pre=1+node_idx_pre
5261  ELSE
5262  node_idx_cur=number_of_nodes_xic(1)+node_idx_cur
5263  node_idx_pre=basis_pre%NUMBER_OF_NODES_XIC(1)+node_idx_pre
5264  ENDIF
5265  node_user_numbers(node_idx_cur)=generated_mesh%MESH%TOPOLOGY(same_basis(3))% &
5266  & ptr%ELEMENTS%ELEMENTS(element_no)%GLOBAL_ELEMENT_NODES(node_idx_pre)
5267  ENDDO
5268  ENDDO
5269  ENDDO
5270  ENDIF
5271  !The following code would only be executed if 3D (automatically satisfied, don't need to check,
5272  !since there must be at least 1 direction that has different interpolation scheme, if two direction
5273  ! has the same interpolation that has appeared before, then interpolation for the last direction
5274  ! must be different) and has same basis in 2 xi direction
5275  !i.e. find user node numbers for face nodes
5276  IF(same_basis(1)==same_basis(2) .AND. same_basis(1)/=0) THEN
5277  basis_pre=>bases(same_basis(1))%PTR
5278  DO nn3=1,2
5279  DO nn2=2,number_of_nodes_xic(2)-1
5280  DO nn1=2,number_of_nodes_xic(1)-1
5281  node_idx_cur=nn1+(nn2-1)*number_of_nodes_xic(1)
5282  node_idx_pre=nn1+(nn2-1)*basis_pre%NUMBER_OF_NODES_XIC(1)
5283  IF(nn3==2) THEN
5284  node_idx_cur=node_idx_cur+number_of_nodes_xic(1)*number_of_nodes_xic(2)* &
5285  & (number_of_nodes_xic(3)-1)
5286  node_idx_pre=node_idx_pre+basis_pre%NUMBER_OF_NODES_XIC(1)*basis_pre% &
5287  & number_of_nodes_xic(2)*(basis_pre%NUMBER_OF_NODES_XIC(3)-1)
5288  ENDIF
5289  node_user_numbers(node_idx_cur)=generated_mesh%MESH%TOPOLOGY(same_basis(1))% &
5290  & ptr%ELEMENTS%ELEMENTS(element_no)%GLOBAL_ELEMENT_NODES(node_idx_pre)
5291  ENDDO
5292  ENDDO
5293  ENDDO
5294  ELSE IF(same_basis(1)==same_basis(3) .AND. same_basis(1)/=0) THEN
5295  basis_pre=>bases(same_basis(1))%PTR
5296  node_idx_cur=0
5297  node_idx_pre=0
5298  DO nn3=2,number_of_nodes_xic(3)-1
5299  DO nn2=1,2
5300  IF(nn2==2) THEN
5301  node_idx_cur=(number_of_nodes_xic(2)-1)*number_of_nodes_xic(1)+number_of_nodes_xic(1)* &
5302  & number_of_nodes_xic(2)*(nn3-1)
5303  node_idx_pre=(basis_pre%NUMBER_OF_NODES_XIC(2)-1)*basis_pre%NUMBER_OF_NODES_XIC(1)+ &
5304  & basis_pre%NUMBER_OF_NODES_XIC(1)*basis_pre%NUMBER_OF_NODES_XIC(2)*(nn3-1)
5305  ENDIF
5306  DO nn1=2,number_of_nodes_xic(1)-1
5307  node_idx_cur=nn1+node_idx_cur
5308  node_idx_pre=nn1+node_idx_pre
5309  node_user_numbers(node_idx_cur)=generated_mesh%MESH%TOPOLOGY(same_basis(1))% &
5310  & ptr%ELEMENTS%ELEMENTS(element_no)%GLOBAL_ELEMENT_NODES(node_idx_pre)
5311  ENDDO
5312  ENDDO
5313  ENDDO
5314  ELSE IF(same_basis(2)==same_basis(3) .AND. same_basis(2)/=0) THEN
5315  basis_pre=>bases(same_basis(2))%PTR
5316  DO nn3=2,number_of_nodes_xic(3)-1
5317  DO nn2=2,number_of_nodes_xic(2)-1
5318  DO nn1=1,2
5319  IF(nn1==1) THEN
5320  node_idx_cur=1+(nn2-1)*number_of_nodes_xic(1)+number_of_nodes_xic(1)* &
5321  & number_of_nodes_xic(2)*(nn3-1)
5322  node_idx_pre=1+(nn2-1)*basis_pre%NUMBER_OF_NODES_XIC(1)+basis_pre%NUMBER_OF_NODES_XIC(1)* &
5323  & basis_pre%NUMBER_OF_NODES_XIC(2)*(nn3-1)
5324  ELSE
5325  node_idx_cur=nn2*number_of_nodes_xic(1)+number_of_nodes_xic(1)* &
5326  & number_of_nodes_xic(2)*(nn3-1)
5327  node_idx_pre=nn2*basis_pre%NUMBER_OF_NODES_XIC(1)+basis_pre%NUMBER_OF_NODES_XIC(1)* &
5328  & basis_pre%NUMBER_OF_NODES_XIC(2)*(nn3-1)
5329  ENDIF
5330  node_user_numbers(node_idx_cur)=generated_mesh%MESH%TOPOLOGY(same_basis(2))% &
5331  & ptr%ELEMENTS%ELEMENTS(element_no)%GLOBAL_ELEMENT_NODES(node_idx_pre)
5332  ENDDO
5333  ENDDO
5334  ENDDO
5335  ENDIF
5336 
5337  !Find the largest node user number in the previous basis
5338  node_offset_last_basis=0
5339  last_elem_no=generated_mesh%MESH%TOPOLOGY(1)%PTR%ELEMENTS%NUMBER_OF_ELEMENTS !The mesh has the same topology regardless of mesh components
5340  DO basis_idx=1,basis_index-1
5341  number_of_nodes_temp=SIZE(generated_mesh%MESH%TOPOLOGY(basis_idx)%PTR%ELEMENTS% &
5342  & elements(last_elem_no)%GLOBAL_ELEMENT_NODES,1)
5343  DO node_index_temp=1,number_of_nodes_temp
5344  IF (generated_mesh%MESH%TOPOLOGY(basis_idx)%PTR%ELEMENTS%ELEMENTS(last_elem_no)% &
5345  & global_element_nodes(node_index_temp)>node_offset_last_basis) THEN
5346  node_offset_last_basis=generated_mesh%MESH%TOPOLOGY(basis_idx)%PTR%ELEMENTS%ELEMENTS(last_elem_no)% &
5347  &global_element_nodes(node_index_temp)
5348  ENDIF
5349  ENDDO !node_index_temp
5350  ENDDO !basis_idx
5351 
5352  !Calculate number of zeros nodes in different dimensions
5353  index_count=1
5354  zero_count_xi1=0
5355  zero_count_xi12=0
5356  total_zero_node=0
5357  edge_node=0
5358  DO nn3=1,number_of_nodes_xic(3)
5359  DO nn2=1,number_of_nodes_xic(2)
5360  node_count=0
5361  DO nn1=1,number_of_nodes_xic(1)
5362  node_idx=(nn3-1)*number_of_nodes_xic(1)*number_of_nodes_xic(2)+(nn2-1)* &
5363  & number_of_nodes_xic(1)+nn1
5364  IF(node_user_numbers(node_idx)==0) THEN
5365  node_count=node_count+1
5366  total_zero_node=total_zero_node+1 !Total number of zeros in an element
5367  ENDIF
5368  ENDDO !nn1
5369  zero_count_xi1(index_count)=node_count !Total number of zero summed up across xi1 direction.
5370  IF(node_count==number_of_nodes_xic(1)) edge_node(index_count)=1 !Shared edge node (with zero value) in xi1 direction (1 number for each node in xi2 direction)
5371  zero_count_xi12(nn3)=zero_count_xi12(nn3)+zero_count_xi1(index_count) !Total number of zero summed on xi1-xi2 faces
5372  index_count=index_count+1
5373  ENDDO !nn2
5374  ENDDO !nn3
5375 
5376  !Calculate how many zero nodes has occurred in previous elements
5377  node_offset_elem=0
5378  IF(num_dims==2 .AND. elem_idx(2)/=1) THEN !Zero nodes occurred in the previous rows of elements
5379  offset_unit=total_zero_node-zero_count_xi1(1)-sum(edge_node(1:number_of_nodes_xic(2)))+edge_node(index_count)
5380  !This is number of zero nodes in the elements before the current row of elements
5381  node_offset_elem=(elem_idx(2)-1)*number_of_elements_xi(1)*offset_unit+(elem_idx(2)-1)* &
5382  & sum(edge_node(2:number_of_nodes_xic(2)-1))
5383  ELSEIF(num_dims==3 .AND. elem_idx(3)/=1) THEN !Zero nodes occurred in the previous layer of elements
5384  node_offset_xi3_accum=0
5385  DO nn3=1,number_of_nodes_xic(3)-1
5386  offset_unit=zero_count_xi12(nn3)-zero_count_xi1((nn3-1)*number_of_nodes_xic(2)+1)- &
5387  & sum(edge_node((nn3-1)*number_of_nodes_xic(2)+1:nn3*number_of_nodes_xic(2)))+ &
5388  & edge_node((nn3-1)*number_of_nodes_xic(2)+1)
5389  node_offset_xi3_accum=node_offset_xi3_accum+offset_unit*number_of_elements_xi(1)*number_of_elements_xi(2)+ &
5390  & (number_of_elements_xi(1)-1)*(zero_count_xi1((nn3-1)*number_of_nodes_xic(2)+1)- &
5391  & edge_node((nn3-1)*number_of_nodes_xic(2)+1))+zero_count_xi1((nn3-1)*number_of_nodes_xic(2)+1)+ &
5392  & sum(edge_node((nn3-1)*number_of_nodes_xic(2)+2:nn3*number_of_nodes_xic(2)))* &
5393  & number_of_elements_xi(2)
5394  ENDDO
5395  node_offset_elem=(elem_idx(3)-1)*node_offset_xi3_accum
5396  ENDIF
5397 
5398  !Compute other nodes which haven't appeared in previous basis
5399  index_count=1
5400  node_offset_elem_xi12=0
5401  node_offset_xi2=0 !Number of zero nodes in the current row
5402  node_offset_xi3_accum=0 !Number of zero nodes in the layers in xi3 direction (nn3)
5403  DO nn3=1,number_of_nodes_xic(3)
5404  node_offset_xi2_accum=0 !Number of zero nodes in the previous rows
5405  offset_unit=zero_count_xi12(nn3)-zero_count_xi1((nn3-1)*number_of_nodes_xic(2)+1)- &
5406  & sum(edge_node((nn3-1)*number_of_nodes_xic(2)+1:nn3*number_of_nodes_xic(2)))+ &
5407  & edge_node((nn3-1)*number_of_nodes_xic(2)+1)
5408  IF(elem_idx(2)/=1 .AND. num_dims==3) THEN
5409  node_offset_elem_xi12=offset_unit*(elem_idx(2)-1)*number_of_elements_xi(1)+ &
5410  & (elem_idx(2)-1)*sum(edge_node((nn3-1)*number_of_nodes_xic(2)+2:nn3*number_of_nodes_xic(2)))
5411  ENDIF
5412  DO nn2=1,number_of_nodes_xic(2)
5413  node_offset_xi2=(zero_count_xi1(index_count)-edge_node(index_count))*(elem_idx(1)-1)
5414  node_offset=node_offset_last_basis+node_offset_elem+node_offset_xi3_accum+ &
5415  & node_offset_elem_xi12+node_offset_xi2_accum+node_offset_xi2
5416  DO nn1=1,number_of_nodes_xic(1)
5417  !Local node index in the current element
5418  node_idx=(nn3-1)*number_of_nodes_xic(1)*number_of_nodes_xic(2)+(nn2-1)* &
5419  & number_of_nodes_xic(1)+nn1
5420  IF(node_user_numbers(node_idx)==0) THEN
5421  !This is for 2D case
5422  node_offset=node_offset+1
5423  node_user_numbers(node_idx)=node_offset
5424  ENDIF
5425  ENDDO !nn1
5426  node_offset_xi2_accum=node_offset_xi2_accum+(zero_count_xi1(index_count)-edge_node(index_count))* &
5427  & number_of_elements_xi(1)+edge_node(index_count)
5428  index_count=index_count+1
5429  ENDDO !nn2
5430  IF(num_dims==3) THEN
5431  node_offset_xi3_accum=node_offset_xi3_accum+offset_unit*number_of_elements_xi(1)*number_of_elements_xi(2)+ &
5432  & (number_of_elements_xi(1)-1)*(zero_count_xi1((nn3-1)*number_of_nodes_xic(2)+1)- &
5433  & edge_node((nn3-1)*number_of_nodes_xic(2)+1))+zero_count_xi1((nn3-1)*number_of_nodes_xic(2)+1)+ &
5434  & sum(edge_node((nn3-1)*number_of_nodes_xic(2)+2:nn3*number_of_nodes_xic(2)))* &
5435  & number_of_elements_xi(2)
5436  ENDIF
5437  ENDDO !nn3
5438  ENDIF
5439  ELSE
5440  CALL flagerror("Generated mesh is not associated",err,error,*999)
5441  ENDIF
5442  ELSE
5443  CALL flagerror("NODE_COMPONENT_NUMBERS and NODE_USER_NUMBERS arrays have different sizes.",err,error,*999)
5444  ENDIF
5445  exits("GeneratedMesh_RegularComponentNodesToUserNumbers")
5446  RETURN
5447 999 errors("GeneratedMesh_RegularComponentNodesToUserNumbers",err,error)
5448  exits("GeneratedMesh_RegularComponentNodesToUserNumbers")
5449  RETURN 1
5450 
5451  END SUBROUTINE generatedmesh_regularcomponentnodestousernumbers
5452 
5453  !
5454  !================================================================================================================================
5455  !
5456 
5459  SUBROUTINE generatedmesh_regularcomponentnodetousernumber(GENERATED_MESH,BASIS_INDEX, &
5460  & node_component_number,node_user_number,err,error,*)
5461 
5462  !Argument variables
5463  TYPE(generated_mesh_type), POINTER :: generated_mesh
5464  INTEGER(INTG),INTENT(IN) :: basis_index
5465  INTEGER(INTG),INTENT(IN) :: node_component_number
5466  INTEGER(INTG),INTENT(OUT) :: node_user_number
5467  INTEGER(INTG) :: err
5468  TYPE(varying_string) :: error
5469 
5470  !Local variables
5471  TYPE(basis_ptr_type), POINTER :: bases(:)
5472  INTEGER(INTG) :: num_bases,num_dims,element_no,local_node_no,number_of_nodes_layer,xi_idx
5473  INTEGER(INTG) :: elem_idx(3),node_idx(3),number_of_nodes_xic(3),number_of_elements_xi(3),reminder_temp
5474 
5475  enters("GeneratedMesh_RegularComponentNodeToUserNumber",err,error,*999)
5476 
5477  IF(ASSOCIATED(generated_mesh)) THEN
5478  IF(ASSOCIATED(generated_mesh%REGULAR_MESH)) THEN
5479  num_bases=SIZE(generated_mesh%REGULAR_MESH%BASES)
5480  num_dims=generated_mesh%REGULAR_MESH%MESH_DIMENSION
5481  bases=>generated_mesh%REGULAR_MESH%BASES
5482  number_of_elements_xi=1
5483  DO xi_idx=1,num_dims
5484  number_of_elements_xi(xi_idx)=generated_mesh%REGULAR_MESH%NUMBER_OF_ELEMENTS_XI(xi_idx)
5485  ENDDO
5486  !Number of nodes in each xi direction
5487  number_of_nodes_xic=1
5488  DO xi_idx=1,num_dims
5489  number_of_nodes_xic(xi_idx)=bases(basis_index)%PTR%NUMBER_OF_NODES_XIC(xi_idx)
5490  ENDDO
5491  ELSE
5492  CALL flagerror("The regular mesh for this generated mesh is not associated.",err,error,*999)
5493  ENDIF
5494 
5495  !Calculate current element/node indices/number
5496  reminder_temp=0;
5497  elem_idx=1;
5498  node_idx=1;
5499  SELECT CASE(num_dims)
5500  CASE(1)
5501  !Calculate xi1 element index
5502  elem_idx(1)=(node_component_number-1)/(number_of_nodes_xic(1)-1)+1
5503  node_idx(1)=mod(node_component_number-1,number_of_nodes_xic(1)-1)+1
5504  !If it's the last node in the line
5505  IF (elem_idx(1)>number_of_elements_xi(1)) THEN
5506  elem_idx(1)=elem_idx(1)-1
5507  node_idx(1)=number_of_nodes_xic(1)
5508  ENDIF
5509  !Calculate element number
5510  element_no=elem_idx(1)
5511  local_node_no=node_idx(1)
5512  CASE(2)
5513  !Calculate xi2 element index
5514  number_of_nodes_layer=((number_of_nodes_xic(1)-1)*number_of_elements_xi(1)+1)*(number_of_nodes_xic(2)-1)
5515  elem_idx(2)=(node_component_number-1)/number_of_nodes_layer+1
5516  reminder_temp=mod(node_component_number-1,number_of_nodes_layer)
5517  number_of_nodes_layer=((number_of_nodes_xic(1)-1)*number_of_elements_xi(1)+1)
5518  node_idx(2)=reminder_temp/number_of_nodes_layer+1
5519  !If it's the last line of nodes in the line
5520  IF (elem_idx(2)>number_of_elements_xi(2)) THEN
5521  elem_idx(2)=elem_idx(2)-1
5522  node_idx(2)=number_of_nodes_xic(2)
5523  ENDIF
5524  !Calculate xi1 element index
5525  reminder_temp=mod(reminder_temp,number_of_nodes_layer)
5526  elem_idx(1)=reminder_temp/(number_of_nodes_xic(1)-1)+1
5527  node_idx(1)=mod(reminder_temp,number_of_nodes_xic(1)-1)+1
5528  !If it's the last node in the line
5529  IF (elem_idx(1)>number_of_elements_xi(1)) THEN
5530  elem_idx(1)=elem_idx(1)-1
5531  node_idx(1)=number_of_nodes_xic(1)
5532  ENDIF
5533  !Calculate element number
5534  element_no=(elem_idx(2)-1)*number_of_elements_xi(1)+elem_idx(1)
5535  local_node_no=(node_idx(2)-1)*number_of_nodes_xic(1)+node_idx(1)
5536  CASE(3)
5537  !Calculate xi3 element index
5538  number_of_nodes_layer=((number_of_nodes_xic(1)-1)*number_of_elements_xi(1)+1)*((number_of_nodes_xic(2)-1)* &
5539  & number_of_elements_xi(2)+1)*(number_of_nodes_xic(3)-1) !Multiple planes of nodes
5540  elem_idx(3)=(node_component_number-1)/number_of_nodes_layer+1
5541  reminder_temp=mod(node_component_number-1,number_of_nodes_layer) !Multiple planes of nodes
5542  number_of_nodes_layer=((number_of_nodes_xic(1)-1)*number_of_elements_xi(1)+1)*((number_of_nodes_xic(2)-1)* &
5543  & number_of_elements_xi(2)+1) !One plane of nodes
5544  node_idx(3)=reminder_temp/number_of_nodes_layer+1
5545  IF (elem_idx(3)>number_of_elements_xi(3)) THEN
5546  elem_idx(3)=elem_idx(3)-1
5547  node_idx(3)=number_of_nodes_xic(3)
5548  ENDIF
5549  reminder_temp=mod(reminder_temp,number_of_nodes_layer) !One plane of nodes
5550  !Calculate xi2 element index
5551  number_of_nodes_layer=((number_of_nodes_xic(1)-1)*number_of_elements_xi(1)+1)*(number_of_nodes_xic(2)-1) !Multiple lines of nodes
5552  elem_idx(2)=reminder_temp/number_of_nodes_layer+1
5553  reminder_temp=mod(reminder_temp,number_of_nodes_layer) !Multiple lines of nodes
5554  number_of_nodes_layer=(number_of_nodes_xic(1)-1)*number_of_elements_xi(1)+1 !One line of nodes
5555  node_idx(2)=reminder_temp/number_of_nodes_layer+1
5556  reminder_temp=mod(reminder_temp,number_of_nodes_layer) !One line of nodes
5557  IF (elem_idx(2)>number_of_elements_xi(2)) THEN
5558  elem_idx(2)=elem_idx(2)-1
5559  node_idx(2)=number_of_nodes_xic(2)
5560  ENDIF
5561  !Calculate xi1 element index
5562  elem_idx(1)=reminder_temp/(number_of_nodes_xic(1)-1)+1
5563  node_idx(1)=mod(reminder_temp,number_of_nodes_xic(1)-1)+1
5564  IF (elem_idx(1)>number_of_elements_xi(1)) THEN
5565  elem_idx(1)=elem_idx(1)-1
5566  node_idx(1)=number_of_nodes_xic(1)
5567  ENDIF
5568  !Calculate element number
5569  element_no=(elem_idx(3)-1)*number_of_elements_xi(1)*number_of_elements_xi(2)+ &
5570  & (elem_idx(2)-1)*number_of_elements_xi(1)+elem_idx(1)
5571  local_node_no=(node_idx(3)-1)*number_of_nodes_xic(1)*number_of_nodes_xic(2)+(node_idx(2)-1)*number_of_nodes_xic(1)+ &
5572  & node_idx(1)
5573  END SELECT
5574  !Retrieve node user number
5575  IF(ASSOCIATED(generated_mesh%MESH)) THEN
5576  node_user_number=generated_mesh%MESH%TOPOLOGY(basis_index)%PTR%ELEMENTS%ELEMENTS(element_no)% &
5577  & user_element_nodes(local_node_no)
5578  ELSE
5579  CALL flagerror("The mesh for this generated mesh is not associated.",err,error,*999)
5580  ENDIF
5581 
5582  ELSE
5583  CALL flagerror("Generated mesh is not associated",err,error,*999)
5584  ENDIF
5585 
5586  exits("GeneratedMesh_RegularComponentNodeToUserNumber")
5587  RETURN
5588 999 errors("GeneratedMesh_RegularComponentNodeToUserNumber",err,error)
5589  exits("GeneratedMesh_RegularComponentNodeToUserNumber")
5590  RETURN 1
5591 
5592  END SUBROUTINE generatedmesh_regularcomponentnodetousernumber
5593 
5594  !
5595  !================================================================================================================================
5596  !
5597 
5600  FUNCTION user_number_to_component_node(GENERATED_MESH,BASIS_INDEX,NODE_USER_NUMBER,ERR,ERROR)
5601  TYPE(generated_mesh_type), POINTER :: generated_mesh
5602  INTEGER(INTG),INTENT(IN) :: basis_index
5603  INTEGER(INTG),INTENT(IN) :: node_user_number
5604  INTEGER(INTG) :: err
5605  TYPE(varying_string) :: error
5606  !function variable
5607  INTEGER(INTG) :: user_number_to_component_node
5608  !local variables
5609  INTEGER(INTG) :: num_bases,num_dims,basis_idx,ni,remainder,temp_term,num_corner_nodes,node_offset,basis_num_nodes
5610  INTEGER(INTG) :: pos(3),corner_node_factor(3),basis_element_factor(3),num_previous_corners
5611  INTEGER(INTG), POINTER :: number_of_elements_xi(:)
5612  TYPE(basis_type), POINTER :: basis
5613  TYPE(basis_ptr_type), POINTER :: bases(:)
5614  LOGICAL :: finished_count,off_edge
5615  TYPE(varying_string) :: local_error
5616 
5617  enters("USER_NUMBER_TO_COMPONENT_NODE",err,error,*999)
5618 
5619  NULLIFY(basis)
5620  NULLIFY(bases)
5621  num_corner_nodes=1
5622  remainder=node_user_number-1 !use zero based numbering
5623  pos=0
5624 
5625  IF(ASSOCIATED(generated_mesh)) THEN
5626  !Only cylinder mesh type uses this now, although it was previously used by regular
5627  !meshes so some things relate to that.
5628  SELECT CASE(generated_mesh%GENERATED_TYPE)
5629  CASE(generated_mesh_regular_mesh_type)
5630  CALL flagerror("Not implemented.",err,error,*999)
5631  CASE(generated_mesh_polar_mesh_type)
5632  CALL flagerror("Not implemented.",err,error,*999)
5633  CASE(generated_mesh_fractal_tree_mesh_type)
5634  CALL flagerror("Not implemented.",err,error,*999)
5635  CASE(generated_mesh_cylinder_mesh_type)
5636  IF(ASSOCIATED(generated_mesh%CYLINDER_MESH)) THEN
5637  num_bases=SIZE(generated_mesh%CYLINDER_MESH%BASES)
5638  num_dims=generated_mesh%CYLINDER_MESH%MESH_DIMENSION
5639  bases=>generated_mesh%CYLINDER_MESH%BASES
5640  number_of_elements_xi=>generated_mesh%CYLINDER_MESH%NUMBER_OF_ELEMENTS_XI
5641  ELSE
5642  CALL flagerror("The cylinder mesh for this generated mesh is not associated.",err,error,*999)
5643  ENDIF
5644  CASE(generated_mesh_ellipsoid_mesh_type)
5645  CALL flagerror("Not implemented.",err,error,*999)
5646  CASE DEFAULT
5647  local_error="The generated mesh generated type of "// &
5648  & trim(number_to_vstring(generated_mesh%GENERATED_TYPE,"*",err,error))//" is invalid."
5649  CALL flagerror(local_error,err,error,*999)
5650  END SELECT
5651  IF(basis_index<=num_bases) THEN
5652  IF(num_bases==1) THEN
5653  !If is the only basis, don't do anything
5654  user_number_to_component_node=node_user_number
5655  ELSE
5656  temp_term=1
5657  num_corner_nodes=1
5658  DO ni=1,num_dims
5659  num_corner_nodes=num_corner_nodes*(number_of_elements_xi(ni)+1)
5660  corner_node_factor(ni)=1
5661  IF(ni>1) THEN
5662  temp_term=temp_term*(number_of_elements_xi(ni-1)+1)
5663  corner_node_factor(ni)=corner_node_factor(ni)*temp_term
5664  ENDIF
5665  ENDDO
5666  !Adjust for other mesh types
5667  IF(generated_mesh%GENERATED_TYPE==generated_mesh_cylinder_mesh_type) THEN
5668  corner_node_factor(3)=corner_node_factor(3)-number_of_elements_xi(1)-1
5669  num_corner_nodes=num_corner_nodes-(number_of_elements_xi(1)+1)*(number_of_elements_xi(3)+1)
5670  ENDIF
5671  node_offset=num_corner_nodes
5672  DO basis_idx=1,basis_index-1
5673  basis=>bases(basis_idx)%PTR
5674  basis_num_nodes=1
5675  DO ni=1,num_dims
5676  basis_num_nodes=basis_num_nodes*(number_of_elements_xi(ni)*(basis%NUMBER_OF_NODES_XIC(ni)-1)+1)
5677  ENDDO
5678  !Adjust for other mesh types
5679  IF(generated_mesh%GENERATED_TYPE==generated_mesh_cylinder_mesh_type) THEN
5680  basis_num_nodes=basis_num_nodes-(number_of_elements_xi(1)+1)*(basis%NUMBER_OF_nodes_xic(1)-1)* &
5681  & (number_of_elements_xi(3)+1)*(basis%NUMBER_OF_nodes_xic(3)-1)
5682  ENDIF
5683  node_offset=node_offset+basis_num_nodes-num_corner_nodes
5684  ENDDO
5685  basis=>bases(basis_index)%PTR
5686  temp_term=1
5687  DO ni=1,num_dims
5688  basis_element_factor(ni)=basis%NUMBER_OF_NODES_XIC(ni)-1
5689  IF(ni>1) THEN
5690  temp_term=temp_term*((basis%NUMBER_OF_NODES_XIC(ni-1)-1)*number_of_elements_xi(ni-1)+1)
5691  basis_element_factor(ni)=basis_element_factor(ni)*temp_term
5692  ENDIF
5693  ENDDO
5694  !Adjust for other mesh types
5695  IF(generated_mesh%GENERATED_TYPE==generated_mesh_cylinder_mesh_type) THEN
5696  !subtract nodes along line where y wraps around
5697  basis_element_factor(3)=basis_element_factor(3)-(number_of_elements_xi(1)* &
5698  & (basis%NUMBER_OF_NODES_XIC(1)-1)+1)*(basis%NUMBER_OF_NODES_XIC(3)-1)
5699  ENDIF
5700  IF(node_user_number<=num_corner_nodes) THEN
5701  !we have a node on a corner
5702  IF(num_dims>2) THEN
5703  pos(3)=remainder/corner_node_factor(3)
5704  remainder=mod(remainder,corner_node_factor(3))
5705  ENDIF
5706  IF(num_dims>1) THEN
5707  pos(2)=remainder/corner_node_factor(2)
5708  remainder=mod(remainder,corner_node_factor(2))
5709  ENDIF
5710  pos(1)=remainder/corner_node_factor(1)
5711  user_number_to_component_node=pos(1)*basis_element_factor(1)+pos(2)*basis_element_factor(2)+ &
5712  & pos(3)*basis_element_factor(3)
5713  user_number_to_component_node=user_number_to_component_node+1
5714  ELSE IF(node_user_number>node_offset) THEN
5715  remainder=remainder-node_offset
5716  DO ni=1,num_dims
5717  basis_element_factor(ni)=basis_element_factor(ni)-corner_node_factor(ni)
5718  ENDDO
5719  num_previous_corners=0
5720  finished_count=.false.
5721  off_edge=.false.
5722  IF(num_dims>2) THEN
5723  IF(generated_mesh%GENERATED_TYPE==generated_mesh_cylinder_mesh_type.AND. &
5724  & (mod(remainder,basis_element_factor(3)) > basis_element_factor(2)*number_of_elements_xi(2)-1)) THEN
5725  off_edge=.true.
5726  ELSE IF(generated_mesh%GENERATED_TYPE==generated_mesh_regular_mesh_type.AND. &
5727  & mod(remainder,basis_element_factor(3)) > (basis_element_factor(2)*number_of_elements_xi(2)+ &
5728  & basis_element_factor(1)*number_of_elements_xi(1)-1)) THEN
5729  off_edge=.true.
5730  ENDIF
5731  IF(off_edge) THEN
5732  num_previous_corners=num_previous_corners+corner_node_factor(3)*(1+remainder/basis_element_factor(3))
5733  remainder=mod(remainder,basis_element_factor(3))
5734  finished_count=.true.
5735  ELSE
5736  num_previous_corners=num_previous_corners+corner_node_factor(3)*(remainder/basis_element_factor(3))
5737  remainder=mod(remainder,basis_element_factor(3))
5738  ENDIF
5739  ENDIF
5740  IF((num_dims>1) .AND. (finished_count.NEQV..true.)) THEN
5741  IF(mod(remainder,basis_element_factor(2)) > &
5742  & basis_element_factor(1)*number_of_elements_xi(1)-1) THEN
5743  num_previous_corners=num_previous_corners+corner_node_factor(2)*(1+remainder/basis_element_factor(2))
5744  remainder=mod(remainder,basis_element_factor(2))
5745  finished_count=.true.
5746  ELSE
5747  num_previous_corners=num_previous_corners+corner_node_factor(2)*(remainder/basis_element_factor(2))
5748  remainder=mod(remainder,basis_element_factor(2))
5749  ENDIF
5750  ENDIF
5751  IF(finished_count.NEQV..true.) THEN
5752  num_previous_corners=num_previous_corners+corner_node_factor(1)*(remainder/basis_element_factor(1))+1
5753  ENDIF
5754  node_offset=node_offset-num_previous_corners
5755  user_number_to_component_node=node_user_number-node_offset
5756  ELSE
5757  CALL flagerror("Invalid node number specified.",err,error,*999)
5758  ENDIF
5759  ENDIF
5760  ELSE
5761  local_error="Mesh component must be less than or equal to "//(number_to_vstring(num_bases,"*",err,error))// &
5762  & " but it is "//(number_to_vstring(basis_index,"*",err,error))//"."
5763  CALL flagerror(local_error,err,error,*999)
5764  ENDIF
5765  ELSE
5766  CALL flagerror("Generated mesh is not associated",err,error,*999)
5767  ENDIF
5768 
5769  exits("USER_NUMBER_TO_COMPONENT_NODE")
5770  RETURN
5771 999 errorsexits("USER_NUMBER_TO_COMPONENT_NODE",err,error)
5772  RETURN
5773  END FUNCTION user_number_to_component_node
5774 
5775  !
5776  !================================================================================================================================
5777  !
5778 
5779 END MODULE generated_mesh_routines
5780 
basis_routines
This module contains all basis function routines.
Definition: basis_routines.f90:45
base_routines::enters
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Definition: base_routines.f90:363
types::generated_mesh_cylinder_type
Contains information of a generated cylinder mesh Allows only a 3D cylinder mesh with xi directions (...
Definition: types.f90:556
kinds::ptr
integer, parameter ptr
Pointer integer kind.
Definition: kinds.f90:58
types::field_variable_component_type
Contains information for a component of a field variable.
Definition: types.f90:1254
coordinate_routines
This module contains all coordinate transformation and support routines.
Definition: coordinate_routines.f90:45
coordinate_routines::coordinate_prolate_spheroidal_type
integer(intg), parameter, public coordinate_prolate_spheroidal_type
Prolate spheroidal coordinate system type.
Definition: coordinate_routines.f90:73
types::region_type
Contains information for a region.
Definition: types.f90:3252
strings::number_to_vstring
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
types::decomposition_type
Contains information on the mesh decomposition.
Definition: types.f90:1063
constants::pi
real(dp), parameter pi
The double precision value of pi.
Definition: constants.f90:57
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
basis_routines::basis_simplex_type
integer(intg), parameter, public basis_simplex_type
Simplex basis type.
Definition: basis_routines.f90:69
types::generated_mesh_ptr_type
A buffer type to allow for an array of pointers to a GENERATED_MESH_TYPE.
Definition: types.f90:594
maths
This module contains all mathematics support routines.
Definition: maths.f90:45
types::field_type
Contains information for a field defined on a region.
Definition: types.f90:1346
constants::global_deriv_s2
integer(intg), parameter global_deriv_s2
First global derivative in the s2 direction i.e., du/ds2.
Definition: constants.f90:215
iso_varying_string
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
Definition: iso_varying_string.f90:62
types::coordinate_system_type
Contains information on a coordinate system.
Definition: types.f90:255
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
constants
This module contains all program wide constants.
Definition: constants.f90:45
coordinate_routines::coordinate_system_dimension_get
subroutine, public coordinate_system_dimension_get(COORDINATE_SYSTEM, NUMBER_OF_DIMENSIONS, ERR, ERROR,)
Gets the coordinate system dimension.
Definition: coordinate_routines.f90:1187
kinds::dp
integer, parameter dp
Double precision real kind.
Definition: kinds.f90:68
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
input_output::write_string
Write a string to a given output stream.
Definition: input_output.f90:74
base_routines
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
Definition: base_routines.f90:45
coordinate_routines::coordinate_cylindrical_polar_type
integer(intg), parameter, public coordinate_cylindrical_polar_type
Cylindrical polar coordinate system type.
Definition: coordinate_routines.f90:71
base_routines::general_output_type
integer(intg), parameter, public general_output_type
General output type.
Definition: base_routines.f90:66
iso_varying_string::trim
Definition: iso_varying_string.f90:204
basis_routines::basis_not_collapsed
integer(intg), parameter, public basis_not_collapsed
The Xi direction is not collapsed.
Definition: basis_routines.f90:149
basis_routines::basis_cubic_interpolation_order
integer(intg), parameter, public basis_cubic_interpolation_order
Cubic interpolation order.
Definition: basis_routines.f90:115
basis_routines::basis_quadratic_interpolation_order
integer(intg), parameter, public basis_quadratic_interpolation_order
Quadratic interpolation order.
Definition: basis_routines.f90:114
comp_environment
This module contains all computational environment variables.
Definition: computational_environment.f90:46
types::basis_ptr_type
A buffer type to allow for an array of pointers to a BASIS_TYPE.
Definition: types.f90:179
coordinate_routines::coordinate_rectangular_cartesian_type
integer(intg), parameter, public coordinate_rectangular_cartesian_type
Rectangular Cartesian coordinate system type.
Definition: coordinate_routines.f90:70
types::mesh_type
Contains information on a mesh defined on a region.
Definition: types.f90:503
types::generated_meshes_type
Contains information on the generated meshes defined on a region.
Definition: types.f90:599
constants::global_deriv_s1_s2
integer(intg), parameter global_deriv_s1_s2
Global Cross derivative in the s1 and s2 direction i.e., d^2u/ds1ds2.
Definition: constants.f90:216
types::generated_mesh_type
Contains information on a generated mesh.
Definition: types.f90:579
types::domain_nodes_type
Contains the topology information for the nodes of a domain.
Definition: types.f90:713
basis_routines::basis_lagrange_hermite_tp_type
integer(intg), parameter, public basis_lagrange_hermite_tp_type
Lagrange-Hermite tensor product basis type.
Definition: basis_routines.f90:68
constants::global_deriv_s1
integer(intg), parameter global_deriv_s1
First global derivative in the s1 direction i.e., du/ds1.
Definition: constants.f90:214
constants::twopi
real(dp), parameter twopi
The double value of 2pi.
Definition: constants.f90:58
types::nodes_type
Contains information on the nodes defined on a region.
Definition: types.f90:359
types::field_variable_type
Contains information for a field variable defined on a field.
Definition: types.f90:1289
constants::global_deriv_s3
integer(intg), parameter global_deriv_s3
First global derivative in the s3 direction i.e., du/ds3.
Definition: constants.f90:217
constants::maximum_global_deriv_number
integer(intg), parameter maximum_global_deriv_number
The maximum global derivative number.
Definition: constants.f90:212
types::domain_type
A pointer to the domain decomposition for this domain.
Definition: types.f90:938
coordinate_routines::coordinate_oblate_spheroidal_type
integer(intg), parameter, public coordinate_oblate_spheroidal_type
Oblate spheroidal coordinate system type.
Definition: coordinate_routines.f90:74
types::generated_mesh_ellipsoid_type
Contains information of a generated ellipsoid mesh Allows only a 3D ellipsoid mesh.
Definition: types.f90:568
base_routines::errors
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
Definition: base_routines.f90:481
types::interface_type
Contains information for the interface data.
Definition: types.f90:2228
types::basis_type
Contains all information about a basis .
Definition: types.f90:184
maths::l2norm
Returns the L2 norm of a vector.
Definition: maths.f90:161
types::generated_mesh_regular_type
Contains information on a generated regular mesh.
Definition: types.f90:543
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
comp_environment::computational_node_number_get
integer(intg) function, public computational_node_number_get(ERR, ERROR)
Returns the number/rank of the computational nodes.
Definition: computational_environment.f90:640
constants::zero_tolerance
real(dp), parameter zero_tolerance
Definition: constants.f90:70
types::meshelementstype
Contains the information for the elements of a mesh.
Definition: types.f90:403
basis_routines::basis_linear_interpolation_order
integer(intg), parameter, public basis_linear_interpolation_order
Linear interpolation order.
Definition: basis_routines.f90:113
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
coordinate_routines::coordinate_spherical_polar_type
integer(intg), parameter, public coordinate_spherical_polar_type
Spherical polar coordinate system type.
Definition: coordinate_routines.f90:72
input_output
This module handles all formating and input and output.
Definition: input_output.f90:45