add GeometryTransform to Fortran

examples/geometry_fexample.F90

@@ -53,42 +53,56 @@ subroutine show_basic_usage( g )
    type(t_gsgeometry)           :: g
 !--local variables
    integer(C_INT)               :: nRows, nCols, out_rows, out_cols, irow, icol, icoor, ipar
-   type(t_gsmatrix)             :: uvm, xyzm
+   type(t_gsmatrix)             :: uvm, xyzm, dxyzm
    real(C_DOUBLE), dimension(:,:), allocatable :: uv
-   character(len=1), parameter  :: c_param(2) = (/ 'u', 'v' /)
-   character(len=1), parameter  :: c_coor(3)  = (/ 'x', 'y', 'z' /)
+   character(len=1), parameter  :: c_param(2)  = (/ 'u', 'v' /)
+   character(len=1), parameter  :: c_coor(3)   = (/ 'x', 'y', 'z' /)
+   character(len=5), parameter  :: c_deriv(6)  = (/ 'dx/du', 'dx/dv', 'dy/du', 'dy/dv', 'dz/du', 'dz/dv' /)
 
    nRows = 2
    nCols = 7
    allocate(uv(nrows,ncols))
-   uv(1, 1:nCols) = (/ 0.0, 0.1, 0.5, 0.5, 0.5, 0.5, 1.0 /)
-   uv(2, 1:nCols) = (/ 0.0, 0.0, 0.0, 0.2, 0.5, 0.9, 1.0 /)
+   uv(1, 1:nCols) = (/ 0.0, 0.1, 0.501, 0.500, 0.500, 0.5, 1.0 /)
+   uv(2, 1:nCols) = (/ 0.0, 0.0, 0.200, 0.200, 0.201, 0.9, 1.0 /)
 
    write(*,*) '------------------------------ show_basic_usage ------------------------------'
    write(*,'(2(a,i3))') 'Input #rows =', nRows, ', #cols =', nCols
    do irow = 1, nRows
-      write(*,'(3a,10f10.3)') '  ',c_param(irow),': ', (uv(irow,icol), icol=1,nCols)
+      write(*,'(3a,10f10.3)') '      ',c_param(irow),': ', (uv(irow,icol), icol=1,nCols)
    enddo
 
    ! evaluate positions (x,y,z) at given parameter values
 
-   uvm  = f_gsmatrix_create_rcd(nRows, nCols, uv)
-   xyzm = f_gsmatrix_create()
+   uvm   = f_gsmatrix_create_rcd(nRows, nCols, uv)
+   xyzm  = f_gsmatrix_create()
+   dxyzm = f_gsmatrix_create()
    call f_gsFunctionSet_eval_into(G, uvm, xyzm)
+   call f_gsFunctionSet_deriv_into(G, uvm, dxyzm)
    ! call f_gsmatrix_print(xyzm)
 
    ! show output data
 
    out_rows = f_gsmatrix_rows(xyzm)
    out_cols = f_gsmatrix_cols(xyzm)
 
-   write(*,'(3(a,i3))') 'Got #rows =', out_rows, ', #cols =', out_cols
+   write(*,'(3(a,i3))') 'Values: #rows =', out_rows, ', #cols =', out_cols
+   do irow = 1, out_rows
+      write(*,'(3a,10f10.3)') '      ',c_coor(irow),': ', (xyzm%data(irow,icol), icol=1,out_cols)
+   enddo
+
+   ! show derivatives data
+
+   out_rows = f_gsmatrix_rows(dxyzm)
+   out_cols = f_gsmatrix_cols(dxyzm)
+
+   write(*,'(3(a,i3))') 'Derivatives: #rows =', out_rows, ', #cols =', out_cols
    do irow = 1, out_rows
-      write(*,'(3a,10f10.3)') '  ',c_coor(irow),': ', (xyzm%data(irow,icol), icol=1,out_cols)
+      write(*,'(3a,10f10.3)') '  ',c_deriv(irow),': ', (dxyzm%data(irow,icol), icol=1,out_cols)
    enddo
 
    call f_gsmatrix_delete(uvm)
    call f_gsmatrix_delete(xyzm)
+   call f_gsmatrix_delete(dxyzm)
    deallocate(uv)
 
 end subroutine show_basic_usage

src/Fgismo.F90

@@ -11,6 +11,7 @@ module Fgismo
    public  t_gsmatrix
    public  t_gsfunctionset
    public  t_gsgeometry
+   public  t_gsgeometrytransform
 
    ! functions from gsCVector.ifc:
    public  f_gsvector_create
@@ -48,6 +49,7 @@ module Fgismo
    public  f_gsfunctionset_print
    public  f_gsfunctionset_domaindim
    public  f_gsfunctionset_eval_into
+   public  f_gsfunctionset_deriv_into
 
    ! functions from gsCReadFile.ifc:
    public  f_gscreadfile
@@ -58,6 +60,16 @@ module Fgismo
    public  f_gsgeometry_recoverpoints
    public  f_gsgeometry_recoverpointgrid
    public  f_gsgeometry_eval_into
+   public  f_gsgeometry_deriv_into
+
+   ! functions from gsCGeometryTransform.ifc:
+   public  f_gsgeometrytransform_create
+   public  f_gsgeometrytransform_delete
+   public  f_gsgeometrytransform_print
+   public  f_gsgeometrytransform_recoverpoints
+   public  f_gsgeometrytransform_recoverpointgrid
+   public  f_gsgeometrytransform_eval_into
+   public  f_gsgeometrytransform_deriv_into
 
 !------------------------------------------------------------------------------------------------------------
 
@@ -101,6 +113,34 @@ module Fgismo
    interface f_gsgeometry_eval_into
       module procedure f_gsfunctionset_eval_into
    end interface
+   interface f_gsgeometry_deriv_into
+      module procedure f_gsfunctionset_deriv_into
+   end interface
+
+!------------------------------------------------------------------------------------------------------------
+
+   type, extends(t_gsgeometry) :: t_gsgeometrytransform         ! C/C++ gsGeometryTransform object
+   end type t_gsgeometrytransform
+
+   ! define delete, print, eval_into --> geometry_delete, print, eval_into
+   interface f_gsgeometrytransform_delete
+      module procedure f_gsfunctionset_delete
+   end interface
+   interface f_gsgeometrytransform_print
+      module procedure f_gsfunctionset_print
+   end interface
+   interface f_gsgeometrytransform_eval_into
+      module procedure f_gsfunctionset_eval_into
+   end interface
+   interface f_gsgeometrytransform_deriv_into
+      module procedure f_gsfunctionset_deriv_into
+   end interface
+   interface f_gsgeometrytransform_recoverpoints
+      module procedure f_gsgeometry_recoverpoints
+   end interface
+   interface f_gsgeometrytransform_recoverpointgrid
+      module procedure f_gsgeometry_recoverpointgrid
+   end interface
 
 !------------------------------------------------------------------------------------------------------------
 
@@ -534,7 +574,7 @@ subroutine f_gsmatrix_delete(f_mat)
 end subroutine f_gsmatrix_delete
 
 !------------------------------------------------------------------------------------------------------------
-! wrap functions of gsFunctionSet.ifc:
+! wrap functions of gsCFunctionSet.ifc:
 !------------------------------------------------------------------------------------------------------------
 
 subroutine f_gsfunctionset_delete(f_fs)
@@ -598,11 +638,19 @@ subroutine f_gsfunctionset_eval_into(f_fs, f_uv, f_result)
 end subroutine f_gsfunctionset_eval_into
 
 !------------------------------------------------------------------------------------------------------------
-!     GISMO_EXPORT void gsFunctionSet_deriv_into(gsCFunctionSet * fs,
-!                                                gsCMatrix * u,
-!                                                gsCMatrix * result);
 
-!------------------------------------------------------------------------------------------------------------
+subroutine f_gsfunctionset_deriv_into(f_fs, f_uv, f_result)
+!--purpose: evaluate derivatives for gsfunctionset object at parameter values uv into result matrix
+#ifdef _WIN32
+!dec$ attributes dllexport :: f_gsfunctionset_deriv_into
+#endif
+!--subroutine arguments:
+   class(t_gsfunctionset) :: f_fs
+   type(t_gsmatrix)       :: f_uv, f_result
+
+   call gsfunctionset_deriv_into(f_fs%c_fs, f_uv%c_mat, f_result%c_mat )
+   call f_gsmatrix_update_data_ptr( f_result )
+end subroutine f_gsfunctionset_deriv_into
 
 !------------------------------------------------------------------------------------------------------------
 ! wrap functions of gsCReadFile.ifc:
@@ -673,6 +721,27 @@ subroutine f_gsgeometry_recoverpointgrid(f_geom, xlow, xhig, npnt, f_xyz, f_uv,
 
 end subroutine f_gsgeometry_recoverpointgrid
 
+!------------------------------------------------------------------------------------------------------------
+! wrap functions of gsCGeometryTransform.ifc:
+!------------------------------------------------------------------------------------------------------------
+
+function f_gsgeometrytransform_create(f_geom, f_mat, f_vec) result(f_trnsf)
+!--purpose: create gsgeometrytransform object from geometry + rot.matrix + transl.vector
+#ifdef _WIN32
+!dec$ attributes dllexport :: f_gsgeometrytransform_create
+#endif
+   implicit none
+!--function result:
+   type(t_gsgeometry) :: f_trnsf
+!--function arguments:
+   type(t_gsgeometry) :: f_geom
+   type(t_gsmatrix)   :: f_mat
+   type(t_gsvector)   :: f_vec
+
+   f_trnsf%c_fs = gsGeometryTransform_create(f_geom%c_fs, f_mat%c_mat, f_vec%c_vec)
+
+end function f_gsgeometrytransform_create
+
 !------------------------------------------------------------------------------------------------------------
 
 end module Fgismo

src/gismo.ifc

@@ -73,6 +73,7 @@
 #     include <gsCInterface/gsCMultiPatch.ifc>
 #     include <gsCInterface/gsCBasis.ifc>
 #     include <gsCInterface/gsCGeometry.ifc>
+#     include <gsCInterface/gsCGeometryTransform.ifc>
 #     include <gsCInterface/gsCReadFile.ifc>
 
    end interface

src/gsCFunctionSet.ifc

@@ -68,4 +68,15 @@
 !                                                gsCMatrix * u,
 !                                                gsCMatrix * result);
 
+      subroutine gsFunctionSet_deriv_into(fs, u, result) bind(c,name='gsFunctionSet_deriv_into')
+#ifdef _WIN32
+         !dir$ attributes stdcall     :: gsFunctionSet_deriv_into
+#endif
+         use, intrinsic               :: iso_c_binding
+         implicit none
+         type(C_PTR),    value        :: fs
+         type(C_PTR),    value        :: u
+         type(C_PTR),    value        :: result
+      end subroutine gsFunctionSet_deriv_into
+
 !------------------------------------------------------------------------------------------------------------

src/gsCGeometry.cpp

@@ -163,4 +163,4 @@ GISMO_EXPORT double gsGeometry_closestPointTo(gsCGeometry * fs,
 
 #ifdef __cplusplus
 }
-#endif
+#endif

src/gsCGeometryTransform.h

@@ -4,11 +4,11 @@ extern "C"
 {
 #endif
 
-#   define gsGeometryTransofrm_print gsFunctionSet_print
-#   define gsGeometryTransofrm_delete gsFunctionSet_delete
+#   define gsGeometryTransform_print gsFunctionSet_print
+#   define gsGeometryTransform_delete gsFunctionSet_delete
 
-    GISMO_EXPORT gsCGeometryTranform* gsGeometrtTransform_create(gsCBasis* b, gsCMatrix * m,
-                                                                 gsCVector * v);
+    GISMO_EXPORT gsCGeometryTransform* gsGeometryTransform_create(gsCBasis* b, gsCMatrix * m,
+                                                                  gsCVector * v);
 
 #ifdef __cplusplus
 }

src/gsCGeometryTransform.ifc

@@ -0,0 +1,19 @@
+
+!   define gsGeometryTransofrm_print gsFunctionSet_print
+!   define gsGeometryTransofrm_delete gsFunctionSet_delete
+
+!------------------------------------------------------------------------------------------------------------
+!     GISMO_EXPORT gsCGeometryTransform* gsGeometryTransform_create(gsCBasis * b, gsCMatrix * m,
+!                                                                   gsCVector * v);
+
+      function gsGeometryTransform_create(b, m, v) bind(c,name='gsGeometryTransform_create')
+#ifdef _WIN32
+         !dir$ attributes stdcall     :: gsGeometryTransform_create
+#endif
+         use, intrinsic               :: iso_c_binding
+         implicit none
+         type(C_PTR)                  :: gsGeometryTransform_create
+         type(C_PTR),      value      :: b, m, v
+      end function gsGeometryTransform_create
+
+!------------------------------------------------------------------------------------------------------------