C call Fortran function with optional argument

[yan__san-chi]

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);

[jimdempseyatthecove]

Why not make two wrapper subroutines?

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

Jim Dempsey

[yan__san-chi]

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?

[Kevin_D_Intel]

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-c

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.

[Kevin_D_Intel]

Although I might be wrong, https://software.intel.com/en-us/forums/intel-fortran-compiler-for-linux-and-mac-os-x/topic/393207#comment-1737916. I'm checking w/Development.

[Kevin_D_Intel]

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.

[yan__san-chi]

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-c

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.

[Kevin_D_Intel]

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.

[jimdempseyatthecove]

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

Jim Dempsey

[IanH]

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.
 

[Kabriel]

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