Optional argument style

Hi everyone, I have a quick question: How do you use optional arguments?

I often have the following pattern, I have an optional argument, that if not present is taken as some default value. But how do you usually implement this mechanism? I give you the two options below

subroutine some_sub(arg1, arg2)
   integer           :: arg1
   integer, optional :: arg2
   integer           :: arg_int
      
   !> Option 1
   arg_int = 1
   if (present(arg2)) arg_int = arg2 ! here potentially move_alloc for big arrays

   !> Option 2 
   if (present(arg2)) then
      arg_int = arg2 ! here potentially move_alloc for big arrays
   else
      arg_int = 1
   end if
   ! Rest of the code
   ! [...]
end subroutine

Clearly, this example has only scalars involved, so I doubt the two options have differences. However, if you have big arrays the two might differ, because option one would fill the array the first just to re-fill it.

What’s your best-practice/experience?

Cheers, Francesco

1 Like

I prefer to write a routine like:

subroutine some_sub(arg1, arg2, arg3)
   integer           :: arg1
   integer, optional :: arg2, arg3
   integer           :: arg2_int, arg3_int
      
   arg2_int = default_int(1, arg2)
   arg3_int = default_int(10, arg3) 
  ...
end subroutine
integer function default_int(val, opt) result (r) 
  integer :: val
  integer, optional :: opt
  if (present (opt)) then 
      r = opt
  else
      r = val
  endif
end function 

For large arrays you can use pointers, so you don’t copy anything

This is such a common need that stdlib has an optval function.

optval - fallback value for optional arguments

Status

Experimental

Description

Returns x if it is present, otherwise default.

This function is intended to be called in a procedure with one or more optional arguments, in order to conveniently fall back to a default value if an optional argument is not present.

Syntax

result = optval (x, default)

Arguments

x: Shall be of type integer, real, complex, or logical, or a scalar of type character.

default: Shall have the same type, kind, and rank as x.

Return value

If x is present, the result is x, otherwise the result is default.

7 Likes

I remember, about ten years ago, I used to see slightly better performance in benchmarks for a large petroleum industry code with “Option 1” in your sample code (using intel ifort). I do not trust that observation today since compilers have dramatically improved, and I do not remember the exact circumstances around those options. Instead, I frequently choose “option 2” in your code because it better indicates the purpose.

If performance is irrelevant to the code section, I try the flexible route others have suggested (through an auxiliary function). But keep in mind that the use of auxiliary functions to handle default values for optional arguments can be orders of magnitude more expensive than a simple if block. The best approach to handling optional arguments is the latest “conditional expression” syntax in Fortran 2023.

4 Likes

With the new F2023 conditional expressions, it can be:

arg_int = ( present(arg2) ? arg2 : 1 )
4 Likes

I hope to see it supported by compilers not too far in the future.

Why would the “conditional expression” be the best option for such a case?

It’s simple, compact, and relatively clear.

Although I would have prefered a more fortranic syntax rather than just copying the C syntax… e.g.
arg_int = if (present(arg2)) then arg2 else 1

1 Like

I was wondering if there were performance arguments behind the “best approach” statement. To be fair, the fact that it is “clear” is arguable, I’m pretty sure I will have to write it on a sticky note on my monitor to remember how to use it, I like my programming languages to be really similar to my natural languages.

You can define macros to have a more natural syntax :wink:

#define IF_
#define THEN_ ?
#define ELSE_ :


arg_int = IF_ present(arg2) THEN_ arg2 ELSE_ 1

Almost, but the parenthesis are actually required. I.e.

#define IF_ (
#define THEN_ ?
#define ELSE_ :

arg_int = IF_ present(arg2) THEN_ arg2 ELSE_ 1 )

For completeness, let’s close it properly :slight_smile:

#define IF_ (
#define THEN_ ?
#define ELSE_ :
#define ENDIF_ )

arg_int = IF_ present(arg2) THEN_ arg2 ELSE_ 1 ENDIF_
1 Like

The conditional expression short-circuits. You might assume something like this already exists in statements such as

value=merge(arg2,100.0,present(arg2))

and as long as you do not use an expression with arg2 it might work as expected, but it is not a good idea. It is clearer if arg2 is used in an expression:

value=merge(abs(arg2)*2.0,100.0,present(arg2))

without short-circuiting the expression is allowed to be evaluated regardless of whether arg2 is present or not, so it would be using an undefined variable when arg2 is not present.

I thought making present() take additional arguments or make a short-circuiting merge() would have been nice, like

value=present(arg2,100.0)  ! return a non-logical value as long as arg2 and the value are the same type

or allowing defaults to be specified when declaring something optional. If C did not exist I suspect that conditional expression syntax would not have been even thought of; and even a good number of C programmers seem to not like it; but it finally gives Fortran a compact expression that short-circuits and can be passed as an argument.

PS,

In a little language of my own all the logical expressions are actually functions (if,eq,le,…)
that short-circuit so you could do something like

value=if(present(arg2),arg2,100.0) 

where it is IF(logical_expression,eval_and_return_if_true,eval_and_return_if_false)

it is like algebraic versus Polish notation, some people like it a lot and others do not. Essentially everything is a function, and you name blocks of commands and then execute
them like functions as well with the execute() function. (like “execute(if(eq(a,b),blocka,blockb)” means if A==B execute commands in BLOCKA else execute BLOCKB. That is only relevant in that instead of the C-like expression I thought something like making IF into a Fortran function would have been more “Fortranik”…

Regarding the original question, I generally eschew using semi-colons
but if I have a lot of optional arguments I either make a contained
procedure like the getopts function described by later replies or use either of the syntaxes
described but on one line:

arg2_ = 1;if (present(arg2)) arg2_ = arg2
arg3_ = 1;if (present(arg3)) arg3_ = arg3
arg4_ = 1;if (present(arg4)) arg4_ = arg4

if (present(arg2)) then; arg2_ = arg2 ; else; arg2_ = 1; endif
if (present(arg3)) then; arg3_ = arg3 ; else; arg3_ = 1; endif
if (present(arg4)) then; arg4_ = arg4 ; else; arg4_ = 1; endif
if (present(arg5)) then; arg5_ = arg5 ; else; arg5_ = 1; endif

it just gets too lengthy and repetitive otherwise.

And I usually name the local variable the same as the actual argument with an underscore following it. Just personal style though. No real functionality to doing that.

1 Like

Just to be clear: it is never a good idea to use the merge intrinsic for this - as all three expressions are always evaluated. This will cause an abend when the optional argument is not present.

The C-like ?: operator is different in that the conditional portion is evaluated first, then only one or the other expression is evaluated.

This is a good use case for Fortran to support generics. So you won’t have to write a deault_int and a default_real and a default_logical etc etc

Yes, of course, I didn’t want to complicate things in the post for the actual standard. Waiting for the future generics… :slight_smile:

You don’t need to wait. This case is covered by existing generic interfaces. For instance in stdlib:

  interface optval
    !! Fallback value for optional arguments
    !! ([Specification](../page/specs/stdlib_optval.html#description))
    #:for k1, t1 in KINDS_TYPES
      module procedure optval_${t1[0]}$${k1}$
    #:endfor
    module procedure optval_character
  end interface optval

In my case I’ve been using good old CPP macro…

#ifdef __GFORTRAN__
#define _setopt_(x,val) x = val; if (present(x/**/_)) x = x/**/_
#else
#define _setopt_(x,val) x = val; if (present(x##_)) x = x##_
#endif

(My naming convention is opposite to that of Urbanjost, i.e. the dummy argument is with underscore, while the corresponding local variable is no underscore, because I want to use the latter on the same footing as other local variables (w/o remembering which is optional or not).

1 Like

You are right, I’m saying that I’m waiting the new Fortran generics that will be available in 202y.

I wrote some default_real, default_int, etc. some time ago before those appeared in the stdlib (or at least, before I realized they were present in stdlib).

I really appreciate the work done in stdlib, and I always suggest colleagues to have a look at stdlib and fpm.
:slight_smile:

1 Like