REAL (KIND= )

REAL (KIND= )

In a calculation procedure I usually apply REAL*8  in math operation. However sometimes accuracy/round off errors affect the results. Then I discovered that with IVF REAL*16 is accepted.  This brings accuracy to a new level, but the downside  is of course that computation time is tripled, at least!

What I wander is, if it is possible to set the KIND=8 or 16 at the time of computation, as a part of the input data?   

I made  test with REAL (KIND=NOTSET) retset

error #6683: A kind type parameter must be a compile-time constant. [NOTSET]

I think this indicates that the KIND parameter must be set to 4, 8 or 16 before compilation. Or is there a way around?

Regards

 

34 posts / 0 new
Last post
For more complete information about compiler optimizations, see our Optimization Notice.

No, this is a compile-time constant, not something you can change on the fly.

However, it is possible to provide alternative implementations from the same code, with merely a different kind, and select the one you want via a SELECT CASE or the like. It is a trifle involved though.

 

Thank you for your response Markus Arjen. However, I du not understand how a SELECT CASE can solve it without having two different versions of most variables and routines. One set with 8 bytes and one with 16 bytes variables. 

Something along these lines:

real(8) ::x , y
select case (prec)
     case(8)
           x = f(y)
     case(16)
           x = f( real(y,kind=16))
end select

where f is an interface to the two underlying implementations

 

To create two different versions of subprograms you need some form of template capability in the language. Fortran doesn't have an explicit capability, but it can be faked to a certain extent via modules. Subprograms that require the two forms are modified so that the KIND is given by a named constant that will be acquired via host association and then they are place in INCLUDE files. Modules are written which just set the named constant to the appropriate value and include the files from the previous sentence. Then you just need a root subprogram which your main program can invoke that starts working with the right KINDs. Let's see... do I have time to compose a simple example?

Suppose your program looked something like this:

! hello1.f90
program hello1
   use ISO_FORTRAN_ENV, only: dp => REAL64
   implicit none
   real(dp) pi
   pi = 4*atan(1.0_dp)
   write(*,*) 'Hello, world: pi = ',pi
end program hello1

First we put the good stuff in an INCLUDE file
 

! hello2.i90
subroutine hello
   real(wp) pi
   pi = 4*atan(1.0_wp)
   write(*,*) 'Hello, world: pi = ',pi
end subroutine hello

Note that we have changed the name of the kind type parameter (not really necessary) and used the name consistently throughout. This is our template version of the program.

Then we have to tell the compiler to make a version for each KIND we want and then create a module that renames the root subprogram[s] and then our program can decide which one to invoke.

! hello3.f90
module M8
   use ISO_FORTRAN_ENV, only: wp => REAL64
   implicit none
   contains
include 'hello2.i90'
end module M8

module M16
   use ISO_FORTRAN_ENV, only: wp => REAL128
   implicit none
   contains
include 'hello2.i90'
end module M16

module M
   use M8, only: hello8 => hello
   use M16, only: hello16 => hello
   implicit none
end module M

program P
   use M
   implicit none
   integer choice
   write(*,'(a)',advance='no') 'Enter 2 for quad precision:> '
   read(*,*) choice
   if(choice == 2) then
      call hello16
   else
      call hello8
   end if
end program P

Of course there are many possible variations of this technique but hopefully this can get you started in the right direction.

 

Thank you for response, Repeat Offender. I  think you want to give a hint about how to set default real variables to either 4, 8 or 16 bytes?  As I am not familiar to the module ISO_Fortran, I just added a use statement to a random file as shown below. 

    USE ISO_FORTRAN_ENV  , only: wp -> REAL64

I received the following response:    
    C:\CALC\CaFeMS\Main_elast6b.f90(68): error #5082: Syntax error, found '-' when expecting one of: ( , <END-OF-STATEMENT> ; (/ =>
compilation aborted for C:\CALC\CaFeMS\Main_elast6b.f90 (code 1)
compilation aborted for C:\CALC\CaFeMS\Main_elast6b.f90 (code 1)

Hope you can give me some more clues.

 

It is a simple syntax error:

only: wp -> REAL64

shoudl be:

only: wp => REAL64

 

 

Repeat Offender: I understand you try to show how to extract a global parameter wp (module M8 and M16) that can be contained by another module (?) that then again is assigned in the actual subroutines. Right ?

The assignment of this global parameter takes place in hello8/hello16 subroutines.  But I do not understand the link between the (undefined) hello, hello8 and hello16 routines.. or are these "routines" just symbol variables that invoke different parts in the M module ?

OK reidar, let's try reasoning this out step by step.  First, after the INCLUDEs are processed by the compiler, it's going to be working on something like this:

! hello3.f90
module M8
   use ISO_FORTRAN_ENV, only: wp => REAL64
   implicit none
   contains
!include 'hello2.i90'
! hello2.i90
subroutine hello
   real(wp) pi
   pi = 4*atan(1.0_wp)
   write(*,*) 'Hello, world: pi = ',pi
end subroutine hello
end module M8

module M16
   use ISO_FORTRAN_ENV, only: wp => REAL128
   implicit none
   contains
!include 'hello2.i90'
! hello2.i90
subroutine hello
   real(wp) pi
   pi = 4*atan(1.0_wp)
   write(*,*) 'Hello, world: pi = ',pi
end subroutine hello
end module M16

module M
   use M8, only: hello8 => hello
   use M16, only: hello16 => hello
   implicit none
end module M

program P
   use M
   implicit none
   integer choice
   write(*,'(a)',advance='no') 'Enter 2 for quad precision:> '
   read(*,*) choice
   if(choice == 2) then
      call hello16
   else
      call hello8
   end if
end program P

Notice that the INCLUDEs have been replaced by copies of the file that was named in the INCLUDE statements. Thus both module M8 and M16 will posses a module procedure called SUBROUTINE HELLO. There isn't really a problem of ambiguity, however, because the compiler will mangle their names to something like M8_mp_HELLO and M16_mp_HELLO. They must have the same name as seen by Fortran within their modules, however, because they were sourced from the same INCLUDE file. If they are going to be visible and used in the same scope (here PROGRAM P) one or both must be renamed. That is the job of MODULE M: it provides names visible to any program units that USE it, HELLO8 for the double precision version that was compiled in MODULE M8 and HELLO16 for the quad precision version from MODULE M16. Both of these modules had a procedure that had the same name (WP) for the REAL KIND we wanted for that procedure, but the named constant picked up its value via host association from its module and was REAL64 [=8] from the specification part of M8 and REAL128 [=16] from the specification part of M16.

So now if we USE M, we have two different names accessible to us: HELLO8 which really means the SUBROUTINE HELLO that was compiled in MODULE M8 where wp had the value 8, and HELLO16 which refers to the SUBROUTINE HELLO that was compiled in MODULE M16 where wp had the value 16. You might be thinking that something more profound is going on here, like C++ templates, but if you think about it carefully you can see how we end up with two different subroutines, HELLO8 and HELLO16, visible in PROGRAM P which were created from the same source code, but associated with different hosts.

 

For function and subroutines, you can also declare a generic interface, say

interface f
  function f4(x) result(y)
    real(4), intent(in) :: x
    real(4) :: y
  end function f4
  function f8(x) result(y)
    real(8), intent(in) :: x
    real(8) :: y
  end function f8
  function f16(x) result(y)
    real(16), intent(in) :: x
    real(16) :: y
  end function f16
end interface

You will need to write the appropriate routines (possibly using the INCLUDE to insert common code).

Generic interface is an exposed means to perform function overloading such as in C/C++/C#.

Jim Dempsey

Thanks for comments Jimdempsey, I will study.

But further to advise from Repeat Offender: I copied and compiled/run your first #5 post. Post #9 is similar but now the hello routine is fully written in the module. I think I understand how it works. But how do I transfer the parameter "wp" to all the other subroutines to declare variables as REAL*8 or REAL *16, so that I can declare the actual  variables with  REAL (KIND=wp) ?  Suppose the "hello" subroutine is number- crunching program that calls other functions and subroutines in which the selected variables are to be declared as 8 or 16 bytes variables.   Is that possible or do I have to arrange assignment of the M8 alternatively M16 module in each subroutine?

 

Repeat Offender's suggestion showed you how to create a facsimile of  a template for use as an INCLUDE file used in a CONTAINS section of a MODULE qualified by a USE ISO_FORTRAN_ENV, only: wp=>...yourDesiredPrecisionHere...

If you want to globally specify a precision, then one of the many ways to do this would be to

a) choose what you want for an identifier, I will choose "wp", you can choose what you want
b) write a module file, perhaps you can call it defaults.f90, and in there have in the data (pre-contains) section
      USE ISO_FORTRAN_ENV, only: wp=>...yourDesiredPrecisionHere...
c) then add "USE defaults" to the subroutines and functions.
d) I assume you understand by now that the module file will have to be compiled and be a dependency of your program.

Note, you likely have a common module that you already USE. You can insert the "USE defaults" inside that if you wish, or simply insert  USE ISO_FORTRAN_ENV, only: wp=>...yourDesiredPrecisionHere...

Jim Dempsey

I tried to make an example that does what you want, but encountered problems possibly due to compiler bugs. Here is what I did: start out with a program that does a little calculation:

subroutine cubic(a,b,c,d,x,n)
   implicit none
   real a,b,c,d
   real x(*)
   integer n
! Solves a*x**3+b*x**2+c*x+d = 0
! Assumes a /= 0
! x(1:n) are the n real solutions, sorted ascending
   real p, q, offset
   real r
   real, parameter :: pi = 4*atan(1.0)

   offset = b/(3*a)
   p = c/a-b**2/(3*a**2)
   q = 2*b**3/(27*a**3)-b*c/(3*a**2)+d/a
   if(p > 0) then
      r = sqrt(4*p/3)
      n = 1
      x(1:n) = r*sinh(asinh(-4*q/r**3)/3)-offset
   else if(p == 0) then
      n = 1
      x(1:n) = -q**(1.0/3)-offset
   else ! p < 0
      r = sign(sqrt(-4*p/3),-q)
      if(q == 0) then
         n = 3
         x(1:n) = [-sqrt(-p),0.0,sqrt(-p)]-offset
      else if(abs(4*q) < abs(r**3)) then
         n = 3
         x(1:n) = r*cos(acos(-4*q/r**3)/3+[2*pi/3,-2*pi/3,0.0])-offset
         if(r < 0) x(1:n) = x(n:1:-1)
      else if(abs(4*q) == abs(r**3)) then
         n = 2
         x(1:n) = r*[-0.5,1.0]-offset
         if(r < 0) x(1:n) = x(n:1:-1)
      else ! abs(4*q) > abs(r**3)
         n = 1
         x(1:n) = r*cosh(acosh(-4*q/r**3)/3)-offset
      end if 
   end if
end subroutine cubic

module vdw
   implicit none
   type params
      character(:), allocatable :: Name
      real a ! kPa**L**2/mol**2
      real b ! L/mol
   end type params
   contains
      function v(P,T,ab)
         real P, T
         type(params) ab
         real, parameter :: R = 8.3144598 ! kPa*L/(K*mol)
         real v
         real x(3)
         integer n
         call cubic(P,-(ab%b*P+R*T),ab%a,-ab%a*ab%b,x,n)
         v = x(n)
      end function v
end module vdw

program vdw1
   use vdw
   implicit none
   real P
   real T
   type(params) ab
   real molar_volume

   write(*,'(a)',advance='no') 'Enter P(kPA) :> '
   read(*,*) P
   write(*,'(a)',advance='no') 'Enter T(K) :> '
   read(*,*) T
   ab = params('Xe',425.0,0.05105)
   molar_volume = v(P,T,ab)
   write(*,*) ab%name,molar_volume,P,8.3144598*T/ &
      (molar_volume-ab%b)-ab%a/molar_volume**2
end program vdw1

I don't know if I'm doing the right thing here: when van der Waals' equation spits out multiple roots for the molar volume are you supposed to take the maximum root? Doesn't really matter as this is just an example. So if you compile the above and enter a reasonable pressure and temperature at the prompts, it seems to yield at least a consistent molar volume for xenon. Again, the first step is to convert all REAL KINDs to a named constant. If all REAL literals have a decimal point it's much easier to search them out and append the _wp in each case.

module default
   use ISO_FORTRAN_ENV, only: wp => REAL64
end module default

subroutine cubic(a,b,c,d,x,n)
   use default
   implicit none
   real(wp) a,b,c,d
   real(wp) x(*)
   integer n
! Solves a*x**3+b*x**2+c*x+d = 0
! Assumes a /= 0
! x(1:n) are the n real solutions, sorted ascending
   real(wp) p, q, offset
   real(wp) r
   real(wp), parameter :: pi = 4*atan(1.0_wp)

   offset = b/(3*a)
   p = c/a-b**2/(3*a**2)
   q = 2*b**3/(27*a**3)-b*c/(3*a**2)+d/a
   if(p > 0) then
      r = sqrt(4*p/3)
      n = 1
      x(1:n) = r*sinh(asinh(-4*q/r**3)/3)-offset
   else if(p == 0) then
      n = 1
      x(1:n) = -q**(1.0_wp/3)-offset
   else ! p < 0
      r = sign(sqrt(-4*p/3),-q)
      if(q == 0) then
         n = 3
         x(1:n) = [-sqrt(-p),0.0_wp,sqrt(-p)]-offset
      else if(abs(4*q) < abs(r**3)) then
         n = 3
         x(1:n) = r*cos(acos(-4*q/r**3)/3+[2*pi/3,-2*pi/3,0.0_wp])-offset
         if(r < 0) x(1:n) = x(n:1:-1)
      else if(abs(4*q) == abs(r**3)) then
         n = 2
         x(1:n) = r*[-0.5_wp,1.0_wp]-offset
         if(r < 0) x(1:n) = x(n:1:-1)
      else ! abs(4*q) > abs(r**3)
         n = 1
         x(1:n) = r*cosh(acosh(-4*q/r**3)/3)-offset
      end if 
   end if
end subroutine cubic

module vdw
   use default
   implicit none
   type params
      character(:), allocatable :: Name
      real(wp) a ! kPa**L**2/mol**2
      real(wp) b ! L/mol
   end type params
   contains
      function v(P,T,ab)
         real(wp) P, T
         type(params) ab
         real(wp), parameter :: R = 8.3144598_wp ! kPa*L/(K*mol)
         real(wp) v
         real(wp) x(3)
         integer n
         call cubic(P,-(ab%b*P+R*T),ab%a,-ab%a*ab%b,x,n)
         v = x(n)
      end function v
end module vdw

program vdw2
   use default
   use vdw
   implicit none
   real(wp) P
   real(wp) T
   type(params) ab
   real(wp) molar_volume

   write(*,'(a)',advance='no') 'Enter P(kPA) :> '
   read(*,*) P
   write(*,'(a)',advance='no') 'Enter T(K) :> '
   read(*,*) T
   ab = params('Xe',425.0_wp,0.05105_wp)
   molar_volume = v(P,T,ab)
   write(*,*) ab%name,molar_volume,P,8.3144598_wp*T/ &
      (molar_volume-ab%b)-ab%a/molar_volume**2
end program vdw2

The problem with this approach is that you have to recompile everything to convert to another KIND, although the only change that need be made is in the second line where the wp is determined and then propagated throughout the program. So I wanted to make an example that doesn't duplicate code but doesn't require all the calculational stuff to be in an INCLUDE file. The idea is that I can write out a file default8.f90 that has that module default in it that sets wp => REAL64. After compiling this we can compile calc.f90 to calc8.dll. Since it USEes the module default that we just compiled, its module vdw will have its wp = REAL64 and its type(params) will have REAL(REAL64) components and so on. Then we compile types8.f90 which gives us a module types8 which is really an alias for the module vdw with wp =" REAL64 inside.

OK, then we repeat the procedure, compiling default16.f90 so now we will have a module default with wp => REAL128. Now when we compile calc.f90 to calc16.dll we get a module vdw with wp=> REAL128 inside. Then when we compile types16.f90 we get a module types16 that is an alias for the most recent modulw vdw we compiled, with wp => REAL128 internally. Thus our only type-specific code to this point was in the 4 files default8.f90, types8.f90, default16.f90, and types16.f90, 3 lines each. This is good from the standpoint of code maintenance.

Now our main program is written to use module types8, and we use LoadLibrary and GetProcAddress to get a pointer to the entry point of calc8.dll. When the user responds to the prompt saying that he wants to do the quad precision calculation, the BLOCK construct is entered that gets type info from module types16 and now gets a pointer to the entry point of calc16.dll so now it can just do the computational stuff that was compiled in quad precision. A little more boilerplate in the main program and we need those 4 extra little files, but the part about cahnging the big computational part to INCLUDE files is gone because there are no INCLUDE file any more.

Unfortunately both gfortran and ifort die on this example. When gfortran is invoked via the batch file gf_vdw.bat, the first and only error I get is

vdw3.f90:63: confused by earlier errors, bailing out

and when ifort is invoked via make_vdw3.bat, the error parade starts with

vdw3.f90(41): error #6405: The same named entity from different modules and/or p
rogram units cannot be referenced.   [WP]
   real(wp) P
--------^

Here is a *.zip file with the failing example:

 

Attachments: 

AttachmentSize
Downloadapplication/zip vdw3.zip2.85 KB

Try commenting out line 70 in program (use default is used in vdw)

This shouldn't have been an error unless the date and time on the .mod file used to build the library differed from the date and time used to build the program.

Jim Dempsey

I'm not sure what you mean about line 70. Line 70 of vdw3.f90 is the first half of a WRITE statement program vdw2 is exactly 70 lines long so this would be the end line.

I think what's happening is that ifort doesn't build a *.mod file containing full info about all symbols but rather it only provides references for symbols it acquires via USE association. And you can't have two different *.mod files with the same name in the visible INCLUDE directories. I tried changing make_vdw3.bat to

ifort /nologo /c default8.f90
IF EXIST sd8\NUL GOTO HAVEsd8
mkdir sd8
:HAVEsd8
move default.mod sd8
ifort /nologo /dll /Isd8 calc.f90 /exe:calc8
move vdw.mod sd8
ifort /nologo /c /Isd8 types8.f90
move types8.mod sd8
ifort /nologo /c default16.f90
IF EXIST sd16\NUL GOTO HAVEsd16
mkdir sd16
:HAVEsd16
move default.mod sd16
ifort /nologo /dll /Isd16 calc.f90 /exe:calc16
move vdw.mod sd16
ifort /nologo /c /Isd16 types16.f90
move types16.mod sd16
ifort /nologo /Isd8 /Isd16 vdw3.f90

And now ifort dies at

vdw3.f90(77): error #6405: The same named entity from different modules and/or p
rogram units cannot be referenced.   [BLOCK_WP]
         real(BLOCK_wp) BLOCK_P
--------------^

Because the first default.mod file in its search path is sd8\default.mod so it was OK when the wp from that module file was required but now when it needs the wp from sd16\default.mod it finds the wrong one because the right one is later in the include search path even though the module that is in the chain leading to it is in sd16. So I can't see a workaround for this issue.

 

>>I'm not sure what you mean about line 70. Line 70 of vdw3.f90

Perhaps I should have made this a bit more clear:

In your post #13, you have two code examples, in the second code example, you have several program units, listed in a single paste. In this second example, on line 70 (which is not necessarily the 70'th line of the program, but is likely unknown as to which line it is), you have what may be a potential incorrect USE (if the module used differs in date/time from the same named module used in the used module named vdw).

Remove/comment the "use default" from "program vdw2"

Jim Dempsey

Oh, that example. No, that's not an incorrect USE because in that case there was only one instance of module default, right there at the top of the file vdw2.f90. That example compiles and runs OK, but requires recompilation to change the REAL KIND. The one the doesn't work is in the vdw3.zip attachment to the post. That one generates two versions of default.mod and there is no way of telling ifort which one to use if both are necessary for a single invocation of the compiler, either directly or chained through USE in other modules. One could write an independent module for use with the final program, but this would be like what you have to do in C where you maintain separate *.c and *.h files, but with the disadvantage that you couldn't confirm the consistency of the *.h files with the *.c files because of the generic nature of the *.c (actually *.f90) files in this case. An extra maintenance headache on top of the already somewhat more complicated build sequence.

Perhaps you could have tried compiling my example so that you better understood what you were commenting on.

 

The problem may be with the "association" wp => ...

Instead of using the "association", for each compilation unit (type) use an INTEGER, PARAMETER :: wp=...

In this manner, wp should be static to the compilation unit (together with the modules it uses in the compilation).

Jim Dempsey

Quote:

Repeat Offender wrote:

That one generates two versions of default.mod and there is no way of telling ifort which one to use if both are necessary for a single invocation of the compiler, either directly or chained through USE in other modules. 

Maybe you know this, but the language disallows having more than one program unit (a module is a program unit) of the same name in a program. (F2008 16.2). Note that an intrinsic module isn't a program unit, so it's ok to have your own module with the same name as an intrinsic module. I would argue that compiling the same source more than once in a build constitutes a duplication as far as this is concerned.

Steve (aka "Doctor Fortran") - Retired from Intel

@jimdempseyatthecove, the problem is that the object of the exercise is to reuse the same file to compile a different function, so the rules of the game dictate that every statement be the same.

@Steve Lionel (Ret.), of course you know that only makes my determination greater! I did get something to work in vdw4.zip, attached below. To build vdw4.exe, just run make_vdw4.bat. Some notes:

I had a bug where I computed the cube root as

x(1:n) = -q**(1.0_wp/3)-offset

When I should have written

x(1:n) = sign(abs(q)**(1.0_wp/3),-q)-offset

but the surprising thing was that ifort interpreted my original code as a request to compute the cube root, so my cubic equation solver didn't crash even when p == 0 and q < 0 :)

Also I forgot to NUL-terminate those strings passed to LoadLibrary and GetProcAddress.

I had the wrong variable P instead of BLOCK_P in my last write statement.

I fixed these issues and restructured as threatened in my last post so that new interfaces are written ab initio with the help of an INCLUDE file.

calc.f90 is still compiled twice in this build.

One might be able to claim that it's OK to have two program units with the same name in two different *.DLLs even if the final program is going to dynamically link to both of them. Has the latest standard gotten around to allowing non-BIND(C) UDTs as dummy arguments to BIND(C) procedures? That would make it easier to rename them without !DEC$ ATTRIBUTES ALIAS. The usage with these UDTs really is nonstandard, because the compiler could reorder their components. You can't have a SEQUENCE type with an allocatable component, can you?

 

Attachments: 

AttachmentSize
Downloadapplication/zip vdw4.zip2.73 KB
module default32
   use ISO_FORTRAN_ENV, only: REAL32
   integer, parameter :: wp = REAL32
end module default32
    
module default64
   use ISO_FORTRAN_ENV, only: REAL64
   integer, parameter :: wp = REAL64
end module default64
    
module default128
   use ISO_FORTRAN_ENV, only: REAL128
   integer, parameter :: wp = REAL128
end module default128

! ================== different source file ==========
module default
    use default64
end module default
    
! ================== different source file ==========
program wptest
    use default
    implicit none
    real(wp) :: x
    x = 123.4_wp
end program wptest

Try revising your code to use something like the above.

Jim Dempsey

Hmmm, thinking

The module default should use a module (ISO_FORTRAN_ENV) in a manner that only generates parameters. This also may require an optimization level to the point of removing dead code. IOW the resultant module containing NO data segment (variables) and NO code segment (contains). Parameters should not construct a variable to contain the literal, however, Debug build may do this, so you may need to experiment.

Jim Dempsey

Recall that what I am trying to do is to start from the technique recommended in Quote #12 but then upgrade it so that different data types are accessible to the same program without recompilation. The second example, vdw2.f90 from Quote #13 is the Quote #12 stage of conversion. But now I want to perform the upgrade from there without changing the calculational part of the code. This means the calculational part must be recompiled as is twice (to two different *.DLLs). I don't see the file in Quote #21 that can be compiled twice.

 

You will have two different codes, one using one type of real and the other using a different type of real. Thus requiring three compilations. (2 DLLs and 1 applicaton)

This said, if your application can be devoid of any/all expressions, including assignment (IOW all operations are performed by call, using opaque pointers for arguments), then the application itself can be compiled once, and have one or the other DLL's loaded. I suppose if you wanted to switch real types in the middle of an application, you could unload one DLL and load the different DLL, or create an abstract type (and live with all the overhead it introduces).

Jim Dempsey

Getting further:

! default8.f90
module default
  use ISO_FORTRAN_ENV, only: REAL64
  integer, parameter :: wp = REAL64
end module default
...
! default16.f90
module default
  use ISO_FORTRAN_ENV, only: REAL128
  integer, parameter :: wp = REAL128
end module default
...
! vdw3.f90
...
end program vdw2
! hack to remove unresolved symbol    
subroutine get_v
write(*,*) "this should not print"
end subroutine get_v

With the above change the program links, however, when run

C:\test\vdw3>vdw3
 GetProcAddress failed with error code          127

So there is a little issue with locating the entry point.

This may be a decoration issue. Adding:

function v(P,T,ab) BIND(C, NAME='v')

Corrects the GetProcAddress, but calling convention may be hosed??

C:\test\vdw3>vdw3
forrtl: severe (157): Program Exception - access violation
Image              PC                Routine            Line        Source

vdw3.exe           000000013F7A1E93  Unknown               Unknown  Unknown
vdw3.exe           000000013F7A10AD  Unknown               Unknown  Unknown
vdw3.exe           000000013F815A0E  Unknown               Unknown  Unknown
vdw3.exe           000000013F8162EC  Unknown               Unknown  Unknown
kernel32.dll       00000000772859CD  Unknown               Unknown  Unknown
ntdll.dll          00000000773BA561  Unknown               Unknown  Unknown

With a little more work, this might get resolved. (are you willing to look at this?)

Jim Dempsey

also tried

!DEC$ ATTRIBUTES DLLEXPORT,ALIAS:"DLL_V" :: v

and changed the name in the GetProcAddress.

The load library succeeds (at least no error reported) and GetProcAddress returns success. The function call fails.

I did not use the debugger to step into the function to see what is going on.

Jim Dempsey

Well, the compiler is hosed by the time it hits the declaration of procedure pointer get_v. How else do you explain the fact that the line

   call C_F_PROCPOINTER(proc,get_v)

causes the compiler to think that GET_V is an external symbol? Even with the invocations through get_v and the other usage of C_F_PROCPOINTER commented out, we still get the unresolved symbol GET_V. With the workaround as given in Quote #25, the access violation happens also on the line quoted above: the program, I would assume, passes the address of the entry point of subroutine GET_V and then C_F_PROCPOINTER figures that's the address of the descriptor of a Fortran procedure pointer and starts filling out the descriptor which overwrites READONLY memory of subroutine GET_V's machine code, causing an access violation.

So this is one of those times where the compiler has gone completely off the rails but by miracle hasn't hit a C0000005. I have attached vdw5.zip to ensure that we are talking about the same code here.

 

Attachments: 

AttachmentSize
Downloadapplication/zip vdw5.zip2.8 KB

Your mykernel32 is an attempt to work around a bug (MHO) inIVF kernel32 where GetProcAddress returns an LPVOID as opposed to a type C_FUNPTR. There is something strange about the return value.

I tried using kernel32, with a TRANSFER to attempt to cast the LPVOID into C_FUNPTR, this "looked ok" (values looked reasonable) however the call C_F_PROCPOINTER aborted. Not entirely sure why but it looks like it expects "proc" to be a reference to reference or some other s**t.
In using the disassembly window (MS VS 2013, IVF 17u4) things look strange too. I think there is an issue with the calling convention of something, since the store of the return value (rax) doesn't go into the named variable. I can alter the value (in proc) to an arbitrary number, step over the GetProcAddress and proc%ptr is unchanged.

The type(C_FUNPTR) has a protected member variable (ptr) that could accept the LPVOID, however I cannot get at it.

kernel32.f90 is in error with respect to LPVOID verses C_FUNPTR on GetProcAddress (and possibly others)
 

Jim Dempsey

 

I agree there is a compiler issue with get_v. It should have been entirely local to vdw (unless it is SAVE ???). It should not have generated a Link error regarding missing symbol (reason for my hack).

In viewing with the debugger:

000000013FB2124A mov qword ptr [PROC (013FC45770h)],rax

rbp=2ff3b0 and rsp=2ff380, therefore PROC appears to be located next to the code (i.e. static/SAVE).

can you take the example code (with Link error) (my code is bunged up now), and place the interior contents of program into a subroutine (not contained subroutine), then call the from program. Also make it recursive or add the openmp switch to force all locals to stack.

If this corrects the Linker issuer, then it may also resolve the C_F_POINTER issue (attempting to place the entry pointe into the first bytes of the subroutine of my hack).

Jim Dempsey

Quote:

Repeat Offender wrote:

Recall that what I am trying to do is to start from the technique recommended in Quote #12 but then upgrade it so that different data types are accessible to the same program without recompilation. ....

@Repeat Offender,

If your goal is to make "different data types are accessible to the same program without recompilation", then I think you're making it all needlessly complicated.

I would suggest using parameterized derrived types (PDTs) with KIND type parameters with GENERIC interfaces and a judicious use of INCLUDE files.  Here'a a working version of the attempt you are making with a Van der Waals' equation-of-state calculation for xenon:

module solve_cubic_eqn_m

   use, intrinsic :: iso_fortran_env, only : R4 => real32, R8 => real64, R16 => real128

   implicit none

   private

   type, public :: solve_cubic_eqn_t(wp)
      integer, kind, public :: wp = R8
      private
   contains
      private
      procedure, pass(this) :: solve_r4
      procedure, pass(this) :: solve_r8
      procedure, pass(this) :: solve_r16
      generic, public :: solve => solve_r4, solve_r8, solve_r16
   end type

contains

   subroutine solve_r4( this, a, b, c, d, x, n )

      ! Argument list
      class(solve_cubic_eqn_t(wp=R4)), intent(in) :: this

      include "cubic.f90"

   end subroutine solve_r4

   subroutine solve_r8( this, a, b, c, d, x, n )

      ! Argument list
      class(solve_cubic_eqn_t(wp=R8)), intent(in) :: this

      include "cubic.f90"

   end subroutine solve_r8

   subroutine solve_r16( this, a, b, c, d, x, n )

      ! Argument list
      class(solve_cubic_eqn_t(wp=R16)), intent(in) :: this

      include "cubic.f90"

   end subroutine solve_r16

end module solve_cubic_eqn_m
      ! cubic.f90 include file
      real(kind=this%wp), intent(in)    :: a
      real(kind=this%wp), intent(in)    :: b
      real(kind=this%wp), intent(in)    :: c
      real(kind=this%wp), intent(in)    :: d
      real(kind=this%wp), intent(inout) :: x(:)
      integer, intent(inout)            :: n

      ! Local variables
      real(kind=this%wp), parameter :: ZERO = real( 0.0, kind=kind(ZERO) )
      real(kind=this%wp), parameter :: HALF = real( 0.5, kind=kind(HALF) )
      real(kind=this%wp), parameter :: ONE = real( 1.0, kind=kind(ONE) )
      real(kind=this%wp), parameter :: TWO = real( 2.0, kind=kind(TWO) )
      real(kind=this%wp), parameter :: THREE = real( 3.0, kind=kind(THREE) )
      real(kind=this%wp), parameter :: FOUR = real( 4.0, kind=kind(FOUR) )
      real(kind=this%wp), parameter :: TWENTY_SEVEN = real( 27.0, kind=kind(TWENTY_SEVEN) )
      real(kind=this%wp), parameter :: PI = FOUR*atan(ONE)
      real(kind=this%wp) :: p
      real(kind=this%wp) :: q
      real(kind=this%wp) :: r
      real(kind=this%wp) :: offset

      offset = b/(THREE*a)
      p = c/a-b**TWO/(THREE*a**TWO)
      q = TWO*b**THREE/(TWENTY_SEVEN*a**THREE)-b*c/(THREE*a**TWO)+d/a
      if(p > ZERO) then
         r = sqrt(FOUR*p/THREE)
         n = 1
         x(1:n) = r*sinh(asinh(-FOUR*q/r**THREE)/THREE)-offset
      else if(p == ZERO) then
         n = 1
         x(1:n) = sign(abs(q)**(ONE/THREE),-q)-offset
      else ! p < ZERO
         r = sign(sqrt(-FOUR*p/THREE),-q)
         if(q == ZERO) then
            n = 3
            x(1:n) = [-sqrt(-p),ZERO,sqrt(-p)]-offset
         else if(abs(FOUR*q) < abs(r**THREE)) then
            n = 3
            x(1:n) = r*cos(acos(-FOUR*q/r**THREE)/THREE+[TWO*pi/THREE,-TWO*pi/THREE,ZERO])-offset
            if(r < ZERO) x(1:n) = x(n:1:-1)
         else if(abs(FOUR*q) == abs(r**THREE)) then
            n = 2
            x(1:n) = r*[-HALF, ONE]-offset
            if(r < ZERO) x(1:n) = x(n:1:-1)
         else ! abs(FOUR*q) > abs(r**THREE)
            n = 1
            x(1:n) = r*cosh(acosh(-FOUR*q/r**THREE)/THREE)-offset
         end if 
      end if
module vdw_m

   use, intrinsic :: iso_fortran_env, only : R4 => real32, R8 => real64, R16 => real128
   use solve_cubic_eqn_m, only : solve_cubic_eqn_t

   implicit none

   private

   type, public :: vdw_t(wp)
      private
      integer, kind, public :: wp = R8
      character(:), allocatable :: m_FluidName
      real(wp) :: m_a ! kPa**L**2/mol**2
      real(wp) :: m_b ! L/mol
      real(wp) :: m_R = real( 8.3144598, kind=wp ) ! Gas constant in kPa*L/(K*mol)
      type(solve_cubic_eqn_t(wp)) :: m_cubic_solver
   contains
      private
      procedure, pass(this) :: get_v_r4
      procedure, pass(this) :: get_v_r8
      procedure, pass(this) :: get_v_r16
      procedure, pass(this) :: get_R_r4
      procedure, pass(this) :: get_R_r8
      procedure, pass(this) :: get_R_r16
      procedure, pass(this) :: init_r4
      procedure, pass(this) :: init_r8
      procedure, pass(this) :: init_r16
      generic, public :: init => init_r4, init_r8, init_r16
      generic, public :: v => get_v_r4, get_v_r8, get_v_r16
      generic, public :: R => get_R_r4, get_R_r8, get_R_r16
   end type

contains

   subroutine init_r4( this, fluid, a, b )
   ! Initialize for a given fluid

      ! Argument list
      class(vdw_t(wp=R4)), intent(inout) :: this

      include "init.f90"

   end subroutine init_r4

   subroutine init_r8( this, fluid, a, b )
   ! Initialize for a given fluid

      ! Argument list
      class(vdw_t(wp=R8)), intent(inout) :: this

      include "init.f90"

   end subroutine init_r8

   subroutine init_r16( this, fluid, a, b )
   ! Initialize for a given fluid

      ! Argument list
      class(vdw_t(wp=R16)), intent(inout) :: this

      include "init.f90"

   end subroutine init_r16

   function get_v_r4(this, P, T) result(v)
   ! Compute volume

      ! Argument list
      class(vdw_t(wp=R4)), intent(in) :: this

      include "calc_v.f90"

   end function get_v_r4

   function get_v_r8(this, P, T) result(v)
   ! Compute volume

      ! Argument list
      class(vdw_t(wp=R8)), intent(in) :: this

      include "calc_v.f90"

   end function get_v_r8

   function get_v_r16(this, P, T) result(v)
   ! Compute volume

      ! Argument list
      class(vdw_t(wp=R16)), intent(in) :: this

      include "calc_v.f90"

   end function get_v_r16

   function get_R_r4(this) result(R)
   ! Return universal gas constant

      ! Argument list
      class(vdw_t(wp=R4)), intent(in) :: this
      ! Function result
      real(this%wp) :: R

      R = this%m_R

      return

   end function get_R_r4

   function get_R_r8(this) result(R)
   ! Return universal gas constant

      ! Argument list
      class(vdw_t(wp=R8)), intent(in) :: this
      ! Function result
      real(this%wp) :: R

      R = this%m_R

      return

   end function get_R_r8

   function get_R_r16(this) result(R)
   ! Return universal gas constant

      ! Argument list
      class(vdw_t(wp=R16)), intent(in) :: this
      ! Function result
      real(this%wp) :: R

      R = this%m_R

      return

   end function get_R_r16

end module
      ! init.f90 include file
      character(len=*), intent(in)      :: fluid
      real(kind=this%wp), intent(in)    :: a
      real(kind=this%wp), intent(in)    :: b

      this%m_FluidName = fluid
      this%m_a = a
      this%m_b = b

      return
      ! calc_v.f90 include file
      real(kind=this%wp), intent(in)    :: P
      real(kind=this%wp), intent(in)    :: T
      ! Function result
      real(kind=this%wp) :: v

      ! Local variables
      real(kind=this%wp) :: x(3)
      integer :: n

      asc: associate ( a => P, b => -(this%m_b*P + this%m_R*T), c => this%m_a, &
                       d => -this%m_a*this%m_b, solver => this%m_cubic_solver )

         call solver%solve( a, b, c, d, x, n )

      end associate asc

      v = x(n)

      return

A main program:

program vbw

   use, intrinsic :: iso_fortran_env, only : input_unit, output_unit

   use vdw_m, only : vdw_t

   implicit none

   character(len=*), parameter :: PREC(*) = [ character(len=7) :: "real32", "real64", "real128" ]
   character(len=*), parameter :: fmt_gen = "(*(g0))"

   character(len=len(PREC)) :: str_wp
   integer :: istat
   character(len=256) :: imsg
   write( output_unit, fmt=fmt_gen ) "Enter desired working precision: " // new_line("") // &
      "Supported options are ", PREC
   read( input_unit, fmt="(a)", iostat=istat, iomsg=imsg ) str_wp
   if ( istat /= 0 ) then
      write( output_unit, fmt=fmt_gen ) "Read failed: iostat = ", istat, "; iomsg = " // new_line("") // &
         imsg
      stop
   end if

   select case ( str_wp )

      case ( PREC(1) )
      ! real32

         blk_r4: block

            use, intrinsic :: iso_fortran_env, only : WP => real32

            include "blk_main.f90"

         end block blk_r4

      case ( PREC(2) )
      ! real64

         blk_r8: block

            use, intrinsic :: iso_fortran_env, only : WP => real64

            include "blk_main.f90"

         end block blk_r8

      case ( PREC(3) )
      ! real128

         blk_r16: block

            use, intrinsic :: iso_fortran_env, only : WP => real128

            include "blk_main.f90"

         end block blk_r16

      case default

         write( output_unit, fmt=fmt_gen ) "Unsupported working precision: ", str_wp
         stop

   end select

   stop

end program

And its include file:

            ! blk_main.f90 include file
            real(WP) :: T
            real(WP) :: P
            type(vdw_t(wp=WP)) :: fluid

            call fluid%init( 'Xe', 425.0_wp, 0.05105_wp )

            write ( output_unit, fmt_gen, advance='no') 'Enter P(kPA) :> '
            read ( input_unit, * ) P
            write ( output_unit, fmt_gen, advance='no') 'Enter T(K) :> '
            read ( input_unit, * ) T

            write ( output_unit, fmt_gen ) "Molar volume = ", fluid%v( P, T )

Upon compilation ONCE with Intel Fortran 18.0 compiler and execution TWICE:

Enter desired working precision:
Supported options are real32 real64 real128
real128
Enter P(kPA) :> 100000.0
Enter T(K) :> 300.0
Molar volume = .631187552645620896496671299015848E-001
Enter desired working precision:
Supported options are real32 real64 real128
real64
Enter P(kPA) :> 100000.0
Enter T(K) :> 300.0
Molar volume = .6311875526456209E-01

 

@jimdempseyatthecove, GetProcAddress originally couldn't return a C_FUNPTR because the interface body was written before 2003! It would be nice if Intel upgraded their Win32 modules to be standard-conforming but it's a big task and it would mean that they would be usable in other compilers (at least gfortran) and Intel wouldn't get paid for such usage. They might do it anyway but I don't see a compelling business reason for them to do so.

Looking at the output of ifort /nologo /FAcs vdw5.f90, we see that the FPTR= argument to C_F_PROCPOINTER is set up via

lea rdx, QWORD PTR [GET_V]

So it is passing the address of subroutine GET_V, just as I predicted. Overwriting this is gonna be an access violation unless you tell Windows to mark the page that GET_V is on as writeable, in which case the first instructions of GET_V will be garbage instead of register saves, so this is not fixable. To see why this problem occurs one would have to run the compiler under a debugger. I don't see how putting local variables on the stack is going to help because the problem is that the compiler just isn't seeing GET_V as a local variable at all. BTW, I am running a really old version of ifort, does the issue still arise with whatever the latest version is?

@FortranFan, does your solution involve writing out 2 or 3 interfaces for each procedure internal to the calculational component of the program? Rather problematic if there are hundreds of such procedures and this is what I was hoping to avoid. Not to mention that I am not too happy with INCLUDE files that consist of lots of edits rather than complete procedures. Consider the spirit of the exercise which is to go from the second example of Quote #13 (vdw2.f90) to something which can choose different REAL KINDs at runtime without major or even any changes to the calculational part. But I am impressed that you could put together a relatively big example like this so quickly. Lynn McGuire ought to hire you for a week to see if you can turn his code inside out and make it work :)

 

Quote:

Repeat Offender wrote:

.. @FortranFan, does your solution involve writing out 2 or 3 interfaces for each procedure internal to the calculational component of the program? Rather problematic if there are hundreds of such procedures and this is what I was hoping to avoid. Not to mention that I am not too happy with INCLUDE files that consist of lots of edits rather than complete procedures. Consider the spirit of the exercise which is to go from the second example of Quote #13 (vdw2.f90) to something which can choose different REAL KINDs at runtime without major or even any changes to the calculational part. But I am impressed that you could put together a relatively big example like this so quickly. Lynn McGuire ought to hire you for a week to see if you can turn his code inside out and make it work :)

@Repeat Offender,

Re: "does your solution involve writing out 2 or 3 interfaces for each procedure internal to the" library "component" - yes,  unfortunately.  But please note what I show in Quote #29 is standard-conforming and although it is verbose and the constructs are mind-numbingly repetitive, it's all explicit and a typical technical/scientific/engineering coder - assuming they can read - should be able to come back to such code and understand again the method to all that madness.  Note it indeed does what you ask: " something which can choose different REAL KINDs at runtime without major or even any changes to the calculational part".  One can execute again the code from last night with NO recompilation with the kind corresponding to 32-bit numeric type:

Enter desired working precision:
Supported options are real32 real64 real128
real32
Enter P(kPA) :> 100000.0
Enter T(K) :> 300.0
Molar volume = .6311876E-01

Now on the verbosity part and with INCLUDE files of the solution I suggest in Quote #29, it's an aspect I have long been stating the Fortran standards committee can easily work on and resolve by building upon the GENERIC keyword and the parameterized derived type (PDT) framework,.  Hopefully the next standard revision (2020) will finally bring Fortran into 1990s as far as generics for scientific and numerical computing is concerned.

Note I posted what I did because I worry the path you are taking with Quote #20, etc. is too "clever" a programming approach, the kind most folks will find too hot to handle and it' can be a very long rope with which they can hang themselves.

Re: "I am impressed that you could put together a relatively big example like this so quickly" - thanks much for noticing and for your kind words! 

The problems I see with this approach is you have two opposing factors at work (disregarding lack of motivation to convert the interfaces):

a) OOP/ C++ / Fortran 2003++++++ are migrating to very strict type checking (on the surface this is good)
b) In your case, the type checking extends to matching the function/subroutine interface and you need to load an arbitrary library and locate in general a specific entry point. IOW you would like to have to write one general entry point fetcher as opposed to re-writing one each time you add a multi-type function.

To facilitate your needs, and to some extent the standards committee needs, it would be nice to have a GET and PUT member function to C_FUNPTR such that it facilitates inserting the LPVOID return from GetProcAddress (or other Windows/Linux programmically loaded libraries). Maybe something like a C++ friend function such that you can write a very short type-safe wrapper function to perform the PUT(LPVOID).

I might add, this was an interesting challenge. RepeatOffender did most the work. Although success was not achieved, there is a lot to learn from looking at the sample code the RO produced. Good job.

Jim Dempsey

引文:

Repeat Offender 写道:
GetProcAddress originally couldn't return a C_FUNPTR because the interface body was written before 2003! It would be nice if Intel upgraded their Win32 modules to be standard-conforming but it's a big task and it would mean that they would be usable in other compilers (at least gfortran) and Intel wouldn't get paid for such usage. They might do it anyway but I don't see a compelling business reason for them to do so.

Not possible - too many of the types have unions. But if you look at the more recent additions to KERNEL32 and IFWINTY, you'll see a lot of BIND(C) usage where I tried to use standard syntax wherever possible. I spent MONTHS on this!

As for changing GetProcAddress to return a C_FUNPTR, that would instantly break thousands of programs. It's simple enough to use TRANSFER on the function result, and indeed the DynamicLoad sample, which I rewrote a while back, does this.

Steve (aka "Doctor Fortran") - Retired from Intel

Leave a Comment

Please sign in to add a comment. Not a member? Join today