fieldml_input_routines.f90

Go to the documentation of this file.

MODULE fieldml_input_routines

  USE base_routines
  USE basis_routines
  USE cmiss
  USE constants
  USE comp_environment
  USE coordinate_routines
  USE field_routines
  USE fieldml_api
  USE fieldml_types
  USE fieldml_util_routines
  USE input_output
  USE lists
  USE mesh_routines
  USE node_routines
  USE region_routines
  USE strings

#include "macros.h"  

  IMPLICIT NONE

  PRIVATE

  !Interfaces

  INTERFACE

  END INTERFACE

  PUBLIC :: fieldml_input_initialise_from_file, fieldml_input_mesh_create_start, &
    & fieldmlinput_coordinatesystemcreatestart, fieldml_input_basis_create_start, fieldml_input_create_mesh_component, &
    & fieldml_input_field_create_start, fieldml_input_field_parameters_update, fieldml_input_nodes_create_start

CONTAINS

  !
  !================================================================================================================================
  !

  SUBROUTINE fieldml_assert_is_in( FIELDML_INFO, ERR, ERROR, * )
    !Argument variables
    TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    
    enters( "FIELDML_ASSERT_IS_IN", err, error, *999 )

    IF(.NOT.ASSOCIATED(fieldml_info)) THEN
      CALL flagerror( "FieldML Info is not associated.", err, error, *999 )
    ELSE IF( fieldml_info%IS_OUT ) THEN
      CALL flagerror( "Outbound FieldML Info used for an input-only operation.", err, error, *999 )
    ENDIF
    
    exits( "FIELDML_ASSERT_IS_IN" )
    RETURN
999 errorsexits( "FIELDML_ASSERT_IS_IN", err, error )
    RETURN 1
    
  END SUBROUTINE fieldml_assert_is_in
  
  !
  !================================================================================================================================
  !
  
  SUBROUTINE fieldml_input_get_basis_connectivity_info( FIELDML_INFO, BASIS_HANDLE, PARAM_ARG_HANDLE, CONNECTIVITY_HANDLE, &
    & layout_handle, err, error, * )
    !Argument variables
    TYPE(fieldml_io_type), INTENT(IN) :: FIELDML_INFO
    INTEGER(INTG), INTENT(IN) :: BASIS_HANDLE
    INTEGER(INTG), INTENT(IN) :: PARAM_ARG_HANDLE
    INTEGER(INTG), INTENT(OUT) :: CONNECTIVITY_HANDLE
    INTEGER(INTG), INTENT(OUT) :: LAYOUT_HANDLE
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    
    !Local variables
    INTEGER(INTG) :: COUNT, BIND_NUMBER, PARAMS_HANDLE, ARG_HANDLE, LAYOUT_INDEX_HANDLE
    
    enters( "FIELDML_INPUT_GET_BASIS_CONNECTIVITY_INFO", err, error, *999 )

    count = fieldml_getbindcount( fieldml_info%FML_HANDLE, basis_handle )
    IF( count /= 2 ) THEN
      CALL flagerror( "Library basis evaluators must have exactly two binds.", err, error, *999 )
    END IF
    
    params_handle = fml_invalid_handle
    DO bind_number = 1, count
      arg_handle = fieldml_getbindargument( fieldml_info%FML_HANDLE, basis_handle, bind_number )
      CALL fieldml_util_check_fieldml_error( "Cannot get bind for interpolator.", fieldml_info%FML_HANDLE, err, error, *999 )
      IF( arg_handle == param_arg_handle ) THEN
        params_handle = fieldml_getbindevaluator( fieldml_info%FML_HANDLE, basis_handle, bind_number )
      ENDIF
    ENDDO

    IF( params_handle == fml_invalid_handle ) THEN
      CALL flagerror( "Library interpolators must have a correct parameter bind.", err, error, *999 )
    ENDIF

    IF( fieldml_getobjecttype( fieldml_info%FML_HANDLE, params_handle ) /= fht_aggregate_evaluator ) THEN
      CALL flagerror( "Parameter evaluator for interpolator must be an aggregate.", err, error, *999 )
    ENDIF
    
    count = fieldml_getbindcount( fieldml_info%FML_HANDLE, params_handle )
    IF( count /= 1 ) THEN
      CALL flagerror( "Nodal parameter evaluator must only have one bind.", err, error, *999 )
    ENDIF

    IF( fieldml_getbindargument( fieldml_info%FML_HANDLE, params_handle, 1 ) /= fieldml_info%NODES_ARGUMENT_HANDLE ) THEN
      CALL flagerror( "Nodal parameter evaluator must bind the nodes argument.", err, error, *999 )
    ENDIF
    
    connectivity_handle = fieldml_getbindevaluator( fieldml_info%FML_HANDLE, params_handle, 1 )
    CALL fieldml_util_check_fieldml_error( "Cannot get connectivity source for nodal parameters.", fieldml_info%FML_HANDLE, &
      & err, error, *999 )
      
    layout_index_handle = fieldml_getindexevaluator( fieldml_info%FML_HANDLE, params_handle, 1 )
    layout_handle = fieldml_getvaluetype( fieldml_info%FML_HANDLE, layout_index_handle )
    CALL fieldml_util_check_fieldml_error( "Cannot get connectivity source for nodal parameters.", fieldml_info%FML_HANDLE, &
      & err, error, *999 )

    exits( "FIELDML_INPUT_GET_BASIS_CONNECTIVITY_INFO" )
    RETURN
999 errorsexits( "FIELDML_INPUT_GET_BASIS_CONNECTIVITY_INFO", err, error )
    RETURN 1

  END SUBROUTINE fieldml_input_get_basis_connectivity_info

  !
  !================================================================================================================================
  !
  
  SUBROUTINE fieldml_input_get_basis_collapse( NAME, COLLAPSE, ERR, ERROR, * )
    !Argument variables
    TYPE(varying_string), INTENT(IN) :: NAME
    INTEGER(INTG), ALLOCATABLE, INTENT(INOUT) :: COLLAPSE(:)
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR

    enters( "FIELDML_INPUT_GET_BASIS_COLLAPSE", err, error, *999 )

    collapse = basis_not_collapsed
    
    IF( SIZE( collapse ) > 0 ) THEN
      IF( index( name, "_xi1C" ) /= 0 ) THEN
        collapse(1) = basis_xi_collapsed
      ELSE IF( index( name, "_xi10" ) /= 0 ) THEN
        collapse(1) = basis_collapsed_at_xi0
      ELSE IF( index( name, "_xi11" ) /= 0 ) THEN
        collapse(1) = basis_collapsed_at_xi1
      ENDIF
    ENDIF
  
    IF( SIZE( collapse ) > 1 ) THEN
      IF( index( name, "_xi2C" ) /= 0 ) THEN
        collapse(2) = basis_xi_collapsed
      ELSE IF( index( name, "_xi20" ) /= 0 ) THEN
        collapse(2) = basis_collapsed_at_xi0
      ELSE IF( index( name, "_xi21" ) /= 0 ) THEN
        collapse(2) = basis_collapsed_at_xi1
      ENDIF
    ENDIF
  
    IF( SIZE( collapse ) > 2 ) THEN
      IF( index( name, "_xi3C" ) /= 0 ) THEN
        collapse(3) = basis_xi_collapsed
      ELSE IF( index( name, "_xi30" ) /= 0 ) THEN
        collapse(3) = basis_collapsed_at_xi0
      ELSE IF( index( name, "_xi31" ) /= 0 ) THEN
        collapse(3) = basis_collapsed_at_xi1
      ENDIF
    ENDIF

    exits( "FIELDML_INPUT_GET_BASIS_COLLAPSE" )
    RETURN
999 errorsexits( "FIELDML_INPUT_GET_BASIS_COLLAPSE", err, error )
    RETURN 1
  
  END SUBROUTINE fieldml_input_get_basis_collapse

  !
  !================================================================================================================================
  !

  SUBROUTINE fieldml_input_get_basis_info( FIELDML_INFO, BASIS_HANDLE, CONNECTIVITY_HANDLE, LAYOUT_HANDLE, BASISTYPE, &
    & basis_interpolations, collapse, err, error, * )
    !Argument variables
    TYPE(fieldml_io_type), INTENT(IN) :: FIELDML_INFO
    INTEGER(INTG), INTENT(IN) :: BASIS_HANDLE
    INTEGER(INTG), INTENT(OUT) :: CONNECTIVITY_HANDLE
    INTEGER(INTG), INTENT(OUT) :: LAYOUT_HANDLE
    INTEGER(INTG), INTENT(OUT) :: BASISTYPE
    INTEGER(INTG), ALLOCATABLE, INTENT(OUT) :: BASIS_INTERPOLATIONS(:)
    INTEGER(INTG), ALLOCATABLE, INTENT(OUT) :: COLLAPSE(:)
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR

    !Locals
    INTEGER(INTG) :: LENGTH, LIBRARY_BASIS_HANDLE, PARAM_ARG_HANDLE
    CHARACTER(LEN=MAXSTRLEN) :: NAME
    TYPE(varying_string) :: COLLAPSE_NAME
    
    enters( "FIELDML_INPUT_GET_BASIS_INFO", err, error, *999 )

    IF( .NOT. fieldml_input_is_known_basis( fieldml_info, basis_handle, err, error ) ) THEN
      CALL flagerror( "Basis specified in FieldML file is not yet supported.", err, error, *999 )
    ENDIF
    IF(err/=0) GOTO 999

    IF( fieldml_getobjecttype( fieldml_info%FML_HANDLE, basis_handle ) /= fht_reference_evaluator ) THEN
      CALL flagerror( "Basis evaluator must be a continuous reference.", err, error, *999 )
    ENDIF
    
    library_basis_handle = fieldml_getreferencesourceevaluator( fieldml_info%FML_HANDLE, basis_handle )
    CALL fieldml_util_check_fieldml_error( "Basis specified in FieldML is not a reference evaluator.", fieldml_info%FML_HANDLE, &
      & err, error, *999 )
    length = fieldml_copyobjectdeclaredname( fieldml_info%FML_HANDLE, library_basis_handle, name, maxstrlen )
    CALL fieldml_util_check_fieldml_error( "Cannot get name of basis evaluator.", fieldml_info%FML_HANDLE, err, error, *999 )

    IF( index( name, 'interpolator.3d.unit.triquadraticLagrange') == 1 ) THEN
      param_arg_handle = fieldml_getobjectbydeclaredname( fieldml_info%FML_HANDLE, &
        & "parameters.3d.unit.triquadraticLagrange.argument"//c_null_char )
      ALLOCATE( basis_interpolations(3), stat = err )
      IF( err /= 0 ) CALL flagerror( "Could not allocate interpolation array.", err, error, *999 )
      ALLOCATE( collapse(3), stat = err )
      IF( err /= 0 ) CALL flagerror( "Could not allocate collapse array.", err, error, *999 )
      basis_interpolations = basis_quadratic_lagrange_interpolation
      basistype = basis_lagrange_hermite_tp_type
    ELSE IF( index( name, 'interpolator.3d.unit.trilinearLagrange') == 1 ) THEN
      param_arg_handle = fieldml_getobjectbydeclaredname( fieldml_info%FML_HANDLE, &
        & "parameters.3d.unit.trilinearLagrange.argument"//c_null_char )
      ALLOCATE( basis_interpolations(3), stat = err )
      IF( err /= 0 ) CALL flagerror( "Could not allocate interpolation array.", err, error, *999 )
      ALLOCATE( collapse(3), stat = err )
      IF( err /= 0 ) CALL flagerror( "Could not allocate collapse array.", err, error, *999 )
      basis_interpolations = basis_linear_lagrange_interpolation
      basistype = basis_lagrange_hermite_tp_type
    ELSE IF( index( name, 'interpolator.2d.unit.biquadraticLagrange') == 1 ) THEN
      param_arg_handle = fieldml_getobjectbydeclaredname( fieldml_info%FML_HANDLE, &
        & "parameters.2d.unit.biquadraticLagrange.argument"//c_null_char )
      ALLOCATE( basis_interpolations(2), stat = err )
      IF( err /= 0 ) CALL flagerror( "Could not allocate interpolation array.", err, error, *999 )
      ALLOCATE( collapse(2), stat = err )
      IF( err /= 0 ) CALL flagerror( "Could not allocate collapse array.", err, error, *999 )
      basis_interpolations = basis_quadratic_lagrange_interpolation
      basistype = basis_lagrange_hermite_tp_type
    ELSE IF( index( name, 'interpolator.2d.unit.bilinearLagrange') == 1 ) THEN
      param_arg_handle = fieldml_getobjectbydeclaredname( fieldml_info%FML_HANDLE, &
        & "parameters.2d.unit.bilinearLagrange.argument"//c_null_char )
      ALLOCATE( basis_interpolations(2), stat = err )
      IF( err /= 0 ) CALL flagerror( "Could not allocate interpolation array.", err, error, *999 )
      ALLOCATE( collapse(2), stat = err )
      IF( err /= 0 ) CALL flagerror( "Could not allocate collapse array.", err, error, *999 )
      basis_interpolations = basis_linear_lagrange_interpolation
      basistype = basis_lagrange_hermite_tp_type
    ELSE IF( index( name, 'interpolator.1d.unit.linearLagrange') == 1 ) THEN
      param_arg_handle = fieldml_getobjectbydeclaredname( fieldml_info%FML_HANDLE, &
        & "parameters.1d.unit.linearLagrange.argument"//c_null_char )
      ALLOCATE( basis_interpolations(1), stat = err )
      IF( err /= 0 ) CALL flagerror( "Could not allocate interpolation array.", err, error, *999 )
      ALLOCATE( collapse(1), stat = err )
      IF( err /= 0 ) CALL flagerror( "Could not allocate collapse array.", err, error, *999 )
      basis_interpolations = basis_linear_lagrange_interpolation
      basistype = basis_lagrange_hermite_tp_type
    ELSE IF( index( name, 'interpolator.2d.unit.bilinearSimplex') == 1 ) THEN
      param_arg_handle = fieldml_getobjectbydeclaredname( fieldml_info%FML_HANDLE, &
        & "parameters.2d.unit.bilinearSimplex.argument"//c_null_char )
      ALLOCATE( basis_interpolations(2), stat = err )
      IF( err /= 0 ) CALL flagerror( "Could not allocate interpolation array.", err, error, *999 )
      basis_interpolations = basis_linear_simplex_interpolation
      basistype = basis_simplex_type
    ELSE IF( index( name, 'interpolator.2d.unit.biquadraticSimplex') == 1 ) THEN
      param_arg_handle = fieldml_getobjectbydeclaredname( fieldml_info%FML_HANDLE, &
        & "parameters.2d.unit.biquadraticSimplex.argument"//c_null_char )
      ALLOCATE( basis_interpolations(2), stat = err )
      IF( err /= 0 ) CALL flagerror( "Could not allocate interpolation array.", err, error, *999 )
      basis_interpolations = basis_quadratic_simplex_interpolation
      basistype = basis_simplex_type
    ELSE IF( index( name, 'interpolator.3d.unit.trilinearSimplex') == 1 ) THEN
      param_arg_handle = fieldml_getobjectbydeclaredname( fieldml_info%FML_HANDLE, &
        & "parameters.3d.unit.trilinearSimplex.argument"//c_null_char )
      ALLOCATE( basis_interpolations(3), stat = err )
      IF( err /= 0 ) CALL flagerror( "Could not allocate interpolation array.", err, error, *999 )
      basis_interpolations = basis_linear_simplex_interpolation
      basistype = basis_simplex_type
    ELSE IF( index( name, 'interpolator.3d.unit.triquadraticSimplex') == 1 ) THEN
      param_arg_handle = fieldml_getobjectbydeclaredname( fieldml_info%FML_HANDLE, &
        & "parameters.3d.unit.triquadraticSimplex.argument"//c_null_char )
      ALLOCATE( basis_interpolations(3), stat = err )
      IF( err /= 0 ) CALL flagerror( "Could not allocate interpolation array.", err, error, *999 )
      basis_interpolations = basis_quadratic_simplex_interpolation
      basistype = basis_simplex_type
    ELSE
      CALL flagerror( "Basis "//name(1:length)//" cannot yet be interpreted.", err, error, *999 )
    ENDIF
    
    IF( basistype == basis_lagrange_hermite_tp_type ) THEN
      collapse_name = name(1:length)
      CALL fieldml_input_get_basis_collapse( collapse_name, collapse, err, error, *999 )
    ENDIF
    
    CALL fieldml_input_get_basis_connectivity_info( fieldml_info, basis_handle, param_arg_handle, connectivity_handle, &
      & layout_handle, err, error, *999 )

    enters( "FIELDML_INPUT_GET_BASIS_INFO", err, error, *999 )
    exits( "FIELDML_INPUT_GET_BASIS_INFO" )
    RETURN
999 errorsexits( "FIELDML_INPUT_GET_BASIS_INFO", err, error )
    RETURN 1

  END SUBROUTINE fieldml_input_get_basis_info

  !
  !================================================================================================================================
  !

  FUNCTION fieldml_input_is_known_basis( FIELDML_INFO, BASIS_HANDLE, ERR, ERROR )
    !Argument variables
    TYPE(fieldml_io_type), INTENT(IN) :: FIELDML_INFO
    INTEGER(INTG), INTENT(IN) :: BASIS_HANDLE
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    
    !Function
    LOGICAL :: FIELDML_INPUT_IS_KNOWN_BASIS

    !Locals
    INTEGER(INTG) :: LENGTH, LIBRARY_BASIS_HANDLE
    CHARACTER(LEN=MAXSTRLEN) :: NAME
    
    enters( "FIELDML_INPUT_IS_KNOWN_BASIS", err, error, *999 )

    IF( fieldml_getobjecttype( fieldml_info%FML_HANDLE, basis_handle ) /= fht_reference_evaluator ) THEN
      fieldml_input_is_known_basis = .false.
      exits( "FIELDML_INPUT_IS_KNOWN_BASIS" )
      RETURN
    ENDIF

    library_basis_handle = fieldml_getreferencesourceevaluator( fieldml_info%FML_HANDLE, basis_handle )
    length = fieldml_copyobjectdeclaredname( fieldml_info%FML_HANDLE, library_basis_handle, name, maxstrlen )

    IF( ( index( name, 'interpolator.3d.unit.triquadraticLagrange') /= 1 ) .AND. &
      & ( index( name, 'interpolator.1d.unit.linearLagrange') /= 1 ) .AND. &
      & ( index( name, 'interpolator.2d.unit.biquadraticLagrange') /= 1 ) .AND. &
      & ( index( name, 'interpolator.2d.unit.bilinearLagrange') /= 1 ) .AND. &
      & ( index( name, 'interpolator.3d.unit.trilinearLagrange') /= 1 ) .AND. &
      & ( index( name, 'interpolator.2d.unit.bilinearSimplex') /= 1 ) .AND. &
      & ( index( name, 'interpolator.2d.unit.biquadraticSimplex') /= 1 ) .AND. &
      & ( index( name, 'interpolator.3d.unit.trilinearSimplex') /= 1 ) .AND. &
      & ( index( name, 'interpolator.3d.unit.triquadraticSimplex') /= 1 ) ) THEN
      fieldml_input_is_known_basis = .false.
    ELSE
      fieldml_input_is_known_basis = .true.
    ENDIF

    exits( "FIELDML_INPUT_IS_KNOWN_BASIS" )
    RETURN
999 errorsexits( "FIELDML_INPUT_IS_KNOWN_BASIS", err, error )
    
  END FUNCTION fieldml_input_is_known_basis
  
  !
  !================================================================================================================================
  !

  FUNCTION fieldml_input_is_template_compatible( FIELDML_INFO, COMPONENT_HANDLE, ELEMENT_TYPE, ERR, ERROR )
    TYPE(fieldml_io_type), INTENT(IN) :: FIELDML_INFO
    INTEGER(INTG), INTENT(IN) :: COMPONENT_HANDLE
    INTEGER(INTG), INTENT(IN) :: ELEMENT_TYPE
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR

    LOGICAL :: FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE

    INTEGER(INTG) :: OBJECT_TYPE, COUNT, I, EVALUATOR, TYPE, FIRST_EVALUATOR, EVALUATOR_HANDLE, DEFAULT_EVALUATOR

    enters( "FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE", err, error, *999 )
  
    object_type = fieldml_getobjecttype( fieldml_info%FML_HANDLE, component_handle )
    IF( object_type /= fht_piecewise_evaluator ) THEN
      fieldml_input_is_template_compatible = .false.
      exits( "FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE" )
      RETURN
    ENDIF

    evaluator_handle = fieldml_getindexevaluator( fieldml_info%FML_HANDLE, component_handle, 1 )
    TYPE = fieldml_getvaluetype( fieldml_info%FML_HANDLE, evaluator_handle )
    IF( TYPE /= element_type ) THEN
      fieldml_input_is_template_compatible = .true.
      exits( "FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE" )
      RETURN
    ENDIF

    count = fieldml_getevaluatorcount( fieldml_info%FML_HANDLE, component_handle )
    default_evaluator = fieldml_getdefaultevaluator( fieldml_info%FML_HANDLE, component_handle )
    
    IF( default_evaluator /= fml_invalid_handle ) THEN
      IF( .NOT.fieldml_input_is_known_basis( fieldml_info, default_evaluator, err, error ) ) THEN
        fieldml_input_is_template_compatible = .false.
        exits( "FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE" )
        RETURN
      ENDIF
    ENDIF
    IF(err/=0) GOTO 999

    IF( count == 0 ) THEN
      IF( default_evaluator == fml_invalid_handle ) THEN
          fieldml_input_is_template_compatible = .false.
      ELSE
          fieldml_input_is_template_compatible = .true.
      ENDIF
      exits( "FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE" )
      RETURN
    ENDIF

    first_evaluator = fieldml_getevaluator( fieldml_info%FML_HANDLE, component_handle, 1 )
    IF( .NOT. fieldml_input_is_known_basis( fieldml_info, first_evaluator, err, error ) ) THEN
      fieldml_input_is_template_compatible = .false.
      exits( "FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE" )
      RETURN
    ENDIF
    IF(err/=0) GOTO 999

    !At the moment, the code does not support different evaluators per element.

    DO i = 2, count
      evaluator = fieldml_getevaluator( fieldml_info%FML_HANDLE, component_handle, i )
      IF( evaluator /= first_evaluator ) THEN
        fieldml_input_is_template_compatible = .false.
        exits( "FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE" )
        RETURN
      ENDIF
    ENDDO

    fieldml_input_is_template_compatible = .true.

    exits( "FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE" )
    RETURN
999 errorsexits( "FIELDML_INPUT_IS_TEMPLATE_COMPATIBLE", err, error )

  END FUNCTION fieldml_input_is_template_compatible

  !
  !================================================================================================================================
  !

  SUBROUTINE fieldml_input_check_field_compatible( FIELDML_INFO, FIELD_HANDLE, ELEMENT_TYPE, ERR, ERROR, * )
    !Arguments
    TYPE(fieldml_io_type), INTENT(IN) :: FIELDML_INFO
    INTEGER(INTG), INTENT(IN) :: FIELD_HANDLE
    INTEGER(INTG), INTENT(IN) :: ELEMENT_TYPE
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR

    !Locals
    INTEGER(INTG) :: TYPE, COUNT, I, EVALUATOR, DEFAULT_EVALUATOR

    enters( "FIELDML_INPUT_CHECK_FIELD_COMPATIBLE", err, error, *999 )

    TYPE = fieldml_getobjecttype( fieldml_info%FML_HANDLE, field_handle )

    IF( TYPE /= fht_aggregate_evaluator ) THEN
      CALL flagerror( "Field evaluator must be an aggregate evaluator.", err, error, *999 )
    ENDIF

    count = fieldml_getevaluatorcount( fieldml_info%FML_HANDLE, field_handle )
    default_evaluator = fieldml_getdefaultevaluator( fieldml_info%FML_HANDLE, field_handle )

    IF( default_evaluator /= fml_invalid_handle ) THEN
      IF(.NOT.fieldml_input_is_template_compatible( fieldml_info, default_evaluator, element_type, err, error ) ) THEN
        CALL flagerror( "Field evaluator must be use a compatible default.", err, error, *999 )
        exits( "FIELDML_INPUT_CHECK_FIELD_COMPATIBLE" )
        RETURN
      ENDIF
    ENDIF
    IF(err/=0) GOTO 999

    IF( count == 0 ) THEN
      IF( default_evaluator == fml_invalid_handle ) THEN
        CALL flagerror( "Field evaluator must be able to evaluator all field components.", err, error, *999 )
      ENDIF
      exits( "FIELDML_INPUT_CHECK_FIELD_COMPATIBLE" )
      RETURN
    ENDIF

    DO i = 1, count
      evaluator = fieldml_getevaluator( fieldml_info%FML_HANDLE, field_handle, i )
      IF( .NOT. fieldml_input_is_template_compatible( fieldml_info, evaluator, element_type, err, error ) ) THEN
        CALL flagerror( "Field evaluator must use a compatible component evaluator.", err, error, *999 )
        exits( "FIELDML_INPUT_CHECK_FIELD_COMPATIBLE" )
        RETURN
      ENDIF
      IF(err/=0) GOTO 999
    ENDDO

    exits( "FIELDML_INPUT_CHECK_FIELD_COMPATIBLE" )
    RETURN
999 errorsexits( "FIELDML_INPUT_CHECK_FIELD_COMPATIBLE", err, error )
    RETURN 1

  END SUBROUTINE fieldml_input_check_field_compatible

  !
  !================================================================================================================================
  !

  SUBROUTINE fieldmlinput_coordinatesystemcreatestart( FIELDML_INFO, EVALUATOR_NAME, COORDINATE_SYSTEM, USER_NUMBER, &
    & err, error, * )
    !Arguments
    TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
    TYPE(varying_string), INTENT(IN) :: EVALUATOR_NAME
    TYPE(coordinate_system_type), POINTER, INTENT(IN) :: COORDINATE_SYSTEM
    INTEGER(INTG), INTENT(IN) :: USER_NUMBER
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR

    !Locals
    INTEGER(INTG) :: EVALUATOR_HANDLE
    INTEGER(INTG) :: TYPE_HANDLE, LENGTH
    CHARACTER(LEN=MAXSTRLEN) :: NAME
    INTEGER(INTG) :: COORDINATE_TYPE
    INTEGER(INTG) :: COORDINATE_COUNT

    enters( "FieldmlInput_CoordinateSystemCreateStart", err, error, *999 )
    
    CALL fieldml_assert_is_in( fieldml_info, err, error, *999 )

    coordinate_type = 0 !There doesn't seem to be a COORDINATE_UNKNOWN_TYPE

    evaluator_handle = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, cchar(evaluator_name) )
    CALL fieldml_util_check_fieldml_error( "Cannot get coordinate evaluator for geometric field "//evaluator_name//".", &
      & fieldml_info%FML_HANDLE, err, error, *999 )

    type_handle = fieldml_getvaluetype( fieldml_info%FML_HANDLE, evaluator_handle )
    CALL fieldml_util_check_fieldml_error( "Cannot get value type for geometric field "//evaluator_name//".", &
      & fieldml_info%FML_HANDLE, err, error, *999 )

    length = fieldml_copyobjectdeclaredname( fieldml_info%FML_HANDLE, type_handle, name, maxstrlen )

    IF( index( name, 'coordinates.rc.3d' ) == 1 ) THEN
      coordinate_type = coordinate_rectangular_cartesian_type
      coordinate_count = 3
    ELSE IF( index( name, 'coordinates.rc.2d' ) == 1 ) THEN
      coordinate_type = coordinate_rectangular_cartesian_type
      coordinate_count = 2
    ELSE
      CALL flagerror( "Coordinate system "//name(1:length)//" not yet supported.", err, error, *999 )
    ENDIF

    CALL coordinate_system_create_start( user_number, coordinate_system, err, error, *999 )
    !Set the coordinate system dimension and type
    CALL coordinate_system_dimension_set( coordinate_system, coordinate_count, err, error, *999 )
    CALL coordinate_system_type_set( coordinate_system, coordinate_type, err, error, *999 )

    exits( "FieldmlInput_CoordinateSystemCreateStart" )
    RETURN
999 errorsexits( "FieldmlInput_CoordinateSystemCreateStart", err, error )
    RETURN 1

  END SUBROUTINE fieldmlinput_coordinatesystemcreatestart


  !
  !================================================================================================================================
  !
  
  SUBROUTINE fieldml_input_nodes_create_start( FIELDML_INFO, NODES_ARGUMENT_NAME, REGION, NODES, ERR, ERROR, * )
    !Arguments
    TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
    TYPE(varying_string), INTENT(IN) :: NODES_ARGUMENT_NAME
    TYPE(region_type), POINTER, INTENT(IN) :: REGION
    TYPE(nodes_type), POINTER, INTENT(INOUT) :: NODES
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR

    !Locals
    INTEGER(INTG) :: NODES_ARGUMENT_HANDLE, NODES_HANDLE, NODE_COUNT
    
    enters( "FIELDML_INPUT_NODES_CREATE_START", err, error, *999 )
    
    CALL fieldml_assert_is_in( fieldml_info, err, error, *999 )

    nodes_argument_handle = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, cchar(nodes_argument_name) )
    IF( nodes_argument_handle == fml_invalid_handle ) THEN
      CALL flagerror( "Nodes argument name "//nodes_argument_name//" is invalid.", err, error, *999 )
    END IF

    IF( fieldml_getobjecttype( fieldml_info%FML_HANDLE, nodes_argument_handle ) /= fht_argument_evaluator ) THEN
      CALL flagerror( "Nodes argument "//nodes_argument_name//" type is not an argument evaluator.", err, error, *999 )
    ENDIF

    nodes_handle = fieldml_getvaluetype( fieldml_info%FML_HANDLE, nodes_argument_handle )
    IF( nodes_handle == fml_invalid_handle ) THEN
      CALL flagerror( "Nodes argument "//nodes_argument_name//" type is invalid.", err, error, *999 )
    END IF

    fieldml_info%NODES_ARGUMENT_HANDLE = nodes_argument_handle
    fieldml_info%NODES_HANDLE = nodes_handle

    node_count = fieldml_getmembercount( fieldml_info%FML_HANDLE, fieldml_info%NODES_HANDLE )
    NULLIFY( nodes )
    CALL nodes_create_start( region, node_count, nodes, err, error, *999 )

    exits( "FIELDML_INPUT_NODES_CREATE_START" )
    RETURN
999 errorsexits( "FIELDML_INPUT_NODES_CREATE_START", err, error )
    RETURN 1

  END SUBROUTINE fieldml_input_nodes_create_start


  !
  !================================================================================================================================
  !

  SUBROUTINE fieldml_input_mesh_create_start( FIELDML_INFO, MESH_ARGUMENT_NAME, MESH, MESH_NUMBER, REGION, ERR, ERROR, * )
    !Arguments
    TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
    TYPE(varying_string), INTENT(IN) :: MESH_ARGUMENT_NAME
    TYPE(mesh_type), POINTER, INTENT(INOUT) :: MESH
    INTEGER(INTG), INTENT(IN) :: MESH_NUMBER
    TYPE(region_type), POINTER, INTENT(IN) :: REGION
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR

    !Locals
    INTEGER(INTG) :: COUNT
    INTEGER(INTG) :: MESH_ARGUMENT, XI_DIMENSIONS, ELEMENT_COUNT

    enters( "FIELDML_INPUT_MESH_CREATE_START", err, error, *999 )
    
    CALL fieldml_assert_is_in( fieldml_info, err, error, *999 )
    
    mesh_argument = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, cchar(mesh_argument_name) )
    IF( mesh_argument == fml_invalid_handle ) THEN
      CALL fieldml_util_check_fieldml_error( "Named mesh argument "//mesh_argument_name//" not found.", &
        & fieldml_info%FML_HANDLE, err, error, *999 )
    ENDIF

    fieldml_info%MESH_HANDLE = fieldml_getvaluetype( fieldml_info%FML_HANDLE, mesh_argument )
    IF( fieldml_info%MESH_HANDLE == fml_invalid_handle ) THEN
      CALL fieldml_util_check_fieldml_error( "Invalid mesh argument type for "//mesh_argument_name//".", &
        & fieldml_info%FML_HANDLE, err, error, *999 )
    ENDIF
    
    fieldml_info%ELEMENTS_HANDLE = fieldml_getmeshelementstype( fieldml_info%FML_HANDLE, fieldml_info%MESH_HANDLE )
    fieldml_info%ELEMENTS_ARGUMENT_HANDLE = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, &
      & cchar(mesh_argument_name//".element"))

    fieldml_info%XI_HANDLE = fieldml_getmeshcharttype( fieldml_info%FML_HANDLE, fieldml_info%MESH_HANDLE )
    fieldml_info%XI_ARGUMENT_HANDLE = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, cchar(mesh_argument_name//".xi") )

    count = fieldml_gettypecomponentcount( fieldml_info%FML_HANDLE, fieldml_info%XI_HANDLE )
    IF( ( count < 1 ) .OR. ( count > 3 ) ) THEN
      CALL flagerror( "Mesh "//mesh_argument_name//" dimension cannot be greater than 3, or less than 1.", &
        & err, error, *999 )
    ENDIF

    xi_dimensions = fieldml_gettypecomponentcount( fieldml_info%FML_HANDLE, fieldml_info%XI_HANDLE )
    element_count = fieldml_getmembercount( fieldml_info%FML_HANDLE, fieldml_info%ELEMENTS_HANDLE )
    NULLIFY( mesh )
    CALL mesh_create_start( mesh_number, region, xi_dimensions, mesh, err, error, *999 )
    CALL mesh_number_of_elements_set( mesh, element_count, err, error, *999 )
    
    exits( "FIELDML_INPUT_MESH_CREATE_START" )
    RETURN
999 errorsexits( "FIELDML_INPUT_MESH_CREATE_START", err, error )
    RETURN 1

  END SUBROUTINE fieldml_input_mesh_create_start

  !
  !================================================================================================================================
  !
  
  SUBROUTINE fieldml_input_basis_create_start( FIELDML_INFO, EVALUATOR_NAME, USER_NUMBER, BASIS, ERR, ERROR, * )
    !Arguments
    TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
    TYPE(varying_string), INTENT(IN) :: EVALUATOR_NAME
    INTEGER(INTG), INTENT(IN) :: USER_NUMBER
    TYPE(basis_type), POINTER, INTENT(INOUT) :: BASIS
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR

    !Locals
    INTEGER(INTG) :: LIST_INDEX
    INTEGER(INTG) :: HANDLE, CONNECTIVITY_HANDLE, LAYOUT_HANDLE, FML_ERR
    INTEGER(INTG) :: BASISTYPE
    INTEGER(INTG), ALLOCATABLE :: BASIS_INTERPOLATIONS(:)
    INTEGER(INTG), ALLOCATABLE :: COLLAPSE(:)
    
    enters( "FIELDML_INPUT_BASIS_CREATE_START", err, error, *999 )
    
    CALL fieldml_assert_is_in( fieldml_info, err, error, *999 )

    handle = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, cchar(evaluator_name) )
    CALL fieldml_util_check_fieldml_error( "Cannot find basis evaluator "//evaluator_name//".", fieldml_info%FML_HANDLE, &
      & err, error, *999 )
    CALL list_item_in_list( fieldml_info%BASIS_HANDLES, handle, list_index, err, error, *999 )
    IF( list_index /= 0 ) THEN
      CALL flagerror( "Named basis "//evaluator_name//" already created", err, error, *999 )
    ENDIF
    
    CALL fieldml_input_get_basis_info( fieldml_info, handle, connectivity_handle, layout_handle, basistype, &
      & basis_interpolations, collapse, err, error, *999 )
    
    CALL list_item_add( fieldml_info%BASIS_HANDLES, handle, err, error, *999 )
    CALL list_item_add( fieldml_info%BASIS_CONNECTIVITY_HANDLES, connectivity_handle, err, error, *999 )
    CALL list_item_add( fieldml_info%BASIS_LAYOUT_HANDLES, layout_handle, err, error, *999 )
    fml_err = fieldml_setobjectint( fieldml_info%FML_HANDLE, handle, user_number )
    CALL fieldml_util_check_fieldml_error( "Cannot set user number for basis "//evaluator_name//".", &
      & fieldml_info%FML_HANDLE, err, error, *999 )
  
    NULLIFY(basis)
    CALL basis_create_start( user_number, basis, err, error, *999 )
    CALL basis_type_set( basis, basistype, err, error, *999 )
    CALL basis_number_of_xi_set( basis, size( basis_interpolations ), err, error, *999 )
    CALL basis_interpolation_xi_set( basis, basis_interpolations, err, error, *999 )
    !Note: collapse bases currently only supported for BASIS_LAGRANGE_HERMITE_TP_TYPE
    IF( size( basis_interpolations ) > 1 .AND. ALLOCATED(collapse)) THEN
      CALL basis_collapsed_xi_set( basis, collapse, err, error, *999 )
    ENDIF
    
    IF( ALLOCATED( basis_interpolations ) ) THEN
      DEALLOCATE( basis_interpolations )
    ENDIF
    IF( ALLOCATED( collapse ) ) THEN
      DEALLOCATE( collapse )
    ENDIF
    
    exits( "FIELDML_INPUT_BASIS_CREATE_START" )
    RETURN
999 errorsexits( "FIELDML_INPUT_BASIS_CREATE_START", err, error )
    RETURN 1

  END SUBROUTINE

  !
  !================================================================================================================================
  !

  SUBROUTINE fieldml_input_initialise_from_file( FIELDML_INFO, FILENAME, ERR, ERROR, * )
    !Arguments
    TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
    TYPE(varying_string), INTENT(IN) :: FILENAME
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    
    !Locals
    INTEGER(INTG) :: LENGTH, COUNT, I, FML_ERR
    CHARACTER(LEN=MAXSTRLEN) :: NAME
    
    enters( "FIELDML_INPUT_INITIALISE_FROM_FILE", err, error, *999 )

    CALL fieldml_io_initialise( fieldml_info, .false., err, error, *999 )

    fieldml_info%FML_HANDLE = fieldml_createfromfile( cchar(filename) )
    
    fml_err = fieldml_getlasterror( fieldml_info%FML_HANDLE )
    IF( fml_err /= fml_err_no_error ) THEN
      count = fieldml_geterrorcount( fieldml_info%FML_HANDLE )
      DO i = 1,count
        length = fieldml_copyerror( fieldml_info%FML_HANDLE, i, name, maxstrlen )
         CALL write_string_value(error_output_type,"FieldML parse error: ",name(1:length),err,error,*999)
      ENDDO
      CALL flagerror( "Cannot create FieldML handle from file "//filename//".", err, error, *999 )
    ENDIF

    exits( "FIELDML_INPUT_INITIALISE_FROM_FILE" )
    RETURN
999 errorsexits( "FIELDML_INPUT_INITIALISE_FROM_FILE", err, error )
    RETURN 1
    
  END SUBROUTINE fieldml_input_initialise_from_file

  !
  !================================================================================================================================
  !
  
  SUBROUTINE fieldml_input_read_order( FIELDML_INFO, ORDER_HANDLE, ORDER, COUNT, ERR, ERROR, * )
    !Argument
    TYPE(fieldml_io_type), INTENT(IN) :: FIELDML_INFO
    INTEGER(INTG), INTENT(IN) :: ORDER_HANDLE
    INTEGER(INTG), ALLOCATABLE, TARGET, INTENT(INOUT) :: ORDER(:)
    INTEGER(INTG), INTENT(IN) :: COUNT
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    
    !Locals
    INTEGER(INTG) :: READER_HANDLE, RANK, FML_ERR
    INTEGER(INTG), TARGET :: OFFSETS(1), SIZES(1)
    
    enters( "FIELDML_INPUT_READ_ORDER", err, error, *999 )

    IF( order_handle == fml_invalid_handle ) THEN
      !This is permitted, and indeed common.
      exits( "FIELDML_INPUT_READ_ORDER" )
      RETURN
    ENDIF
    
    rank = fieldml_getarraydatasourcerank( fieldml_info%FML_HANDLE, order_handle )
    IF( rank /= 1 ) THEN
      CALL flagerror( "Invalid rank for ensemble order.", err, error, *999 )
    ENDIF
    
    reader_handle = fieldml_openreader( fieldml_info%FML_HANDLE, order_handle )
    CALL fieldml_util_check_fieldml_error( "Cannot open order reader.", fieldml_info%FML_HANDLE, err, error, *999 )
    
    ALLOCATE( order(count), stat = err )
    IF( err /= 0 ) CALL flagerror( "Could not allocate order array.", err, error, *999 )
    offsets(:) = 0
    sizes(1) = count

    fml_err = fieldml_readintslab( reader_handle, c_loc(offsets), c_loc(sizes), c_loc(order) )
    IF( fml_err /= fml_err_no_error ) THEN
      CALL flagerror( "Error reading order data"//"("// trim(number_to_vstring(fml_err,"*",err,error)) //").", &
        & err, error, *999 )
    ENDIF

    fml_err = fieldml_closereader( reader_handle )
    
    exits( "FIELDML_INPUT_READ_ORDER" )
    RETURN
999 errorsexits( "FIELDML_INPUT_READ_ORDER", err, error )
    RETURN 1

  END SUBROUTINE fieldml_input_read_order

  !
  !================================================================================================================================
  !

  SUBROUTINE fieldml_input_reorder( INPUT_BUFFER, ORDER, COUNT, OUTPUT_BUFFER, ERR, ERROR, * )
    !Argument
    INTEGER(INTG), INTENT(IN) :: INPUT_BUFFER(:)
    INTEGER(INTG), ALLOCATABLE, INTENT(IN) :: ORDER(:)
    INTEGER(INTG), INTENT(IN) :: COUNT
    INTEGER(INTG), INTENT(INOUT) :: OUTPUT_BUFFER(:)
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
  
    !Locals
    INTEGER(INTG) :: I
    
    enters( "FIELDML_INPUT_REORDER", err, error, *999 )
    
    IF( ALLOCATED( order ) ) THEN
      DO i = 1,count
        output_buffer( i ) = input_buffer( order( i ) )
      ENDDO
    ELSE
      output_buffer = input_buffer
    ENDIF

    exits( "FIELDML_INPUT_REORDER" )
    RETURN
999 errorsexits( "FIELDML_INPUT_REORDER", err, error )
    RETURN 1
  
  END SUBROUTINE fieldml_input_reorder

  !
  !================================================================================================================================
  !

  SUBROUTINE fieldml_input_create_mesh_component( FIELDML_INFO, MESH, COMPONENT_NUMBER, EVALUATOR_NAME, ERR, ERROR, * )
    !Arguments
    TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
    TYPE(mesh_type), POINTER, INTENT(IN) :: MESH
    INTEGER(INTG), INTENT(IN) :: COMPONENT_NUMBER
    TYPE(varying_string), INTENT(IN) :: EVALUATOR_NAME
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    
    !Locals
    INTEGER(INTG) :: HANDLE, BASIS_REFERENCE_HANDLE, CONNECTIVITY_HANDLE, LAYOUT_HANDLE, BASIS_NUMBER, LAST_BASIS_HANDLE
    INTEGER(INTG), ALLOCATABLE, TARGET :: NODES_BUFFER(:), RAW_BUFFER(:)
    INTEGER(INTG) :: COMPONENT_COUNT, ELEMENT_COUNT, KNOWN_BASIS_COUNT, MAX_BASIS_NODES_COUNT, BASIS_NODES_COUNT
    INTEGER(INTG) :: ELEMENT_NUMBER, KNOWN_BASIS_NUMBER, COUNT
    INTEGER(INTG), TARGET :: OFFSETS(2), SIZES(2)
    INTEGER(INTG), ALLOCATABLE :: CONNECTIVITY_READERS(:), CONNECTIVITY_COUNTS(:)
    TYPE(integer_cint_alloc_type), ALLOCATABLE :: CONNECTIVITY_ORDERS(:)
    INTEGER(INTG) :: TEMP_POINTER, DATA_SOURCE, ORDER_HANDLE, TEMP_BASIS_HANDLE, FML_ERR
    TYPE(basis_type), POINTER :: BASIS
    TYPE(meshelementstype), POINTER :: MESH_ELEMENTS

    enters( "FIELDML_INPUT_CREATE_MESH_COMPONENT", err, error, *999 )
    
    CALL fieldml_assert_is_in( fieldml_info, err, error, *999 )
    
    NULLIFY( basis )
    NULLIFY( mesh_elements )    

    handle = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, cchar(evaluator_name) )
    IF( .NOT. fieldml_input_is_template_compatible( fieldml_info, handle, fieldml_info%ELEMENTS_HANDLE, err, error ) ) THEN
      CALL flagerror( "Mesh component cannot be created from evaluator "//evaluator_name//".", err, error, *999 )
    ENDIF
    IF(err/=0) GOTO 999
    
    CALL list_number_of_items_get( fieldml_info%COMPONENT_HANDLES, count, err, error, *999 )
    IF( count < component_number ) THEN
      DO component_count = count + 1, component_number
        CALL list_item_add( fieldml_info%COMPONENT_HANDLES, fml_invalid_handle, err, error, *999 )
      ENDDO
    ENDIF
    
    CALL list_item_set( fieldml_info%COMPONENT_HANDLES, component_number, handle, err, error, *999 )
    
    CALL list_number_of_items_get( fieldml_info%BASIS_HANDLES, known_basis_count, err, error, *999 )
    ALLOCATE( connectivity_readers( known_basis_count ), stat = err )
    IF( err /= 0 ) CALL flagerror( "Could not allocate connectivity readers for "//evaluator_name//".", err, error, *999 )
    ALLOCATE( connectivity_counts( known_basis_count ), stat = err )
    IF( err /= 0 ) CALL flagerror( "Could not allocate connectivity counts for "//evaluator_name//".", err, error, *999 )
    ALLOCATE( connectivity_orders( known_basis_count ), stat = err )
    IF( err /= 0 ) CALL flagerror( "Could not allocate connectivity orders for "//evaluator_name//".", err, error, *999 )
    
    max_basis_nodes_count = 0
    DO known_basis_number = 1, known_basis_count
      CALL list_item_get( fieldml_info%BASIS_LAYOUT_HANDLES, known_basis_number, layout_handle, err, error, *999 )
      CALL list_item_get( fieldml_info%BASIS_CONNECTIVITY_HANDLES, known_basis_number, connectivity_handle, &
        & err, error, *999 )
        
      basis_nodes_count = fieldml_getmembercount( fieldml_info%FML_HANDLE, layout_handle )
      CALL fieldml_util_check_fieldml_error( "Cannot get local node count for layout for mesh component "//evaluator_name//".", &
        & fieldml_info%FML_HANDLE, err, error, *999 )

      IF( basis_nodes_count > max_basis_nodes_count ) THEN
        max_basis_nodes_count = basis_nodes_count
      ENDIF
      
      order_handle = fieldml_getparameterindexorder( fieldml_info%FML_HANDLE, connectivity_handle, 1 )
      CALL fieldml_input_read_order( fieldml_info, order_handle, connectivity_orders( known_basis_number )%ARRAY, &
        & basis_nodes_count, err, error, *999 )
    
      data_source = fieldml_getdatasource( fieldml_info%FML_HANDLE, connectivity_handle )
      connectivity_readers(known_basis_number) = fieldml_openreader( fieldml_info%FML_HANDLE, data_source )
      connectivity_counts(known_basis_number) = basis_nodes_count
      CALL fieldml_util_check_fieldml_error( "Cannot open connectivity reader for mesh component "//evaluator_name//".", &
        & fieldml_info%FML_HANDLE, err, error, *999 )
      
    END DO

    ALLOCATE( nodes_buffer( max_basis_nodes_count ), stat = err )
    IF( err /= 0 ) CALL flagerror( "Could not allocate nodes buffer for "//evaluator_name//".", err, error, *999 )
    ALLOCATE( raw_buffer( max_basis_nodes_count ), stat = err )
    IF( err /= 0 ) CALL flagerror( "Could not allocate raw nodes buffer for "//evaluator_name//".", err, error, *999 )

    element_count = fieldml_getmembercount( fieldml_info%FML_HANDLE, fieldml_info%ELEMENTS_HANDLE )
    CALL fieldml_util_check_fieldml_error( "Cannot get element count for mesh with component "//evaluator_name//".", &
      & fieldml_info%FML_HANDLE, err, error, *999 )
    
    last_basis_handle = fml_invalid_handle
    
    offsets(:) = 0
    sizes(1) = 1
    sizes(2) = 0
    
    DO element_number = 1, element_count
      basis_reference_handle = fieldml_getelementevaluator( fieldml_info%FML_HANDLE, handle, element_number, 1 )
      CALL fieldml_util_check_fieldml_error( "Cannot get element evaluator from mesh component "//evaluator_name//".", &
        & fieldml_info%FML_HANDLE, err, error, *999 )
      
      IF( basis_reference_handle /= last_basis_handle ) THEN
        basis_number = fieldml_getobjectint( fieldml_info%FML_HANDLE, basis_reference_handle )
        CALL fieldml_util_check_fieldml_error( "Cannot get basis user number for element evaluator for mesh component "//&
          & evaluator_name//".", fieldml_info%FML_HANDLE, err, error, *999 )
        CALL basis_user_number_find( basis_number, basis, err, error, *999 )
        IF( .NOT. ASSOCIATED( basis ) ) THEN
          CALL flagerror( "Basis not found for component "//evaluator_name//".", err, error, *999 ) 
        ENDIF
        last_basis_handle = basis_reference_handle
      ENDIF

      IF( element_number == 1 ) THEN
        CALL mesh_topology_elements_create_start( mesh, component_number, basis, mesh_elements, err, error, *999 )
      ENDIF
      
      CALL mesh_topology_elements_element_basis_set( element_number, mesh_elements, basis, err, error, *999 )
      
      DO known_basis_number = 1, known_basis_count
        basis_nodes_count = connectivity_counts( known_basis_number )
        !BUGFIX Intel compiler will explode if we don't use a temporary variable
        temp_pointer = connectivity_readers(known_basis_number)
        sizes(2) = basis_nodes_count
        fml_err = fieldml_readintslab( temp_pointer, &
          & c_loc(offsets), c_loc(sizes), c_loc(raw_buffer) )
        IF( fml_err /= fml_err_no_error ) THEN
          CALL flagerror( "Error reading connectivity for "//evaluator_name//"("// &
            & trim(number_to_vstring(fml_err,"*",err,error)) //").", err, error, *999 )
        ENDIF
        CALL list_item_get( fieldml_info%BASIS_HANDLES, known_basis_number, temp_basis_handle, err, error, *999 )
        IF( temp_basis_handle == basis_reference_handle ) THEN
          CALL fieldml_input_reorder( raw_buffer, connectivity_orders(known_basis_number)%ARRAY, basis_nodes_count, &
            & nodes_buffer, err, error, *999 )
          CALL mesh_topology_elements_element_nodes_set( element_number, mesh_elements, nodes_buffer(1:basis_nodes_count), &
            & err, error, *999 )
        ENDIF
      ENDDO
      
      offsets(1) = offsets(1) + 1
  
    END DO
    
    DO known_basis_number = 1, known_basis_count
      !BUGFIX Intel compiler will explode if we don't use a temporary variable
      temp_pointer = connectivity_readers(known_basis_number)
      fml_err = fieldml_closereader( temp_pointer )
      IF( fml_err /= fml_err_no_error ) THEN
        CALL flagerror( "Error closing connectivity reader for "//evaluator_name//"("// &
          & trim(number_to_vstring(fml_err,"*",err,error)) //").", err, error, *999 )
      ENDIF
      IF( ALLOCATED( connectivity_orders( known_basis_number )%ARRAY ) ) THEN
        DEALLOCATE( connectivity_orders( known_basis_number )%ARRAY )
      ENDIF
    ENDDO
    
    DEALLOCATE( nodes_buffer )
    DEALLOCATE( connectivity_readers )
    DEALLOCATE( connectivity_counts )
    DEALLOCATE( connectivity_orders )
    
    CALL mesh_topology_elements_create_finish( mesh_elements, err, error, *999 )
    
    fml_err = fieldml_setobjectint( fieldml_info%FML_HANDLE, handle, component_number )

    exits( "FIELDML_INPUT_CREATE_MESH_COMPONENT" )
    RETURN
999 errorsexits( "FIELDML_INPUT_CREATE_MESH_COMPONENT", err, error )
    IF( ALLOCATED( nodes_buffer ) ) THEN
      DEALLOCATE( nodes_buffer )
    ENDIF
    IF( ALLOCATED( connectivity_readers ) ) THEN
      DEALLOCATE( connectivity_readers )
    ENDIF
    IF( ALLOCATED( connectivity_counts ) ) THEN
      DEALLOCATE( connectivity_counts )
    ENDIF
    IF( ALLOCATED( connectivity_orders ) ) THEN
      DO known_basis_number = 1, known_basis_count
        IF( ALLOCATED( connectivity_orders( known_basis_number )%ARRAY ) ) THEN
          DEALLOCATE( connectivity_orders( known_basis_number )%ARRAY )
        ENDIF
      ENDDO
    
      DEALLOCATE( connectivity_orders )
    ENDIF
    
    exits( "FIELDML_INPUT_CREATE_MESH_COMPONENT" )
    RETURN 1

  END SUBROUTINE fieldml_input_create_mesh_component

  !
  !================================================================================================================================
  !
  
  SUBROUTINE fieldml_input_field_create_start( FIELDML_INFO, REGION, DECOMPOSITION, FIELD_NUMBER, FIELD, VARIABLE_TYPE, &
    & evaluator_name, err, error, * )
    !Arguments
    TYPE(fieldml_io_type), POINTER :: FIELDML_INFO
    TYPE(region_type), POINTER, INTENT(IN) :: REGION
    TYPE(decomposition_type), POINTER, INTENT(IN) :: DECOMPOSITION
    INTEGER(INTG), INTENT(IN) :: FIELD_NUMBER
    TYPE(field_type), POINTER, INTENT(INOUT) :: FIELD
    INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
    TYPE(varying_string), INTENT(IN) :: EVALUATOR_NAME
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    
    !Locals
    INTEGER(INTG) :: FIELD_HANDLE, TEMPLATE_HANDLE, TYPE_HANDLE
    INTEGER(INTG) :: COMPONENT_NUMBER, TEMPLATE_COMPONENT_NUMBER, FIELD_DIMENSIONS

    enters( "FIELDML_INPUT_FIELD_CREATE_START", err, error, *999 )
    
    CALL fieldml_assert_is_in( fieldml_info, err, error, *999 )

    field_handle = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, cchar(evaluator_name) )
    CALL fieldml_util_check_fieldml_error( "Cannot get named field evaluator "//evaluator_name//".", &
      & fieldml_info%FML_HANDLE, err, error, *999 )
    type_handle = fieldml_getvaluetype( fieldml_info%FML_HANDLE, field_handle )
    CALL fieldml_util_check_fieldml_error( "Cannot get named field evaluator's value type for "//evaluator_name//".", &
      & fieldml_info%FML_HANDLE, err, error, *999 )
    field_dimensions = fieldml_gettypecomponentcount( fieldml_info%FML_HANDLE, type_handle )
    CALL fieldml_util_check_fieldml_error( "Cannot get named field evaluator's component count for "//evaluator_name//".", &
      & fieldml_info%FML_HANDLE, err, error, *999 )
    
    CALL fieldml_input_check_field_compatible( fieldml_info, field_handle, fieldml_info%ELEMENTS_HANDLE, err, error, *999 )

    NULLIFY( field )
    CALL field_create_start( field_number, region, field, err, error, *999 )
    CALL field_type_set( field, field_geometric_type, err, error, *999 )
    CALL field_mesh_decomposition_set( field, decomposition, err, error, *999 )
    CALL field_scaling_type_set( field, field_no_scaling, err, error, *999 )

    DO component_number = 1, field_dimensions
      template_handle = fieldml_getelementevaluator( fieldml_info%FML_HANDLE, field_handle, component_number, 1 )
      CALL fieldml_util_check_fieldml_error( var_str("Cannot get field component ")//component_number//" evaluator for "//&
        & evaluator_name//".", fieldml_info%FML_HANDLE, err, error, *999 )

      template_component_number = fieldml_getobjectint( fieldml_info%FML_HANDLE, template_handle )
      CALL fieldml_util_check_fieldml_error( var_str("Cannot get mesh component number for field component ")//component_number//&
        & " of "//evaluator_name//".", fieldml_info%FML_HANDLE, err, error, *999 )

      CALL field_component_mesh_component_set( field, variable_type, component_number, template_component_number, &
        & err, error, *999 )
    ENDDO

    exits( "FIELDML_INPUT_FIELD_CREATE_START" )
    RETURN
999 errorsexits( "FIELDML_INPUT_FIELD_CREATE_START", err, error )
    RETURN 1
  
  END SUBROUTINE fieldml_input_field_create_start

  !
  !================================================================================================================================
  !

  SUBROUTINE fieldml_input_field_parameters_update(FIELDML_INFO, EVALUATOR_NAME, FIELD, VARIABLE_TYPE, SET_TYPE, &
    & err, error, * )
    !Argument variables
    TYPE(fieldml_io_type), INTENT(INOUT) :: FIELDML_INFO
    TYPE(varying_string), INTENT(IN) :: EVALUATOR_NAME
    TYPE(field_type), POINTER, INTENT(INOUT) :: FIELD
    INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
    INTEGER(INTG), INTENT(IN) :: SET_TYPE
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Local Variables
    INTEGER(INTG) :: component_idx,INTERPOLATION_TYPE,MESH_COMPONENT1,MESH_COMPONENT2,NUMBER_OF_COMPONENTS
    LOGICAL :: IS_ALL_NODAL_INTERPOLATION,IS_SAME_MESH_COMPONENTS

    enters("FIELDML_INPUT_FIELD_PARAMETERS_UPDATE",err,error,*999)

    IF(ASSOCIATED(field)) THEN
      CALL field_number_of_components_get(field,variable_type,number_of_components,err,error,*999)
      IF(number_of_components>0) THEN
        CALL field_component_interpolation_get(field,variable_type,1,interpolation_type,err,error,*999)
        CALL field_component_mesh_component_get(field,variable_type,1,mesh_component1,err,error,*999)
        is_all_nodal_interpolation=interpolation_type==field_node_based_interpolation
        is_same_mesh_components=.true.
        DO component_idx=2,number_of_components
          CALL field_component_interpolation_get(field,variable_type,component_idx,interpolation_type,err,error,*999)
          CALL field_component_mesh_component_get(field,variable_type,component_idx,mesh_component2,err,error,*999)
          is_all_nodal_interpolation=is_all_nodal_interpolation.AND.interpolation_type==field_node_based_interpolation
          is_same_mesh_components=is_same_mesh_components.AND.mesh_component2==mesh_component1
        ENDDO !component_idx
        IF(is_all_nodal_interpolation) THEN
          IF(is_same_mesh_components) THEN
            CALL fieldmlinput_fieldnodalparametersupdate(fieldml_info,evaluator_name,field,variable_type,set_type, &
              & err,error,*999)
          ELSE
            CALL flagerror( &
              & "FieldML input parameters only implemented for fields where all components have the same mesh component.", &
              & err,error,*999)            
          ENDIF
        ELSE
          CALL flagerror("FieldML input parameters only implemented for fields where all components are nodally interpolated.", &
            & err,error,*999)
        ENDIF
      ELSE
        CALL flagerror("Field does not have any components.",err,error,*999)
      ENDIF
    ELSE
      CALL flagerror("Field is not associated.",err,error,*999)
    ENDIF

    exits("FIELDML_INPUT_FIELD_PARAMETERS_UPDATE")
    RETURN
999 errorsexits("FIELDML_INPUT_FIELD_PARAMETERS_UPDATE",err,error)
    RETURN 1
  END SUBROUTINE fieldml_input_field_parameters_update

  !
  !================================================================================================================================
  !

  SUBROUTINE fieldmlinput_fieldnodalparametersupdate( FIELDML_INFO, EVALUATOR_NAME, FIELD, VARIABLE_TYPE, SET_TYPE, &
    & err, error, * )
    !Arguments
    TYPE(fieldml_io_type), INTENT(INOUT) :: FIELDML_INFO
    TYPE(varying_string), INTENT(IN) :: EVALUATOR_NAME
    TYPE(field_type), POINTER, INTENT(INOUT) :: FIELD
    INTEGER(INTG), INTENT(IN) :: VARIABLE_TYPE
    INTEGER(INTG), INTENT(IN) :: SET_TYPE
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    
    !Locals
    TYPE(mesh_type), POINTER :: MESH
    TYPE(nodes_type), POINTER :: NODES
    INTEGER(INTG) :: NODAL_DOFS_HANDLE, DATA_SOURCE, FML_ERR, RANK
    INTEGER(INTG) :: VERSION_NUMBER,COMPONENT_NUMBER, NODE_NUMBER, FIELD_DIMENSIONS, MESH_NODE_COUNT
    INTEGER(INTG), TARGET :: OFFSETS(2), SIZES(2)
    REAL(C_DOUBLE), ALLOCATABLE, TARGET :: BUFFER(:)
    INTEGER(INTG) :: READER
    INTEGER(INTG) :: myComputationalNodeNumber,nodeDomain,meshComponentNumber
    
    enters( "FieldmlInput_FieldNodalParametersUpdate", err, error, *999 )
    
    mesh => field%DECOMPOSITION%MESH

    nodal_dofs_handle = fieldml_getobjectbyname( fieldml_info%FML_HANDLE, cchar(evaluator_name) )
    CALL fieldml_util_check_fieldml_error( "Cannot get nodal field dofs evaluator "//evaluator_name//".", &
      & fieldml_info%FML_HANDLE, err, error, *999 )
  
    data_source = fieldml_getdatasource( fieldml_info%FML_HANDLE, nodal_dofs_handle )
    CALL fieldml_util_check_fieldml_error( "Cannot get nodal data source for "//evaluator_name//".", &
      & fieldml_info%FML_HANDLE, err, error, *999 )
      
    rank = fieldml_getarraydatasourcerank( fieldml_info%FML_HANDLE, data_source )
    IF( rank /= 2 ) THEN
      CALL flagerror( "Invalid rank for nodal dofs.", err, error, *999 )
    ENDIF

    reader = fieldml_openreader( fieldml_info%FML_HANDLE, data_source )
    CALL fieldml_util_check_fieldml_error( "Cannot open nodal dofs reader for "//evaluator_name//".", &
      & fieldml_info%FML_HANDLE, err, error, *999 )
    
    CALL field_number_of_components_get( field, variable_type, field_dimensions, err, error, *999 )
    
    ALLOCATE( buffer( field_dimensions ), stat = err )
    IF( err /= 0 ) CALL flagerror( "Could not allocate raw nodes buffer for "//evaluator_name//".", err, error, *999 )
      
    !TODO Code assumes that the data is dense in both node and component indexes.
    NULLIFY( nodes )
    CALL region_nodes_get( mesh%REGION, nodes, err, error, *999 )
    CALL nodes_number_of_nodes_get( nodes, mesh_node_count, err, error, *999 )
    CALL fieldml_util_check_fieldml_error( var_str("Cannot get mesh nodes count for mesh ")//mesh%USER_NUMBER//".", &
      & fieldml_info%FML_HANDLE, err, error, *999 )
    
    offsets(:) = 0
    sizes(1) = 1
    sizes(2) = field_dimensions
    
    DO node_number = 1, mesh_node_count
      fml_err = fieldml_readdoubleslab( reader, c_loc(offsets), c_loc(sizes), c_loc(buffer) )
      offsets(1) = offsets(1) + 1
      IF( fml_err /= fml_err_no_error ) THEN
        CALL flagerror( "Cannot read nodal dofs from "//evaluator_name//"("&
          & // trim(number_to_vstring(fml_err,"*",err,error)) //").", err, error, *999 )
      ENDIF

      DO component_number = 1, field_dimensions
        !Default to version 1 of each node derivative (value hardcoded in loop)
        version_number = 1

        mycomputationalnodenumber = computational_node_number_get(err,error)
        CALL decomposition_mesh_component_number_get(field%DECOMPOSITION,meshcomponentnumber,err,error,*999)
        CALL decomposition_node_domain_get(field%DECOMPOSITION,node_number,meshcomponentnumber,nodedomain,err,error,*999)
        IF(nodedomain==mycomputationalnodenumber) THEN
          CALL field_parameter_set_update_node( field, variable_type, set_type, version_number, &
            & no_global_deriv, node_number, component_number, buffer( component_number ), err, error, *999 )
        ENDIF

      ENDDO
    ENDDO
    
    DEALLOCATE( buffer )
  
    fml_err = fieldml_closereader( reader )
    IF( fml_err /= fml_err_no_error ) THEN
      CALL flagerror( "Error closing nodal dofs reader for "//evaluator_name//"("&
        & // trim(number_to_vstring(fml_err,"*",err,error)) //").", err, error, *999 )
    ENDIF

    !TODO Set element and constant parameters
    
    exits( "FieldmlInput_FieldNodalParametersUpdate" )
    RETURN
999 errorsexits( "FieldmlInput_FieldNodalParametersUpdate", err, error )
    RETURN 1
  
  END SUBROUTINE fieldmlinput_fieldnodalparametersupdate

  !
  !================================================================================================================================
  !

END MODULE fieldml_input_routines