Community
cancel
Showing results for 
Search instead for 
Did you mean: 
Highlighted
Beginner
41 Views

C call Fortran function with optional argument

Hi! I have interoperable  Fortran code that C can call ODRPACK95. At least it works without passing optional argument from C. And now is it possbile way to pass optional argument from C?

Fortran code:

subroutine wrapper_ODR(FCN,N,M,NP,NQ,BETA,Y,X,&
        DELTA,WE,WD,IFIXB,IFIXX,JOB,NDIGIT,TAUFAC,&
        SSTOL,PARTOL,MAXIT,IPRINT,LUNERR,LUNRPT,&
     STPB,STPD,SCLB,SCLD,WORK,IWORK,INFO,LOWER,UPPER) bind(C, name='wrapper_ODR')
!DEC$ ATTRIBUTES DLLEXPORT :: wrapper_ODR    
    use iso_c_binding
    use ODRPACK95
    implicit none
    
    interface 
        subroutine FCN(N,M,NP,NQ,LDN,LDM,LDNP,BETA,XPLUSD,IFIXB,IFIXX,LDIFX,&
        IDEVAL,F,FJACB,FJACD,ISTOP) bind(C)
        
        use, intrinsic :: iso_c_binding
        implicit none
        
        integer(c_int) :: IDEVAL,ISTOP,LDIFX,LDM,LDN,LDNP,M,N,NP,NQ
        
        real (c_double) :: BETA(1:NP),F(1:LDN,1:NQ),FJACB(1:LDN,1:LDNP,1:NQ), &
        FJACD(1:LDN,1:LDM,1:NQ),XPLUSD(1:LDN,1:M)
        
        integer(c_int) :: IFIXB(1:NP),IFIXX(1:LDIFX,1:M)
    
        end subroutine
    end interface
  
    integer(c_int),value :: N,M,NP,NQ
    real(c_double) :: BETA(1:NP),Y(1:N,1:NQ),X(1:N,1:M)
    
!!!!!Optional variable
    !!!!!!!!Unfinished
    !
    !integer(c_int), optional :: IFIXB(:),IFIXX(:,:),JOB,NDIGIT,MAXIT&
    !,IPRINT,LUNERR,LUNRPT,INFO
    !
    !real(c_double),  optional :: WE(:,:,:),WD(:,:,:),&
    !    TAUFAC,SSTOL,PARTOL,STPB(:),STPD(:,:),&
    !    SCLB(:),SCLD(:,:),LOWER(:),UPPER(:)
    !
    ! integer(c_int), optional,pointer :: IWORK(:)
    !real(c_double), optional, pointer :: DELTA(:,:),WORK(:)
    
!!!!!Call ODR    
    call ODR(FCN,N,M,NP,NQ,BETA,Y,X,&
        DELTA,WE,WD,IFIXB,IFIXX,JOB,NDIGIT,TAUFAC,&
        SSTOL,PARTOL,MAXIT,IPRINT,LUNERR,LUNRPT,&
     STPB,STPD,SCLB,SCLD,WORK,IWORK,INFO,LOWER,UPPER)
    
end subroutine wrapper_ODR    

wrapper_ODR in C code:

wrapper_ODR(&FCN, N, M, NP, NQ, BETA, Y, X, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, \
        NULL, NULL,NULL, NULL, NULL, NULL, NULL,NULL, NULL, NULL, NULL, NULL, NULL, \
        NULL, NULL);

 

0 Kudos
10 Replies
Highlighted
41 Views

Why not make two wrapper subroutines?

wrapper_ODR as you have it above
wraqpper_ODR_short as you want for apparent initialization

Jim Dempsey

0 Kudos
Highlighted
Beginner
41 Views

jimdempseyatthecove wrote:

Why not make two wrapper subroutines?

wrapper_ODR as you have it above
wraqpper_ODR_short as you want for apparent initialization

Jim Dempsey

I see! Maybe I can try it! Well, if I want to pass UPPER and LOWER from C to Fortran, what does it look like?

 

0 Kudos
Highlighted
Employee
41 Views

I believe ifort officially supports using BIND(C) with optional arguments. I have small working example based on this post, http://stackoverflow.com/questions/40089567/calling-fortran-subroutines-with-optional-arguments-from...

Optional arguments that are not PRESENT cannot be referenced. The call to ODR references optional arguments (e.g. WORK, IWORK) that may not be present which would cause a run-time fault.

0 Kudos
Highlighted
Employee
41 Views

0 Kudos
Highlighted
Employee
41 Views

When using BIND(C) with OPTIONAL and compiling with /stand:f08 the compiler issues a warning:

sub.f90(1): warning #8809: An OPTIONAL or EXTERNAL dummy argument to a BIND(C) procedure is not interoperable.  
subroutine fort_foo(i, x) bind(C, name="fort_foo")

In the Fortran 2008 standard it is not legal to have an OPTIONAL argument with a BIND(C).

The 17.0 release includes support for some Fortran 2015 features from the "Technical Specification 29113 Further Interoperability with C", so it works in this version.

0 Kudos
Highlighted
Beginner
41 Views

Davis, Kevin D wrote:

I believe ifort officially supports using BIND(C) with optional arguments. I have small working example based on this post, http://stackoverflow.com/questions/40089567/calling-fortran-subroutines-with-optional-arguments-from...

Optional arguments that are not PRESENT cannot be referenced. The call to ODR references optional arguments (e.g. WORK, IWORK) that may not be present which would cause a run-time fault.

Yes! I believe BIND(C) still works with OPTIONAL arguments, The example can run in my environment. For example

!!!!!Optional variable
    
    integer(c_int), intent(in), optional :: IFIXB(:),IFIXX(:,:),JOB,NDIGIT,MAXIT&
    ,IPRINT,LUNERR,LUNRPT,IWORK(:),INFO
    
    real(c_double), intent(in), optional :: DELTA(:,:),&
        WE(:,:,:),WD(:,:,:),TAUFAC,SSTOL,PARTOL,&
        STPB(:),STPD(:,:),SCLB(:),SCLD(:,:),&
         WORK(:),LOWER(:),UPPER(1:NP)
    
!!!!!Call ODR
    if(present(UPPER)) then
    call ODR(FCN=FCN,N=N,M=M,NP=NP,NQ=NQ,BETA=BETA,Y=Y,X=X,UPPER=UPPER)
    end if

Above code can be used when I need to use UPPER argument, however sometimes I use UPPER and LOWER or only using LOWER, so call ODR(...) and if(present(...)) statements keep adjusting all the time. Well that is a little inconvinent.

0 Kudos
Highlighted
Employee
41 Views

I'm may be misreading your post and perhaps you already have this; however, you can create an IF/ELSEIF construct to cover each unique case having different optional arguments present to call OCR accordingly rather than regularly adjusting the source for when only certain arguments are present/used.

0 Kudos
Highlighted
41 Views

Why not make the scalar arguments call by reference? Then pass a null pointer from the C side for missing arguments.

Jim Dempsey

0 Kudos
Highlighted
Black Belt
41 Views

If UPPER and LOWER were optional dummy arguments inside ODR, then you may simply pass the corresponding actual argument along, even if it is not present.
 

0 Kudos
Highlighted
Beginner
41 Views

I didn't realize you could pass along optional arguments downstream, so I gave it a try, but ran into some trouble and got some unexpected behavior. I attached an example to highlight what I am seeing. I am using Linux version 17.0.0.

If I compile using debug flags, then the compiler has trouble knowing that an optional dummy argument is missing. If I put the interface in the main file, or if I call the subroutine from a contains in the main file, it works. It also works with no flags, but I haven't tested with any other flags. I'm not sure if it helps, but if I use an older compiler (e.g. v12), I see the same wrong behavior, but it is independent of any compiler flags.

It looks like a bug to me.

Here is how I am compiling:

#!/bin/bash
# this works with v17
flags=""
ifort ${flags} -o test_optional test_optional.f90 test_optional_sub.f90
echo "Running with no debug flags"
./test_optional
echo ""

# this does not
flags="-O0 -sox -traceback -debug extended -g"
ifort ${flags} -o test_optional test_optional.f90 test_optional_sub.f90
echo "Running with debug flags"
./test_optional
echo ""

Here is my output:

Running with no debug flags
 test passing of optional arguments
 calling s1 directly
   hi, subroutine s1
   three =    3.000000    
 calling s2, then s1 indirectly
   hi, subroutine s2 calling s1
   hi, subroutine s1
   three =    3.000000    
 calling s3 (program contains), then s1 indirectly
   hi, subroutine s3 calling s1
   hi, subroutine s1
   three =    3.000000    

Running with debug flags
 test passing of optional arguments
 calling s1 directly
   hi, subroutine s1
   three =    3.000000    
   four =    3.000000     -- this should not be printed
 calling s2, then s1 indirectly
   hi, subroutine s2 calling s1
   hi, subroutine s1
   three =    3.000000    
   four =    3.000000     -- this should not be printed
 calling s3 (program contains), then s1 indirectly
   hi, subroutine s3 calling s1
   hi, subroutine s1
   three =    3.000000    

Main program:

program test
  implicit none

  real one, two, three

  ! uncomment to make call to s2 work, when debugging symbols added
  ! interface 
  !    subroutine s1(one, two, three, four)
  !      implicit none
  !      real, intent(in) :: one, two
  !      real, intent(in), optional :: three, four
  !    end subroutine s1
  ! end interface

  one = 1.
  two = 2.
  three = 3.

  write(*,*) 'test passing of optional arguments'
  write(*,*) 'calling s1 directly'
  call s1(one, two, three)
  write(*,*) 'calling s2, then s1 indirectly'
  call s2(one, two, three)
  write(*,*) 'calling s3 (program contains), then s1 indirectly'
  call s3(one, two, three)

contains
  subroutine s3(one, two, three, four)
    implicit none
    real, intent(in) :: one, two
    real, intent(in), optional :: three, four
    write(*,*) '  hi, subroutine s3 calling s1'
    call s1(one, two, three, four)
  end subroutine s3

end program test

Subroutines:

subroutine s1(one, two, three, four)
  implicit none
  real, intent(in) :: one, two
  real, intent(in), optional :: three, four

  write(*,*) '  hi, subroutine s1'
  if (present(three)) then
     write(*,*) '  three = ', three
  end if
  if (present(four)) then
     write(*,*) '  four = ', four, "-- this should not be printed"
  end if
end subroutine s1

subroutine s2(one, two, three, four)
  implicit none
  real, intent(in) :: one, two
  real, intent(in), optional :: three, four

  interface 
     subroutine s1(one, two, three, four)
       implicit none
       real, intent(in) :: one, two
       real, intent(in), optional :: three, four
     end subroutine s1
  end interface

  write(*,*) '  hi, subroutine s2 calling s1'  
  call s1(one, two, three, four)
end subroutine s2

 

0 Kudos