Quote:Repeat Offender wrote: - Page 2

reidar · ‎10-04-2017

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

jimdempseyatthecove · ‎10-26-2017

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

JVanB · ‎10-26-2017

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.

jimdempseyatthecove · ‎10-26-2017

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

jimdempseyatthecove · ‎10-26-2017

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

jimdempseyatthecove · ‎10-26-2017

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

JVanB · ‎10-26-2017

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.

jimdempseyatthecove · ‎10-26-2017

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

jimdempseyatthecove · ‎10-26-2017

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

FortranFan · ‎10-26-2017

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

JVanB · ‎10-26-2017

@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 :)

FortranFan · ‎10-27-2017

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!

jimdempseyatthecove · ‎10-27-2017

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

Steve_Lionel · ‎10-27-2017

Repeat Offender wrote:
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.

REAL (KIND= )