Dear all,
I have a fortran program with several functions and subroutines. My intention is to compile a dll from which I can call the subroutines with Qt. My question is: is it sufficient to only match the variables/arguments involved in the BIND(C) interface (in, out) explicitly to C types (e.g., real(c_float), character(kind_c_char), integer(c_int), or is it better to do this with all variables, even those who stay internal to the module.
Roger
What is the question? You may have pressed the “Send” button a bit too quickly.
sorry for that.
If you know for sure that the Fortran types you are going to eventually end up with in the module are interoperable with the C types you can usually pass them directly. However, I always convert at a minimum, Fortran integers you are passing to/from C to C_INT types because I was bitten once by someone using some code I wrote who insisted on doing -i8 -r8 compiler options. I also explicitly type all default REAL values to REAL(REAL32) if the interoperable C real type is C_FLOAT. Again for the case of implicit promotion to REAL64, the Fortran compiler should catch the type mismatch. So in short I think its best to always expicitly type everything to be the C_ values unless you know for sure that the Fortran variable that will interoperate with the C dummy argument is actually interoperable. Yes, this can lead to some explicit type conversions and wasted memory you can probably in most cases avoid, BUT its alwasy better to be (type) safe than sorry. Also, in my experience deciding what to pass by VALUE and what to pass by reference (pointer) is in most cases a bigger issue when writting C interop code than type conformance.
The arguments that are exposed to the calling routines will be checked for type/kind/rank (TKR) consistency at compile time when they are called from fortran, but they may not (or most likely will not) be checked when called from other languages. This is a general problem with cross-language interoperability. The consequence is that TKR errors will typically be quickly detected and fixed in fortran, but they may only appear at runtime, and often in obscure ways that are difficult to debug, in other languages. It also means that many of the nice features of fortran, such as optional arguments, generic interfaces, and the elemental attribute, cannot be used in the interoperable subprograms.
Thank you for these informative comments.
Roger
I’m not sure the initial question has been answered. It’s definitely a good practice to declare all arguments/components of the bind(C) procedures/derived types as c_int, c_float, etc… But regarding the variables that are not exposed to C, it’s really up to you.
If it is of any help, this is part of the code:
! DLL Max. moments and shear forces in 2-span beam with! DLL Max. moments and shear forces in 2-span beam with equal lengths
! under up to 4 moving loads
! Version Author Date
! A R.M. 14/06/2024
! B R.M. 02/05/2025
! C R.M. 23/06/2025 (ISO C Binding modifications)
! D R.M. 24/06/2025 (Literal Kind Conversion Fix)
! E R.M. 24/06/2025 (INTENT(IN) & Declarations Fix)
! F R.M. 24/06/2025 (Robust String Parsing & Call Fix)
! G R.M. 24/06/2025 (Incorporated actual profielen.txt data)
module mom_m
use iso_c_binding, only: c_float, c_double, c_int, c_char, c_null_char
implicit none
! Conversion factors
real(c_float), parameter, public :: m_to_mm = 1000.0_c_float
real(c_float), parameter, public :: N_to_kN = 0.001_c_float
real(c_float), parameter, public :: kNm_to_Nm = 1000.0_c_float
real(c_float), parameter, public :: MPa_to_Pa = 1.0e6_c_float
real(c_float), parameter, public :: mm_to_m = 0.001_c_float
real(c_float), parameter, public :: kN_to_N = 1000.0_c_float
real(c_float), parameter, public :: Nm_to_kNm = 0.001_c_float
real(c_float), parameter, public :: Pa_to_MPa = 1.0e-6_c_float
! Error codes
integer(c_int), parameter, public :: ERR_SUCCESS = 0
integer(c_int), parameter, public :: ERR_INVALID_INPUT = -1
integer(c_int), parameter, public :: ERR_CALCULATION = -2
! Module constants
real(c_float), parameter :: PI = 3.141592653589793_c_float
real(c_float), parameter :: TINY_VALUE = 1.0E-10_c_float
real(c_float), parameter :: GammaM0 = 1.00_c_float
real(c_float), parameter :: GammaM1 = 1.10_c_float
real(c_float), parameter :: GammaM2 = 1.14_c_float
real(c_float), parameter :: GammaMser = 1.00_c_float
contains
! Helper function to convert C_CHAR array to Fortran string
! This function is internal to the module and not exposed to C.
function c_char_to_fortran_string(c_str_array, c_str_len, max_fortran_len) result(f_str)
character(kind=c_char), dimension(*), intent(in) :: c_str_array
integer(c_int), value, intent(in) :: c_str_len
integer(c_int), value, intent(in) :: max_fortran_len
character(len=max_fortran_len) :: f_str
integer :: i, actual_len
f_str = ' ' ! Initialize with spaces
actual_len = 0
do i = 1, c_str_len
if (c_str_array(i) == c_null_char) then
exit
else if (actual_len < max_fortran_len) then
f_str(i:i) = char(ichar(c_str_array(i)))
actual_len = actual_len + 1
else
! String is longer than max_fortran_len, truncate
exit
end if
end do
! Trim any trailing nulls if the C string was shorter than its reported length
f_str = f_str(1:actual_len)
end function c_char_to_fortran_string
real(c_float) function Mx(x_in, a_in, L_in, P_in)
!Calling parameters
real(c_float), intent(in) :: x_in ! Position where moment is calculated
real(c_float), intent(in) :: a_in ! Position point load
real(c_float), intent(in) :: L_in ! Span
real(c_float), intent(in) :: P_in ! Value load
! Local copies for modification
real(c_float) :: x, a, L, P, b
x = x_in
a = a_in
L = L_in
P = P_in
! Evaluate Mx
if (a < L) then
b = L - a
else
a = 2._c_float * L - a
b = L - a
x = 2._c_float * L - x
endif
if (a < 0._c_float .or. a > 2._c_float * L) then
Mx = 0.0_c_float
else if (x <= a) then
Mx = ((P * b) / (4._c_float * (L ** 3._c_float))) * ((4._c_float * (L ** 2._c_float)) - (a * (L + a))) * x
else if ((x > a) .and. (x <= L)) then
Mx = ((P * b) / (4._c_float * (L ** 3._c_float))) * ((4._c_float * (L ** 2._c_float)) - (a * (L + a))) * x - P * (x - a)
else if (x > L) then
Mx = -( (P * b * a) / (4._c_float * L ** 3._c_float) ) * (L + a) * (2._c_float * L - x)
end if
end function Mx
real(c_float) function Va(a_in,L_in,P_in)
! Function to calcute max. shear at end support under one moving point load
!Calling parameters
real(c_float), intent(in) :: a_in, L_in, P_in
! Local copies for modification
real(c_float) :: a, L, P, b
a = a_in
L = L_in
P = P_in
Va = 0.0_c_float
! Evaluate Va
if (a <= L) then
b = L-a
else
a = 2._c_float*L-a
b = a-L
endif
if (a < 0._c_float .or. a > 2._c_float*L) then
Va = 0.0_c_float
else if (a <= L) then
Va = -((P*b)/(4._c_float*L**3._c_float))*(4._c_float*L**2._c_float-a*(L+a))
else if (a > L) then
Va = -((P*a*b)/(4._c_float*L**3._c_float))*(L+a)
end if
end function Va
real(c_float) function Vb(a_in,L_in,P_in)
! Function to calcute max. shear at mid support under one moving point load
!Calling parameters
real(c_float), intent(in) :: a_in, L_in, P_in
! Local copies for modification
real(c_float) :: a, L, P, b
a = a_in
L = L_in
P = P_in
Vb = 0.0_c_float
! Evaluate Vb
if (a <= L) then
b = L-a
else
a = 2._c_float*L-a
b = a-L
endif
if (a < 0._c_float .or. a > 2._c_float*L) then
Vb = 0.0_c_float
else if (a <= L) then
Vb = -((P*a)/(4._c_float*L**3._c_float))*(4._c_float*L**2._c_float+b*(L+a))
else if (a > L) then
Vb = -((P*a*b)/(4._c_float*L**3._c_float))*(L+a)
end if
end function Vb
real(c_float) function Rb(a_in,L_in,P_in)
!Function to calcute max. reaction at mid support under one moving point load
real(c_float), intent(in) :: a_in, L_in, P_in
! Local copies for modification
real(c_float) :: a, L, P, b
a = a_in
L = L_in
P = P_in
Rb = 0.0_c_float
! Evaluate rb
if (a <= L) then
b = L-a
else
a = 2._c_float*L-a
b = a-L
endif
if (a < 0._c_float .or. a > 2._c_float*L) then
Rb = 0.0_c_float
else if (a <= L) then
Rb = ((P*a)/(2._c_float*L**3._c_float))*(2._c_float*L**2._c_float+b*(L+a))
else if (a > L) then
Rb = ((P*a)/(2._c_float*L**3._c_float))*(2._c_float*L**2._c_float+b*(L+a))
end if
end function Rb
! Pure function for moment calculation - needs to be at module level for MaxMin to use it
pure function calc_total_moment(x_in, a_in, L_in, P_in, L3inv, L2_4) result(Mx_val)
real(c_float), intent(in) :: x_in, a_in, L_in, P_in, L3inv, L2_4
real(c_float) :: Mx_val, b, a_local, x_local
a_local = a_in
x_local = x_in
! Early exit for zero load
if (abs(P_in) < tiny(P_in)) then
Mx_val = 0.0_c_float
return
endif
! Handle position calculations
if (a_local < L_in) then
b = L_in - a_local
else
a_local = 2.0_c_float*L_in - a_local
x_local = 2.0_c_float*L_in - x_local
b = L_in - a_local
endif
! Check bounds
if (a_local < 0.0_c_float .or. a_local > 2.0_c_float*L_in) then
Mx_val = 0.0_c_float
else if (x_local <= a_local) then
Mx_val = (P_in * b * L3inv) * (L2_4 - a_local * (L_in + a_local)) * x_local
else if (x_local <= L_in) then
Mx_val = (P_in * b * L3inv) * (L2_4 - a_local * (L_in + a_local)) * x_local - P_in * (x_local - a_local)
else
Mx_val = -(P_in * b * a_local * L3inv * (L_in + a_local)) * (2.0_c_float*L_in - x_local)
endif
end function calc_total_moment
! Subroutine to calculate moments maxmin
! Using BIND(C) for C interoperability
subroutine MaxMin(L, P1, P2, P3, P4, a1, a2, a3, t, ar) bind(C, name='MaxMin')
use omp_lib ! Add OpenMP library (assuming it's compatible with C binding)
real(c_float), intent(in) :: L, P1, P2, P3, P4, a1, a2, a3, t
real(c_float), intent(out) :: ar(6) ! Fixed size array for C interoperability
integer :: n, ia, ix
real(c_float) :: chunk
real(c_float) :: maxmom, minmom
integer :: maxpos(2), minpos(2)
real(c_float) :: maxposx, maxposa, minposx, minposa
real(c_float) :: curr_moment, x, a
real(c_float) :: a12, a123, L3inv, L2_4 ! Pre-calculated constants
if (L <= 0.0_c_float .or. t <= 0.0_c_float) then
print *, "Error: Invalid length or step size"
ar = 0.0_c_float
return
endif
if (a1 < 0.0_c_float .or. a2 < 0.0_c_float .or. a3 < 0.0_c_float) then
print *, "Error: Invalid load spacing"
ar = 0.0_c_float
return
endif
! Pre-calculate frequently used values
n = int(2._c_float * L / t + 1._c_float)
a12 = a1 + a2
a123 = a12 + a3
L3inv = 1.0_c_float / (4.0_c_float * L**3._c_float) ! Inverse of L^3 used in Mx
L2_4 = 4.0_c_float * L**2._c_float ! 4L^2 used in Mx
chunk = max(1, n/4) ! Use fixed chunk size instead of omp_get_max_threads
! Initialize with proper min/max values
maxmom = -huge(maxmom)
minmom = huge(minmom)
maxpos = 0
minpos = 0
do ix = 1, n
do ia = 1, n
! Corrected conversion: use REAL(expression, KIND=c_float)
x = REAL(ix-1, KIND=c_float) * t
a = REAL(ia-1, KIND=c_float) * t
! Inline moment calculation for better performance
curr_moment = calc_total_moment(x, a, L, P1, L3inv, L2_4) + &
calc_total_moment(x, a - a1, L, P2, L3inv, L2_4) + &
calc_total_moment(x, a - a12, L, P3, L3inv, L2_4) + &
calc_total_moment(x, a - a123, L, P4, L3inv, L2_4)
! Update max/min in thread-safe way
if (curr_moment > maxmom) then
!$OMP CRITICAL
if (curr_moment > maxmom) then
maxmom = curr_moment
maxpos = (/ia, ix/)
endif
!$OMP END CRITICAL
endif
if (curr_moment < minmom) then
!$OMP CRITICAL
if (curr_moment < minmom) then
minmom = curr_moment
minpos = (/ia, ix/)
endif
!$OMP END CRITICAL
endif
end do
end do
!$OMP END PARALLEL DO
! Calculate final positions
! Corrected conversion: use REAL(expression, KIND=c_float)
maxposx = REAL(maxpos(2)-1, KIND=c_float) * t
maxposa = REAL(maxpos(1)-1, KIND=c_float) * t
minposx = REAL(minpos(2)-1, KIND=c_float) * t
minposa = REAL(minpos(1)-1, KIND=c_float) * t
! Set output arrays
ar = (/maxmom, minmom, maxposx, maxposa, minposx, minposa/)
end subroutine MaxMin
real(c_float) function DkEnd(L, P1, P2, P3, P4, a1, a2, a3, t) bind(C, name='DkEnd')
! Function to calculate max. shear force at end support
integer :: ia, n, alloc_stat
real(c_float), intent(in) :: L, P1, P2, P3, P4, a1, a2, a3, t
real(c_float) :: MaxVa
real(c_float), dimension(:), allocatable :: dka
n = int(2._c_float * L / t + 1._c_float)
! print *, "DEBUG: DkEnd - L=", L, " t=", t, " Calculated n=", n
allocate(dka(n), stat=alloc_stat)
if (alloc_stat /= 0) then
print *, "Error: DkEnd - Memory allocation failed for dka, n=", n, " stat=", alloc_stat
DkEnd = 0.0_c_float ! Return a safe value on error
return
endif
do ia = 1, n
! Corrected conversion: use REAL(expression, KIND=c_float)
dka(ia) = Va(REAL(ia-1, KIND=c_float) * t, L, P1) + &
Va(REAL(ia-1, KIND=c_float) * t - a1, L, P2) + &
Va(REAL(ia-1, KIND=c_float) * t - (a1+a2), L, P3) + &
Va(REAL(ia-1, KIND=c_float) * t - (a1+a2+a3), L, P4)
end do
MaxVa = minval(dka)
DkEnd = MaxVa
deallocate(dka, stat=alloc_stat)
end function DkEnd
real(c_float) function DkMid(L, P1, P2, P3, P4, a1, a2, a3, t) bind(C, name='DkMid')
! Function to calculate max. shear force at mid support
integer :: ia
integer :: n
integer :: alloc_stat
real(c_float), intent(in) :: L,P1,P2,P3,P4,a1,a2,a3,t
real(c_float) :: MaxVb
real(c_float), dimension(:), allocatable :: dkb
n = int(2._c_float * L / t + 1._c_float)
!print *, "DEBUG: DkMid - L=", L, " t=", t, " Calculated n=", n
allocate(dkb(n), stat=alloc_stat)
if (alloc_stat /= 0) then
print *, "Error: DkMid - Memory allocation failed for dkb, n=", n, " stat=", alloc_stat
DkMid = 0.0_c_float ! Return a safe value on error
return
endif
do ia = 1, n
! Corrected conversion: use REAL(expression, KIND=c_float)
dkb(ia) = Vb(REAL(ia-1, KIND=c_float) * t, L, P1) + &
Vb(REAL(ia-1, KIND=c_float) * t - a1, L, P2) + &
Vb(REAL(ia-1, KIND=c_float) * t - (a1+a2), L, P3) + &
Vb(REAL(ia-1, KIND=c_float) * t - (a1+a2+a3), L, P4)
end do
MaxVb = minval(dkb)
DkMid = MaxVb
deallocate(dkb, stat=alloc_stat)
end function DkMid
real(c_float) function ReacB(L, P1, P2, P3, P4, a1, a2, a3, t) bind(C, name='ReacB')
! Function to calculate max. reaction at mid support
integer :: ia
integer :: n
integer :: alloc_stat
real(c_float), intent(in) :: L,P1,P2,P3,P4,a1,a2,a3,t
real(c_float) :: MaxRb
real(c_float), dimension(:), allocatable :: recb
n = int(2._c_float * L / t + 1._c_float)
!print *, "DEBUG: ReacB - L=", L, " t=", t, " Calculated n=", n
allocate(recb(n), stat=alloc_stat)
if (alloc_stat /= 0) then
print *, "Error: ReacB - Memory allocation failed for recb, n=", n, " stat=", alloc_stat
ReacB = 0.0_c_float ! Return a safe value on error
return
endif
do ia = 1, n
! Corrected conversion: use REAL(expression, KIND=c_float)
recb(ia) = Rb(REAL(ia-1, KIND=c_float) * t, L, P1) + &
Rb(REAL(ia-1, KIND=c_float) * t - a1, L, P2) + &
Rb(REAL(ia-1, KIND=c_float) * t - (a1+a2), L, P3) + &
Rb(REAL(ia-1, KIND=c_float) * t - (a1+a2+a3), L, P4)
end do
MaxRb = maxval(recb)
ReacB = MaxRb
deallocate(recb, stat=alloc_stat)
end function ReacB
! Internal function, parameters are standard Fortran strings after conversion
function validate_input(HC, S, name) result(valid)
implicit none
character(len=*), intent(in) :: HC, S, name
logical :: valid
integer :: ios, num
valid = .false.
! Check HC format (HC1-HC4)
if (len_trim(HC) /= 3) return
if (HC(1:2) /= 'HC') return
read(HC(len_trim(HC):len_trim(HC)), '(I1)', iostat=ios) num
if (ios /= 0 .or. num < 1 .or. num > 4) return
! Check S format (S1-S10)
if (len_trim(S) /= 2) return
if (S(1:1) /= 'S') return
read(S(len_trim(S):len_trim(S)), '(I1)', iostat=ios) num
if (ios /= 0 .or. num < 1 .or. num > 10) return
! Check name (must be in profielen.fi)
if (len_trim(name) == 0 .or. len_trim(name) > 10) return
! All validations passed
valid = .true.
end function validate_input
! Main subroutine for external calls
subroutine mom_EV12(L_in, Qh_in, Qc_in, H1acc_in, H2acc_in, H1rail_in, H2rail_in, &
a1_in, a2_in, a3_in, t_in, HC_in, HC_len, name_in, name_len, S_in, S_len, v_in, &
all_results, Mzmax1, Mzmin1, Mzmax5, Mzmin5, Mymax1, Mymin1, Mymax5, Mymin5,&
Mzmx1, Mzmx5, Mymx1, Mymx5, &
MyEd, MzEd, MyEd5, MzEd5, VzEdMid1, VyEdEnd1, VzEdMid5, VyEdEnd5, P) &
bind(C, name='mom_EV12')
implicit none
! Input parameters (C-compatible types)
real(c_float), intent(in) :: L_in, a1_in, a2_in, a3_in, t_in, v_in
real(c_float), intent(in) :: Qh_in, Qc_in, H1acc_in, H2acc_in, H1rail_in, H2rail_in
character(kind=c_char), dimension(3), intent(in) :: HC_in ! Max len for HC is 3 (e.g., 'HC2')
integer(c_int), value, intent(in) :: HC_len
character(kind=c_char), dimension(10), intent(in) :: name_in ! Max len for name is 10 (e.g., 'HEB300 ')
integer(c_int), value, intent(in) :: name_len
character(kind=c_char), dimension(3), intent(in) :: S_in ! Max len for S is 2 (e.g., 'S2')
integer(c_int), value, intent(in) :: S_len
! Output parameters (C-compatible types)
real(c_float), intent(out) :: all_results(4,6) ! Results for all 4 force sets
real(c_float), intent(out) :: Mzmax1, Mzmin1, Mzmax5, Mzmin5, Mymax1, Mymin1, Mymax5, Mymin5
real(c_float), intent(out) :: Mzmx1, Mzmx5, Mymx1, Mymx5 ! Max/min moments
real(c_float), intent(out) :: MyEd, MzEd, MyEd5, MzEd5, VzEdMid1, VyEdEnd1, VzEdMid5, VyEdEnd5 ! Design moments shear forces
real(c_float), intent(out) :: P(7) ! Force values output
! Local Fortran variables
integer :: ios, i, HCCl, SCl ! Declared HCCl and SCl here
real(c_float) :: G, Gb
real(c_float) :: arp_in(26)
real(c_float) :: ar(6)
real(c_float) :: P11, P21, P31, P41, P15, P25, P35, P45
real(c_float) :: H11, H21, H31, H41, H15, H25, H35, H45
real(c_float) :: Mybmax, Mybmin, Vbend, Vbmid
real(c_float) :: phi1, phi2, phi4, phi5, phi2min
real(c_float) :: beta2,v_local, norm, sch
character(len=3) :: HC_local ! Fortran string copy
character(len=2) :: S_local ! Fortran string copy
character(len=10) :: name_local ! Fortran string copy
! Convert C strings (character(kind=c_char) arrays) to Fortran strings
HC_local = c_char_to_fortran_string(HC_in, HC_len, 3)
S_local = c_char_to_fortran_string(S_in, S_len, 2)
name_local = c_char_to_fortran_string(name_in, name_len, 10)
! Validate input parameters
if (.not. validate_input(HC_local, S_local, name_local)) then
print *, "Error: Invalid input parameters in mom_EV12"
print *, "HC=", trim(HC_local), " S=", trim(S_local), " name=", trim(name_local)
all_results = 0.0_c_float
! Initialize all output variables to 0.0_c_float on error
Mzmax1 = 0.0_c_float; Mzmin1 = 0.0_c_float; Mzmax5 = 0.0_c_float; Mzmin5 = 0.0_c_float
Mymax1 = 0.0_c_float; Mymin1 = 0.0_c_float; Mymax5 = 0.0_c_float; Mymin5 = 0.0_c_float
Mzmx1 = 0.0_c_float; Mzmx5 = 0.0_c_float; Mymx1 = 0.0_c_float; Mymx5 = 0.0_c_float
MyEd = 0.0_c_float; MzEd = 0.0_c_float; MyEd5 = 0.0_c_float; MzEd5 = 0.0_c_float
VzEdMid1 = 0.0_c_float; VyEdEnd1 = 0.0_c_float; VzEdMid5 = 0.0_c_float; VyEdEnd5 = 0.0_c_float
P = 0.0_c_float
return
endif
! Get dynamic factors
! CRITICAL FIX: Pass the original C-compatible string arguments to dyfa
call dyfa(HC_in, HC_len, S_in, S_len, v_in, beta2, phi2min, phi2, norm, sch)
! Use v_in directly, not v_local
phi2 = phi2min + beta2 * v_in / 60.0_c_float ! Calculate phi2 based on beta2 and v_in
phi1 = 1.1_c_float
phi4 = 1.0_c_float
phi5 = 1.5_c_float
! Get beam own weight
! Pass the length of the name_local Fortran string
call poutrel(name_local, len_trim(name_local), arp_in)
G = arp_in(8)
Gb = G
! Calculate moment, shear beam
Mybmax = (0.0772_c_float * Gb * L_in**2_c_float) / 100.0_c_float
Mybmin = (0.1250_c_float * Gb * L_in**2_c_float) / 100.0_c_float
Vbend = ((3.0_c_float/8.0_c_float) * Gb * L_in) / 100.0_c_float
Vbmid = ((5.0_c_float/8.0_c_float) * Gb * L_in) / 100.0_c_float
! Calculate forces
P11 = phi1 * Qc_in + phi2 * Qh_in
P21 = phi1 * Qc_in + phi2 * Qh_in
P31 = 0.0_c_float
P41 = 0.0_c_float
P15 = phi4 * Qc_in + phi4 * Qh_in
P25 = phi4 * Qc_in + phi4 * Qh_in
P35 = 0.0_c_float
P45 = 0.0_c_float
H11 = phi5 * H1acc_in
H21 = -phi5 * H1acc_in
H31 = 0.0_c_float
H41 = 0.0_c_float
H15 = H1rail_in
H25 = 0.0_c_float
H35 = 0.0_c_float
H45 = 0.0_c_float
P = (/P11, P21, P15, P25, H11, H21, H15/)
! Calculate force sets
call MaxMin(L_in, P11, P21, P31, P41, a1_in, a2_in, a3_in, t_in, ar)
all_results(1,:) = ar
call MaxMin(L_in, P15, P25, P35, P45, a1_in, a2_in, a3_in, t_in, ar)
all_results(2,:) = ar
call MaxMin(L_in, H11, H21, H31, H41, a1_in, a2_in, a3_in, t_in, ar)
all_results(3,:) = ar
call MaxMin(L_in, H15, H25, H35, H45, a1_in, a2_in, a3_in, t_in, ar)
all_results(4,:) = ar
Mymax1 = all_results(1, 1) ! Maximum moment for first set
Mymin1 = all_results(1, 2) ! Minimum moment for first set
Mymx1 = max(abs(Mymax1), abs(Mymin1))
Mymax5 = all_results(2, 1) ! Maximum moment for second set
Mymin5 = all_results(2, 2) ! Minimum moment for second set
Mymx5 = max(abs(Mymax5), abs(Mymin5))
Mzmax1 = all_results(3, 1) ! Maximum moment for third set
Mzmin1 = all_results(3, 2) ! Minimum moment for third set
Mzmx1 = max(abs(Mzmax1), abs(Mzmin1))
Mzmax5 = all_results(4, 1) ! Maximum moment for fourth set
Mzmin5 = all_results(4, 2) ! Minimum moment for fourth set
Mzmx5 = max(abs(Mzmax5), abs(Mzmin5))
MyEd = 1.35_c_float * (Mymx1 + Mybmax)
MzEd = 1.35_c_float * Mzmx1
MyEd5 = 1.35_c_float * (Mymx5 + Mybmax)
MzEd5 = 1.35_c_float * Mzmx5
! Calculate vertical shear forces
VzEdMid1 = 1.35_c_float * (DkMid(L_in, P11, P21, P31, P41, a1_in, a2_in, a3_in, t_in) - VbMid)
VyEdEnd1 = 1.35_c_float * (DkEnd(L_in, H11, H21, H31, H41, a1_in, a2_in, a3_in, t_in))
VzEdMid5 = 1.35_c_float * (DkMid(L_in, P15, P25, P35, P45, a1_in, a2_in, a3_in, t_in) - VbMid)
VyEdEnd5 = 1.35_c_float * (DkEnd(L_in, H15, H25, H35, H45, a1_in, a2_in, a3_in, t_in))
! Add validation check
if (abs(VzEdMid1) < TINY_VALUE) VzEdMid1 = 0.0_c_float
if (abs(VyEdEnd1) < TINY_VALUE) VyEdEnd1 = 0.0_c_float
if (abs(VzEdMid5) < TINY_VALUE) VzEdMid5 = 0.0_c_float
if (abs(VyEdEnd5) < TINY_VALUE) VyEdEnd5 = 0.0_c_float
end subroutine mom_EV12
! Poutrel subroutine - special handling for character string 'name'
subroutine poutrel(name_in, name_len, arp) bind(C, name='poutrel')
use iso_fortran_env, only: error_unit
implicit none
! Calling parameter (C-compatible character array)
character(kind=c_char), dimension(10), intent(in) :: name_in ! Fixed max length 10
integer(c_int), value, intent(in) :: name_len ! Length of the C string
real(c_float), intent(out) :: arp(26) ! Array of profile data
! Internal Fortran string for processing
character(len=10) :: name_local
! Define the internal derived type for profiles
type :: profiel
character(len=10) :: name ! Fortran string
real(c_float) :: A, h, b, tw, tf, r
end type profiel
! NPROF is now dynamically set to 69 based on profielen.txt content
integer, parameter :: NPROF = 90
type(profiel) :: profielen(NPROF)
! The following DATA statements are generated from your profielen.txt file
DATA profielen / &
profiel("HEA100 ",2124.000,96.00000,100.0000,5.000000,8.000000,12.00000), &
profiel("HEA120 ",2534.000,114.0000,120.0000,5.000000,8.000000,12.00000), &
...........
real(c_float) :: A = 0.0_c_float, h = 0.0_c_float, b = 0.0_c_float, tw = 0.0_c_float, tf = 0.0_c_float, r = 0.0_c_float
real(c_float) :: Iy = 0.0_c_float, Avz = 0.0_c_float, Wy = 0.0_c_float, Wply = 0.0_c_float, iry = 0.0_c_float
real(c_float) :: Iz = 0.0_c_float, Wz = 0.0_c_float, Wplz = 0.0_c_float, irz = 0.0_c_float
real(c_float) :: Ss = 0.0_c_float, IT = 0.0_c_float, Iw = 0.0_c_float, G = 0.0_c_float
real(c_float) :: Auf = 0.0_c_float, Izuf = 0.0_c_float, irzuf = 0.0_c_float, Wzuf = 0.0_c_float, Wzpluf = 0.0_c_float, Sy = 0.0_c_float, Syr = 0.0_c_float
real(c_float) :: Mplyd = 0.0_c_float, Mplzd = 0.0_c_float, Mplwd = 0.0_c_float, Vplzd = 0.0_c_float, Vplyd = 0.0_c_float
real(c_float), parameter :: pi = 3.1415926535_c_float
integer :: idx, i
! Initialize output array to zeros
arp = 0.0_c_float
! Convert C string to Fortran string for search
name_local = c_char_to_fortran_string(name_in, name_len, 10)
! Pad with spaces if the string is shorter than 10 characters
name_local = adjustl(name_local)
name_local = name_local // REPEAT(' ', 10 - LEN_TRIM(name_local))
! Search for the profile
! Using an explicit loop for findloc on derived type array
idx = 0
do i = 1, NPROF
if (profielen(i)%name == name_local) then
idx = i
exit
end if
end do
if (idx == 0) then
print *, "Invalid input in poutrel: Profile '", trim(name_local), "' not found."
! Initialize with zeros in case profile not found (already done)
return
end if
! Profile was found
A = profielen(idx)%A
h = profielen(idx)%h
b = profielen(idx)%b
tw = profielen(idx)%tw
tf = profielen(idx)%tf
r = profielen(idx)%r
! Shear area
Avz = A - 2._c_float*b*tf + (tw+2._c_float*r)*tf
! Weight per meter
G = A * 8000._c_float * 1.0e-6_c_float
! Second moment of inertia
Iy =(1.0_c_float/12.0_c_float)*(b*h**3.0_c_float-(b-tw)*(h-2.0_c_float*tf)**3.0_c_float)+0.03_c_float*r**4.0_c_float+0.2146_c_float*r**2.0_c_float*(h-2.0_c_float*tf-0.4468_c_float*r)**2.0_c_float
! Second moment of inertia about z-axis
Iz = (1.0_c_float/12.0_c_float)*(2._c_float*tf*b**3.0_c_float+(h-2._c_float*tf)*tw**3.0_c_float) + &
0.03_c_float*r**4.0_c_float + 0.2146_c_float*r**2.0_c_float*(tw-0.4468_c_float*r)**2.0_c_float
! Radius of gyration
iry = sqrt(Iy/A)
irz = sqrt(Iz/A)
! Tortional constant
IT = (2.0_c_float/3.0_c_float)*(b-0.63_c_float*tf)*tf**3.0_c_float+1.0_c_float/3.0_c_float*(h-2._c_float*tf)*tw**3.0_c_float+2._c_float*tw/tf*(0.145_c_float+0.1_c_float*r/tf) &
*((((r+tw/2.0_c_float)**2.0_c_float+(r+tf)**2.0_c_float-r**2.0_c_float)/(2._c_float*r+tf))**4.0_c_float)
! Warping constant
Iw = ((tf*b**3.0_c_float)/24.0_c_float)*(h-tf)**2.0_c_float
! Length of stiff bearing
Ss = tw+2._c_float*tf+(4.0_c_float-2.0_c_float*sqrt(2.0_c_float))*r
! Elastic section modulus
Wy = 2._c_float*Iy/h
Wz = 2._c_float*Iz/b
! Plastic section modulus
Wply = (tw*h**2.0_c_float)/4.0_c_float+(b-tw)*(h-tf)*tf+((4.0_c_float-pi)/2.0_c_float)*r**2.0_c_float*(h-2.0_c_float*tf)+((3.0_c_float*pi-10.0_c_float)/3.0_c_float)*r**3.0_c_float
Wplz = (b**2.0_c_float*tf)/2.0_c_float + ((h-2.0_c_float*tf)/4.0_c_float)*tw**2.0_c_float+r**3.0_c_float*(10.0_c_float/3.0_c_float-pi)+(2.0_c_float-pi/2.0_c_float)*tw*r**2.0_c_float
! Static radius
Sy = b*tf*((h-tf)/2.0_c_float)+(h/2.0_c_float-tf)*tw*((h-2.0_c_float*tf)/4.0_c_float)+((r**2_c_float*(4.0_c_float-pi))/4.0_c_float)*((h-2.0_c_float*tf-r)/2.0_c_float)
Syr = Sy - tw*((h/2.0_c_float-tf-r)**2_c_float)/2.0_c_float
! Cross sectional values top flange top flange + 1/5 web)
Auf = b*tf + ((h - 2._c_float*tf)/5._c_float)*tw
Izuf = Iz/2.0_c_float
irzuf = sqrt(Izuf/Auf)
Wzuf = Wz /2.0_c_float
Wzpluf = Wplz/2.0_c_float
! Output (indexed for easier reference)
arp( 1) = A
arp( 2) = h
arp( 3) = b
arp( 4) = tw
arp( 5) = tf
arp( 6) = r
arp( 7) = Avz
arp( 8) = G
arp( 9) = Iy
arp(10) = Iz
arp(11) = iry
arp(12) = irz
arp(13) = IT
arp(14) = Iw
arp(15) = Ss
arp(16) = Wy
arp(17) = Wz
arp(18) = Wply
arp(19) = Wplz
arp(20) = Auf
arp(21) = Izuf
arp(22) = irzuf
arp(23) = Wzuf
arp(24) = Wzpluf
arp(25) = Sy
arp(26) = Syr
end subroutine poutrel
I’m a structural engineer, but programming is a hobby of mine and since I’m retired I have lots of time.
Roger
Yes, that’s something I also discovered soon. It took many hours to figure out what to call by reference and what by value. But everything is fine now. I got a nice GUI with Qt. Now I have to figure out how to package it so my collegues can run it on the fly and what GNU license to use regarding liability.
Roger