diff --git a/examples/geometry_fexample.F90 b/examples/geometry_fexample.F90 index 754af64..666b86a 100644 --- a/examples/geometry_fexample.F90 +++ b/examples/geometry_fexample.F90 @@ -16,44 +16,24 @@ program geometry_fexample implicit none # include "gsCInterface/gismo.ifc" character(len=80, kind=C_CHAR) :: some_file - type(c_ptr) :: g + type(c_ptr) :: g integer :: nu, nv - logical, parameter :: use_thb = .false. ! TODO: input option for xml-file? - if (use_thb) then - write(*,'(2(a,f5.1),a,i3)') 'reading XML for THB-spline' - some_file = 'optional/gsWRContact/examples/sw_crossing/sw_thb.xml' // C_NULL_CHAR - g = gsCReadFile(some_file) - else - write(*,'(2(a,f5.1),a,i3)') 'reading XML for tensor B-spline' - some_file = 'optional/gsWRContact/examples/sw_crossing/sw_tp.xml' // C_NULL_CHAR - g = gsCReadFile(some_file) - endif - write(*,'(a,i3)') 'done, g.dim=', domainDim(g) - - call print(g) + write(*,'(2(a,f5.1),a,i3)') 'reading XML for tensor B-spline' + some_file = 'optional/gsWRContact/examples/sw_crossing/sw_tp.xml' // C_NULL_CHAR + g = gsCReadFile(some_file) - if (.true.) then - call show_basic_usage( g ) - endif + write(*,'(a,i3)') 'done, g.dim=', gsFunctionSet_domainDim(g) - if (.false.) then - nu = 251 - nv = 201 - call sample_surface( g, nu, nv ) - endif + call gsFunctionSet_print(g) if (.true.) then - call show_recover_points( g ) + call show_basic_usage( g ) endif - if (use_thb) then - call destroy(g) - else - call destroy(g) - endif + call gsFunctionSet_delete(g) write(*,*) 'done.' end program geometry_fexample @@ -66,10 +46,12 @@ subroutine show_basic_usage( g ) implicit none # include "gsCInterface/gismo.ifc" !--subroutine arguments - type(c_ptr) :: g, uvm, xyzm, xyz1 + type(c_ptr) :: g !--local variables integer(C_INT) :: nRows, nCols, out_rows, out_cols, irow, icol, icoor, ipar - real(C_DOUBLE), dimension(:,:), target, allocatable :: uv, xyz + type(C_PTR) :: uvm, xyzm, xyz1 + real(C_DOUBLE), dimension(:,:), allocatable :: uv + real(C_DOUBLE), dimension(:,:), pointer :: xyz character(len=1), parameter :: c_param(2) = (/ 'u', 'v' /) character(len=1), parameter :: c_coor(3) = (/ 'x', 'y', 'z' /) @@ -87,11 +69,16 @@ subroutine show_basic_usage( g ) ! evaluate positions (x,y,z) at given parameter values - uvm = gsMatrix_create_rcd(nRows, nCols, c_loc(uv(1,1))) - uvm = gsMatrix_create() - call eval_into(G, uvm, xyzm) + uvm = gsMatrix_create_rcd(nRows, nCols, uv) + xyzm = gsMatrix_create() + call gsFunctionSet_eval_into(G, uvm, xyzm) + call gsMatrix_print(xyzm) + xyz1 = gsMatrix_data(xyzm) - call C_F_POINTER(xyz1,xyz) + call C_F_POINTER(xyz1, xyz, (/ 3,nCols /)) + + 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) @@ -102,116 +89,3 @@ end subroutine show_basic_usage !----------------------------------------------------------------------------------------------------------- -subroutine sample_surface( g, nu, nv ) -!--purpose: evaluate positions (x,y,z) at uniform grid [0:du:1] x [0:dv:1], print table of results - use, intrinsic :: iso_c_binding - implicit none -# include "gsCInterface/gismo.ifc" -!--subroutine arguments - type(c_ptr) :: g - integer, intent(in) :: nu, nv -!--local variables - integer :: iu, iv, ii - real(kind=8) :: du, dv, ui, vj - integer(C_INT) :: nRows, nCols, out_rows, out_cols, mode, irow, icol, icoor, ipar - real(C_DOUBLE), dimension(:,:), allocatable :: uv - real(C_DOUBLE), dimension(:,:), allocatable :: xyz - character(len=1), parameter :: c_param(2) = (/ 'u', 'v' /) - character(len=1), parameter :: c_coor(3) = (/ 'x', 'y', 'z' /) - - write(*,*) '-------------------------------- sample_surface --------------------------------' - ! set step-sizes for parameters u, v, interval [0,1] divided into equidistant positions - - du = 1d0 / (nu - 1) - dv = 1d0 / (nv - 1) - - ! create input for gs_eval_geometry - - nRows = 2 - nCols = nu * nv - allocate(uv(nRows,nCols)) - - do iu = 1, nu - do iv = 1, nv - ii = (iu-1) * nv + iv - uv(1, ii) = (iu-1) * du - uv(2, ii) = (iv-1) * dv - enddo - enddo - - write(*,'(2(a,i4),a)') 'Parameter grid nu x nv =',nu,' x',nv,' positions' - - ! evaluate positions (x,y,z) at given parameter values - - mode = 0 - allocate(xyz(3,nCols)) - call eval_into(G, uv, nRows, nCols, xyz, 3*nCols, out_rows, out_cols, mode) - - ! print results in tabular form - - write(*,'(2(a,i3),a,i7)') 'Mode =',mode,': got #rows =', out_rows, ', #cols =', out_cols - write(*,'(a)') '% iu iv ii ui vj xij yij zij' - do iu = 1, nu - do iv = 1, nv - ii = (iu-1) * nv + iv - write(*,'(3i8,2f12.6,f14.6,2f12.6)') iu, iv, ii, uv(1,ii), uv(2,ii), & - (xyz(irow,ii), irow=1,out_rows) - enddo - enddo - deallocate(xyz) - -end subroutine sample_surface - -!----------------------------------------------------------------------------------------------------------- - -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 - real(C_DOUBLE), dimension(:,:), allocatable :: uv, xyz - 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)) - allocate(uv(2,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 /) - - do icol = 1, nCols - uv(:,icol) = 0d0 - enddo - - 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 - - call gs_recover_points(G, uv, xyz, nCols, ZDIR) - - 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 - - deallocate(uv) - deallocate(xyz) - -end subroutine show_recover_points - -!----------------------------------------------------------------------------------------------------------- diff --git a/src/gismo.ifc b/src/gismo.ifc index 60a26d6..7bcfcc5 100644 --- a/src/gismo.ifc +++ b/src/gismo.ifc @@ -11,89 +11,247 @@ ! Author(s): E. Vollebregt ! +!------------------------------------------------------------------------------------------------------------ + +! #include + +!------------------------------------------------------------------------------------------------------------ +! #include +! Structs for holding G+Smo objects +!------------------------------------------------------------------------------------------------------------ + +! type, bind(c) :: gsFMatrix +! type(C_PTR) :: ptr +! end type gsFMatrix + +! type, bind(c) :: gsFMatrixInt +! type(C_PTR) :: ptr +! end type gsFMatrixInt + +! type, bind(c) :: gsFVector +! type(C_PTR) :: ptr +! end type gsFVector + +! type, bind(c) :: gsFVectorInt +! type(C_PTR) :: ptr +! end type gsFVectorInt + +! type, bind(c) :: gsFFunctionSet +! type(C_PTR) :: ptr +! end type gsFFunctionSet + +! type, bind(c) :: gsFMultiPatch +! type(C_PTR) :: ptr +! end type gsFMultiPatch + +! type, bind(c) :: gsFBasis +! type(C_PTR) :: ptr +! end type gsFBasis + +! type, bind(c) :: gsFGeometry +! type(C_PTR) :: ptr +! end type gsFGeometry + +! type, bind(c) :: gsFGeometryTransform +! type(C_PTR) :: ptr +! end type gsFGeometryTransform + +! type, bind(c) :: gsFKnotVector +! type(C_PTR) :: ptr +! end type gsFKnotVector + !------------------------------------------------------------------------------------------------------------ interface - function gsCReadFile(filename) bind(c) +!------------------------------------------------------------------------------------------------------------ +! #include +!------------------------------------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------------------------------------ +! GISMO_EXPORT gsCMatrix * gsMatrix_create(void); + + function gsMatrix_create( ) bind(c,name='gsMatrix_create') #ifdef _WIN32 - !dir$ attributes stdcall :: gsCReadFile + !dir$ attributes stdcall :: gsMatrix_create #endif use, intrinsic :: iso_c_binding implicit none - type(c_ptr) :: gsCReadFile - character(len=1,kind=C_CHAR) :: filename(*) - end function gsCReadFile + type(C_PTR) :: gsMatrix_create + end function gsMatrix_create - function domainDim(g) bind(c) +!------------------------------------------------------------------------------------------------------------ +! 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 :: domainDim + !dir$ attributes stdcall :: gsMatrix_create_rcd #endif use, intrinsic :: iso_c_binding implicit none - integer(c_int) :: domainDim - type(c_ptr) :: g - end function domainDim + 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 eval_into(fs,u,result) bind(c) + subroutine gsMatrix_delete(m) bind(c,name='gsMatrix_delete') #ifdef _WIN32 - !dir$ attributes stdcall :: eval_into + !dir$ attributes stdcall :: gsMatrix_delete #endif use, intrinsic :: iso_c_binding implicit none - type(c_ptr) :: fs - type(c_ptr) :: u - type(c_ptr) :: result - end subroutine eval_into + type(C_PTR), value :: m + end subroutine gsMatrix_delete + +!------------------------------------------------------------------------------------------------------------ +! GISMO_EXPORT void gsMatrix_print(gsCMatrix * m); - subroutine deriv_into(fs,u,result) bind(c) + subroutine gsMatrix_print(m) bind(c,name='gsMatrix_print') #ifdef _WIN32 - !dir$ attributes stdcall :: deriv_into + !dir$ attributes stdcall :: gsMatrix_print #endif use, intrinsic :: iso_c_binding implicit none - type(c_ptr) :: fs - type(c_ptr) :: u - type(c_ptr) :: result - end subroutine deriv_into + type(C_PTR), value :: m + end subroutine gsMatrix_print + +!------------------------------------------------------------------------------------------------------------ +! GISMO_EXPORT double* gsMatrix_data(gsCMatrix * m); - function gsMatrix_create() bind(c) + function gsMatrix_data(m) bind(c,name='gsMatrix_data') #ifdef _WIN32 - !dir$ attributes stdcall :: gsMatrix_create + !dir$ attributes stdcall :: gsMatrix_data #endif use, intrinsic :: iso_c_binding implicit none - type(c_ptr) :: gsMatrix_create - end function gsMatrix_create + 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 +!------------------------------------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------------------------------------ +! #include +!------------------------------------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------------------------------------ +! #include +!------------------------------------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------------------------------------ +! #include +!------------------------------------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------------------------------------ +! #include +!------------------------------------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------------------------------------ +! GISMO_EXPORT void gsFunctionSet_delete(gsCFunctionSet * ptr); - function gsMatrix_data(m) bind(c) + subroutine gsFunctionSet_delete( fs ) bind(c,name='gsFunctionSet_delete') #ifdef _WIN32 - !dir$ attributes stdcall :: gsMatrix_create + !dir$ attributes stdcall :: gsFunctionSet_delete #endif use, intrinsic :: iso_c_binding implicit none - type(c_ptr) :: m - type(c_ptr) :: gsMatrix_data - end function gsMatrix_data + type(C_PTR), value :: fs + end subroutine gsFunctionSet_delete + +!------------------------------------------------------------------------------------------------------------ +! GISMO_EXPORT void gsFunctionSet_print(gsCFunctionSet * fs); - function gsMatrix_create_rcd(r,c,data) bind(c) + subroutine gsFunctionSet_print(fs) bind(c,name='gsFunctionSet_print') #ifdef _WIN32 - !dir$ attributes stdcall :: gsMatrix_create + !dir$ attributes stdcall :: gsFunctionSet_print #endif use, intrinsic :: iso_c_binding implicit none - type(c_ptr) :: gsMatrix_create_rcd - integer(c_int), value :: r, c - type(c_ptr) :: data - end function gsMatrix_create_rcd + type(C_PTR), value :: fs + end subroutine gsFunctionSet_print - subroutine gsMatrix_delete(m) bind(c) +!------------------------------------------------------------------------------------------------------------ +! GISMO_EXPORT int gsFunctionSet_domainDim(gsCFunctionSet * fs); + + function gsFunctionSet_domainDim(fs) bind(c,name='gsFunctionSet_domainDim') #ifdef _WIN32 - !dir$ attributes stdcall :: gsMatrix_delete + !dir$ attributes stdcall :: gsFunctionSet_domainDim #endif - use, intrinsic :: iso_c_binding + use, intrinsic :: iso_c_binding implicit none - type(c_ptr) :: m - end subroutine gsMatrix_delete + 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 +!------------------------------------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------------------------------------ +! #include +!------------------------------------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------------------------------------ +! #include +!------------------------------------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------------------------------------ +! #include +!------------------------------------------------------------------------------------------------------------ + + 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 +!------------------------------------------------------------------------------------------------------------ end interface