Skip to content

Commit

Permalink
add ifc-files, add recoverPoints in F-example
Browse files Browse the repository at this point in the history
  • Loading branch information
@eve70a
eve70a committed Apr 23, 2024
1 parent 5168439 commit df60873
Show file tree
Hide file tree
Showing 13 changed files with 487 additions and 202 deletions.
90 changes: 81 additions & 9 deletions examples/geometry_fexample.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,10 @@ program geometry_fexample
call show_basic_usage( g )
endif

if (.true.) then
call show_recover_points( g )
endif

call gsFunctionSet_delete(g)
write(*,*) 'done.'

Expand All @@ -49,7 +53,7 @@ subroutine show_basic_usage( g )
type(c_ptr) :: g
!--local variables
integer(C_INT) :: nRows, nCols, out_rows, out_cols, irow, icol, icoor, ipar
type(C_PTR) :: uvm, xyzm, xyz1
type(C_PTR) :: uvm, xyzm, xyz_p
real(C_DOUBLE), dimension(:,:), allocatable :: uv
real(C_DOUBLE), dimension(:,:), pointer :: xyz
character(len=1), parameter :: c_param(2) = (/ 'u', 'v' /)
Expand All @@ -69,27 +73,95 @@ subroutine show_basic_usage( g )

! evaluate positions (x,y,z) at given parameter values

uvm = gsMatrix_create_rcd(nRows, nCols, uv)
uvm = gsMatrix_create_rcd(nRows, nCols, uv)
xyzm = gsMatrix_create()
call gsFunctionSet_eval_into(G, uvm, xyzm)
call gsMatrix_print(xyzm)
! call gsMatrix_print(xyzm)

xyz1 = gsMatrix_data(xyzm)
call C_F_POINTER(xyz1, xyz, (/ 3,nCols /))
! get pointer to matrix data

out_rows = gsMatrix_rows(xyzm)
out_cols = gsMatrix_cols(xyzm)
xyz_p = gsMatrix_data(xyzm)
call C_F_POINTER(xyz_p, xyz, (/ out_rows, out_cols /))

out_rows = size(xyz, 1)
out_cols = size(xyz, 2)
write(*,'(3(a,i3))') 'Got #rows =', out_rows, ', #cols =', out_cols
do irow = 1, out_rows
write(*,'(3a,10f10.3)') ' ',c_coor(irow),': ', (xyz(irow,icol), icol=1,out_cols)
enddo

call gsMatrix_delete(uvm)
call gsMatrix_delete(xyzm)
deallocate(uv)
! TODO: deallocate memory allocated by gsMatrix_data? Or is xyz1 pointing inside xyzm?
! write(*,*) 'deallocate uv'
! deallocate(uv)

end subroutine show_basic_usage

!-----------------------------------------------------------------------------------------------------------

subroutine show_recover_points( g )
!--purpose: for some positions (x,y), determine z on the surface and corresponding (u,v)
use, intrinsic :: iso_c_binding
implicit none
# include "gsCInterface/gismo.ifc"
!--subroutine arguments
type(c_ptr) :: g
!--local variables
integer(C_INT), parameter :: XDIR = 0, YDIR = 1, ZDIR = 2
integer(C_INT) :: nCols, irow, icol, out_rows, out_cols
real(C_DOUBLE) :: eps
real(C_DOUBLE), dimension(:,:), allocatable :: xyz
real(C_DOUBLE), dimension(:,:), pointer :: uv
type(C_PTR) :: uvm, xyzm, uv_p
character(len=1), parameter :: c_param(2) = (/ 'u', 'v' /)
character(len=1), parameter :: c_coor(3) = (/ 'x', 'y', 'z' /)

write(*,*) '----------------------------- show_recover_points -----------------------------'
nCols = 4
allocate(xyz(3,ncols))

xyz(1, 1:ncols) = (/ 2451.0, 210.001, 708.0, 210.0 /)
xyz(2, 1:ncols) = (/ 122.3, -38.957, 18.568, -13.9 /)
xyz(3, 1:ncols) = (/ 0.0, 0.0, 0.0, 0.0 /)

write(*,'(a,i3,a)') 'Input #cols =', nCols,', (x,y,z) ='
do irow = 1, 3
write(*,'(3a,10f10.3)') ' ',c_coor(irow),': ', (xyz(irow,icol), icol=1,nCols)
enddo

! evaluate z-positions and (u,v)-values for given (x,y)-positions

! evaluate positions (x,y,z) at given parameter values

xyzm = gsMatrix_create_rcd(3, ncols, xyz)
uvm = gsMatrix_create()

eps = 1d-6
call gsGeometry_recoverPoints(G, uvm, xyzm, ZDIR, eps)

! get pointer to matrix data

out_rows = gsMatrix_rows(uvm)
out_cols = gsMatrix_cols(uvm)
uv_p = gsMatrix_data(uvm)
call C_F_POINTER(uv_p, uv, (/ out_rows, out_cols /))

write(*,'(a)') 'Output (u,v) ='
do irow = 1, 2
write(*,'(3a,10f10.3)') ' ',c_param(irow),': ', (uv(irow,icol), icol=1, nCols)
enddo
write(*,'(a)') 'Output (x,y,z) ='
do irow = 1, 3
write(*,'(3a,10f10.3)') ' ',c_coor(irow),': ', (xyz(irow,icol), icol=1, nCols)
enddo

! clean up input data, matrices used

call gsMatrix_delete(xyzm)
call gsMatrix_delete(uvm)
deallocate(xyz)

end subroutine show_recover_points

!-----------------------------------------------------------------------------------------------------------

199 changes: 10 additions & 189 deletions src/gismo.ifc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -64,194 +64,15 @@

interface

!------------------------------------------------------------------------------------------------------------
! #include <gsCInterface/gsCMatrix.h>
!------------------------------------------------------------------------------------------------------------

!------------------------------------------------------------------------------------------------------------
! GISMO_EXPORT gsCMatrix * gsMatrix_create(void);

function gsMatrix_create( ) bind(c,name='gsMatrix_create')
#ifdef _WIN32
!dir$ attributes stdcall :: gsMatrix_create
#endif
use, intrinsic :: iso_c_binding
implicit none
type(C_PTR) :: gsMatrix_create
end function gsMatrix_create

!------------------------------------------------------------------------------------------------------------
! GISMO_EXPORT gsCMatrix * gsMatrix_create_rc (int rows, int cols);

!------------------------------------------------------------------------------------------------------------
! GISMO_EXPORT gsCMatrix * gsMatrix_create_rcd(int rows, int cols, double * data);

function gsMatrix_create_rcd(rows, cols, data ) bind(c,name='gsMatrix_create_rcd')
#ifdef _WIN32
!dir$ attributes stdcall :: gsMatrix_create_rcd
#endif
use, intrinsic :: iso_c_binding
implicit none
type(C_PTR) :: gsMatrix_create_rcd
integer(C_INT), value :: rows, cols
real(C_DOUBLE) :: data(*)
end function gsMatrix_create_rcd

!------------------------------------------------------------------------------------------------------------
! GISMO_EXPORT void gsMatrix_delete(gsCMatrix * m);

subroutine gsMatrix_delete(m) bind(c,name='gsMatrix_delete')
#ifdef _WIN32
!dir$ attributes stdcall :: gsMatrix_delete
#endif
use, intrinsic :: iso_c_binding
implicit none
type(C_PTR), value :: m
end subroutine gsMatrix_delete

!------------------------------------------------------------------------------------------------------------
! GISMO_EXPORT void gsMatrix_print(gsCMatrix * m);

subroutine gsMatrix_print(m) bind(c,name='gsMatrix_print')
#ifdef _WIN32
!dir$ attributes stdcall :: gsMatrix_print
#endif
use, intrinsic :: iso_c_binding
implicit none
type(C_PTR), value :: m
end subroutine gsMatrix_print

!------------------------------------------------------------------------------------------------------------
! GISMO_EXPORT double* gsMatrix_data(gsCMatrix * m);

function gsMatrix_data(m) bind(c,name='gsMatrix_data')
#ifdef _WIN32
!dir$ attributes stdcall :: gsMatrix_data
#endif
use, intrinsic :: iso_c_binding
implicit none
type(C_PTR) :: gsMatrix_data
type(C_PTR), value :: m
end function gsMatrix_data

! GISMO_EXPORT void gsMatrix_transposeInPlace(gsCMatrix * m);
! GISMO_EXPORT int gsMatrix_rows(gsCMatrix * m);
! GISMO_EXPORT int gsMatrix_cols(gsCMatrix * m);
! GISMO_EXPORT void gsMatrix_setZero(gsCMatrix * m);

!------------------------------------------------------------------------------------------------------------
! #include <gsCInterface/gsCMatrixInt.h>
!------------------------------------------------------------------------------------------------------------

!------------------------------------------------------------------------------------------------------------
! #include <gsCInterface/gsCVector.h>
!------------------------------------------------------------------------------------------------------------

!------------------------------------------------------------------------------------------------------------
! #include <gsCInterface/gsCVectorInt.h>
!------------------------------------------------------------------------------------------------------------

!------------------------------------------------------------------------------------------------------------
! #include <gsCInterface/gsCKnotVector.h>
!------------------------------------------------------------------------------------------------------------

!------------------------------------------------------------------------------------------------------------
! #include <gsCInterface/gsCFunctionSet.h>
!------------------------------------------------------------------------------------------------------------

!------------------------------------------------------------------------------------------------------------
! GISMO_EXPORT void gsFunctionSet_delete(gsCFunctionSet * ptr);

subroutine gsFunctionSet_delete( fs ) bind(c,name='gsFunctionSet_delete')
#ifdef _WIN32
!dir$ attributes stdcall :: gsFunctionSet_delete
#endif
use, intrinsic :: iso_c_binding
implicit none
type(C_PTR), value :: fs
end subroutine gsFunctionSet_delete

!------------------------------------------------------------------------------------------------------------
! GISMO_EXPORT void gsFunctionSet_print(gsCFunctionSet * fs);

subroutine gsFunctionSet_print(fs) bind(c,name='gsFunctionSet_print')
#ifdef _WIN32
!dir$ attributes stdcall :: gsFunctionSet_print
#endif
use, intrinsic :: iso_c_binding
implicit none
type(C_PTR), value :: fs
end subroutine gsFunctionSet_print

!------------------------------------------------------------------------------------------------------------
! GISMO_EXPORT int gsFunctionSet_domainDim(gsCFunctionSet * fs);

function gsFunctionSet_domainDim(fs) bind(c,name='gsFunctionSet_domainDim')
#ifdef _WIN32
!dir$ attributes stdcall :: gsFunctionSet_domainDim
#endif
use, intrinsic :: iso_c_binding
implicit none
integer :: gsFunctionSet_domainDim
type(C_PTR), value :: fs
end function gsFunctionSet_domainDim

! GISMO_EXPORT int gsFunctionSet_targetDim(gsCFunctionSet * fs);

! GISMO_EXPORT gsCBasis * gsFunctionSet_basis(gsCFunctionSet * fs, int i);

!------------------------------------------------------------------------------------------------------------
! GISMO_EXPORT void gsFunctionSet_eval_into(gsCFunctionSet * fs,
! gsCMatrix * u,
! gsCMatrix * result);

subroutine gsFunctionSet_eval_into(fs, u, result) bind(c,name='gsFunctionSet_eval_into')
#ifdef _WIN32
!dir$ attributes stdcall :: gsFunctionSet_eval_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_eval_into

!------------------------------------------------------------------------------------------------------------
! GISMO_EXPORT void gsFunctionSet_deriv_into(gsCFunctionSet * fs,
! gsCMatrix * u,
! gsCMatrix * result);

! GISMO_EXPORT void gsFunctionSet_normal_into(gsCFunctionSet * fs,
! gsCMatrix * u,
! gsCMatrix * result);

!------------------------------------------------------------------------------------------------------------
! #include <gsCInterface/gsCMultiPatch.h>
!------------------------------------------------------------------------------------------------------------

!------------------------------------------------------------------------------------------------------------
! #include <gsCInterface/gsCBasis.h>
!------------------------------------------------------------------------------------------------------------

!------------------------------------------------------------------------------------------------------------
! #include <gsCInterface/gsCGeometry.h>
!------------------------------------------------------------------------------------------------------------

!------------------------------------------------------------------------------------------------------------
! #include <gsCInterface/gsCReadFile.h>
!------------------------------------------------------------------------------------------------------------

function gsCReadFile(filename) bind(c,name='gsCReadFile')
#ifdef _WIN32
!dir$ attributes stdcall :: gsCReadFile
#endif
use, intrinsic :: iso_c_binding
implicit none
type(c_ptr) :: gsCReadFile
character(len=1,kind=C_CHAR) :: filename(*)
end function gsCReadFile

! end <gsCInterface/gsCReadfile.h>
!------------------------------------------------------------------------------------------------------------
#include <gsCInterface/gsCMatrix.ifc>
#include <gsCInterface/gsCMatrixInt.ifc>
#include <gsCInterface/gsCVector.ifc>
#include <gsCInterface/gsCVectorInt.ifc>
#include <gsCInterface/gsCKnotVector.ifc>
#include <gsCInterface/gsCFunctionSet.ifc>
#include <gsCInterface/gsCMultiPatch.ifc>
#include <gsCInterface/gsCBasis.ifc>
#include <gsCInterface/gsCGeometry.ifc>
#include <gsCInterface/gsCReadFile.ifc>

end interface
26 changes: 26 additions & 0 deletions src/gsCBasis.ifc
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,26 @@

!------------------------------------------------------------------------------------------------------------
! #define gsBasis_print gsFunctionSet_print
! #define gsBasis_delete gsFunctionSet_delete

! GISMO_EXPORT gsCBasis* gsBSplineBasis_create(gsCKnotVector* knots);

! GISMO_EXPORT gsCBasis* gsTensorBSplineBasis2_create(gsCKnotVector* KV1, gsCKnotVector* KV2);
! GISMO_EXPORT gsCBasis* gsTensorBSplineBasis3_create(gsCKnotVector* KV1, gsCKnotVector* KV2, gsCKnotVector* KV3);
! GISMO_EXPORT gsCBasis* gsTensorBSplineBasis4_create(gsCKnotVector* KV1, gsCKnotVector* KV2, gsCKnotVector* KV3, gsCKnotVector* KV4);

! GISMO_EXPORT gsCBasis* THBSplineBasis1_create(gsCBasis* basis);
! GISMO_EXPORT gsCBasis* THBSplineBasis2_create(gsCBasis* basis);
! GISMO_EXPORT gsCBasis* THBSplineBasis3_create(gsCBasis* basis);
! GISMO_EXPORT gsCBasis* THBSplineBasis4_create(gsCBasis* basis);

! GISMO_EXPORT void gsBasis_active_into(gsCBasis * b, gsCMatrix * u, gsCMatrixInt * result);

! GISMO_EXPORT gsCBasis * gsBasis_component(gsCBasis * b, int dir);
! GISMO_EXPORT int gsBasis_degree(gsCBasis * b, int dir);
! GISMO_EXPORT int gsBasis_numElements(gsCBasis * b);
! GISMO_EXPORT int gsBasis_size(gsCBasis * b);
!
! GISMO_EXPORT void gsBasis_uniformRefine(gsCBasis * b, int numKnots, int mul, int dir);
! GISMO_EXPORT void gsBasis_refineElements(gsCBasis * b, int * boxData, int boxSize);
!------------------------------------------------------------------------------------------------------------
Loading

0 comments on commit df60873

Please sign in to comment.