OpenCMISS-Iron Internal API Documentation
fieldml_output_routines.f90
Go to the documentation of this file.
1 
43 
45 
46 MODULE fieldml_output_routines
47 
48  USE base_routines
49  USE basis_routines
50  USE coordinate_routines
51  USE constants
52  USE comp_environment
53  USE field_routines
54  USE fieldml_api
55  USE fieldml_types
56  USE fieldml_util_routines
57  USE iso_varying_string
58  USE kinds
59  USE lists
60  USE mesh_routines
61  USE node_routines
62  USE region_routines
63  USE strings
64  USE types
65 
66 #include "macros.h"
67 
68  IMPLICIT NONE
69 
70  PRIVATE
71 
72  !Interfaces
73  TYPE connectivity_info_type
74  INTEGER(INTG) :: connectivity_handle
75  INTEGER(INTG) :: layout_handle
76  END TYPE connectivity_info_type
77 
78  TYPE basis_info_type
79  TYPE(basis_type), POINTER :: basis
80  INTEGER(INTG) :: connectivity_handle
81  INTEGER(INTG) :: reference_handle
82  INTEGER(INTG) :: layout_handle
83  END TYPE basis_info_type
84 
85  INTERFACE fieldml_output_add_field
86  MODULE PROCEDURE fieldml_output_add_field_no_type
87  MODULE PROCEDURE fieldml_output_add_field_with_type
88  END INTERFACE
89 
90  PUBLIC :: fieldml_output_write, fieldml_output_add_field, fieldml_output_initialise_info, &
91  & fieldml_output_add_import, fieldml_output_add_field_components
92 
93 CONTAINS
94 
95  !
96  !================================================================================================================================
97  !
98 
100  SUBROUTINE fieldml_assert_is_out( FIELDML_INFO, ERR, ERROR, * )
101  !Argument variables
102  TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
103  INTEGER(INTG), INTENT(OUT) :: ERR
104  TYPE(varying_string), INTENT(OUT) :: ERROR
105 
106  enters( "FIELDML_ASSERT_IS_OUT", err, error, *999 )
107 
108  IF(.NOT.ASSOCIATED(fieldml_info)) THEN
109  CALL flagerror( "FieldML Info is not associated.", err, error, *999 )
110  ELSE IF( .NOT. fieldml_info%IS_OUT ) THEN
111  CALL flagerror( "Inbound FieldML Info used for an output-only operation.", err, error, *999 )
112  ENDIF
113 
114  exits( "FIELDML_ASSERT_IS_OUT" )
115  RETURN
116 999 errorsexits( "FIELDML_ASSERT_IS_OUT", err, error )
117  RETURN 1
118 
119  END SUBROUTINE fieldml_assert_is_out
120 
121  !
122  !================================================================================================================================
123  !
124 
126  SUBROUTINE fieldml_output_get_collapse_suffix( COLLAPSE_INFO, SUFFIX, ERR, ERROR, * )
127  !Argument variables
128  INTEGER(INTG), INTENT(IN) :: COLLAPSE_INFO(:)
129  TYPE(varying_string), INTENT(INOUT) :: SUFFIX
130  INTEGER(INTG), INTENT(OUT) :: ERR
131  TYPE(varying_string), INTENT(OUT) :: ERROR
132 
133  !Locals
134  INTEGER(INTG) :: I
135 
136  enters( "FIELDML_OUTPUT_GET_COLLAPSE_SUFFIX", err, error, *999 )
137 
138  suffix = ""
139  DO i = 1, SIZE( collapse_info )
140  IF( collapse_info( i ) == basis_xi_collapsed ) THEN
141  suffix = suffix // "_xi"//trim(number_to_vstring(i,"*",err,error))//"C"
142  ELSEIF( collapse_info( i ) == basis_collapsed_at_xi0 ) THEN
143  suffix = suffix // "_xi"//trim(number_to_vstring(i,"*",err,error))//"0"
144  ELSEIF( collapse_info( i ) == basis_collapsed_at_xi1 ) THEN
145  suffix = suffix // "_xi"//trim(number_to_vstring(i,"*",err,error))//"1"
146  ENDIF
147  ENDDO
148 
149  exits( "FIELDML_OUTPUT_GET_COLLAPSE_SUFFIX" )
150  RETURN
151 999 errorsexits( "FIELDML_OUTPUT_GET_COLLAPSE_SUFFIX", err, error )
152  RETURN 1
153 
154  END SUBROUTINE fieldml_output_get_collapse_suffix
155 
156  !
157  !================================================================================================================================
158  !
159 
161  FUNCTION fieldml_output_import_fml( FML_HANDLE, REMOTE_NAME, ERR, ERROR )
162  !Argument variables
163  INTEGER(INTG), INTENT(IN) :: FML_HANDLE
164  TYPE(varying_string), INTENT(IN) :: REMOTE_NAME
165  INTEGER(INTG), INTENT(OUT) :: ERR
166  TYPE(varying_string), INTENT(OUT) :: ERROR
167 
168  INTEGER(INTG) :: FIELDML_OUTPUT_IMPORT_FML
169 
170  !Local variables
171  INTEGER(INTG) :: IMPORT_INDEX
172 
173  enters( "FIELDML_OUTPUT_IMPORT_FML", err, error, *999 )
174 
175  fieldml_output_import_fml = fieldml_getobjectbyname( fml_handle, cchar(remote_name) )
176  IF( fieldml_output_import_fml == fml_invalid_handle ) THEN
177  import_index = fieldml_addimportsource( fml_handle, &
178  & "http://www.fieldml.org/resources/xml/0.5/FieldML_Library_0.5.xml"//c_null_char, "library"//c_null_char )
179  fieldml_output_import_fml = fieldml_addimport( fml_handle, import_index, cchar(remote_name), cchar(remote_name) )
180  IF( fieldml_output_import_fml == fml_invalid_handle ) err = 1
181  ENDIF
182 
183  exits( "FIELDML_OUTPUT_IMPORT_FML" )
184  RETURN
185 999 errorsexits( "FIELDML_OUTPUT_IMPORT_FML", err, error )
186 
187  END FUNCTION fieldml_output_import_fml
188 
189  !
190  !================================================================================================================================
191  !
192 
194  FUNCTION fieldml_output_import( FIELDML_INFO, REMOTE_NAME, ERR, ERROR )
195  !Argument variables
196  TYPE(fieldml_io_type), INTENT(IN) :: FIELDML_INFO
197  TYPE(varying_string), INTENT(IN) :: REMOTE_NAME
198  INTEGER(INTG), INTENT(OUT) :: ERR
199  TYPE(varying_string), INTENT(OUT) :: ERROR
200 
201  INTEGER(INTG) :: FIELDML_OUTPUT_IMPORT
202 
203  enters( "FIELDML_OUTPUT_IMPORT", err, error, *999 )
204 
205  fieldml_output_import = fieldml_output_import_fml( fieldml_info%FML_HANDLE, remote_name, err, error )
206 
207  exits( "FIELDML_OUTPUT_IMPORT" )
208  RETURN
209 999 errorsexits( "FIELDML_OUTPUT_IMPORT", err, error )
210 
211  END FUNCTION fieldml_output_import
212 
213  !
214  !================================================================================================================================
215  !
216 
218  ! External variant of FIELDML_OUTPUT_IMPORT taking pointer argument and checking it
219  FUNCTION fieldml_output_add_import( FIELDML_INFO, REMOTE_NAME, ERR, ERROR )
220  !Argument variables
221  TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
222  TYPE(varying_string), INTENT(IN) :: REMOTE_NAME
223  INTEGER(INTG), INTENT(OUT) :: ERR
224  TYPE(varying_string), INTENT(OUT) :: ERROR
225 
226  INTEGER(INTG) :: FIELDML_OUTPUT_ADD_IMPORT
227 
228  enters( "FIELDML_OUTPUT_ADD_IMPORT", err, error, *999 )
229 
230  CALL fieldml_assert_is_out( fieldml_info, err, error, *999 )
231 
232  fieldml_output_add_import = fieldml_output_import_fml( fieldml_info%FML_HANDLE, remote_name, err, error )
233 
234  exits( "FIELDML_OUTPUT_ADD_IMPORT" )
235  RETURN
236 999 errorsexits( "FIELDML_OUTPUT_ADD_IMPORT", err, error )
237 
238  END FUNCTION fieldml_output_add_import
239 
240  !
241  !================================================================================================================================
242  !
243 
245  FUNCTION fieldml_output_import_handle( FML_HANDLE, HANDLE, ERR, ERROR )
246  !Argument variables
247  INTEGER(INTG), INTENT(IN) :: FML_HANDLE
248  INTEGER(INTG), INTENT(IN) :: HANDLE
249  INTEGER(INTG), INTENT(OUT) :: ERR
250  TYPE(varying_string), INTENT(OUT) :: ERROR
251 
252  INTEGER(INTG) :: FIELDML_OUTPUT_IMPORT_HANDLE
253 
254  !Local variables
255  INTEGER(INTG) :: IMPORT_INDEX, LOCAL_HANDLE
256  CHARACTER(KIND=C_CHAR,LEN=MAXSTRLEN) :: NAME
257  INTEGER(INTG) :: LENGTH
258 
259  enters( "FIELDML_OUTPUT_IMPORT_HANDLE", err, error, *999 )
260 
261  fieldml_output_import_handle = fml_invalid_handle
262  length = fieldml_copyobjectdeclaredname( fml_handle, handle, name, maxstrlen )
263 
264  IF( fieldml_isobjectlocal( fml_handle, handle , 1 ) /= 1 ) THEN
265  IF( length > 0 ) THEN
266  local_handle = fieldml_getobjectbyname( fml_handle, name(1:length)//c_null_char )
267  IF( local_handle == fml_invalid_handle ) THEN
268  import_index = fieldml_addimportsource( fml_handle, &
269  & "http://www.fieldml.org/resources/xml/0.5/FieldML_Library_0.5.xml"//c_null_char, "library"//c_null_char )
270  fieldml_output_import_handle = fieldml_addimport( fml_handle, &
271  & import_index, name(1:length)//c_null_char, name(1:length)//c_null_char )
272  ELSE IF( local_handle == handle ) THEN
273  fieldml_output_import_handle = handle
274  ENDIF
275  ENDIF
276  ENDIF
277 
278  exits( "FIELDML_OUTPUT_IMPORT_HANDLE" )
279  RETURN
280 999 errorsexits( "FIELDML_OUTPUT_IMPORT_HANDLE", err, error )
281 
282  END FUNCTION fieldml_output_import_handle
283 
284  !
285  !================================================================================================================================
286  !
287 
289  FUNCTION fieldml_output_get_type_argument_handle( FIELDML_INFO, TYPE_HANDLE, DO_IMPORT, ERR, ERROR )
290  !Argument variables
291  TYPE(fieldml_io_type), INTENT(IN) :: FIELDML_INFO
292  LOGICAL, INTENT(IN) :: DO_IMPORT
293  INTEGER(INTG), INTENT(IN) :: TYPE_HANDLE
294  INTEGER(INTG), INTENT(OUT) :: ERR
295  TYPE(varying_string), INTENT(OUT) :: ERROR
296 
297  INTEGER(INTG) :: FIELDML_OUTPUT_GET_TYPE_ARGUMENT_HANDLE
298 
299  !Local variables
300  CHARACTER(KIND=C_CHAR,LEN=MAXSTRLEN) :: NAME
301  INTEGER(INTG) :: LENGTH
302  INTEGER(INTG) :: HANDLE, FML_ERR
303  TYPE(varying_string) :: FULL_NAME
304 
305  enters( "FIELDML_OUTPUT_GET_TYPE_ARGUMENT_HANDLE", err, error, *999 )
306 
307  length = fieldml_copyobjectname( fieldml_info%FML_HANDLE, type_handle, name, maxstrlen )
308  IF( length < 1 ) THEN
309  length = fieldml_copyobjectdeclaredname( fieldml_info%FML_HANDLE, type_handle, name, maxstrlen )
310  fieldml_output_get_type_argument_handle = fml_invalid_handle
311  exits( "FIELDML_OUTPUT_GET_TYPE_ARGUMENT_HANDLE" )
312  RETURN
313  ENDIF
314 
315  IF( do_import ) THEN
316  full_name = name(1:length)//".argument"
317  fml_err = fieldml_output_import( fieldml_info, full_name, err, error )
318  IF(err/=0) GOTO 999
319  ENDIF
320 
321  handle = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, name(1:length)//".argument"//c_null_char )
322  IF( handle == fml_invalid_handle ) THEN
323  fieldml_output_get_type_argument_handle = fml_invalid_handle
324  exits( "FIELDML_OUTPUT_GET_TYPE_ARGUMENT_HANDLE" )
325  RETURN
326  ENDIF
327 
328  fieldml_output_get_type_argument_handle = handle
329 
330  enters( "FIELDML_OUTPUT_GET_TYPE_ARGUMENT_HANDLE", err, error, *999 )
331  exits( "FIELDML_OUTPUT_GET_TYPE_ARGUMENT_HANDLE" )
332  RETURN
333 999 errorsexits( "FIELDML_OUTPUT_GET_TYPE_ARGUMENT_HANDLE", err, error )
334 
335  END FUNCTION fieldml_output_get_type_argument_handle
336 
337  !
338  !================================================================================================================================
339  !
340 
342  SUBROUTINE fieldml_output_get_coordinates_type( FIELDML_HANDLE, COORDS_TYPE, DIMENSIONS, DO_IMPORT, TYPE_HANDLE, &
343  & err, error, * )
344  !Argument variables
345  INTEGER(INTG), INTENT(IN) :: FIELDML_HANDLE
346  INTEGER(INTG), INTENT(IN) :: COORDS_TYPE
347  INTEGER(INTG), INTENT(IN) :: DIMENSIONS
348  LOGICAL, INTENT(IN) :: DO_IMPORT
349  INTEGER(INTG), INTENT(OUT) :: TYPE_HANDLE
350  INTEGER(INTG), INTENT(OUT) :: ERR
351  TYPE(varying_string), INTENT(OUT) :: ERROR
352 
353  !Locals
354  TYPE(varying_string) :: TYPE_NAME
355  INTEGER(INTG) :: TEMP
356 
357  enters( "FIELDML_OUTPUT_GET_COORDINATES_TYPE", err, error, *999 )
358 
359  IF( coords_type == coordinate_rectangular_cartesian_type ) THEN
360  IF( dimensions == 1 ) THEN
361  type_name = "coordinates.rc.1d"
362  ELSE IF( dimensions == 2 ) THEN
363  type_name = "coordinates.rc.2d"
364  ELSE IF( dimensions == 3 ) THEN
365  type_name = "coordinates.rc.3d"
366  ELSE
367  type_handle = fml_invalid_handle
368  CALL flagerror( var_str("Cannot get FieldML RC coordinates type of dimension ")//dimensions//".", err, error, *999)
369  ENDIF
370  ELSE
371  type_handle = fml_invalid_handle
372  CALL flagerror( var_str("Cannot get FieldML coordinates for OpenCMISS type ")//coords_type//".", err, error, *999 )
373  ENDIF
374 
375  IF( do_import ) THEN
376  temp = fieldml_output_import_fml( fieldml_handle, type_name, err, error )
377  IF(err/=0) GOTO 999
378  ENDIF
379  type_handle = fieldml_getobjectbyname( fieldml_handle, cchar(type_name) )
380  CALL fieldml_util_check_fieldml_error( "Cannot get FieldML coordinates type "//char(type_name)//".", fieldml_handle, &
381  & err, error, *999 )
382 
383  exits( "FIELDML_OUTPUT_GET_COORDINATES_TYPE" )
384  RETURN
385 999 errorsexits( "FIELDML_OUTPUT_GET_COORDINATES_TYPE", err, error )
386  RETURN 1
387 
388  END SUBROUTINE fieldml_output_get_coordinates_type
389 
390  !
391  !================================================================================================================================
392  !
393 
395  SUBROUTINE fieldml_output_get_generic_type( FIELDML_HANDLE, DIMENSIONS, TYPE_HANDLE, DO_IMPORT, ERR, ERROR, * )
396  !Argument variables
397  INTEGER(INTG), INTENT(IN) :: FIELDML_HANDLE
398  INTEGER(INTG), INTENT(IN) :: DIMENSIONS
399  INTEGER(INTG), INTENT(OUT) :: TYPE_HANDLE
400  LOGICAL, INTENT(IN) :: DO_IMPORT
401  INTEGER(INTG), INTENT(OUT) :: ERR
402  TYPE(varying_string), INTENT(OUT) :: ERROR
403 
404  !Locals
405  TYPE(varying_string) :: TYPE_NAME
406  INTEGER(INTG) :: TEMP
407 
408  enters( "FIELDML_OUTPUT_GET_GENERIC_TYPE", err, error, *999 )
409 
410  IF( dimensions == 1 ) THEN
411  type_name = "real.1d"
412  ELSE IF( dimensions == 2 ) THEN
413  type_name = "real.2d"
414  ELSE IF( dimensions == 3 ) THEN
415  type_name = "real.3d"
416  ELSE
417  type_handle = fml_invalid_handle
418  CALL flagerror( var_str("Cannot get FieldML generic type of dimensionality ")//dimensions//".", err, error, *999 )
419  ENDIF
420 
421  IF( do_import ) THEN
422  temp = fieldml_output_import_fml( fieldml_handle, type_name, err, error )
423  IF(err/=0) GOTO 999
424  ENDIF
425  type_handle = fieldml_getobjectbyname( fieldml_handle, cchar(type_name) )
426  CALL fieldml_util_check_fieldml_error( "Cannot get generic type "//type_name//".", fieldml_handle, err, error, *999 )
427 
428  exits( "FIELDML_OUTPUT_GET_GENERIC_TYPE" )
429  RETURN
430 999 errorsexits( "FIELDML_OUTPUT_GET_GENERIC_TYPE", err, error )
431  RETURN 1
432 
433  END SUBROUTINE fieldml_output_get_generic_type
434 
435  !
436  !================================================================================================================================
437  !
438 
440  SUBROUTINE fieldml_output_get_xi_type( FIELDML_HANDLE, DIMENSIONS, DO_IMPORT, TYPE_HANDLE, ERR, ERROR, * )
441  !Argument variables
442  INTEGER(INTG), INTENT(IN) :: FIELDML_HANDLE
443  INTEGER(INTG), INTENT(IN) :: DIMENSIONS
444  LOGICAL, INTENT(IN) :: DO_IMPORT
445  INTEGER(INTG), INTENT(OUT) :: TYPE_HANDLE
446  INTEGER(INTG), INTENT(OUT) :: ERR
447  TYPE(varying_string), INTENT(OUT) :: ERROR
448 
449  !Locals
450  INTEGER(INTG) :: TEMP
451  TYPE(varying_string) :: TYPE_NAME
452 
453  enters( "FIELDML_OUTPUT_GET_XI_TYPE", err, error, *999 )
454 
455  IF( dimensions == 1 ) THEN
456  type_name = "chart.1d"
457  ELSE IF( dimensions == 2 ) THEN
458  type_name = "chart.2d"
459  ELSE IF( dimensions == 3 ) THEN
460  type_name = "chart.3d"
461  ELSE
462  type_handle = fml_invalid_handle
463  CALL flagerror( var_str("Chart dimensionality ")//dimensions//" not supported.", err, error, *999 )
464  ENDIF
465 
466  IF( do_import ) THEN
467  temp = fieldml_output_import_fml( fieldml_handle, type_name, err, error )
468  IF(err/=0) GOTO 999
469  ENDIF
470  type_handle = fieldml_getobjectbyname( fieldml_handle, cchar(type_name) )
471  CALL fieldml_util_check_fieldml_error( "Cannot get xi type "//type_name//".", fieldml_handle, err, error, *999 )
472 
473  exits( "FIELDML_OUTPUT_GET_XI_TYPE" )
474  RETURN
475 999 errorsexits( "FIELDML_OUTPUT_GET_XI_TYPE", err, error )
476  RETURN 1
477 
478  END SUBROUTINE fieldml_output_get_xi_type
479 
480  !
481  !================================================================================================================================
482  !
483 
485  SUBROUTINE fieldml_output_get_value_type( FML_HANDLE, FIELD, VARIABLE_TYPE, DO_IMPORT, TYPE_HANDLE, ERR, ERROR, * )
486  !Argument variables
487  INTEGER(INTG), INTENT(IN) :: FML_HANDLE
488  TYPE(field_type), POINTER, INTENT(IN) :: FIELD
489  INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
490  LOGICAL, INTENT(IN) :: DO_IMPORT
491  INTEGER(INTG), INTENT(OUT) :: TYPE_HANDLE
492  INTEGER(INTG), INTENT(OUT) :: ERR
493  TYPE(varying_string), INTENT(OUT) :: ERROR
494 
495  !Locals
496  INTEGER(INTG) :: FIELDTYPE, SUB_TYPE, COUNT
497  TYPE(coordinate_system_type), POINTER :: COORDINATE_SYSTEM
498  TYPE(region_type), POINTER :: REGION
499 
500  enters( "FIELDML_OUTPUT_GET_VALUE_TYPE", err, error, *999 )
501 
502  region => field%REGION
503 
504  CALL field_type_get( field, fieldtype, err, error, *999 )
505  CALL field_number_of_components_get( field, variable_type, count, err, error, *999 )
506 
507  SELECT CASE( fieldtype )
508  CASE( field_geometric_type )
509  NULLIFY( coordinate_system )
510  CALL region_coordinate_system_get( region, coordinate_system, err, error, *999 )
511  CALL coordinate_system_type_get( coordinate_system, sub_type, err, error, *999 )
512  CALL fieldml_output_get_coordinates_type( fml_handle, sub_type, count, do_import, type_handle, err, error, *999 )
513 
514  !CASE( CMISSFieldFibreType )
515 
516  !CASE( CMISSFieldGeneralType )
517 
518  !CASE( CMISSFieldMaterialType )
519 
520  CASE DEFAULT
521  CALL fieldml_output_get_generic_type( fml_handle, count, type_handle, do_import, err, error, *999 )
522  END SELECT
523 
524  exits( "FIELDML_OUTPUT_GET_VALUE_TYPE" )
525  RETURN
526 999 errorsexits( "FIELDML_OUTPUT_GET_VALUE_TYPE", err, error )
527  RETURN 1
528 
529  END SUBROUTINE fieldml_output_get_value_type
530 
531  !
532  !================================================================================================================================
533  !
534 
536  SUBROUTINE fieldml_output_get_tp_basis_evaluator( FML_HANDLE, XI_INTERPOLATIONS, COLLAPSE_INFO, EVALUATOR_HANDLE, &
537  & parameters_handle, err, error, * )
538  !Argument variables
539  INTEGER(INTG), INTENT(IN) :: FML_HANDLE
540  INTEGER(INTG), INTENT(IN) :: XI_INTERPOLATIONS(:)
541  INTEGER(INTG), INTENT(IN) :: COLLAPSE_INFO(:)
542  INTEGER(INTG), INTENT(OUT) :: EVALUATOR_HANDLE
543  INTEGER(INTG), INTENT(OUT) :: PARAMETERS_HANDLE
544  INTEGER(INTG), INTENT(OUT) :: ERR
545  TYPE(varying_string), INTENT(OUT) :: ERROR
546 
547  !Locals
548  INTEGER(INTG) :: XI_COUNT, FIRST_INTERPOLATION, I
549  TYPE(varying_string) :: SUFFIX, INTERPOLATOR_NAME, PARAMETER_NAME
550 
551  enters( "FIELDML_OUTPUT_GET_TP_BASIS_EVALUATOR", err, error, *999 )
552 
553  xi_count = SIZE( xi_interpolations )
554 
555  DO i = 1, xi_count
556  IF( i == 1 ) THEN
557  first_interpolation = xi_interpolations(i)
558  ELSE IF( xi_interpolations(i) /= first_interpolation ) THEN
559  !Do not yet support inhomogeneous TP bases
560  CALL flagerror( "Translation of inhomogeneous tensor-product basis not yet supported.", err, error, *999 )
561  ENDIF
562  ENDDO
563 
564  CALL fieldml_output_get_collapse_suffix( collapse_info, suffix, err, error, *999 )
565 
566  evaluator_handle = fml_invalid_handle
567  parameters_handle = fml_invalid_handle
568 
569  IF( first_interpolation == basis_quadratic_lagrange_interpolation ) THEN
570  IF( xi_count == 1 ) THEN
571  interpolator_name = "interpolator.1d.unit.quadraticLagrange"
572  parameter_name = "parameters.1d.unit.quadraticLagrange"
573  ELSE IF( xi_count == 2 ) THEN
574  interpolator_name = "interpolator.2d.unit.biquadraticLagrange"//suffix
575  parameter_name = "parameters.2d.unit.biquadraticLagrange"//suffix
576  ELSE IF( xi_count == 3 ) THEN
577  interpolator_name = "interpolator.3d.unit.triquadraticLagrange"//suffix
578  parameter_name = "parameters.3d.unit.triquadraticLagrange"//suffix
579  ELSE
580  !Do not yet support dimensions higher than 3.
581  CALL flagerror( var_str("Quadratic Lagrangian interpolation not supported for ")//xi_count//" dimensions.", &
582  & err, error, *999 )
583  ENDIF
584  ELSE IF( first_interpolation == basis_linear_lagrange_interpolation ) THEN
585  IF( xi_count == 1 ) THEN
586  interpolator_name = "interpolator.1d.unit.linearLagrange"
587  parameter_name = "parameters.1d.unit.linearLagrange"
588  ELSE IF( xi_count == 2 ) THEN
589  interpolator_name = "interpolator.2d.unit.bilinearLagrange"//suffix
590  parameter_name = "parameters.2d.unit.bilinearLagrange"//suffix
591  ELSE IF( xi_count == 3 ) THEN
592  interpolator_name = "interpolator.3d.unit.trilinearLagrange"//suffix
593  parameter_name = "parameters.3d.unit.trilinearLagrange"//suffix
594  ELSE
595  !Do not yet support dimensions higher than 3.
596  CALL flagerror( var_str("Quadratic Lagrangian interpolation not supported for ")//xi_count//" dimensions.", &
597  & err, error, *999 )
598  ENDIF
599  ELSE
600  CALL flagerror( var_str("FieldML translation not yet supported for interpolation type ")//first_interpolation//".", &
601  & err, error, *999 )
602  ENDIF
603 
604  evaluator_handle = fieldml_output_import_fml( fml_handle, interpolator_name, err, error )
605  IF( err /= 0 ) CALL flagerror( "Could not import interpolator "//char(interpolator_name)//".", err, error, *999 )
606 
607  parameters_handle = fieldml_output_import_fml( fml_handle, parameter_name, err, error )
608  IF( err /= 0 ) CALL flagerror( "Could not import parameter type "//char(parameter_name)//".", err, error, *999 )
609 
610  IF( evaluator_handle == fml_invalid_handle ) THEN
611  CALL flagerror( "Cannot get a handle for basis evaluator "//char(interpolator_name)//".", err, error, *999 )
612  ENDIF
613 
614  IF( parameters_handle == fml_invalid_handle ) THEN
615  CALL flagerror( "Cannot get a handle for basis parameters "//char(parameter_name)//".", err, error, *999 )
616  ENDIF
617 
618  exits( "FIELDML_OUTPUT_GET_TP_BASIS_EVALUATOR" )
619  RETURN
620 999 errorsexits( "FIELDML_OUTPUT_GET_TP_BASIS_EVALUATOR", err, error )
621  RETURN 1
622 
623  END SUBROUTINE fieldml_output_get_tp_basis_evaluator
624 
625 
626  !
627  !================================================================================================================================
628  !
629 
631  SUBROUTINE fieldmloutputgetsimplexbasisevaluator( fmlHandle, xiInterpolations, evaluatorHandle, &
632  & parametershandle, err, error, * )
633  !Argument variables
634  INTEGER(INTG), INTENT(IN) :: fmlHandle
635  INTEGER(INTG), INTENT(IN) :: xiInterpolations(:)
636  INTEGER(INTG), INTENT(OUT) :: evaluatorHandle
637  INTEGER(INTG), INTENT(OUT) :: parametersHandle
638  INTEGER(INTG), INTENT(OUT) :: err
639  TYPE(varying_string), INTENT(OUT) :: error
640 
641  !Locals
642  INTEGER(INTG) :: xiCount, firstInterpolation, i
643  TYPE(varying_string) :: interpolatorName, parameterName
644 
645  enters( "FieldmlOutputGetSimplexBasisEvaluator", err, error, *999 )
646 
647  xicount = SIZE( xiinterpolations )
648 
649  DO i = 1, xicount
650  IF( i == 1 ) THEN
651  firstinterpolation = xiinterpolations(i)
652  ELSE IF( xiinterpolations(i) /= firstinterpolation ) THEN
653  !Do not yet support inhomogeneous simplex bases
654  CALL flag_error( "Translation of inhomogeneous tensor-product basis not yet supported.", err, error, *999 )
655  ENDIF
656  ENDDO
657 
658  evaluatorhandle = fml_invalid_handle
659  parametershandle = fml_invalid_handle
660 
661  IF( firstinterpolation == basis_quadratic_simplex_interpolation ) THEN
662  IF( xicount == 1 ) THEN
663  interpolatorname = "interpolator.1d.unit.quadraticSimplex"
664  parametername = "parameters.1d.unit.quadraticLagrange"
665  ELSE IF( xicount == 2 ) THEN
666  interpolatorname = "interpolator.2d.unit.biquadraticSimplex.vtk"
667  parametername = "parameters.2d.unit.biquadraticSimplex.vtk"
668  ELSE IF( xicount == 3 ) THEN
669  interpolatorname = "interpolator.3d.unit.triquadraticSimplex.zienkiewicz"
670  parametername = "parameters.3d.unit.triquadraticSimplex.zienkiewicz"
671  ELSE
672  !Do not yet support dimensions higher than 3.
673  CALL flag_error( var_str("Quadratic simplex interpolation not supported for ")//xicount//" dimensions.", &
674  & err, error, *999 )
675  ENDIF
676  ELSE IF( firstinterpolation == basis_linear_simplex_interpolation ) THEN
677  IF( xicount == 1 ) THEN
678  interpolatorname = "interpolator.1d.unit.linearSimplex"
679  parametername = "parameters.1d.unit.linearLagrange"
680  ELSE IF( xicount == 2 ) THEN
681  interpolatorname = "interpolator.2d.unit.bilinearSimplex"
682  parametername = "parameters.2d.unit.bilinearSimplex"
683  ELSE IF( xicount == 3 ) THEN
684  interpolatorname = "interpolator.3d.unit.trilinearSimplex"
685  parametername = "parameters.3d.unit.trilinearSimplex"
686  ELSE
687  !Do not yet support dimensions higher than 3.
688  CALL flag_error( var_str("Linear simplex interpolation not supported for ")//xicount//" dimensions.", &
689  & err, error, *999 )
690  ENDIF
691  ELSE
692  CALL flag_error( var_str("FieldML translation not yet supported for interpolation type ")//firstinterpolation//".", &
693  & err, error, *999 )
694  ENDIF
695 
696  evaluatorhandle = fieldml_output_import_fml( fmlhandle, interpolatorname, err, error )
697  IF( err /= 0 ) CALL flag_error( "Could not import interpolator "//char(interpolatorname)//".", err, error, *999 )
698 
699  parametershandle = fieldml_output_import_fml( fmlhandle, parametername, err, error )
700  IF( err /= 0 ) CALL flag_error( "Could not import parameter type "//char(parametername)//".", err, error, *999 )
701 
702  IF( evaluatorhandle == fml_invalid_handle ) THEN
703  CALL flag_error( "Cannot get a handle for basis evaluator "//char(interpolatorname)//".", err, error, *999 )
704  ENDIF
705 
706  IF( parametershandle == fml_invalid_handle ) THEN
707  CALL flag_error( "Cannot get a handle for basis parameters "//char(parametername)//".", err, error, *999 )
708  ENDIF
709 
710  exits( "FieldmlOutputGetSimplexBasisEvaluator" )
711  RETURN
712 999 errorsexits( "FieldmlOutputGetSimplexBasisEvaluator", err, error )
713  RETURN 1
714 
715  END SUBROUTINE fieldmloutputgetsimplexbasisevaluator
716 
717  !
718  !================================================================================================================================
719  !
720 
722  SUBROUTINE fieldml_output_get_tp_connectivity_type( FIELDML_HANDLE, XI_INTERPOLATIONS, COLLAPSE_INFO, DO_IMPORT, TYPE_HANDLE, &
723  & err, error, * )
724  !Argument variables
725  INTEGER(INTG), INTENT(IN) :: FIELDML_HANDLE
726  INTEGER(INTG), INTENT(IN) :: XI_INTERPOLATIONS(:)
727  INTEGER(INTG), INTENT(IN) :: COLLAPSE_INFO(:)
728  LOGICAL, INTENT(IN) :: DO_IMPORT
729  INTEGER(INTG), INTENT(OUT) :: TYPE_HANDLE
730  INTEGER(INTG), INTENT(OUT) :: ERR
731  TYPE(varying_string), INTENT(OUT) :: ERROR
732 
733  !Locals
734  INTEGER(INTG) :: XI_COUNT, FIRST_INTERPOLATION, I, IMPORT_INDEX, TEMP
735  TYPE(varying_string) :: SUFFIX, LAYOUT_NAME
736 
737  enters( "FIELDML_OUTPUT_GET_TP_CONNECTIVITY_TYPE", err, error, *999 )
738 
739  xi_count = SIZE( xi_interpolations )
740 
741  import_index = fieldml_addimportsource( fieldml_handle, &
742  & "http://www.fieldml.org/resources/xml/0.5/FieldML_Library_0.5.xml"//c_null_char, "library"//c_null_char )
743  CALL fieldml_util_check_fieldml_error( "Cannot access built-in FieldML library.", fieldml_handle, err, error, *999 )
744 
745  first_interpolation = xi_interpolations(1)
746  DO i = 2, xi_count
747  IF( xi_interpolations(i) /= first_interpolation ) THEN
748  !Do not yet support inhomogeneous TP bases
749  CALL flagerror( "FieldML translation of inhomogeneous tensor-product bases are not yet supported.", &
750  & err, error, *999 )
751  ENDIF
752  ENDDO
753 
754  CALL fieldml_output_get_collapse_suffix( collapse_info, suffix, err, error, *999 )
755 
756  IF( first_interpolation == basis_quadratic_lagrange_interpolation ) THEN
757  IF( xi_count == 1 ) THEN
758  layout_name = "localNodes.1d.line3"
759  ELSE IF( xi_count == 2 ) THEN
760  layout_name = "localNodes.2d.square3x3"//suffix
761  ELSE IF( xi_count == 3 ) THEN
762  layout_name = "localNodes.3d.cube3x3x3"//suffix
763  ELSE
764  !Do not yet support dimensions higher than 3.
765  CALL flagerror( var_str("Quadratic Lagrangian interpolation not supported for ")//xi_count//" dimensions.", &
766  & err, error, *999 )
767  ENDIF
768  ELSE IF( first_interpolation == basis_linear_lagrange_interpolation ) THEN
769  IF( xi_count == 1 ) THEN
770  layout_name = "localNodes.1d.line2"
771  ELSE IF( xi_count == 2 ) THEN
772  layout_name = "localNodes.2d.square2x2"//suffix
773  ELSE IF( xi_count == 3 ) THEN
774  layout_name = "localNodes.3d.cube2x2x2"//suffix
775  ELSE
776  !Do not yet support dimensions higher than 3.
777  CALL flagerror( var_str("Linear Lagrangian interpolation not supported for ")//xi_count//" dimensions.", &
778  & err, error, *999 )
779  ENDIF
780  ELSE
781  CALL flagerror( var_str("FieldML translation not yet supported for interpolation type ")//first_interpolation//".", &
782  & err, error, *999 )
783  ENDIF
784 
785  IF( do_import ) THEN
786  temp = fieldml_output_import_fml( fieldml_handle, layout_name, err, error )
787  IF(err/=0) GOTO 999
788  ENDIF
789  type_handle = fieldml_getobjectbyname( fieldml_handle, cchar(layout_name) )
790  CALL fieldml_util_check_fieldml_error( "Cannot get local nodes type "//layout_name//".", fieldml_handle, err, error, *999 )
791 
792  exits( "FIELDML_OUTPUT_GET_TP_CONNECTIVITY_TYPE" )
793  RETURN
794 999 errorsexits( "FIELDML_OUTPUT_GET_TP_CONNECTIVITY_TYPE", err, error )
795  RETURN 1
796 
797  END SUBROUTINE fieldml_output_get_tp_connectivity_type
798 
799  !
800  !================================================================================================================================
801  !
802 
804  SUBROUTINE fieldmloutputgetsimplexconnectivitytype( fieldmlHandle, xiInterpolations, doImport, typeHandle, err, error, * )
805  !Argument variables
806  INTEGER(INTG), INTENT(IN) :: fieldmlHandle
807  INTEGER(INTG), INTENT(IN) :: xiInterpolations(:)
808  LOGICAL, INTENT(IN) :: doImport
809  INTEGER(INTG), INTENT(OUT) :: typeHandle
810  INTEGER(INTG), INTENT(OUT) :: err
811  TYPE(varying_string), INTENT(OUT) :: error
812 
813  !Locals
814  INTEGER(INTG) :: xiCount, firstInterpolation, i, importIndex, temp
815  TYPE(varying_string) :: layoutName
816 
817  enters( "FieldmlOutputGetSimplexConnectivityType", err, error, *999 )
818 
819  xicount = SIZE( xiinterpolations )
820 
821  importindex = fieldml_addimportsource( fieldmlhandle, &
822  & "http://www.fieldml.org/resources/xml/0.4/FieldML_Library_0.4.xml"//c_null_char, "library"//c_null_char )
823  CALL fieldml_util_check_fieldml_error( "Cannot access built-in FieldML library.", fieldmlhandle, err, error, *999 )
824 
825  firstinterpolation = xiinterpolations(1)
826  DO i = 2, xicount
827  IF( xiinterpolations(i) /= firstinterpolation ) THEN
828  !Do not yet support inhomogeneous TP bases
829  CALL flag_error( "FieldML translation of inhomogeneous simplex bases are not yet supported.", &
830  & err, error, *999 )
831  ENDIF
832  ENDDO
833 
834  IF( firstinterpolation == basis_quadratic_simplex_interpolation ) THEN
835  IF( xicount == 1 ) THEN
836  layoutname = "localNodes.1d.line3"
837  ELSE IF( xicount == 2 ) THEN
838  layoutname = "localNodes.2d.triangle6.vtk"
839  ELSE IF( xicount == 3 ) THEN
840  layoutname = "localNodes.3d.tetrahedron10.zienkiewicz"
841  ELSE
842  !Do not yet support dimensions higher than 3.
843  CALL flag_error( var_str("Quadratic Simplex interpolation not supported for ")//xicount//" dimensions.", &
844  & err, error, *999 )
845  ENDIF
846  ELSE IF( firstinterpolation == basis_linear_simplex_interpolation ) THEN
847  IF( xicount == 1 ) THEN
848  layoutname = "localNodes.1d.line2"
849  ELSE IF( xicount == 2 ) THEN
850  layoutname = "localNodes.2d.triangle3"
851  ELSE IF( xicount == 3 ) THEN
852  layoutname = "localNodes.3d.tetrahedron4"
853  ELSE
854  !Do not yet support dimensions higher than 3.
855  CALL flag_error( var_str("Linear Simplex interpolation not supported for ")//xicount//" dimensions.", &
856  & err, error, *999 )
857  ENDIF
858  ELSE
859  CALL flag_error( var_str("FieldML translation not yet supported for interpolation type ")//firstinterpolation//".", &
860  & err, error, *999 )
861  ENDIF
862 
863  IF( doimport ) THEN
864  temp = fieldml_output_import_fml( fieldmlhandle, layoutname, err, error )
865  IF(err/=0) GOTO 999
866  ENDIF
867  typehandle = fieldml_getobjectbyname( fieldmlhandle, cchar(layoutname) )
868  CALL fieldml_util_check_fieldml_error( "Cannot get local nodes type "//layoutname//".", fieldmlhandle, err, error, *999 )
869 
870  exits( "FieldmlOutputGetSimplexConnectivityType" )
871  RETURN
872 999 errorsexits( "FieldmlOutputGetSimplexConnectivityType", err, error )
873  RETURN 1
874 
875  END SUBROUTINE fieldmloutputgetsimplexconnectivitytype
876 
877  !
878  !================================================================================================================================
879  !
880 
882  SUBROUTINE fieldml_output_get_connectivity_ensemble( FIELDML_HANDLE, BASIS, TYPE_HANDLE, ERR, ERROR, * )
883  !Argument variables
884  INTEGER(INTG), INTENT(IN) :: FIELDML_HANDLE
885  TYPE(basis_type), POINTER :: BASIS
886  INTEGER(INTG), INTENT(OUT) :: TYPE_HANDLE
887  INTEGER(INTG), INTENT(OUT) :: ERR
888  TYPE(varying_string), INTENT(OUT) :: ERROR
889 
890  !Locals
891  INTEGER(INTG) :: BASISTYPE, XI_COUNT
892  INTEGER(INTG), ALLOCATABLE :: XI_INTERPOLATIONS(:), COLLAPSE_INFO(:)
893 
894  enters( "FIELDML_OUTPUT_GET_CONNECTIVITY_ENSEMBLE", err, error, *999 )
895 
896  type_handle = fml_invalid_handle
897 
898  CALL basis_type_get( basis, basistype, err, error, *999 )
899  CALL basis_number_of_xi_get( basis, xi_count, err, error, *999 )
900 
901  IF( basistype == basis_lagrange_hermite_tp_type ) THEN
902  ALLOCATE( xi_interpolations( xi_count ), stat = err )
903  IF( err /= 0 ) CALL flagerror( "Could not allocate xi interpolations array.", err, error, *999 )
904  ALLOCATE( collapse_info( xi_count ), stat = err )
905  IF( err /= 0 ) CALL flagerror( "Could not allocate collapse info array.", err, error, *999 )
906  CALL basis_interpolation_xi_get( basis, xi_interpolations, err, error, *999 )
907  CALL basis_collapsed_xi_get( basis, collapse_info, err, error, *999 )
908 
909  CALL fieldml_output_get_tp_connectivity_type( fieldml_handle, xi_interpolations, collapse_info, .true., type_handle, &
910  & err, error, *999 )
911 
912  DEALLOCATE( xi_interpolations )
913  DEALLOCATE( collapse_info )
914  ELSE IF( basistype == basis_simplex_type ) THEN
915  ALLOCATE( xi_interpolations( xi_count ), stat = err )
916  IF( err /= 0 ) CALL flagerror( "Could not allocate xi interpolations array.", err, error, *999 )
917  CALL basis_interpolation_xi_get( basis, xi_interpolations, err, error, *999 )
918 
919  CALL fieldmloutputgetsimplexconnectivitytype( fieldml_handle, xi_interpolations, .true., type_handle, &
920  & err, error, *999 )
921 
922  DEALLOCATE( xi_interpolations )
923  ELSE
924  CALL flagerror( "Only translation of tensor product bases are currently supported", err, error, *999 )
925  ENDIF
926 
927  exits( "FIELDML_OUTPUT_GET_CONNECTIVITY_ENSEMBLE" )
928  RETURN
929 999 errorsexits( "FIELDML_OUTPUT_GET_CONNECTIVITY_ENSEMBLE", err, error )
930  RETURN 1
931 
932  END SUBROUTINE fieldml_output_get_connectivity_ensemble
933 
934  !
935  !================================================================================================================================
936  !
937 
939  FUNCTION fieldml_output_find_layout( CONNECTIVITY_INFO, LAYOUT_HANDLE, ERR, ERROR )
940  !Argument variables
941  TYPE(connectivity_info_type), INTENT(IN) :: CONNECTIVITY_INFO(:)
942  INTEGER(INTG), INTENT(IN) :: LAYOUT_HANDLE
943  INTEGER(INTG), INTENT(OUT) :: ERR
944  TYPE(varying_string), INTENT(OUT) :: ERROR
945 
946  !Function
947  INTEGER(INTG) :: FIELDML_OUTPUT_FIND_LAYOUT
948 
949  !Locals
950  INTEGER(INTG) :: I
951 
952  enters( "FIELDML_OUTPUT_FIND_LAYOUT", err, error, *999 )
953 
954  fieldml_output_find_layout = -1
955  DO i = 1, SIZE( connectivity_info )
956  IF( connectivity_info(i)%LAYOUT_HANDLE == layout_handle ) THEN
957  fieldml_output_find_layout = i
958  ENDIF
959  ENDDO
960 
961  exits( "FIELDML_OUTPUT_FIND_LAYOUT" )
962  RETURN
963 999 errorsexits( "FIELDML_OUTPUT_FIND_LAYOUT", err, error )
964 
965  END FUNCTION fieldml_output_find_layout
966 
967  !
968  !================================================================================================================================
969  !
970 
972  FUNCTION fieldml_output_find_basis( BASIS_INFO, BASIS, ERR, ERROR )
973  !Argument variables
974  TYPE(basis_info_type), INTENT(IN) :: BASIS_INFO(:)
975  TYPE(basis_type), POINTER, INTENT(IN) :: BASIS
976  INTEGER(INTG), INTENT(OUT) :: ERR
977  TYPE(varying_string), INTENT(OUT) :: ERROR
978 
979  !Function
980  INTEGER(INTG) :: FIELDML_OUTPUT_FIND_BASIS
981 
982  !Locals
983  INTEGER(INTG) :: I
984 
985  enters( "FIELDML_OUTPUT_FIND_BASIS", err, error, *999 )
986 
987  fieldml_output_find_basis = -1
988  DO i = 1, SIZE( basis_info )
989  IF( ASSOCIATED( basis_info(i)%BASIS, TARGET = basis ) ) THEN
990  fieldml_output_find_basis = i
991  ENDIF
992  ENDDO
993 
994  exits( "FIELDML_OUTPUT_FIND_BASIS" )
995  RETURN
996 999 errorsexits( "FIELDML_OUTPUT_FIND_BASIS", err, error )
997 
998  END FUNCTION fieldml_output_find_basis
999 
1000  !
1001  !================================================================================================================================
1002  !
1003 
1005  SUBROUTINE fieldml_output_get_simple_layout_name( FML_HANDLE, LAYOUT_HANDLE, NAME, ERR, ERROR, * )
1006  !Argument variables
1007  INTEGER(INTG), INTENT(IN) :: FML_HANDLE
1008  INTEGER(INTG), INTENT(IN) :: LAYOUT_HANDLE
1009  TYPE(varying_string), INTENT(INOUT) :: NAME
1010  INTEGER(INTG), INTENT(OUT) :: ERR
1011  TYPE(varying_string), INTENT(OUT) :: ERROR
1012 
1013  !Locals
1014  CHARACTER(KIND=C_CHAR,LEN=MAXSTRLEN) :: FULL_NAME
1015  INTEGER(INTG) :: LENGTH
1016 
1017  enters( "FIELDML_OUTPUT_GET_SIMPLE_LAYOUT_NAME", err, error, *999 )
1018 
1019  length = fieldml_copyobjectdeclaredname( fml_handle, layout_handle, full_name, maxstrlen )
1020  CALL fieldml_util_check_fieldml_error("Cannot get name of layout ensemble.", fml_handle, err, error, *999 )
1021 
1022  IF( index( full_name, 'localNodes.') /= 1 ) THEN
1023  name = full_name(1:length)
1024  ELSE
1025  name = full_name(12:length)
1026  ENDIF
1027 
1028  exits( "FIELDML_OUTPUT_GET_SIMPLE_LAYOUT_NAME" )
1029  RETURN
1030 999 errorsexits( "FIELDML_OUTPUT_GET_SIMPLE_LAYOUT_NAME", err, error )
1031  RETURN 1
1032 
1033  END SUBROUTINE
1034 
1035  !
1036  !================================================================================================================================
1037  !
1038 
1040  SUBROUTINE fieldml_output_get_simple_basis_name( FML_HANDLE, BASIS_HANDLE, NAME, ERR, ERROR, * )
1041  !Argument variables
1042  INTEGER(INTG), INTENT(IN) :: FML_HANDLE
1043  INTEGER(INTG), INTENT(IN) :: BASIS_HANDLE
1044  TYPE(varying_string), INTENT(INOUT) :: NAME
1045  INTEGER(INTG), INTENT(OUT) :: ERR
1046  TYPE(varying_string), INTENT(OUT) :: ERROR
1047 
1048  !Locals
1049  CHARACTER(KIND=C_CHAR,LEN=MAXSTRLEN) :: FULL_NAME
1050  INTEGER(INTG) :: LENGTH
1051 
1052  enters( "FIELDML_OUTPUT_GET_SIMPLE_BASIS_NAME", err, error, *999 )
1053 
1054  length = fieldml_copyobjectdeclaredname( fml_handle, basis_handle, full_name, maxstrlen )
1055  CALL fieldml_util_check_fieldml_error("Cannot get name of basis evaluator.", fml_handle, err, error, *999 )
1056 
1057  IF( index( full_name, 'interpolator.1d.unit.') == 1 ) THEN
1058  name = full_name(22:length)
1059  ELSEIF( index( full_name, 'interpolator.2d.unit.') == 1 ) THEN
1060  name = full_name(22:length)
1061  ELSEIF( index( full_name, 'interpolator.3d.unit.') == 1 ) THEN
1062  name = full_name(22:length)
1063  ELSE
1064  name = full_name(1:length)
1065  ENDIF
1066 
1067  exits( "FIELDML_OUTPUT_GET_SIMPLE_BASIS_NAME" )
1068  RETURN
1069 999 errorsexits( "FIELDML_OUTPUT_GET_SIMPLE_BASIS_NAME", err, error )
1070  RETURN 1
1071 
1072  END SUBROUTINE fieldml_output_get_simple_basis_name
1073 
1074  !
1075  !================================================================================================================================
1076  !
1077 
1079  SUBROUTINE fieldml_output_create_basis_reference( FIELDML_INFO, BASE_NAME, BASIS_INFO, ERR, ERROR, * )
1080  !Argument variables
1081  TYPE(fieldml_io_type), INTENT(IN) :: FIELDML_INFO
1082  TYPE(varying_string), INTENT(IN) :: BASE_NAME
1083  TYPE(basis_info_type), INTENT(INOUT) :: BASIS_INFO
1084  INTEGER(INTG), INTENT(OUT) :: ERR
1085  TYPE(varying_string), INTENT(OUT) :: ERROR
1086 
1087  !Locals
1088  INTEGER(INTG) :: BASIS_TYPE, XI_COUNT, INTERPOLATION_PARAMETERS_HANDLE, HANDLE, EVALUATOR_HANDLE, valueType
1089  INTEGER(INTG) :: VARIABLE_HANDLE, AGGREGATE_HANDLE, INDEX_EVALUATOR_HANDLE, FML_ERR
1090  INTEGER(INTG), ALLOCATABLE :: XI_INTERPOLATIONS(:), COLLAPSE_INFO(:)
1091  TYPE(varying_string) :: REFERENCE_NAME, NAME
1092 
1093  enters( "FIELDML_OUTPUT_CREATE_BASIS_REFERENCE", err, error, *999 )
1094 
1095  CALL basis_type_get( basis_info%BASIS, basis_type, err, error, *999 )
1096  CALL basis_number_of_xi_get( basis_info%BASIS, xi_count, err, error, *999 )
1097 
1098  IF( basis_type == basis_lagrange_hermite_tp_type ) THEN
1099  ALLOCATE( xi_interpolations( xi_count ), stat = err )
1100  IF( err /= 0 ) CALL flagerror( "Could not allocate xi interpolation array.", err, error, *999 )
1101  ALLOCATE( collapse_info( xi_count ), stat = err )
1102  CALL basis_interpolation_xi_get( basis_info%BASIS, xi_interpolations, err, error, *999 )
1103  CALL basis_collapsed_xi_get( basis_info%BASIS, collapse_info, err, error, *999 )
1104 
1105  CALL fieldml_output_get_tp_basis_evaluator( fieldml_info%FML_HANDLE, xi_interpolations, collapse_info, evaluator_handle, &
1106  & interpolation_parameters_handle, err, error, *999 )
1107  DEALLOCATE( xi_interpolations )
1108  DEALLOCATE( collapse_info )
1109 
1110  CALL fieldml_output_get_simple_basis_name( fieldml_info%FML_HANDLE, evaluator_handle, name, err, error, *999 )
1111 
1112  reference_name = base_name//name//"_"//trim(number_to_vstring(basis_info%BASIS%USER_NUMBER,"*",err,error))// &
1113  & ".parameters"
1114 
1115  aggregate_handle = fieldml_createaggregateevaluator( fieldml_info%FML_HANDLE, cchar(reference_name), &
1116  & interpolation_parameters_handle )
1117  CALL fieldml_util_check_fieldml_error( "Cannot create dofs for basis connectivity for "//name//".", &
1118  & fieldml_info%FML_HANDLE, err, error, *999 )
1119 
1120  index_evaluator_handle = fieldml_output_get_type_argument_handle( fieldml_info, basis_info%LAYOUT_HANDLE, .true., &
1121  & err, error )
1122  IF(err/=0) GOTO 999
1123 
1124  fml_err = fieldml_setindexevaluator( fieldml_info%FML_HANDLE, aggregate_handle, 1, index_evaluator_handle )
1125  CALL fieldml_util_check_fieldml_error( "Cannot set field component index evaluator for "//reference_name//".", &
1126  & fieldml_info%FML_HANDLE, err, error, *999 )
1127 
1128  fml_err = fieldml_setdefaultevaluator( fieldml_info%FML_HANDLE, aggregate_handle, fieldml_info%NODE_DOFS_HANDLE )
1129  CALL fieldml_util_check_fieldml_error( "Cannot set nodal field dofs for "//reference_name//".", &
1130  & fieldml_info%FML_HANDLE, err, error, *999 )
1131 
1132  handle = fieldml_getvaluetype( fieldml_info%FML_HANDLE, basis_info%CONNECTIVITY_HANDLE )
1133  variable_handle = fieldml_output_get_type_argument_handle( fieldml_info, handle, .false., err, error )
1134  IF(err/=0) GOTO 999
1135  fml_err = fieldml_setbind( fieldml_info%FML_HANDLE, aggregate_handle, variable_handle, basis_info%CONNECTIVITY_HANDLE )
1136  CALL fieldml_util_check_fieldml_error( "Cannot set bind for basis dofs for"//reference_name//".", &
1137  & fieldml_info%FML_HANDLE, err, error, *999 )
1138 
1139  reference_name = base_name//name//"_"//trim(number_to_vstring(basis_info%BASIS%USER_NUMBER,"*",err,error))// &
1140  & ".evaluator"
1141 
1142  valuetype = fieldml_getvaluetype( fieldml_info%FML_HANDLE, evaluator_handle )
1143 
1144  basis_info%REFERENCE_HANDLE = fieldml_createreferenceevaluator( fieldml_info%FML_HANDLE, cchar(reference_name), &
1145  & evaluator_handle, valuetype )
1146 
1147  CALL fieldml_output_get_xi_type( fieldml_info%FML_HANDLE, xi_count, .true., handle, err, error, *999 )
1148  variable_handle = fieldml_output_get_type_argument_handle( fieldml_info, handle, .true., err, error )
1149  IF(err/=0) GOTO 999
1150  fml_err = fieldml_setbind( fieldml_info%FML_HANDLE, basis_info%REFERENCE_HANDLE, variable_handle, &
1151  & fieldml_info%XI_ARGUMENT_HANDLE )
1152  CALL fieldml_util_check_fieldml_error( "Cannot bind xi to basis evaluator "//reference_name//".", &
1153  & fieldml_info%FML_HANDLE, err, error, *999 )
1154 
1155  variable_handle = fieldml_output_get_type_argument_handle( fieldml_info, interpolation_parameters_handle, .true.,&
1156  & err, error )
1157  IF(err/=0) GOTO 999
1158  fml_err = fieldml_setbind( fieldml_info%FML_HANDLE, basis_info%REFERENCE_HANDLE, variable_handle, &
1159  & aggregate_handle )
1160  CALL fieldml_util_check_fieldml_error( "Cannot bind parameters to basis evaluator "//reference_name//".", &
1161  & fieldml_info%FML_HANDLE, err, error, *999 )
1162 
1163  ELSE IF( basis_type == basis_simplex_type ) THEN
1164  ALLOCATE( xi_interpolations( xi_count ), stat = err )
1165  IF( err /= 0 ) CALL flagerror( "Could not allocate xi interpolation array.", err, error, *999 )
1166 
1167  CALL basis_interpolation_xi_get( basis_info%BASIS, xi_interpolations, err, error, *999 )
1168 
1169  CALL fieldmloutputgetsimplexbasisevaluator( fieldml_info%FML_HANDLE, xi_interpolations, evaluator_handle, &
1170  & interpolation_parameters_handle, err, error, *999 )
1171  DEALLOCATE( xi_interpolations )
1172 
1173  CALL fieldml_output_get_simple_basis_name( fieldml_info%FML_HANDLE, evaluator_handle, name, err, error, *999 )
1174 
1175  reference_name = base_name//name//"_"//trim(number_to_vstring(basis_info%BASIS%USER_NUMBER,"*",err,error))// &
1176  & ".parameters"
1177 
1178  aggregate_handle = fieldml_createaggregateevaluator( fieldml_info%FML_HANDLE, cchar(reference_name), &
1179  & interpolation_parameters_handle )
1180  CALL fieldml_util_check_fieldml_error( "Cannot create dofs for basis connectivity for "//name//".", &
1181  & fieldml_info%FML_HANDLE, err, error, *999 )
1182 
1183  index_evaluator_handle = fieldml_output_get_type_argument_handle( fieldml_info, basis_info%LAYOUT_HANDLE, .true., &
1184  & err, error )
1185  IF(err/=0) GOTO 999
1186 
1187  fml_err = fieldml_setindexevaluator( fieldml_info%FML_HANDLE, aggregate_handle, 1, index_evaluator_handle )
1188  CALL fieldml_util_check_fieldml_error( "Cannot set field component index evaluator for "//reference_name//".", &
1189  & fieldml_info%FML_HANDLE, err, error, *999 )
1190 
1191  fml_err = fieldml_setdefaultevaluator( fieldml_info%FML_HANDLE, aggregate_handle, fieldml_info%NODE_DOFS_HANDLE )
1192  CALL fieldml_util_check_fieldml_error( "Cannot set nodal field dofs for "//reference_name//".", &
1193  & fieldml_info%FML_HANDLE, err, error, *999 )
1194 
1195  handle = fieldml_getvaluetype( fieldml_info%FML_HANDLE, basis_info%CONNECTIVITY_HANDLE )
1196  variable_handle = fieldml_output_get_type_argument_handle( fieldml_info, handle, .false., err, error )
1197  IF(err/=0) GOTO 999
1198  fml_err = fieldml_setbind( fieldml_info%FML_HANDLE, aggregate_handle, variable_handle, basis_info%CONNECTIVITY_HANDLE )
1199  CALL fieldml_util_check_fieldml_error( "Cannot set bind for basis dofs for"//reference_name//".", &
1200  & fieldml_info%FML_HANDLE, err, error, *999 )
1201 
1202  reference_name = base_name//name//"_"//trim(number_to_vstring(basis_info%BASIS%USER_NUMBER,"*",err,error))// &
1203  & ".evaluator"
1204 
1205  valuetype = fieldml_getvaluetype( fieldml_info%FML_HANDLE, evaluator_handle )
1206 
1207  basis_info%REFERENCE_HANDLE = fieldml_createreferenceevaluator( fieldml_info%FML_HANDLE, cchar(reference_name), &
1208  & evaluator_handle, valuetype )
1209 
1210  CALL fieldml_output_get_xi_type( fieldml_info%FML_HANDLE, xi_count, .true., handle, err, error, *999 )
1211  variable_handle = fieldml_output_get_type_argument_handle( fieldml_info, handle, .true., err, error )
1212  IF(err/=0) GOTO 999
1213  fml_err = fieldml_setbind( fieldml_info%FML_HANDLE, basis_info%REFERENCE_HANDLE, variable_handle, &
1214  & fieldml_info%XI_ARGUMENT_HANDLE )
1215  CALL fieldml_util_check_fieldml_error( "Cannot bind xi to basis evaluator "//reference_name//".", &
1216  & fieldml_info%FML_HANDLE, err, error, *999 )
1217 
1218  variable_handle = fieldml_output_get_type_argument_handle( fieldml_info, interpolation_parameters_handle, .true.,&
1219  & err, error )
1220  IF(err/=0) GOTO 999
1221  fml_err = fieldml_setbind( fieldml_info%FML_HANDLE, basis_info%REFERENCE_HANDLE, variable_handle, &
1222  & aggregate_handle )
1223  CALL fieldml_util_check_fieldml_error( "Cannot bind parameters to basis evaluator "//reference_name//".", &
1224  & fieldml_info%FML_HANDLE, err, error, *999 )
1225 
1226  ELSE
1227  basis_info%REFERENCE_HANDLE = fml_invalid_handle
1228  CALL flagerror( "FieldML export code can currently only translate tensor-product bases.", err, error, *999 )
1229  ENDIF
1230 
1231  exits( "FIELDML_OUTPUT_CREATE_BASIS_REFERENCE" )
1232  RETURN
1233 999 errorsexits( "FIELDML_OUTPUT_CREATE_BASIS_REFERENCE", err, error )
1234  RETURN 1
1235 
1236  END SUBROUTINE fieldml_output_create_basis_reference
1237 
1238  !
1239  !================================================================================================================================
1240  !
1241 
1243  SUBROUTINE fieldml_output_create_layout_parameters( FIELDML_INFO, LAYOUT_HANDLE, COMPONENT_NAME, &
1244  & connectivity_info, err, error, * )
1245  !Argument variables
1246  TYPE(fieldml_io_type), INTENT(INOUT) :: FIELDML_INFO
1247  INTEGER(INTG), INTENT(IN) :: LAYOUT_HANDLE
1248  TYPE(varying_string), INTENT(IN) :: COMPONENT_NAME
1249  TYPE(connectivity_info_type), INTENT(INOUT) :: CONNECTIVITY_INFO
1250  INTEGER(INTG), INTENT(OUT) :: ERR
1251  TYPE(varying_string), INTENT(OUT) :: ERROR
1252 
1253  !Locals
1254  TYPE(varying_string) :: NAME
1255  INTEGER(INTG) :: INDEX_HANDLE, FML_ERR
1256  TYPE(varying_string) :: CONNECTIVITY_NAME
1257 
1258  enters( "FIELDML_OUTPUT_CREATE_LAYOUT_PARAMETERS", err, error, *999 )
1259 
1260  CALL fieldml_output_get_simple_layout_name( fieldml_info%FML_HANDLE, layout_handle, name, err, error, *999 )
1261  connectivity_name = component_name//name
1262 
1263  connectivity_info%LAYOUT_HANDLE = layout_handle
1264  connectivity_info%CONNECTIVITY_HANDLE = fieldml_createparameterevaluator( fieldml_info%FML_HANDLE, &
1265  & cchar(connectivity_name), fieldml_info%NODES_HANDLE )
1266  CALL fieldml_util_check_fieldml_error("Cannot create nodal parameters for "//connectivity_name//".", &
1267  & fieldml_info%FML_HANDLE, err, error, *999 )
1268 
1269  fml_err = fieldml_setparameterdatadescription( fieldml_info%FML_HANDLE, connectivity_info%CONNECTIVITY_HANDLE, &
1270  & fml_data_description_dense_array )
1271  CALL fieldml_util_check_fieldml_error("Cannot set nodal parameters description for "//connectivity_name//".", &
1272  & fieldml_info%FML_HANDLE, err, error, *999 )
1273 
1274  fml_err = fieldml_adddenseindexevaluator( fieldml_info%FML_HANDLE, connectivity_info%CONNECTIVITY_HANDLE, &
1275  & fieldml_info%ELEMENTS_ARGUMENT_HANDLE, fml_invalid_handle )
1276  CALL fieldml_util_check_fieldml_error("Cannot add element index to nodal parameters "//connectivity_name//".", &
1277  & fieldml_info%FML_HANDLE, err, error, *999 )
1278 
1279  index_handle = fieldml_output_get_type_argument_handle( fieldml_info, layout_handle, .true., err, error )
1280  IF(err/=0) GOTO 999
1281  fml_err = fieldml_adddenseindexevaluator( fieldml_info%FML_HANDLE, connectivity_info%CONNECTIVITY_HANDLE, index_handle, &
1282  & fml_invalid_handle )
1283  CALL fieldml_util_check_fieldml_error("Cannot add layout index to nodal parameters "//connectivity_name//".", &
1284  & fieldml_info%FML_HANDLE, err, error, *999 )
1285 
1286  exits( "FIELDML_OUTPUT_CREATE_LAYOUT_PARAMETERS" )
1287  RETURN
1288 999 errorsexits( "FIELDML_OUTPUT_CREATE_LAYOUT_PARAMETERS", err, error )
1289  RETURN 1
1290 
1291  END SUBROUTINE fieldml_output_create_layout_parameters
1292 
1293  !
1294  !================================================================================================================================
1295  !
1296 
1298  SUBROUTINE fieldml_output_add_mesh_component( FIELDML_INFO, BASE_NAME, CONNECTIVITY_FORMAT, COMPONENT_NUMBER, &
1299  & mesh_elements, err, error, * )
1300  !Argument variables
1301  TYPE(fieldml_io_type), INTENT(INOUT) :: FIELDML_INFO
1302  TYPE(varying_string), INTENT(IN) :: BASE_NAME
1303  TYPE(varying_string), INTENT(IN) :: CONNECTIVITY_FORMAT
1304  INTEGER(INTG), INTENT(IN) :: COMPONENT_NUMBER
1305  TYPE(meshelementstype), POINTER, INTENT(IN) :: MESH_ELEMENTS
1306  INTEGER(INTG), INTENT(OUT) :: ERR
1307  TYPE(varying_string), INTENT(OUT) :: ERROR
1308 
1309  !Locals
1310  INTEGER(INTG) :: LAYOUT_HANDLE, CONNECTIVITY_HANDLE, ELEMENT_COUNT, DEFAULT_HANDLE, TEMPLATE_HANDLE, TYPE_HANDLE
1311  INTEGER(INTG) :: CONNECTIVITY_COUNT, BASIS_COUNT, I, J, LAYOUT_NODE_COUNT, IDX
1312  INTEGER(INTG), ALLOCATABLE, TARGET :: IBUFFER(:)
1313  TYPE(basis_type), POINTER :: BASIS
1314  INTEGER(INTG) :: WRITER, SOURCE_HANDLE, FML_ERR, RESOURCE_HANDLE
1315  TYPE(connectivity_info_type), ALLOCATABLE :: CONNECTIVITY_INFO(:), TEMP_CONNECTIVITY_INFO(:)
1316  TYPE(basis_info_type), ALLOCATABLE :: BASIS_INFO(:), TEMP_BASIS_INFO(:)
1317  TYPE(varying_string) :: COMPONENT_NAME, ARRAY_LOCATION
1318  INTEGER(INTG), TARGET :: OFFSETS(2), SIZES(2)
1319 
1320  enters( "FIELDML_OUTPUT_ADD_MESH_COMPONENT", err, error, *999 )
1321 
1322  element_count = fieldml_getmembercount( fieldml_info%FML_HANDLE, fieldml_info%ELEMENTS_HANDLE )
1323  CALL fieldml_util_check_fieldml_error( "Cannot get element count for mesh "//base_name//".", &
1324  & fieldml_info%FML_HANDLE, err, error, *999 )
1325 
1326  connectivity_count = 0
1327  basis_count = 0
1328 
1329  component_name = base_name//".component"//trim(number_to_vstring(component_number,"*",err,error))
1330 
1331  type_handle = fieldml_getvaluetype( fieldml_info%FML_HANDLE, fieldml_info%NODE_DOFS_HANDLE )
1332  CALL fieldml_util_check_fieldml_error( "Cannot get node dofs FieldML type.", fieldml_info%FML_HANDLE, err, error, *999 )
1333 
1334  resource_handle = fieldml_createhrefdataresource( fieldml_info%FML_HANDLE, &
1335  & cchar(component_name//".connectivity.resource"), cchar( connectivity_format ), &
1336  & cchar(component_name//".connectivity") )
1337  CALL fieldml_util_check_fieldml_error( "Cannot create mesh component connectivity resource "//component_name//&
1338  & ".connectivity.resource", fieldml_info%FML_HANDLE, err, error, *999 )
1339 
1340  template_handle = fieldml_createpiecewiseevaluator( fieldml_info%FML_HANDLE, cchar(component_name//".template"), &
1341  & type_handle )
1342  CALL fieldml_util_check_fieldml_error( "Cannot create mesh component template "//component_name//".template.", &
1343  & fieldml_info%FML_HANDLE, err, error, *999 )
1344  fml_err = fieldml_setindexevaluator( fieldml_info%FML_HANDLE, template_handle, 1, fieldml_info%ELEMENTS_ARGUMENT_HANDLE )
1345  CALL fieldml_util_check_fieldml_error( &
1346  & "Cannot set index evaluator for mesh omponent template "//component_name//".template.", &
1347  & fieldml_info%FML_HANDLE, err, error, *999 )
1348 
1349  DO i = 1, element_count
1350  CALL mesh_topology_elements_element_basis_get( i, mesh_elements, basis, err, error, *999 )
1351 
1352  CALL fieldml_output_get_connectivity_ensemble( fieldml_info%FML_HANDLE, basis, layout_handle, err, error, *999 )
1353 
1354  idx = -1
1355  IF( connectivity_count > 0 ) THEN
1356  idx = fieldml_output_find_layout( connectivity_info, layout_handle, err, error )
1357  IF(err/=0) GOTO 999
1358  ENDIF
1359 
1360  IF( idx == -1 ) THEN
1361  IF( connectivity_count == 0 ) THEN
1362  ALLOCATE( connectivity_info( connectivity_count + 1 ), stat = err )
1363  IF( err /= 0 ) CALL flagerror( "Could not allocate connectivity info array.", err, error, *999 )
1364  ELSE
1365  ALLOCATE( temp_connectivity_info( connectivity_count ), stat = err )
1366  IF( err /= 0 ) CALL flagerror( "Could not allocate temporary connectivity array.", err, error, *999 )
1367  temp_connectivity_info(:) = connectivity_info(:)
1368  DEALLOCATE( connectivity_info )
1369  ALLOCATE( connectivity_info( connectivity_count + 1 ), stat = err )
1370  IF( err /= 0 ) CALL flagerror( "Could not allocate new connectivity info array.", err, error, *999 )
1371  connectivity_info( 1:connectivity_count ) = temp_connectivity_info( 1:connectivity_count )
1372  ENDIF
1373 
1374  CALL fieldml_output_create_layout_parameters( fieldml_info, layout_handle, component_name, &
1375  & connectivity_info(connectivity_count+1), err, error, *999 )
1376 
1377  layout_node_count = fieldml_getmembercount( fieldml_info%FML_HANDLE, &
1378  & connectivity_info(connectivity_count+1)%LAYOUT_HANDLE )
1379 
1380  array_location = ""
1381  array_location = array_location//( connectivity_count + 1 )
1382  sizes(1) = element_count
1383  sizes(2) = layout_node_count
1384  source_handle = fieldml_createarraydatasource( fieldml_info%FML_HANDLE, cchar(component_name//".connectivity"), &
1385  & resource_handle, cchar(array_location), 2 )
1386  fml_err = fieldml_setarraydatasourcerawsizes( fieldml_info%FML_HANDLE, source_handle, c_loc(sizes) )
1387  fml_err = fieldml_setarraydatasourcesizes( fieldml_info%FML_HANDLE, source_handle, c_loc(sizes) )
1388  CALL fieldml_util_check_fieldml_error( "Cannot create connectivity data source "//component_name//".connectivity", &
1389  & fieldml_info%FML_HANDLE, err, error, *999 )
1390 
1391  fml_err = fieldml_setdatasource( fieldml_info%FML_HANDLE, connectivity_info(connectivity_count+1)%CONNECTIVITY_HANDLE, &
1392  & source_handle )
1393  CALL fieldml_util_check_fieldml_error( "Cannot set connectivity data source to "//component_name//".connectivity.",&
1394  & fieldml_info%FML_HANDLE, err, error, *999 )
1395 
1396  connectivity_count = connectivity_count + 1
1397 
1398  idx = connectivity_count
1399  ENDIF
1400  connectivity_handle = connectivity_info(idx)%CONNECTIVITY_HANDLE
1401 
1402  IF( basis_count == 0 ) THEN
1403  idx = -1
1404  ELSE
1405  idx = fieldml_output_find_basis( basis_info, basis, err, error )
1406  IF(err/=0) GOTO 999
1407  ENDIF
1408  IF( idx == -1 ) THEN
1409  IF( basis_count == 0 ) THEN
1410  ALLOCATE( basis_info( basis_count + 1 ), stat = err )
1411  IF( err /= 0 ) CALL flagerror( "Could not allocate basis info array.", err, error, *999 )
1412  ELSE
1413  ALLOCATE( temp_basis_info( basis_count ), stat = err )
1414  IF( err /= 0 ) CALL flagerror( "Could not allocate temporary basis info array.", err, error, *999 )
1415  temp_basis_info(:) = basis_info(:)
1416  DEALLOCATE( basis_info )
1417  ALLOCATE( basis_info( basis_count + 1 ), stat = err )
1418  IF( err /= 0 ) CALL flagerror( "Could not allocate new basis info array.", err, error, *999 )
1419  basis_info( 1:basis_count ) = temp_basis_info( 1:basis_count )
1420  ENDIF
1421 
1422  basis_count = basis_count + 1
1423  basis_info( basis_count )%BASIS => basis
1424  basis_info( basis_count )%CONNECTIVITY_HANDLE = connectivity_handle
1425  basis_info( basis_count )%LAYOUT_HANDLE = layout_handle
1426  CALL fieldml_output_create_basis_reference( fieldml_info, component_name, basis_info(basis_count), err, error, *999 )
1427  idx = basis_count
1428  ENDIF
1429 
1430  IF( i == 1 ) THEN
1431  default_handle = basis_info( idx )%REFERENCE_HANDLE
1432  fml_err = fieldml_setdefaultevaluator( fieldml_info%FML_HANDLE, template_handle, default_handle )
1433  ELSEIF( basis_info( idx )%REFERENCE_HANDLE /= default_handle ) THEN
1434  fml_err = fieldml_setevaluator( fieldml_info%FML_HANDLE, template_handle, i, basis_info( idx )%REFERENCE_HANDLE )
1435  ENDIF
1436  CALL fieldml_util_check_fieldml_error( "Cannot set mesh connectivity evaluator to "//component_name//".template.", &
1437  & fieldml_info%FML_HANDLE, err, error, *999 )
1438 
1439  ENDDO
1440 
1441  DO i = 1, connectivity_count
1442  layout_node_count = fieldml_getmembercount( fieldml_info%FML_HANDLE, connectivity_info(i)%LAYOUT_HANDLE )
1443  CALL fieldml_util_check_fieldml_error( "Cannot get layout node count.", fieldml_info%FML_HANDLE, err, error, *999 )
1444 
1445  source_handle = fieldml_getdatasource( fieldml_info%FML_HANDLE, connectivity_info(i)%CONNECTIVITY_HANDLE )
1446 
1447  sizes(1) = element_count
1448  sizes(2) = layout_node_count
1449  IF( i == 1 ) THEN
1450  writer = fieldml_openarraywriter( fieldml_info%FML_HANDLE, source_handle, fieldml_info%NODES_HANDLE, 0, c_loc(sizes), 2)
1451  ELSE
1452  writer = fieldml_openarraywriter( fieldml_info%FML_HANDLE, source_handle, fieldml_info%NODES_HANDLE, 1, c_loc(sizes), 2)
1453  ENDIF
1454  CALL fieldml_util_check_fieldml_error( "Cannot open connectivity data writer.", fieldml_info%FML_HANDLE, err, error, *999 )
1455 
1456  ALLOCATE( ibuffer( layout_node_count ), stat = err )
1457  IF( err /= 0 ) CALL flagerror( "Could not allocate layout buffer.", err, error, *999 )
1458  sizes(1) = 1
1459  sizes(2) = layout_node_count
1460  offsets(:) = 0
1461  DO j = 1, element_count
1462  CALL mesh_topology_elements_element_basis_get( j, mesh_elements, basis, err, error, *999 )
1463 
1464  CALL fieldml_output_get_connectivity_ensemble( fieldml_info%FML_HANDLE, basis, layout_handle, err, error, *999 )
1465  IF( layout_handle == connectivity_info(i)%LAYOUT_HANDLE ) THEN
1466  CALL mesh_topology_elements_element_nodes_get( j, mesh_elements, ibuffer, err, error, *999 )
1467  ELSE
1468  ibuffer(:) = 0
1469  ENDIF
1470  fml_err = fieldml_writeintslab( writer, c_loc(offsets), c_loc(sizes), c_loc(ibuffer) )
1471  IF( fml_err /= fml_err_no_error ) THEN
1472  CALL flagerror( var_str("I/O error while writing connectivity data for ")//base_name//"("&
1473  & // trim(number_to_vstring(fml_err,"*",err,error)) //").", &
1474  & err, error, *999 )
1475  ENDIF
1476  offsets(1) = offsets(1) + 1
1477  ENDDO
1478  DEALLOCATE( ibuffer )
1479  fml_err = fieldml_closewriter( writer )
1480  CALL fieldml_util_check_fieldml_error( "Cannot close connectivity data writer.", fieldml_info%FML_HANDLE, &
1481  & err, error, *999 )
1482  ENDDO
1483 
1484  IF( ALLOCATED( basis_info ) ) THEN
1485  DEALLOCATE( basis_info )
1486  ENDIF
1487  IF( ALLOCATED( connectivity_info ) ) THEN
1488  DEALLOCATE( connectivity_info )
1489  ENDIF
1490 
1491  CALL list_item_set( fieldml_info%COMPONENT_HANDLES, component_number, template_handle, err, error, *999 )
1492 
1493  exits( "FIELDML_OUTPUT_ADD_MESH_COMPONENT" )
1494  RETURN
1495 999 errorsexits( "FIELDML_OUTPUT_ADD_MESH_COMPONENT", err, error )
1496  RETURN 1
1497 
1498  END SUBROUTINE fieldml_output_add_mesh_component
1499 
1500  !
1501  !================================================================================================================================
1502  !
1503 
1505  SUBROUTINE fieldml_output_add_field_node_dofs( FIELDML_INFO, BASE_NAME, DOF_FORMAT, TYPE_HANDLE, FIELD, &
1506  & field_component_numbers, variable_type, set_type, node_dofs_handle, err, error, * )
1507  !Argument variables
1508  TYPE(fieldml_io_type), INTENT(IN) :: FIELDML_INFO
1509  TYPE(varying_string), INTENT(IN) :: BASE_NAME
1510  TYPE(varying_string), INTENT(IN) :: DOF_FORMAT
1511  INTEGER(INTG), INTENT(IN) :: TYPE_HANDLE
1512  TYPE(field_type), POINTER, INTENT(IN) :: FIELD
1513  INTEGER(INTG), INTENT(IN) :: FIELD_COMPONENT_NUMBERS(:)
1514  INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
1515  INTEGER(INTG), INTENT(IN) :: SET_TYPE
1516  INTEGER(INTG), INTENT(INOUT) :: NODE_DOFS_HANDLE
1517  INTEGER(INTG), INTENT(OUT) :: ERR
1518  TYPE(varying_string), INTENT(OUT) :: ERROR
1519 
1520  !Locals
1521  TYPE(mesh_type), POINTER :: MESH
1522  INTEGER(INTG) :: TYPE_COMPONENT_HANDLE, REAL_1D_HANDLE, NODE_COUNT, INDEX_HANDLE, RESOURCE_HANDLE, SOURCE_HANDLE
1523  INTEGER(INTG) :: VERSION_NUMBER,COMPONENT_COUNT, I, J, INTERPOLATION_TYPE, GLOBAL_NODE_NUMBER, RANK
1524  INTEGER(INTG), ALLOCATABLE :: MESH_COMPONENT_NUMBERS(:)
1525  INTEGER(INTG), TARGET :: SIZES(2), OFFSETS(2), SINGLE_SIZE
1526  INTEGER(INTG) :: WRITER, FML_ERR
1527  REAL(C_DOUBLE), ALLOCATABLE, TARGET :: DBUFFER(:)
1528  REAL(C_DOUBLE) :: DVALUE
1529  LOGICAL :: NODE_EXISTS
1530  LOGICAL, ALLOCATABLE :: IS_NODE_BASED(:)
1531  TYPE(c_ptr) :: SIZE_POINTER
1532  TYPE(varying_string) :: ARRAY_LOCATION
1533  INTEGER(INTG) :: myComputationalNodeNumber,nodeDomain,meshComponentNumber
1534 
1535  enters( "FIELDML_OUTPUT_ADD_FIELD_NODE_DOFS", err, error, *999 )
1536 
1537  mesh => field%DECOMPOSITION%MESH
1538 
1539  CALL fieldml_output_get_generic_type( fieldml_info%FML_HANDLE, 1, real_1d_handle, .true., err, error, *999 )
1540 
1541  component_count = fieldml_gettypecomponentcount( fieldml_info%FML_HANDLE, type_handle )
1542  type_component_handle = fieldml_gettypecomponentensemble( fieldml_info%FML_HANDLE, type_handle )
1543  node_count = fieldml_getmembercount( fieldml_info%FML_HANDLE, fieldml_info%NODES_HANDLE )
1544 
1545  ALLOCATE( mesh_component_numbers( component_count ), stat = err )
1546  IF( err /= 0 ) CALL flagerror( "Could not allocate mesh component array.", err, error, *999 )
1547  ALLOCATE( is_node_based( component_count ), stat = err )
1548  IF( err /= 0 ) CALL flagerror( "Could not allocate nodal component array.", err, error, *999 )
1549 
1550  DO i = 1, component_count
1551  CALL field_component_mesh_component_get( field, variable_type, field_component_numbers(i), &
1552  & mesh_component_numbers(i), err, error, *999 )
1553  CALL field_component_interpolation_get( field, variable_type, field_component_numbers(i), interpolation_type, &
1554  & err, error, *999 )
1555 
1556  is_node_based( i ) = ( interpolation_type == field_node_based_interpolation )
1557  ENDDO
1558 
1559  resource_handle = fieldml_createhrefdataresource( fieldml_info%FML_HANDLE, cchar(base_name//".dofs.node.resource"), &
1560  & cchar( dof_format ), cchar(base_name//".dofs.node") )
1561  CALL fieldml_util_check_fieldml_error( "Cannot create nodal dofs data resource "//base_name//".dofs.node.resource", &
1562  & fieldml_info%FML_HANDLE, err, error, *999 )
1563 
1564  node_dofs_handle = fieldml_createparameterevaluator( fieldml_info%FML_HANDLE, cchar(base_name//".dofs.node"), real_1d_handle )
1565  CALL fieldml_util_check_fieldml_error( "Cannot create nodal dofs parameter set "//base_name//".dofs.node.", &
1566  & fieldml_info%FML_HANDLE, err, error, *999 )
1567  fml_err = fieldml_setparameterdatadescription( fieldml_info%FML_HANDLE, node_dofs_handle, fml_data_description_dense_array )
1568  CALL fieldml_util_check_fieldml_error( "Cannot set nodal dofs parameter description for "//base_name//".dofs.node.", &
1569  & fieldml_info%FML_HANDLE, err, error, *999 )
1570 
1571  sizes( 1 ) = node_count
1572  sizes( 2 ) = component_count
1573  single_size = node_count
1574 
1575  IF( component_count == 1 ) THEN
1576  rank = 1
1577  size_pointer = c_loc(single_size)
1578  ELSE
1579  rank = 2
1580  size_pointer = c_loc(sizes)
1581  ENDIF
1582 
1583  array_location = array_location//1
1584  source_handle = fieldml_createarraydatasource( fieldml_info%FML_HANDLE, cchar(base_name//".dofs.node.data"), &
1585  & resource_handle, cchar(array_location), rank )
1586  fml_err = fieldml_setarraydatasourcerawsizes( fieldml_info%FML_HANDLE, source_handle, size_pointer )
1587  fml_err = fieldml_setarraydatasourcesizes( fieldml_info%FML_HANDLE, source_handle, size_pointer )
1588  CALL fieldml_util_check_fieldml_error( "Cannot create nodal dofs data source "//base_name//".dofs.node.data.", &
1589  & fieldml_info%FML_HANDLE, err, error, *999 )
1590 
1591  fml_err = fieldml_setdatasource( fieldml_info%FML_HANDLE, node_dofs_handle, source_handle )
1592  CALL fieldml_util_check_fieldml_error( "Cannot set nodal dofs data source to "//base_name//".dofs.node.data", &
1593  & fieldml_info%FML_HANDLE, err, error, *999 )
1594 
1595  fml_err = fieldml_adddenseindexevaluator( fieldml_info%FML_HANDLE, node_dofs_handle, fieldml_info%NODES_ARGUMENT_HANDLE, &
1596  & fml_invalid_handle )
1597  CALL fieldml_util_check_fieldml_error( "Cannot add layout index for nodal dofs parameter set "//base_name//".dofs.node.", &
1598  & fieldml_info%FML_HANDLE, err, error, *999 )
1599 
1600  IF( type_component_handle /= fml_invalid_handle ) THEN
1601  type_component_handle = fieldml_output_import_handle( fieldml_info%FML_HANDLE, type_component_handle, err, error )
1602  IF(err/=0) GOTO 999
1603  index_handle = fieldml_output_get_type_argument_handle( fieldml_info, type_component_handle, .true., err, error )
1604  IF(err/=0) GOTO 999
1605  fml_err = fieldml_adddenseindexevaluator( fieldml_info%FML_HANDLE, node_dofs_handle, index_handle, fml_invalid_handle )
1606  CALL fieldml_util_check_fieldml_error( &
1607  & "Cannot add component index for nodal dofs parameter set "//base_name//".dofs.node.", &
1608  & fieldml_info%FML_HANDLE, err, error, *999 )
1609  ENDIF
1610 
1611  ALLOCATE( dbuffer( component_count ), stat = err )
1612  IF( err /= 0 ) CALL flagerror( "Could not allocate nodal dofs array.", err, error, *999 )
1613  writer = fieldml_openarraywriter( fieldml_info%FML_HANDLE, source_handle, real_1d_handle, 0, size_pointer, rank )
1614  CALL fieldml_util_check_fieldml_error( "Cannot open nodal parameter writer for "//base_name//".dofs.node.data.", &
1615  & fieldml_info%FML_HANDLE, err, error, *999 )
1616 
1617  offsets(:) = 0
1618  sizes(1) = 1
1619  sizes(2) = component_count
1620  DO i = 1, node_count
1621  DO j = 1, component_count
1622  dvalue = 0
1623  IF( is_node_based(j) ) THEN
1624  CALL meshtopologynodecheckexists( mesh, mesh_component_numbers(j), i, node_exists, global_node_number, &
1625  & err, error, *999 )
1626  IF( node_exists ) THEN
1627  !Default to version 1 of each node derivative (value hardcoded in loop)
1628  version_number = 1
1629 
1630  mycomputationalnodenumber = computational_node_number_get(err,error)
1631  CALL decomposition_mesh_component_number_get(field%DECOMPOSITION,meshcomponentnumber,err,error,*999)
1632  CALL decomposition_node_domain_get(field%DECOMPOSITION,i,meshcomponentnumber,nodedomain,err,error,*999)
1633  IF(nodedomain==mycomputationalnodenumber) THEN
1634  CALL field_parameter_set_get_node( field, variable_type, set_type, version_number, &
1635  & no_global_deriv, i, field_component_numbers(j), dvalue, err, error, *999 )
1636  ENDIF
1637 
1638  ENDIF
1639  ENDIF
1640  dbuffer( j ) = dvalue
1641  ENDDO
1642  fml_err = fieldml_writedoubleslab( writer, c_loc(offsets), c_loc(sizes), c_loc(dbuffer) )
1643  IF( fml_err /= fml_err_no_error ) THEN
1644  CALL flagerror( var_str("I/O error while writing nodal parameter values for ")//base_name//"("// &
1645  & trim(number_to_vstring(fml_err,"*",err,error)) //").", err, error, *999 )
1646  ENDIF
1647  offsets(1) = offsets(1) + 1
1648  ENDDO
1649  fml_err = fieldml_closewriter( writer )
1650  CALL fieldml_util_check_fieldml_error( "Cannot close nodal parameter writer for "//base_name//".dofs.node.data.", &
1651  & fieldml_info%FML_HANDLE, err, error, *999 )
1652  DEALLOCATE( dbuffer )
1653 
1654  DEALLOCATE( mesh_component_numbers )
1655  DEALLOCATE( is_node_based )
1656 
1657  exits( "FIELDML_OUTPUT_ADD_FIELD_NODE_DOFS" )
1658  RETURN
1659 999 errorsexits( "FIELDML_OUTPUT_ADD_FIELD_NODE_DOFS", err, error )
1660  RETURN 1
1661 
1662  END SUBROUTINE fieldml_output_add_field_node_dofs
1663 
1664  !
1665  !================================================================================================================================
1666  !
1667 
1669  SUBROUTINE fieldml_output_add_field_element_dofs( FIELDML_INFO, BASE_NAME, DOF_FORMAT, TYPE_HANDLE, FIELD, &
1670  & field_component_numbers, variable_type, set_type, element_dofs_handle, err, error, * )
1671  !Argument variables
1672  TYPE(fieldml_io_type), INTENT(IN) :: FIELDML_INFO
1673  TYPE(varying_string), INTENT(IN) :: BASE_NAME
1674  TYPE(varying_string), INTENT(IN) :: DOF_FORMAT
1675  INTEGER(INTG), INTENT(IN) :: TYPE_HANDLE
1676  TYPE(field_type), POINTER, INTENT(IN) :: FIELD
1677  INTEGER(INTG), INTENT(IN) :: FIELD_COMPONENT_NUMBERS(:)
1678  INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
1679  INTEGER(INTG), INTENT(IN) :: SET_TYPE
1680  INTEGER(INTG), INTENT(INOUT) :: ELEMENT_DOFS_HANDLE
1681  INTEGER(INTG), INTENT(OUT) :: ERR
1682  TYPE(varying_string), INTENT(OUT) :: ERROR
1683 
1684  !Locals
1685  INTEGER(INTG) :: TYPE_COMPONENT_HANDLE, REAL_1D_HANDLE, ELEMENT_COUNT, INDEX_HANDLE, RESOURCE_HANDLE, SOURCE_HANDLE
1686  INTEGER(INTG) :: COMPONENT_COUNT, I, J, INTERPOLATION_TYPE
1687  INTEGER(INTG), ALLOCATABLE :: MESH_COMPONENT_NUMBERS(:)
1688  INTEGER(INTG) :: WRITER, FML_ERR
1689  INTEGER(INTG), TARGET :: SIZES(2), OFFSETS(2)
1690  REAL(C_DOUBLE), ALLOCATABLE, TARGET :: DBUFFER(:)
1691  REAL(C_DOUBLE) :: DVALUE
1692  LOGICAL, ALLOCATABLE :: IS_ELEMENT_BASED(:)
1693  TYPE(varying_string) :: ARRAY_LOCATION
1694 
1695  exits( "FIELDML_OUTPUT_ADD_FIELD_ELEMENT_DOFS" )
1696 
1697  CALL fieldml_output_get_generic_type( fieldml_info%FML_HANDLE, 1, real_1d_handle, .true., err, error, *999 )
1698 
1699  component_count = fieldml_gettypecomponentcount( fieldml_info%FML_HANDLE, type_handle )
1700  type_component_handle = fieldml_gettypecomponentensemble( fieldml_info%FML_HANDLE, type_handle )
1701 
1702  element_count = fieldml_getmembercount( fieldml_info%FML_HANDLE, fieldml_info%ELEMENTS_HANDLE )
1703 
1704  ALLOCATE( mesh_component_numbers( component_count ), stat = err )
1705  IF( err /= 0 ) CALL flagerror( "Could not allocate mesh component number array.", err, error, *999 )
1706  ALLOCATE( is_element_based( component_count ), stat = err )
1707  IF( err /= 0 ) CALL flagerror( "Could not allocate element component array.", err, error, *999 )
1708 
1709  DO i = 1, component_count
1710  CALL field_component_mesh_component_get( field, variable_type, field_component_numbers(i), &
1711  & mesh_component_numbers(i), err, error, *999 )
1712  CALL field_component_interpolation_get( field, variable_type, field_component_numbers(i), interpolation_type, &
1713  & err, error, *999 )
1714 
1715  is_element_based( i ) = ( interpolation_type == field_element_based_interpolation )
1716  ENDDO
1717 
1718  resource_handle = fieldml_createhrefdataresource( fieldml_info%FML_HANDLE, cchar(base_name//".dofs.element.resource"), &
1719  & cchar( dof_format ), cchar(base_name//".dofs.element") )
1720  CALL fieldml_util_check_fieldml_error( "Cannot create element dofs data resource "//base_name//".dofs.element.resource.", &
1721  & fieldml_info%FML_HANDLE, err, error, *999 )
1722 
1723  element_dofs_handle = fieldml_createparameterevaluator( fieldml_info%FML_HANDLE, cchar(base_name//".dofs.element"), &
1724  & real_1d_handle )
1725  CALL fieldml_util_check_fieldml_error( "Cannot create element dofs parameter set "//base_name//".dofs.element.", &
1726  & fieldml_info%FML_HANDLE, err, error, *999 )
1727  fml_err = fieldml_setparameterdatadescription( fieldml_info%FML_HANDLE, element_dofs_handle, fml_data_description_dense_array )
1728  CALL fieldml_util_check_fieldml_error( "Cannot set element dofs parameter description for "//base_name//".dofs.element.", &
1729  & fieldml_info%FML_HANDLE, err, error, *999 )
1730 
1731  array_location = array_location//1
1732  source_handle = fieldml_createarraydatasource( fieldml_info%FML_HANDLE, cchar(base_name//".dofs.element.data"), &
1733  & resource_handle, cchar(array_location), 2 )
1734  sizes( 1 ) = element_count
1735  sizes( 2 ) = component_count
1736  fml_err = fieldml_setarraydatasourcerawsizes( fieldml_info%FML_HANDLE, source_handle, c_loc( sizes ) )
1737  fml_err = fieldml_setarraydatasourcesizes( fieldml_info%FML_HANDLE, source_handle, c_loc( sizes ) )
1738  CALL fieldml_util_check_fieldml_error( "Cannot create element dofs data source "//base_name//".dofs.element.data.", &
1739  & fieldml_info%FML_HANDLE, err, error, *999 )
1740 
1741  fml_err = fieldml_setdatasource( fieldml_info%FML_HANDLE, element_dofs_handle, source_handle )
1742  CALL fieldml_util_check_fieldml_error( "Cannot set nodal dofs data source for "//base_name//".dofs.element.", &
1743  & fieldml_info%FML_HANDLE, err, error, *999 )
1744 
1745  fml_err = fieldml_adddenseindexevaluator( fieldml_info%FML_HANDLE, element_dofs_handle, &
1746  & fieldml_info%ELEMENTS_ARGUMENT_HANDLE, fml_invalid_handle )
1747  CALL fieldml_util_check_fieldml_error( "Cannot add element index for element dofs parameter set "//base_name//".dofs.element."&
1748  & , fieldml_info%FML_HANDLE, err, error, *999 )
1749 
1750  IF( type_component_handle /= fml_invalid_handle ) THEN
1751  type_component_handle = fieldml_output_import_handle( fieldml_info%FML_HANDLE, type_component_handle, err, error )
1752  IF(err/=0) GOTO 999
1753  index_handle = fieldml_output_get_type_argument_handle( fieldml_info, type_component_handle, .true., err, error )
1754  IF(err/=0) GOTO 999
1755  fml_err = fieldml_adddenseindexevaluator( fieldml_info%FML_HANDLE, element_dofs_handle, type_component_handle, &
1756  & fml_invalid_handle )
1757  CALL fieldml_util_check_fieldml_error( "Cannot add component index for element dofs parameter set "//base_name//&
1758  & ".dofs.element.", fieldml_info%FML_HANDLE, err, error, *999 )
1759  ENDIF
1760 
1761  ALLOCATE( dbuffer( component_count ), stat = err )
1762  IF( err /= 0 ) CALL flagerror( "Could not allocate element dofs buffer.", err, error, *999 )
1763  writer = fieldml_openarraywriter( fieldml_info%FML_HANDLE, source_handle, real_1d_handle, 0, c_loc(sizes), 2 )
1764  CALL fieldml_util_check_fieldml_error( "Cannot open element parameter writer for "//base_name//".dofs.element.data.", &
1765  & fieldml_info%FML_HANDLE, err, error, *999 )
1766 
1767  offsets(:) = 0
1768  sizes(1) = 1
1769  sizes(2) = component_count
1770  DO i = 1, element_count
1771  DO j = 1, component_count
1772  dvalue = 0
1773  IF( is_element_based(j) ) THEN
1774  CALL field_parameter_set_get_element( field, variable_type, set_type, i, &
1775  & field_component_numbers(j), dvalue, err, error, *999 )
1776  ENDIF
1777  dbuffer( j ) = dvalue
1778  ENDDO
1779  fml_err = fieldml_writedoubleslab( writer, c_loc(offsets), c_loc(sizes), c_loc(dbuffer) )
1780  IF( fml_err /= fml_err_no_error ) THEN
1781  CALL flagerror( var_str("I/O error while writing element parameter values for")//base_name//"("&
1782  & // trim(number_to_vstring(fml_err,"*",err,error)) //").", err, error, *999 )
1783  ENDIF
1784  offsets(1) = offsets(1) + 1
1785  ENDDO
1786  fml_err = fieldml_closewriter( writer )
1787  CALL fieldml_util_check_fieldml_error( "Cannot close element parameter writer for "//base_name//".dofs.element.data", &
1788  & fieldml_info%FML_HANDLE, err, error, *999 )
1789  DEALLOCATE( dbuffer )
1790 
1791  DEALLOCATE( mesh_component_numbers )
1792  DEALLOCATE( is_element_based )
1793 
1794  exits( "FIELDML_OUTPUT_ADD_FIELD_ELEMENT_DOFS" )
1795  RETURN
1796 999 errorsexits( "FIELDML_OUTPUT_ADD_FIELD_ELEMENT_DOFS", err, error )
1797  RETURN 1
1798 
1799  END SUBROUTINE fieldml_output_add_field_element_dofs
1800 
1801  !
1802  !================================================================================================================================
1803  !
1804 
1806  SUBROUTINE fieldml_output_add_field_constant_dofs( FIELDML_INFO, BASE_NAME, DOF_FORMAT, TYPE_HANDLE, FIELD, &
1807  & field_component_numbers, variable_type, set_type, constant_dofs_handle, err, error, * )
1808  !Argument variables
1809  TYPE(fieldml_io_type), INTENT(IN) :: FIELDML_INFO
1810  TYPE(varying_string), INTENT(IN) :: BASE_NAME
1811  TYPE(varying_string), INTENT(IN) :: DOF_FORMAT
1812  INTEGER(INTG), INTENT(IN) :: TYPE_HANDLE
1813  TYPE(field_type), POINTER, INTENT(IN) :: FIELD
1814  INTEGER(INTG), INTENT(IN) :: FIELD_COMPONENT_NUMBERS(:)
1815  INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
1816  INTEGER(INTG), INTENT(IN) :: SET_TYPE
1817  INTEGER(INTG), INTENT(INOUT) :: CONSTANT_DOFS_HANDLE
1818  INTEGER(INTG), INTENT(OUT) :: ERR
1819  TYPE(varying_string), INTENT(OUT) :: ERROR
1820 
1821  !Locals
1822  INTEGER(INTG) :: DOFTYPE_HANDLE, TYPE_TYPE, COMPONENT_TYPE, DATA_TYPE, INDEX_HANDLE, RESOURCE_HANDLE, SOURCE_HANDLE
1823  INTEGER(INTG) :: COMPONENT_COUNT, I, J, INTERPOLATION_TYPE
1824  INTEGER(INTG), ALLOCATABLE :: MESH_COMPONENT_NUMBERS(:)
1825  INTEGER(INTG), TARGET :: OFFSETS(2), SINGLE_SIZE
1826  TYPE(varying_string) :: ARRAY_LOCATION
1827  INTEGER(INTG) :: WRITER, FML_ERR
1828  REAL(C_DOUBLE), ALLOCATABLE, TARGET :: DBUFFER(:)
1829  INTEGER(INTG), ALLOCATABLE, TARGET :: IBUFFER(:)
1830  REAL(C_DOUBLE) :: DVALUE
1831  INTEGER(INTG) :: IVALUE
1832  LOGICAL :: IS_REAL
1833  LOGICAL, ALLOCATABLE :: IS_CONSTANT(:)
1834 
1835  enters( "FIELDML_OUTPUT_ADD_FIELD_CONSTANT_DOFS", err, error, *999 )
1836 
1837  type_type = fieldml_getobjecttype( fieldml_info%FML_HANDLE, type_handle )
1838 
1839  IF( type_type == fht_ensemble_type ) THEN
1840  doftype_handle = type_handle
1841  component_count = 1
1842  component_type = fml_invalid_handle
1843  is_real = .false.
1844  ELSE
1845  CALL fieldml_output_get_generic_type( fieldml_info%FML_HANDLE, 1, doftype_handle, .true., err, error, *999 )
1846  component_count = fieldml_gettypecomponentcount( fieldml_info%FML_HANDLE, type_handle )
1847  component_type = fieldml_gettypecomponentensemble( fieldml_info%FML_HANDLE, type_handle )
1848  is_real = .true.
1849  ENDIF
1850 
1851  ALLOCATE( mesh_component_numbers( component_count ), stat = err )
1852  IF( err /= 0 ) CALL flagerror( "Could not allocate mesh component array.", err, error, *999 )
1853  ALLOCATE( is_constant( component_count ), stat = err )
1854  IF( err /= 0 ) CALL flagerror( "Could not allocate constant component array.", err, error, *999 )
1855 
1856  DO i = 1, component_count
1857  CALL field_component_mesh_component_get( field, variable_type, field_component_numbers(i), &
1858  & mesh_component_numbers(i), err, error, *999 )
1859  CALL field_component_interpolation_get( field, variable_type, field_component_numbers(i), interpolation_type, &
1860  & err, error, *999 )
1861 
1862  is_constant( i ) = ( interpolation_type == field_constant_interpolation )
1863  ENDDO
1864 
1865  resource_handle = fieldml_createhrefdataresource( fieldml_info%FML_HANDLE, cchar(base_name//".dofs.constant.resource"), &
1866  & cchar( dof_format ), cchar(base_name//".dofs.constant") )
1867  CALL fieldml_util_check_fieldml_error( "Cannot create constant dofs data resource "//base_name//".dofs.constant.resource.", &
1868  & fieldml_info%FML_HANDLE, err, error, *999 )
1869 
1870  constant_dofs_handle = fieldml_createparameterevaluator( fieldml_info%FML_HANDLE, cchar(base_name//".dofs.constant"), &
1871  & doftype_handle )
1872  CALL fieldml_util_check_fieldml_error( "Cannot create constant dofs parameter set "//base_name//".dofs.constant.", &
1873  & fieldml_info%FML_HANDLE, err, error, *999 )
1874  fml_err = fieldml_setparameterdatadescription( fieldml_info%FML_HANDLE, constant_dofs_handle, fml_data_description_dense_array )
1875  CALL fieldml_util_check_fieldml_error( "Cannot set constant dofs parameter description for "//base_name//".dofs.constant", &
1876  & fieldml_info%FML_HANDLE, err, error, *999 )
1877 
1878  array_location = array_location//1
1879  source_handle = fieldml_createarraydatasource( fieldml_info%FML_HANDLE, cchar(base_name//".dofs.element.data"), &
1880  & resource_handle, cchar(array_location), 1 )
1881  single_size = component_count
1882  fml_err = fieldml_setarraydatasourcerawsizes( fieldml_info%FML_HANDLE, source_handle, c_loc(single_size) )
1883  fml_err = fieldml_setarraydatasourcesizes( fieldml_info%FML_HANDLE, source_handle, c_loc(single_size) )
1884  CALL fieldml_util_check_fieldml_error( "Cannot create constant dofs data source "//base_name//".dofs.constant.data", &
1885  & fieldml_info%FML_HANDLE, err, error, *999 )
1886 
1887  fml_err = fieldml_setdatasource( fieldml_info%FML_HANDLE, constant_dofs_handle, source_handle )
1888  CALL fieldml_util_check_fieldml_error( "Cannot set nodal dofs data source for "//base_name//".dofs.constant", &
1889  & fieldml_info%FML_HANDLE, err, error, *999 )
1890 
1891  IF( component_type /= fml_invalid_handle ) THEN
1892  component_type = fieldml_output_import_handle( fieldml_info%FML_HANDLE, component_type, err, error )
1893  IF(err/=0) GOTO 999
1894  index_handle = fieldml_output_get_type_argument_handle( fieldml_info, component_type, .true., err, error )
1895  IF(err/=0) GOTO 999
1896  fml_err = fieldml_adddenseindexevaluator( fieldml_info%FML_HANDLE, constant_dofs_handle, index_handle, fml_invalid_handle )
1897  CALL fieldml_util_check_fieldml_error( "Cannot add component index for constant dofs parameter set "//base_name//&
1898  & ".dofs.constant", fieldml_info%FML_HANDLE, err, error, *999 )
1899  ENDIF
1900 
1901  writer = fieldml_openarraywriter( fieldml_info%FML_HANDLE, source_handle, doftype_handle, 0, c_loc(single_size), 1 )
1902  CALL fieldml_util_check_fieldml_error( "Cannot open constant parameter writer for "//base_name//".dofs.constant.data", &
1903  & fieldml_info%FML_HANDLE, err, error, *999 )
1904 
1905  CALL field_data_type_get( field, variable_type, data_type, err, error, *999 )
1906  IF( data_type == field_intg_type ) THEN
1907  is_real = .false.
1908  ELSEIF( data_type == field_dp_type ) THEN
1909  is_real = .true.
1910  ENDIF
1911 
1912  offsets(:) = 0
1913  single_size = component_count
1914  IF( is_real ) THEN
1915  ALLOCATE( dbuffer( component_count ), stat = err )
1916  IF( err /= 0 ) CALL flagerror( "Could not allocate constant dofs buffer.", err, error, *999 )
1917  DO j = 1, component_count
1918  dvalue = 0
1919  IF( is_constant(j) ) THEN
1920  CALL field_parameter_set_get_constant( field, variable_type, set_type, &
1921  & field_component_numbers(j), dvalue, err, error, *999 )
1922  ENDIF
1923  dbuffer( j ) = dvalue
1924  ENDDO
1925  fml_err = fieldml_writedoubleslab( writer, c_loc(offsets), c_loc(single_size), c_loc(dbuffer) )
1926  IF( fml_err /= fml_err_no_error ) THEN
1927  CALL flagerror( var_str("I/O error while writing constant parameter values for ")//base_name//"(" &
1928  & // trim(number_to_vstring(fml_err,"*",err,error)) //").", err, error, *999)
1929  ENDIF
1930  fml_err = fieldml_closewriter( writer )
1931  CALL fieldml_util_check_fieldml_error( "Cannot close constant parameter writer for "//base_name//".dofs.constant.data", &
1932  & fieldml_info%FML_HANDLE, err, error, *999 )
1933  DEALLOCATE( dbuffer )
1934  ELSE
1935  ALLOCATE( ibuffer( component_count ), stat = err )
1936  IF( err /= 0 ) CALL flagerror( "Could not allocate constant dofs buffer.", err, error, *999 )
1937  DO j = 1, component_count
1938  ivalue = 0
1939  IF( is_constant(j) ) THEN
1940  CALL field_parameter_set_get_constant( field, variable_type, set_type, &
1941  & field_component_numbers(j), ivalue, err, error, *999 )
1942  ENDIF
1943  ibuffer( j ) = ivalue
1944  ENDDO
1945  fml_err = fieldml_writeintslab( writer, c_loc(offsets), c_loc(single_size), c_loc(ibuffer) )
1946  IF( fml_err /= fml_err_no_error ) THEN
1947  CALL flagerror( var_str("I/O while writing constant parameter values for ")//base_name//"(" &
1948  & // trim(number_to_vstring(fml_err,"*",err,error)) //").", err, error, *999 )
1949  ENDIF
1950  fml_err = fieldml_closewriter( writer )
1951  CALL fieldml_util_check_fieldml_error( "Cannot close constant parameter writer for "//base_name//".dofs.constant.data", &
1952  & fieldml_info%FML_HANDLE, err, error, *999 )
1953  DEALLOCATE( ibuffer )
1954  ENDIF
1955 
1956  DEALLOCATE( mesh_component_numbers )
1957  DEALLOCATE( is_constant )
1958 
1959  exits( "FIELDML_OUTPUT_ADD_FIELD_CONSTANT_DOFS" )
1960  RETURN
1961 999 errorsexits( "FIELDML_OUTPUT_ADD_FIELD_CONSTANT_DOFS", err, error )
1962  RETURN 1
1963 
1964  END SUBROUTINE fieldml_output_add_field_constant_dofs
1965 
1966  !
1967  !================================================================================================================================
1968  !
1969 
1971  SUBROUTINE fieldml_output_initialise_info( MESH, LOCATION, BASE_NAME, CONNECTIVITY_FORMAT, FIELDML_INFO, ERR, ERROR, * )
1972  !Argument variables
1973  TYPE(mesh_type), POINTER, INTENT(IN) :: MESH
1974  TYPE(varying_string), INTENT(IN) :: LOCATION
1975  TYPE(varying_string), INTENT(IN) :: BASE_NAME
1976  TYPE(varying_string), INTENT(IN) :: CONNECTIVITY_FORMAT
1977  TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
1978  INTEGER(INTG), INTENT(OUT) :: ERR
1979  TYPE(varying_string), INTENT(OUT) :: ERROR
1980 
1981  !Locals
1982  TYPE(region_type), POINTER :: REGION
1983  INTEGER(INTG) :: COMPONENT_COUNT, I, NODE_COUNT, ELEMENT_COUNT, DIMENSIONS
1984  INTEGER(INTG) :: REAL_1D_HANDLE, XI_COMPONENT_HANDLE, FML_ERR, SHAPE_HANDLE
1985  TYPE(meshelementstype), POINTER :: MESH_ELEMENTS
1986  TYPE(basis_type), POINTER :: BASIS
1987  TYPE(nodes_type), POINTER :: NODES
1988  TYPE(varying_string) :: SHAPE_NAME
1989 
1990  enters( "FIELDML_OUTPUT_INITIALISE_INFO", err, error, *999 )
1991 
1992  region => mesh%REGION
1993 
1994  dimensions = mesh%NUMBER_OF_DIMENSIONS
1995 
1996  CALL fieldml_io_initialise( fieldml_info, .true., err, error, *999 )
1997 
1998  fieldml_info%FML_HANDLE = fieldml_create( cchar(location), cchar(base_name) )
1999  CALL fieldml_util_check_fieldml_error( "Cannot create fieldml handle for "//base_name//" at "//location//".", &
2000  & fieldml_info%FML_HANDLE, err, error, *999 )
2001 
2002  NULLIFY( nodes )
2003  CALL region_nodes_get( region, nodes, err, error, *999 )
2004  CALL nodes_number_of_nodes_get( nodes, node_count, err, error, *999 )
2005 
2006  fieldml_info%NODES_HANDLE = fieldml_createensembletype( fieldml_info%FML_HANDLE, cchar(base_name//".nodes") )
2007  CALL fieldml_util_check_fieldml_error( "Cannot create mesh nodes ensemble "//base_name//".nodes", &
2008  & fieldml_info%FML_HANDLE, err, error, *999 )
2009  fml_err = fieldml_setensemblemembersrange( fieldml_info%FML_HANDLE, fieldml_info%NODES_HANDLE, 1, node_count, 1 )
2010  CALL fieldml_util_check_fieldml_error( "Cannot set mesh nodes ensemble bounds for "//base_name//".nodes", &
2011  & fieldml_info%FML_HANDLE, err, error, *999 )
2012 
2013  fieldml_info%NODES_ARGUMENT_HANDLE = fieldml_createargumentevaluator( fieldml_info%FML_HANDLE, &
2014  & cchar(base_name//".nodes.argument"), fieldml_info%NODES_HANDLE )
2015  CALL fieldml_util_check_fieldml_error( "Cannot create mesh nodes variable "//base_name//".nodes.argument", &
2016  & fieldml_info%FML_HANDLE, err, error, *999 )
2017 
2018  CALL mesh_number_of_elements_get( mesh, element_count, err, error, *999 )
2019 
2020  fieldml_info%MESH_HANDLE = fieldml_createmeshtype( fieldml_info%FML_HANDLE, cchar(base_name//".mesh") )
2021  CALL fieldml_util_check_fieldml_error( "Cannot create mesh type "//base_name//".mesh", fieldml_info%FML_HANDLE, &
2022  & err, error, *999 )
2023 
2024  fieldml_info%ELEMENTS_HANDLE = fieldml_createmeshelementstype( fieldml_info%FML_HANDLE, fieldml_info%MESH_HANDLE, &
2025  & "element"//c_null_char )
2026  CALL fieldml_util_check_fieldml_error( "Cannot create mesh elements type for "//base_name//".mesh", &
2027  & fieldml_info%FML_HANDLE, err, error, *999 )
2028  fml_err = fieldml_setensemblemembersrange( fieldml_info%FML_HANDLE, fieldml_info%ELEMENTS_HANDLE, 1, element_count, 1 )
2029  CALL fieldml_util_check_fieldml_error( "Cannot set mesh type element count for "//base_name//".mesh", &
2030  & fieldml_info%FML_HANDLE, err, error, *999 )
2031 
2032  fieldml_info%XI_HANDLE = fieldml_createmeshcharttype( fieldml_info%FML_HANDLE, fieldml_info%MESH_HANDLE, "xi"//c_null_char )
2033  CALL fieldml_util_check_fieldml_error( "Cannot create mesh chart type for "//base_name//".mesh", &
2034  & fieldml_info%FML_HANDLE, err, error, *999 )
2035  xi_component_handle = fieldml_createcontinuoustypecomponents( fieldml_info%FML_HANDLE, fieldml_info%XI_HANDLE, &
2036  & cchar(base_name//".mesh.xi.component"), dimensions )
2037  CALL fieldml_util_check_fieldml_error( "Cannot create mesh chart components for "//base_name//".mesh", &
2038  & fieldml_info%FML_HANDLE, err, error, *999 )
2039 
2040  fml_err = fieldml_createargumentevaluator( fieldml_info%FML_HANDLE, cchar(base_name//".mesh.argument"), &
2041  & fieldml_info%MESH_HANDLE )
2042  CALL fieldml_util_check_fieldml_error( "Cannot create mesh variable "//base_name//".mesh.argument", &
2043  & fieldml_info%FML_HANDLE, err, error, *999 )
2044 
2045  fieldml_info%XI_ARGUMENT_HANDLE = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, cchar(base_name//".mesh.argument.xi") )
2046  CALL fieldml_util_check_fieldml_error( "Cannot get mesh xi variable for "//base_name//".mesh", &
2047  & fieldml_info%FML_HANDLE, err, error, *999 )
2048  fieldml_info%ELEMENTS_ARGUMENT_HANDLE = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, &
2049  & cchar(base_name//".mesh.argument.element") )
2050  CALL fieldml_util_check_fieldml_error( "Cannot get mesh element variable for "//base_name//".mesh", &
2051  & fieldml_info%FML_HANDLE, err, error, *999 )
2052 
2053  CALL fieldml_output_get_generic_type( fieldml_info%FML_HANDLE, 1, real_1d_handle, .true., err, error, *999 )
2054 
2055  !TODO Some of these may end up being unused. Should use deferred assignment.
2056  fieldml_info%NODE_DOFS_HANDLE = fieldml_createargumentevaluator( fieldml_info%FML_HANDLE, cchar(base_name//".dofs.node"), &
2057  & real_1d_handle )
2058  CALL fieldml_util_check_fieldml_error( "Cannot create nodal dofs variable "//base_name//".dofs.node", &
2059  & fieldml_info%FML_HANDLE, err, error, *999 )
2060 ! fieldmlInfo%elementDofsHandle = Fieldml_CreateArgumentEvaluator( fieldmlInfo%FML_HANDLE, cchar(baseName//".dofs.element"), &
2061 ! & real1DHandle )
2062 ! CALL FieldmlUtilCheckFieldmlError( "Cannot create element dofs variable "//".dofs.element", &
2063 ! & fieldmlInfo, err, errorString, *999 )
2064 ! fieldmlInfo%constantDofsHandle = Fieldml_CreateArgumentEvaluator( fieldmlInfo%FML_HANDLE, cchar(baseName//".dofs.constant"), &
2065 ! & real1DHandle )
2066 ! CALL FieldmlUtilCheckFieldmlError( "Cannot create constant dofs variable "//".dofs.constant", &
2067 ! & fieldmlInfo, err, errorString, *999 )
2068 
2069  CALL mesh_number_of_components_get( mesh, component_count, err, error, *999 )
2070  DO i = 1, component_count
2071  NULLIFY( mesh_elements )
2072  CALL list_item_add( fieldml_info%COMPONENT_HANDLES, fml_invalid_handle, err, error, *999 )
2073  CALL mesh_topology_elements_get( mesh, i, mesh_elements, err, error, *999 )
2074  CALL fieldml_output_add_mesh_component( fieldml_info, base_name, connectivity_format, i, mesh_elements, &
2075  & err, error, *999 )
2076  basis =>mesh_elements%ELEMENTS( 1 )%BASIS
2077  ENDDO
2078 
2079 
2080  !TODO Proper shape assignment.
2081  IF( dimensions == 1 ) THEN
2082  shape_name = "shape.unit.line"
2083  ELSE IF( dimensions == 2 ) THEN
2084  SELECT CASE(basis%TYPE)
2085  CASE(basis_simplex_type)
2086  shape_name = "shape.unit.triangle"
2087  CASE DEFAULT
2088  shape_name = "shape.unit.square"
2089  END SELECT
2090  ELSE
2091  SELECT CASE(basis%TYPE)
2092  CASE(basis_simplex_type)
2093  shape_name = "shape.unit.tetrahedron"
2094  CASE DEFAULT
2095  shape_name = "shape.unit.cube"
2096  END SELECT
2097  ENDIF
2098 
2099  shape_handle = fieldml_output_import( fieldml_info, shape_name, err, error )
2100 
2101  IF(err/=0) GOTO 999
2102  fml_err = fieldml_setmeshshapes( fieldml_info%FML_HANDLE, fieldml_info%MESH_HANDLE, shape_handle )
2103  CALL fieldml_util_check_fieldml_error( "Cannot set mesh type element shape.", fieldml_info%FML_HANDLE, err, error, *999 )
2104 
2105  exits( "FIELDML_OUTPUT_INITIALISE_INFO" )
2106  RETURN
2107 
2108 999 errorsexits( "FIELDML_OUTPUT_INITIALISE_INFO", err, error )
2109  RETURN 1
2110 
2111  END SUBROUTINE fieldml_output_initialise_info
2112 
2113  !
2114  !================================================================================================================================
2115  !
2116 
2118  SUBROUTINE fieldml_output_add_field_components( FIELDML_INFO, TYPE_HANDLE, BASE_NAME, DOF_FORMAT, FIELD, &
2119  & field_component_numbers, variable_type, set_type, err, error, * )
2120  !Argument variables
2121  TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
2122  INTEGER(INTG), INTENT(IN) :: TYPE_HANDLE
2123  TYPE(varying_string), INTENT(IN) :: BASE_NAME
2124  TYPE(varying_string), INTENT(IN) :: DOF_FORMAT
2125  TYPE(field_type), POINTER, INTENT(IN) :: FIELD
2126  INTEGER(INTG), INTENT(IN) :: FIELD_COMPONENT_NUMBERS(:)
2127  INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
2128  INTEGER(INTG), INTENT(IN) :: SET_TYPE
2129  INTEGER(INTG), INTENT(OUT) :: ERR
2130  TYPE(varying_string), INTENT(OUT) :: ERROR
2131 
2132  !Locals
2133  TYPE(mesh_type), POINTER :: MESH
2134  INTEGER(INTG) :: FIELD_HANDLE, COMPONENT_HANDLE, NODAL_DOFS_HANDLE, ELEMENT_DOFS_HANDLE, CONSTANT_DOFS_HANDLE, INDEX_HANDLE
2135  INTEGER(INTG) :: COMPONENT_COUNT, I, MESH_COMPONENT_NUMBER, INTERPOLATION_TYPE, FML_ERR, valueType
2136  INTEGER(INTG), ALLOCATABLE, TARGET :: COMPONENT_EVALUATORS(:)
2137 
2138  enters( "FIELDML_OUTPUT_ADD_FIELD_COMPONENTS", err, error, *999 )
2139 
2140  CALL fieldml_assert_is_out( fieldml_info, err, error, *999 )
2141 
2142  mesh => field%DECOMPOSITION%MESH
2143 
2144  component_handle = fieldml_gettypecomponentensemble( fieldml_info%FML_HANDLE, type_handle )
2145  component_count = fieldml_gettypecomponentcount( fieldml_info%FML_HANDLE, type_handle )
2146  ALLOCATE( component_evaluators( component_count ), stat = err )
2147  IF( err /= 0 ) CALL flagerror( "Could not allocate component evaluators array.", err, error, *999 )
2148 
2149  IF( SIZE( field_component_numbers ) /= component_count ) THEN
2150  CALL flagerror( var_str("Fieldml Component count ")//SIZE( field_component_numbers )//&
2151  & " must match value type component count "//component_count//".", err, error, *999 )
2152  ENDIF
2153 
2154  nodal_dofs_handle = fml_invalid_handle
2155  element_dofs_handle = fml_invalid_handle
2156  constant_dofs_handle = fml_invalid_handle
2157  !TODO Other types of interpolation not yet supported.
2158  DO i = 1, component_count
2159  CALL field_component_interpolation_get( field, variable_type, field_component_numbers(i), interpolation_type, &
2160  & err, error, *999 )
2161 
2162  IF( interpolation_type == field_node_based_interpolation ) THEN
2163  IF( nodal_dofs_handle == fml_invalid_handle ) THEN
2164  CALL fieldml_output_add_field_node_dofs( fieldml_info, base_name, dof_format, type_handle, field, &
2165  & field_component_numbers, variable_type, set_type, nodal_dofs_handle, err, error, *999 )
2166  ENDIF
2167  CALL field_component_mesh_component_get( field, variable_type, field_component_numbers(i), &
2168  & mesh_component_number, err, error, *999 )
2169  CALL list_item_get( fieldml_info%COMPONENT_HANDLES, mesh_component_number, component_evaluators( i ), &
2170  & err, error, *999 )
2171  ELSEIF( interpolation_type == field_element_based_interpolation ) THEN
2172  IF( element_dofs_handle == fml_invalid_handle ) THEN
2173  CALL fieldml_output_add_field_element_dofs( fieldml_info, base_name, dof_format, type_handle, field, &
2174  & field_component_numbers, variable_type, set_type, element_dofs_handle, err, error, *999 )
2175  ENDIF
2176  component_evaluators( i ) = element_dofs_handle
2177  ELSEIF( interpolation_type == field_constant_interpolation ) THEN
2178  IF( constant_dofs_handle == fml_invalid_handle ) THEN
2179  CALL fieldml_output_add_field_constant_dofs( fieldml_info, base_name, dof_format, type_handle, field, &
2180  & field_component_numbers, variable_type, set_type, constant_dofs_handle, err, error, *999 )
2181  ENDIF
2182  component_evaluators( i ) = constant_dofs_handle
2183  ENDIF
2184  ENDDO
2185 
2186  IF( component_handle /= fml_invalid_handle ) THEN
2187  field_handle = fieldml_createaggregateevaluator( fieldml_info%FML_HANDLE, cchar(base_name), type_handle )
2188  CALL fieldml_util_check_fieldml_error( "Cannot create field aggregate evaluator "//base_name, &
2189  & fieldml_info%FML_HANDLE, err, error, *999 )
2190  index_handle = fieldml_output_get_type_argument_handle( fieldml_info, component_handle, .true., err, error )
2191  IF(err/=0) GOTO 999
2192  fml_err = fieldml_setindexevaluator( fieldml_info%FML_HANDLE, field_handle, 1, index_handle )
2193  CALL fieldml_util_check_fieldml_error( "Cannot set index evaluator for aggregate evaluator "//base_name//".", &
2194  & fieldml_info%FML_HANDLE, err, error, *999 )
2195 
2196  DO i = 1, component_count
2197  fml_err = fieldml_setevaluator( fieldml_info%FML_HANDLE, field_handle, i, component_evaluators( i ) )
2198  CALL fieldml_util_check_fieldml_error( "Cannot set nodal evaluator for aggregate evaluator "//base_name//".", &
2199  & fieldml_info%FML_HANDLE, err, error, *999 )
2200  ENDDO
2201  ELSE
2202  valuetype = fieldml_getvaluetype( fieldml_info%FML_HANDLE, component_evaluators( 1 ) )
2203  field_handle = fieldml_createreferenceevaluator( fieldml_info%FML_HANDLE, cchar(base_name), component_evaluators( 1 ), &
2204  & valuetype)
2205  CALL fieldml_util_check_fieldml_error( "Cannot create reference evaluator for field "//base_name, &
2206  & fieldml_info%FML_HANDLE, err, error, *999 )
2207  ENDIF
2208 
2209  IF( nodal_dofs_handle /= fml_invalid_handle ) THEN
2210  fml_err = fieldml_setbind( fieldml_info%FML_HANDLE, field_handle, fieldml_info%NODE_DOFS_HANDLE, nodal_dofs_handle )
2211  CALL fieldml_util_check_fieldml_error( "Cannot set nodal dofs bind for field "//base_name//" with interpolated elements", &
2212  & fieldml_info%FML_HANDLE, err, error, *999 )
2213  ENDIF
2214 ! IF( elementDofsHandle /= FML_INVALID_HANDLE ) THEN
2215 ! fmlErr = Fieldml_SetBind( fieldmlInfo%FML_HANDLE, fieldHandle, fieldmlInfo%elementDofsHandle, elementDofsHandle )
2216 ! CALL FieldmlUtilCheckFieldmlError( "Cannot set element dofs bind for field with constant elements", fieldmlInfo, &
2217 ! &err, errorString, *999 )
2218 ! ENDIF
2219 ! IF( constantDofsHandle /= FML_INVALID_HANDLE ) THEN
2220 ! fmlErr = Fieldml_SetBind( fieldmlInfo%FML_HANDLE, fieldHandle, fieldmlInfo%constantDofsHandle, constantDofsHandle )
2221 ! CALL FieldmlUtilCheckFieldmlError( "Cannot set constant dofs bind for field with constant value", fieldmlInfo, &
2222 ! &err, errorString, *999 )
2223 ! ENDIF
2224 
2225 
2226  DEALLOCATE( component_evaluators )
2227  exits( "FIELDML_OUTPUT_ADD_FIELD_COMPONENTS" )
2228  RETURN
2229 999 DEALLOCATE( component_evaluators )
2230  errorsexits( "FIELDML_OUTPUT_ADD_FIELD_COMPONENTS", err, error )
2231  RETURN 1
2232 
2233  END SUBROUTINE fieldml_output_add_field_components
2234 
2235  !
2236  !================================================================================================================================
2237  !
2238 
2240  SUBROUTINE fieldml_output_add_field_no_type( FIELDML_INFO, BASE_NAME, DOF_FORMAT, FIELD, VARIABLE_TYPE, SET_TYPE, &
2241  & err, error, * )
2242  !Argument variables
2243  TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
2244  TYPE(varying_string), INTENT(IN) :: BASE_NAME
2245  TYPE(varying_string), INTENT(IN) :: DOF_FORMAT
2246  TYPE(field_type), POINTER, INTENT(IN) :: FIELD
2247  INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
2248  INTEGER(INTG), INTENT(IN) :: SET_TYPE
2249  INTEGER(INTG), INTENT(OUT) :: ERR
2250  TYPE(varying_string), INTENT(OUT) :: ERROR
2251 
2252  !Locals
2253  INTEGER(INTG) :: TYPE_HANDLE
2254 
2255  enters( "FIELDML_OUTPUT_ADD_FIELD_NO_TYPE", err, error, *999 )
2256 
2257  CALL fieldml_assert_is_out( fieldml_info, err, error, *999 )
2258 
2259  CALL fieldml_output_get_value_type( fieldml_info%FML_HANDLE, field, variable_type, .true., type_handle, err, error, *999 )
2260 
2261  CALL fieldml_output_add_field_with_type( fieldml_info, base_name, dof_format, field, variable_type, set_type, type_handle, &
2262  & err, error, *999 )
2263 
2264  exits( "FIELDML_OUTPUT_ADD_FIELD_NO_TYPE" )
2265  RETURN
2266 999 errorsexits( "FIELDML_OUTPUT_ADD_FIELD_NO_TYPE", err, error )
2267  RETURN 1
2268 
2269  END SUBROUTINE fieldml_output_add_field_no_type
2270 
2271  !
2272  !================================================================================================================================
2273  !
2274 
2276  SUBROUTINE fieldml_output_add_field_with_type( FIELDML_INFO, BASE_NAME, DOF_FORMAT, FIELD, VARIABLE_TYPE, SET_TYPE, &
2277  & type_handle, err, error, * )
2278  !Argument variables
2279  TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
2280  TYPE(varying_string), INTENT(IN) :: BASE_NAME
2281  TYPE(varying_string), INTENT(IN) :: DOF_FORMAT
2282  TYPE(field_type), POINTER, INTENT(IN) :: FIELD
2283  INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
2284  INTEGER(INTG), INTENT(IN) :: SET_TYPE
2285  INTEGER(INTG), INTENT(IN) :: TYPE_HANDLE
2286  INTEGER(INTG), INTENT(OUT) :: ERR
2287  TYPE(varying_string), INTENT(OUT) :: ERROR
2288 
2289  !Locals
2290  INTEGER(INTG) :: I, COMPONENT_COUNT
2291  INTEGER(INTG), ALLOCATABLE :: FIELD_COMPONENT_NUMBERS(:)
2292  TYPE(mesh_type), POINTER :: MESH
2293 
2294  enters( "FIELDML_OUTPUT_ADD_FIELD_WITH_TYPE", err, error, *999 )
2295 
2296  CALL fieldml_assert_is_out( fieldml_info, err, error, *999 )
2297 
2298  mesh => field%DECOMPOSITION%MESH
2299 
2300  IF( type_handle == fml_invalid_handle ) THEN
2301  CALL flagerror( var_str("Cannot get value type for field ")//base_name//".", err, error, *999 )
2302  ENDIF
2303 
2304  CALL field_number_of_components_get( field, variable_type, component_count, err, error, *999 )
2305 
2306  ALLOCATE( field_component_numbers( component_count ), stat = err )
2307  IF( err /= 0 ) CALL flagerror( "Could not allocate component numbers array.", err, error, *999 )
2308  DO i = 1, component_count
2309  field_component_numbers(i) = i
2310  ENDDO
2311 
2312  CALL fieldml_output_add_field_components( fieldml_info, type_handle, base_name, dof_format, field, field_component_numbers, &
2313  & variable_type, set_type, err, error, *999 )
2314 
2315  DEALLOCATE( field_component_numbers )
2316 
2317  exits( "FIELDML_OUTPUT_ADD_FIELD_WITH_TYPE" )
2318  RETURN
2319 999 errorsexits( "FIELDML_OUTPUT_ADD_FIELD_WITH_TYPE", err, error )
2320  RETURN 1
2321 
2322  END SUBROUTINE fieldml_output_add_field_with_type
2323 
2324  !
2325  !================================================================================================================================
2326  !
2327 
2329  SUBROUTINE fieldml_output_write( FIELDML_INFO, FILENAME, ERR, ERROR, * )
2330  !Argument variables
2331  TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
2332  TYPE(varying_string), INTENT(IN) :: FILENAME
2333  INTEGER(INTG), INTENT(OUT) :: ERR
2334  TYPE(varying_string), INTENT(OUT) :: ERROR
2335 
2336  !Locals
2337  INTEGER(INTG) :: FML_ERR
2338 
2339  enters( "FIELDML_OUTPUT_WRITE", err, error, *999 )
2340 
2341  CALL fieldml_assert_is_out( fieldml_info, err, error, *999 )
2342 
2343  fml_err = fieldml_writefile( fieldml_info%FML_HANDLE, cchar(filename) )
2344  CALL fieldml_util_check_fieldml_error( "Error writing fieldml file "//filename//".", fieldml_info%FML_HANDLE, &
2345  & err, error, *999 )
2346 
2347  exits( "FIELDML_OUTPUT_WRITE" )
2348  RETURN
2349 999 errorsexits( "FIELDML_OUTPUT_WRITE", err, error )
2350  RETURN 1
2351 
2352  END SUBROUTINE
2353 
2354  !
2355  !================================================================================================================================
2356  !
2357 
2358 END MODULE fieldml_output_routines
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
basis_routines::basis_xi_collapsed
integer(intg), parameter, public basis_xi_collapsed
The Xi direction is collapsed.
Definition: basis_routines.f90:146
basis_routines::basis_quadratic_lagrange_interpolation
integer(intg), parameter, public basis_quadratic_lagrange_interpolation
Quadratic Lagrange interpolation specification.
Definition: basis_routines.f90:83
coordinate_routines
This module contains all coordinate transformation and support routines.
Definition: coordinate_routines.f90:45
fieldml_output_routines::fieldml_output_get_type_argument_handle
integer(intg) function fieldml_output_get_type_argument_handle(FIELDML_INFO, TYPE_HANDLE, DO_IMPORT, ERR, ERROR)
Get the argument corresponding to the given type (named *.argument), importing it if needed...
Definition: fieldml_output_routines.f90:290
fieldml_output_routines::fieldml_output_import_fml
integer(intg) function fieldml_output_import_fml(FML_HANDLE, REMOTE_NAME, ERR, ERROR)
Import the named object from the built-in library into the current FieldML document. The local name will be the same as the remote name.
Definition: fieldml_output_routines.f90:162
types::region_type
Contains information for a region.
Definition: types.f90:3252
fieldml_output_routines::fieldml_output_write
subroutine, public fieldml_output_write(FIELDML_INFO, FILENAME, ERR, ERROR,)
Write the given FieldML document to the given file.
Definition: fieldml_output_routines.f90:2330
fieldml_output_routines::fieldml_output_import_handle
integer(intg) function fieldml_output_import_handle(FML_HANDLE, HANDLE, ERR, ERROR)
Import the given FieldML object if it is not already imported or local.
Definition: fieldml_output_routines.f90:246
constants::no_global_deriv
integer(intg), parameter no_global_deriv
No global derivative i.e., u.
Definition: constants.f90:213
strings::number_to_vstring
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
fieldml_output_routines::fieldmloutputgetsimplexbasisevaluator
subroutine fieldmloutputgetsimplexbasisevaluator(fmlHandle, xiInterpolations, evaluatorHandle, parametersHandle, err, error,)
Get an evaluator from the built-in library that corresponds to the given OpenCMISS simplex basis...
Definition: fieldml_output_routines.f90:633
region_routines
This module contains all region routines.
Definition: region_routines.f90:45
fieldml_util_routines::fieldml_util_check_fieldml_error
Definition: fieldml_util_routines.f90:70
basis_routines::basis_collapsed_at_xi0
integer(intg), parameter, public basis_collapsed_at_xi0
The Xi direction at the xi=0 end of this Xi direction is collapsed.
Definition: basis_routines.f90:147
fieldml_output_routines::basis_info_type
Definition: fieldml_output_routines.f90:78
fieldml_output_routines::fieldml_output_get_simple_basis_name
subroutine fieldml_output_get_simple_basis_name(FML_HANDLE, BASIS_HANDLE, NAME, ERR, ERROR,)
Returns the simplified name of the given basis. This is used for naming associated reference evaluato...
Definition: fieldml_output_routines.f90:1041
fieldml_types::fieldml_io_type
Contains information on the current FieldML parsing state.
Definition: fieldml_types.f90:59
iso_varying_string::cchar
Definition: iso_varying_string.f90:143
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
basis_routines::basis_quadratic_simplex_interpolation
integer(intg), parameter, public basis_quadratic_simplex_interpolation
Quadratic Simplex interpolation specification.
Definition: basis_routines.f90:89
basis_routines::basis_interpolation_xi_get
subroutine, public basis_interpolation_xi_get(BASIS, INTERPOLATION_XI, ERR, ERROR,)
Gets/changes the interpolation type in each xi directions for a basis identified by a pointer...
Definition: basis_routines.f90:1337
fieldml_util_routines
Utility routines for FieldML.
Definition: fieldml_util_routines.f90:46
fieldml_output_routines::fieldml_output_get_value_type
subroutine fieldml_output_get_value_type(FML_HANDLE, FIELD, VARIABLE_TYPE, DO_IMPORT, TYPE_HANDLE, ERR, ERROR,)
Returns a FieldML type appropriate for the given OpenCMISS field.
Definition: fieldml_output_routines.f90:486
basis_routines::basis_collapsed_xi_get
subroutine, public basis_collapsed_xi_get(BASIS, COLLAPSED_XI, ERR, ERROR,)
Gets the collapsed xi flags for a basis is identified by a a pointer.
Definition: basis_routines.f90:5620
basis_routines::basis_simplex_type
integer(intg), parameter, public basis_simplex_type
Simplex basis type.
Definition: basis_routines.f90:69
types::field_type
Contains information for a field defined on a region.
Definition: types.f90:1346
fieldml_output_routines::fieldml_output_add_import
integer(intg) function, public fieldml_output_add_import(FIELDML_INFO, REMOTE_NAME, ERR, ERROR)
Import the named object from the built-in library into the current FieldML document. The local name will be the same as the remote name.
Definition: fieldml_output_routines.f90:220
region_routines::region_nodes_get
subroutine, public region_nodes_get(REGION, NODES, ERR, ERROR,)
Returns a pointer to the nodes for a region.
Definition: region_routines.f90:679
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
fieldml_output_routines::fieldml_output_add_field_with_type
subroutine fieldml_output_add_field_with_type(FIELDML_INFO, BASE_NAME, DOF_FORMAT, FIELD, VARIABLE_TYPE, SET_TYPE, TYPE_HANDLE, ERR, ERROR,)
Add the given field to the given FieldML document using the given FieldML type.
Definition: fieldml_output_routines.f90:2278
fieldml_output_routines::fieldml_output_get_tp_basis_evaluator
subroutine fieldml_output_get_tp_basis_evaluator(FML_HANDLE, XI_INTERPOLATIONS, COLLAPSE_INFO, EVALUATOR_HANDLE, PARAMETERS_HANDLE, ERR, ERROR,)
Get an evaluator from the built-in library that corresponds to the given OpenCMISS tensor-product bas...
Definition: fieldml_output_routines.f90:538
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
basis_routines::basis_linear_simplex_interpolation
integer(intg), parameter, public basis_linear_simplex_interpolation
Linear Simplex interpolation specification.
Definition: basis_routines.f90:88
fieldml_output_routines::fieldml_output_get_tp_connectivity_type
subroutine fieldml_output_get_tp_connectivity_type(FIELDML_HANDLE, XI_INTERPOLATIONS, COLLAPSE_INFO, DO_IMPORT, TYPE_HANDLE, ERR, ERROR,)
Return the FieldML connectivity ensemble corresponding to the given tensor-product basis info...
Definition: fieldml_output_routines.f90:724
fieldml_output_routines::fieldml_output_get_coordinates_type
subroutine fieldml_output_get_coordinates_type(FIELDML_HANDLE, COORDS_TYPE, DIMENSIONS, DO_IMPORT, TYPE_HANDLE, ERR, ERROR,)
Get the FieldML built-in library type corresponding to the given OpenCMISS coordinate system type...
Definition: fieldml_output_routines.f90:344
constants::maxstrlen
integer(intg), parameter maxstrlen
Maximum string length fro character strings.
Definition: constants.f90:79
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
fieldml_output_routines::fieldml_output_get_connectivity_ensemble
subroutine fieldml_output_get_connectivity_ensemble(FIELDML_HANDLE, BASIS, TYPE_HANDLE, ERR, ERROR,)
Get the connectivity ensemble for the given basis. Currently, only tensor-product bases are supported...
Definition: fieldml_output_routines.f90:883
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
fieldml_output_routines::fieldml_output_import
integer(intg) function fieldml_output_import(FIELDML_INFO, REMOTE_NAME, ERR, ERROR)
Import the named object from the built-in library into the current FieldML document. The local name will be the same as the remote name.
Definition: fieldml_output_routines.f90:195
iso_varying_string::trim
Definition: iso_varying_string.f90:204
fieldml_output_routines::connectivity_info_type
Definition: fieldml_output_routines.f90:73
fieldml_types
Types for FieldML.
Definition: fieldml_types.f90:46
fieldml_output_routines::fieldmloutputgetsimplexconnectivitytype
subroutine fieldmloutputgetsimplexconnectivitytype(fieldmlHandle, xiInterpolations, doImport, typeHandle, err, error,)
Return the FieldML connectivity ensemble corresponding to the given simplex basis info...
Definition: fieldml_output_routines.f90:805
comp_environment
This module contains all computational environment variables.
Definition: computational_environment.f90:46
coordinate_routines::coordinate_system_type_get
subroutine, public coordinate_system_type_get(COORDINATE_SYSTEM, SYSTEM_TYPE, ERR, ERROR,)
Gets the coordinate system type.
Definition: coordinate_routines.f90:1323
fieldml_output_routines::fieldml_output_add_field
Definition: fieldml_output_routines.f90:85
iso_varying_string::var_str
Definition: iso_varying_string.f90:214
fieldml_output_routines::fieldml_output_get_generic_type
subroutine fieldml_output_get_generic_type(FIELDML_HANDLE, DIMENSIONS, TYPE_HANDLE, DO_IMPORT, ERR, ERROR,)
Returns a generic n-dimensional real type from the built-in library.
Definition: fieldml_output_routines.f90:396
fieldml_output_routines::fieldml_assert_is_out
subroutine fieldml_assert_is_out(FIELDML_INFO, ERR, ERROR,)
Asserts that the FieldML Info is associated and created for output.
Definition: fieldml_output_routines.f90:101
coordinate_routines::coordinate_rectangular_cartesian_type
integer(intg), parameter, public coordinate_rectangular_cartesian_type
Rectangular Cartesian coordinate system type.
Definition: coordinate_routines.f90:70
fieldml_util_routines::fieldml_io_initialise
subroutine, public fieldml_io_initialise(FIELDML_INFO, IS_OUT, ERR, ERROR,)
Definition: fieldml_util_routines.f90:141
fieldml_output_routines::fieldml_output_find_basis
integer(intg) function fieldml_output_find_basis(BASIS_INFO, BASIS, ERR, ERROR)
Returns the index of the basis handle used by the given basis info array, or -1 if none can be found...
Definition: fieldml_output_routines.f90:973
types::mesh_type
Contains information on a mesh defined on a region.
Definition: types.f90:503
fieldml_output_routines::fieldml_output_add_field_constant_dofs
subroutine fieldml_output_add_field_constant_dofs(FIELDML_INFO, BASE_NAME, DOF_FORMAT, TYPE_HANDLE, FIELD, FIELD_COMPONENT_NUMBERS, VARIABLE_TYPE, SET_TYPE, CONSTANT_DOFS_HANDLE, ERR, ERROR,)
Create a parameter evaluator and associated data source containing the globally constant dofs for the...
Definition: fieldml_output_routines.f90:1808
fieldml_output_routines::fieldml_output_add_field_node_dofs
subroutine fieldml_output_add_field_node_dofs(FIELDML_INFO, BASE_NAME, DOF_FORMAT, TYPE_HANDLE, FIELD, FIELD_COMPONENT_NUMBERS, VARIABLE_TYPE, SET_TYPE, NODE_DOFS_HANDLE, ERR, ERROR,)
Create a parameter evaluator and associated data source containing the nodal dofs for the given field...
Definition: fieldml_output_routines.f90:1507
fieldml_output_routines::fieldml_output_add_field_components
subroutine, public fieldml_output_add_field_components(FIELDML_INFO, TYPE_HANDLE, BASE_NAME, DOF_FORMAT, FIELD, FIELD_COMPONENT_NUMBERS, VARIABLE_TYPE, SET_TYPE, ERR, ERROR,)
Add the components of the given field to the given FieldML evaluator, creating component templates as...
Definition: fieldml_output_routines.f90:2120
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
fieldml_output_routines::fieldml_output_get_collapse_suffix
subroutine fieldml_output_get_collapse_suffix(COLLAPSE_INFO, SUFFIX, ERR, ERROR,)
Get the text suffix corresponding to the given array of collapse constants.
Definition: fieldml_output_routines.f90:127
basis_routines::basis_type_get
subroutine, public basis_type_get(BASIS, TYPE, ERR, ERROR,)
get the type for a basis is identified by a a pointer.
Definition: basis_routines.f90:5515
basis_routines::basis_collapsed_at_xi1
integer(intg), parameter, public basis_collapsed_at_xi1
The Xi direction at the xi=1 end of this Xi direction is collapsed.
Definition: basis_routines.f90:148
fieldml_output_routines::fieldml_output_find_layout
integer(intg) function fieldml_output_find_layout(CONNECTIVITY_INFO, LAYOUT_HANDLE, ERR, ERROR)
Returns the index of the layout handle used by the given connectivity info array, or -1 if none can b...
Definition: fieldml_output_routines.f90:940
lists::list_item_get
Returns an item in a list at a specififed position.
Definition: lists.f90:177
iso_varying_string::char
Definition: iso_varying_string.f90:138
basis_routines::basis_number_of_xi_get
subroutine, public basis_number_of_xi_get(BASIS, NUMBER_OF_XI, ERR, ERROR,)
Gets the number of xi directions for a basis.
Definition: basis_routines.f90:2638
types::nodes_type
Contains information on the nodes defined on a region.
Definition: types.f90:359
fieldml_output_routines::fieldml_output_create_layout_parameters
subroutine fieldml_output_create_layout_parameters(FIELDML_INFO, LAYOUT_HANDLE, COMPONENT_NAME, CONNECTIVITY_INFO, ERR, ERROR,)
Create a parameter evaluator for the given local node layout.
Definition: fieldml_output_routines.f90:1245
lists::list_item_set
Sets an item in the list.
Definition: lists.f90:157
fieldml_output_routines::fieldml_output_get_xi_type
subroutine fieldml_output_get_xi_type(FIELDML_HANDLE, DIMENSIONS, DO_IMPORT, TYPE_HANDLE, ERR, ERROR,)
Returns a type in the built-in library corresponding to a chart of the given dimensionality.
Definition: fieldml_output_routines.f90:441
iso_varying_string::index
Definition: iso_varying_string.f90:156
lists::list_item_add
Adds an item to the end of a list.
Definition: lists.f90:133
fieldml_output_routines
Output routines for FieldML.
Definition: fieldml_output_routines.f90:46
fieldml_output_routines::fieldml_output_add_field_no_type
subroutine fieldml_output_add_field_no_type(FIELDML_INFO, BASE_NAME, DOF_FORMAT, FIELD, VARIABLE_TYPE, SET_TYPE, ERR, ERROR,)
Add the given field to the given FieldML document. The field&#39;s type will be determined by FieldmlUtil...
Definition: fieldml_output_routines.f90:2242
lists
Implements lists of base types.
Definition: lists.f90:46
types::basis_type
Contains all information about a basis .
Definition: types.f90:184
base_routines::flag_error
Flags an error condition.
Definition: base_routines.f90:226
fieldml_output_routines::fieldml_output_add_field_element_dofs
subroutine fieldml_output_add_field_element_dofs(FIELDML_INFO, BASE_NAME, DOF_FORMAT, TYPE_HANDLE, FIELD, FIELD_COMPONENT_NUMBERS, VARIABLE_TYPE, SET_TYPE, ELEMENT_DOFS_HANDLE, ERR, ERROR,)
Create a parameter evaluator and associated data source containing the element dofs for the given fie...
Definition: fieldml_output_routines.f90:1671
fieldml_output_routines::fieldml_output_create_basis_reference
subroutine fieldml_output_create_basis_reference(FIELDML_INFO, BASE_NAME, BASIS_INFO, ERR, ERROR,)
Create a basis evaluator from the given basis info.
Definition: fieldml_output_routines.f90:1080
fieldml_output_routines::fieldml_output_get_simple_layout_name
subroutine fieldml_output_get_simple_layout_name(FML_HANDLE, LAYOUT_HANDLE, NAME, ERR, ERROR,)
Returns the simplified name of the given layout. This is used for naming associated connectivity eval...
Definition: fieldml_output_routines.f90:1006
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
region_routines::region_coordinate_system_get
subroutine, public region_coordinate_system_get(REGION, COORDINATE_SYSTEM, ERR, ERROR,)
Returns the coordinate system of region.
Definition: region_routines.f90:115
basis_routines::basis_linear_lagrange_interpolation
integer(intg), parameter, public basis_linear_lagrange_interpolation
Linear Lagrange interpolation specification.
Definition: basis_routines.f90:82
fieldml_output_routines::fieldml_output_add_mesh_component
subroutine fieldml_output_add_mesh_component(FIELDML_INFO, BASE_NAME, CONNECTIVITY_FORMAT, COMPONENT_NUMBER, MESH_ELEMENTS, ERR, ERROR,)
Add an evaluator corresponding to the given component of the given OpenCMISS mesh.
Definition: fieldml_output_routines.f90:1300
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
types::meshelementstype
Contains the information for the elements of a mesh.
Definition: types.f90:403
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
fieldml_output_routines::fieldml_output_initialise_info
subroutine, public fieldml_output_initialise_info(MESH, LOCATION, BASE_NAME, CONNECTIVITY_FORMAT, FIELDML_INFO, ERR, ERROR,)
Initialize the given FieldML parsing state for use with the given mesh.
Definition: fieldml_output_routines.f90:1972