Merge pull request #88 from dladd/fieldml_tets

Fieldml support for simplex elements

src/basis_routines.f90

@@ -3287,6 +3287,12 @@ SUBROUTINE BASIS_QUADRATURE_NUMBER_OF_GAUSS_XI_SET_PTR(BASIS,NUMBER_OF_GAUSS_XI,
                     & " Gauss points are insufficient for cubic Hermite interpolation"
                   CALL FLAG_WARNING(LOCAL_WARNING,ERR,ERROR,*999)
                 ENDIF
+              CASE(BASIS_LINEAR_SIMPLEX_INTERPOLATION)
+                LOCAL_WARNING="For simplex elements please set quadrature order rather than number of gauss points."
+                CALL FLAG_WARNING(LOCAL_WARNING,ERR,ERROR,*999)
+              CASE(BASIS_QUADRATIC_SIMPLEX_INTERPOLATION)
+                LOCAL_WARNING="For simplex elements please set quadrature order rather than number of gauss points."
+                CALL FLAG_WARNING(LOCAL_WARNING,ERR,ERROR,*999)
               CASE DEFAULT
                 LOCAL_ERROR="Interpolation xi value "//TRIM(NUMBER_TO_VSTRING(BASIS%INTERPOLATION_XI(ni),"*",ERR,ERROR))// &
                   & " is invalid for xi direction "//TRIM(NUMBER_TO_VSTRING(ni,"*",ERR,ERROR))

src/fieldml_input_routines.f90

@@ -49,6 +49,7 @@ MODULE FIELDML_INPUT_ROUTINES
   USE BASIS_ROUTINES
   USE CMISS
   USE CONSTANTS
+  USE COMP_ENVIRONMENT
   USE COORDINATE_ROUTINES
   USE FIELD_ROUTINES
   USE FIELDML_API
@@ -282,6 +283,15 @@ SUBROUTINE FIELDML_INPUT_GET_BASIS_INFO( FIELDML_INFO, BASIS_HANDLE, CONNECTIVIT
       IF( ERR /= 0 ) CALL FLAG_ERROR( "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 FLAG_ERROR( "Could not allocate interpolation array.", ERR, ERROR, *999 )
+      ALLOCATE( COLLAPSE(2), STAT = ERR )
+      IF( ERR /= 0 ) CALL FLAG_ERROR( "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 )
@@ -300,6 +310,34 @@ SUBROUTINE FIELDML_INPUT_GET_BASIS_INFO( FIELDML_INFO, BASIS_HANDLE, CONNECTIVIT
       IF( ERR /= 0 ) CALL FLAG_ERROR( "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 FLAG_ERROR( "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 FLAG_ERROR( "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 FLAG_ERROR( "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 FLAG_ERROR( "Could not allocate interpolation array.", ERR, ERROR, *999 )
+      BASIS_INTERPOLATIONS = BASIS_QUADRATIC_SIMPLEX_INTERPOLATION
+      BASISTYPE = BASIS_SIMPLEX_TYPE
     ELSE
       CALL FLAG_ERROR( "Basis "//NAME(1:LENGTH)//" cannot yet be interpreted.", ERR, ERROR, *999 )
     ENDIF
@@ -353,8 +391,13 @@ FUNCTION FIELDML_INPUT_IS_KNOWN_BASIS( FIELDML_INFO, BASIS_HANDLE, ERR, ERROR )
 
     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 ) ) THEN
+      & ( 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.
@@ -733,7 +776,8 @@ SUBROUTINE FIELDML_INPUT_BASIS_CREATE_START( FIELDML_INFO, EVALUATOR_NAME, USER_
     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 )
-    IF( size( BASIS_INTERPOLATIONS ) > 1 ) THEN
+    !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
 
@@ -1224,6 +1268,7 @@ SUBROUTINE FIELDML_INPUT_FIELD_NODAL_PARAMETERS_UPDATE( FIELDML_INFO, EVALUATOR_
     INTEGER(INTG), TARGET :: OFFSETS(2), SIZES(2)
     REAL(C_DOUBLE), ALLOCATABLE, TARGET :: BUFFER(:)
     INTEGER(INTG) :: READER
+    INTEGER(INTG) :: myComputationalNodeNumber,nodeDomain,meshComponentNumber
 
     CALL ENTERS( "FIELDML_INPUT_FIELD_NODAL_PARAMETERS_UPDATE", ERR, ERROR, *999 )
 
@@ -1275,8 +1320,15 @@ SUBROUTINE FIELDML_INPUT_FIELD_NODAL_PARAMETERS_UPDATE( FIELDML_INFO, EVALUATOR_
       DO COMPONENT_NUMBER = 1, FIELD_DIMENSIONS
         !Default to version 1 of each node derivative (value hardcoded in loop)
         VERSION_NUMBER = 1
-        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 )
+
+        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