DECLARE VARIANT

OpenMP* Fortran Compiler Directive: Identifies a variant of a base procedure and specifies the context in which this variant is used. This feature is only available for ifx.

Syntax

!$OMP DECLARE VARIANT ([base-proc-name:]variant-proc-name) clause[[[,] clause]... ]

base-proc-name

Is the name of a base procedure. It is the name that appears in a procedure reference and is replaced by the variant name if the procedure reference appears in the OpenMP* context specified by the MATCH clause. base-proc-name must have an accessible explicit interface.

variant-proc-name

Is the name of the variant procedure that is to be called instead of the base procedure if the base procedure is called from an OpenMP* context that matches the context specified by the MATCH clause.

clause

Is one or more of the following:

  • ADJUST_ARGS (adjust-op : argument-list)

    Causes the adjust-op operation to be performed to each argument specified in argument-list before calling the variant procedure.

    adjust-op is either need_device_ptr or nothing.

    If need_device_ptr is specified, it causes the listed arguments to be converted to corresponding device pointers of the default device. An argument in the argument-list following need_device_ptr must be of type C_PTR.

    If nothing is specified, the arguments listed are passed without modification.

    Multiple ADJUST_ARG clauses can appear for a DECLARE VARIANT directive.

  • APPEND_ARGS (append-op [[, append-op] … ]

    Causes additional arguments to be passed to the call at the end of the argument list of the base procedure.

    append-op is:

    INTEROP (modifier-list)

    where modifier-list is a valid modifier-list accepted in an INIT clause of the INTEROP directive.

    Only one APPEND_ARGS clause can appear in a DECLARE VARIANT directive.

  • MATCH (context-selector-specification-list)

    Specifies OpenMP* context selectors that determine if a variant function is to be used as a base function replacement in the specified context. Any variable referenced in an expression of a context selector must be accessible at the call site to the base function.

An APPEND_ARGS clause or ADJUST_ARGS clause is not permitted unless a MATCH clause also appears that specifies CONSTRUCT= {DISPATCH} as a selector.

The DECLARE VARIANT directive is a declarative directive and must appear in the specification part of a subroutine or function, or in an interface in an interface block. It is a pure directive, so it can appear in a Fortran PURE procedure. It identifies the name of a variant procedure that is to be called instead of the base procedure when the call appears in a context that matches the context-selector-specification in the MATCH clause.

If base-proc-name is not specified, the name of the procedure containing the directive is the base-proc-name. base-proc-name must not be a dummy procedure name, a statement function name, a generic name, a procedure pointer, or an alternate entry name.

If a DECLARE VARIANT directive appears in an interface body for a procedure, it must match a DECLARE VARIANT directive in the definition of that procedure. If a DECLARE VARIANT directive appears for a procedure with an explicit interface, and the definition of that procedure also contains a DECLARE VARIANT directive for that procedure, the two directives must match.

Multiple DECLARE VARIANT directives can associate different variant-proc-names with the same base-proc-name. If more than one DECLARE VARIANT associates the same variant-proc-name with the same base-proc-name, then the context-selector-specification must be the same for all such directives.

A variant procedure must have the same interface characteristics as the base procedure.

When the ADJUST_ARGS clause is specified, an argument with the is-device-ptr property in its interoperability requirement set will be passed as is. Otherwise, the argument will be converted in the same way that a USE_DEVICE_PTR clause on a TARGET DATA construct converts a pointer list item into a device pointer.

When the APPEND_ARGS clause appears, the following occurs:

If the variant is invoked by a DISPATCH construct that contains an INTEROP clause with n variables specified, the first n modifiers specified in the APPEND_ARGS clause are ignored and replaced by the n variables specified in the INTEROP clause of the DISPATCH directive. The order of these n variables appearing in the argument list is the same order that they are specified in the INTEROP clause of the DISPATCH directive.

If there are m modifiers specified in the APPEND_ARG clause, and m > n, an argument for each of the remaining m - n modifiers in the APPEND_ARGS clause is constructed and appended to the end of the argument list in the same order in which they appear in the APPEND_ARGS clause.

Calling a procedure variant directly by variant-proc-name within an OpenMP* context that is different than the context specified in the MATCH clause is non-conforming.

Example

The DECLARE VARIANT directive in the module procedure vecadd_base identifies the procedure vecadd_gpu_offload as a variant that is to replace references to vecadd_base when called from a DISPATCH construct and a GEN device is available for offloading. Notice that vecadd_base does not have any dummy arguments, while vecadd_gpu_offload has a single C_PTR dummy argument.

MODULE vecadd
  INTEGER,PARAMETER  :: n = 1024
CONTAINS
  FUNCTION vecadd_gpu_offload (ptr) RESULT (res)
   USE,INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr
   !$DEC ATTRIBUTES NOINLINE :: vecadd_gpu_offload
    TYPE (c_ptr)      :: ptr
    REAL              :: res
    REAL,DIMENSION(n) :: a, b
    INTEGER           :: k

!$omp TARGET PARALLEL DO REDUCTION (+: res) MAP(TO: a, b)
   DO k= 0, n - 1
     a(k) = k
     b(k) = k + 1
     res   = a(k) + b(k)
    END DO
!$omp END TARGET PARALLEL DO 
    PRINT *, "GPU version of vecadd called"
  END FUNCTION vecadd_gpu_offload

  FUNCTION vecadd_base ()RESULT (res)
    !$DEC ATTRIBUTES NOINLINE :: vecadd_base
    !$OMP DECLARE VARIANT (vecadd_gpu_offload) &
    !$OMP&                ,MATCH (DEVICE = {ARCH (gen)} ))
    REAL              :: res
    REAL,DIMENSION(n) :: a, b
    INTEGER           :: k

!$omp PARALLEL DO REDUCTION (+: res)
   DO k = 1, n
      a(k) = k
      b(k) = k + 1
      res   = a(k) + b(k)
    END DO
!$omp END PARALLEL DO
    PRINT *, "CPU version of vecadd called"
  END FUNCTION vecadd_base
END MODULE vecadd

PROGRAM main
  USE vecadd
  REAL    :: result = 0.0

  !$OMP DISPATCH 
  result = vecadd_base ()

  IF (result == 1048576.0) then
    PRINT *, "PASSED: correct results"
  ELSE 
    PRINT *, "FAILED: incorrect results"
  ENDIF
END PROGRAM

See Also