When I try to compile with ifx /dll /libs:static /threads prof.f90 I get the following error:
prof.f90(40): error #6562: A data initialization-expr is not valid for this object
character(len=len(name)) :: name_to_find = 0
I nedd to initialize all variables because otherwise I get in trouble when calling this dll in excel vba.
! Retrieve date of European parallel flange beams
! Version Author Date
! A R.M. 21/04/2025
module prof_m
implicit none
contains
! Subroutine to calculate steel profile data
subroutine poutrel(name, arp)
!DEC$ ATTRIBUTES REFERENCE, STDCALL, DLLEXPORT :: poutrel
!DEC$ ATTRIBUTES ALIAS: 'poutrel' :: poutrel
!DEC$ ATTRIBUTES REFERENCE :: arp
!DEC$ ATTRIBUTES MIXED_STR_LEN_ARG :: poutrel
use, intrinsic :: iso_fortran_env, only: error_unit
! Calling parameter
character(*), intent(inout) :: name
real, intent(out) :: arp(19)
type :: profiel
character(10) :: name = ""
real :: A = 0.0
real :: h = 0.0
real :: b = 0.0
real :: tw = 0.0
real :: tf = 0.0
real :: r = 0.0
end type profiel
type(profiel) :: profielen(90)
integer :: file_unit = 0
integer :: rc = 0, i = 0
real :: A = 0.0, h = 0.0, b = 0.0, tw = 0.0, tf = 0.0, r = 0.0
real :: Iy = 0.0, Avz = 0.0, Wy = 0.0, Wply = 0.0, iry = 0.0
real :: Iz = 0.0, Wz = 0.0, Wplz = 0.0, irz = 0.0
real :: Ss = 0.0, IT = 0.0, Iw = 0.0, G = 0.0
real, parameter :: pi = 3.1415926535
character(len=100) :: line = ""
character(len=len(name)) :: name_to_find = ""
logical :: found = .false.
! Initialize output array to zeros
arp = 0.0
! Initialize variables
found = .false.
name_to_find = trim(name) ! Set name_to_find to input parameter
! Initialize all profiles in the array
do i = 1, 90
profielen(i)%name = ""
profielen(i)%A = 0.0
profielen(i)%h = 0.0
profielen(i)%b = 0.0
profielen(i)%tw = 0.0
profielen(i)%tf = 0.0
profielen(i)%r = 0.0
end do
print *, "name=", name
print*, "name_to_find=", name_to_find
! Debug output
print *, "Looking for profile: '", trim(name_to_find), "'"
open (action='read', file='poutr.csv', iostat=rc, newunit=file_unit)
if (rc /= 0) then
write(error_unit,*) "Error opening file poutr.csv"
stop
end if
do i = 1, 90
read (file_unit, '(A)', iostat=rc) line
if (rc /= 0) exit
! Parse the line
read(line, *, iostat=rc) profielen(i)%name, &
profielen(i)%A, profielen(i)%h, profielen(i)%b, &
profielen(i)%tw, profielen(i)%tf, profielen(i)%r
if (rc /= 0) then
write(error_unit,*) "Error parsing line: ", trim(line)
cycle
end if
! Debug output
print *, "Read profile: '", trim(profielen(i)%name), "'"
end do
close (file_unit)
! Search for the profile
do i = 1, 90
if (trim(profielen(i)%name) == trim(name_to_find)) then
A = profielen(i)%A
h = profielen(i)%h
b = profielen(i)%b
tw = profielen(i)%tw
tf = profielen(i)%tf
r = profielen(i)%r
found = .true.
exit
end if
end do
if (.not. found) then
print *, "Invalid input: Profile not found."
! Initialize with zeros in case profile not found
arp = 0.0
return
end if
! Shear area
Avz = A-2*b*tf+(tw+2*r)*tf
! Weight per meter
G = A*8000*1.0e-6 ! Fixed precision issue
! Second moment of inertia
Iy =(1.0/12.0)*(b*h**3.0-(b-tw)*(h-2.0*tf)**3.0)+0.03*r**4.0+0.2146*r**2.0*(h-2.0*tf-0.4468*r)**2.0
! Second moment of inertia about z-axis
Iz = (1.0/12.0)*(2*tf*b**3.0+(h-2*tf)*tw**3.0) + &
0.03*r**4.0 + 0.2146*r**2.0*(b-tw-0.4468*r)**2.0
! Radius of gyration
iry = sqrt(Iy/A)
irz = sqrt(Iz/A)
! Tortional constant
IT = (2.0/3.0)*(b-0.63*tf)*tf**3.0+1.0/3.0*(h-2*tf)*tw**3.0+2*tw/tf*(0.145+0.1*r/tf) &
*(((r+tw/2.0)**2.0+(r+tf)**2.0-r**2.0)/(2*r+tf))**4.0
! Warping constant
Iw = ((tf*b**3.0)/24.0)*(h-tf)**2.0
! Length of stiff bearing
Ss = tw+2*tf+(4.0-2.0*sqrt(2.0))*r
! Elastic section modulus
Wy = 2*Iy/h
Wz = 2*Iz/b
! Plastic section modulus
Wply = (tw*h**2.0)/4.0+(b-tw)*(h-tf)*tf+((4.0-pi)/2.0)*r**2.0*(h-2.0*tf)+((3.0*pi-10.0)/3.0)*r**3.0
Wplz = (b**2.0*tf)/2.0 + ((h-2.0*tf)/4.0)*tw**2.0+r**3.0*(10.0/3.0-pi)+(2.0-pi/2.0)*tw*r**2.0
arp = (/A, h, b, tw, tf, r, Avz, G, Iy, Iz, iry, irz, IT, Iw, Ss, Wy, Wz, Wply, Wplz/)
return
end subroutine poutrel
end module prof_m