Compilation aborted

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

Put the 0 in quotes

Remove the initialization on this line. (Note: you could also use len_trim.)

I changed to character(len=10) :: name_to_find = “” ,because name_to_find to will never be >10.
Now the DLL compiles.
However still no succes with calling the dll from excel vba. Excel leaves without a message. when trying to run the function.
I know my vba code is OK because it did work once, but on reopening, Excel crashed.
Therefore I thought that initializing all variables would solve the problem, but it didn’t.

Declare PtrSafe Sub poutrel Lib "C:\windows\system32\prof.dll" (ByVal name As String, _
ByVal name_len As Long, ByRef arp As Single)

Function poutr()
    Application.Volatile
    On Error GoTo err
    
    Dim ws_pout As Worksheet
    Set ws_pout = Application.ThisWorkbook.Worksheets("Sheet1")
    
    Dim beamName As String
    beamName = ws_pout.Range("B2").Value
    Dim name_len As Long
    Dim arp(1 To 19) As Single
    
    name_len = Len(beamName)
    
    'Call Fortran DLL
    poutrel beamName, name_len, arp(1)
    
    poutr = WorksheetFunction.Transpose(arp)
    
Exit Function
    
err:
    MsgBox "The following error occurred: " & err.Description
   
End Function



Sorry, I’m not familiar with the process of how VBA loads a DLL. It sounds like something goes wrong at the loading step.

On the Fortran side you could simplify things with findloc:

    ! Search for the profile
    idx = findloc(profielen%name,name_to_find,dim=1)

    if (idx == 0) then
        print *, "Invalid input: Profile not found."
        ! Initialize with zeros in case profile not found
        arp = 0.0
        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

Another idea I played with was embedding the profile table directly using a DATA statement. This avoids the reading at runtime and saves the initialization overhead.

    type :: profiel
        character(10) :: name
        real :: A, h, b, tw, tf, r
    end type profiel

    integer, parameter :: nprof = NPROF  ! Set by the preprocessor
    type(profiel) :: profielen(nprof)

    ! The table is generated automatically from poutr.csv and
    ! included using a data statement
    include "profielen.fi"

where profielen.fi contains:

data profielen / &
  profiel("ASTM-A992 ",1.00000000,1.00000000,1.00000000,1.00000000,1.00000000,1.00000000), &
  profiel("ASTM-A588 ",2.00000000,2.00000000,2.00000000,2.00000000,2.00000000,2.00000000), &
  profiel("ASTM-A36  ",3.00000000,3.00000000,3.00000000,3.00000000,3.00000000,3.00000000) /

The full subroutine I used is in the drop-down box below:

poutrel.F90
! Retrieve date of European parallel flange beams
! Version        Author         Date
!    A            R.M.        21/04/2025

! 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
    implicit none

    ! Calling parameter
    character(*), intent(inout) :: name
    real, intent(out) :: arp(19)

    type :: profiel
        character(10) :: name
        real :: A, h, b, tw, tf, r
    end type profiel

    integer, parameter :: nprof = NPROF  ! Set by the preprocessor
    type(profiel) :: profielen(nprof)

    ! The table is generated automatically from poutr.csv and
    ! included using a data statement
    include "profielen.fi"

    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=10) :: name_to_find
    integer :: idx

    ! Initialize output array to zeros
    arp = 0.0

    ! Initialize variables
    name_to_find = trim(name)  ! Set name_to_find to input parameter

    ! Debug output
    print *, "Looking for profile: '", trim(name_to_find), "'"

    ! Search for the profile
    idx = findloc(profielen%name,name_to_find,dim=1)

    if (idx == 0) then
        print *, "Invalid input: Profile not found."
        ! Initialize with zeros in case profile not found
        arp = 0.0
        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*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

    ! 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

end subroutine poutrel

To generate the table, I took your I/O part and converted it to this small helper program:

! export_profielen.f90 --
!   Reads the profile data and formats it as a valid Fortran DATA statement
!
!   The profiles are read from 'poutr.csv'.
!   Output goes to standard output.
!
program export_profielen

use, intrinsic :: iso_fortran_env, only: error_unit
implicit none

type :: profiel
    character(10) :: name
    real :: A, h, b, tw, tf, r
end type profiel

integer :: rc, file_unit, nlines
character(100) :: line
type(profiel) :: p

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

! begin DATA statement
write(*,'(A)') "data profielen / &"

nlines = 0
do
    read (file_unit, '(A)', iostat=rc) line
    if (rc /= 0) exit

    ! Parse the line
    read(line, *, iostat=rc) p%name, p%A, p%h, p%b, p%tw, p%tf, p%r

    if (rc /= 0) then
       write(error_unit,*) "Error parsing line: ", trim(line)
       cycle
    end if

    nlines = nlines + 1

    if (nlines > 1) write(*,'(A)') ', &'
    write(*,'("  profiel(",A,6(",",G0),")",A)',advance='no') &
        '"'//p%name//'"', p%A, p%h, p%b, p%tw, p%tf, p%r

end do

! end DATA statement
write(*,'(A)') ' /'

end program

The generation of the table is instrumented by this Makefile (specific to Unix/MacOS):

FC=gfortran
FFLAGS=-Wall -pedantic

# Extract the number of profiles directly from the CSV file
#  (N.b. we need to escape the dollar sign)
NPROF = $(shell wc -l poutr.csv | awk '{print $$1}')

poutrel.o: FFLAGS+=-DNPROF=$(NPROF)
poutrel.o: poutrel.F90 profielen.fi
	$(FC) $(FFLAGS) -c -o $@ $<

profielen.fi: export_profielen poutr.csv
	./export_profielen > $@

export_profielen: export_profielen.f90
	$(FC) $(FFLAGS) -o $@ $<

.PHONY: clean
clean:
	$(RM) *.o *.fi export_profielen

Why do you put name length in second position here? A string length can be passed as hidden parameter after the regular arguments. Try swapping second and third parameter. Also be sure that that name_len is of proper size (8 bytes with gfortran).

1 Like

The position of the implicit-length parameter was changed by the Intel-specific directive: https://www.intel.com/content/www/us/en/docs/fortran-compiler/developer-guide-reference/2023-0/attributes-mixed-and-nomixed-str-len-arg.html

With gfortran the implicit string length is placed at the end as you say.

1 Like

With the Intel Fortran Compiler, @sblionel wrote previously,

The string length is passed as what C would call size_t - that is indeed 8 bytes on x64.

With gfortran it is described here (paragraph 7 under 4.6.2) - since gfortran version 7 it is also size_t.

VBA specifies Long as 4 bytes: Long data type | Microsoft Learn. Presumably, @rmoortgat is using a 64-bit machine, so there could be a mismatch as you suggest.

Beware that “initializing” a variable at the same time it is declared, turns this variable into a static variable, as if it had the save attribute. It is recommended in this case to explicitly add the save attribute, even if this is not required.

I doubt that interfacing with VBA require static variables, though.

Reading a property table only once, would fit the purpose of a save variable. But I don’t know how this is handled when Excel (VBA) sees,

Declare PtrSafe Sub poutrel Lib "C:\windows\system32\prof.dll" (ByVal name As String, _
ByVal name_len As Long, ByRef arp As Single)

Is the DLL only loaded once, and remains in memory until the end of the process?

Hello,

when running the makefile i get: Unexpected token ‘$’.
Sorry but my knowledge of makefiles is very limited.

Roger

The Makefile I showed is specific to GNU Make. It might work if you use a POSIX-like shell (MSYS2, Cygwin, Git Bash, WSL). Do you know which Make you have available? The best way to check would be where make (under cmd.exe) or which make (under Cygwin, MSYS2, Git Bash).

You can also just try adapting the commands to your own build workflow:

$ make
gfortran -Wall -pedantic -DNPROF=3 -o export_profielen export_profielen.f90
./export_profielen > profielen.fi
gfortran -Wall -pedantic -DNPROF=3 -c -o poutrel.o poutrel.F90

Note the -DNPROF=3 variable is set with the number of lines in poutr.csv (I used a fake CSV file with 3 records). The second command writes the property table to an include file. The last command should be replaced with the commands needed to create the DLL.

gfortran make 4.3-4.1

Changed Makefile, now it works.

SHELL := /mnt/c/windows/system32/bash.exe

FC=gfortran
FFLAGS=-Wall -pedantic

# Extract the number of profiles directly from the CSV file
# Using a more portable approach
NPROF := $(shell if [ -f poutr.csv ]; then cat poutr.csv | wc -l; else echo 0; fi)

# Define target-specific flags
poutrel.o: FFLAGS+=-DNPROF=$(NPROF)

# Main object file
poutrel.o: poutrel.F90 profielen.fi
	$(FC) $(FFLAGS) -c -o $@ $<

# Generated include file
profielen.fi: export_profielen poutr.csv
	./export_profielen > $@

# Ensure export_profielen is built before profielen.fi
profielen.fi: export_profielen

# Utility program
export_profielen: export_profielen.f90
	$(FC) $(FFLAGS) -o $@ $<

# Clean target
.PHONY: clean
clean:
	rm -f *.o *.fi export_profielenype or paste code here
1 Like
SHELL := /mnt/c/windows/system32/bash.exe

FC=gfortran
FFLAGS=-Wall -pedantic

# Extract the number of profiles directly from the CSV file
# Using a more portable approach
NPROF := $(shell if [ -f poutr.csv ]; then cat poutr.csv | wc -l; else echo 0; fi)

# Define target-specific flags
poutrel.o: FFLAGS+=-DNPROF=$(NPROF)

# Main object file
poutrel.o: poutrel.F90 profielen.fi
	$(FC) $(FFLAGS) -c -o $@ $<

# Generated include file
profielen.fi: export_profielen poutr.csv
	./export_profielen > $@

# Ensure export_profielen is built before profielen.fi
profielen.fi: export_profielen

# Utility program
export_profielen: export_profielen.f90
	$(FC) $(FFLAGS) -o $@ $<
	
# Create DLL
kraanbaan.dll: poutrel.o export_profielen
	$(FC) -shared -o $@ $^

# Clean target
.PHONY: clean
clean:
	rm -f *.o *.fi export_profielen

Added a line to create a DLL. I get the DLL but it is not found by the vba function.
I think the message ‘file not found’ can mean anything.
Did I build a 32 bit DLL on a 64 bit machine?

Did you adapt the VBA part to use kraanbaan.dll?

Declare PtrSafe Sub poutrel Lib "C:\windows\system32\prof.dll" (ByVal name As String, _
ByVal name_len As Long, ByRef arp As Single)

Note that with gfortran (GCC) you will need other attributes to produce the public symbol with the right calling convention: ATTRIBUTES directive (The GNU Fortran Compiler)

I think the export_profilien should be dropped from the DLL target:

# Create DLL
kraanbaan.dll: poutrel.o
	$(FC) -shared -o $@ $^

Maybe it would be a good idea to add -static-libgfortran (similar to /libs:static) to include the runtime library statically. I don’t know if this option has an effect on Windows (it depends how the compiler was installed). You could also switch back to ifx; just watch out to modify the flags correctly. Usually the option -fPIC is also added when creating shared libraries (DLL’s). This could go directly to FFLAGS.

There could also be an issue with the name. With ifx you were using the ATTRIBUTES ALIAS directive:

   !DEC$ ATTRIBUTES ALIAS: 'poutrel' :: poutrel

When using gfortran the external name will be different (presumably it has a trailing underscore, i.e. poutrel_). To view the symbols you can use nm <path to library> (in a POSIX-like shell) or dumpbin /EXPORTS <path to DLL> for Windows.

My apologies if my use of gfortran was confusing. I just used what I had available on my computer.

If that can help, here is an example that I always use to start such interop development

SUBROUTINE TestCall(n, A, c, name, progressCallBack)
    IMPLICIT NONE

    !DEC$ ATTRIBUTES DLLEXPORT,STDCALL,REFERENCE, ALIAS:"testcall" :: TestCall
    !DEC$ ATTRIBUTES REFERENCE :: n, A, c, name, progressCallBack

    EXTERNAL progressCallBack
    INTEGER, INTENT(IN) :: n
    INTEGER, INTENT(IN) :: c
    DOUBLE PRECISION, DIMENSION(n, n), INTENT(inout) :: A
    CHARACTER(LEN=*), PARAMETER :: power="power"
    CHARACTER(LEN=c), INTENT(IN) :: name
    INTEGER :: i

    DO i = 1, n
        CALL progressCallBack(i)
        IF (name ==  power) THEN
            A(i, i) = i**2
        ELSE
            A(i, i) = i
        END IF
    END DO

    RETURN

END SUBROUTINE

Note that I pass the string length explicitely.
The following piece of code is for some vb.net which should not be too far from VBA

<UnmanagedFunctionPointer(CallingConvention.Cdecl)>
Public Delegate Sub ActionRefInt(ByRef progress As Integer)

Public Function Test(n As Integer, method As String) As Double(,)
      Dim A = New Double(n - 1, n - 1) {}
      InternalTestCall(n, A, method.Length, method.ToCharArray, Calc.CallbackHandler)
      Return A
End Function

<DllImport("test.dll", EntryPoint:="testcall", CharSet:=CharSet.Ansi, CallingConvention:=CallingConvention.Cdecl)>
Public Shared Sub InternalTestCall(ByRef n As Integer,
                                       <[In], Out> ByVal A As Double(,),
                                       ByRef c As Integer,
                                       <[In]> ByVal name As Char(),
                                       <MarshalAs(UnmanagedType.FunctionPtr)> ByVal callBack As ActionRefInt)
End Sub

And for the compilation with gfortran

gfortran -fno-underscoring -Wl, -Wall -Wno-tabs -c "test.f90" -o test.o
gfortran -shared -Wl,--output-def="libtest.def" -Wl,--out-implib="libtest.a" -Wl,--dll test.o -o "test.dll" -static

Hope that helps

1 Like

Dear all,

I finally got it working.
Couldn’t get the Makefile to work.
Tried a windows version of the Makefile to no avail.
I don’t like Makefiles :grimacing:, isn’t there a more convenient alternative?
I gave up an did it manually.
Exported the csv file to a fi file, included the fi file in the dll, et voilĂ  all is well.
Thank you all for your invaluable advice.

Roger

3 Likes

I now got it all working.
I ran DLL Export Viewer on the DLL.
The problem was that Fortran changed the name of some function calls in the DLLs.

e.g
mplst became MOM_M_mp_mplst
TestDLL became MOM_M_mp_test_dll

Roger

We created fpm (GitHub - fortran-lang/fpm: Fortran Package Manager (fpm)) to make it easy to build Fortran codes and libraries.