Skip to content

Commit

Permalink
completed and tested F-wrappers for gsMatrix
Browse files Browse the repository at this point in the history
  • Loading branch information
@eve70a
eve70a committed Jun 12, 2024
1 parent 957dee3 commit 926888b
Show file tree
Hide file tree
Showing 3 changed files with 113 additions and 60 deletions.
3 changes: 2 additions & 1 deletion CMakeLists.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,8 @@ endif()
# Compile statically the extension
add_library(${PROJECT_NAME} OBJECT
${${PROJECT_NAME}_H}
${${PROJECT_NAME}_CPP} )
${${PROJECT_NAME}_CPP}
src/Fgismo.F90 )

set_target_properties(${PROJECT_NAME} PROPERTIES
COMPILE_DEFINITIONS gismo_EXPORTS
Expand Down
58 changes: 28 additions & 30 deletions examples/geometry_fexample.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -47,15 +47,15 @@ end program geometry_fexample
subroutine show_basic_usage( g )
!--purpose: evaluate positions (x,y,z) and derivatives d[xyz]/d[uv] at some arbitrary (u,v) \in [0,1)^2
use, intrinsic :: iso_c_binding
use Fgismo
implicit none
# include "gsCInterface/gismo.ifc"
!--subroutine arguments
type(c_ptr) :: g
!--local variables
integer(C_INT) :: nRows, nCols, out_rows, out_cols, irow, icol, icoor, ipar
type(C_PTR) :: uvm, xyzm, xyz_p
type(t_gsmatrix) :: uvm, xyzm
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' /)

Expand All @@ -73,27 +73,25 @@ subroutine show_basic_usage( g )

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

uvm = gsMatrix_create_rcd(nRows, nCols, uv)
xyzm = gsMatrix_create()
call gsFunctionSet_eval_into(G, uvm, xyzm)
! call gsMatrix_print(xyzm)
uvm = f_gsmatrix_create_rcd(nRows, nCols, uv)
xyzm = f_gsmatrix_create()
call gsFunctionSet_eval_into(G, uvm%c_mat, xyzm%c_mat)
call f_gsmatrix_update_data_ptr( xyzm )
! call f_gsmatrix_print(xyzm)

! get pointer to matrix data
! show output 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 = f_gsmatrix_rows(xyzm)
out_cols = f_gsmatrix_cols(xyzm)

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)
write(*,'(3a,10f10.3)') ' ',c_coor(irow),': ', (xyzm%data(irow,icol), icol=1,out_cols)
enddo

call gsMatrix_delete(uvm)
call gsMatrix_delete(xyzm)
! write(*,*) 'deallocate uv'
! deallocate(uv)
call f_gsmatrix_delete(uvm)
call f_gsmatrix_delete(xyzm)
deallocate(uv)

end subroutine show_basic_usage

Expand All @@ -102,6 +100,7 @@ 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
use Fgismo
implicit none
# include "gsCInterface/gismo.ifc"
!--subroutine arguments
Expand All @@ -111,8 +110,7 @@ subroutine show_recover_points( g )
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
type(t_gsmatrix) :: uvm, xyzm
character(len=1), parameter :: c_param(2) = (/ 'u', 'v' /)
character(len=1), parameter :: c_coor(3) = (/ 'x', 'y', 'z' /)

Expand All @@ -133,32 +131,32 @@ subroutine show_recover_points( g )

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

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

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

! get pointer to matrix data
! print output 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 /))
out_rows = f_gsmatrix_rows(uvm)
out_cols = f_gsmatrix_cols(uvm)

write(*,'(a)') 'Output (u,v) ='
do irow = 1, 2
write(*,'(3a,10f10.3)') ' ',c_param(irow),': ', (uv(irow,icol), icol=1, nCols)
write(*,'(3a,10f10.3)') ' ',c_param(irow),': ', (uvm%data(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)
write(*,'(3a,10f10.3)') ' ',c_coor(irow),': ', (xyzm%data(irow,icol), icol=1, nCols)
enddo

! clean up input data, matrices used

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

end subroutine show_recover_points
Expand Down
112 changes: 83 additions & 29 deletions src/Fgismo.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,19 +17,21 @@ module Fgismo
# include "gsCReadFile.ifc"
end interface

public t_gsmatrix
public f_gsmatrix_create
public f_gsmatrix_create_rcd
public f_gsmatrix_print
public f_gsmatrix_rows
public f_gsmatrix_cols
public f_gsmatrix_data
public t_gsmatrix
public f_gsmatrix_create
public f_gsmatrix_create_rcd
public f_gsmatrix_print
public f_gsmatrix_rows
public f_gsmatrix_cols
public f_gsmatrix_data
public f_gsmatrix_delete
public f_gsmatrix_update_data_ptr

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

type :: t_gsmatrix
type(C_PTR) :: c_mat
real(C_DOUBLE), dimension(:,:), pointer :: data => NULL()
type(C_PTR) :: c_mat ! C/C++ gsMatrix object
real(C_DOUBLE), dimension(:,:), pointer :: data => NULL() ! link to array in C/C++ gsMatrix
end type t_gsmatrix

!------------------------------------------------------------------------------------------------------------
Expand All @@ -38,43 +40,64 @@ module Fgismo

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

function f_gsmatrix_create()
!--purpose: create empty gsmatrix object
#ifdef _WIN32
!dec$ attributes dllexport :: f_gsmatrix_create
#endif
implicit none
!--function result type:
type(t_gsmatrix) :: f_gsmatrix_create

f_gsmatrix_create%c_mat = gsMatrix_create()
call f_gsmatrix_update_data_ptr( f_gsmatrix_create )

end function f_gsmatrix_create

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

function f_gsmatrix_create_rcd(nrows, ncols, data)
!--purpose: create gsmatrix object from input data
#ifdef _WIN32
!dec$ attributes dllexport :: f_gsmatrix_create_rcd
#endif
implicit none
!--function result type:
type(t_gsmatrix) :: f_gsmatrix_create_rcd
!--function arguments:
integer(C_INT) :: nrows, ncols
integer(C_INT) :: nrows, ncols
real(C_DOUBLE), dimension(:,:) :: data
!--local variables:

associate( f_mat => f_gsmatrix_create_rcd )
f_mat%c_mat = gsMatrix_create_rcd(nrows, ncols, data)
f_mat%data = f_gsmatrix_data(f_mat)
call f_gsmatrix_update_data_ptr( f_mat )
end associate

end function f_gsmatrix_create_rcd

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

function f_gsmatrix_create()
!--function result type:
type(t_gsmatrix) :: f_gsmatrix_create

f_gsmatrix_create%c_mat = gsMatrix_create()
f_gsmatrix_create%data => NULL()
end function f_gsmatrix_create

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

subroutine f_gsmatrix_print(f_mat)
!--purpose: print contents of gsmatrix object
#ifdef _WIN32
!dec$ attributes dllexport :: f_gsmatrix_print
#endif
implicit none
!--subroutine arguments:
type(t_gsmatrix) :: f_mat

call gsMatrix_print(f_mat%c_mat)
write(*,*) ! flush stdout(?)
end subroutine f_gsmatrix_print

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

function f_gsmatrix_rows(f_mat)
!--purpose: get number of rows from gsmatrix object
#ifdef _WIN32
!dec$ attributes dllexport :: f_gsmatrix_rows
#endif
implicit none
!--function return value:
integer(C_INT) :: f_gsmatrix_rows
!--function arguments:
Expand All @@ -86,6 +109,11 @@ end function f_gsmatrix_rows
!------------------------------------------------------------------------------------------------------------

function f_gsmatrix_cols(f_mat)
!--purpose: get number of columns from gsmatrix object
#ifdef _WIN32
!dec$ attributes dllexport :: f_gsmatrix_cols
#endif
implicit none
!--function return value:
integer(C_INT) :: f_gsmatrix_cols
!--function arguments:
Expand All @@ -96,24 +124,50 @@ end function f_gsmatrix_cols

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

function f_gsmatrix_data(f_mat)
!--function return value:
real(C_DOUBLE), dimension(:,:), pointer :: f_gsmatrix_data
!--function arguments:
subroutine f_gsmatrix_update_data_ptr(f_mat)
!--purpose: reconnect f_mat%data after possible (re)allocation in C/C++
#ifdef _WIN32
!dec$ attributes dllexport :: f_gsmatrix_update_data_ptr
#endif
implicit none
!--subroutine arguments:
type(t_gsmatrix) :: f_mat
!--local variables:
integer(C_INT) :: nrows, ncols
type(C_PTR) :: c_data

nrows = gsMatrix_rows(f_mat%c_mat)
ncols = gsMatrix_cols(f_mat%c_mat)
c_data = gsMatrix_data(f_mat%c_mat)
call C_F_POINTER(c_data, f_gsmatrix_data, (/ nrows, ncols /))
if (nrows.le.0 .or. ncols.le.0) then
f_mat%data => NULL()
else
call C_F_POINTER( gsMatrix_data(f_mat%c_mat), f_mat%data, (/ nrows, ncols /))
endif
end subroutine f_gsmatrix_update_data_ptr

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

function f_gsmatrix_data(f_mat)
!--purpose: get pointer to data array of a gsmatrix object
#ifdef _WIN32
!dec$ attributes dllexport :: f_gsmatrix_data
#endif
implicit none
!--function return value:
real(C_DOUBLE), dimension(:,:), pointer :: f_gsmatrix_data
!--function arguments:
type(t_gsmatrix) :: f_mat

call f_gsmatrix_update_data_ptr(f_mat)
f_gsmatrix_data => f_mat%data
end function f_gsmatrix_data

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

subroutine f_gsmatrix_delete(f_mat)
!--purpose: destroy a gsmatrix object
#ifdef _WIN32
!dec$ attributes dllexport :: f_gsmatrix_delete
#endif
!--subroutine arguments:
type(t_gsmatrix) :: f_mat

Expand Down

0 comments on commit 926888b

Please sign in to comment.