OpenCMISS-Iron Internal API Documentation
fieldml_input_routines.f90
Go to the documentation of this file.
1 
43 
45 
47 
48  USE base_routines
49  USE basis_routines
50  USE cmiss
51  USE constants
54  USE field_routines
55  USE fieldml_api
56  USE fieldml_types
58  USE input_output
59  USE lists
60  USE mesh_routines
61  USE node_routines
62  USE region_routines
63  USE strings
64 
65 #include "macros.h"
66 
67  IMPLICIT NONE
68 
69  PRIVATE
70 
71  !Interfaces
72 
73  INTERFACE
74 
75  END INTERFACE
76 
80 
81 CONTAINS
82 
83  !
84  !================================================================================================================================
85  !
86 
88  SUBROUTINE fieldml_assert_is_in( FIELDML_INFO, ERR, ERROR, * )
89  !Argument variables
90  TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
91  INTEGER(INTG), INTENT(OUT) :: ERR
92  TYPE(varying_string), INTENT(OUT) :: ERROR
93 
94  enters( "FIELDML_ASSERT_IS_IN", err, error, *999 )
95 
96  IF(.NOT.ASSOCIATED(fieldml_info)) THEN
97  CALL flagerror( "FieldML Info is not associated.", err, error, *999 )
98  ELSE IF( fieldml_info%IS_OUT ) THEN
99  CALL flagerror( "Outbound FieldML Info used for an input-only operation.", err, error, *999 )
100  ENDIF
101 
102  exits( "FIELDML_ASSERT_IS_IN" )
103  RETURN
104 999 errorsexits( "FIELDML_ASSERT_IS_IN", err, error )
105  RETURN 1
106 
107  END SUBROUTINE fieldml_assert_is_in
108 
109  !
110  !================================================================================================================================
111  !
112 
114  SUBROUTINE fieldml_input_get_basis_connectivity_info( FIELDML_INFO, BASIS_HANDLE, PARAM_ARG_HANDLE, CONNECTIVITY_HANDLE, &
115  & layout_handle, err, error, * )
116  !Argument variables
117  TYPE(fieldml_io_type), INTENT(IN) :: FIELDML_INFO
118  INTEGER(INTG), INTENT(IN) :: BASIS_HANDLE
119  INTEGER(INTG), INTENT(IN) :: PARAM_ARG_HANDLE
120  INTEGER(INTG), INTENT(OUT) :: CONNECTIVITY_HANDLE
121  INTEGER(INTG), INTENT(OUT) :: LAYOUT_HANDLE
122  INTEGER(INTG), INTENT(OUT) :: ERR
123  TYPE(varying_string), INTENT(OUT) :: ERROR
124 
125  !Local variables
126  INTEGER(INTG) :: COUNT, BIND_NUMBER, PARAMS_HANDLE, ARG_HANDLE, LAYOUT_INDEX_HANDLE
127 
128  enters( "FIELDML_INPUT_GET_BASIS_CONNECTIVITY_INFO", err, error, *999 )
129 
130  count = fieldml_getbindcount( fieldml_info%FML_HANDLE, basis_handle )
131  IF( count /= 2 ) THEN
132  CALL flagerror( "Library basis evaluators must have exactly two binds.", err, error, *999 )
133  END IF
134 
135  params_handle = fml_invalid_handle
136  DO bind_number = 1, count
137  arg_handle = fieldml_getbindargument( fieldml_info%FML_HANDLE, basis_handle, bind_number )
138  CALL fieldml_util_check_fieldml_error( "Cannot get bind for interpolator.", fieldml_info%FML_HANDLE, err, error, *999 )
139  IF( arg_handle == param_arg_handle ) THEN
140  params_handle = fieldml_getbindevaluator( fieldml_info%FML_HANDLE, basis_handle, bind_number )
141  ENDIF
142  ENDDO
143 
144  IF( params_handle == fml_invalid_handle ) THEN
145  CALL flagerror( "Library interpolators must have a correct parameter bind.", err, error, *999 )
146  ENDIF
147 
148  IF( fieldml_getobjecttype( fieldml_info%FML_HANDLE, params_handle ) /= fht_aggregate_evaluator ) THEN
149  CALL flagerror( "Parameter evaluator for interpolator must be an aggregate.", err, error, *999 )
150  ENDIF
151 
152  count = fieldml_getbindcount( fieldml_info%FML_HANDLE, params_handle )
153  IF( count /= 1 ) THEN
154  CALL flagerror( "Nodal parameter evaluator must only have one bind.", err, error, *999 )
155  ENDIF
156 
157  IF( fieldml_getbindargument( fieldml_info%FML_HANDLE, params_handle, 1 ) /= fieldml_info%NODES_ARGUMENT_HANDLE ) THEN
158  CALL flagerror( "Nodal parameter evaluator must bind the nodes argument.", err, error, *999 )
159  ENDIF
160 
161  connectivity_handle = fieldml_getbindevaluator( fieldml_info%FML_HANDLE, params_handle, 1 )
162  CALL fieldml_util_check_fieldml_error( "Cannot get connectivity source for nodal parameters.", fieldml_info%FML_HANDLE, &
163  & err, error, *999 )
164 
165  layout_index_handle = fieldml_getindexevaluator( fieldml_info%FML_HANDLE, params_handle, 1 )
166  layout_handle = fieldml_getvaluetype( fieldml_info%FML_HANDLE, layout_index_handle )
167  CALL fieldml_util_check_fieldml_error( "Cannot get connectivity source for nodal parameters.", fieldml_info%FML_HANDLE, &
168  & err, error, *999 )
169 
170  exits( "FIELDML_INPUT_GET_BASIS_CONNECTIVITY_INFO" )
171  RETURN
172 999 errorsexits( "FIELDML_INPUT_GET_BASIS_CONNECTIVITY_INFO", err, error )
173  RETURN 1
174 
176 
177  !
178  !================================================================================================================================
179  !
180 
182  SUBROUTINE fieldml_input_get_basis_collapse( NAME, COLLAPSE, ERR, ERROR, * )
183  !Argument variables
184  TYPE(varying_string), INTENT(IN) :: NAME
185  INTEGER(INTG), ALLOCATABLE, INTENT(INOUT) :: COLLAPSE(:)
186  INTEGER(INTG), INTENT(OUT) :: ERR
187  TYPE(varying_string), INTENT(OUT) :: ERROR
188 
189  enters( "FIELDML_INPUT_GET_BASIS_COLLAPSE", err, error, *999 )
190 
191  collapse = basis_not_collapsed
192 
193  IF( SIZE( collapse ) > 0 ) THEN
194  IF( index( name, "_xi1C" ) /= 0 ) THEN
195  collapse(1) = basis_xi_collapsed
196  ELSE IF( index( name, "_xi10" ) /= 0 ) THEN
197  collapse(1) = basis_collapsed_at_xi0
198  ELSE IF( index( name, "_xi11" ) /= 0 ) THEN
199  collapse(1) = basis_collapsed_at_xi1
200  ENDIF
201  ENDIF
202 
203  IF( SIZE( collapse ) > 1 ) THEN
204  IF( index( name, "_xi2C" ) /= 0 ) THEN
205  collapse(2) = basis_xi_collapsed
206  ELSE IF( index( name, "_xi20" ) /= 0 ) THEN
207  collapse(2) = basis_collapsed_at_xi0
208  ELSE IF( index( name, "_xi21" ) /= 0 ) THEN
209  collapse(2) = basis_collapsed_at_xi1
210  ENDIF
211  ENDIF
212 
213  IF( SIZE( collapse ) > 2 ) THEN
214  IF( index( name, "_xi3C" ) /= 0 ) THEN
215  collapse(3) = basis_xi_collapsed
216  ELSE IF( index( name, "_xi30" ) /= 0 ) THEN
217  collapse(3) = basis_collapsed_at_xi0
218  ELSE IF( index( name, "_xi31" ) /= 0 ) THEN
219  collapse(3) = basis_collapsed_at_xi1
220  ENDIF
221  ENDIF
222 
223  exits( "FIELDML_INPUT_GET_BASIS_COLLAPSE" )
224  RETURN
225 999 errorsexits( "FIELDML_INPUT_GET_BASIS_COLLAPSE", err, error )
226  RETURN 1
227 
228  END SUBROUTINE fieldml_input_get_basis_collapse
229 
230  !
231  !================================================================================================================================
232  !
233 
235  SUBROUTINE fieldml_input_get_basis_info( FIELDML_INFO, BASIS_HANDLE, CONNECTIVITY_HANDLE, LAYOUT_HANDLE, BASISTYPE, &
236  & basis_interpolations, collapse, err, error, * )
237  !Argument variables
238  TYPE(fieldml_io_type), INTENT(IN) :: FIELDML_INFO
239  INTEGER(INTG), INTENT(IN) :: BASIS_HANDLE
240  INTEGER(INTG), INTENT(OUT) :: CONNECTIVITY_HANDLE
241  INTEGER(INTG), INTENT(OUT) :: LAYOUT_HANDLE
242  INTEGER(INTG), INTENT(OUT) :: BASISTYPE
243  INTEGER(INTG), ALLOCATABLE, INTENT(OUT) :: BASIS_INTERPOLATIONS(:)
244  INTEGER(INTG), ALLOCATABLE, INTENT(OUT) :: COLLAPSE(:)
245  INTEGER(INTG), INTENT(OUT) :: ERR
246  TYPE(varying_string), INTENT(OUT) :: ERROR
247 
248  !Locals
249  INTEGER(INTG) :: LENGTH, LIBRARY_BASIS_HANDLE, PARAM_ARG_HANDLE
250  CHARACTER(LEN=MAXSTRLEN) :: NAME
251  TYPE(varying_string) :: COLLAPSE_NAME
252 
253  enters( "FIELDML_INPUT_GET_BASIS_INFO", err, error, *999 )
254 
255  IF( .NOT. fieldml_input_is_known_basis( fieldml_info, basis_handle, err, error ) ) THEN
256  CALL flagerror( "Basis specified in FieldML file is not yet supported.", err, error, *999 )
257  ENDIF
258  IF(err/=0) GOTO 999
259 
260  IF( fieldml_getobjecttype( fieldml_info%FML_HANDLE, basis_handle ) /= fht_reference_evaluator ) THEN
261  CALL flagerror( "Basis evaluator must be a continuous reference.", err, error, *999 )
262  ENDIF
263 
264  library_basis_handle = fieldml_getreferencesourceevaluator( fieldml_info%FML_HANDLE, basis_handle )
265  CALL fieldml_util_check_fieldml_error( "Basis specified in FieldML is not a reference evaluator.", fieldml_info%FML_HANDLE, &
266  & err, error, *999 )
267  length = fieldml_copyobjectdeclaredname( fieldml_info%FML_HANDLE, library_basis_handle, name, maxstrlen )
268  CALL fieldml_util_check_fieldml_error( "Cannot get name of basis evaluator.", fieldml_info%FML_HANDLE, err, error, *999 )
269 
270  IF( index( name, 'interpolator.3d.unit.triquadraticLagrange') == 1 ) THEN
271  param_arg_handle = fieldml_getobjectbydeclaredname( fieldml_info%FML_HANDLE, &
272  & "parameters.3d.unit.triquadraticLagrange.argument"//c_null_char )
273  ALLOCATE( basis_interpolations(3), stat = err )
274  IF( err /= 0 ) CALL flagerror( "Could not allocate interpolation array.", err, error, *999 )
275  ALLOCATE( collapse(3), stat = err )
276  IF( err /= 0 ) CALL flagerror( "Could not allocate collapse array.", err, error, *999 )
277  basis_interpolations = basis_quadratic_lagrange_interpolation
279  ELSE IF( index( name, 'interpolator.3d.unit.trilinearLagrange') == 1 ) THEN
280  param_arg_handle = fieldml_getobjectbydeclaredname( fieldml_info%FML_HANDLE, &
281  & "parameters.3d.unit.trilinearLagrange.argument"//c_null_char )
282  ALLOCATE( basis_interpolations(3), stat = err )
283  IF( err /= 0 ) CALL flagerror( "Could not allocate interpolation array.", err, error, *999 )
284  ALLOCATE( collapse(3), stat = err )
285  IF( err /= 0 ) CALL flagerror( "Could not allocate collapse array.", err, error, *999 )
286  basis_interpolations = basis_linear_lagrange_interpolation
288  ELSE IF( index( name, 'interpolator.2d.unit.biquadraticLagrange') == 1 ) THEN
289  param_arg_handle = fieldml_getobjectbydeclaredname( fieldml_info%FML_HANDLE, &
290  & "parameters.2d.unit.biquadraticLagrange.argument"//c_null_char )
291  ALLOCATE( basis_interpolations(2), stat = err )
292  IF( err /= 0 ) CALL flagerror( "Could not allocate interpolation array.", err, error, *999 )
293  ALLOCATE( collapse(2), stat = err )
294  IF( err /= 0 ) CALL flagerror( "Could not allocate collapse array.", err, error, *999 )
295  basis_interpolations = basis_quadratic_lagrange_interpolation
297  ELSE IF( index( name, 'interpolator.2d.unit.bilinearLagrange') == 1 ) THEN
298  param_arg_handle = fieldml_getobjectbydeclaredname( fieldml_info%FML_HANDLE, &
299  & "parameters.2d.unit.bilinearLagrange.argument"//c_null_char )
300  ALLOCATE( basis_interpolations(2), stat = err )
301  IF( err /= 0 ) CALL flagerror( "Could not allocate interpolation array.", err, error, *999 )
302  ALLOCATE( collapse(2), stat = err )
303  IF( err /= 0 ) CALL flagerror( "Could not allocate collapse array.", err, error, *999 )
304  basis_interpolations = basis_linear_lagrange_interpolation
306  ELSE IF( index( name, 'interpolator.1d.unit.linearLagrange') == 1 ) THEN
307  param_arg_handle = fieldml_getobjectbydeclaredname( fieldml_info%FML_HANDLE, &
308  & "parameters.1d.unit.linearLagrange.argument"//c_null_char )
309  ALLOCATE( basis_interpolations(1), stat = err )
310  IF( err /= 0 ) CALL flagerror( "Could not allocate interpolation array.", err, error, *999 )
311  ALLOCATE( collapse(1), stat = err )
312  IF( err /= 0 ) CALL flagerror( "Could not allocate collapse array.", err, error, *999 )
313  basis_interpolations = basis_linear_lagrange_interpolation
315  ELSE IF( index( name, 'interpolator.2d.unit.bilinearSimplex') == 1 ) THEN
316  param_arg_handle = fieldml_getobjectbydeclaredname( fieldml_info%FML_HANDLE, &
317  & "parameters.2d.unit.bilinearSimplex.argument"//c_null_char )
318  ALLOCATE( basis_interpolations(2), stat = err )
319  IF( err /= 0 ) CALL flagerror( "Could not allocate interpolation array.", err, error, *999 )
320  basis_interpolations = basis_linear_simplex_interpolation
321  basistype = basis_simplex_type
322  ELSE IF( index( name, 'interpolator.2d.unit.biquadraticSimplex') == 1 ) THEN
323  param_arg_handle = fieldml_getobjectbydeclaredname( fieldml_info%FML_HANDLE, &
324  & "parameters.2d.unit.biquadraticSimplex.argument"//c_null_char )
325  ALLOCATE( basis_interpolations(2), stat = err )
326  IF( err /= 0 ) CALL flagerror( "Could not allocate interpolation array.", err, error, *999 )
327  basis_interpolations = basis_quadratic_simplex_interpolation
328  basistype = basis_simplex_type
329  ELSE IF( index( name, 'interpolator.3d.unit.trilinearSimplex') == 1 ) THEN
330  param_arg_handle = fieldml_getobjectbydeclaredname( fieldml_info%FML_HANDLE, &
331  & "parameters.3d.unit.trilinearSimplex.argument"//c_null_char )
332  ALLOCATE( basis_interpolations(3), stat = err )
333  IF( err /= 0 ) CALL flagerror( "Could not allocate interpolation array.", err, error, *999 )
334  basis_interpolations = basis_linear_simplex_interpolation
335  basistype = basis_simplex_type
336  ELSE IF( index( name, 'interpolator.3d.unit.triquadraticSimplex') == 1 ) THEN
337  param_arg_handle = fieldml_getobjectbydeclaredname( fieldml_info%FML_HANDLE, &
338  & "parameters.3d.unit.triquadraticSimplex.argument"//c_null_char )
339  ALLOCATE( basis_interpolations(3), stat = err )
340  IF( err /= 0 ) CALL flagerror( "Could not allocate interpolation array.", err, error, *999 )
341  basis_interpolations = basis_quadratic_simplex_interpolation
342  basistype = basis_simplex_type
343  ELSE
344  CALL flagerror( "Basis "//name(1:length)//" cannot yet be interpreted.", err, error, *999 )
345  ENDIF
346 
347  IF( basistype == basis_lagrange_hermite_tp_type ) THEN
348  collapse_name = name(1:length)
349  CALL fieldml_input_get_basis_collapse( collapse_name, collapse, err, error, *999 )
350  ENDIF
351 
352  CALL fieldml_input_get_basis_connectivity_info( fieldml_info, basis_handle, param_arg_handle, connectivity_handle, &
353  & layout_handle, err, error, *999 )
354 
355  enters( "FIELDML_INPUT_GET_BASIS_INFO", err, error, *999 )
356  exits( "FIELDML_INPUT_GET_BASIS_INFO" )
357  RETURN
358 999 errorsexits( "FIELDML_INPUT_GET_BASIS_INFO", err, error )
359  RETURN 1
360 
361  END SUBROUTINE fieldml_input_get_basis_info
362 
363  !
364  !================================================================================================================================
365  !
366 
368  FUNCTION fieldml_input_is_known_basis( FIELDML_INFO, BASIS_HANDLE, ERR, ERROR )
369  !Argument variables
370  TYPE(fieldml_io_type), INTENT(IN) :: FIELDML_INFO
371  INTEGER(INTG), INTENT(IN) :: BASIS_HANDLE
372  INTEGER(INTG), INTENT(OUT) :: ERR
373  TYPE(varying_string), INTENT(OUT) :: ERROR
374 
375  !Function
376  LOGICAL :: FIELDML_INPUT_IS_KNOWN_BASIS
377 
378  !Locals
379  INTEGER(INTG) :: LENGTH, LIBRARY_BASIS_HANDLE
380  CHARACTER(LEN=MAXSTRLEN) :: NAME
381 
382  enters( "FIELDML_INPUT_IS_KNOWN_BASIS", err, error, *999 )
383 
384  IF( fieldml_getobjecttype( fieldml_info%FML_HANDLE, basis_handle ) /= fht_reference_evaluator ) THEN
385  fieldml_input_is_known_basis = .false.
386  exits( "FIELDML_INPUT_IS_KNOWN_BASIS" )
387  RETURN
388  ENDIF
389 
390  library_basis_handle = fieldml_getreferencesourceevaluator( fieldml_info%FML_HANDLE, basis_handle )
391  length = fieldml_copyobjectdeclaredname( fieldml_info%FML_HANDLE, library_basis_handle, name, maxstrlen )
392 
393  IF( ( index( name, 'interpolator.3d.unit.triquadraticLagrange') /= 1 ) .AND. &
394  & ( index( name, 'interpolator.1d.unit.linearLagrange') /= 1 ) .AND. &
395  & ( index( name, 'interpolator.2d.unit.biquadraticLagrange') /= 1 ) .AND. &
396  & ( index( name, 'interpolator.2d.unit.bilinearLagrange') /= 1 ) .AND. &
397  & ( index( name, 'interpolator.3d.unit.trilinearLagrange') /= 1 ) .AND. &
398  & ( index( name, 'interpolator.2d.unit.bilinearSimplex') /= 1 ) .AND. &
399  & ( index( name, 'interpolator.2d.unit.biquadraticSimplex') /= 1 ) .AND. &
400  & ( index( name, 'interpolator.3d.unit.trilinearSimplex') /= 1 ) .AND. &
401  & ( index( name, 'interpolator.3d.unit.triquadraticSimplex') /= 1 ) ) THEN
402  fieldml_input_is_known_basis = .false.
403  ELSE
404  fieldml_input_is_known_basis = .true.
405  ENDIF
406 
407  exits( "FIELDML_INPUT_IS_KNOWN_BASIS" )
408  RETURN
409 999 errorsexits( "FIELDML_INPUT_IS_KNOWN_BASIS", err, error )
410 
411  END FUNCTION fieldml_input_is_known_basis
412 
413  !
414  !================================================================================================================================
415  !
416 
418  FUNCTION fieldml_input_is_template_compatible( FIELDML_INFO, COMPONENT_HANDLE, ELEMENT_TYPE, ERR, ERROR )
419  TYPE(fieldml_io_type), INTENT(IN) :: FIELDML_INFO
420  INTEGER(INTG), INTENT(IN) :: COMPONENT_HANDLE
421  INTEGER(INTG), INTENT(IN) :: ELEMENT_TYPE
422  INTEGER(INTG), INTENT(OUT) :: ERR
423  TYPE(varying_string), INTENT(OUT) :: ERROR
424 
425  LOGICAL :: FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE
426 
427  INTEGER(INTG) :: OBJECT_TYPE, COUNT, I, EVALUATOR, TYPE, FIRST_EVALUATOR, EVALUATOR_HANDLE, DEFAULT_EVALUATOR
428 
429  enters( "FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE", err, error, *999 )
430 
431  object_type = fieldml_getobjecttype( fieldml_info%FML_HANDLE, component_handle )
432  IF( object_type /= fht_piecewise_evaluator ) THEN
433  fieldml_input_is_template_compatible = .false.
434  exits( "FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE" )
435  RETURN
436  ENDIF
437 
438  evaluator_handle = fieldml_getindexevaluator( fieldml_info%FML_HANDLE, component_handle, 1 )
439  TYPE = fieldml_getvaluetype( fieldml_info%FML_HANDLE, evaluator_handle )
440  IF( TYPE /= element_type ) THEN
441  fieldml_input_is_template_compatible = .true.
442  exits( "FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE" )
443  RETURN
444  ENDIF
445 
446  count = fieldml_getevaluatorcount( fieldml_info%FML_HANDLE, component_handle )
447  default_evaluator = fieldml_getdefaultevaluator( fieldml_info%FML_HANDLE, component_handle )
448 
449  IF( default_evaluator /= fml_invalid_handle ) THEN
450  IF( .NOT.fieldml_input_is_known_basis( fieldml_info, default_evaluator, err, error ) ) THEN
451  fieldml_input_is_template_compatible = .false.
452  exits( "FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE" )
453  RETURN
454  ENDIF
455  ENDIF
456  IF(err/=0) GOTO 999
457 
458  IF( count == 0 ) THEN
459  IF( default_evaluator == fml_invalid_handle ) THEN
460  fieldml_input_is_template_compatible = .false.
461  ELSE
462  fieldml_input_is_template_compatible = .true.
463  ENDIF
464  exits( "FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE" )
465  RETURN
466  ENDIF
467 
468  first_evaluator = fieldml_getevaluator( fieldml_info%FML_HANDLE, component_handle, 1 )
469  IF( .NOT. fieldml_input_is_known_basis( fieldml_info, first_evaluator, err, error ) ) THEN
470  fieldml_input_is_template_compatible = .false.
471  exits( "FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE" )
472  RETURN
473  ENDIF
474  IF(err/=0) GOTO 999
475 
476  !At the moment, the code does not support different evaluators per element.
477 
478  DO i = 2, count
479  evaluator = fieldml_getevaluator( fieldml_info%FML_HANDLE, component_handle, i )
480  IF( evaluator /= first_evaluator ) THEN
481  fieldml_input_is_template_compatible = .false.
482  exits( "FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE" )
483  RETURN
484  ENDIF
485  ENDDO
486 
487  fieldml_input_is_template_compatible = .true.
488 
489  exits( "FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE" )
490  RETURN
491 999 errorsexits( "FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE", err, error )
492 
493  END FUNCTION fieldml_input_is_template_compatible
494 
495  !
496  !================================================================================================================================
497  !
498 
500  SUBROUTINE fieldml_input_check_field_compatible( FIELDML_INFO, FIELD_HANDLE, ELEMENT_TYPE, ERR, ERROR, * )
501  !Arguments
502  TYPE(fieldml_io_type), INTENT(IN) :: FIELDML_INFO
503  INTEGER(INTG), INTENT(IN) :: FIELD_HANDLE
504  INTEGER(INTG), INTENT(IN) :: ELEMENT_TYPE
505  INTEGER(INTG), INTENT(OUT) :: ERR
506  TYPE(varying_string), INTENT(OUT) :: ERROR
507 
508  !Locals
509  INTEGER(INTG) :: TYPE, COUNT, I, EVALUATOR, DEFAULT_EVALUATOR
510 
511  enters( "FIELDML_INPUT_CHECK_FIELD_COMPATIBLE", err, error, *999 )
512 
513  TYPE = fieldml_getobjecttype( fieldml_info%FML_HANDLE, field_handle )
514 
515  IF( TYPE /= fht_aggregate_evaluator ) THEN
516  CALL flagerror( "Field evaluator must be an aggregate evaluator.", err, error, *999 )
517  ENDIF
518 
519  count = fieldml_getevaluatorcount( fieldml_info%FML_HANDLE, field_handle )
520  default_evaluator = fieldml_getdefaultevaluator( fieldml_info%FML_HANDLE, field_handle )
521 
522  IF( default_evaluator /= fml_invalid_handle ) THEN
523  IF(.NOT.fieldml_input_is_template_compatible( fieldml_info, default_evaluator, element_type, err, error ) ) THEN
524  CALL flagerror( "Field evaluator must be use a compatible default.", err, error, *999 )
525  exits( "FIELDML_INPUT_CHECK_FIELD_COMPATIBLE" )
526  RETURN
527  ENDIF
528  ENDIF
529  IF(err/=0) GOTO 999
530 
531  IF( count == 0 ) THEN
532  IF( default_evaluator == fml_invalid_handle ) THEN
533  CALL flagerror( "Field evaluator must be able to evaluator all field components.", err, error, *999 )
534  ENDIF
535  exits( "FIELDML_INPUT_CHECK_FIELD_COMPATIBLE" )
536  RETURN
537  ENDIF
538 
539  DO i = 1, count
540  evaluator = fieldml_getevaluator( fieldml_info%FML_HANDLE, field_handle, i )
541  IF( .NOT. fieldml_input_is_template_compatible( fieldml_info, evaluator, element_type, err, error ) ) THEN
542  CALL flagerror( "Field evaluator must use a compatible component evaluator.", err, error, *999 )
543  exits( "FIELDML_INPUT_CHECK_FIELD_COMPATIBLE" )
544  RETURN
545  ENDIF
546  IF(err/=0) GOTO 999
547  ENDDO
548 
549  exits( "FIELDML_INPUT_CHECK_FIELD_COMPATIBLE" )
550  RETURN
551 999 errorsexits( "FIELDML_INPUT_CHECK_FIELD_COMPATIBLE", err, error )
552  RETURN 1
553 
555 
556  !
557  !================================================================================================================================
558  !
559 
561  SUBROUTINE fieldmlinput_coordinatesystemcreatestart( FIELDML_INFO, EVALUATOR_NAME, COORDINATE_SYSTEM, USER_NUMBER, &
562  & err, error, * )
563  !Arguments
564  TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
565  TYPE(varying_string), INTENT(IN) :: EVALUATOR_NAME
566  TYPE(coordinate_system_type), POINTER, INTENT(IN) :: COORDINATE_SYSTEM
567  INTEGER(INTG), INTENT(IN) :: USER_NUMBER
568  INTEGER(INTG), INTENT(OUT) :: ERR
569  TYPE(varying_string), INTENT(OUT) :: ERROR
570 
571  !Locals
572  INTEGER(INTG) :: EVALUATOR_HANDLE
573  INTEGER(INTG) :: TYPE_HANDLE, LENGTH
574  CHARACTER(LEN=MAXSTRLEN) :: NAME
575  INTEGER(INTG) :: COORDINATE_TYPE
576  INTEGER(INTG) :: COORDINATE_COUNT
577 
578  enters( "FieldmlInput_CoordinateSystemCreateStart", err, error, *999 )
579 
580  CALL fieldml_assert_is_in( fieldml_info, err, error, *999 )
581 
582  coordinate_type = 0 !There doesn't seem to be a COORDINATE_UNKNOWN_TYPE
583 
584  evaluator_handle = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, cchar(evaluator_name) )
585  CALL fieldml_util_check_fieldml_error( "Cannot get coordinate evaluator for geometric field "//evaluator_name//".", &
586  & fieldml_info%FML_HANDLE, err, error, *999 )
587 
588  type_handle = fieldml_getvaluetype( fieldml_info%FML_HANDLE, evaluator_handle )
589  CALL fieldml_util_check_fieldml_error( "Cannot get value type for geometric field "//evaluator_name//".", &
590  & fieldml_info%FML_HANDLE, err, error, *999 )
591 
592  length = fieldml_copyobjectdeclaredname( fieldml_info%FML_HANDLE, type_handle, name, maxstrlen )
593 
594  IF( index( name, 'coordinates.rc.3d' ) == 1 ) THEN
595  coordinate_type = coordinate_rectangular_cartesian_type
596  coordinate_count = 3
597  ELSE IF( index( name, 'coordinates.rc.2d' ) == 1 ) THEN
598  coordinate_type = coordinate_rectangular_cartesian_type
599  coordinate_count = 2
600  ELSE
601  CALL flagerror( "Coordinate system "//name(1:length)//" not yet supported.", err, error, *999 )
602  ENDIF
603 
604  CALL coordinate_system_create_start( user_number, coordinate_system, err, error, *999 )
605  !Set the coordinate system dimension and type
606  CALL coordinate_system_dimension_set( coordinate_system, coordinate_count, err, error, *999 )
607  CALL coordinate_system_type_set( coordinate_system, coordinate_type, err, error, *999 )
608 
609  exits( "FieldmlInput_CoordinateSystemCreateStart" )
610  RETURN
611 999 errorsexits( "FieldmlInput_CoordinateSystemCreateStart", err, error )
612  RETURN 1
613 
615 
616 
617  !
618  !================================================================================================================================
619  !
620 
622  SUBROUTINE fieldml_input_nodes_create_start( FIELDML_INFO, NODES_ARGUMENT_NAME, REGION, NODES, ERR, ERROR, * )
623  !Arguments
624  TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
625  TYPE(varying_string), INTENT(IN) :: NODES_ARGUMENT_NAME
626  TYPE(region_type), POINTER, INTENT(IN) :: REGION
627  TYPE(nodes_type), POINTER, INTENT(INOUT) :: NODES
628  INTEGER(INTG), INTENT(OUT) :: ERR
629  TYPE(varying_string), INTENT(OUT) :: ERROR
630 
631  !Locals
632  INTEGER(INTG) :: NODES_ARGUMENT_HANDLE, NODES_HANDLE, NODE_COUNT
633 
634  enters( "FIELDML_INPUT_NODES_CREATE_START", err, error, *999 )
635 
636  CALL fieldml_assert_is_in( fieldml_info, err, error, *999 )
637 
638  nodes_argument_handle = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, cchar(nodes_argument_name) )
639  IF( nodes_argument_handle == fml_invalid_handle ) THEN
640  CALL flagerror( "Nodes argument name "//nodes_argument_name//" is invalid.", err, error, *999 )
641  END IF
642 
643  IF( fieldml_getobjecttype( fieldml_info%FML_HANDLE, nodes_argument_handle ) /= fht_argument_evaluator ) THEN
644  CALL flagerror( "Nodes argument "//nodes_argument_name//" type is not an argument evaluator.", err, error, *999 )
645  ENDIF
646 
647  nodes_handle = fieldml_getvaluetype( fieldml_info%FML_HANDLE, nodes_argument_handle )
648  IF( nodes_handle == fml_invalid_handle ) THEN
649  CALL flagerror( "Nodes argument "//nodes_argument_name//" type is invalid.", err, error, *999 )
650  END IF
651 
652  fieldml_info%NODES_ARGUMENT_HANDLE = nodes_argument_handle
653  fieldml_info%NODES_HANDLE = nodes_handle
654 
655  node_count = fieldml_getmembercount( fieldml_info%FML_HANDLE, fieldml_info%NODES_HANDLE )
656  NULLIFY( nodes )
657  CALL nodes_create_start( region, node_count, nodes, err, error, *999 )
658 
659  exits( "FIELDML_INPUT_NODES_CREATE_START" )
660  RETURN
661 999 errorsexits( "FIELDML_INPUT_NODES_CREATE_START", err, error )
662  RETURN 1
663 
664  END SUBROUTINE fieldml_input_nodes_create_start
665 
666 
667  !
668  !================================================================================================================================
669  !
670 
672  SUBROUTINE fieldml_input_mesh_create_start( FIELDML_INFO, MESH_ARGUMENT_NAME, MESH, MESH_NUMBER, REGION, ERR, ERROR, * )
673  !Arguments
674  TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
675  TYPE(varying_string), INTENT(IN) :: MESH_ARGUMENT_NAME
676  TYPE(mesh_type), POINTER, INTENT(INOUT) :: MESH
677  INTEGER(INTG), INTENT(IN) :: MESH_NUMBER
678  TYPE(region_type), POINTER, INTENT(IN) :: REGION
679  INTEGER(INTG), INTENT(OUT) :: ERR
680  TYPE(varying_string), INTENT(OUT) :: ERROR
681 
682  !Locals
683  INTEGER(INTG) :: COUNT
684  INTEGER(INTG) :: MESH_ARGUMENT, XI_DIMENSIONS, ELEMENT_COUNT
685 
686  enters( "FIELDML_INPUT_MESH_CREATE_START", err, error, *999 )
687 
688  CALL fieldml_assert_is_in( fieldml_info, err, error, *999 )
689 
690  mesh_argument = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, cchar(mesh_argument_name) )
691  IF( mesh_argument == fml_invalid_handle ) THEN
692  CALL fieldml_util_check_fieldml_error( "Named mesh argument "//mesh_argument_name//" not found.", &
693  & fieldml_info%FML_HANDLE, err, error, *999 )
694  ENDIF
695 
696  fieldml_info%MESH_HANDLE = fieldml_getvaluetype( fieldml_info%FML_HANDLE, mesh_argument )
697  IF( fieldml_info%MESH_HANDLE == fml_invalid_handle ) THEN
698  CALL fieldml_util_check_fieldml_error( "Invalid mesh argument type for "//mesh_argument_name//".", &
699  & fieldml_info%FML_HANDLE, err, error, *999 )
700  ENDIF
701 
702  fieldml_info%ELEMENTS_HANDLE = fieldml_getmeshelementstype( fieldml_info%FML_HANDLE, fieldml_info%MESH_HANDLE )
703  fieldml_info%ELEMENTS_ARGUMENT_HANDLE = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, &
704  & cchar(mesh_argument_name//".element"))
705 
706  fieldml_info%XI_HANDLE = fieldml_getmeshcharttype( fieldml_info%FML_HANDLE, fieldml_info%MESH_HANDLE )
707  fieldml_info%XI_ARGUMENT_HANDLE = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, cchar(mesh_argument_name//".xi") )
708 
709  count = fieldml_gettypecomponentcount( fieldml_info%FML_HANDLE, fieldml_info%XI_HANDLE )
710  IF( ( count < 1 ) .OR. ( count > 3 ) ) THEN
711  CALL flagerror( "Mesh "//mesh_argument_name//" dimension cannot be greater than 3, or less than 1.", &
712  & err, error, *999 )
713  ENDIF
714 
715  xi_dimensions = fieldml_gettypecomponentcount( fieldml_info%FML_HANDLE, fieldml_info%XI_HANDLE )
716  element_count = fieldml_getmembercount( fieldml_info%FML_HANDLE, fieldml_info%ELEMENTS_HANDLE )
717  NULLIFY( mesh )
718  CALL mesh_create_start( mesh_number, region, xi_dimensions, mesh, err, error, *999 )
719  CALL mesh_number_of_elements_set( mesh, element_count, err, error, *999 )
720 
721  exits( "FIELDML_INPUT_MESH_CREATE_START" )
722  RETURN
723 999 errorsexits( "FIELDML_INPUT_MESH_CREATE_START", err, error )
724  RETURN 1
725 
726  END SUBROUTINE fieldml_input_mesh_create_start
727 
728  !
729  !================================================================================================================================
730  !
731 
733  SUBROUTINE fieldml_input_basis_create_start( FIELDML_INFO, EVALUATOR_NAME, USER_NUMBER, BASIS, ERR, ERROR, * )
734  !Arguments
735  TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
736  TYPE(varying_string), INTENT(IN) :: EVALUATOR_NAME
737  INTEGER(INTG), INTENT(IN) :: USER_NUMBER
738  TYPE(basis_type), POINTER, INTENT(INOUT) :: BASIS
739  INTEGER(INTG), INTENT(OUT) :: ERR
740  TYPE(varying_string), INTENT(OUT) :: ERROR
741 
742  !Locals
743  INTEGER(INTG) :: LIST_INDEX
744  INTEGER(INTG) :: HANDLE, CONNECTIVITY_HANDLE, LAYOUT_HANDLE, FML_ERR
745  INTEGER(INTG) :: BASISTYPE
746  INTEGER(INTG), ALLOCATABLE :: BASIS_INTERPOLATIONS(:)
747  INTEGER(INTG), ALLOCATABLE :: COLLAPSE(:)
748 
749  enters( "FIELDML_INPUT_BASIS_CREATE_START", err, error, *999 )
750 
751  CALL fieldml_assert_is_in( fieldml_info, err, error, *999 )
752 
753  handle = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, cchar(evaluator_name) )
754  CALL fieldml_util_check_fieldml_error( "Cannot find basis evaluator "//evaluator_name//".", fieldml_info%FML_HANDLE, &
755  & err, error, *999 )
756  CALL list_item_in_list( fieldml_info%BASIS_HANDLES, handle, list_index, err, error, *999 )
757  IF( list_index /= 0 ) THEN
758  CALL flagerror( "Named basis "//evaluator_name//" already created", err, error, *999 )
759  ENDIF
760 
761  CALL fieldml_input_get_basis_info( fieldml_info, handle, connectivity_handle, layout_handle, basistype, &
762  & basis_interpolations, collapse, err, error, *999 )
763 
764  CALL list_item_add( fieldml_info%BASIS_HANDLES, handle, err, error, *999 )
765  CALL list_item_add( fieldml_info%BASIS_CONNECTIVITY_HANDLES, connectivity_handle, err, error, *999 )
766  CALL list_item_add( fieldml_info%BASIS_LAYOUT_HANDLES, layout_handle, err, error, *999 )
767  fml_err = fieldml_setobjectint( fieldml_info%FML_HANDLE, handle, user_number )
768  CALL fieldml_util_check_fieldml_error( "Cannot set user number for basis "//evaluator_name//".", &
769  & fieldml_info%FML_HANDLE, err, error, *999 )
770 
771  NULLIFY(basis)
772  CALL basis_create_start( user_number, basis, err, error, *999 )
773  CALL basis_type_set( basis, basistype, err, error, *999 )
774  CALL basis_number_of_xi_set( basis, size( basis_interpolations ), err, error, *999 )
775  CALL basis_interpolation_xi_set( basis, basis_interpolations, err, error, *999 )
776  !Note: collapse bases currently only supported for BASIS_LAGRANGE_HERMITE_TP_TYPE
777  IF( size( basis_interpolations ) > 1 .AND. ALLOCATED(collapse)) THEN
778  CALL basis_collapsed_xi_set( basis, collapse, err, error, *999 )
779  ENDIF
780 
781  IF( ALLOCATED( basis_interpolations ) ) THEN
782  DEALLOCATE( basis_interpolations )
783  ENDIF
784  IF( ALLOCATED( collapse ) ) THEN
785  DEALLOCATE( collapse )
786  ENDIF
787 
788  exits( "FIELDML_INPUT_BASIS_CREATE_START" )
789  RETURN
790 999 errorsexits( "FIELDML_INPUT_BASIS_CREATE_START", err, error )
791  RETURN 1
792 
793  END SUBROUTINE
794 
795  !
796  !================================================================================================================================
797  !
798 
800  SUBROUTINE fieldml_input_initialise_from_file( FIELDML_INFO, FILENAME, ERR, ERROR, * )
801  !Arguments
802  TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
803  TYPE(varying_string), INTENT(IN) :: FILENAME
804  INTEGER(INTG), INTENT(OUT) :: ERR
805  TYPE(varying_string), INTENT(OUT) :: ERROR
806 
807  !Locals
808  INTEGER(INTG) :: LENGTH, COUNT, I, FML_ERR
809  CHARACTER(LEN=MAXSTRLEN) :: NAME
810 
811  enters( "FIELDML_INPUT_INITIALISE_FROM_FILE", err, error, *999 )
812 
813  CALL fieldml_io_initialise( fieldml_info, .false., err, error, *999 )
814 
815  fieldml_info%FML_HANDLE = fieldml_createfromfile( cchar(filename) )
816 
817  fml_err = fieldml_getlasterror( fieldml_info%FML_HANDLE )
818  IF( fml_err /= fml_err_no_error ) THEN
819  count = fieldml_geterrorcount( fieldml_info%FML_HANDLE )
820  DO i = 1,count
821  length = fieldml_copyerror( fieldml_info%FML_HANDLE, i, name, maxstrlen )
822  CALL write_string_value(error_output_type,"FieldML parse error: ",name(1:length),err,error,*999)
823  ENDDO
824  CALL flagerror( "Cannot create FieldML handle from file "//filename//".", err, error, *999 )
825  ENDIF
826 
827  exits( "FIELDML_INPUT_INITIALISE_FROM_FILE" )
828  RETURN
829 999 errorsexits( "FIELDML_INPUT_INITIALISE_FROM_FILE", err, error )
830  RETURN 1
831 
833 
834  !
835  !================================================================================================================================
836  !
837 
839  SUBROUTINE fieldml_input_read_order( FIELDML_INFO, ORDER_HANDLE, ORDER, COUNT, ERR, ERROR, * )
840  !Argument
841  TYPE(fieldml_io_type), INTENT(IN) :: FIELDML_INFO
842  INTEGER(INTG), INTENT(IN) :: ORDER_HANDLE
843  INTEGER(INTG), ALLOCATABLE, TARGET, INTENT(INOUT) :: ORDER(:)
844  INTEGER(INTG), INTENT(IN) :: COUNT
845  INTEGER(INTG), INTENT(OUT) :: ERR
846  TYPE(varying_string), INTENT(OUT) :: ERROR
847 
848  !Locals
849  INTEGER(INTG) :: READER_HANDLE, RANK, FML_ERR
850  INTEGER(INTG), TARGET :: OFFSETS(1), SIZES(1)
851 
852  enters( "FIELDML_INPUT_READ_ORDER", err, error, *999 )
853 
854  IF( order_handle == fml_invalid_handle ) THEN
855  !This is permitted, and indeed common.
856  exits( "FIELDML_INPUT_READ_ORDER" )
857  RETURN
858  ENDIF
859 
860  rank = fieldml_getarraydatasourcerank( fieldml_info%FML_HANDLE, order_handle )
861  IF( rank /= 1 ) THEN
862  CALL flagerror( "Invalid rank for ensemble order.", err, error, *999 )
863  ENDIF
864 
865  reader_handle = fieldml_openreader( fieldml_info%FML_HANDLE, order_handle )
866  CALL fieldml_util_check_fieldml_error( "Cannot open order reader.", fieldml_info%FML_HANDLE, err, error, *999 )
867 
868  ALLOCATE( order(count), stat = err )
869  IF( err /= 0 ) CALL flagerror( "Could not allocate order array.", err, error, *999 )
870  offsets(:) = 0
871  sizes(1) = count
872 
873  fml_err = fieldml_readintslab( reader_handle, c_loc(offsets), c_loc(sizes), c_loc(order) )
874  IF( fml_err /= fml_err_no_error ) THEN
875  CALL flagerror( "Error reading order data"//"("// trim(number_to_vstring(fml_err,"*",err,error)) //").", &
876  & err, error, *999 )
877  ENDIF
878 
879  fml_err = fieldml_closereader( reader_handle )
880 
881  exits( "FIELDML_INPUT_READ_ORDER" )
882  RETURN
883 999 errorsexits( "FIELDML_INPUT_READ_ORDER", err, error )
884  RETURN 1
885 
886  END SUBROUTINE fieldml_input_read_order
887 
888  !
889  !================================================================================================================================
890  !
891 
893  SUBROUTINE fieldml_input_reorder( INPUT_BUFFER, ORDER, COUNT, OUTPUT_BUFFER, ERR, ERROR, * )
894  !Argument
895  INTEGER(INTG), INTENT(IN) :: INPUT_BUFFER(:)
896  INTEGER(INTG), ALLOCATABLE, INTENT(IN) :: ORDER(:)
897  INTEGER(INTG), INTENT(IN) :: COUNT
898  INTEGER(INTG), INTENT(INOUT) :: OUTPUT_BUFFER(:)
899  INTEGER(INTG), INTENT(OUT) :: ERR
900  TYPE(varying_string), INTENT(OUT) :: ERROR
901 
902  !Locals
903  INTEGER(INTG) :: I
904 
905  enters( "FIELDML_INPUT_REORDER", err, error, *999 )
906 
907  IF( ALLOCATED( order ) ) THEN
908  DO i = 1,count
909  output_buffer( i ) = input_buffer( order( i ) )
910  ENDDO
911  ELSE
912  output_buffer = input_buffer
913  ENDIF
914 
915  exits( "FIELDML_INPUT_REORDER" )
916  RETURN
917 999 errorsexits( "FIELDML_INPUT_REORDER", err, error )
918  RETURN 1
919 
920  END SUBROUTINE fieldml_input_reorder
921 
922  !
923  !================================================================================================================================
924  !
925 
927  SUBROUTINE fieldml_input_create_mesh_component( FIELDML_INFO, MESH, COMPONENT_NUMBER, EVALUATOR_NAME, ERR, ERROR, * )
928  !Arguments
929  TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
930  TYPE(mesh_type), POINTER, INTENT(IN) :: MESH
931  INTEGER(INTG), INTENT(IN) :: COMPONENT_NUMBER
932  TYPE(varying_string), INTENT(IN) :: EVALUATOR_NAME
933  INTEGER(INTG), INTENT(OUT) :: ERR
934  TYPE(varying_string), INTENT(OUT) :: ERROR
935 
936  !Locals
937  INTEGER(INTG) :: HANDLE, BASIS_REFERENCE_HANDLE, CONNECTIVITY_HANDLE, LAYOUT_HANDLE, BASIS_NUMBER, LAST_BASIS_HANDLE
938  INTEGER(INTG), ALLOCATABLE, TARGET :: NODES_BUFFER(:), RAW_BUFFER(:)
939  INTEGER(INTG) :: COMPONENT_COUNT, ELEMENT_COUNT, KNOWN_BASIS_COUNT, MAX_BASIS_NODES_COUNT, BASIS_NODES_COUNT
940  INTEGER(INTG) :: ELEMENT_NUMBER, KNOWN_BASIS_NUMBER, COUNT
941  INTEGER(INTG), TARGET :: OFFSETS(2), SIZES(2)
942  INTEGER(INTG), ALLOCATABLE :: CONNECTIVITY_READERS(:), CONNECTIVITY_COUNTS(:)
943  TYPE(integer_cint_alloc_type), ALLOCATABLE :: CONNECTIVITY_ORDERS(:)
944  INTEGER(INTG) :: TEMP_POINTER, DATA_SOURCE, ORDER_HANDLE, TEMP_BASIS_HANDLE, FML_ERR
945  TYPE(basis_type), POINTER :: BASIS
946  TYPE(meshelementstype), POINTER :: MESH_ELEMENTS
947 
948  enters( "FIELDML_INPUT_CREATE_MESH_COMPONENT", err, error, *999 )
949 
950  CALL fieldml_assert_is_in( fieldml_info, err, error, *999 )
951 
952  NULLIFY( basis )
953  NULLIFY( mesh_elements )
954 
955  handle = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, cchar(evaluator_name) )
956  IF( .NOT. fieldml_input_is_template_compatible( fieldml_info, handle, fieldml_info%ELEMENTS_HANDLE, err, error ) ) THEN
957  CALL flagerror( "Mesh component cannot be created from evaluator "//evaluator_name//".", err, error, *999 )
958  ENDIF
959  IF(err/=0) GOTO 999
960 
961  CALL list_number_of_items_get( fieldml_info%COMPONENT_HANDLES, count, err, error, *999 )
962  IF( count < component_number ) THEN
963  DO component_count = count + 1, component_number
964  CALL list_item_add( fieldml_info%COMPONENT_HANDLES, fml_invalid_handle, err, error, *999 )
965  ENDDO
966  ENDIF
967 
968  CALL list_item_set( fieldml_info%COMPONENT_HANDLES, component_number, handle, err, error, *999 )
969 
970  CALL list_number_of_items_get( fieldml_info%BASIS_HANDLES, known_basis_count, err, error, *999 )
971  ALLOCATE( connectivity_readers( known_basis_count ), stat = err )
972  IF( err /= 0 ) CALL flagerror( "Could not allocate connectivity readers for "//evaluator_name//".", err, error, *999 )
973  ALLOCATE( connectivity_counts( known_basis_count ), stat = err )
974  IF( err /= 0 ) CALL flagerror( "Could not allocate connectivity counts for "//evaluator_name//".", err, error, *999 )
975  ALLOCATE( connectivity_orders( known_basis_count ), stat = err )
976  IF( err /= 0 ) CALL flagerror( "Could not allocate connectivity orders for "//evaluator_name//".", err, error, *999 )
977 
978  max_basis_nodes_count = 0
979  DO known_basis_number = 1, known_basis_count
980  CALL list_item_get( fieldml_info%BASIS_LAYOUT_HANDLES, known_basis_number, layout_handle, err, error, *999 )
981  CALL list_item_get( fieldml_info%BASIS_CONNECTIVITY_HANDLES, known_basis_number, connectivity_handle, &
982  & err, error, *999 )
983 
984  basis_nodes_count = fieldml_getmembercount( fieldml_info%FML_HANDLE, layout_handle )
985  CALL fieldml_util_check_fieldml_error( "Cannot get local node count for layout for mesh component "//evaluator_name//".", &
986  & fieldml_info%FML_HANDLE, err, error, *999 )
987 
988  IF( basis_nodes_count > max_basis_nodes_count ) THEN
989  max_basis_nodes_count = basis_nodes_count
990  ENDIF
991 
992  order_handle = fieldml_getparameterindexorder( fieldml_info%FML_HANDLE, connectivity_handle, 1 )
993  CALL fieldml_input_read_order( fieldml_info, order_handle, connectivity_orders( known_basis_number )%ARRAY, &
994  & basis_nodes_count, err, error, *999 )
995 
996  data_source = fieldml_getdatasource( fieldml_info%FML_HANDLE, connectivity_handle )
997  connectivity_readers(known_basis_number) = fieldml_openreader( fieldml_info%FML_HANDLE, data_source )
998  connectivity_counts(known_basis_number) = basis_nodes_count
999  CALL fieldml_util_check_fieldml_error( "Cannot open connectivity reader for mesh component "//evaluator_name//".", &
1000  & fieldml_info%FML_HANDLE, err, error, *999 )
1001 
1002  END DO
1003 
1004  ALLOCATE( nodes_buffer( max_basis_nodes_count ), stat = err )
1005  IF( err /= 0 ) CALL flagerror( "Could not allocate nodes buffer for "//evaluator_name//".", err, error, *999 )
1006  ALLOCATE( raw_buffer( max_basis_nodes_count ), stat = err )
1007  IF( err /= 0 ) CALL flagerror( "Could not allocate raw nodes buffer for "//evaluator_name//".", err, error, *999 )
1008 
1009  element_count = fieldml_getmembercount( fieldml_info%FML_HANDLE, fieldml_info%ELEMENTS_HANDLE )
1010  CALL fieldml_util_check_fieldml_error( "Cannot get element count for mesh with component "//evaluator_name//".", &
1011  & fieldml_info%FML_HANDLE, err, error, *999 )
1012 
1013  last_basis_handle = fml_invalid_handle
1014 
1015  offsets(:) = 0
1016  sizes(1) = 1
1017  sizes(2) = 0
1018 
1019  DO element_number = 1, element_count
1020  basis_reference_handle = fieldml_getelementevaluator( fieldml_info%FML_HANDLE, handle, element_number, 1 )
1021  CALL fieldml_util_check_fieldml_error( "Cannot get element evaluator from mesh component "//evaluator_name//".", &
1022  & fieldml_info%FML_HANDLE, err, error, *999 )
1023 
1024  IF( basis_reference_handle /= last_basis_handle ) THEN
1025  basis_number = fieldml_getobjectint( fieldml_info%FML_HANDLE, basis_reference_handle )
1026  CALL fieldml_util_check_fieldml_error( "Cannot get basis user number for element evaluator for mesh component "//&
1027  & evaluator_name//".", fieldml_info%FML_HANDLE, err, error, *999 )
1028  CALL basis_user_number_find( basis_number, basis, err, error, *999 )
1029  IF( .NOT. ASSOCIATED( basis ) ) THEN
1030  CALL flagerror( "Basis not found for component "//evaluator_name//".", err, error, *999 )
1031  ENDIF
1032  last_basis_handle = basis_reference_handle
1033  ENDIF
1034 
1035  IF( element_number == 1 ) THEN
1036  CALL mesh_topology_elements_create_start( mesh, component_number, basis, mesh_elements, err, error, *999 )
1037  ENDIF
1038 
1039  CALL mesh_topology_elements_element_basis_set( element_number, mesh_elements, basis, err, error, *999 )
1040 
1041  DO known_basis_number = 1, known_basis_count
1042  basis_nodes_count = connectivity_counts( known_basis_number )
1043  !BUGFIX Intel compiler will explode if we don't use a temporary variable
1044  temp_pointer = connectivity_readers(known_basis_number)
1045  sizes(2) = basis_nodes_count
1046  fml_err = fieldml_readintslab( temp_pointer, &
1047  & c_loc(offsets), c_loc(sizes), c_loc(raw_buffer) )
1048  IF( fml_err /= fml_err_no_error ) THEN
1049  CALL flagerror( "Error reading connectivity for "//evaluator_name//"("// &
1050  & trim(number_to_vstring(fml_err,"*",err,error)) //").", err, error, *999 )
1051  ENDIF
1052  CALL list_item_get( fieldml_info%BASIS_HANDLES, known_basis_number, temp_basis_handle, err, error, *999 )
1053  IF( temp_basis_handle == basis_reference_handle ) THEN
1054  CALL fieldml_input_reorder( raw_buffer, connectivity_orders(known_basis_number)%ARRAY, basis_nodes_count, &
1055  & nodes_buffer, err, error, *999 )
1056  CALL mesh_topology_elements_element_nodes_set( element_number, mesh_elements, nodes_buffer(1:basis_nodes_count), &
1057  & err, error, *999 )
1058  ENDIF
1059  ENDDO
1060 
1061  offsets(1) = offsets(1) + 1
1062 
1063  END DO
1064 
1065  DO known_basis_number = 1, known_basis_count
1066  !BUGFIX Intel compiler will explode if we don't use a temporary variable
1067  temp_pointer = connectivity_readers(known_basis_number)
1068  fml_err = fieldml_closereader( temp_pointer )
1069  IF( fml_err /= fml_err_no_error ) THEN
1070  CALL flagerror( "Error closing connectivity reader for "//evaluator_name//"("// &
1071  & trim(number_to_vstring(fml_err,"*",err,error)) //").", err, error, *999 )
1072  ENDIF
1073  IF( ALLOCATED( connectivity_orders( known_basis_number )%ARRAY ) ) THEN
1074  DEALLOCATE( connectivity_orders( known_basis_number )%ARRAY )
1075  ENDIF
1076  ENDDO
1077 
1078  DEALLOCATE( nodes_buffer )
1079  DEALLOCATE( connectivity_readers )
1080  DEALLOCATE( connectivity_counts )
1081  DEALLOCATE( connectivity_orders )
1082 
1083  CALL mesh_topology_elements_create_finish( mesh_elements, err, error, *999 )
1084 
1085  fml_err = fieldml_setobjectint( fieldml_info%FML_HANDLE, handle, component_number )
1086 
1087  exits( "FIELDML_INPUT_CREATE_MESH_COMPONENT" )
1088  RETURN
1089 999 errorsexits( "FIELDML_INPUT_CREATE_MESH_COMPONENT", err, error )
1090  IF( ALLOCATED( nodes_buffer ) ) THEN
1091  DEALLOCATE( nodes_buffer )
1092  ENDIF
1093  IF( ALLOCATED( connectivity_readers ) ) THEN
1094  DEALLOCATE( connectivity_readers )
1095  ENDIF
1096  IF( ALLOCATED( connectivity_counts ) ) THEN
1097  DEALLOCATE( connectivity_counts )
1098  ENDIF
1099  IF( ALLOCATED( connectivity_orders ) ) THEN
1100  DO known_basis_number = 1, known_basis_count
1101  IF( ALLOCATED( connectivity_orders( known_basis_number )%ARRAY ) ) THEN
1102  DEALLOCATE( connectivity_orders( known_basis_number )%ARRAY )
1103  ENDIF
1104  ENDDO
1105 
1106  DEALLOCATE( connectivity_orders )
1107  ENDIF
1108 
1109  exits( "FIELDML_INPUT_CREATE_MESH_COMPONENT" )
1110  RETURN 1
1111 
1113 
1114  !
1115  !================================================================================================================================
1116  !
1117 
1119  SUBROUTINE fieldml_input_field_create_start( FIELDML_INFO, REGION, DECOMPOSITION, FIELD_NUMBER, FIELD, VARIABLE_TYPE, &
1120  & evaluator_name, err, error, * )
1121  !Arguments
1122  TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
1123  TYPE(region_type), POINTER, INTENT(IN) :: REGION
1124  TYPE(decomposition_type), POINTER, INTENT(IN) :: DECOMPOSITION
1125  INTEGER(INTG), INTENT(IN) :: FIELD_NUMBER
1126  TYPE(field_type), POINTER, INTENT(INOUT) :: FIELD
1127  INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
1128  TYPE(varying_string), INTENT(IN) :: EVALUATOR_NAME
1129  INTEGER(INTG), INTENT(OUT) :: ERR
1130  TYPE(varying_string), INTENT(OUT) :: ERROR
1131 
1132  !Locals
1133  INTEGER(INTG) :: FIELD_HANDLE, TEMPLATE_HANDLE, TYPE_HANDLE
1134  INTEGER(INTG) :: COMPONENT_NUMBER, TEMPLATE_COMPONENT_NUMBER, FIELD_DIMENSIONS
1135 
1136  enters( "FIELDML_INPUT_FIELD_CREATE_START", err, error, *999 )
1137 
1138  CALL fieldml_assert_is_in( fieldml_info, err, error, *999 )
1139 
1140  field_handle = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, cchar(evaluator_name) )
1141  CALL fieldml_util_check_fieldml_error( "Cannot get named field evaluator "//evaluator_name//".", &
1142  & fieldml_info%FML_HANDLE, err, error, *999 )
1143  type_handle = fieldml_getvaluetype( fieldml_info%FML_HANDLE, field_handle )
1144  CALL fieldml_util_check_fieldml_error( "Cannot get named field evaluator's value type for "//evaluator_name//".", &
1145  & fieldml_info%FML_HANDLE, err, error, *999 )
1146  field_dimensions = fieldml_gettypecomponentcount( fieldml_info%FML_HANDLE, type_handle )
1147  CALL fieldml_util_check_fieldml_error( "Cannot get named field evaluator's component count for "//evaluator_name//".", &
1148  & fieldml_info%FML_HANDLE, err, error, *999 )
1149 
1150  CALL fieldml_input_check_field_compatible( fieldml_info, field_handle, fieldml_info%ELEMENTS_HANDLE, err, error, *999 )
1151 
1152  NULLIFY( field )
1153  CALL field_create_start( field_number, region, field, err, error, *999 )
1154  CALL field_type_set( field, field_geometric_type, err, error, *999 )
1155  CALL field_mesh_decomposition_set( field, decomposition, err, error, *999 )
1156  CALL field_scaling_type_set( field, field_no_scaling, err, error, *999 )
1157 
1158  DO component_number = 1, field_dimensions
1159  template_handle = fieldml_getelementevaluator( fieldml_info%FML_HANDLE, field_handle, component_number, 1 )
1160  CALL fieldml_util_check_fieldml_error( var_str("Cannot get field component ")//component_number//" evaluator for "//&
1161  & evaluator_name//".", fieldml_info%FML_HANDLE, err, error, *999 )
1162 
1163  template_component_number = fieldml_getobjectint( fieldml_info%FML_HANDLE, template_handle )
1164  CALL fieldml_util_check_fieldml_error( var_str("Cannot get mesh component number for field component ")//component_number//&
1165  & " of "//evaluator_name//".", fieldml_info%FML_HANDLE, err, error, *999 )
1166 
1167  CALL field_component_mesh_component_set( field, variable_type, component_number, template_component_number, &
1168  & err, error, *999 )
1169  ENDDO
1170 
1171  exits( "FIELDML_INPUT_FIELD_CREATE_START" )
1172  RETURN
1173 999 errorsexits( "FIELDML_INPUT_FIELD_CREATE_START", err, error )
1174  RETURN 1
1175 
1176  END SUBROUTINE fieldml_input_field_create_start
1177 
1178  !
1179  !================================================================================================================================
1180  !
1181 
1183  SUBROUTINE fieldml_input_field_parameters_update(FIELDML_INFO, EVALUATOR_NAME, FIELD, VARIABLE_TYPE, SET_TYPE, &
1184  & err, error, * )
1185  !Argument variables
1186  TYPE(fieldml_io_type), INTENT(INOUT) :: FIELDML_INFO
1187  TYPE(varying_string), INTENT(IN) :: EVALUATOR_NAME
1188  TYPE(field_type), POINTER, INTENT(INOUT) :: FIELD
1189  INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
1190  INTEGER(INTG), INTENT(IN) :: SET_TYPE
1191  INTEGER(INTG), INTENT(OUT) :: ERR
1192  TYPE(varying_string), INTENT(OUT) :: ERROR
1193  !Local Variables
1194  INTEGER(INTG) :: component_idx,INTERPOLATION_TYPE,MESH_COMPONENT1,MESH_COMPONENT2,NUMBER_OF_COMPONENTS
1195  LOGICAL :: IS_ALL_NODAL_INTERPOLATION,IS_SAME_MESH_COMPONENTS
1196 
1197  enters("FIELDML_INPUT_FIELD_PARAMETERS_UPDATE",err,error,*999)
1198 
1199  IF(ASSOCIATED(field)) THEN
1200  CALL field_number_of_components_get(field,variable_type,number_of_components,err,error,*999)
1201  IF(number_of_components>0) THEN
1202  CALL field_component_interpolation_get(field,variable_type,1,interpolation_type,err,error,*999)
1203  CALL field_component_mesh_component_get(field,variable_type,1,mesh_component1,err,error,*999)
1204  is_all_nodal_interpolation=interpolation_type==field_node_based_interpolation
1205  is_same_mesh_components=.true.
1206  DO component_idx=2,number_of_components
1207  CALL field_component_interpolation_get(field,variable_type,component_idx,interpolation_type,err,error,*999)
1208  CALL field_component_mesh_component_get(field,variable_type,component_idx,mesh_component2,err,error,*999)
1209  is_all_nodal_interpolation=is_all_nodal_interpolation.AND.interpolation_type==field_node_based_interpolation
1210  is_same_mesh_components=is_same_mesh_components.AND.mesh_component2==mesh_component1
1211  ENDDO !component_idx
1212  IF(is_all_nodal_interpolation) THEN
1213  IF(is_same_mesh_components) THEN
1214  CALL fieldmlinput_fieldnodalparametersupdate(fieldml_info,evaluator_name,field,variable_type,set_type, &
1215  & err,error,*999)
1216  ELSE
1217  CALL flagerror( &
1218  & "FieldML input parameters only implemented for fields where all components have the same mesh component.", &
1219  & err,error,*999)
1220  ENDIF
1221  ELSE
1222  CALL flagerror("FieldML input parameters only implemented for fields where all components are nodally interpolated.", &
1223  & err,error,*999)
1224  ENDIF
1225  ELSE
1226  CALL flagerror("Field does not have any components.",err,error,*999)
1227  ENDIF
1228  ELSE
1229  CALL flagerror("Field is not associated.",err,error,*999)
1230  ENDIF
1231 
1232  exits("FIELDML_INPUT_FIELD_PARAMETERS_UPDATE")
1233  RETURN
1234 999 errorsexits("FIELDML_INPUT_FIELD_PARAMETERS_UPDATE",err,error)
1235  RETURN 1
1237 
1238  !
1239  !================================================================================================================================
1240  !
1241 
1243  SUBROUTINE fieldmlinput_fieldnodalparametersupdate( FIELDML_INFO, EVALUATOR_NAME, FIELD, VARIABLE_TYPE, SET_TYPE, &
1244  & err, error, * )
1245  !Arguments
1246  TYPE(fieldml_io_type), INTENT(INOUT) :: FIELDML_INFO
1247  TYPE(varying_string), INTENT(IN) :: EVALUATOR_NAME
1248  TYPE(field_type), POINTER, INTENT(INOUT) :: FIELD
1249  INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
1250  INTEGER(INTG), INTENT(IN) :: SET_TYPE
1251  INTEGER(INTG), INTENT(OUT) :: ERR
1252  TYPE(varying_string), INTENT(OUT) :: ERROR
1253 
1254  !Locals
1255  TYPE(mesh_type), POINTER :: MESH
1256  TYPE(nodes_type), POINTER :: NODES
1257  INTEGER(INTG) :: NODAL_DOFS_HANDLE, DATA_SOURCE, FML_ERR, RANK
1258  INTEGER(INTG) :: VERSION_NUMBER,COMPONENT_NUMBER, NODE_NUMBER, FIELD_DIMENSIONS, MESH_NODE_COUNT
1259  INTEGER(INTG), TARGET :: OFFSETS(2), SIZES(2)
1260  REAL(C_DOUBLE), ALLOCATABLE, TARGET :: BUFFER(:)
1261  INTEGER(INTG) :: READER
1262  INTEGER(INTG) :: myComputationalNodeNumber,nodeDomain,meshComponentNumber
1263 
1264  enters( "FieldmlInput_FieldNodalParametersUpdate", err, error, *999 )
1265 
1266  mesh => field%DECOMPOSITION%MESH
1267 
1268  nodal_dofs_handle = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, cchar(evaluator_name) )
1269  CALL fieldml_util_check_fieldml_error( "Cannot get nodal field dofs evaluator "//evaluator_name//".", &
1270  & fieldml_info%FML_HANDLE, err, error, *999 )
1271 
1272  data_source = fieldml_getdatasource( fieldml_info%FML_HANDLE, nodal_dofs_handle )
1273  CALL fieldml_util_check_fieldml_error( "Cannot get nodal data source for "//evaluator_name//".", &
1274  & fieldml_info%FML_HANDLE, err, error, *999 )
1275 
1276  rank = fieldml_getarraydatasourcerank( fieldml_info%FML_HANDLE, data_source )
1277  IF( rank /= 2 ) THEN
1278  CALL flagerror( "Invalid rank for nodal dofs.", err, error, *999 )
1279  ENDIF
1280 
1281  reader = fieldml_openreader( fieldml_info%FML_HANDLE, data_source )
1282  CALL fieldml_util_check_fieldml_error( "Cannot open nodal dofs reader for "//evaluator_name//".", &
1283  & fieldml_info%FML_HANDLE, err, error, *999 )
1284 
1285  CALL field_number_of_components_get( field, variable_type, field_dimensions, err, error, *999 )
1286 
1287  ALLOCATE( buffer( field_dimensions ), stat = err )
1288  IF( err /= 0 ) CALL flagerror( "Could not allocate raw nodes buffer for "//evaluator_name//".", err, error, *999 )
1289 
1290  !TODO Code assumes that the data is dense in both node and component indexes.
1291  NULLIFY( nodes )
1292  CALL region_nodes_get( mesh%REGION, nodes, err, error, *999 )
1293  CALL nodes_number_of_nodes_get( nodes, mesh_node_count, err, error, *999 )
1294  CALL fieldml_util_check_fieldml_error( var_str("Cannot get mesh nodes count for mesh ")//mesh%USER_NUMBER//".", &
1295  & fieldml_info%FML_HANDLE, err, error, *999 )
1296 
1297  offsets(:) = 0
1298  sizes(1) = 1
1299  sizes(2) = field_dimensions
1300 
1301  DO node_number = 1, mesh_node_count
1302  fml_err = fieldml_readdoubleslab( reader, c_loc(offsets), c_loc(sizes), c_loc(buffer) )
1303  offsets(1) = offsets(1) + 1
1304  IF( fml_err /= fml_err_no_error ) THEN
1305  CALL flagerror( "Cannot read nodal dofs from "//evaluator_name//"("&
1306  & // trim(number_to_vstring(fml_err,"*",err,error)) //").", err, error, *999 )
1307  ENDIF
1308 
1309  DO component_number = 1, field_dimensions
1310  !Default to version 1 of each node derivative (value hardcoded in loop)
1311  version_number = 1
1312 
1313  mycomputationalnodenumber = computational_node_number_get(err,error)
1314  CALL decomposition_mesh_component_number_get(field%DECOMPOSITION,meshcomponentnumber,err,error,*999)
1315  CALL decomposition_node_domain_get(field%DECOMPOSITION,node_number,meshcomponentnumber,nodedomain,err,error,*999)
1316  IF(nodedomain==mycomputationalnodenumber) THEN
1317  CALL field_parameter_set_update_node( field, variable_type, set_type, version_number, &
1318  & no_global_deriv, node_number, component_number, buffer( component_number ), err, error, *999 )
1319  ENDIF
1320 
1321  ENDDO
1322  ENDDO
1323 
1324  DEALLOCATE( buffer )
1325 
1326  fml_err = fieldml_closereader( reader )
1327  IF( fml_err /= fml_err_no_error ) THEN
1328  CALL flagerror( "Error closing nodal dofs reader for "//evaluator_name//"("&
1329  & // trim(number_to_vstring(fml_err,"*",err,error)) //").", err, error, *999 )
1330  ENDIF
1331 
1332  !TODO Set element and constant parameters
1333 
1334  exits( "FieldmlInput_FieldNodalParametersUpdate" )
1335  RETURN
1336 999 errorsexits( "FieldmlInput_FieldNodalParametersUpdate", err, error )
1337  RETURN 1
1338 
1340 
1341  !
1342  !================================================================================================================================
1343  !
1344 
1345 END MODULE fieldml_input_routines
This module contains all basis function routines.
Sets/changes the number of Xi directions for a basis.
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Write a string followed by a value to a given output stream.
integer(intg), parameter, public basis_xi_collapsed
The Xi direction is collapsed.
subroutine, public basis_user_number_find(USER_NUMBER, BASIS, ERR, ERROR,)
Finds and returns in BASIS a pointer to the basis with the number given in USER_NUMBER. If no basis with that number exits BASIS is left nullified.
integer(intg), parameter, public basis_quadratic_lagrange_interpolation
Quadratic Lagrange interpolation specification.
This module contains all coordinate transformation and support routines.
integer(intg), parameter no_global_deriv
No global derivative i.e., u.
Definition: constants.f90:213
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
This module contains all region routines.
Sets/changes the interpolation type in each Xi direction for a basis.
integer(intg), parameter, public basis_collapsed_at_xi0
The Xi direction at the xi=0 end of this Xi direction is collapsed.
Determines if an item is in a list and returns the position of the item.
Definition: lists.f90:197
Contains information on the current FieldML parsing state.
Sets/changes the collapsed Xi flags for a basis.
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
subroutine, public fieldml_input_create_mesh_component(FIELDML_INFO, MESH, COMPONENT_NUMBER, EVALUATOR_NAME, ERR, ERROR,)
Creates an OpenCMISS mesh component using relevant parameters from FieldML. Does not call CreateFinis...
subroutine, public list_number_of_items_get(LIST, NUMBER_OF_ITEMS, ERR, ERROR,)
Gets the current number of items in a list.
Definition: lists.f90:2290
integer(intg), parameter, public basis_quadratic_simplex_interpolation
Quadratic Simplex interpolation specification.
Utility routines for FieldML.
subroutine fieldml_input_read_order(FIELDML_INFO, ORDER_HANDLE, ORDER, COUNT, ERR, ERROR,)
Reads an ensemble ordering using the given data source.
integer(intg), parameter, public basis_simplex_type
Simplex basis type.
subroutine, public fieldml_input_nodes_create_start(FIELDML_INFO, NODES_ARGUMENT_NAME, REGION, NODES, ERR, ERROR,)
Creates an OpenCMISS nodes object using relevant parameters from FieldML. Does not call CreateFinish...
subroutine, public coordinate_system_dimension_set(COORDINATE_SYSTEM, DIMENSION, ERR, ERROR,)
Sets/changes the dimension of the coordinate system.
subroutine, public region_nodes_get(REGION, NODES, ERR, ERROR,)
Returns a pointer to the nodes for a region.
subroutine, public coordinate_system_create_start(USER_NUMBER, COORDINATE_SYSTEM, ERR, ERROR,)
Starts the creation of and initialises a new coordinate system.
This module contains all program wide constants.
Definition: constants.f90:45
Input routines for FieldML.
subroutine fieldml_input_check_field_compatible(FIELDML_INFO, FIELD_HANDLE, ELEMENT_TYPE, ERR, ERROR,)
Determines whether or not the given field evaluator can be parsed as an OpenCMISS field...
subroutine, public fieldml_input_basis_create_start(FIELDML_INFO, EVALUATOR_NAME, USER_NUMBER, BASIS, ERR, ERROR,)
Creates an OpenCMISS basis object using relevant parameters from FieldML. Does not call CreateFinish...
integer(intg), parameter, public basis_linear_simplex_interpolation
Linear Simplex interpolation specification.
integer(intg), parameter maxstrlen
Maximum string length fro character strings.
Definition: constants.f90:79
subroutine, public exits(NAME)
Records the exit out of the named procedure.
subroutine fieldml_input_get_basis_info(FIELDML_INFO, BASIS_HANDLE, CONNECTIVITY_HANDLE, LAYOUT_HANDLE, BASISTYPE, BASIS_INTERPOLATIONS, COLLAPSE, ERR, ERROR,)
Determines the basis configuration from the given basis evaluator.
subroutine, public fieldml_input_initialise_from_file(FIELDML_INFO, FILENAME, ERR, ERROR,)
Initialize the given FieldML parsing state from the given FieldML file.
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
integer(intg), parameter, public basis_not_collapsed
The Xi direction is not collapsed.
Types for FieldML.
subroutine fieldml_input_get_basis_connectivity_info(FIELDML_INFO, BASIS_HANDLE, PARAM_ARG_HANDLE, CONNECTIVITY_HANDLE, LAYOUT_HANDLE, ERR, ERROR,)
Determines the connectivity evaluator and layout argument for the given basis.
This module contains all computational environment variables.
integer(intg), parameter, public coordinate_rectangular_cartesian_type
Rectangular Cartesian coordinate system type.
subroutine, public fieldml_io_initialise(FIELDML_INFO, IS_OUT, ERR, ERROR,)
subroutine, public fieldmlinput_coordinatesystemcreatestart(FIELDML_INFO, EVALUATOR_NAME, COORDINATE_SYSTEM, USER_NUMBER, ERR, ERROR,)
Creates an OpenCMISS coordinate system using relevant parameters from FieldML. Does not call CreateFi...
Definition: cmiss.f90:51
integer(intg), parameter, public basis_lagrange_hermite_tp_type
Lagrange-Hermite tensor product basis type.
subroutine fieldml_input_reorder(INPUT_BUFFER, ORDER, COUNT, OUTPUT_BUFFER, ERR, ERROR,)
Reorder the given values according to the given ordering.
integer(intg), parameter, public basis_collapsed_at_xi1
The Xi direction at the xi=1 end of this Xi direction is collapsed.
Returns an item in a list at a specififed position.
Definition: lists.f90:177
subroutine, public fieldml_input_mesh_create_start(FIELDML_INFO, MESH_ARGUMENT_NAME, MESH, MESH_NUMBER, REGION, ERR, ERROR,)
Creates an OpenCMISS mesh using relevant parameters from FieldML. Does not call CreateFinish.
subroutine, public fieldml_input_field_parameters_update(FIELDML_INFO, EVALUATOR_NAME, FIELD, VARIABLE_TYPE, SET_TYPE, ERR, ERROR,)
Inputs from a FieldML file the parameters for a field variable parameter set.
subroutine fieldml_assert_is_in(FIELDML_INFO, ERR, ERROR,)
Asserts that the FieldML Info is associated and created for input.
subroutine, public coordinate_system_type_set(COORDINATE_SYSTEM, TYPE, ERR, ERROR,)
Sets/changes the type of a coordinate system.
Sets an item in the list.
Definition: lists.f90:157
subroutine, public fieldml_input_field_create_start(FIELDML_INFO, REGION, DECOMPOSITION, FIELD_NUMBER, FIELD, VARIABLE_TYPE, EVALUATOR_NAME, ERR, ERROR,)
Creates an OpenCMISS field using relevant parameters from FieldML. Does not call CreateFinish.
Adds an item to the end of a list.
Definition: lists.f90:133
Implements lists of base types.
Definition: lists.f90:46
Sets/changes the type for a basis.
subroutine fieldml_input_get_basis_collapse(NAME, COLLAPSE, ERR, ERROR,)
Determine the basis collapse parameters from the given evaluator&#39;s name.
subroutine, public basis_create_start(USER_NUMBER, BASIS, ERR, ERROR,)
Starts the creation of a new basis The default values of the BASIS attributes are: ...
logical function fieldml_input_is_template_compatible(FIELDML_INFO, COMPONENT_HANDLE, ELEMENT_TYPE, ERR, ERROR)
Determines whether or not the given evaluator is a recognisable mesh component evaluator.
logical function fieldml_input_is_known_basis(FIELDML_INFO, BASIS_HANDLE, ERR, ERROR)
Determines whether or not the given basis evaluator is known to OpenCMISS.
Flags an error condition.
integer(intg), parameter, public basis_linear_lagrange_interpolation
Linear Lagrange interpolation specification.
integer(intg) function, public computational_node_number_get(ERR, ERROR)
Returns the number/rank of the computational nodes.
integer(intg), parameter, public error_output_type
Error output type.
subroutine fieldmlinput_fieldnodalparametersupdate(FIELDML_INFO, EVALUATOR_NAME, FIELD, VARIABLE_TYPE, SET_TYPE, ERR, ERROR,)
Update the given field&#39;s nodal parameters using the given parameter evaluator.
This module handles all formating and input and output.