topic VB is case sensitive and in Intel® Fortran Compiler

A reference to path//myDLL.dll could not be added.please make sure that the file is accessible,and that is a valid assembly or

John_C_ — Mon, 07 Aug 2017 11:48:09 GMT

1. have some Fortran .f90 files.

2 I installed visual Fortran compiler in visual studio 2015

I created library DLL empty project.
I added all .f90 and .f files to the project.

5 I compiled the project.

6 now I have myproject.dll file.

7.I created a web application.

8 I try to add myproject.dll to references.

9.I got this error in visual studio environment before compile. :

reference manager: A reference to path//myDLL.dll could not be added.please make sure that the file is accessible,and that is a valid assembly or COM component.

Which project type knows my dll?.is there any error in compile of my dll?therefore what should I do?

Best regards

Which version of Fortran dll

John_C_ — Mon, 07 Aug 2017 16:18:00 GMT

Which version of Fortran dll is compatible with c# ASP.NET web application ,something like http://www.c-sharpcorner.com/UploadFile/1e050f/creating-and-using-dll-class-library-in-C-Sharp/ At all my question is that how could I use .dll files created with visual Fortran compiler >library>DLL? Any help Wil be appreciated

Quote:John C. wrote:

FortranFan — Mon, 07 Aug 2017 18:03:33 GMT

John C. wrote:

Which version of Fortran dll is compatible with c# ASP.NET web application ,something like
http://www.c-sharpcorner.com/UploadFile/1e050f/creating-and-using-dll-cl...

Any help Wil be appreciated

@John C.,

Please note a Fortran DLL is similar to a C DLL or an unmanaged (Microsift terminology) C++ DLL.

Look up online on how to interoperate ASP.NET applications with a C DLL or an unmanaged C++ DLL using a P/Invoke layer, etc. the same concepts will apply to the Fortran libraries also.

By the way, look in Quote #2 of the thread below for an example of a .NET application working with Fortran; it's in Visual Basic but the same idea holds for a C# ASP.NET web application too, though with the latter you will likely have to consider thread safety and reentrancy.

https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/509148

Dear @FortranFan

John_C_ — Mon, 07 Aug 2017 18:59:00 GMT

Dear @FortranFan Thanks for your attention.I saw the link.that was too complicated.Would you please give me a brief in some sentences,for more information.how should I do step by step in a few sentences. Is it possible to import such a this dll from reference add new reference in project explorer window and see the inner modules? Best regards

Dear @FortranFan your project

John_C_ — Mon, 07 Aug 2017 22:18:00 GMT

Dear @FortranFan your project works in VS2012 but not work in VS2015.it gets the error reference manager: A reference to path//myDLL.dll could not be added.please make sure that the file is accessible,and that is a valid assembly or COM component When trying to add dll to references.in VS2012 in VB there is no reference approach.you must import Fortran module manually coding. But the main problem reason still available.

Dear @FortranFan I did what

John_C_ — Thu, 10 Aug 2017 16:32:00 GMT

Dear @FortranFan I did what you said (on the project as the topic) as same as your link instruction but I got this errors

EntryPointNotFoundException was unhandled

Unable to find an entry point named 'endat3D' in DLL 'C:\Users\admin\Downloads\HW5 add mexfam with DLL VB B\HelloWorld\HelloWorld\electrostatic3D\Debug\electrostatic3D.DLL'.

on this line of code (VB):

Call endat3D( _
strMessage, _
AddressOf RTBDisplayStatus)

this is my vb page:

Option Strict Off
Option Explicit On

Imports System.Text
Imports System.Runtime.InteropServices

Public Class frmHelloWorld

<UnmanagedFunctionPointer(CallingConvention.Cdecl)> _
Public Delegate Sub WriteDelegate(SomeString As StringBuilder, ByRef Irc As Integer)

<DllImport("C:\Users\admin\Downloads\HW5 add mexfam with DLL VB B\HelloWorld\HelloWorld\electrostatic3D\Debug\electrostatic3D.DLL", CallingConvention:=CallingConvention.Cdecl)> _
Public Shared Sub endat3D(MsgString As StringBuilder, _
<MarshalAs(UnmanagedType.FunctionPtr)> fPtr As WriteDelegate)
End Sub

Private Sub btnRun_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnRun.Click

Dim strMessage As StringBuilder
Dim IRC As Integer

strMessage = New StringBuilder("From VB.NET: Hello World")

Call RTBDisplayStatus(New StringBuilder("From VB.NET: Starting Fortran"), IRC)
Call endat3D( _
strMessage, _
AddressOf RTBDisplayStatus)

Call RTBDisplayStatus(New StringBuilder("From VB.NET: Finished Fortran"), IRC)

End Sub

Public Sub RTBDisplayStatus(s1 As StringBuilder, ByRef irc As Integer)
'
'frmHelloWorld.vb / RTBDisplayStatus
'
RichTextBox1.Text += s1.ToString().Trim() & vbCrLf
System.Windows.Forms.Application.DoEvents()
'
End Sub

End Class

and this is my endat3D.f90

!------------------------------------------------------------------------
! DATA INPUT
!------------------------------------------------------------------------

subroutine endat3D( )

use fich_electros3D
use parametros_electros3D
use electros3D
use cargavol
use cargacur
use cargapun
use permitividad
use bloqueo
use derivados3D
use auxiliar_cargas

implicit none

integer :: temp ! Dirichlte/Neumann : number of references per function
! Volumic charges : number of charged domains per function
integer :: fnum ! function numbers: Dirichlet (1 to 7) function(1) == User defined
! Neumann (1 or 3) function(1) == User defined
integer :: temp1 ! input via function for the volumic charge (1 Y 0 N)
integer :: temp2 ! input via array for the volumic charge (1 Y 0 N)
integer :: temp3 ! input via file for the volumic charge (1 Y 0 N)
integer :: i,j

dir%fun = 1
neu%fun = 1
vol%fun = 1
sup%fun = 1
cur%fun = 1

nrn = 0
neuman%numero = 0
nrd = 0
blofron%numero = 0
blopun%numero = 0
carvol%numero = 0
carsup%numero = 0
carcur%numero = 0
ncarpun = 0
permirel%numero = 0

read*,fichma
read*,fichsol
read*,fichgradsol

print*,'Strong imposition of Dirichlet conditions option (1 Yes 0 No)'
read*,iopblo
print*,iopblo

opcion_bloqueo: if (iopblo.eq.1) then

print*, 'Strong imposition of Dirichlet conditions'
print*, 'Input via function (1 Yes 0 No)'
read*,iopblo1
print*,iopblo1
print*, 'Strong imposition of Dirichlet conditions'
print*, 'Input via constants in the boundaries (1 Yes 0 No)'
read*,iopblo2
print*,iopblo2
print*, 'Strong imposition of Dirichlet conditions'
print*, 'Input via punctual blocking (1 Yes 0 No)'
read*,iopblo3
print*,iopblo3

entrada_por_funcion: if (iopblo1.eq.1) then
print*, 'Strong imposition of Dirichlet conditions'
print*, 'Input via function'
do while (.TRUE.)
print *, 'Number of references'
read*,temp
print*,temp
if (temp <= 0) exit
print *, 'References'
read*,(irefd(i),i=nrd+1,nrd+temp)
print*,(irefd(i),i=nrd+1,nrd+temp)
print *, 'Function associated to the references'
read*, fnum
print*,fnum
dir%fun(nrd+1:nrd+temp) = fnum
if (fnum<1 .or. fnum>7) stop 'incorrect function number'
nrd = nrd + temp
enddo
endif entrada_por_funcion

entrada_por_constantes: if (iopblo2.eq.1) then
print*, 'Strong imposition of Dirichlet conditions'
print*, 'Input via constants in the boundaries'
print*, 'Number of references'
read*,blofron%numero
print*,blofron%numero
if(blofron%numero.gt.0) then
print*,'References and values'
do i=1,blofron%numero
read*,blofron%referencias(i)
read*,blofron%valor(i)
enddo
print*,(blofron%referencias(i),i=1,blofron%numero)
print*,(blofron%valor(i),i=1,blofron%numero)
endif
endif entrada_por_constantes

entrada_por_puntos: if (iopblo3.eq.1) then
print*, 'Strong imposition of Dirichlet conditions'
print*, 'Input via punctual blocking'
print*, 'Number of points'
read*,blopun%numero
print*,blopun%numero
if (blopun%numero.gt.0) then
print*,'References and values'
do i=1,blopun%numero
read*,blopun%referencias(i)
read*,blopun%valor(i)
enddo
print*,(blopun%referencias(i),i=1,blopun%numero)
print*,(blopun%valor(i),i=1,blopun%numero)
endif
endif entrada_por_puntos

endif opcion_bloqueo

print*, 'Neumann references option (1 Yes 0 No)'
read*,iopneu
print*,iopneu

opcion_neuman: if (iopneu.eq.1) then

print*, 'Neumann references option'
print*, 'Input via function (1 Yes 0 No)'
read*,iopneu1
print*,iopneu1
print*, 'Neumann references option'
print*, 'Input via constants in the boundaries (1 Yes 0 No)'
read*,iopneu2
print*,iopneu2

entrada_por_funcion_neuman: if (iopneu1.eq.1) then
print*, 'Neumann references option'
print*, 'Input via function'
do while (.TRUE.)
print *, 'Number of references'
read*,temp
print *, temp
if (temp <= 0) exit
print *, 'References'
read*,(irefn(i),i=nrn+1,nrn+temp)
print*,(irefn(i),i=nrn+1,nrn+temp)
print *, 'Function associated to the references'
read*, fnum
neu%fun(nrn+1:nrn+temp) = fnum
if (fnum/=1 .and. fnum/=3) stop 'incorrect function number'
print*,fnum,functions(fnum)
nrn = nrn + temp
enddo
endif entrada_por_funcion_neuman

entrada_por_constantes_neuman: if (iopneu2.eq.1) then
print*, 'Neumann references option'
print*, 'Input via constants in the boundaries'
print*, 'Number of references'
read*,neuman%numero
print*,neuman%numero
if (neuman%numero.gt.0) then
print *, 'References and values'
do i=1,neuman%numero
read*,neuman%referencias(i)
read*,neuman%valor(i)
enddo
endif
print*,(neuman%referencias(i),i=1,neuman%numero)
print*,(neuman%valor(i),i=1,neuman%numero)
endif entrada_por_constantes_neuman

endif opcion_neuman

print *, 'Quadrature formula for matrix and second member option'
read*,iop
print*,iop
print *, 'Quadrature formula for the boundary terms'
read*,iopf
print*,iopf

print *, 'Volumic charge option (1 Yes 0 No)'
read*,iopvol
print*,iopvol

if (iopvol.eq.1) then
print*, 'Volumic charge option'
print*, 'Input via function (1 Yes 0 No)'
read*, temp1
print *, temp1
print*, 'Volumic charge option'
print*, 'Input via constants in the domains (1 Yes 0 No)'
read*, temp2
print *, temp2

if (temp1.eq.1) then
do while (.TRUE.)
print *, 'Number of references'
read*,temp
print *, temp
if (temp <= 0) exit
print*,'Domain references'
read*,(carvol%referencias(i), i=carvol%numero+1,carvol%numero+temp)
print*,(carvol%referencias(i), i=carvol%numero+1,carvol%numero+temp)
carvol%valor(carvol%numero+1:carvol%numero+temp)=0.d0
carvol%constante(carvol%numero+1:carvol%numero+temp)=.FALSE.
print*,'Type one of the function numbers below:'
print*,1,': ',functions(1)
print*,2,': ',functions(2)
read*, fnum
vol%fun(carvol%numero+1:carvol%numero+temp) = fnum
if (fnum/=1 .and. fnum/=2) stop 'incorrect function number'
print*,fnum,functions(fnum)
carvol%numero = carvol%numero + temp
enddo
endif

if (temp2.eq.1) then
print*,'Number of charges by constant'
read*,temp
print*,temp
if (temp.gt.0) then
do i=1,temp
print*,'Domain references'
read*,carvol%referencias(carvol%numero+i)
print*,carvol%referencias(carvol%numero+i)
print*,'Charge associated to the domain'
read*,carvol%valor(carvol%numero+i)
print*,carvol%valor(carvol%numero+i)
carvol%constante(carvol%numero+i) = .TRUE.
enddo
carvol%numero = carvol%numero + temp
endif
end if

end if

print*,'Superficial charge option (1 Yes 0 No)'
read*,iopsup
print*,iopsup

if (iopsup.eq.1) then

print*,'Superficial charge option'
print*, 'Input via function (1 Yes 0 No)'
read*,temp1
print*,temp1
print*,'Superficial charge option'
print*, 'Input via constants in the surfaces (1 Yes 0 No)'
read*,temp2
print*,temp2

if (temp1.eq.1) then
do while (.TRUE.)
print*,'Number of surfaces'
read*,temp
print *, temp
if (temp <= 0) exit
print*,'Surface references'
read*,(carsup%referencias(i),i=carsup%numero+1,carsup%numero+temp)
print*,(carsup%referencias(i),i=carsup%numero+1,carsup%numero+temp)
carsup%valor(carsup%numero+1:carsup%numero+temp)=0.d0
carsup%constante(carsup%numero+1:carsup%numero+temp)=.FALSE.
print*,'Type one of the function numbers below:'
print*,1,': ',functions(1)
print*,3,': ',functions(3)
print*,4,': ',functions(4)
read*, fnum
sup%fun(carsup%numero+1:carsup%numero+temp) = fnum
if (fnum/=1 .and. fnum/=3 .and. fnum/=4) stop 'incorrect function number'
print*,fnum,functions(fnum)
carsup%numero = carsup%numero + temp
enddo
endif

if (temp2.eq.1) then
print*,'Number of surfaces'
read*,temp
print *, temp
if (temp.gt.0) then
print *, 'Surface references and associated values'
do i=1,temp
read*,carsup%referencias(carsup%numero+i)
read*,carsup%valor(carsup%numero+i)
carsup%constante(carsup%numero+i) = .TRUE.
enddo
print *, (carsup%referencias(carsup%numero+i),i=1,temp)
print *, (carsup%valor(carsup%numero+i),i=1,temp)
carsup%numero = carsup%numero + temp
endif
end if

end if

print*,'Curvilinear charge option (1 Yes 0 No)'
read*,iopcur
print*,iopcur

if (iopcur.eq.1) then

print*,'Curvilinear charge option'
print*, 'Input via function (1 Yes 0 No)'
read*,temp1
print *, temp1
print*,'Curvilinear charge option'
print*, 'Input via constants in the curves (1 Yes 0 No)'
read*,temp2
print *, temp2

if (temp1.eq.1) then
do while (.TRUE.)
print*,'Number of curves'
read*,temp
print*,temp
if (temp <= 0) exit
print*,'Curve references'
read*,(carcur%referencias(i),i=carcur%numero+1,carcur%numero+temp)
print*,(carcur%referencias(i),i=carcur%numero+1,carcur%numero+temp)
carcur%valor(carcur%numero+1:carcur%numero+temp)=0.d0
carcur%constante(carcur%numero+1:carcur%numero+temp)=.FALSE.
print*,'Type one of the function numbers below:'
print*,1,': ',functions(1)
print*,5,': ',functions(5)
read*, fnum
cur%fun(carcur%numero+1:carcur%numero+temp) = fnum
if (fnum/=1 .and. fnum/=5) stop 'incorrect function number'
print*,fnum,functions(fnum)
carcur%numero = carcur%numero + temp
enddo
endif

if (temp2.eq.1) then
print*,'Number of curves'
read*,temp
print *, temp
if(temp.gt.0) then
print*, 'Curve references and associated charges'
do i=1,temp
read*,carcur%referencias(carcur%numero+i)
read*,carcur%valor(carcur%numero+i)
carcur%constante(carcur%numero+i) = .TRUE.
enddo
print *, (carcur%referencias(carcur%numero+i),i=1,temp)
print *, (carcur%valor(carcur%numero+i),i=1,temp)
carcur%numero = carcur%numero + temp
endif
end if

end if

print*,'Punctual charge option (1 Yes 0 No)'
read*,ioppun
print*,ioppun

if (ioppun.eq.1) then
print*,'Number of charges'
read*,ncarpun
do i=1,ncarpun
print*,'Point coordinates and associated charge'
read*,xcarpun(i)
read*,ycarpun(i)
read*,zcarpun(i)
read*,carpun(i)
print*, xcarpun(i),ycarpun(i),zcarpun(i)
print*, carpun(i)
enddo
end if

iopteta=0

print*,'Number of subdomains'
read*,permirel%numero
do i=1,permirel%numero
print*,'Subdomain number'
read*,permirel%referencias(i)
print*,permirel%referencias(i)
print*,'Relative electric permitivity option'
print*,'1 --> Via function'
print*,'2 --> Via constants per domain'
print*,'3 --> Via array'
read*,permirel%iopermir(i)
print*,permirel%iopermir(i)
if(permirel%iopermir(i).eq.1) then
print*,'Function name'
!do j=1,size(functions_perm,1)
! print *, j,': ', functions_perm(j)
!enddo
read*,permirel%etiqueta(i)
!print*,permirel%fun(i)
if (permirel%fun(i)<1 .or. permirel%fun(i)> &
size(functions_perm,1)) stop 'incorrect function number'
elseif(permirel%iopermir(i).eq.2) then
print*,'Electric permitivity (x,y,z)'
read*,permirel%valorx(i), permirel%valory(i), permirel%valorz(i)
print*,permirel%valorx(i), permirel%valory(i), permirel%valorz(i)
elseif(permirel%iopermir(i).eq.3)then
iopteta=1
read*,permirel%ntab(i)
do j=1,permirel%ntab(i)
read*,permirel%teta(i,j),permirel%valtabx(i,j), &
permirel%valtaby(i,j),permirel%valtabz(i,j)
enddo
else
stop 'Incorrect relative electric permitivity option: only 1 , 2 , 3'
endif
enddo

if (iopteta.eq.1) then
print*,'Name of temperature file'
read*,fichteta
print*,fichteta
endif

print*,'Option for the linear system resolution'
print*,'1: Direct method, 0 : Conjugate gradient'
read*,iopsl
print*,iopsl
if(iopsl.eq.0) then
print*,'Corvengence error in CG'
read* ,epscg
print*,epscg
print*,'Maximum number of iterations in CG'
read*,nitcg
print*,nitcg
endif

if(allocated(ncaras))deallocate(ncaras)
allocate(ncaras(carsup%numero),stat=ierror)
if (ierror.ne.0) then
print*,'Error while allocating ncaras'
stop 1
endif

if(allocated(nodc1))deallocate(nodc1)
if(allocated(nodc2))deallocate(nodc2)
if(allocated(nodc3))deallocate(nodc3)
allocate(nodc1(carsup%numero,ndcaras), &
nodc2(carsup%numero,ndcaras), &
nodc3(carsup%numero,ndcaras),stat=ierror)
if (ierror.ne.0) then
print*,'Error while allocating nodc1,2 o 3'
stop 1
endif

if(allocated(naristas))deallocate(naristas)
allocate(naristas(carcur%numero),stat=ierror)
if (ierror.ne.0) then
print*,'Error while allocating naristas'
stop 1
endif

if(allocated(nod1))deallocate(nod1)
if(allocated(nod2))deallocate(nod2)
allocate(nod1(carcur%numero,ndar), &
nod2(carcur%numero,ndar),stat=ierror)
if (ierror.ne.0) then
print*,'Error while allocating nod1 o nod2'
stop 1
endif

return
end

so what should I do?

best regards

It appears to be a simple

mecej4 — Thu, 10 Aug 2017 16:58:54 GMT

It appears to be a simple name decoration issue. By default, the Fortran compiler creates an entry point ENDAT3D regardless of the case used for the name in the Fortran source. VB probably uses a different convention, so the names of the entry expected and the entry present differ in case and/or underscores. There are a number of ways of managing name decoration, ranging from compiler options to embedded DEC$ directives in the Fortran code. Find out what VB expects and make the Fortran match that (I don't use VB, so I don't know what it expects).

VB is case sensitive and

Steve_Lionel — Thu, 10 Aug 2017 17:56:53 GMT

VB is case sensitive and doesn't "decorate" names. Also for 32-bit, VB uses the STDCALL convention by default, but I see you overrode that with Cdecl, so that part is ok.

perhaps maybe problems is

John_C_ — Thu, 10 Aug 2017 18:21:00 GMT

perhaps maybe problems is there : 1.one probability is that compiler could not make a total DLL from my Fortran files . 2.and another maybe there is a mistake on calling dlls in my vb code . 3.and at last any modification in my .f90 Fortran files are needed. 4. Finally maybe confusing of the names(in .f90 ,in dll,in vb code and so far)...

Focusing on these lines:

John_C_ — Thu, 10 Aug 2017 18:26:46 GMT

Focusing on these lines: .... _ Public Shared Sub endat3D(MsgString As StringBuilder, _ fPtr As WriteDelegate) End Sub .... and ..... Call endat3D( _ strMessage, _ AddressOf RTBDisplayStatus)

My main .f90 file that I want

John_C_ — Thu, 10 Aug 2017 19:17:56 GMT

My main .f90 file that I want to call via DLL is principal.f90 as below: !--------------------------------------------------------------------------- ! ! GOAL : Solve, by means of finite elements, the electrostatics 3D ! PDE with different boundary conditions and charges ! ! | -div(permi grad(V))=f ! (1) | V = V+ on Dirichlet boundary ! | permi d(V)/dn=g ! ! Dolores Gomez ! MC Muٌiz ! Jose Luis Ferrin Gonzalez ! !--------------------------------------------------------------------------- program ppalelectros3D use fich_electros3D use electros3D use cargavol use cargacur use cargapun use permitividad use bloqueo use derivados3D use malla_3DP1 use external_electros3D use module_writeVTU use comprobaciones use module_convers use module_fem_extract use module_conver3d, only: conver3d use LIB_VTK_IO_READ use module_readUNV use module_compiler_dependant implicit none integer :: i,istat, p, nnod,DIMS,LNN,LNV,LNE,LNF,nnd,nco,npieces,nverteta,iformat integer, allocatable :: nn(:,:) real(real64), allocatable :: evtun(:) !--------------------------------------------------------------------------- ! INPUT DATA !--------------------------------------------------------------------------- if (command_argument_count() == 0) then call endat3D() else call readxml() end if ! INPUT DATA VERIFICATION, FOR ENDAT & READXML if (.not. comprueba()) then write(error_unit,*) 'Input data check failed' stop 1 else write(output_unit,*) 'Input data check passed' endif call calculate_funs() ! 0.0 IS ASSIGNED TO THE LAST VERTEX IN CASE OF NOT HAVING DIRICHLET CONDITIONS if (blocking_node() < 0) then write(error_unit,*) 'Error assigning blocking node' stop 1 endif !--------------------------------------------------------------------------- ! ELECTROMAGNETIC MESH READING !--------------------------------------------------------------------------- call calindc(indc,inda) p = index(fichma, '.', back=.true.) if (p == 0) stop 'Mesh file has not extension: unable to identify mesh format' select case (lcase(fichma(p+1:len_trim(fichma)))) case('mfm') iformat=1 call leema3D(iformat) case('mum') iformat=2 call leema3D(iformat) case('unv') call readUNV(fichma,nel,nnod,nver,dims,LNN,LNV,LNE,LNF,nn,mm,nrc,nra,nrv,z,nsd) call conver3d(nel, nver, mm, z, nemm, det, binv, ib, jb) case default stop 'Unrecognized mesh file extension' end select call alloc_after_mesh() !--------------------------------------------------------------------------- ! TEMPERATURE READING !--------------------------------------------------------------------------- if (iopteta == 1) call leetmp() !--------------------------------------------------------------------------- ! COMPUTATIONS !--------------------------------------------------------------------------- if (iopblo.eq.1.and.iopblo1.eq.1) then call calprebloqueof(nrd,irefd) endif if (iopblo.eq.1.and.iopblo2.eq.1) then call calprebloqueoc(blofron%numero,blofron%referencias) endif call electrostatica3D() if(allocated(vexac))deallocate(vexac) allocate(vexac(nver),stat=ierror) if (ierror.ne.0) then print*,'Error while allocating array vexac',nver stop 1 endif if(allocated(err))deallocate(err) allocate(err(nver),stat=ierror) if (ierror.ne.0) then print*,'Error while allocating array err',nver stop 1 endif ! call wrtcmp(nver,sol,10,fichsol) ! call writeVTU(nel,nver,mm,z,'tetra',sol,'solucion','scalar', & ! 'node',trim(fichsol)//'.vtu') ! -1: mixed functions ! 0: no data ! 1: User defined / Function defined by user ! ... if (dir%funs > 1.or.& neu%funs > 1.or.& vol%funs > 1.or.& sup%funs > 1.or.& cur%funs > 1) then do i=1,nver vexac(i) = fexac(z(1,i),z(2,i),z(3,i)) err(i) = dabs(vexac(i)-sol(i)) enddo if (dir%funs == 7) then ! 'Example 6' vexac(376) = sol(376) vexac(193) = sol(193) err(193) = dabs(vexac(193)-sol(193)) err(376) = dabs(vexac(376)-sol(376)) elseif (dir%funs == 6) then ! 'Example 5' vexac(1292) = sol(1292) err(1292) = dabs(vexac(1292)-sol(1292)) endif call norl2_3D(sol,xnorexac) call norl2_3D(vexac,xnorexac) call norl2_3D(err,xnorerr) rel = xnorerr/xnorexac print*,'Relative error (%)',100*rel endif ! COMPUTATION OF THE ELECTRIC FIELD call ef() !--------------------------------------------------------------------------- ! RESULTS OUTPUT !--------------------------------------------------------------------------- call wrtcmp(nver,sol,10,fichsol) call writeVTU(nel,nver,mm,z,'tetra',sol,'Potential (V)','scalar', & 'node',trim(fichsol)//'.vtu') call wrtcmpv(nel,e,10,fichgradsol) if(allocated(evtu))deallocate(evtu) allocate(evtu(3*nel),STAT=istat) if (istat.ne.0) stop 'Error while allocating evtu in principal' evtu(1:nel*3:3)=e(1,1:nel) evtu(2:nel*3:3)=e(2,1:nel) evtu(3:nel*3:3)=e(3,1:nel) call cell2node(nver, mm, evtu, evtun) call writeVTU(nel,nver,mm,z,'tetra',evtun,'Electric field (V/m)',& 'vector','node',trim(fichgradsol)//'.vtu') deallocate(evtu,STAT=istat) if (istat.ne.0) stop 'Error while deallocating in principal' deallocate(sol,STAT=istat) if (istat.ne.0) stop 'Error while deallocating in principal' deallocate(e,STAT=istat) if (istat.ne.0) stop 'Error while deallocating in principal' stop 'End of the execution' end

As @FortranFan said in

John_C_ — Thu, 10 Aug 2017 20:05:00 GMT

As @FortranFan said in https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/509148 Visit my vs2012 ell error page snapshot. At. https://i.stack.imgur.com/CnoTQ.jpg Everything is ok.but I have a lot of .f90 files as a dll project.how could I modify @FortranFan project with a little changes that cover my Fortran project? Regards

Quote:John C. wrote:

FortranFan — Thu, 10 Aug 2017 21:23:29 GMT

John C. wrote:

As @FortranFan said in
https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-fo...

.. how could I modify @FortranFan project with a little changes that cover my Fortran project ..

@John C.,

You seem to be taking the Visual Basic .NET and Fortran example from the above thread on this forum and literally using the Visual Basic code with only a name change to endat3D and hoping everything works out. It's not as simple as that, at least as far as I know.

It would appear you need to do a lot more research and investigate further because your posts above indicate issues at the very basic (no pun intended!) level: first, you do not seem to have paid attention to make the procedures in Fortran callable in a mixed language environment and whether as part of this, you have even looked into the interoperability aspects with a companion C processor; you do not seem to have looked into the method signatures i.e., matching the procedure declaration in Fortran with the interface in Visual Basic; also, it's unclear if you have setup your Fortran DLL project correctly with the necessary export definitions.

All I can suggest is for you to look up information online and apply the learnings to your situation and note the complete working example of Visual Basic .NET and Fortran from the above thread is a good guide, provided you pay attention to the relevant details:

Information on setting up of DLLs by Microsoft: https://msdn.microsoft.com/en-us/library/1ez7dh12.aspx
Also look into DLL example with Intel Fortran: https://software.intel.com/en-us/fortran-compiler-18.0-developer-guide-and-reference-using-the-intel-fortran-samples
Mixed-language programming for Fortran and C: https://software.intel.com/en-us/fortran-compiler-18.0-developer-guide-and-reference-mixed-language-programming
Pay particular attention to standard Fortran interoperability aspects: https://software.intel.com/en-us/fortran-compiler-18.0-developer-guide-and-reference-standard-fortran-and-c-interoperability

@FortranFan,

John_C_ — Thu, 10 Aug 2017 22:08:00 GMT

@FortranFan, I saw some pages of each link you introduced.but it takes a lot of time to study.I am looking for a more quick strategy.so what should I do? As the discussion issue Would you please introduce or send me a visual studio 2012 -Fortran application -dll .NET example which I could download and test them with vs2012? Really I want to mix Fortran with c# asp.net web application , but VB.NET Windows form application as the first step is good.actually c or c++ are a little far from my goal. Regards

There are two sample

Steve_Lionel — Fri, 11 Aug 2017 00:00:29 GMT

There are two sample applications that mix VB with Fortran that you can find in the samples installed with your compiler version. (In some newer versions the samples are provided online only.) Unpack the samples ZIP file into a writable folder and look under Fortran > MixedLanguage. I don't know what the "stringbuilder" thing does.

@Steve Lionel (Ret) ,

John_C_ — Fri, 11 Aug 2017 00:45:28 GMT

@Steve Lionel (Ret) , I run them.could I use them for my purpose.means changing .f90 file into many .f90 files and call them via vb.net as the sample easily or as @FortranFan said it takes to study more.do you have any idea? Best regards

One or many .f90 files makes

Steve_Lionel — Fri, 11 Aug 2017 01:05:06 GMT

One or many .f90 files makes no difference. What matters is getting the expectations of VB and Fortran to match.

I see that your Fortran code that you want to call "as a DLL" has a main program. That won't work. You have to call a subroutine or a function, so you'll have to restructure the program as a function that can be called. You can test it first by calling from a Fortran main program, and then work out how to interface it to VB.

I suggested the VB-Fortran samples as "case studies" for how to do this sort of thing. You'll see in both programs that there is no Fortran main program - instead there are functions. The VB code determines what data wants to be processed by the Fortran code and calls the Fortran function, which resides in a DLL. The call then returns to VB which does something with the result.

I fear that you think there's a simple edit to your existing program that will make it all work with VB - that is not the case.

@Steve Lionel (Ret) ,,

John_C_ — Sat, 12 Aug 2017 18:21:00 GMT

@Steve Lionel (Ret) ,, Could I change VB-Calls-Fortran project (sample inside Intel Parallel package) ? as locally in C:\Users\admin\Documents\MixedLanguage\MixedLanguage\VB-Calls-Fortran... as to run my project with a few modification as below: the scripts below are originally as same as the package ,no modification applied. in fcall.90 : ... ! Fortran part of a VB-Fortran DLL example. This ! routine DLL_ROUT is called from a VB.NET executable ! program. SUBROUTINE DLL_ROUT (DBL_IN, STRING_IN, DBL_OUT) IMPLICIT NONE ... in Module1.vb ... Module Module1 REM Use ByVal to pass strings unless the called routine expects BSTR structures Public Declare Auto Sub DLL_ROUTMo Lib "FCALL.DLL" _ (ByVal DBL_IN() As Double, ByVal STR_IN As String, ByVal DBL_OUT() As Double) End Module ... in Form1.vb .... Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim DBL_IN(4) As Double Dim DBL_OUT(4) As Double Dim MULTIPLIER As String ' Note that in VB, arrays are zero-based. DBL_IN(0) = 1.0 DBL_IN(1) = 2.0 DBL_IN(2) = 3.0 DBL_IN(3) = 4.0 MULTIPLIER = "2.0" Call DLL_ROUT(DBL_IN, MULTIPLIER, DBL_OUT) TextBox1.Text = DBL_OUT(0) TextBox2.Text = DBL_OUT(1) TextBox3.Text = DBL_OUT(2) TextBox4.Text = DBL_OUT(3) End Sub .... i want to add more .f90 files and now it's not important to send argument(in future maybe).In a fortran DLL librray could it make a DLL covering all .f90 subroutine (or function) files? the tree directory list is as below: C:. │ build.bat │ ReadMe.txt │ VB-Calls-Fortran.sln │ ├───FCALL │ │ fcall.f90 │ │ FCALL.vfproj │ │ │ └───Debug │ BuildLog.htm │ FCALL.dll │ FCALL.dll.intermediate.manifest │ FCALL.exp │ FCALL.lib │ fcall.obj │ FCALL.pdb │ vc110.pdb │ ├───README_FIRST │ README_FIRST.vfproj │ └───VBCallsFortran │ AssemblyInfo.vb │ Form1.resx │ Form1.vb │ Module1.vb │ VBCallsFortran.vbproj │ ├───bin │ FCALL.dll │ VBCallsFortran.exe │ VBCallsFortran.pdb │ VBCallsFortran.vshost.exe │ VBCallsFortran.vshost.exe.manifest │ VBCallsFortran.xml │ ├───My Project └───obj └───x86 └───Debug │ DesignTimeResolveAssemblyReferences.cache │ DesignTimeResolveAssemblyReferencesInput.cache │ VBCallsFortran.exe │ VBCallsFortran.Form1.resources │ VBCallsFortran.pdb │ VBCallsFortran.vbproj.FileListAbsolute.txt │ VBCallsFortran.vbproj.GenerateResource.Cache │ VBCallsFortran.xml │ └───TempPE When I changed DLL_ROUT to Mysubroutine in all files above and I add all my .f90 files I see this error: EntryPointNotFoundException was unhandled Unable to find an entry point named 'Mysubroutine' in DLL 'FCALL.DLL'. on this line: Call Mysubroutine() But When I changed back the Mysubroutine to it's original name DLL_ROUT everything works right.Is there any problem in making DLL or something else? any help will be appreciated Best Regards

A part of my problem solved

John_C_ — Sat, 12 Aug 2017 21:30:31 GMT

A part of my problem solved as I use VB.NET-SafeArrays package and changing all ForCall statements to readxml and add this line of code: !dec$ attributes dllexport, stdcall, reference, alias : "readxml" :: readxml define readxml as subroutine readxml(VBArray) and adding integer(int_ptr_kind()), intent(inout) :: VBArray !Pointer to a SafeArray structure there is no error but nothing happen when I run the project , this is my readxml.f90 file contents: !----------------------------------------------------------------------- ! procedure for reading the solver variables !----------------------------------------------------------------------- subroutine readxml(VBArray) ! Set the attributes needed for compatibility with VB.NET. VB always uses STDCALL. ! !dec$ attributes dllexport, stdcall, reference, alias : "readxml" :: readxml use module_SO_DEPENDANT use module_REPORT use module_xml_parser !Solver modules use fich_electros3D use electros3D, DOUBLElocal1 => DOUBLE use cargavol, DOUBLElocal2 => DOUBLE use cargacur, DOUBLElocal3 => DOUBLE use cargapun, DOUBLElocal4 => DOUBLE use permitividad, DOUBLElocal5 => DOUBLE use bloqueo, DOUBLElocal6 => DOUBLE use derivados3D, DOUBLElocal7 => DOUBLE use auxiliar_cargas !use ifcom ! Declare SafeArray and BSTR interfaces implicit none !! !! implicit none !! integer(int_ptr_kind()), intent(inout) :: VBArray !Pointer to a SafeArray structure integer :: i, j, pos, ide, im, fnum real(DOUBLE) :: cval real(DOUBLE), dimension(:), allocatable :: xcp, aux character(len=MAXPATH) :: matxml, sval, tval character(len=MAXPATH), dimension(:), allocatable :: list, list2, list3, refs call set_SO() call set_report_level(REPORT_STDOUT) ! inicializacion de variables (array) ! fun_0 == User defined / Function defined by user dir%fun = 1 neu%fun = 1 vol%fun = 1 sup%fun = 1 cur%fun = 1 ide = fopen() !Mesh call fread(ide, '/Mesh/Open/Mesh file', fichma) !Boundary Condicions print*,'Neumann' !Neumann conditions iopneu = 0; iopneu1 = 0; iopneu2 = 0 nrn = 0 neuman%numero = 0 call flist(ide, '/Boundary conditions/Neumann/Conditions/', list) do i = 1, size(list,1) !loop for defined Neumann BC's call flist(ide, '/Boundary conditions/Neumann/Conditions/'//trim(list(i)), list2) do j = 1, size(list2,1) !loop for data type for each BC select case(trim(list2(j))) case('A function') !References call fread_alloc(ide, '/Boundary conditions/Neumann/Conditions/'//trim(list(i))//& &'/A function/Surface references', refs, realloc=.true.) if (size(refs,1)>0) then iopneu = 1 iopneu1 = 1 ! ok !Function call fread(ide, '/Boundary conditions/Neumann/Conditions/'//trim(list(i))//& &'/A function/Function name', sval) pos = nrn + 1 irefn(pos:pos+size(refs,1)-1) = int(refs) fnum = function_number(sval,functions) if (fnum == 0) call error('readxml: unknown function: '//sval) neu%fun(pos:pos+size(refs,1)-1) = fnum nrn = nrn + size(refs,1) else print * , 'Function Neumann B.C. with 0 references: skipping' endif case('A constant') !References call fread_alloc(ide, '/Boundary conditions/Neumann/Conditions/'//trim(list(i))//& &'/A constant/Surface references', refs, realloc=.true.) if (size(refs,1)>0) then iopneu = 1 iopneu2 = 1 ! ok !Constant value call fread(ide, '/Boundary conditions/Neumann/Conditions/'//trim(list(i))//& &'/A constant/Constant value', cval) pos = neuman%numero + 1 neuman%referencias(pos:pos+size(refs,1)-1) = int(refs) neuman%numero = neuman%numero + size(refs,1) neuman%valor(pos:pos+size(refs,1)-1) = cval else print * , 'Constant Neumann B.C. with 0 references: skipping' endif case default; call error('readxml: Case not implemented.') end select enddo enddo print*,'Dirichlet' !Potential (Dirichlet) conditions iopblo = 0; iopblo1 = 0; iopblo2 = 0; iopblo3 = 0 nrd = 0 blofron%numero = 0 blopun%numero = 0 call flist(ide, '/Boundary conditions/Dirichlet/Conditions', list) do i = 1, size(list,1) !loop for defined potential BC's call flist(ide, '/Boundary conditions/Dirichlet/Conditions/'//trim(list(i)), list2) do j = 1, size(list2,1) !loop for data type for each BC select case(trim(list2(j))) case('A function') !References call fread_alloc(ide, '/Boundary conditions/Dirichlet/Conditions/'//trim(list(i))//& &'/A function/Surface references', refs, realloc=.true.) if (size(refs,1)>0) then iopblo = 1 iopblo1 = 1 ! ok !Function call fread(ide, '/Boundary conditions/Dirichlet/Conditions/'//trim(list(i))//& &'/A function/Function name', sval) pos = nrd + 1 irefd(pos:pos+size(refs,1)-1) = int(refs) fnum = function_number(sval,functions) if (fnum == 0) call error('readxml: unknown function: '//sval) dir%fun(pos:pos+size(refs,1)-1) = fnum nrd = nrd + size(refs,1) else print * , 'Function Dirichlet B.C. with 0 references: skipping' endif case('A constant') !References call fread_alloc(ide, '/Boundary conditions/Dirichlet/Conditions/'//trim(list(i))//& &'/A constant/Surface references', refs, realloc=.true.) if (size(refs,1)>0) then iopblo = 1 iopblo2 = 1 ! ok !Constant value call fread(ide, '/Boundary conditions/Dirichlet/Conditions/'//trim(list(i))//& &'/A constant/Constant value', cval) pos = blofron%numero + 1 blofron%referencias(pos:pos+size(refs,1)-1) = int(refs) blofron%numero = blofron%numero + size(refs,1) blofron%valor(pos:pos+size(refs,1)-1) = cval else print * , 'Constant Dirichlet B.C. with 0 references: skipping' endif ! case('Point') ! iopblo3 = 1 ! ok ! !References ! call fread_alloc('/B.C./Define.../B.C. type/Potential/'//trim(list(i))//& ! &'/Point/Reference number(s)', refs, realloc=.true.) ! !Constant value ! call fread('/B.C./Define.../B.C. type/Potential/'//trim(list(i))//& ! &'/Point/Constant value', cval) ! if (size(refs,1)>0) ! iopblo3 = 1 ! ok ! pos = blopun%numero + 1 ! blopun%referencias(pos:pos+size(refs,1)-1) = int(refs) ! blopun%numero = blopun%numero + size(refs,1) ! blopun%valor(pos:pos+size(refs,1)-1) = cval ! else ! print * , 'Dirichlet B.C. with 0 references: skipping' ! endif case default; call error('readxml: Case not implemented.') end select enddo enddo ! 2010-02-08,11: Blocking node and Blocking value ! 2010-09-21: comentado !print*,'Blocking node and blocking value' ! call fread_alloc(ide, '/Data/Blocking for Neumann problem/'//& ! &'Blocking for Neumann problem/Blocking node', xcp, realloc=.true.) ! call fread_alloc(ide, '/Data/Blocking for Neumann problem/'//& ! &'Blocking for Neumann problem/Blocking value', aux, realloc=.true.) ! if ( size(xcp,1) > 1 ) call error('readxml: Only 0 or 1 blocking node allowed') ! if ( size(aux,1) > 1 ) call error('readxml: Only 0 or 1 blocking value allowed') ! if ( ( size(xcp,1) == 1 ) .and. ( size(aux,1) /= 1 ) )& ! &call error('readxml: Found blocking node but no blocking value') ! if ( ( size(aux,1) == 1 ) .and. ( size(xcp,1) /= 1 ) )& ! &call error('readxml: Found blocking value but no blocking node') ! if ( ( size(xcp,1) == 1 ) .and. ( size(aux,1) == 1 ) ) then ! iopblo = 1 ! iopblo3 = 1 ! blopun%numero = blopun%numero + 1 ! blopun%referencias(blopun%numero) = int(xcp(1)) ! blopun%valor(blopun%numero) = aux(1) ! end if !Sources print*,'Volume sources' !Volumic sources iopvol = 0 ! 1 => hai volumic sources carvol%numero = 0 call flist(ide, '/Sources/Volumetric/Volumetric sources', list) do i = 1, size(list,1) !loop for defined volumic sources call flist(ide, '/Sources/Volumetric/Volumetric sources/'//trim(list(i)), list2) if (size(list2,1)/=1) call error('readxml: Incorrect number of childs in volume source.') if (trim(list2(1)) == 'A function') then !References call fread_alloc(ide, '/Sources/Volumetric/Volumetric sources/'//trim(list(i))//& &'/A function/Domain references', refs, realloc=.true.) if (size(refs,1)>0) then iopvol = 1 !Function call fread(ide, '/Sources/Volumetric/Volumetric sources/'//trim(list(i))//& &'/A function/Function name', sval) pos = carvol%numero + 1 carvol%referencias(pos:pos+size(refs,1)-1) = int(refs) carvol%numero = carvol%numero + size(refs,1) carvol%valor(pos:pos+size(refs,1)-1) = 0.d0 fnum = function_number(sval,functions) if (fnum == 0) call error('readxml: unknown function: '//sval) vol%fun(pos:pos+size(refs,1)-1) = fnum carvol%constante(pos:pos+size(refs,1)-1) = .FALSE. else print * , 'Function volume source with 0 references: skipping' endif elseif (trim(list2(1)) == 'A constant') then !References call fread_alloc(ide, '/Sources/Volumetric/Volumetric sources/'//trim(list(i))//& &'/A constant/Domain references', refs, realloc=.true.) if (size(refs,1)>0) then iopvol = 1 !Constant value call fread(ide, '/Sources/Volumetric/Volumetric sources/'//trim(list(i))//& &'/A constant/Constant value', cval) pos = carvol%numero + 1 carvol%referencias(pos:pos+size(refs,1)-1) = int(refs) carvol%numero = carvol%numero + size(refs,1) carvol%valor(pos:pos+size(refs,1)-1) = cval carvol%constante(pos:pos+size(refs,1)-1) = .TRUE. else print * , 'Constant volume source with 0 references: skipping' endif else call error('readxml: Incorrect volume source child: '//trim(list2(1))//'.') endif enddo print*,'Surface sources' !Surface sources iopsup = 0 ! 1 => hai surface sources carsup%numero = 0 call flist(ide, '/Sources/Surface/Surface sources', list) do i = 1, size(list,1) !loop for defined surface sources call flist(ide, '/Sources/Surface/Surface sources/'//trim(list(i)), list2) if (size(list2,1)/=1) call error('readxml: Incorrect number of childs in surface source.') if (trim(list2(1)) == 'A function') then !References call fread_alloc(ide, '/Sources/Surface/Surface sources/'//trim(list(i))//& &'/A function/Surface references', refs, realloc=.true.) if (size(refs,1)>0) then iopsup = 1 !Function call fread(ide, '/Sources/Surface/Surface sources/'//trim(list(i))//& &'/A function/Function name', sval) pos = carsup%numero + 1 carsup%referencias(pos:pos+size(refs,1)-1) = int(refs) carsup%numero = carsup%numero + size(refs,1) carsup%valor(pos:pos+size(refs,1)-1) = 0.d0 fnum = function_number(sval,functions) if (fnum == 0) call error('readxml: unknown function: '//sval) sup%fun(pos:pos+size(refs,1)-1) = fnum carsup%constante(pos:pos+size(refs,1)-1) = .FALSE. else print * , 'Function surface source with 0 references: skipping' endif elseif (trim(list2(1)) == 'A constant') then !References call fread_alloc(ide, '/Sources/Surface/Surface sources/'//trim(list(i))//& &'/A constant/Surface references', refs, realloc=.true.) if (size(refs,1)>0) then iopsup = 1 !Constant value call fread(ide, '/Sources/Surface/Surface sources/'//trim(list(i))//& &'/A constant/Constant value', cval) pos = carsup%numero + 1 carsup%referencias(pos:pos+size(refs,1)-1) = int(refs) carsup%numero = carsup%numero + size(refs,1) carsup%valor(pos:pos+size(refs,1)-1) = cval carsup%constante(pos:pos+size(refs,1)-1) = .TRUE. else print * , 'Constant surface source with 0 references: skipping' endif else call error('readxml: Incorrect surface source child: '//trim(list2(1))//'.') endif enddo print*,'Line sources' !Curvilinear sources iopcur = 0 ! 1 => hai line sources carcur%numero = 0 call flist(ide, '/Sources/Line/Line sources', list) do i = 1, size(list,1) !loop for defined curvilinear sources call flist(ide, '/Sources/Line/Line sources/'//trim(list(i)), list2) if (size(list2,1)/=1) call error('readxml: Incorrect number of childs in line source.') if (trim(list2(1)) == 'A function') then !References call fread_alloc(ide, '/Sources/Line/Line sources/'//trim(list(i))//& &'/A function/Line references', refs, realloc=.true.) if (size(refs,1)>0) then iopcur = 1 !Function call fread(ide, '/Sources/Line/Line sources/'//trim(list(i))//& &'/A function/Function name', sval) pos = carcur%numero + 1 carcur%referencias(pos:pos+size(refs,1)-1) = int(refs) carcur%numero = carcur%numero + size(refs,1) carcur%valor(pos:pos+size(refs,1)-1) = 0.d0 fnum = function_number(sval,functions) if (fnum == 0) call error('readxml: unknown function: '//sval) cur%fun(pos:pos+size(refs,1)-1) = fnum carcur%constante(pos:pos+size(refs,1)-1) = .FALSE. else print * , 'Function line source with 0 references: skipping' endif elseif (trim(list2(1)) == 'A constant') then !References call fread_alloc(ide, '/Sources/Line/Line sources/'//trim(list(i))//& &'/A constant/Line references', refs, realloc=.true.) if (size(refs,1)>0) then iopcur = 1 !Constant value call fread(ide, '/Sources/Line/Line sources/'//trim(list(i))//& &'/A constant/Constant value', cval) pos = carcur%numero + 1 carcur%referencias(pos:pos+size(refs,1)-1) = int(refs) carcur%numero = carcur%numero + size(refs,1) carcur%valor(pos:pos+size(refs,1)-1) = cval carcur%constante(pos:pos+size(refs,1)-1) = .TRUE. else print * , 'Constant line source with 0 references: skipping' endif else call error('readxml: Incorrect surface source child: '//trim(list2(1))//'.') endif enddo print*,'Point sources' !Point sources ioppun = 0 ncarpun = 0 call flist(ide, '/Sources/Point/Point sources', list) if (size(list,1) > 0) ioppun = 1 do i = 1, size(list,1) !loop for defined point sources pos = ncarpun + 1 call fread_alloc(ide, '/Sources/Point/Point sources/'//trim(list(i))//'/X coordinates',xcp, realloc=.true.) xcarpun(pos:pos+size(xcp,1)-1) = xcp call fread_alloc(ide, '/Sources/Point/Point sources/'//trim(list(i))//'/Y coordinates',xcp, realloc=.true.) ycarpun(pos:pos+size(xcp,1)-1) = xcp call fread_alloc(ide, '/Sources/Point/Point sources/'//trim(list(i))//'/Z coordinates',xcp, realloc=.true.) zcarpun(pos:pos+size(xcp,1)-1) = xcp call fread_alloc(ide, '/Sources/Point/Point sources/'//trim(list(i))//'/Values',xcp, realloc=.true.) !val !para face ser se da un �nica valor na fonte para varios puntos ! alg�n outro sitio onde sexa necesario ? ! if (size(val,1) == 1) then extendemos val � lonxitude de xcp carpun(pos:pos+size(xcp,1)-1) = xcp ncarpun = ncarpun + size(xcp,1) enddo print*,'Materials database' !Open materials database call fread(ide, '/Materials file/Open/materialsDB', matxml) im = fopen(matxml) print*,'Magnitudes' !Magnitudes call flist(ide, '/Properties/Materials/Materials', list) permirel%numero = size(list,1) do i = 1, size(list,1) permirel%referencias(i) = int(list(i)) call fread(ide, '/Properties/Materials/Materials/'//trim(list(i)), sval) call flist(im, '/Materials database/Open/Materials/'//trim(sval)//'/Relative permittivity', list2) if (size(list2,1)==0) call error('readxml: missing relative permittivity type for material') select case(trim(list2(1))) case('A constant') call flist(im,'/Materials database/Open/Materials/'//trim(sval)//'/Relative permittivity/A constant', list3) if (size(list3,1)==0) call error('readxml: missing constant relative permittivity type for material') select case(trim(list3(1))) case('Isotropic') call fread(im, '/Materials database/Open/Materials/'//trim(sval)//'/Relative permittivity/A constant/Isotropic',& permirel%valorx(i)) permirel%valory(i) = permirel%valorx(i) permirel%valorz(i) = permirel%valorx(i) case('Orthotropic') call fread(im, '/Materials database/Open/Materials/' & //trim(sval)//'/Relative permittivity/A constant/Orthotropic/X Value',& permirel%valorx(i)) call fread(im, '/Materials database/Open/Materials/' & //trim(sval)//'/Relative permittivity/A constant/Orthotropic/Y Value',& permirel%valory(i)) call fread(im, '/Materials database/Open/Materials/' & //trim(sval)//'/Relative permittivity/A constant/Orthotropic/Z Value',& permirel%valorz(i)) case default; call error('readxml: Case not implemented.') end select permirel%iopermir(i) = 2 case('A temperature dependant table') call flist(im,'/Materials database/Open/Materials/' & //trim(sval)//'/Relative permittivity/A temperature dependant table', list3) if (size(list3,1)==0) call error('readxml: missing temperature dependant relative permittivity type for material') select case(trim(list3(1))) case('Isotropic') !utilizamos unha variable auxiliar (aux) allocatable para saber o n� de elementos call fread_alloc(im, '/Materials database/Open/Materials/' & //trim(sval)//'/Relative permittivity/A temperature dependant table/Isotropic/Temperatures', aux, realloc=.true.) call fread(im, '/Materials database/Open/Materials/' & //trim(sval)//'/Relative permittivity/A temperature dependant table/Isotropic/Values', permirel%valtabx(i,:)) permirel%ntab(i) = size(aux,1) permirel%teta(i,1:permirel%ntab(i)) = aux permirel%valtaby(i,1:permirel%ntab(i)) = permirel%valtabx(i,1:permirel%ntab(i)) permirel%valtabz(i,1:permirel%ntab(i)) = permirel%valtabx(i,1:permirel%ntab(i)) case('Orthotropic') call fread_alloc(im, '/Materials database/Open/Materials/'& &//trim(sval)//'/Relative permittivity/A temperature dependant table/Orthotropic/Temperatures', aux, realloc=.true.) call fread(im, '/Materials database/Open/Materials/'& &//trim(sval)//'/Relative permittivity/A temperature dependant table/Orthotropic/X values', permirel%valtabx(i,:)) call fread(im, '/Materials database/Open/Materials/'& &//trim(sval)//'/Relative permittivity/A temperature dependant table/Orthotropic/Y values', permirel%valtaby(i,:)) call fread(im, '/Materials database/Open/Materials/'& &//trim(sval)//'/Relative permittivity/A temperature dependant table/Orthotropic/Z values', permirel%valtabz(i,:)) permirel%ntab(i) = size(aux,1) permirel%teta(1,1:permirel%ntab(i)) = aux case default; call error('readxml: Case not implemented.') end select permirel%iopermir(i) = 3 iopteta = 1 case ('A function') !call fread(im, '/Materials database/Open/Materials/'//trim(sval)//& ! &'/Relative permittivity/'//trim(list2(1)), tval) !fnum = function_number(tval, functions_perm) !if (fnum == 0) call error('readxml: unknown function: '//tval) !permirel%fun(i) = fnum permirel%etiqueta(i) = trim(sval) permirel%iopermir(i) = 1 case default; call error('readxml: Case not implemented.') end select enddo !Se iopermir = 3 hai q ler un ficheiro de temperaturas fichteta if (iopteta == 1) then print*,'Temperature field' call fread(ide, '/Data/Temperature field for materials/Field', fichteta) endif call fclose(im) call fclose(ide) !Results (missing) fichsol = 'fichpot' fichgradsol = 'fichgradpot' !Quadrature options (missing) iop = 2 iopf = 1 !Another data (missing) iopej = 0 !fichvexac: usado solo si iopej != 0 ! todos os exemplos estan asi ! van fixas iopsl = 0 epscg = 1.d-50 nitcg = 1000 ! ncaras nodc1 nodc2 nodc3 naristas nod1 nod2 ! alojamiento de variables allocate(ncaras(carsup%numero),stat=ierror) if (ierror.ne.0) then print*,'error: no se ha podido reservar memoria para ncaras' stop 1 endif allocate(nodc1(carsup%numero,ndcaras),& nodc2(carsup%numero,ndcaras),& nodc3(carsup%numero,ndcaras),stat=ierror) if (ierror.ne.0) then print*,'error: no se ha podido reservar memoria para nodc1,2 o 3' stop 1 endif allocate(naristas(carcur%numero),stat=ierror) if (ierror.ne.0) then print*,'error: no se ha podido reservar memoria para naristas' stop 1 endif allocate(nod1(carcur%numero,ndar),& nod2(carcur%numero,ndar),stat=ierror) if (ierror.ne.0) then print*,'error: no se ha podido reservar memoria para nod1 o nod2' stop 1 endif end subroutine and this is the arrays.f90 file content: subroutine ForCall (VBArray) ! Set the attributes needed for compatibility with VB.NET. VB always uses STDCALL. ! !dec$ attributes dllexport, stdcall, reference, alias : "ForCall" :: ForCall use ifcom ! Declare SafeArray and BSTR interfaces implicit none integer(int_ptr_kind()), intent(inout) :: VBArray !Pointer to a SafeArray structure integer, parameter :: LONG_ENOUGH_BUFFER = 2048 ! Assume we won't get a string longer than this character(LEN=LONG_ENOUGH_BUFFER) mystring ! Fortran string converted to/from BSTR integer(int_ptr_kind()) :: BSTRptr ! Receives a pointer to a BSTR ! Array in which we will keep track of array bounds type bounds_type integer lb ! Lower Bound integer ub ! Upper Bound end type bounds_type integer nbounds ! Number of bounds type(bounds_type), allocatable :: bounds(:) integer, allocatable :: indexes(:) ! Array to hold current element indexes integer :: i, iRes, length ! First, we'll get the bounds of the array. This code makes no assumptions about the number of ! dimensions. ! nbounds = SafeArrayGetDim (VBArray) allocate (bounds(nbounds), indexes(nbounds)) do i=1,nbounds ires = SafeArrayGetLbound (VBArray, i, bounds(i)%lb) ires = SafeArrayGetUbound (VBArray, i, bounds(i)%ub) end do ! Example 1 - write to a text file (since we don't have a console) the ! bounds of the array. You'll find this file in the BIN subfolder of ! the VB.NET project folder. open (2, file="testout.txt", status="unknown") write (2, *) "Shape of the array passed by VB:" write (2,'(" (")',advance='no') do i=1,nbounds write (2,'(I0,":",I0)',advance='no') bounds(i) if (i < nbounds) write(2,'(",")',advance='no') end do write (2,'(")")') ! Example 2 - Write the values of the string elements to the file. This code ! also makes no assumptions about the number of dimensions. ! ! For each element we: ! 1) Call SafeArrayGetElement to return a pointer to a BSTR element ! 2) Convert the BSTR to a Fortran string (which we then write to the file) ! 3) Free the string which we retrieved ! ! Note that the current interface to SafeArrayGetElement has the second "indices" ! argument defined as a scalar - we work around that by passing the first element ! by reference. ! write (2, *) "Strings from the array:" indexes = bounds%lb ! Initialize to all lower bounds readloop: do ires = SafeArrayGetElement (VBArray, indexes(1), loc(BSTRPtr)) length = ConvertBSTRToString (BSTRPtr, mystring) call SysFreeString(BSTRPtr) write (2, '(" A(")', advance='no') write (2, '(100(I0,:,","))', advance='no') (indexes(i),i=1,nbounds) write (2, '(") = ", A)') mystring(1:length) ! Determine what the next element is. We increment the last index, ! and if it is greater than the upper bound, reset it to the lower bound and ! repeat for the next lower index. If we run out of indexes, we're done. do i = nbounds, 1, -1 indexes(i) = indexes(i) + 1 if (indexes(i) <= bounds(i)%ub) exit indexes(i) = bounds(i)%lb if (i == 1) exit readloop end do end do readloop close (2) ! We're done with the file ! Example 3 - Modifying BSTR elements in a SafeArray. Here we append ! " potato" to each of the elements. ! indexes = bounds%lb ! Initialize to all lower bounds writeloop: do ires = SafeArrayGetElement (VBArray, indexes(1), loc(BSTRPtr)) length = ConvertBSTRToString (BSTRPtr, mystring) call SysFreeString (BSTRPtr) ! Append "potato" to the element mystring = trim(mystring) // " potato" ! Convert it back to a BSTR BSTRptr = ConvertStringToBSTR (trim(mystring)) ! Write it back to the array ires = SafeArrayPutElement (VBArray, indexes(1), BSTRptr) call SysFreeString (BSTRPtr) ! Free our copy ! Determine what the next element is. We increment the last index, ! and if it is greater than the upper bound, reset it to the lower bound and ! repeat for the next lower index. If we run out of indexes, we're done. do i = nbounds, 1, -1 indexes(i) = indexes(i) + 1 if (indexes(i) <= bounds(i)%ub) exit indexes(i) = bounds(i)%lb if (i == 1) exit writeloop end do end do writeloop ! Deallocate our local arrays, though this would be done implicitly anyway ! deallocate (bounds) deallocate (indexes) return end subroutine ForCall what should I do to get an output result?

Why don't you test with a

gib — Sat, 12 Aug 2017 22:42:42 GMT

Why don't you test with a very small piece of Fortran code? Why not try the VB-Fortran sample code as Steve has suggested?