Fortran: Remove deprecated coarray routines [PR107635]

gcc/fortran/ChangeLog:

	PR fortran/107635

	* gfortran.texi: Remove deprecated functions from documentation.
	* trans-decl.cc (gfc_build_builtin_function_decls): Remove
	decprecated function decls.
	* trans-intrinsic.cc (gfc_conv_intrinsic_exponent): Remove
	deprecated/no longer needed routines.
	* trans.h: Remove unused decls.

libgfortran/ChangeLog:

	* caf/libcaf.h (_gfortran_caf_get): Removed because deprecated.
	(_gfortran_caf_send): Same.
	(_gfortran_caf_sendget): Same.
	(_gfortran_caf_send_by_ref): Same.
	* caf/single.c (assign_char4_from_char1): Same.
	(assign_char1_from_char4): Same.
	(convert_type): Same.
	(defined): Same.
	(_gfortran_caf_get): Same.
	(_gfortran_caf_send): Same.
	(_gfortran_caf_sendget): Same.
	(copy_data): Same.
	(get_for_ref): Same.
	(_gfortran_caf_get_by_ref): Same.
	(send_by_ref): Same.
	(_gfortran_caf_send_by_ref): Same.
	(_gfortran_caf_sendget_by_ref): Same.

diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 36c203b27b3a993d98c2fff2b674e05d5f8e25c7..ba3c3771c43c5cc5474d5ff4519d3ca6a34623be 100644 (file)
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -4205,12 +4205,6 @@ future implementation of teams.  It is about to change without further notice.
 * _gfortran_caf_register_accessor:: Register an accessor for remote access
 * _gfortran_caf_register_accessors_finish:: Finish registering accessor functions
 * _gfortran_caf_get_remote_function_index:: Get the index of an accessor
-* _gfortran_caf_is_present:: Query whether an allocatable or pointer component in a derived type coarray is allocated
-* _gfortran_caf_send:: Sending data from a local image to a remote image
-* _gfortran_caf_get:: Getting data from a remote image
-* _gfortran_caf_sendget:: Sending data between remote images
-* _gfortran_caf_send_by_ref:: Sending data from a local image to a remote image using enhanced references
-* _gfortran_caf_get_by_ref:: Getting data from a remote image using enhanced references
 * _gfortran_caf_get_from_remote:: Getting data from a remote image using a remote side accessor
 * _gfortran_caf_is_present_on_remote:: Check that a coarray or a part of it is allocated on the remote image
 * _gfortran_caf_send_to_remote:: Send data to a remote image using a remote side accessor to store it
@@ -4649,335 +4643,6 @@ message, when the hash could not be found.
 @end table
 
 
-
-@node _gfortran_caf_is_present
-@subsection @code{_gfortran_caf_is_present} --- Query whether an allocatable or pointer component in a derived type coarray is allocated
-@cindex Coarray, _gfortran_caf_is_present
-
-@table @asis
-@item @emph{Description}:
-Used to query the coarray library whether an allocatable component in a derived
-type coarray is allocated on a remote image.
-
-@item @emph{Syntax}:
-@code{void _gfortran_caf_is_present (caf_token_t token, int image_index,
-gfc_reference_t *ref)}
-
-@item @emph{Arguments}:
-@multitable @columnfractions .15 .70
-@item @var{token} @tab An opaque pointer identifying the coarray.
-@item @var{image_index} @tab The ID of the remote image; must be a positive
-number.
-@item @var{ref} @tab A chain of references to address the allocatable or
-pointer component in the derived type coarray.  The object reference needs to be
-a scalar or a full array reference, respectively.
-@end multitable
-
-@end table
-
-@node _gfortran_caf_send
-@subsection @code{_gfortran_caf_send} --- Sending data from a local image to a remote image
-@cindex Coarray, _gfortran_caf_send
-
-@table @asis
-@item @emph{Description}:
-Called to send a scalar, an array section or a whole array from a local
-to a remote image identified by the image_index.
-
-@item @emph{Syntax}:
-@code{void _gfortran_caf_send (caf_token_t token, size_t offset,
-int image_index, gfc_descriptor_t *dest, caf_vector_t *dst_vector,
-gfc_descriptor_t *src, int dst_kind, int src_kind, bool may_require_tmp,
-int *stat)}
-
-@item @emph{Arguments}:
-@multitable @columnfractions .15 .70
-@item @var{token} @tab intent(in)  An opaque pointer identifying the coarray.
-@item @var{offset} @tab intent(in)  The number of bytes the actual data is
-shifted compared to the base address of the coarray.
-@item @var{image_index} @tab intent(in)  The ID of the remote image; must be a
-positive number.
-@item @var{dest} @tab intent(in)  Array descriptor for the remote image for the
-bounds and the size.  The @code{base_addr} shall not be accessed.
-@item @var{dst_vector} @tab intent(in)  If not NULL, it contains the vector
-subscript of the destination array; the values are relative to the dimension
-triplet of the dest argument.
-@item @var{src} @tab intent(in)  Array descriptor of the local array to be
-transferred to the remote image
-@item @var{dst_kind} @tab intent(in)  Kind of the destination argument
-@item @var{src_kind} @tab intent(in)  Kind of the source argument
-@item @var{may_require_tmp} @tab intent(in)  The variable is @code{false} when
-it is known at compile time that the @var{dest} and @var{src} either cannot
-overlap or overlap (fully or partially) such that walking @var{src} and
-@var{dest} in elementwise order (honoring the stride value) does not
-lead to wrong results.  Otherwise, the value is @code{true}.
-@item @var{stat} @tab intent(out) when non-NULL give the result of the
-operation, i.e., zero on success and nonzero on error.  When NULL and an error
-occurs, then an error message is printed and the program is terminated.
-@end multitable
-
-@item @emph{NOTES}
-It is permitted to have @var{image_index} equal the current image; the memory
-of the send-to and the send-from might (partially) overlap in that case.  The
-implementation has to take care that it handles this case, e.g. using
-@code{memmove} which handles (partially) overlapping memory. If
-@var{may_require_tmp} is true, the library might additionally create a
-temporary variable, unless additional checks show that this is not required
-(e.g. because walking backward is possible or because both arrays are
-contiguous and @code{memmove} takes care of overlap issues).
-
-Note that the assignment of a scalar to an array is permitted. In addition,
-the library has to handle numeric type conversion, and padding
-and different character kinds for strings.
-@end table
-
-
-@node _gfortran_caf_get
-@subsection @code{_gfortran_caf_get} --- Getting data from a remote image
-@cindex Coarray, _gfortran_caf_get
-
-@table @asis
-@item @emph{Description}:
-Called to get an array section or a whole array from a remote,
-image identified by the image_index.
-
-@item @emph{Syntax}:
-@code{void _gfortran_caf_get (caf_token_t token, size_t offset,
-int image_index, gfc_descriptor_t *src, caf_vector_t *src_vector,
-gfc_descriptor_t *dest, int src_kind, int dst_kind, bool may_require_tmp,
-int *stat)}
-
-@item @emph{Arguments}:
-@multitable @columnfractions .15 .70
-@item @var{token} @tab intent(in)  An opaque pointer identifying the coarray.
-@item @var{offset} @tab intent(in)  The number of bytes the actual data is
-shifted compared to the base address of the coarray.
-@item @var{image_index} @tab intent(in)  The ID of the remote image; must be a
-positive number.
-@item @var{dest} @tab intent(out) Array descriptor of the local array to store
-the data retrieved from the remote image
-@item @var{src} @tab intent(in) Array descriptor for the remote image for the
-bounds and the size.  The @code{base_addr} shall not be accessed.
-@item @var{src_vector} @tab intent(in)  If not NULL, it contains the vector
-subscript of the source array; the values are relative to the dimension
-triplet of the @var{src} argument.
-@item @var{dst_kind} @tab intent(in)  Kind of the destination argument
-@item @var{src_kind} @tab intent(in)  Kind of the source argument
-@item @var{may_require_tmp} @tab intent(in)  The variable is @code{false} when
-it is known at compile time that the @var{dest} and @var{src} either cannot
-overlap or overlap (fully or partially) such that walking @var{src} and
-@var{dest} in elementwise order (honoring the stride value) does not
-lead to wrong results.  Otherwise, the value is @code{true}.
-@item @var{stat} @tab intent(out) When non-NULL give the result of the
-operation, i.e., zero on success and nonzero on error.  When NULL and an error
-occurs, then an error message is printed and the program is terminated.
-@end multitable
-
-@item @emph{NOTES}
-It is permitted to have @var{image_index} equal the current image; the memory of
-the send-to and the send-from might (partially) overlap in that case.  The
-implementation has to take care that it handles this case, e.g. using
-@code{memmove} which handles (partially) overlapping memory. If
-@var{may_require_tmp} is true, the library might additionally create a
-temporary variable, unless additional checks show that this is not required
-(e.g. because walking backward is possible or because both arrays are
-contiguous and @code{memmove} takes care of overlap issues).
-
-Note that the library has to handle numeric-type conversion and for strings,
-padding and different character kinds.
-@end table
-
-
-@node _gfortran_caf_sendget
-@subsection @code{_gfortran_caf_sendget} --- Sending data between remote images
-@cindex Coarray, _gfortran_caf_sendget
-
-@table @asis
-@item @emph{Description}:
-Called to send a scalar, an array section or a whole array from a remote image
-identified by the @var{src_image_index} to a remote image identified by the
-@var{dst_image_index}.
-
-@item @emph{Syntax}:
-@code{void _gfortran_caf_sendget (caf_token_t dst_token, size_t dst_offset,
-int dst_image_index, gfc_descriptor_t *dest, caf_vector_t *dst_vector,
-caf_token_t src_token, size_t src_offset, int src_image_index,
-gfc_descriptor_t *src, caf_vector_t *src_vector, int dst_kind, int src_kind,
-bool may_require_tmp, int *stat)}
-
-@item @emph{Arguments}:
-@multitable @columnfractions .15 .70
-@item @var{dst_token} @tab intent(in)  An opaque pointer identifying the
-destination coarray.
-@item @var{dst_offset} @tab intent(in)  The number of bytes the actual data
-is shifted compared to the base address of the destination coarray.
-@item @var{dst_image_index} @tab intent(in)  The ID of the destination remote
-image; must be a positive number.
-@item @var{dest} @tab intent(in) Array descriptor for the destination
-remote image for the bounds and the size.  The @code{base_addr} shall not be
-accessed.
-@item @var{dst_vector} @tab intent(int)  If not NULL, it contains the vector
-subscript of the destination array; the values are relative to the dimension
-triplet of the @var{dest} argument.
-@item @var{src_token} @tab intent(in)  An opaque pointer identifying the source
-coarray.
-@item @var{src_offset} @tab intent(in)  The number of bytes the actual data
-is shifted compared to the base address of the source coarray.
-@item @var{src_image_index} @tab intent(in)  The ID of the source remote image;
-must be a positive number.
-@item @var{src} @tab intent(in) Array descriptor of the local array to be
-transferred to the remote image.
-@item @var{src_vector} @tab intent(in) Array descriptor of the local array to
-be transferred to the remote image
-@item @var{dst_kind} @tab intent(in)  Kind of the destination argument
-@item @var{src_kind} @tab intent(in)  Kind of the source argument
-@item @var{may_require_tmp} @tab intent(in)  The variable is @code{false} when
-it is known at compile time that the @var{dest} and @var{src} either cannot
-overlap or overlap (fully or partially) such that walking @var{src} and
-@var{dest} in elementwise order (honoring the stride value) does not
-lead to wrong results.  Otherwise, the value is @code{true}.
-@item @var{stat} @tab intent(out) when non-NULL give the result of the
-operation, i.e., zero on success and nonzero on error.  When NULL and an error
-occurs, then an error message is printed and the program is terminated.
-@end multitable
-
-@item @emph{NOTES}
-It is permitted to have the same image index for both @var{src_image_index} and
-@var{dst_image_index}; the memory of the send-to and the send-from might
-(partially) overlap in that case.  The implementation has to take care that it
-handles this case, e.g. using @code{memmove} which handles (partially)
-overlapping memory.  If @var{may_require_tmp} is true, the library
-might additionally create a temporary variable, unless additional checks show
-that this is not required (e.g. because walking backward is possible or because
-both arrays are contiguous and @code{memmove} takes care of overlap issues).
-
-Note that the assignment of a scalar to an array is permitted. In addition,
-the library has to handle numeric-type conversion and for strings, padding and
-different character kinds.
-@end table
-
-@node _gfortran_caf_send_by_ref
-@subsection @code{_gfortran_caf_send_by_ref} --- Sending data from a local image to a remote image with enhanced referencing options
-@cindex Coarray, _gfortran_caf_send_by_ref
-
-@table @asis
-@item @emph{Description}:
-Called to send a scalar, an array section or a whole array from a local to a
-remote image identified by the @var{image_index}.
-
-@item @emph{Syntax}:
-@code{void _gfortran_caf_send_by_ref (caf_token_t token, int image_index,
-gfc_descriptor_t *src, caf_reference_t *refs, int dst_kind, int src_kind,
-bool may_require_tmp, bool dst_reallocatable, int *stat, int dst_type)}
-
-@item @emph{Arguments}:
-@multitable @columnfractions .15 .70
-@item @var{token} @tab intent(in)  An opaque pointer identifying the coarray.
-@item @var{image_index} @tab intent(in)  The ID of the remote image; must be a
-positive number.
-@item @var{src} @tab intent(in) Array descriptor of the local array to be
-transferred to the remote image
-@item @var{refs} @tab intent(in) The references on the remote array to store
-the data given by src.  Guaranteed to have at least one entry.
-@item @var{dst_kind} @tab intent(in)  Kind of the destination argument
-@item @var{src_kind} @tab intent(in)  Kind of the source argument
-@item @var{may_require_tmp} @tab intent(in)  The variable is @code{false} when
-it is known at compile time that the @var{dest} and @var{src} either cannot
-overlap or overlap (fully or partially) such that walking @var{src} and
-@var{dest} in elementwise order (honoring the stride value) does not
-lead to wrong results.  Otherwise, the value is @code{true}.
-@item @var{dst_reallocatable} @tab intent(in)  Set when the destination is of
-allocatable or pointer type and the refs allow reallocation, i.e., the ref
-is a full array or component ref.
-@item @var{stat} @tab intent(out) When non-@code{NULL} give the result of the
-operation, i.e., zero on success and nonzero on error.  When @code{NULL} and
-an error occurs, then an error message is printed and the program is terminated.
-@item @var{dst_type} @tab intent(in)  Give the type of the destination.  When
-the destination is not an array, than the precise type, e.g. of a component in
-a derived type, is not known, but provided here.
-@end multitable
-
-@item @emph{NOTES}
-It is permitted to have @var{image_index} equal the current image; the memory of
-the send-to and the send-from might (partially) overlap in that case.  The
-implementation has to take care that it handles this case, e.g. using
-@code{memmove} which handles (partially) overlapping memory.  If
-@var{may_require_tmp} is true, the library might additionally create a
-temporary variable, unless additional checks show that this is not required
-(e.g. because walking backward is possible or because both arrays are
-contiguous and @code{memmove} takes care of overlap issues).
-
-Note that the assignment of a scalar to an array is permitted.  In addition,
-the library has to handle numeric-type conversion and for strings, padding
-and different character kinds.
-
-Because of the more complicated references possible some operations may be
-unsupported by certain libraries.  The library is expected to issue a precise
-error message why the operation is not permitted.
-@end table
-
-
-@node _gfortran_caf_get_by_ref
-@subsection @code{_gfortran_caf_get_by_ref} --- Getting data from a remote image using enhanced references
-@cindex Coarray, _gfortran_caf_get_by_ref
-
-@table @asis
-@item @emph{Description}:
-Called to get a scalar, an array section or a whole array from a remote image
-identified by the @var{image_index}.
-
-@item @emph{Syntax}:
-@code{void _gfortran_caf_get_by_ref (caf_token_t token, int image_index,
-caf_reference_t *refs, gfc_descriptor_t *dst, int dst_kind, int src_kind,
-bool may_require_tmp, bool dst_reallocatable, int *stat, int src_type)}
-
-@item @emph{Arguments}:
-@multitable @columnfractions .15 .70
-@item @var{token} @tab intent(in)  An opaque pointer identifying the coarray.
-@item @var{image_index} @tab intent(in)  The ID of the remote image; must be a
-positive number.
-@item @var{refs} @tab intent(in) The references to apply to the remote structure
-to get the data.
-@item @var{dst} @tab intent(in) Array descriptor of the local array to store
-the data transferred from the remote image.  May be reallocated where needed
-and when @var{DST_REALLOCATABLE} allows it.
-@item @var{dst_kind} @tab intent(in)  Kind of the destination argument
-@item @var{src_kind} @tab intent(in)  Kind of the source argument
-@item @var{may_require_tmp} @tab intent(in)  The variable is @code{false} when
-it is known at compile time that the @var{dest} and @var{src} either cannot
-overlap or overlap (fully or partially) such that walking @var{src} and
-@var{dest} in elementwise order (honoring the stride value) does not
-lead to wrong results.  Otherwise, the value is @code{true}.
-@item @var{dst_reallocatable} @tab intent(in)  Set when @var{DST} is of
-allocatable or pointer type and its refs allow reallocation, i.e., the full
-array or a component is referenced.
-@item @var{stat} @tab intent(out) When non-@code{NULL} give the result of the
-operation, i.e., zero on success and nonzero on error.  When @code{NULL} and an
-error occurs, then an error message is printed and the program is terminated.
-@item @var{src_type} @tab intent(in)  Give the type of the source.  When the
-source is not an array, than the precise type, e.g. of a component in a
-derived type, is not known, but provided here.
-@end multitable
-
-@item @emph{NOTES}
-It is permitted to have @code{image_index} equal the current image; the memory
-of the send-to and the send-from might (partially) overlap in that case.  The
-implementation has to take care that it handles this case, e.g. using
-@code{memmove} which handles (partially) overlapping memory.  If
-@var{may_require_tmp} is true, the library might additionally create a
-temporary variable, unless additional checks show that this is not required
-(e.g. because walking backward is possible or because both arrays are
-contiguous and @code{memmove} takes care of overlap issues).
-
-Note that the library has to handle numeric-type conversion and for strings,
-padding and different character kinds.
-
-Because of the more complicated references possible some operations may be
-unsupported by certain libraries.  The library is expected to issue a precise
-error message why the operation is not permitted.
-@end table
-
-
 @node _gfortran_caf_get_from_remote
 @subsection @code{_gfortran_caf_get_from_remote} --- Getting data from a remote image using a remote side accessor
 @cindex Coarray, _gfortran_caf_get_from_remote

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 025ad539d25307b29758127b28dfe42c63ee2753..893eac07c764557079a02cea529e6a8f761a16f0 100644 (file)
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -135,22 +135,12 @@ tree gfor_fndecl_caf_this_image;
 tree gfor_fndecl_caf_num_images;
 tree gfor_fndecl_caf_register;
 tree gfor_fndecl_caf_deregister;
-
-// Deprecate start
-tree gfor_fndecl_caf_get;
-tree gfor_fndecl_caf_send;
-tree gfor_fndecl_caf_sendget;
-tree gfor_fndecl_caf_send_by_ref;
-tree gfor_fndecl_caf_sendget_by_ref;
-// Deprecate end
-
 tree gfor_fndecl_caf_register_accessor;
 tree gfor_fndecl_caf_register_accessors_finish;
 tree gfor_fndecl_caf_get_remote_function_index;
 tree gfor_fndecl_caf_get_from_remote;
 tree gfor_fndecl_caf_send_to_remote;
 tree gfor_fndecl_caf_transfer_between_remotes;
-
 tree gfor_fndecl_caf_sync_all;
 tree gfor_fndecl_caf_sync_memory;
 tree gfor_fndecl_caf_sync_images;
@@ -4073,45 +4063,6 @@ gfc_build_builtin_function_decls (void)
        ppvoid_type_node, integer_type_node, pint_type, pchar_type_node,
        size_type_node);
 
-      // Deprecate start
-      gfor_fndecl_caf_get = gfc_build_library_function_decl_with_spec (
-       get_identifier (PREFIX("caf_get")), ". r . . r r w . . . w ",
-       void_type_node, 10,
-       pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
-       pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node,
-       boolean_type_node, pint_type);
-
-      gfor_fndecl_caf_send = gfc_build_library_function_decl_with_spec (
-       get_identifier (PREFIX("caf_send")), ". r . . w r r . . . w ",
-       void_type_node, 11,
-       pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
-       pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node,
-       boolean_type_node, pint_type, pvoid_type_node);
-
-      gfor_fndecl_caf_sendget = gfc_build_library_function_decl_with_spec (
-       get_identifier (PREFIX("caf_sendget")), ". r . . w r r . . r r . . . w ",
-       void_type_node, 14, pvoid_type_node, size_type_node, integer_type_node,
-       pvoid_type_node, pvoid_type_node, pvoid_type_node, size_type_node,
-       integer_type_node, pvoid_type_node, pvoid_type_node, integer_type_node,
-       integer_type_node, boolean_type_node, integer_type_node);
-
-      gfor_fndecl_caf_send_by_ref = gfc_build_library_function_decl_with_spec (
-       get_identifier (PREFIX("caf_send_by_ref")), ". r . r r . . . . w . ",
-       void_type_node, 10, pvoid_type_node, integer_type_node, pvoid_type_node,
-       pvoid_type_node, integer_type_node, integer_type_node,
-       boolean_type_node, boolean_type_node, pint_type, integer_type_node);
-
-      gfor_fndecl_caf_sendget_by_ref
-         = gfc_build_library_function_decl_with_spec (
-           get_identifier (PREFIX("caf_sendget_by_ref")),
-           ". r . r r . r . . . w w . . ",
-           void_type_node, 13, pvoid_type_node, integer_type_node,
-           pvoid_type_node, pvoid_type_node, integer_type_node,
-           pvoid_type_node, integer_type_node, integer_type_node,
-           boolean_type_node, pint_type, pint_type, integer_type_node,
-           integer_type_node);
-      // Deprecate end
-
       gfor_fndecl_caf_register_accessor
        = gfc_build_library_function_decl_with_spec (
          get_identifier (PREFIX ("caf_register_accessor")), ". r r ",

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 84f18a533a9292b01bb440f5bbdd37083fa5f0b8..2c4c47816c828e46d0eabb232475ebc06d7d7d04 100644 (file)
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -1025,653 +1025,6 @@ gfc_conv_intrinsic_exponent (gfc_se *se, gfc_expr *expr)
 }
 
 
-/* Fill in the following structure
-     struct caf_vector_t {
-       size_t nvec;  // size of the vector
-       union {
-         struct {
-           void *vector;
-           int kind;
-         } v;
-         struct {
-           ptrdiff_t lower_bound;
-           ptrdiff_t upper_bound;
-           ptrdiff_t stride;
-         } triplet;
-       } u;
-     }  */
-
-// static void
-// conv_caf_vector_subscript_elem (stmtblock_t *block, int i, tree desc,
-//                             tree lower, tree upper, tree stride,
-//                             tree vector, int kind, tree nvec)
-// {
-//   tree field, type, tmp;
-
-//   desc = gfc_build_array_ref (desc, gfc_rank_cst[i], NULL_TREE);
-//   type = TREE_TYPE (desc);
-
-//   field = gfc_advance_chain (TYPE_FIELDS (type), 0);
-//   tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
-//                      desc, field, NULL_TREE);
-//   gfc_add_modify (block, tmp, fold_convert (TREE_TYPE (field), nvec));
-
-//   /* Access union.  */
-//   field = gfc_advance_chain (TYPE_FIELDS (type), 1);
-//   desc = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
-//                       desc, field, NULL_TREE);
-//   type = TREE_TYPE (desc);
-
-//   /* Access the inner struct.  */
-//   field = gfc_advance_chain (TYPE_FIELDS (type), vector != NULL_TREE ? 0 :
-//   1); desc = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE
-//   (field),
-//                   desc, field, NULL_TREE);
-//   type = TREE_TYPE (desc);
-
-//   if (vector != NULL_TREE)
-//     {
-//       /* Set vector and kind.  */
-//       field = gfc_advance_chain (TYPE_FIELDS (type), 0);
-//       tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE
-//       (field),
-//                      desc, field, NULL_TREE);
-//       gfc_add_modify (block, tmp, fold_convert (TREE_TYPE (field), vector));
-//       field = gfc_advance_chain (TYPE_FIELDS (type), 1);
-//       tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE
-//       (field),
-//                      desc, field, NULL_TREE);
-//       gfc_add_modify (block, tmp, build_int_cst (integer_type_node, kind));
-//     }
-//   else
-//     {
-//       /* Set dim.lower/upper/stride.  */
-//       field = gfc_advance_chain (TYPE_FIELDS (type), 0);
-//       tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE
-//       (field),
-//                          desc, field, NULL_TREE);
-//       gfc_add_modify (block, tmp, fold_convert (TREE_TYPE (field), lower));
-
-//       field = gfc_advance_chain (TYPE_FIELDS (type), 1);
-//       tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE
-//       (field),
-//                          desc, field, NULL_TREE);
-//       gfc_add_modify (block, tmp, fold_convert (TREE_TYPE (field), upper));
-
-//       field = gfc_advance_chain (TYPE_FIELDS (type), 2);
-//       tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE
-//       (field),
-//                          desc, field, NULL_TREE);
-//       gfc_add_modify (block, tmp, fold_convert (TREE_TYPE (field), stride));
-//     }
-// }
-
-// static tree
-// conv_caf_vector_subscript (stmtblock_t *block, tree desc, gfc_array_ref *ar)
-// {
-//   gfc_se argse;
-//   tree var, lower, upper = NULL_TREE, stride = NULL_TREE, vector, nvec;
-//   tree lbound, ubound, tmp;
-//   int i;
-
-//   var = gfc_create_var (gfc_get_caf_vector_type (ar->dimen), "vector");
-
-//   for (i = 0; i < ar->dimen; i++)
-//     switch (ar->dimen_type[i])
-//       {
-//       case DIMEN_RANGE:
-//         if (ar->end[i])
-//       {
-//         gfc_init_se (&argse, NULL);
-//         gfc_conv_expr (&argse, ar->end[i]);
-//         gfc_add_block_to_block (block, &argse.pre);
-//         upper = gfc_evaluate_now (argse.expr, block);
-//       }
-//         else
-//       upper = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[i]);
-//     if (ar->stride[i])
-//       {
-//         gfc_init_se (&argse, NULL);
-//         gfc_conv_expr (&argse, ar->stride[i]);
-//         gfc_add_block_to_block (block, &argse.pre);
-//         stride = gfc_evaluate_now (argse.expr, block);
-//       }
-//     else
-//       stride = gfc_index_one_node;
-
-//     /* Fall through.  */
-//       case DIMEN_ELEMENT:
-//     if (ar->start[i])
-//       {
-//         gfc_init_se (&argse, NULL);
-//         gfc_conv_expr (&argse, ar->start[i]);
-//         gfc_add_block_to_block (block, &argse.pre);
-//         lower = gfc_evaluate_now (argse.expr, block);
-//       }
-//     else
-//       lower = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[i]);
-//     if (ar->dimen_type[i] == DIMEN_ELEMENT)
-//       {
-//         upper = lower;
-//         stride = gfc_index_one_node;
-//       }
-//     vector = NULL_TREE;
-//     nvec = size_zero_node;
-//     conv_caf_vector_subscript_elem (block, i, var, lower, upper, stride,
-//                                     vector, 0, nvec);
-//     break;
-
-//       case DIMEN_VECTOR:
-//     gfc_init_se (&argse, NULL);
-//     argse.descriptor_only = 1;
-//     gfc_conv_expr_descriptor (&argse, ar->start[i]);
-//     gfc_add_block_to_block (block, &argse.pre);
-//     vector = argse.expr;
-//     lbound = gfc_conv_descriptor_lbound_get (vector, gfc_rank_cst[0]);
-//     ubound = gfc_conv_descriptor_ubound_get (vector, gfc_rank_cst[0]);
-//     nvec = gfc_conv_array_extent_dim (lbound, ubound, NULL);
-//         tmp = gfc_conv_descriptor_stride_get (vector, gfc_rank_cst[0]);
-//     nvec = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
-//                             TREE_TYPE (nvec), nvec, tmp);
-//     lower = gfc_index_zero_node;
-//     upper = gfc_index_zero_node;
-//     stride = gfc_index_zero_node;
-//     vector = gfc_conv_descriptor_data_get (vector);
-//     conv_caf_vector_subscript_elem (block, i, var, lower, upper, stride,
-//                                     vector, ar->start[i]->ts.kind, nvec);
-//     break;
-//       default:
-//     gcc_unreachable();
-//     }
-//   return gfc_build_addr_expr (NULL_TREE, var);
-// }
-
-// static tree
-// compute_component_offset (tree field, tree type)
-// {
-//   tree tmp;
-//   if (DECL_FIELD_BIT_OFFSET (field) != NULL_TREE
-//       && !integer_zerop (DECL_FIELD_BIT_OFFSET (field)))
-//     {
-//       tmp = fold_build2 (TRUNC_DIV_EXPR, type,
-//                      DECL_FIELD_BIT_OFFSET (field),
-//                      bitsize_unit_node);
-//       return fold_build2 (PLUS_EXPR, type, DECL_FIELD_OFFSET (field), tmp);
-//     }
-//   else
-//     return DECL_FIELD_OFFSET (field);
-// }
-
-// static tree
-// conv_expr_ref_to_caf_ref (stmtblock_t *block, gfc_expr *expr)
-// {
-//   gfc_ref *ref = expr->ref, *last_comp_ref;
-//   tree caf_ref = NULL_TREE, prev_caf_ref = NULL_TREE, reference_type, tmp,
-//   tmp2,
-//       field, last_type, inner_struct, mode, mode_rhs, dim_array, dim,
-//       dim_type, start, end, stride, vector, nvec;
-//   gfc_se se;
-//   bool ref_static_array = false;
-//   tree last_component_ref_tree = NULL_TREE;
-//   int i, last_type_n;
-
-//   if (expr->symtree)
-//     {
-//       last_component_ref_tree = expr->symtree->n.sym->backend_decl;
-//       ref_static_array = !expr->symtree->n.sym->attr.allocatable
-//       && !expr->symtree->n.sym->attr.pointer;
-//     }
-
-//   /* Prevent uninit-warning.  */
-//   reference_type = NULL_TREE;
-
-//   /* Skip refs upto the first coarray-ref.  */
-//   last_comp_ref = NULL;
-//   while (ref && (ref->type != REF_ARRAY || ref->u.ar.codimen == 0))
-//     {
-//       /* Remember the type of components skipped.  */
-//       if (ref->type == REF_COMPONENT)
-//     last_comp_ref = ref;
-//       ref = ref->next;
-//     }
-//   /* When a component was skipped, get the type information of the last
-//      component ref, else get the type from the symbol.  */
-//   if (last_comp_ref)
-//     {
-//       last_type = gfc_typenode_for_spec (&last_comp_ref->u.c.component->ts);
-//       last_type_n = last_comp_ref->u.c.component->ts.type;
-//     }
-//   else
-//     {
-//       last_type = gfc_typenode_for_spec (&expr->symtree->n.sym->ts);
-//       last_type_n = expr->symtree->n.sym->ts.type;
-//     }
-
-//   while (ref)
-//     {
-//       if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0
-//       && ref->u.ar.dimen == 0)
-//     {
-//       /* Skip pure coindexes.  */
-//       ref = ref->next;
-//       continue;
-//     }
-//       tmp = gfc_create_var (gfc_get_caf_reference_type (), "caf_ref");
-//       reference_type = TREE_TYPE (tmp);
-
-//       if (caf_ref == NULL_TREE)
-//     caf_ref = tmp;
-
-//       /* Construct the chain of refs.  */
-//       if (prev_caf_ref != NULL_TREE)
-//     {
-//       field = gfc_advance_chain (TYPE_FIELDS (reference_type), 0);
-//       tmp2 = fold_build3_loc (input_location, COMPONENT_REF,
-//                               TREE_TYPE (field), prev_caf_ref, field,
-//                               NULL_TREE);
-//       gfc_add_modify (block, tmp2, gfc_build_addr_expr (TREE_TYPE (field),
-//                                                         tmp));
-//     }
-//       prev_caf_ref = tmp;
-
-//       switch (ref->type)
-//     {
-//     case REF_COMPONENT:
-//       last_type = gfc_typenode_for_spec (&ref->u.c.component->ts);
-//       last_type_n = ref->u.c.component->ts.type;
-//       /* Set the type of the ref.  */
-//       field = gfc_advance_chain (TYPE_FIELDS (reference_type), 1);
-//       tmp = fold_build3_loc (input_location, COMPONENT_REF,
-//                              TREE_TYPE (field), prev_caf_ref, field,
-//                              NULL_TREE);
-//       gfc_add_modify (block, tmp, build_int_cst (integer_type_node,
-//                                                  GFC_CAF_REF_COMPONENT));
-
-//       /* Ref the c in union u.  */
-//       field = gfc_advance_chain (TYPE_FIELDS (reference_type), 3);
-//       tmp = fold_build3_loc (input_location, COMPONENT_REF,
-//                              TREE_TYPE (field), prev_caf_ref, field,
-//                              NULL_TREE);
-//       field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (field)), 0);
-//       inner_struct = fold_build3_loc (input_location, COMPONENT_REF,
-//                                    TREE_TYPE (field), tmp, field,
-//                                    NULL_TREE);
-
-//       /* Set the offset.  */
-//       field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (inner_struct)), 0);
-//       tmp = fold_build3_loc (input_location, COMPONENT_REF,
-//                              TREE_TYPE (field), inner_struct, field,
-//                              NULL_TREE);
-//       /* Computing the offset is somewhat harder.  The bit_offset has to be
-//          taken into account.  When the bit_offset in the field_decl is non-
-//          null, divide it by the bitsize_unit and add it to the regular
-//          offset.  */
-//       tmp2 = compute_component_offset (ref->u.c.component->backend_decl,
-//                                        TREE_TYPE (tmp));
-//       gfc_add_modify (block, tmp, fold_convert (TREE_TYPE (tmp), tmp2));
-
-//       /* Set caf_token_offset.  */
-//       field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (inner_struct)), 1);
-//       tmp = fold_build3_loc (input_location, COMPONENT_REF,
-//                              TREE_TYPE (field), inner_struct, field,
-//                              NULL_TREE);
-//       if ((ref->u.c.component->attr.allocatable
-//            || ref->u.c.component->attr.pointer)
-//           && ref->u.c.component->attr.dimension)
-//         {
-//           tree arr_desc_token_offset;
-//           /* Get the token field from the descriptor.  */
-//           arr_desc_token_offset = TREE_OPERAND (
-//                 gfc_conv_descriptor_token
-// (ref->u.c.component->backend_decl), 1);           arr_desc_token_offset
-// = compute_component_offset (arr_desc_token_offset,
-// TREE_TYPE (tmp));         tmp2 = fold_build2_loc (input_location, PLUS_EXPR,
-// TREE_TYPE (tmp2), tmp2,                                   arr_desc_token_offset);
-//         }
-//       else if (ref->u.c.component->caf_token)
-//         tmp2 = compute_component_offset (gfc_comp_caf_token (
-//                                            ref->u.c.component),
-//                                          TREE_TYPE (tmp));
-//       else
-//         tmp2 = integer_zero_node;
-//       gfc_add_modify (block, tmp, fold_convert (TREE_TYPE (tmp), tmp2));
-
-//       /* Remember whether this ref was to a non-allocatable/non-pointer
-//          component so the next array ref can be tailored correctly.  */
-//       ref_static_array = !ref->u.c.component->attr.allocatable
-//           && !ref->u.c.component->attr.pointer;
-//       last_component_ref_tree = ref_static_array
-//           ? ref->u.c.component->backend_decl : NULL_TREE;
-//       break;
-//     case REF_ARRAY:
-//       if (ref_static_array && ref->u.ar.as->type == AS_DEFERRED)
-//         ref_static_array = false;
-//       /* Set the type of the ref.  */
-//       field = gfc_advance_chain (TYPE_FIELDS (reference_type), 1);
-//       tmp = fold_build3_loc (input_location, COMPONENT_REF,
-//                              TREE_TYPE (field), prev_caf_ref, field,
-//                              NULL_TREE);
-//       gfc_add_modify (block, tmp, build_int_cst (integer_type_node,
-//                                                  ref_static_array
-//                                                  ? GFC_CAF_REF_STATIC_ARRAY
-//                                                  : GFC_CAF_REF_ARRAY));
-
-//       /* Ref the a in union u.  */
-//       field = gfc_advance_chain (TYPE_FIELDS (reference_type), 3);
-//       tmp = fold_build3_loc (input_location, COMPONENT_REF,
-//                              TREE_TYPE (field), prev_caf_ref, field,
-//                              NULL_TREE);
-//       field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (field)), 1);
-//       inner_struct = fold_build3_loc (input_location, COMPONENT_REF,
-//                                    TREE_TYPE (field), tmp, field,
-//                                    NULL_TREE);
-
-//       /* Set the static_array_type in a for static arrays.  */
-//       if (ref_static_array)
-//         {
-//           field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (inner_struct)),
-//                                      1);
-//           tmp = fold_build3_loc (input_location, COMPONENT_REF,
-//                                  TREE_TYPE (field), inner_struct, field,
-//                                  NULL_TREE);
-//           gfc_add_modify (block, tmp, build_int_cst (TREE_TYPE (tmp),
-//                                                      last_type_n));
-//         }
-//       /* Ref the mode in the inner_struct.  */
-//       field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (inner_struct)), 0);
-//       mode = fold_build3_loc (input_location, COMPONENT_REF,
-//                               TREE_TYPE (field), inner_struct, field,
-//                               NULL_TREE);
-//       /* Ref the dim in the inner_struct.  */
-//       field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (inner_struct)), 2);
-//       dim_array = fold_build3_loc (input_location, COMPONENT_REF,
-//                                    TREE_TYPE (field), inner_struct, field,
-//                                    NULL_TREE);
-//       for (i = 0; i < ref->u.ar.dimen; ++i)
-//         {
-//           /* Ref dim i.  */
-//           dim = gfc_build_array_ref (dim_array, gfc_rank_cst[i], NULL_TREE);
-//           dim_type = TREE_TYPE (dim);
-//           mode_rhs = start = end = stride = NULL_TREE;
-//           switch (ref->u.ar.dimen_type[i])
-//             {
-//             case DIMEN_RANGE:
-//               if (ref->u.ar.end[i])
-//                 {
-//                   gfc_init_se (&se, NULL);
-//                   gfc_conv_expr (&se, ref->u.ar.end[i]);
-//                   gfc_add_block_to_block (block, &se.pre);
-//                   if (ref_static_array)
-//                     {
-//                       /* Make the index zero-based, when reffing a static
-//                          array.  */
-//                       end = se.expr;
-//                       gfc_init_se (&se, NULL);
-//                       gfc_conv_expr (&se, ref->u.ar.as->lower[i]);
-//                       gfc_add_block_to_block (block, &se.pre);
-//                       se.expr = fold_build2 (MINUS_EXPR,
-//                                              gfc_array_index_type,
-//                                              end, fold_convert (
-//                                                gfc_array_index_type,
-//                                                se.expr));
-//                     }
-//                   end = gfc_evaluate_now (fold_convert (
-//                                             gfc_array_index_type,
-//                                             se.expr),
-//                                           block);
-//                 }
-//               else if (ref_static_array)
-//                 end = fold_build2 (MINUS_EXPR,
-//                                    gfc_array_index_type,
-//                                    gfc_conv_array_ubound (
-//                                      last_component_ref_tree, i),
-//                                    gfc_conv_array_lbound (
-//                                      last_component_ref_tree, i));
-//               else
-//                 {
-//                   end = NULL_TREE;
-//                   mode_rhs = build_int_cst (unsigned_char_type_node,
-//                                             GFC_CAF_ARR_REF_OPEN_END);
-//                 }
-//               if (ref->u.ar.stride[i])
-//                 {
-//                   gfc_init_se (&se, NULL);
-//                   gfc_conv_expr (&se, ref->u.ar.stride[i]);
-//                   gfc_add_block_to_block (block, &se.pre);
-//                   stride = gfc_evaluate_now (fold_convert (
-//                                                gfc_array_index_type,
-//                                                se.expr),
-//                                              block);
-//                   if (ref_static_array)
-//                     {
-//                       /* Make the index zero-based, when reffing a static
-//                          array.  */
-//                       stride = fold_build2 (MULT_EXPR,
-//                                             gfc_array_index_type,
-//                                             gfc_conv_array_stride (
-//                                               last_component_ref_tree,
-//                                               i),
-//                                             stride);
-//                       gcc_assert (end != NULL_TREE);
-//                       /* Multiply with the product of array's stride and
-//                          the step of the ref to a virtual upper bound.
-//                          We cannot compute the actual upper bound here or
-//                          the caflib would compute the extend
-//                          incorrectly.  */
-//                       end = fold_build2 (MULT_EXPR, gfc_array_index_type,
-//                                          end, gfc_conv_array_stride (
-//                                            last_component_ref_tree,
-//                                            i));
-//                       end = gfc_evaluate_now (end, block);
-//                       stride = gfc_evaluate_now (stride, block);
-//                     }
-//                 }
-//               else if (ref_static_array)
-//                 {
-//                   stride = gfc_conv_array_stride (last_component_ref_tree,
-//                                                   i);
-//                   end = fold_build2 (MULT_EXPR, gfc_array_index_type,
-//                                      end, stride);
-//                   end = gfc_evaluate_now (end, block);
-//                 }
-//               else
-//                 /* Always set a ref stride of one to make caflib's
-//                    handling easier.  */
-//                 stride = gfc_index_one_node;
-
-//               /* Fall through.  */
-//             case DIMEN_ELEMENT:
-//               if (ref->u.ar.start[i])
-//                 {
-//                   gfc_init_se (&se, NULL);
-//                   gfc_conv_expr (&se, ref->u.ar.start[i]);
-//                   gfc_add_block_to_block (block, &se.pre);
-//                   if (ref_static_array)
-//                     {
-//                       /* Make the index zero-based, when reffing a static
-//                          array.  */
-//                       start = fold_convert (gfc_array_index_type, se.expr);
-//                       gfc_init_se (&se, NULL);
-//                       gfc_conv_expr (&se, ref->u.ar.as->lower[i]);
-//                       gfc_add_block_to_block (block, &se.pre);
-//                       se.expr = fold_build2 (MINUS_EXPR,
-//                                              gfc_array_index_type,
-//                                              start, fold_convert (
-//                                                gfc_array_index_type,
-//                                                se.expr));
-//                       /* Multiply with the stride.  */
-//                       se.expr = fold_build2 (MULT_EXPR,
-//                                              gfc_array_index_type,
-//                                              se.expr,
-//                                              gfc_conv_array_stride (
-//                                                last_component_ref_tree,
-//                                                i));
-//                     }
-//                   start = gfc_evaluate_now (fold_convert (
-//                                               gfc_array_index_type,
-//                                               se.expr),
-//                                             block);
-//                   if (mode_rhs == NULL_TREE)
-//                     mode_rhs = build_int_cst (unsigned_char_type_node,
-//                                               ref->u.ar.dimen_type[i]
-//                                               == DIMEN_ELEMENT
-//                                               ? GFC_CAF_ARR_REF_SINGLE
-//                                               : GFC_CAF_ARR_REF_RANGE);
-//                 }
-//               else if (ref_static_array)
-//                 {
-//                   start = integer_zero_node;
-//                   mode_rhs = build_int_cst (unsigned_char_type_node,
-//                                             ref->u.ar.start[i] == NULL
-//                                             ? GFC_CAF_ARR_REF_FULL
-//                                             : GFC_CAF_ARR_REF_RANGE);
-//                 }
-//               else if (end == NULL_TREE)
-//                 mode_rhs = build_int_cst (unsigned_char_type_node,
-//                                           GFC_CAF_ARR_REF_FULL);
-//               else
-//                 mode_rhs = build_int_cst (unsigned_char_type_node,
-//                                           GFC_CAF_ARR_REF_OPEN_START);
-
-//               /* Ref the s in dim.  */
-//               field = gfc_advance_chain (TYPE_FIELDS (dim_type), 0);
-//               tmp = fold_build3_loc (input_location, COMPONENT_REF,
-//                                      TREE_TYPE (field), dim, field,
-//                                      NULL_TREE);
-
-//               /* Set start in s.  */
-//               if (start != NULL_TREE)
-//                 {
-//                   field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)),
-//                                              0);
-//                   tmp2 = fold_build3_loc (input_location, COMPONENT_REF,
-//                                           TREE_TYPE (field), tmp, field,
-//                                           NULL_TREE);
-//                   gfc_add_modify (block, tmp2,
-//                                   fold_convert (TREE_TYPE (tmp2), start));
-//                 }
-
-//               /* Set end in s.  */
-//               if (end != NULL_TREE)
-//                 {
-//                   field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)),
-//                                              1);
-//                   tmp2 = fold_build3_loc (input_location, COMPONENT_REF,
-//                                           TREE_TYPE (field), tmp, field,
-//                                           NULL_TREE);
-//                   gfc_add_modify (block, tmp2,
-//                                   fold_convert (TREE_TYPE (tmp2), end));
-//                 }
-
-//               /* Set end in s.  */
-//               if (stride != NULL_TREE)
-//                 {
-//                   field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)),
-//                                              2);
-//                   tmp2 = fold_build3_loc (input_location, COMPONENT_REF,
-//                                           TREE_TYPE (field), tmp, field,
-//                                           NULL_TREE);
-//                   gfc_add_modify (block, tmp2,
-//                                   fold_convert (TREE_TYPE (tmp2), stride));
-//                 }
-//               break;
-//             case DIMEN_VECTOR:
-//               /* TODO: In case of static array.  */
-//               gcc_assert (!ref_static_array);
-//               mode_rhs = build_int_cst (unsigned_char_type_node,
-//                                         GFC_CAF_ARR_REF_VECTOR);
-//               gfc_init_se (&se, NULL);
-//               se.descriptor_only = 1;
-//               gfc_conv_expr_descriptor (&se, ref->u.ar.start[i]);
-//               gfc_add_block_to_block (block, &se.pre);
-//               vector = se.expr;
-//               tmp = gfc_conv_descriptor_lbound_get (vector,
-//                                                     gfc_rank_cst[0]);
-//               tmp2 = gfc_conv_descriptor_ubound_get (vector,
-//                                                      gfc_rank_cst[0]);
-//               nvec = gfc_conv_array_extent_dim (tmp, tmp2, NULL);
-//               tmp = gfc_conv_descriptor_stride_get (vector,
-//                                                     gfc_rank_cst[0]);
-//               nvec = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
-//                                       TREE_TYPE (nvec), nvec, tmp);
-//               vector = gfc_conv_descriptor_data_get (vector);
-
-//               /* Ref the v in dim.  */
-//               field = gfc_advance_chain (TYPE_FIELDS (dim_type), 1);
-//               tmp = fold_build3_loc (input_location, COMPONENT_REF,
-//                                      TREE_TYPE (field), dim, field,
-//                                      NULL_TREE);
-
-//               /* Set vector in v.  */
-//               field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), 0);
-//               tmp2 = fold_build3_loc (input_location, COMPONENT_REF,
-//                                       TREE_TYPE (field), tmp, field,
-//                                       NULL_TREE);
-//               gfc_add_modify (block, tmp2, fold_convert (TREE_TYPE (tmp2),
-//                                                          vector));
-
-//               /* Set nvec in v.  */
-//               field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), 1);
-//               tmp2 = fold_build3_loc (input_location, COMPONENT_REF,
-//                                       TREE_TYPE (field), tmp, field,
-//                                       NULL_TREE);
-//               gfc_add_modify (block, tmp2, fold_convert (TREE_TYPE (tmp2),
-//                                                          nvec));
-
-//               /* Set kind in v.  */
-//               field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), 2);
-//               tmp2 = fold_build3_loc (input_location, COMPONENT_REF,
-//                                       TREE_TYPE (field), tmp, field,
-//                                       NULL_TREE);
-//               gfc_add_modify (block, tmp2, build_int_cst (integer_type_node,
-//                                               ref->u.ar.start[i]->ts.kind));
-//               break;
-//             default:
-//               gcc_unreachable ();
-//             }
-//           /* Set the mode for dim i.  */
-//           tmp = gfc_build_array_ref (mode, gfc_rank_cst[i], NULL_TREE);
-//           gfc_add_modify (block, tmp, fold_convert (TREE_TYPE (tmp),
-//                                                     mode_rhs));
-//         }
-
-//       /* Set the mode for dim i+1 to GFC_ARR_REF_NONE.  */
-//       if (i < GFC_MAX_DIMENSIONS)
-//         {
-//           tmp = gfc_build_array_ref (mode, gfc_rank_cst[i], NULL_TREE);
-//           gfc_add_modify (block, tmp,
-//                           build_int_cst (unsigned_char_type_node,
-//                                          GFC_CAF_ARR_REF_NONE));
-//         }
-//       break;
-//     default:
-//       gcc_unreachable ();
-//     }
-
-//       /* Set the size of the current type.  */
-//       field = gfc_advance_chain (TYPE_FIELDS (reference_type), 2);
-//       tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE
-//       (field),
-//                          prev_caf_ref, field, NULL_TREE);
-//       gfc_add_modify (block, tmp, fold_convert (TREE_TYPE (field),
-//                                             TYPE_SIZE_UNIT (last_type)));
-
-//       ref = ref->next;
-//     }
-
-//   if (prev_caf_ref != NULL_TREE)
-//     {
-//       field = gfc_advance_chain (TYPE_FIELDS (reference_type), 0);
-//       tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE
-//       (field),
-//                          prev_caf_ref, field, NULL_TREE);
-//       gfc_add_modify (block, tmp, fold_convert (TREE_TYPE (field),
-//                                               null_pointer_node));
-//     }
-//   return caf_ref != NULL_TREE ? gfc_build_addr_expr (NULL_TREE, caf_ref)
-//                           : NULL_TREE;
-// }
-
 static int caf_call_cnt = 0;
 
 static tree
@@ -2202,15 +1555,6 @@ conv_caf_send_to_remote (gfc_code *code)
   return gfc_finish_block (&block);
 }
 
-// static bool
-// has_ref_after_cafref (gfc_expr *expr)
-// {
-//   for (gfc_ref *ref = expr->ref; ref; ref = ref->next)
-//     if (ref->type == REF_ARRAY && ref->u.ar.codimen)
-//       return ref->next;
-//   return false;
-// }
-
 /* Send-get data to a remote coarray.  */
 
 static tree
@@ -2436,450 +1780,6 @@ conv_caf_sendget (gfc_code *code)
   return gfc_finish_block (&block);
 }
 
-// static tree
-// conv_caf_sendget (gfc_code *code)
-// {
-//   gfc_expr *lhs_expr, *rhs_expr, *tmp_stat, *tmp_team;
-//   gfc_se lhs_se, rhs_se;
-//   stmtblock_t block;
-//   tree caf_decl, token, offset, image_index, tmp, lhs_kind, rhs_kind;
-//   tree may_require_tmp, src_stat, dst_stat, dst_team;
-//   tree lhs_type = NULL_TREE;
-//   tree vec = null_pointer_node, rhs_vec = null_pointer_node;
-//   symbol_attribute lhs_caf_attr, rhs_caf_attr;
-//   bool lhs_is_coindexed, rhs_is_coindexed;
-
-//   gcc_assert (flag_coarray == GFC_FCOARRAY_LIB);
-
-//   lhs_expr
-//     = code->ext.actual->expr->expr_type == EXPR_FUNCTION
-//       && code->ext.actual->expr->value.function.isym->id == GFC_ISYM_CAF_GET
-//     ? code->ext.actual->expr->value.function.actual->expr
-//     : code->ext.actual->expr;
-//   rhs_expr = code->ext.actual->next->expr->expr_type == EXPR_FUNCTION
-//              && code->ext.actual->next->expr->value.function.isym->id
-//                   == GFC_ISYM_CAF_GET
-//            ? code->ext.actual->next->expr->value.function.actual->expr
-//            : code->ext.actual->next->expr;
-//   lhs_is_coindexed = gfc_is_coindexed (lhs_expr);
-//   rhs_is_coindexed = gfc_is_coindexed (rhs_expr);
-//   may_require_tmp = gfc_check_dependency (lhs_expr, rhs_expr, true) == 0
-//                 ? boolean_false_node : boolean_true_node;
-//   gfc_init_block (&block);
-
-//   lhs_caf_attr = gfc_caf_attr (lhs_expr);
-//   rhs_caf_attr = gfc_caf_attr (rhs_expr);
-//   src_stat = dst_stat = null_pointer_node;
-//   dst_team = null_pointer_node;
-
-//   /* LHS.  */
-//   gfc_init_se (&lhs_se, NULL);
-//   if (lhs_expr->rank == 0)
-//     {
-//       if (lhs_expr->ts.type == BT_CHARACTER && lhs_expr->ts.deferred)
-//     {
-//       lhs_se.expr = gfc_get_tree_for_caf_expr (lhs_expr);
-//       if (!POINTER_TYPE_P (TREE_TYPE (lhs_se.expr)))
-//         lhs_se.expr = gfc_build_addr_expr (NULL_TREE, lhs_se.expr);
-//     }
-//       else
-//     {
-//       symbol_attribute attr;
-//       gfc_clear_attr (&attr);
-//       gfc_conv_expr (&lhs_se, lhs_expr);
-//       lhs_type = TREE_TYPE (lhs_se.expr);
-//       if (lhs_is_coindexed)
-//         lhs_se.expr = gfc_conv_scalar_to_descriptor (&lhs_se, lhs_se.expr,
-//                                                      attr);
-//       lhs_se.expr = gfc_build_addr_expr (NULL_TREE, lhs_se.expr);
-//     }
-//     }
-//   else if ((lhs_caf_attr.alloc_comp || lhs_caf_attr.pointer_comp)
-//        && lhs_caf_attr.codimension)
-//     {
-//       lhs_se.want_pointer = 1;
-//       gfc_conv_expr_descriptor (&lhs_se, lhs_expr);
-//       /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that
-//      has the wrong type if component references are done.  */
-//       lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
-//       tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr);
-//       gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp),
-//                   gfc_get_dtype_rank_type (
-//                     gfc_has_vector_subscript (lhs_expr)
-//                     ? gfc_find_array_ref (lhs_expr)->dimen
-//                     : lhs_expr->rank,
-//                   lhs_type));
-//     }
-//   else
-//     {
-//       bool has_vector = gfc_has_vector_subscript (lhs_expr);
-
-//       if (lhs_is_coindexed || !has_vector)
-//     {
-//       /* If has_vector, pass descriptor for whole array and the
-//          vector bounds separately.  */
-//       gfc_array_ref *ar, ar2;
-//       bool has_tmp_lhs_array = false;
-//       if (has_vector)
-//         {
-//           has_tmp_lhs_array = true;
-//           ar = gfc_find_array_ref (lhs_expr);
-//           ar2 = *ar;
-//           memset (ar, '\0', sizeof (*ar));
-//           ar->as = ar2.as;
-//           ar->type = AR_FULL;
-//         }
-//       lhs_se.want_pointer = 1;
-//       gfc_conv_expr_descriptor (&lhs_se, lhs_expr);
-//       /* Using gfc_conv_expr_descriptor, we only get the descriptor, but
-//          that has the wrong type if component references are done.  */
-//       lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
-//       tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr);
-//       gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp),
-//                       gfc_get_dtype_rank_type (has_vector ? ar2.dimen
-//                                                           : lhs_expr->rank,
-//                                                lhs_type));
-//       if (has_tmp_lhs_array)
-//         {
-//           vec = conv_caf_vector_subscript (&block, lhs_se.expr, &ar2);
-//           *ar = ar2;
-//         }
-//     }
-//       else if (rhs_is_coindexed)
-//     {
-//       /* Special casing for arr1 ([...]) = arr2[...], i.e. caf_get to
-//          indexed array expression.  This is rewritten to:
-
-//          tmp_array = arr2[...]
-//          arr1 ([...]) = tmp_array
-
-//          because using the standard gfc_conv_expr (lhs_expr) did the
-//          assignment with lhs and rhs exchanged.  */
-
-//       gfc_ss *lss_for_tmparray, *lss_real;
-//       gfc_loopinfo loop;
-//       gfc_se se;
-//       stmtblock_t body;
-//       tree tmparr_desc, src;
-//       tree index = gfc_index_zero_node;
-//       tree stride = gfc_index_zero_node;
-//       int n;
-
-//       /* Walk both sides of the assignment, once to get the shape of the
-//          temporary array to create right.  */
-//       lss_for_tmparray = gfc_walk_expr (lhs_expr);
-//       /* And a second time to be able to create an assignment of the
-//          temporary to the lhs_expr.  gfc_trans_create_temp_array replaces
-//          the tree in the descriptor with the one for the temporary
-//          array.  */
-//       lss_real = gfc_walk_expr (lhs_expr);
-//       gfc_init_loopinfo (&loop);
-//       gfc_add_ss_to_loop (&loop, lss_for_tmparray);
-//       gfc_add_ss_to_loop (&loop, lss_real);
-//       gfc_conv_ss_startstride (&loop);
-//       gfc_conv_loop_setup (&loop, &lhs_expr->where);
-//       lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
-//       gfc_trans_create_temp_array (&lhs_se.pre, &lhs_se.post,
-//                                    lss_for_tmparray, lhs_type, NULL_TREE,
-//                                    false, true, false,
-//                                    &lhs_expr->where);
-//       tmparr_desc = lss_for_tmparray->info->data.array.descriptor;
-//       gfc_start_scalarized_body (&loop, &body);
-//       gfc_init_se (&se, NULL);
-//       gfc_copy_loopinfo_to_se (&se, &loop);
-//       se.ss = lss_real;
-//       gfc_conv_expr (&se, lhs_expr);
-//       gfc_add_block_to_block (&body, &se.pre);
-
-//       /* Walk over all indexes of the loop.  */
-//       for (n = loop.dimen - 1; n > 0; --n)
-//         {
-//           tmp = loop.loopvar[n];
-//           tmp = fold_build2_loc (input_location, MINUS_EXPR,
-//                                  gfc_array_index_type, tmp, loop.from[n]);
-//           tmp = fold_build2_loc (input_location, PLUS_EXPR,
-//                                  gfc_array_index_type, tmp, index);
-
-//           stride = fold_build2_loc (input_location, MINUS_EXPR,
-//                                     gfc_array_index_type,
-//                                     loop.to[n - 1], loop.from[n - 1]);
-//           stride = fold_build2_loc (input_location, PLUS_EXPR,
-//                                     gfc_array_index_type,
-//                                     stride, gfc_index_one_node);
-
-//           index = fold_build2_loc (input_location, MULT_EXPR,
-//                                    gfc_array_index_type, tmp, stride);
-//         }
-
-//       index = fold_build2_loc (input_location, MINUS_EXPR,
-//                                gfc_array_index_type,
-//                                index, loop.from[0]);
-
-//       index = fold_build2_loc (input_location, PLUS_EXPR,
-//                                gfc_array_index_type,
-//                                loop.loopvar[0], index);
-
-//       src = build_fold_indirect_ref (gfc_conv_array_data (tmparr_desc));
-//       src = gfc_build_array_ref (src, index, NULL);
-//       /* Now create the assignment of lhs_expr = tmp_array.  */
-//       gfc_add_modify (&body, se.expr, src);
-//       gfc_add_block_to_block (&body, &se.post);
-//       lhs_se.expr = gfc_build_addr_expr (NULL_TREE, tmparr_desc);
-//       gfc_trans_scalarizing_loops (&loop, &body);
-//       gfc_add_block_to_block (&loop.pre, &loop.post);
-//       gfc_add_expr_to_block (&lhs_se.post, gfc_finish_block (&loop.pre));
-//       gfc_free_ss (lss_for_tmparray);
-//       gfc_free_ss (lss_real);
-//     }
-//     }
-
-//   lhs_kind = build_int_cst (integer_type_node, lhs_expr->ts.kind);
-
-//   /* Special case: RHS is a coarray but LHS is not; this code path avoids a
-//      temporary and a loop.  */
-//   if (!lhs_is_coindexed && rhs_is_coindexed
-//       && (!lhs_caf_attr.codimension
-//       || !(lhs_expr->rank > 0
-//            && (lhs_caf_attr.allocatable || lhs_caf_attr.pointer))))
-//     {
-//       bool lhs_may_realloc = lhs_expr->rank > 0 && lhs_caf_attr.allocatable;
-//       gfc_init_se (&rhs_se, NULL);
-//       if (lhs_expr->rank == 0 && lhs_caf_attr.allocatable)
-//     {
-//       gfc_se scal_se;
-//       gfc_init_se (&scal_se, NULL);
-//       scal_se.want_pointer = 1;
-//       gfc_conv_expr (&scal_se, lhs_expr);
-//       /* Ensure scalar on lhs is allocated.  */
-//       gfc_add_block_to_block (&block, &scal_se.pre);
-
-//       gfc_allocate_using_malloc (&scal_se.pre, scal_se.expr,
-//                                 TYPE_SIZE_UNIT (
-//                                    gfc_typenode_for_spec (&lhs_expr->ts)),
-//                                 NULL_TREE);
-//       tmp = fold_build2 (EQ_EXPR, logical_type_node, scal_se.expr,
-//                          null_pointer_node);
-//       tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
-//                              tmp, gfc_finish_block (&scal_se.pre),
-//                              build_empty_stmt (input_location));
-//       gfc_add_expr_to_block (&block, tmp);
-//     }
-//       else
-//     lhs_may_realloc = lhs_may_realloc
-//         && gfc_full_array_ref_p (lhs_expr->ref, NULL);
-//       gfc_add_block_to_block (&block, &lhs_se.pre);
-//       gfc_conv_intrinsic_caf_get (&rhs_se, code->ext.actual->next->expr,
-//                               lhs_se.expr, lhs_may_realloc, &rhs_caf_attr);
-//       gfc_add_block_to_block (&block, &rhs_se.pre);
-//       gfc_add_block_to_block (&block, &rhs_se.post);
-//       gfc_add_block_to_block (&block, &lhs_se.post);
-//       return gfc_finish_block (&block);
-//     }
-
-//   gfc_add_block_to_block (&block, &lhs_se.pre);
-
-//   /* Obtain token, offset and image index for the LHS.  */
-//   caf_decl = gfc_get_tree_for_caf_expr (lhs_expr);
-//   if (TREE_CODE (TREE_TYPE (caf_decl)) == REFERENCE_TYPE)
-//     caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl);
-//   image_index = gfc_caf_get_image_index (&block, lhs_expr, caf_decl);
-//   tmp = lhs_se.expr;
-//   if (lhs_caf_attr.alloc_comp)
-//     gfc_get_caf_token_offset (&lhs_se, &token, NULL, caf_decl, NULL_TREE,
-//                           NULL);
-//   else
-//     gfc_get_caf_token_offset (&lhs_se, &token, &offset, caf_decl, tmp,
-//                           lhs_expr);
-//   lhs_se.expr = tmp;
-
-//   /* RHS.  */
-//   gfc_init_se (&rhs_se, NULL);
-//   if (rhs_expr->expr_type == EXPR_FUNCTION && rhs_expr->value.function.isym
-//       && rhs_expr->value.function.isym->id == GFC_ISYM_CONVERSION)
-//     rhs_expr = rhs_expr->value.function.actual->expr;
-//   if (rhs_expr->rank == 0)
-//     {
-//       symbol_attribute attr;
-//       gfc_clear_attr (&attr);
-//       gfc_conv_expr (&rhs_se, rhs_expr);
-//       rhs_se.expr = gfc_conv_scalar_to_descriptor (&rhs_se, rhs_se.expr,
-//       attr); rhs_se.expr = gfc_build_addr_expr (NULL_TREE, rhs_se.expr);
-//     }
-//   else if ((rhs_caf_attr.alloc_comp || rhs_caf_attr.pointer_comp)
-//        && rhs_caf_attr.codimension)
-//     {
-//       tree tmp2;
-//       rhs_se.want_pointer = 1;
-//       gfc_conv_expr_descriptor (&rhs_se, rhs_expr);
-//       /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that
-//      has the wrong type if component references are done.  */
-//       tmp2 = gfc_typenode_for_spec (&rhs_expr->ts);
-//       tmp = build_fold_indirect_ref_loc (input_location, rhs_se.expr);
-//       gfc_add_modify (&rhs_se.pre, gfc_conv_descriptor_dtype (tmp),
-//                   gfc_get_dtype_rank_type (
-//                     gfc_has_vector_subscript (rhs_expr)
-//                     ? gfc_find_array_ref (rhs_expr)->dimen
-//                     : rhs_expr->rank,
-//                   tmp2));
-//     }
-//   else
-//     {
-//       /* If has_vector, pass descriptor for whole array and the
-//          vector bounds separately.  */
-//       gfc_array_ref *ar, ar2;
-//       bool has_vector = false;
-//       tree tmp2;
-
-//       if (rhs_is_coindexed && gfc_has_vector_subscript (rhs_expr))
-//     {
-//           has_vector = true;
-//           ar = gfc_find_array_ref (rhs_expr);
-//       ar2 = *ar;
-//       memset (ar, '\0', sizeof (*ar));
-//       ar->as = ar2.as;
-//       ar->type = AR_FULL;
-//     }
-//       rhs_se.want_pointer = 1;
-//       gfc_conv_expr_descriptor (&rhs_se, rhs_expr);
-//       /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that
-//          has the wrong type if component references are done.  */
-//       tmp = build_fold_indirect_ref_loc (input_location, rhs_se.expr);
-//       tmp2 = gfc_typenode_for_spec (&rhs_expr->ts);
-//       gfc_add_modify (&rhs_se.pre, gfc_conv_descriptor_dtype (tmp),
-//                       gfc_get_dtype_rank_type (has_vector ? ar2.dimen
-//                                                       : rhs_expr->rank,
-//                   tmp2));
-//       if (has_vector)
-//     {
-//       rhs_vec = conv_caf_vector_subscript (&block, rhs_se.expr, &ar2);
-//       *ar = ar2;
-//     }
-//     }
-
-//   gfc_add_block_to_block (&block, &rhs_se.pre);
-
-//   rhs_kind = build_int_cst (integer_type_node, rhs_expr->ts.kind);
-
-//   tmp_stat = gfc_find_stat_co (lhs_expr);
-
-//   if (tmp_stat)
-//     {
-//       gfc_se stat_se;
-//       gfc_init_se (&stat_se, NULL);
-//       gfc_conv_expr_reference (&stat_se, tmp_stat);
-//       dst_stat = stat_se.expr;
-//       gfc_add_block_to_block (&block, &stat_se.pre);
-//       gfc_add_block_to_block (&block, &stat_se.post);
-//     }
-
-//   tmp_team = gfc_find_team_co (lhs_expr);
-
-//   if (tmp_team)
-//     {
-//       gfc_se team_se;
-//       gfc_init_se (&team_se, NULL);
-//       gfc_conv_expr_reference (&team_se, tmp_team);
-//       dst_team = team_se.expr;
-//       gfc_add_block_to_block (&block, &team_se.pre);
-//       gfc_add_block_to_block (&block, &team_se.post);
-//     }
-
-//   if (!rhs_is_coindexed)
-//     {
-//       if (lhs_caf_attr.alloc_comp || lhs_caf_attr.pointer_comp
-//       || has_ref_after_cafref (lhs_expr))
-//     {
-//       tree reference, dst_realloc;
-//       reference = conv_expr_ref_to_caf_ref (&block, lhs_expr);
-//       dst_realloc
-//         = lhs_caf_attr.allocatable ? boolean_true_node : boolean_false_node;
-//       tmp = build_call_expr_loc (input_location,
-//                                  gfor_fndecl_caf_send_by_ref,
-//                                  10, token, image_index, rhs_se.expr,
-//                                  reference, lhs_kind, rhs_kind,
-//                                  may_require_tmp, dst_realloc, src_stat,
-//                                  build_int_cst (integer_type_node,
-//                                                 lhs_expr->ts.type));
-//     }
-//       else
-//     tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 11,
-//                                token, offset, image_index, lhs_se.expr, vec,
-//                                rhs_se.expr, lhs_kind, rhs_kind,
-//                                may_require_tmp, src_stat, dst_team);
-//     }
-//   else
-//     {
-//       tree rhs_token, rhs_offset, rhs_image_index;
-
-//       /* It guarantees memory consistency within the same segment.  */
-//       tmp = gfc_build_string_const (strlen ("memory") + 1, "memory");
-//       tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
-//                       gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE,
-//                       tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE);
-//       ASM_VOLATILE_P (tmp) = 1;
-//       gfc_add_expr_to_block (&block, tmp);
-
-//       caf_decl = gfc_get_tree_for_caf_expr (rhs_expr);
-//       if (TREE_CODE (TREE_TYPE (caf_decl)) == REFERENCE_TYPE)
-//     caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl);
-//       rhs_image_index = gfc_caf_get_image_index (&block, rhs_expr, caf_decl);
-//       tmp = rhs_se.expr;
-//       if (rhs_caf_attr.alloc_comp || rhs_caf_attr.pointer_comp
-//       || has_ref_after_cafref (lhs_expr))
-//     {
-//       tmp_stat = gfc_find_stat_co (lhs_expr);
-
-//       if (tmp_stat)
-//         {
-//           gfc_se stat_se;
-//           gfc_init_se (&stat_se, NULL);
-//           gfc_conv_expr_reference (&stat_se, tmp_stat);
-//           src_stat = stat_se.expr;
-//           gfc_add_block_to_block (&block, &stat_se.pre);
-//           gfc_add_block_to_block (&block, &stat_se.post);
-//         }
-
-//       gfc_get_caf_token_offset (&rhs_se, &rhs_token, NULL, caf_decl,
-//                                 NULL_TREE, NULL);
-//       tree lhs_reference, rhs_reference;
-//       lhs_reference = conv_expr_ref_to_caf_ref (&block, lhs_expr);
-//       rhs_reference = conv_expr_ref_to_caf_ref (&block, rhs_expr);
-//       tmp = build_call_expr_loc (input_location,
-//                                  gfor_fndecl_caf_sendget_by_ref, 13,
-//                                  token, image_index, lhs_reference,
-//                                  rhs_token, rhs_image_index, rhs_reference,
-//                                  lhs_kind, rhs_kind, may_require_tmp,
-//                                  dst_stat, src_stat,
-//                                  build_int_cst (integer_type_node,
-//                                                 lhs_expr->ts.type),
-//                                  build_int_cst (integer_type_node,
-//                                                 rhs_expr->ts.type));
-//     }
-//       else
-//     {
-//       gfc_get_caf_token_offset (&rhs_se, &rhs_token, &rhs_offset, caf_decl,
-//                                 tmp, rhs_expr);
-//       tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sendget,
-//                                  14, token, offset, image_index,
-//                                  lhs_se.expr, vec, rhs_token, rhs_offset,
-//                                  rhs_image_index, tmp, rhs_vec, lhs_kind,
-//                                  rhs_kind, may_require_tmp, src_stat);
-//     }
-//     }
-//   gfc_add_expr_to_block (&block, tmp);
-//   gfc_add_block_to_block (&block, &lhs_se.post);
-//   gfc_add_block_to_block (&block, &rhs_se.post);
-
-//   /* It guarantees memory consistency within the same segment.  */
-//   tmp = gfc_build_string_const (strlen ("memory") + 1, "memory");
-//   tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
-//                 gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE,
-//                 tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE);
-//   ASM_VOLATILE_P (tmp) = 1;
-//   gfc_add_expr_to_block (&block, tmp);
-
-//   return gfc_finish_block (&block);
-// }
 
 static void
 trans_this_image (gfc_se * se, gfc_expr *expr)

diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index fcb091a3cc6cdc473a8fd7b61b5dec4c711e9474..e22e0f18f6fba5b8b9d043a8f2b01fe3f24c212e 100644 (file)
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -883,22 +883,12 @@ extern GTY(()) tree gfor_fndecl_caf_this_image;
 extern GTY(()) tree gfor_fndecl_caf_num_images;
 extern GTY(()) tree gfor_fndecl_caf_register;
 extern GTY(()) tree gfor_fndecl_caf_deregister;
-
-// Deprecate start
-extern GTY(()) tree gfor_fndecl_caf_get;
-extern GTY(()) tree gfor_fndecl_caf_send;
-extern GTY(()) tree gfor_fndecl_caf_sendget;
-extern GTY(()) tree gfor_fndecl_caf_send_by_ref;
-extern GTY(()) tree gfor_fndecl_caf_sendget_by_ref;
-// Deprecate end
-
 extern GTY(()) tree gfor_fndecl_caf_register_accessor;
 extern GTY(()) tree gfor_fndecl_caf_register_accessors_finish;
 extern GTY(()) tree gfor_fndecl_caf_get_remote_function_index;
 extern GTY(()) tree gfor_fndecl_caf_get_from_remote;
 extern GTY(()) tree gfor_fndecl_caf_send_to_remote;
 extern GTY(()) tree gfor_fndecl_caf_transfer_between_remotes;
-
 extern GTY(()) tree gfor_fndecl_caf_sync_all;
 extern GTY(()) tree gfor_fndecl_caf_sync_memory;
 extern GTY(()) tree gfor_fndecl_caf_sync_images;

diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index ef3dacfd8e761380ceecf3cbd2050328ecc5db62..0b371d02a18bdfe0a3d7886dc24da465abe7fb26 100644 (file)
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -89,98 +89,6 @@ typedef struct caf_static_t {
 }
 caf_static_t;
 
-/* When there is a vector subscript in this dimension, nvec == 0, otherwise,
-   lower_bound, upper_bound, stride contains the bounds relative to the declared
-   bounds; kind denotes the integer kind of the elements of vector[].  */
-typedef struct caf_vector_t {
-  size_t nvec;
-  union {
-    struct {
-      void *vector;
-      int kind;
-    } v;
-    struct {
-      ptrdiff_t lower_bound, upper_bound, stride;
-    } triplet;
-  } u;
-}
-caf_vector_t;
-
-typedef enum caf_ref_type_t {
-  /* Reference a component of a derived type, either regular one or an
-     allocatable or pointer type.  For regular ones idx in caf_reference_t is
-     set to -1.  */
-  CAF_REF_COMPONENT,
-  /* Reference an allocatable array.  */
-  CAF_REF_ARRAY,
-  /* Reference a non-allocatable/non-pointer array.  */
-  CAF_REF_STATIC_ARRAY
-} caf_ref_type_t;
-
-typedef enum caf_array_ref_t {
-  /* No array ref.  This terminates the array ref.  */
-  CAF_ARR_REF_NONE = 0,
-  /* Reference array elements given by a vector.  Only for this mode
-     caf_reference_t.u.a.dim[i].v is valid.  */
-  CAF_ARR_REF_VECTOR,
-  /* A full array ref (:).  */
-  CAF_ARR_REF_FULL,
-  /* Reference a range on elements given by start, end and stride.  */
-  CAF_ARR_REF_RANGE,
-  /* Only a single item is referenced given in the start member.  */
-  CAF_ARR_REF_SINGLE,
-  /* An array ref of the kind (i:), where i is an arbitrary valid index in the
-     array.  The index i is given in the start member.  */
-  CAF_ARR_REF_OPEN_END,
-  /* An array ref of the kind (:i), where the lower bound of the array ref
-     is given by the remote side.  The index i is given in the end member.  */
-  CAF_ARR_REF_OPEN_START
-} caf_array_ref_t;
-
-/* References to remote components of a derived type.  */
-typedef struct caf_reference_t {
-  /* A pointer to the next ref or NULL.  */
-  struct caf_reference_t *next;
-  /* The type of the reference.  */
-  /* caf_ref_type_t, replaced by int to allow specification in fortran FE.  */
-  int type;
-  /* The size of an item referenced in bytes.  I.e. in an array ref this is
-     the factor to advance the array pointer with to get to the next item.
-     For component refs this gives just the size of the element referenced.  */
-  size_t item_size;
-  union {
-    struct {
-      /* The offset (in bytes) of the component in the derived type.  */
-      ptrdiff_t offset;
-      /* The offset (in bytes) to the caf_token associated with this
-        component.  NULL, when not allocatable/pointer ref.  */
-      ptrdiff_t caf_token_offset;
-    } c;
-    struct {
-      /* The mode of the array ref.  See CAF_ARR_REF_*.  */
-      /* caf_array_ref_t, replaced by unsigend char to allow specification in
-        fortran FE.  */
-      unsigned char mode[GFC_MAX_DIMENSIONS];
-      /* The type of a static array.  Unset for array's with descriptors.  */
-      int static_array_type;
-      /* Subscript refs (s) or vector refs (v).  */
-      union {
-       struct {
-         /* The start and end boundary of the ref and the stride.  */
-         index_type start, end, stride;
-       } s;
-       struct {
-         /* nvec entries of kind giving the elements to reference.  */
-         void *vector;
-         /* The number of entries in vector.  */
-         size_t nvec;
-         /* The integer kind used for the elements in vector.  */
-         int kind;
-       } v;
-      } dim[GFC_MAX_DIMENSIONS];
-    } a;
-  } u;
-} caf_reference_t;
 
 void _gfortran_caf_init (int *, char ***);
 void _gfortran_caf_finalize (void);
@@ -213,26 +121,6 @@ void _gfortran_caf_co_max (gfc_descriptor_t *, int, int *, char *, int, size_t);
 void _gfortran_caf_co_reduce (gfc_descriptor_t *, void* (*) (void *, void*),
                              int, int, int *, char *, int, size_t);
 
-void _gfortran_caf_get (caf_token_t, size_t, int, gfc_descriptor_t *,
-                       caf_vector_t *, gfc_descriptor_t *, int, int, bool,
-                       int *);
-void _gfortran_caf_send (caf_token_t, size_t, int, gfc_descriptor_t *,
-                        caf_vector_t *, gfc_descriptor_t *, int, int, bool,
-                        int *);
-void _gfortran_caf_sendget (caf_token_t, size_t, int, gfc_descriptor_t *,
-                           caf_vector_t *, caf_token_t, size_t, int,
-                           gfc_descriptor_t *, caf_vector_t *, int, int, bool);
-
-void _gfortran_caf_send_by_ref (caf_token_t token, int image_index,
-       gfc_descriptor_t *src, caf_reference_t *refs, int dst_kind,
-       int src_kind, bool may_require_tmp, bool dst_reallocatable, int *stat,
-       int dst_type);
-void _gfortran_caf_sendget_by_ref (
-       caf_token_t dst_token, int dst_image_index, caf_reference_t *dst_refs,
-       caf_token_t src_token, int src_image_index, caf_reference_t *src_refs,
-       int dst_kind, int src_kind, bool may_require_tmp, int *dst_stat,
-       int *src_stat, int dst_type, int src_type);
-
 void _gfortran_caf_register_accessor (
   const int hash,
   void (*accessor) (void *, const int *, void **, int32_t *, void *,

diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 1f7a9022e39e32e5b4ce5b85d1b129c0ab7a2fe8..d4e081be4dd7b38e97beea6ff30d4446e3a27cbc 100644 (file)
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -477,2393 +477,6 @@ _gfortran_caf_co_reduce (gfc_descriptor_t *a __attribute__ ((unused)),
  }
 
 
-static void
-assign_char4_from_char1 (size_t dst_size, size_t src_size, uint32_t *dst,
-                        unsigned char *src)
-{
-  size_t i, n;
-  n = dst_size/4 > src_size ? src_size : dst_size/4;
-  for (i = 0; i < n; ++i)
-    dst[i] = (int32_t) src[i];
-  for (; i < dst_size/4; ++i)
-    dst[i] = (int32_t) ' ';
-}
-
-
-static void
-assign_char1_from_char4 (size_t dst_size, size_t src_size, unsigned char *dst,
-                        uint32_t *src)
-{
-  size_t i, n;
-  n = dst_size > src_size/4 ? src_size/4 : dst_size;
-  for (i = 0; i < n; ++i)
-    dst[i] = src[i] > UINT8_MAX ? (unsigned char) '?' : (unsigned char) src[i];
-  if (dst_size > n)
-    memset (&dst[n], ' ', dst_size - n);
-}
-
-
-static void
-convert_type (void *dst, int dst_type, int dst_kind, void *src, int src_type,
-             int src_kind, int *stat)
-{
-#ifdef HAVE_GFC_INTEGER_16
-  typedef __int128 int128t;
-#else
-  typedef int64_t int128t;
-#endif
-
-#if defined(GFC_REAL_16_IS_LONG_DOUBLE)
-  typedef long double real128t;
-  typedef _Complex long double complex128t;
-#elif defined(HAVE_GFC_REAL_16)
-  typedef _Float128 real128t;
-  typedef _Complex _Float128 complex128t;
-#elif defined(HAVE_GFC_REAL_10)
-  typedef long double real128t;
-  typedef _Complex long double complex128t;
-#else
-  typedef double real128t;
-  typedef _Complex double complex128t;
-#endif
-
-  int128t int_val = 0;
-  real128t real_val = 0;
-  complex128t cmpx_val = 0;
-
-  switch (src_type)
-    {
-    case BT_INTEGER:
-      if (src_kind == 1)
-       int_val = *(int8_t*) src;
-      else if (src_kind == 2)
-       int_val = *(int16_t*) src;
-      else if (src_kind == 4)
-       int_val = *(int32_t*) src;
-      else if (src_kind == 8)
-       int_val = *(int64_t*) src;
-#ifdef HAVE_GFC_INTEGER_16
-      else if (src_kind == 16)
-       int_val = *(int128t*) src;
-#endif
-      else
-       goto error;
-      break;
-    case BT_REAL:
-      if (src_kind == 4)
-       real_val = *(float*) src;
-      else if (src_kind == 8)
-       real_val = *(double*) src;
-#ifdef HAVE_GFC_REAL_10
-      else if (src_kind == 10)
-       real_val = *(long double*) src;
-#endif
-#ifdef HAVE_GFC_REAL_16
-      else if (src_kind == 16)
-       real_val = *(real128t*) src;
-#endif
-      else
-       goto error;
-      break;
-    case BT_COMPLEX:
-      if (src_kind == 4)
-       cmpx_val = *(_Complex float*) src;
-      else if (src_kind == 8)
-       cmpx_val = *(_Complex double*) src;
-#ifdef HAVE_GFC_REAL_10
-      else if (src_kind == 10)
-       cmpx_val = *(_Complex long double*) src;
-#endif
-#ifdef HAVE_GFC_REAL_16
-      else if (src_kind == 16)
-       cmpx_val = *(complex128t*) src;
-#endif
-      else
-       goto error;
-      break;
-    default:
-      goto error;
-    }
-
-  switch (dst_type)
-    {
-    case BT_INTEGER:
-      if (src_type == BT_INTEGER)
-       {
-         if (dst_kind == 1)
-           *(int8_t*) dst = (int8_t) int_val;
-         else if (dst_kind == 2)
-           *(int16_t*) dst = (int16_t) int_val;
-         else if (dst_kind == 4)
-           *(int32_t*) dst = (int32_t) int_val;
-         else if (dst_kind == 8)
-           *(int64_t*) dst = (int64_t) int_val;
-#ifdef HAVE_GFC_INTEGER_16
-         else if (dst_kind == 16)
-           *(int128t*) dst = (int128t) int_val;
-#endif
-         else
-           goto error;
-       }
-      else if (src_type == BT_REAL)
-       {
-         if (dst_kind == 1)
-           *(int8_t*) dst = (int8_t) real_val;
-         else if (dst_kind == 2)
-           *(int16_t*) dst = (int16_t) real_val;
-         else if (dst_kind == 4)
-           *(int32_t*) dst = (int32_t) real_val;
-         else if (dst_kind == 8)
-           *(int64_t*) dst = (int64_t) real_val;
-#ifdef HAVE_GFC_INTEGER_16
-         else if (dst_kind == 16)
-           *(int128t*) dst = (int128t) real_val;
-#endif
-         else
-           goto error;
-       }
-      else if (src_type == BT_COMPLEX)
-       {
-         if (dst_kind == 1)
-           *(int8_t*) dst = (int8_t) cmpx_val;
-         else if (dst_kind == 2)
-           *(int16_t*) dst = (int16_t) cmpx_val;
-         else if (dst_kind == 4)
-           *(int32_t*) dst = (int32_t) cmpx_val;
-         else if (dst_kind == 8)
-           *(int64_t*) dst = (int64_t) cmpx_val;
-#ifdef HAVE_GFC_INTEGER_16
-         else if (dst_kind == 16)
-           *(int128t*) dst = (int128t) cmpx_val;
-#endif
-         else
-           goto error;
-       }
-      else
-       goto error;
-      return;
-    case BT_REAL:
-      if (src_type == BT_INTEGER)
-       {
-         if (dst_kind == 4)
-           *(float*) dst = (float) int_val;
-         else if (dst_kind == 8)
-           *(double*) dst = (double) int_val;
-#ifdef HAVE_GFC_REAL_10
-         else if (dst_kind == 10)
-           *(long double*) dst = (long double) int_val;
-#endif
-#ifdef HAVE_GFC_REAL_16
-         else if (dst_kind == 16)
-           *(real128t*) dst = (real128t) int_val;
-#endif
-         else
-           goto error;
-       }
-      else if (src_type == BT_REAL)
-       {
-         if (dst_kind == 4)
-           *(float*) dst = (float) real_val;
-         else if (dst_kind == 8)
-           *(double*) dst = (double) real_val;
-#ifdef HAVE_GFC_REAL_10
-         else if (dst_kind == 10)
-           *(long double*) dst = (long double) real_val;
-#endif
-#ifdef HAVE_GFC_REAL_16
-         else if (dst_kind == 16)
-           *(real128t*) dst = (real128t) real_val;
-#endif
-         else
-           goto error;
-       }
-      else if (src_type == BT_COMPLEX)
-       {
-         if (dst_kind == 4)
-           *(float*) dst = (float) cmpx_val;
-         else if (dst_kind == 8)
-           *(double*) dst = (double) cmpx_val;
-#ifdef HAVE_GFC_REAL_10
-         else if (dst_kind == 10)
-           *(long double*) dst = (long double) cmpx_val;
-#endif
-#ifdef HAVE_GFC_REAL_16
-         else if (dst_kind == 16)
-           *(real128t*) dst = (real128t) cmpx_val;
-#endif
-         else
-           goto error;
-       }
-      return;
-    case BT_COMPLEX:
-      if (src_type == BT_INTEGER)
-       {
-         if (dst_kind == 4)
-           *(_Complex float*) dst = (_Complex float) int_val;
-         else if (dst_kind == 8)
-           *(_Complex double*) dst = (_Complex double) int_val;
-#ifdef HAVE_GFC_REAL_10
-         else if (dst_kind == 10)
-           *(_Complex long double*) dst = (_Complex long double) int_val;
-#endif
-#ifdef HAVE_GFC_REAL_16
-         else if (dst_kind == 16)
-           *(complex128t*) dst = (complex128t) int_val;
-#endif
-         else
-           goto error;
-       }
-      else if (src_type == BT_REAL)
-       {
-         if (dst_kind == 4)
-           *(_Complex float*) dst = (_Complex float) real_val;
-         else if (dst_kind == 8)
-           *(_Complex double*) dst = (_Complex double) real_val;
-#ifdef HAVE_GFC_REAL_10
-         else if (dst_kind == 10)
-           *(_Complex long double*) dst = (_Complex long double) real_val;
-#endif
-#ifdef HAVE_GFC_REAL_16
-         else if (dst_kind == 16)
-           *(complex128t*) dst = (complex128t) real_val;
-#endif
-         else
-           goto error;
-       }
-      else if (src_type == BT_COMPLEX)
-       {
-         if (dst_kind == 4)
-           *(_Complex float*) dst = (_Complex float) cmpx_val;
-         else if (dst_kind == 8)
-           *(_Complex double*) dst = (_Complex double) cmpx_val;
-#ifdef HAVE_GFC_REAL_10
-         else if (dst_kind == 10)
-           *(_Complex long double*) dst = (_Complex long double) cmpx_val;
-#endif
-#ifdef HAVE_GFC_REAL_16
-         else if (dst_kind == 16)
-           *(complex128t*) dst = (complex128t) cmpx_val;
-#endif
-         else
-           goto error;
-       }
-      else
-       goto error;
-      return;
-    default:
-      goto error;
-    }
-
-error:
-  fprintf (stderr, "libcaf_single RUNTIME ERROR: Cannot convert type %d kind "
-          "%d to type %d kind %d\n", src_type, src_kind, dst_type, dst_kind);
-  if (stat)
-    *stat = 1;
-  else
-    abort ();
-}
-
-
-void
-_gfortran_caf_get (caf_token_t token, size_t offset,
-                  int image_index __attribute__ ((unused)),
-                  gfc_descriptor_t *src,
-                  caf_vector_t *src_vector __attribute__ ((unused)),
-                  gfc_descriptor_t *dest, int src_kind, int dst_kind,
-                  bool may_require_tmp, int *stat)
-{
-  /* FIXME: Handle vector subscripts.  */
-  size_t i, k, size;
-  int j;
-  int rank = GFC_DESCRIPTOR_RANK (dest);
-  size_t src_size = GFC_DESCRIPTOR_SIZE (src);
-  size_t dst_size = GFC_DESCRIPTOR_SIZE (dest);
-
-  if (stat)
-    *stat = 0;
-
-  if (rank == 0)
-    {
-      void *sr = (void *) ((char *) MEMTOK (token) + offset);
-      if (GFC_DESCRIPTOR_TYPE (dest) == GFC_DESCRIPTOR_TYPE (src)
-         && dst_kind == src_kind)
-       {
-         memmove (GFC_DESCRIPTOR_DATA (dest), sr,
-                  dst_size > src_size ? src_size : dst_size);
-         if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_size > src_size)
-           {
-             if (dst_kind == 1)
-               memset ((void*)(char*) GFC_DESCRIPTOR_DATA (dest) + src_size,
-                       ' ', dst_size - src_size);
-             else /* dst_kind == 4.  */
-               for (i = src_size/4; i < dst_size/4; i++)
-                 ((int32_t*) GFC_DESCRIPTOR_DATA (dest))[i] = (int32_t) ' ';
-           }
-       }
-      else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_kind == 1)
-       assign_char1_from_char4 (dst_size, src_size, GFC_DESCRIPTOR_DATA (dest),
-                                sr);
-      else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER)
-       assign_char4_from_char1 (dst_size, src_size, GFC_DESCRIPTOR_DATA (dest),
-                                sr);
-      else
-       convert_type (GFC_DESCRIPTOR_DATA (dest), GFC_DESCRIPTOR_TYPE (dest),
-                     dst_kind, sr, GFC_DESCRIPTOR_TYPE (src), src_kind, stat);
-      return;
-    }
-
-  size = 1;
-  for (j = 0; j < rank; j++)
-    {
-      ptrdiff_t dimextent = dest->dim[j]._ubound - dest->dim[j].lower_bound + 1;
-      if (dimextent < 0)
-       dimextent = 0;
-      size *= dimextent;
-    }
-
-  if (size == 0)
-    return;
-
-  if (may_require_tmp)
-    {
-      ptrdiff_t array_offset_sr, array_offset_dst;
-      void *tmp = malloc (size*src_size);
-
-      array_offset_dst = 0;
-      for (i = 0; i < size; i++)
-       {
-         ptrdiff_t array_offset_sr = 0;
-         ptrdiff_t stride = 1;
-         ptrdiff_t extent = 1;
-         for (j = 0; j < GFC_DESCRIPTOR_RANK (src)-1; j++)
-           {
-             array_offset_sr += ((i / (extent*stride))
-                                 % (src->dim[j]._ubound
-                                   - src->dim[j].lower_bound + 1))
-                                * src->dim[j]._stride;
-             extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1);
-             stride = src->dim[j]._stride;
-           }
-         array_offset_sr += (i / extent) * src->dim[rank-1]._stride;
-         void *sr = (void *)((char *) MEMTOK (token) + offset
-                         + array_offset_sr*GFC_DESCRIPTOR_SIZE (src));
-          memcpy ((void *) ((char *) tmp + array_offset_dst), sr, src_size);
-          array_offset_dst += src_size;
-       }
-
-      array_offset_sr = 0;
-      for (i = 0; i < size; i++)
-       {
-         ptrdiff_t array_offset_dst = 0;
-         ptrdiff_t stride = 1;
-         ptrdiff_t extent = 1;
-         for (j = 0; j < rank-1; j++)
-           {
-             array_offset_dst += ((i / (extent*stride))
-                                  % (dest->dim[j]._ubound
-                                     - dest->dim[j].lower_bound + 1))
-                                 * dest->dim[j]._stride;
-             extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1);
-             stride = dest->dim[j]._stride;
-           }
-         array_offset_dst += (i / extent) * dest->dim[rank-1]._stride;
-         void *dst = dest->base_addr
-                     + array_offset_dst*GFC_DESCRIPTOR_SIZE (dest);
-          void *sr = tmp + array_offset_sr;
-
-         if (GFC_DESCRIPTOR_TYPE (dest) == GFC_DESCRIPTOR_TYPE (src)
-             && dst_kind == src_kind)
-           {
-             memmove (dst, sr, dst_size > src_size ? src_size : dst_size);
-             if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER
-                 && dst_size > src_size)
-               {
-                 if (dst_kind == 1)
-                   memset ((void*)(char*) dst + src_size, ' ',
-                           dst_size-src_size);
-                 else /* dst_kind == 4.  */
-                   for (k = src_size/4; k < dst_size/4; k++)
-                     ((int32_t*) dst)[k] = (int32_t) ' ';
-               }
-           }
-         else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_kind == 1)
-           assign_char1_from_char4 (dst_size, src_size, dst, sr);
-         else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER)
-           assign_char4_from_char1 (dst_size, src_size, dst, sr);
-         else
-           convert_type (dst, GFC_DESCRIPTOR_TYPE (dest), dst_kind,
-                         sr, GFC_DESCRIPTOR_TYPE (src), src_kind, stat);
-          array_offset_sr += src_size;
-       }
-
-      free (tmp);
-      return;
-    }
-
-  for (i = 0; i < size; i++)
-    {
-      ptrdiff_t array_offset_dst = 0;
-      ptrdiff_t stride = 1;
-      ptrdiff_t extent = 1;
-      for (j = 0; j < rank-1; j++)
-       {
-         array_offset_dst += ((i / (extent*stride))
-                              % (dest->dim[j]._ubound
-                                 - dest->dim[j].lower_bound + 1))
-                             * dest->dim[j]._stride;
-         extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1);
-          stride = dest->dim[j]._stride;
-       }
-      array_offset_dst += (i / extent) * dest->dim[rank-1]._stride;
-      void *dst = dest->base_addr + array_offset_dst*GFC_DESCRIPTOR_SIZE (dest);
-
-      ptrdiff_t array_offset_sr = 0;
-      stride = 1;
-      extent = 1;
-      for (j = 0; j < GFC_DESCRIPTOR_RANK (src)-1; j++)
-       {
-         array_offset_sr += ((i / (extent*stride))
-                              % (src->dim[j]._ubound
-                                 - src->dim[j].lower_bound + 1))
-                             * src->dim[j]._stride;
-         extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1);
-         stride = src->dim[j]._stride;
-       }
-      array_offset_sr += (i / extent) * src->dim[rank-1]._stride;
-      void *sr = (void *)((char *) MEMTOK (token) + offset
-                         + array_offset_sr*GFC_DESCRIPTOR_SIZE (src));
-
-      if (GFC_DESCRIPTOR_TYPE (dest) == GFC_DESCRIPTOR_TYPE (src)
-         && dst_kind == src_kind)
-       {
-         memmove (dst, sr, dst_size > src_size ? src_size : dst_size);
-         if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_size > src_size)
-           {
-             if (dst_kind == 1)
-               memset ((void*)(char*) dst + src_size, ' ', dst_size-src_size);
-             else /* dst_kind == 4.  */
-               for (k = src_size/4; k < dst_size/4; k++)
-                 ((int32_t*) dst)[k] = (int32_t) ' ';
-           }
-       }
-      else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_kind == 1)
-       assign_char1_from_char4 (dst_size, src_size, dst, sr);
-      else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER)
-       assign_char4_from_char1 (dst_size, src_size, dst, sr);
-      else
-       convert_type (dst, GFC_DESCRIPTOR_TYPE (dest), dst_kind,
-                     sr, GFC_DESCRIPTOR_TYPE (src), src_kind, stat);
-    }
-}
-
-
-void
-_gfortran_caf_send (caf_token_t token, size_t offset,
-                   int image_index __attribute__ ((unused)),
-                   gfc_descriptor_t *dest,
-                   caf_vector_t *dst_vector __attribute__ ((unused)),
-                   gfc_descriptor_t *src, int dst_kind, int src_kind,
-                   bool may_require_tmp, int *stat)
-{
-  /* FIXME: Handle vector subscripts.  */
-  size_t i, k, size;
-  int j;
-  int rank = GFC_DESCRIPTOR_RANK (dest);
-  size_t src_size = GFC_DESCRIPTOR_SIZE (src);
-  size_t dst_size = GFC_DESCRIPTOR_SIZE (dest);
-
-  if (stat)
-    *stat = 0;
-
-  if (rank == 0)
-    {
-      void *dst = (void *) ((char *) MEMTOK (token) + offset);
-      if (GFC_DESCRIPTOR_TYPE (dest) == GFC_DESCRIPTOR_TYPE (src)
-         && dst_kind == src_kind)
-       {
-         memmove (dst, GFC_DESCRIPTOR_DATA (src),
-                  dst_size > src_size ? src_size : dst_size);
-         if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_size > src_size)
-           {
-             if (dst_kind == 1)
-               memset ((void*)(char*) dst + src_size, ' ', dst_size-src_size);
-             else /* dst_kind == 4.  */
-               for (i = src_size/4; i < dst_size/4; i++)
-                 ((int32_t*) dst)[i] = (int32_t) ' ';
-           }
-       }
-      else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_kind == 1)
-       assign_char1_from_char4 (dst_size, src_size, dst,
-                                GFC_DESCRIPTOR_DATA (src));
-      else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER)
-       assign_char4_from_char1 (dst_size, src_size, dst,
-                                GFC_DESCRIPTOR_DATA (src));
-      else
-       convert_type (dst, GFC_DESCRIPTOR_TYPE (dest), dst_kind,
-                     GFC_DESCRIPTOR_DATA (src), GFC_DESCRIPTOR_TYPE (src),
-                     src_kind, stat);
-      return;
-    }
-
-  size = 1;
-  for (j = 0; j < rank; j++)
-    {
-      ptrdiff_t dimextent = dest->dim[j]._ubound - dest->dim[j].lower_bound + 1;
-      if (dimextent < 0)
-       dimextent = 0;
-      size *= dimextent;
-    }
-
-  if (size == 0)
-    return;
-
-  if (may_require_tmp)
-    {
-      ptrdiff_t array_offset_sr, array_offset_dst;
-      void *tmp;
-
-      if (GFC_DESCRIPTOR_RANK (src) == 0)
-       {
-         tmp = malloc (src_size);
-         memcpy (tmp, GFC_DESCRIPTOR_DATA (src), src_size);
-       }
-      else
-       {
-         tmp = malloc (size*src_size);
-         array_offset_dst = 0;
-         for (i = 0; i < size; i++)
-           {
-             ptrdiff_t array_offset_sr = 0;
-             ptrdiff_t stride = 1;
-             ptrdiff_t extent = 1;
-             for (j = 0; j < GFC_DESCRIPTOR_RANK (src)-1; j++)
-               {
-                 array_offset_sr += ((i / (extent*stride))
-                                     % (src->dim[j]._ubound
-                                        - src->dim[j].lower_bound + 1))
-                                    * src->dim[j]._stride;
-                 extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1);
-                 stride = src->dim[j]._stride;
-               }
-             array_offset_sr += (i / extent) * src->dim[rank-1]._stride;
-             void *sr = (void *) ((char *) src->base_addr
-                                  + array_offset_sr*GFC_DESCRIPTOR_SIZE (src));
-             memcpy ((void *) ((char *) tmp + array_offset_dst), sr, src_size);
-             array_offset_dst += src_size;
-           }
-       }
-
-      array_offset_sr = 0;
-      for (i = 0; i < size; i++)
-       {
-         ptrdiff_t array_offset_dst = 0;
-         ptrdiff_t stride = 1;
-         ptrdiff_t extent = 1;
-         for (j = 0; j < rank-1; j++)
-           {
-             array_offset_dst += ((i / (extent*stride))
-                                  % (dest->dim[j]._ubound
-                                     - dest->dim[j].lower_bound + 1))
-                                 * dest->dim[j]._stride;
-         extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1);
-          stride = dest->dim[j]._stride;
-           }
-         array_offset_dst += (i / extent) * dest->dim[rank-1]._stride;
-         void *dst = (void *)((char *) MEMTOK (token) + offset
-                     + array_offset_dst*GFC_DESCRIPTOR_SIZE (dest));
-          void *sr = tmp + array_offset_sr;
-         if (GFC_DESCRIPTOR_TYPE (dest) == GFC_DESCRIPTOR_TYPE (src)
-             && dst_kind == src_kind)
-           {
-             memmove (dst, sr,
-                      dst_size > src_size ? src_size : dst_size);
-             if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER
-                 && dst_size > src_size)
-               {
-                 if (dst_kind == 1)
-                   memset ((void*)(char*) dst + src_size, ' ',
-                           dst_size-src_size);
-                 else /* dst_kind == 4.  */
-                   for (k = src_size/4; k < dst_size/4; k++)
-                     ((int32_t*) dst)[k] = (int32_t) ' ';
-               }
-           }
-         else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_kind == 1)
-           assign_char1_from_char4 (dst_size, src_size, dst, sr);
-         else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER)
-           assign_char4_from_char1 (dst_size, src_size, dst, sr);
-         else
-           convert_type (dst, GFC_DESCRIPTOR_TYPE (dest), dst_kind,
-                         sr, GFC_DESCRIPTOR_TYPE (src), src_kind, stat);
-          if (GFC_DESCRIPTOR_RANK (src))
-           array_offset_sr += src_size;
-       }
-      free (tmp);
-      return;
-    }
-
-  for (i = 0; i < size; i++)
-    {
-      ptrdiff_t array_offset_dst = 0;
-      ptrdiff_t stride = 1;
-      ptrdiff_t extent = 1;
-      for (j = 0; j < rank-1; j++)
-       {
-         array_offset_dst += ((i / (extent*stride))
-                              % (dest->dim[j]._ubound
-                                 - dest->dim[j].lower_bound + 1))
-                             * dest->dim[j]._stride;
-         extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1);
-         stride = dest->dim[j]._stride;
-       }
-      array_offset_dst += (i / extent) * dest->dim[rank - 1]._stride;
-      void *dst = (void *) ((char *) MEMTOK (token) + offset
-                           + array_offset_dst * dest->span);
-      void *sr;
-      if (GFC_DESCRIPTOR_RANK (src) != 0)
-       {
-         ptrdiff_t array_offset_sr = 0;
-         stride = 1;
-         extent = 1;
-         for (j = 0; j < GFC_DESCRIPTOR_RANK (src)-1; j++)
-           {
-             array_offset_sr += ((i / (extent*stride))
-                                 % (src->dim[j]._ubound
-                                    - src->dim[j].lower_bound + 1))
-                                * src->dim[j]._stride;
-             extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1);
-             stride = src->dim[j]._stride;
-           }
-         array_offset_sr += (i / extent) * src->dim[rank-1]._stride;
-         sr = (void *) ((char *) src->base_addr + array_offset_sr * src->span);
-       }
-      else
-       sr = src->base_addr;
-
-      if (GFC_DESCRIPTOR_TYPE (dest) == GFC_DESCRIPTOR_TYPE (src)
-         && dst_kind == src_kind)
-       {
-         memmove (dst, sr,
-                  dst_size > src_size ? src_size : dst_size);
-         if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_size > src_size)
-           {
-             if (dst_kind == 1)
-               memset ((void*)(char*) dst + src_size, ' ', dst_size-src_size);
-             else /* dst_kind == 4.  */
-               for (k = src_size/4; k < dst_size/4; k++)
-                 ((int32_t*) dst)[k] = (int32_t) ' ';
-           }
-       }
-      else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_kind == 1)
-       assign_char1_from_char4 (dst_size, src_size, dst, sr);
-      else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER)
-       assign_char4_from_char1 (dst_size, src_size, dst, sr);
-      else
-       convert_type (dst, GFC_DESCRIPTOR_TYPE (dest), dst_kind,
-                     sr, GFC_DESCRIPTOR_TYPE (src), src_kind, stat);
-    }
-}
-
-
-void
-_gfortran_caf_sendget (caf_token_t dst_token, size_t dst_offset,
-                      int dst_image_index, gfc_descriptor_t *dest,
-                      caf_vector_t *dst_vector, caf_token_t src_token,
-                      size_t src_offset,
-                      int src_image_index __attribute__ ((unused)),
-                      gfc_descriptor_t *src,
-                      caf_vector_t *src_vector __attribute__ ((unused)),
-                      int dst_kind, int src_kind, bool may_require_tmp)
-{
-  /* FIXME: Handle vector subscript of 'src_vector'.  */
-  /* For a single image, src->base_addr should be the same as src_token + offset
-     but to play save, we do it properly.  */
-  void *src_base = GFC_DESCRIPTOR_DATA (src);
-  GFC_DESCRIPTOR_DATA (src) = (void *) ((char *) MEMTOK (src_token)
-                                       + src_offset);
-  _gfortran_caf_send (dst_token, dst_offset, dst_image_index, dest, dst_vector,
-                     src, dst_kind, src_kind, may_require_tmp, NULL);
-  GFC_DESCRIPTOR_DATA (src) = src_base;
-}
-
-
-/* Emitted when a theorectically unreachable part is reached.  */
-const char unreachable[] = "Fatal error: unreachable alternative found.\n";
-
-
-static void
-copy_data (void *ds, void *sr, int dst_type, int src_type,
-          int dst_kind, int src_kind, size_t dst_size, size_t src_size,
-          size_t num, int *stat)
-{
-  size_t k;
-  if (dst_type == src_type && dst_kind == src_kind)
-    {
-      memmove (ds, sr, (dst_size > src_size ? src_size : dst_size) * num);
-      if ((dst_type == BT_CHARACTER || src_type == BT_CHARACTER)
-         && dst_size > src_size)
-       {
-         if (dst_kind == 1)
-           memset ((void*)(char*) ds + src_size, ' ', dst_size-src_size);
-         else /* dst_kind == 4.  */
-           for (k = src_size/4; k < dst_size/4; k++)
-             ((int32_t*) ds)[k] = (int32_t) ' ';
-       }
-    }
-  else if (dst_type == BT_CHARACTER && dst_kind == 1)
-    assign_char1_from_char4 (dst_size, src_size, ds, sr);
-  else if (dst_type == BT_CHARACTER)
-    assign_char4_from_char1 (dst_size, src_size, ds, sr);
-  else
-    for (k = 0; k < num; ++k)
-      {
-       convert_type (ds, dst_type, dst_kind, sr, src_type, src_kind, stat);
-       ds += dst_size;
-       sr += src_size;
-      }
-}
-
-
-#define COMPUTE_NUM_ITEMS(num, stride, lb, ub) \
-  do { \
-    index_type abs_stride = (stride) > 0 ? (stride) : -(stride); \
-    num = (stride) > 0 ? (ub) + 1 - (lb) : (lb) + 1 - (ub); \
-    if (num <= 0 || abs_stride < 1) return; \
-    num = (abs_stride > 1) ? (1 + (num - 1) / abs_stride) : num; \
-  } while (0)
-
-
-static void
-get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
-            caf_single_token_t single_token, gfc_descriptor_t *dst,
-            gfc_descriptor_t *src, void *ds, void *sr,
-            int dst_kind, int src_kind, size_t dst_dim, size_t src_dim,
-            size_t num, int *stat, int src_type)
-{
-  ptrdiff_t extent_src = 1, array_offset_src = 0, stride_src;
-  size_t next_dst_dim;
-
-  if (unlikely (ref == NULL))
-    /* May be we should issue an error here, because this case should not
-       occur.  */
-    return;
-
-  if (ref->next == NULL)
-    {
-      size_t dst_size = GFC_DESCRIPTOR_SIZE (dst);
-      ptrdiff_t array_offset_dst = 0;;
-      size_t dst_rank = GFC_DESCRIPTOR_RANK (dst);
-
-      switch (ref->type)
-       {
-       case CAF_REF_COMPONENT:
-         /* Because the token is always registered after the component, its
-            offset is always greater zero.  */
-         if (ref->u.c.caf_token_offset > 0)
-           /* Note, that sr is dereffed here.  */
-           copy_data (ds, *(void **)(sr + ref->u.c.offset),
-                      GFC_DESCRIPTOR_TYPE (dst), src_type,
-                      dst_kind, src_kind, dst_size, ref->item_size, 1, stat);
-         else
-           copy_data (ds, sr + ref->u.c.offset,
-                      GFC_DESCRIPTOR_TYPE (dst), src_type,
-                      dst_kind, src_kind, dst_size, ref->item_size, 1, stat);
-         ++(*i);
-         return;
-       case CAF_REF_STATIC_ARRAY:
-         /* Intentionally fall through.  */
-       case CAF_REF_ARRAY:
-         if (ref->u.a.mode[src_dim] == CAF_ARR_REF_NONE)
-           {
-             for (size_t d = 0; d < dst_rank; ++d)
-               array_offset_dst += dst_index[d];
-             copy_data (ds + array_offset_dst * dst_size, sr,
-                        GFC_DESCRIPTOR_TYPE (dst), src_type,
-                        dst_kind, src_kind, dst_size, ref->item_size, num,
-                        stat);
-             *i += num;
-             return;
-           }
-         break;
-       default:
-         caf_runtime_error (unreachable);
-       }
-    }
-
-  switch (ref->type)
-    {
-    case CAF_REF_COMPONENT:
-      if (ref->u.c.caf_token_offset > 0)
-       {
-         single_token = *(caf_single_token_t*)(sr + ref->u.c.caf_token_offset);
-
-         if (ref->next && ref->next->type == CAF_REF_ARRAY)
-           src = single_token->desc;
-         else
-           src = NULL;
-
-         if (ref->next && ref->next->type == CAF_REF_COMPONENT)
-           /* The currently ref'ed component was allocatabe (caf_token_offset
-              > 0) and the next ref is a component, too, then the new sr has to
-              be dereffed.  (static arrays cannot be allocatable or they
-              become an array with descriptor.  */
-           sr = *(void **)(sr + ref->u.c.offset);
-         else
-           sr += ref->u.c.offset;
-
-         get_for_ref (ref->next, i, dst_index, single_token, dst, src,
-                      ds, sr, dst_kind, src_kind, dst_dim, 0,
-                      1, stat, src_type);
-       }
-      else
-       get_for_ref (ref->next, i, dst_index, single_token, dst,
-                    (gfc_descriptor_t *)(sr + ref->u.c.offset), ds,
-                    sr + ref->u.c.offset, dst_kind, src_kind, dst_dim, 0, 1,
-                    stat, src_type);
-      return;
-    case CAF_REF_ARRAY:
-      if (ref->u.a.mode[src_dim] == CAF_ARR_REF_NONE)
-       {
-         get_for_ref (ref->next, i, dst_index, single_token, dst,
-                      src, ds, sr, dst_kind, src_kind,
-                      dst_dim, 0, 1, stat, src_type);
-         return;
-       }
-      /* Only when on the left most index switch the data pointer to
-        the array's data pointer.  */
-      if (src_dim == 0)
-       sr = GFC_DESCRIPTOR_DATA (src);
-      switch (ref->u.a.mode[src_dim])
-       {
-       case CAF_ARR_REF_VECTOR:
-         extent_src = GFC_DIMENSION_EXTENT (src->dim[src_dim]);
-         array_offset_src = 0;
-         dst_index[dst_dim] = 0;
-         for (size_t idx = 0; idx < ref->u.a.dim[src_dim].v.nvec;
-              ++idx)
-           {
-#define KINDCASE(kind, type) case kind: \
-             array_offset_src = (((index_type) \
-                 ((type *)ref->u.a.dim[src_dim].v.vector)[idx]) \
-                 - GFC_DIMENSION_LBOUND (src->dim[src_dim])) \
-                 * GFC_DIMENSION_STRIDE (src->dim[src_dim]); \
-             break
-
-             switch (ref->u.a.dim[src_dim].v.kind)
-               {
-               KINDCASE (1, GFC_INTEGER_1);
-               KINDCASE (2, GFC_INTEGER_2);
-               KINDCASE (4, GFC_INTEGER_4);
-#ifdef HAVE_GFC_INTEGER_8
-               KINDCASE (8, GFC_INTEGER_8);
-#endif
-#ifdef HAVE_GFC_INTEGER_16
-               KINDCASE (16, GFC_INTEGER_16);
-#endif
-               default:
-                 caf_runtime_error (unreachable);
-                 return;
-               }
-#undef KINDCASE
-
-             get_for_ref (ref, i, dst_index, single_token, dst, src,
-                          ds, sr + array_offset_src * ref->item_size,
-                          dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-                          1, stat, src_type);
-             dst_index[dst_dim]
-                 += GFC_DIMENSION_STRIDE (dst->dim[dst_dim]);
-           }
-         return;
-       case CAF_ARR_REF_FULL:
-         COMPUTE_NUM_ITEMS (extent_src,
-                            ref->u.a.dim[src_dim].s.stride,
-                            GFC_DIMENSION_LBOUND (src->dim[src_dim]),
-                            GFC_DIMENSION_UBOUND (src->dim[src_dim]));
-         stride_src = src->dim[src_dim]._stride
-             * ref->u.a.dim[src_dim].s.stride;
-         array_offset_src = 0;
-         dst_index[dst_dim] = 0;
-         for (index_type idx = 0; idx < extent_src;
-              ++idx, array_offset_src += stride_src)
-           {
-             get_for_ref (ref, i, dst_index, single_token, dst, src,
-                          ds, sr + array_offset_src * ref->item_size,
-                          dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-                          1, stat, src_type);
-             dst_index[dst_dim]
-                 += GFC_DIMENSION_STRIDE (dst->dim[dst_dim]);
-           }
-         return;
-       case CAF_ARR_REF_RANGE:
-         COMPUTE_NUM_ITEMS (extent_src,
-                            ref->u.a.dim[src_dim].s.stride,
-                            ref->u.a.dim[src_dim].s.start,
-                            ref->u.a.dim[src_dim].s.end);
-         array_offset_src = (ref->u.a.dim[src_dim].s.start
-                             - GFC_DIMENSION_LBOUND (src->dim[src_dim]))
-             * GFC_DIMENSION_STRIDE (src->dim[src_dim]);
-         stride_src = GFC_DIMENSION_STRIDE (src->dim[src_dim])
-             * ref->u.a.dim[src_dim].s.stride;
-         dst_index[dst_dim] = 0;
-         /* Increase the dst_dim only, when the src_extent is greater one
-            or src and dst extent are both one.  Don't increase when the scalar
-            source is not present in the dst.  */
-         next_dst_dim = extent_src > 1
-             || (GFC_DIMENSION_EXTENT (dst->dim[dst_dim]) == 1
-                 && extent_src == 1) ? (dst_dim + 1) : dst_dim;
-         for (index_type idx = 0; idx < extent_src; ++idx)
-           {
-             get_for_ref (ref, i, dst_index, single_token, dst, src,
-                          ds, sr + array_offset_src * ref->item_size,
-                          dst_kind, src_kind, next_dst_dim, src_dim + 1,
-                          1, stat, src_type);
-             dst_index[dst_dim]
-                 += GFC_DIMENSION_STRIDE (dst->dim[dst_dim]);
-             array_offset_src += stride_src;
-           }
-         return;
-       case CAF_ARR_REF_SINGLE:
-         array_offset_src = (ref->u.a.dim[src_dim].s.start
-                             - src->dim[src_dim].lower_bound)
-             * GFC_DIMENSION_STRIDE (src->dim[src_dim]);
-         dst_index[dst_dim] = 0;
-         get_for_ref (ref, i, dst_index, single_token, dst, src, ds,
-                      sr + array_offset_src * ref->item_size,
-                      dst_kind, src_kind, dst_dim, src_dim + 1, 1,
-                      stat, src_type);
-         return;
-       case CAF_ARR_REF_OPEN_END:
-         COMPUTE_NUM_ITEMS (extent_src,
-                            ref->u.a.dim[src_dim].s.stride,
-                            ref->u.a.dim[src_dim].s.start,
-                            GFC_DIMENSION_UBOUND (src->dim[src_dim]));
-         stride_src = GFC_DIMENSION_STRIDE (src->dim[src_dim])
-             * ref->u.a.dim[src_dim].s.stride;
-         array_offset_src = (ref->u.a.dim[src_dim].s.start
-                             - GFC_DIMENSION_LBOUND (src->dim[src_dim]))
-             * GFC_DIMENSION_STRIDE (src->dim[src_dim]);
-         dst_index[dst_dim] = 0;
-         for (index_type idx = 0; idx < extent_src; ++idx)
-           {
-             get_for_ref (ref, i, dst_index, single_token, dst, src,
-                          ds, sr + array_offset_src * ref->item_size,
-                          dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-                          1, stat, src_type);
-             dst_index[dst_dim]
-                 += GFC_DIMENSION_STRIDE (dst->dim[dst_dim]);
-             array_offset_src += stride_src;
-           }
-         return;
-       case CAF_ARR_REF_OPEN_START:
-         COMPUTE_NUM_ITEMS (extent_src,
-                            ref->u.a.dim[src_dim].s.stride,
-                            GFC_DIMENSION_LBOUND (src->dim[src_dim]),
-                            ref->u.a.dim[src_dim].s.end);
-         stride_src = GFC_DIMENSION_STRIDE (src->dim[src_dim])
-             * ref->u.a.dim[src_dim].s.stride;
-         array_offset_src = 0;
-         dst_index[dst_dim] = 0;
-         for (index_type idx = 0; idx < extent_src; ++idx)
-           {
-             get_for_ref (ref, i, dst_index, single_token, dst, src,
-                          ds, sr + array_offset_src * ref->item_size,
-                          dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-                          1, stat, src_type);
-             dst_index[dst_dim]
-                 += GFC_DIMENSION_STRIDE (dst->dim[dst_dim]);
-             array_offset_src += stride_src;
-           }
-         return;
-       default:
-         caf_runtime_error (unreachable);
-       }
-      return;
-    case CAF_REF_STATIC_ARRAY:
-      if (ref->u.a.mode[src_dim] == CAF_ARR_REF_NONE)
-       {
-         get_for_ref (ref->next, i, dst_index, single_token, dst,
-                      NULL, ds, sr, dst_kind, src_kind,
-                      dst_dim, 0, 1, stat, src_type);
-         return;
-       }
-      switch (ref->u.a.mode[src_dim])
-       {
-       case CAF_ARR_REF_VECTOR:
-         array_offset_src = 0;
-         dst_index[dst_dim] = 0;
-         for (size_t idx = 0; idx < ref->u.a.dim[src_dim].v.nvec;
-              ++idx)
-           {
-#define KINDCASE(kind, type) case kind: \
-            array_offset_src = ((type *)ref->u.a.dim[src_dim].v.vector)[idx]; \
-             break
-
-             switch (ref->u.a.dim[src_dim].v.kind)
-               {
-               KINDCASE (1, GFC_INTEGER_1);
-               KINDCASE (2, GFC_INTEGER_2);
-               KINDCASE (4, GFC_INTEGER_4);
-#ifdef HAVE_GFC_INTEGER_8
-               KINDCASE (8, GFC_INTEGER_8);
-#endif
-#ifdef HAVE_GFC_INTEGER_16
-               KINDCASE (16, GFC_INTEGER_16);
-#endif
-               default:
-                 caf_runtime_error (unreachable);
-                 return;
-               }
-#undef KINDCASE
-
-             get_for_ref (ref, i, dst_index, single_token, dst, NULL,
-                          ds, sr + array_offset_src * ref->item_size,
-                          dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-                          1, stat, src_type);
-             dst_index[dst_dim]
-                 += GFC_DIMENSION_STRIDE (dst->dim[dst_dim]);
-           }
-         return;
-       case CAF_ARR_REF_FULL:
-         dst_index[dst_dim] = 0;
-         for (array_offset_src = 0 ;
-              array_offset_src <= ref->u.a.dim[src_dim].s.end;
-              array_offset_src += ref->u.a.dim[src_dim].s.stride)
-           {
-             get_for_ref (ref, i, dst_index, single_token, dst, NULL,
-                          ds, sr + array_offset_src * ref->item_size,
-                          dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-                          1, stat, src_type);
-             dst_index[dst_dim]
-                 += GFC_DIMENSION_STRIDE (dst->dim[dst_dim]);
-           }
-         return;
-       case CAF_ARR_REF_RANGE:
-         COMPUTE_NUM_ITEMS (extent_src,
-                            ref->u.a.dim[src_dim].s.stride,
-                            ref->u.a.dim[src_dim].s.start,
-                            ref->u.a.dim[src_dim].s.end);
-         array_offset_src = ref->u.a.dim[src_dim].s.start;
-         dst_index[dst_dim] = 0;
-         for (index_type idx = 0; idx < extent_src; ++idx)
-           {
-             get_for_ref (ref, i, dst_index, single_token, dst, NULL,
-                          ds, sr + array_offset_src * ref->item_size,
-                          dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-                          1, stat, src_type);
-             dst_index[dst_dim]
-                 += GFC_DIMENSION_STRIDE (dst->dim[dst_dim]);
-             array_offset_src += ref->u.a.dim[src_dim].s.stride;
-           }
-         return;
-       case CAF_ARR_REF_SINGLE:
-         array_offset_src = ref->u.a.dim[src_dim].s.start;
-         get_for_ref (ref, i, dst_index, single_token, dst, NULL, ds,
-                      sr + array_offset_src * ref->item_size,
-                      dst_kind, src_kind, dst_dim, src_dim + 1, 1,
-                      stat, src_type);
-         return;
-       /* The OPEN_* are mapped to a RANGE and therefore cannot occur.  */
-       case CAF_ARR_REF_OPEN_END:
-       case CAF_ARR_REF_OPEN_START:
-       default:
-         caf_runtime_error (unreachable);
-       }
-      return;
-    default:
-      caf_runtime_error (unreachable);
-    }
-}
-
-/* For internal use only.  */
-static void
-_gfortran_caf_get_by_ref (caf_token_t token,
-                         int image_index __attribute__ ((unused)),
-                         gfc_descriptor_t *dst, caf_reference_t *refs,
-                         int dst_kind, int src_kind,
-                         bool may_require_tmp __attribute__ ((unused)),
-                         bool dst_reallocatable, int *stat, int src_type)
-{
-  const char vecrefunknownkind[] = "libcaf_single::caf_get_by_ref(): "
-                                  "unknown kind in vector-ref.\n";
-  const char unknownreftype[] = "libcaf_single::caf_get_by_ref(): "
-                               "unknown reference type.\n";
-  const char unknownarrreftype[] = "libcaf_single::caf_get_by_ref(): "
-                                  "unknown array reference type.\n";
-  const char rankoutofrange[] = "libcaf_single::caf_get_by_ref(): "
-                               "rank out of range.\n";
-  const char extentoutofrange[] = "libcaf_single::caf_get_by_ref(): "
-                                 "extent out of range.\n";
-  const char cannotallocdst[] = "libcaf_single::caf_get_by_ref(): "
-                               "cannot allocate memory.\n";
-  const char nonallocextentmismatch[] = "libcaf_single::caf_get_by_ref(): "
-      "extent of non-allocatable arrays mismatch (%lu != %lu).\n";
-  const char doublearrayref[] = "libcaf_single::caf_get_by_ref(): "
-      "two or more array part references are not supported.\n";
-  size_t size, i;
-  size_t dst_index[GFC_MAX_DIMENSIONS];
-  int dst_rank = GFC_DESCRIPTOR_RANK (dst);
-  int dst_cur_dim = 0;
-  size_t src_size = 0;
-  caf_single_token_t single_token = TOKEN (token);
-  void *memptr = single_token->memptr;
-  gfc_descriptor_t *src = single_token->desc;
-  caf_reference_t *riter = refs;
-  long delta;
-  /* Reallocation of dst.data is needed (e.g., array to small).  */
-  bool realloc_needed;
-  /* Reallocation of dst.data is required, because data is not alloced at
-     all.  */
-  bool realloc_required;
-  bool extent_mismatch = false;
-  /* Set when the first non-scalar array reference is encountered.  */
-  bool in_array_ref = false;
-  bool array_extent_fixed = false;
-  realloc_needed = realloc_required = GFC_DESCRIPTOR_DATA (dst) == NULL;
-
-  assert (!realloc_needed || dst_reallocatable);
-
-  if (stat)
-    *stat = 0;
-
-  /* Compute the size of the result.  In the beginning size just counts the
-     number of elements.  */
-  size = 1;
-  while (riter)
-    {
-      switch (riter->type)
-       {
-       case CAF_REF_COMPONENT:
-         if (riter->u.c.caf_token_offset)
-           {
-             single_token = *(caf_single_token_t*)
-                                        (memptr + riter->u.c.caf_token_offset);
-             memptr = single_token->memptr;
-             src = single_token->desc;
-           }
-         else
-           {
-             memptr += riter->u.c.offset;
-             /* When the next ref is an array ref, assume there is an
-                array descriptor at memptr.  Note, static arrays do not have
-                a descriptor.  */
-             if (riter->next && riter->next->type == CAF_REF_ARRAY)
-               src = (gfc_descriptor_t *)memptr;
-             else
-               src = NULL;
-           }
-         break;
-       case CAF_REF_ARRAY:
-         for (i = 0; riter->u.a.mode[i] != CAF_ARR_REF_NONE; ++i)
-           {
-             switch (riter->u.a.mode[i])
-               {
-               case CAF_ARR_REF_VECTOR:
-                 delta = riter->u.a.dim[i].v.nvec;
-#define KINDCASE(kind, type) case kind: \
-                   memptr += (((index_type) \
-                       ((type *)riter->u.a.dim[i].v.vector)[0]) \
-                       - GFC_DIMENSION_LBOUND (src->dim[i])) \
-                       * GFC_DIMENSION_STRIDE (src->dim[i]) \
-                       * riter->item_size; \
-                   break
-
-                 switch (riter->u.a.dim[i].v.kind)
-                   {
-                   KINDCASE (1, GFC_INTEGER_1);
-                   KINDCASE (2, GFC_INTEGER_2);
-                   KINDCASE (4, GFC_INTEGER_4);
-#ifdef HAVE_GFC_INTEGER_8
-                   KINDCASE (8, GFC_INTEGER_8);
-#endif
-#ifdef HAVE_GFC_INTEGER_16
-                   KINDCASE (16, GFC_INTEGER_16);
-#endif
-                   default:
-                     caf_internal_error (vecrefunknownkind, stat, NULL, 0);
-                     return;
-                   }
-#undef KINDCASE
-                 break;
-               case CAF_ARR_REF_FULL:
-                 COMPUTE_NUM_ITEMS (delta,
-                                    riter->u.a.dim[i].s.stride,
-                                    GFC_DIMENSION_LBOUND (src->dim[i]),
-                                    GFC_DIMENSION_UBOUND (src->dim[i]));
-                 /* The memptr stays unchanged when ref'ing the first element
-                    in a dimension.  */
-                 break;
-               case CAF_ARR_REF_RANGE:
-                 COMPUTE_NUM_ITEMS (delta,
-                                    riter->u.a.dim[i].s.stride,
-                                    riter->u.a.dim[i].s.start,
-                                    riter->u.a.dim[i].s.end);
-                 memptr += (riter->u.a.dim[i].s.start
-                            - GFC_DIMENSION_LBOUND (src->dim[i]))
-                     * GFC_DIMENSION_STRIDE (src->dim[i])
-                     * riter->item_size;
-                 break;
-               case CAF_ARR_REF_SINGLE:
-                 delta = 1;
-                 memptr += (riter->u.a.dim[i].s.start
-                            - GFC_DIMENSION_LBOUND (src->dim[i]))
-                     * GFC_DIMENSION_STRIDE (src->dim[i])
-                     * riter->item_size;
-                 break;
-               case CAF_ARR_REF_OPEN_END:
-                 COMPUTE_NUM_ITEMS (delta,
-                                    riter->u.a.dim[i].s.stride,
-                                    riter->u.a.dim[i].s.start,
-                                    GFC_DIMENSION_UBOUND (src->dim[i]));
-                 memptr += (riter->u.a.dim[i].s.start
-                            - GFC_DIMENSION_LBOUND (src->dim[i]))
-                     * GFC_DIMENSION_STRIDE (src->dim[i])
-                     * riter->item_size;
-                 break;
-               case CAF_ARR_REF_OPEN_START:
-                 COMPUTE_NUM_ITEMS (delta,
-                                    riter->u.a.dim[i].s.stride,
-                                    GFC_DIMENSION_LBOUND (src->dim[i]),
-                                    riter->u.a.dim[i].s.end);
-                 /* The memptr stays unchanged when ref'ing the first element
-                    in a dimension.  */
-                 break;
-               default:
-                 caf_internal_error (unknownarrreftype, stat, NULL, 0);
-                 return;
-               }
-             if (delta <= 0)
-               return;
-             /* Check the various properties of the destination array.
-                Is an array expected and present?  */
-             if (delta > 1 && dst_rank == 0)
-               {
-                 /* No, an array is required, but not provided.  */
-                 caf_internal_error (extentoutofrange, stat, NULL, 0);
-                 return;
-               }
-             /* Special mode when called by __caf_sendget_by_ref ().  */
-             if (dst_rank == -1 && GFC_DESCRIPTOR_DATA (dst) == NULL)
-               {
-                 dst_rank = dst_cur_dim + 1;
-                 GFC_DESCRIPTOR_RANK (dst) = dst_rank;
-                 GFC_DESCRIPTOR_SIZE (dst) = dst_kind;
-               }
-             /* When dst is an array.  */
-             if (dst_rank > 0)
-               {
-                 /* Check that dst_cur_dim is valid for dst.  Can be
-                    superceeded only by scalar data.  */
-                 if (dst_cur_dim >= dst_rank && delta != 1)
-                   {
-                     caf_internal_error (rankoutofrange, stat, NULL, 0);
-                     return;
-                   }
-                 /* Do further checks, when the source is not scalar.  */
-                 else if (delta != 1)
-                   {
-                     /* Check that the extent is not scalar and we are not in
-                        an array ref for the dst side.  */
-                     if (!in_array_ref)
-                       {
-                         /* Check that this is the non-scalar extent.  */
-                         if (!array_extent_fixed)
-                           {
-                             /* In an array extent now.  */
-                             in_array_ref = true;
-                             /* Check that we haven't skipped any scalar
-                                dimensions yet and that the dst is
-                                compatible.  */
-                             if (i > 0
-                                 && dst_rank == GFC_DESCRIPTOR_RANK (src))
-                               {
-                                 if (dst_reallocatable)
-                                   {
-                                     /* Dst is reallocatable, which means that
-                                        the bounds are not set.  Set them.  */
-                                     for (dst_cur_dim= 0; dst_cur_dim < (int)i;
-                                          ++dst_cur_dim)
-                                      GFC_DIMENSION_SET (dst->dim[dst_cur_dim],
-                                                         1, 1, 1);
-                                   }
-                                 else
-                                   dst_cur_dim = i;
-                               }
-                             /* Else press thumbs, that there are enough
-                                dimensional refs to come.  Checked below.  */
-                           }
-                         else
-                           {
-                             caf_internal_error (doublearrayref, stat, NULL,
-                                                 0);
-                             return;
-                           }
-                       }
-                     /* When the realloc is required, then no extent may have
-                        been set.  */
-                     extent_mismatch = realloc_required
-                         || GFC_DESCRIPTOR_EXTENT (dst, dst_cur_dim) != delta;
-                     /* When it already known, that a realloc is needed or
-                        the extent does not match the needed one.  */
-                     if (realloc_required || realloc_needed
-                         || extent_mismatch)
-                       {
-                         /* Check whether dst is reallocatable.  */
-                         if (unlikely (!dst_reallocatable))
-                           {
-                             caf_internal_error (nonallocextentmismatch, stat,
-                                                 NULL, 0, delta,
-                                                 GFC_DESCRIPTOR_EXTENT (dst,
-                                                                 dst_cur_dim));
-                             return;
-                           }
-                         /* Only report an error, when the extent needs to be
-                            modified, which is not allowed.  */
-                         else if (!dst_reallocatable && extent_mismatch)
-                           {
-                             caf_internal_error (extentoutofrange, stat, NULL,
-                                                 0);
-                             return;
-                           }
-                         realloc_needed = true;
-                       }
-                     /* Only change the extent when it does not match.  This is
-                        to prevent resetting given array bounds.  */
-                     if (extent_mismatch)
-                       GFC_DIMENSION_SET (dst->dim[dst_cur_dim], 1, delta,
-                                          size);
-                   }
-
-                 /* Only increase the dim counter, when in an array ref.  */
-                 if (in_array_ref && dst_cur_dim < dst_rank)
-                   ++dst_cur_dim;
-               }
-             size *= (index_type)delta;
-           }
-         if (in_array_ref)
-           {
-             array_extent_fixed = true;
-             in_array_ref = false;
-             /* Check, if we got less dimensional refs than the rank of dst
-                expects.  */
-             assert (dst_cur_dim == GFC_DESCRIPTOR_RANK (dst));
-           }
-         break;
-       case CAF_REF_STATIC_ARRAY:
-         for (i = 0; riter->u.a.mode[i] != CAF_ARR_REF_NONE; ++i)
-           {
-             switch (riter->u.a.mode[i])
-               {
-               case CAF_ARR_REF_VECTOR:
-                 delta = riter->u.a.dim[i].v.nvec;
-#define KINDCASE(kind, type) case kind: \
-                   memptr += ((type *)riter->u.a.dim[i].v.vector)[0] \
-                       * riter->item_size; \
-                   break
-
-                 switch (riter->u.a.dim[i].v.kind)
-                   {
-                   KINDCASE (1, GFC_INTEGER_1);
-                   KINDCASE (2, GFC_INTEGER_2);
-                   KINDCASE (4, GFC_INTEGER_4);
-#ifdef HAVE_GFC_INTEGER_8
-                   KINDCASE (8, GFC_INTEGER_8);
-#endif
-#ifdef HAVE_GFC_INTEGER_16
-                   KINDCASE (16, GFC_INTEGER_16);
-#endif
-                   default:
-                     caf_internal_error (vecrefunknownkind, stat, NULL, 0);
-                     return;
-                   }
-#undef KINDCASE
-                 break;
-               case CAF_ARR_REF_FULL:
-                 delta = riter->u.a.dim[i].s.end / riter->u.a.dim[i].s.stride
-                     + 1;
-                 /* The memptr stays unchanged when ref'ing the first element
-                    in a dimension.  */
-                 break;
-               case CAF_ARR_REF_RANGE:
-                 COMPUTE_NUM_ITEMS (delta,
-                                    riter->u.a.dim[i].s.stride,
-                                    riter->u.a.dim[i].s.start,
-                                    riter->u.a.dim[i].s.end);
-                 memptr += riter->u.a.dim[i].s.start
-                     * riter->u.a.dim[i].s.stride
-                     * riter->item_size;
-                 break;
-               case CAF_ARR_REF_SINGLE:
-                 delta = 1;
-                 memptr += riter->u.a.dim[i].s.start
-                     * riter->u.a.dim[i].s.stride
-                     * riter->item_size;
-                 break;
-               case CAF_ARR_REF_OPEN_END:
-                 /* This and OPEN_START are mapped to a RANGE and therefore
-                    cannot occur here.  */
-               case CAF_ARR_REF_OPEN_START:
-               default:
-                 caf_internal_error (unknownarrreftype, stat, NULL, 0);
-                 return;
-               }
-             if (delta <= 0)
-               return;
-             /* Check the various properties of the destination array.
-                Is an array expected and present?  */
-             if (delta > 1 && dst_rank == 0)
-               {
-                 /* No, an array is required, but not provided.  */
-                 caf_internal_error (extentoutofrange, stat, NULL, 0);
-                 return;
-               }
-             /* Special mode when called by __caf_sendget_by_ref ().  */
-             if (dst_rank == -1 && GFC_DESCRIPTOR_DATA (dst) == NULL)
-               {
-                 dst_rank = dst_cur_dim + 1;
-                 GFC_DESCRIPTOR_RANK (dst) = dst_rank;
-                 GFC_DESCRIPTOR_SIZE (dst) = dst_kind;
-               }
-             /* When dst is an array.  */
-             if (dst_rank > 0)
-               {
-                 /* Check that dst_cur_dim is valid for dst.  Can be
-                    superceeded only by scalar data.  */
-                 if (dst_cur_dim >= dst_rank && delta != 1)
-                   {
-                     caf_internal_error (rankoutofrange, stat, NULL, 0);
-                     return;
-                   }
-                 /* Do further checks, when the source is not scalar.  */
-                 else if (delta != 1)
-                   {
-                     /* Check that the extent is not scalar and we are not in
-                        an array ref for the dst side.  */
-                     if (!in_array_ref)
-                       {
-                         /* Check that this is the non-scalar extent.  */
-                         if (!array_extent_fixed)
-                           {
-                             /* In an array extent now.  */
-                             in_array_ref = true;
-                             /* The dst is not reallocatable, so nothing more
-                                to do, then correct the dim counter.  */
-                             dst_cur_dim = i;
-                           }
-                         else
-                           {
-                             caf_internal_error (doublearrayref, stat, NULL,
-                                                 0);
-                             return;
-                           }
-                       }
-                     /* When the realloc is required, then no extent may have
-                        been set.  */
-                     extent_mismatch = realloc_required
-                         || GFC_DESCRIPTOR_EXTENT (dst, dst_cur_dim) != delta;
-                     /* When it is already known, that a realloc is needed or
-                        the extent does not match the needed one.  */
-                     if (realloc_required || realloc_needed
-                         || extent_mismatch)
-                       {
-                         /* Check whether dst is reallocatable.  */
-                         if (unlikely (!dst_reallocatable))
-                           {
-                             caf_internal_error (nonallocextentmismatch, stat,
-                                                 NULL, 0, delta,
-                                                 GFC_DESCRIPTOR_EXTENT (dst,
-                                                                 dst_cur_dim));
-                             return;
-                           }
-                         /* Only report an error, when the extent needs to be
-                            modified, which is not allowed.  */
-                         else if (!dst_reallocatable && extent_mismatch)
-                           {
-                             caf_internal_error (extentoutofrange, stat, NULL,
-                                                 0);
-                             return;
-                           }
-                         realloc_needed = true;
-                       }
-                     /* Only change the extent when it does not match.  This is
-                        to prevent resetting given array bounds.  */
-                     if (extent_mismatch)
-                       GFC_DIMENSION_SET (dst->dim[dst_cur_dim], 1, delta,
-                                          size);
-                   }
-                 /* Only increase the dim counter, when in an array ref.  */
-                 if (in_array_ref && dst_cur_dim < dst_rank)
-                   ++dst_cur_dim;
-               }
-             size *= (index_type)delta;
-           }
-         if (in_array_ref)
-           {
-             array_extent_fixed = true;
-             in_array_ref = false;
-             /* Check, if we got less dimensional refs than the rank of dst
-                expects.  */
-             assert (dst_cur_dim == GFC_DESCRIPTOR_RANK (dst));
-           }
-         break;
-       default:
-         caf_internal_error (unknownreftype, stat, NULL, 0);
-         return;
-       }
-      src_size = riter->item_size;
-      riter = riter->next;
-    }
-  if (size == 0 || src_size == 0)
-    return;
-  /* Postcondition:
-     - size contains the number of elements to store in the destination array,
-     - src_size gives the size in bytes of each item in the destination array.
-  */
-
-  if (realloc_needed)
-    {
-      if (!array_extent_fixed)
-       {
-         assert (size == 1);
-         /* Special mode when called by __caf_sendget_by_ref ().  */
-         if (dst_rank == -1 && GFC_DESCRIPTOR_DATA (dst) == NULL)
-           {
-             dst_rank = dst_cur_dim + 1;
-             GFC_DESCRIPTOR_RANK (dst) = dst_rank;
-             GFC_DESCRIPTOR_SIZE (dst) = dst_kind;
-           }
-         /* This can happen only, when the result is scalar.  */
-         for (dst_cur_dim = 0; dst_cur_dim < dst_rank; ++dst_cur_dim)
-           GFC_DIMENSION_SET (dst->dim[dst_cur_dim], 1, 1, 1);
-       }
-
-      GFC_DESCRIPTOR_DATA (dst) = malloc (size * GFC_DESCRIPTOR_SIZE (dst));
-      if (unlikely (GFC_DESCRIPTOR_DATA (dst) == NULL))
-       {
-         caf_internal_error (cannotallocdst, stat, NULL, 0);
-         return;
-       }
-    }
-
-  /* Reset the token.  */
-  single_token = TOKEN (token);
-  memptr = single_token->memptr;
-  src = single_token->desc;
-  memset(dst_index, 0, sizeof (dst_index));
-  i = 0;
-  get_for_ref (refs, &i, dst_index, single_token, dst, src,
-              GFC_DESCRIPTOR_DATA (dst), memptr, dst_kind, src_kind, 0, 0,
-              1, stat, src_type);
-}
-
-
-static void
-send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index,
-            caf_single_token_t single_token, gfc_descriptor_t *dst,
-            gfc_descriptor_t *src, void *ds, void *sr,
-            int dst_kind, int src_kind, size_t dst_dim, size_t src_dim,
-            size_t num, size_t size, int *stat, int dst_type)
-{
-  const char vecrefunknownkind[] = "libcaf_single::caf_send_by_ref(): "
-      "unknown kind in vector-ref.\n";
-  ptrdiff_t extent_dst = 1, array_offset_dst = 0, stride_dst;
-  const size_t src_rank = GFC_DESCRIPTOR_RANK (src);
-
-  if (unlikely (ref == NULL))
-    /* May be we should issue an error here, because this case should not
-       occur.  */
-    return;
-
-  if (ref->next == NULL)
-    {
-      size_t src_size = GFC_DESCRIPTOR_SIZE (src);
-      ptrdiff_t array_offset_src = 0;;
-
-      switch (ref->type)
-       {
-       case CAF_REF_COMPONENT:
-         if (ref->u.c.caf_token_offset > 0)
-           {
-             if (*(void**)(ds + ref->u.c.offset) == NULL)
-               {
-                 /* Create a scalar temporary array descriptor.  */
-                 gfc_descriptor_t static_dst;
-                 GFC_DESCRIPTOR_DATA (&static_dst) = NULL;
-                 GFC_DESCRIPTOR_DTYPE (&static_dst)
-                     = GFC_DESCRIPTOR_DTYPE (src);
-                 /* The component can be allocated now, because it is a
-                    scalar.  */
-                 _gfortran_caf_register (ref->item_size,
-                                         CAF_REGTYPE_COARRAY_ALLOC,
-                                         ds + ref->u.c.caf_token_offset,
-                                         &static_dst, stat, NULL, 0);
-                 single_token = *(caf_single_token_t *)
-                                              (ds + ref->u.c.caf_token_offset);
-                 /* In case of an error in allocation return.  When stat is
-                    NULL, then register_component() terminates on error.  */
-                 if (stat != NULL && *stat)
-                   return;
-                 /* Publish the allocated memory.  */
-                 *((void **)(ds + ref->u.c.offset))
-                     = GFC_DESCRIPTOR_DATA (&static_dst);
-                 ds = GFC_DESCRIPTOR_DATA (&static_dst);
-                 /* Set the type from the src.  */
-                 dst_type = GFC_DESCRIPTOR_TYPE (src);
-               }
-             else
-               {
-                 single_token = *(caf_single_token_t *)
-                                              (ds + ref->u.c.caf_token_offset);
-                 dst = single_token->desc;
-                 if (dst)
-                   {
-                     ds = GFC_DESCRIPTOR_DATA (dst);
-                     dst_type = GFC_DESCRIPTOR_TYPE (dst);
-                   }
-                 else
-                   ds = *(void **)(ds + ref->u.c.offset);
-               }
-             copy_data (ds, sr, dst_type, GFC_DESCRIPTOR_TYPE (src),
-                        dst_kind, src_kind, ref->item_size, src_size, 1, stat);
-           }
-         else
-           copy_data (ds + ref->u.c.offset, sr, dst_type,
-                      GFC_DESCRIPTOR_TYPE (src),
-                      dst_kind, src_kind, ref->item_size, src_size, 1, stat);
-         ++(*i);
-         return;
-       case CAF_REF_STATIC_ARRAY:
-         /* Intentionally fall through.  */
-       case CAF_REF_ARRAY:
-         if (ref->u.a.mode[dst_dim] == CAF_ARR_REF_NONE)
-           {
-             if (src_rank > 0)
-               {
-                 for (size_t d = 0; d < src_rank; ++d)
-                   array_offset_src += src_index[d];
-                 copy_data (ds, sr + array_offset_src * src_size,
-                            dst_type, GFC_DESCRIPTOR_TYPE (src), dst_kind,
-                            src_kind, ref->item_size, src_size, num, stat);
-               }
-             else
-               copy_data (ds, sr, dst_type, GFC_DESCRIPTOR_TYPE (src),
-                          dst_kind, src_kind, ref->item_size, src_size, num,
-                          stat);
-             *i += num;
-             return;
-           }
-         break;
-       default:
-         caf_runtime_error (unreachable);
-       }
-    }
-
-  switch (ref->type)
-    {
-    case CAF_REF_COMPONENT:
-      if (ref->u.c.caf_token_offset > 0)
-       {
-         if (*(void**)(ds + ref->u.c.offset) == NULL)
-           {
-             /* This component refs an unallocated array.  Non-arrays are
-                caught in the if (!ref->next) above.  */
-             dst = (gfc_descriptor_t *)(ds + ref->u.c.offset);
-             /* Assume that the rank and the dimensions fit for copying src
-                to dst.  */
-             GFC_DESCRIPTOR_DTYPE (dst) = GFC_DESCRIPTOR_DTYPE (src);
-             GFC_DESCRIPTOR_SPAN (dst) = GFC_DESCRIPTOR_SPAN (src);
-             stride_dst = 1;
-             dst->offset = 0;
-             for (size_t d = 0; d < src_rank; ++d)
-               {
-                 extent_dst = GFC_DIMENSION_EXTENT (src->dim[d]);
-                 GFC_DIMENSION_LBOUND (dst->dim[d]) = 1;
-                 GFC_DIMENSION_UBOUND (dst->dim[d]) = extent_dst;
-                 GFC_DIMENSION_STRIDE (dst->dim[d]) = stride_dst;
-                 dst->offset -= stride_dst;
-                 stride_dst *= extent_dst;
-               }
-             /* Null the data-pointer to make register_component allocate
-                its own memory.  */
-             GFC_DESCRIPTOR_DATA (dst) = NULL;
-
-             /* The size of the array is given by size.  */
-             _gfortran_caf_register (size * ref->item_size,
-                                     CAF_REGTYPE_COARRAY_ALLOC,
-                                     ds + ref->u.c.caf_token_offset,
-                                     dst, stat, NULL, 0);
-             /* In case of an error in allocation return.  When stat is
-                NULL, then register_component() terminates on error.  */
-             if (stat != NULL && *stat)
-               return;
-           }
-         single_token = *(caf_single_token_t*)(ds + ref->u.c.caf_token_offset);
-         /* When a component is allocatable (caf_token_offset != 0) and not an
-            array (ref->next->type == CAF_REF_COMPONENT), then ds has to be
-            dereffed.  */
-         if (ref->next && ref->next->type == CAF_REF_COMPONENT)
-           ds = *(void **)(ds + ref->u.c.offset);
-         else
-           ds += ref->u.c.offset;
-
-         send_by_ref (ref->next, i, src_index, single_token,
-                      single_token->desc, src, ds, sr,
-                      dst_kind, src_kind, 0, src_dim, 1, size, stat, dst_type);
-       }
-      else
-       send_by_ref (ref->next, i, src_index, single_token,
-                    (gfc_descriptor_t *)(ds + ref->u.c.offset), src,
-                    ds + ref->u.c.offset, sr, dst_kind, src_kind, 0, src_dim,
-                    1, size, stat, dst_type);
-      return;
-    case CAF_REF_ARRAY:
-      if (ref->u.a.mode[dst_dim] == CAF_ARR_REF_NONE)
-       {
-         send_by_ref (ref->next, i, src_index, single_token,
-                      (gfc_descriptor_t *)ds, src, ds, sr, dst_kind, src_kind,
-                      0, src_dim, 1, size, stat, dst_type);
-         return;
-       }
-      /* Only when on the left most index switch the data pointer to
-        the array's data pointer.  And only for non-static arrays.  */
-      if (dst_dim == 0 && ref->type != CAF_REF_STATIC_ARRAY)
-       ds = GFC_DESCRIPTOR_DATA (dst);
-      switch (ref->u.a.mode[dst_dim])
-       {
-       case CAF_ARR_REF_VECTOR:
-         array_offset_dst = 0;
-         src_index[src_dim] = 0;
-         for (size_t idx = 0; idx < ref->u.a.dim[dst_dim].v.nvec;
-              ++idx)
-           {
-#define KINDCASE(kind, type) case kind: \
-             array_offset_dst = (((index_type) \
-                 ((type *)ref->u.a.dim[dst_dim].v.vector)[idx]) \
-                 - GFC_DIMENSION_LBOUND (dst->dim[dst_dim])) \
-                 * GFC_DIMENSION_STRIDE (dst->dim[dst_dim]); \
-             break
-
-             switch (ref->u.a.dim[dst_dim].v.kind)
-               {
-               KINDCASE (1, GFC_INTEGER_1);
-               KINDCASE (2, GFC_INTEGER_2);
-               KINDCASE (4, GFC_INTEGER_4);
-#ifdef HAVE_GFC_INTEGER_8
-               KINDCASE (8, GFC_INTEGER_8);
-#endif
-#ifdef HAVE_GFC_INTEGER_16
-               KINDCASE (16, GFC_INTEGER_16);
-#endif
-               default:
-                 caf_internal_error (vecrefunknownkind, stat, NULL, 0);
-                 return;
-               }
-#undef KINDCASE
-
-             send_by_ref (ref, i, src_index, single_token, dst, src,
-                          ds + array_offset_dst * ref->item_size, sr,
-                          dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-                          1, size, stat, dst_type);
-             if (src_rank > 0)
-               src_index[src_dim]
-                   += GFC_DIMENSION_STRIDE (src->dim[src_dim]);
-           }
-         return;
-       case CAF_ARR_REF_FULL:
-         COMPUTE_NUM_ITEMS (extent_dst,
-                            ref->u.a.dim[dst_dim].s.stride,
-                            GFC_DIMENSION_LBOUND (dst->dim[dst_dim]),
-                            GFC_DIMENSION_UBOUND (dst->dim[dst_dim]));
-         array_offset_dst = 0;
-         stride_dst = GFC_DIMENSION_STRIDE (dst->dim[dst_dim])
-             * ref->u.a.dim[dst_dim].s.stride;
-         src_index[src_dim] = 0;
-         for (index_type idx = 0; idx < extent_dst;
-              ++idx, array_offset_dst += stride_dst)
-           {
-             send_by_ref (ref, i, src_index, single_token, dst, src,
-                          ds + array_offset_dst * ref->item_size, sr,
-                          dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-                          1, size, stat, dst_type);
-             if (src_rank > 0)
-               src_index[src_dim]
-                   += GFC_DIMENSION_STRIDE (src->dim[src_dim]);
-           }
-         return;
-       case CAF_ARR_REF_RANGE:
-         COMPUTE_NUM_ITEMS (extent_dst,
-                            ref->u.a.dim[dst_dim].s.stride,
-                            ref->u.a.dim[dst_dim].s.start,
-                            ref->u.a.dim[dst_dim].s.end);
-         array_offset_dst = ref->u.a.dim[dst_dim].s.start
-             - GFC_DIMENSION_LBOUND (dst->dim[dst_dim]);
-         stride_dst = GFC_DIMENSION_STRIDE (dst->dim[dst_dim])
-             * ref->u.a.dim[dst_dim].s.stride;
-         src_index[src_dim] = 0;
-         for (index_type idx = 0; idx < extent_dst; ++idx)
-           {
-             send_by_ref (ref, i, src_index, single_token, dst, src,
-                          ds + array_offset_dst * ref->item_size, sr,
-                          dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-                          1, size, stat, dst_type);
-             if (src_rank > 0)
-               src_index[src_dim]
-                   += GFC_DIMENSION_STRIDE (src->dim[src_dim]);
-             array_offset_dst += stride_dst;
-           }
-         return;
-       case CAF_ARR_REF_SINGLE:
-         array_offset_dst = (ref->u.a.dim[dst_dim].s.start
-                              - GFC_DIMENSION_LBOUND (dst->dim[dst_dim]))
-                            * GFC_DIMENSION_STRIDE (dst->dim[dst_dim]);
-         send_by_ref (ref, i, src_index, single_token, dst, src, ds
-                      + array_offset_dst * ref->item_size, sr,
-                      dst_kind, src_kind, dst_dim + 1, src_dim, 1,
-                      size, stat, dst_type);
-         return;
-       case CAF_ARR_REF_OPEN_END:
-         COMPUTE_NUM_ITEMS (extent_dst,
-                            ref->u.a.dim[dst_dim].s.stride,
-                            ref->u.a.dim[dst_dim].s.start,
-                            GFC_DIMENSION_UBOUND (dst->dim[dst_dim]));
-         array_offset_dst = ref->u.a.dim[dst_dim].s.start
-             - GFC_DIMENSION_LBOUND (dst->dim[dst_dim]);
-         stride_dst = GFC_DIMENSION_STRIDE (dst->dim[dst_dim])
-             * ref->u.a.dim[dst_dim].s.stride;
-         src_index[src_dim] = 0;
-         for (index_type idx = 0; idx < extent_dst; ++idx)
-           {
-             send_by_ref (ref, i, src_index, single_token, dst, src,
-                          ds + array_offset_dst * ref->item_size, sr,
-                          dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-                          1, size, stat, dst_type);
-             if (src_rank > 0)
-               src_index[src_dim]
-                   += GFC_DIMENSION_STRIDE (src->dim[src_dim]);
-             array_offset_dst += stride_dst;
-           }
-         return;
-       case CAF_ARR_REF_OPEN_START:
-         COMPUTE_NUM_ITEMS (extent_dst,
-                            ref->u.a.dim[dst_dim].s.stride,
-                            GFC_DIMENSION_LBOUND (dst->dim[dst_dim]),
-                            ref->u.a.dim[dst_dim].s.end);
-         array_offset_dst = 0;
-         stride_dst = GFC_DIMENSION_STRIDE (dst->dim[dst_dim])
-             * ref->u.a.dim[dst_dim].s.stride;
-         src_index[src_dim] = 0;
-         for (index_type idx = 0; idx < extent_dst; ++idx)
-           {
-             send_by_ref (ref, i, src_index, single_token, dst, src,
-                          ds + array_offset_dst * ref->item_size, sr,
-                          dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-                          1, size, stat, dst_type);
-             if (src_rank > 0)
-               src_index[src_dim]
-                   += GFC_DIMENSION_STRIDE (src->dim[src_dim]);
-             array_offset_dst += stride_dst;
-           }
-         return;
-       default:
-         caf_runtime_error (unreachable);
-       }
-      return;
-    case CAF_REF_STATIC_ARRAY:
-      if (ref->u.a.mode[dst_dim] == CAF_ARR_REF_NONE)
-       {
-         send_by_ref (ref->next, i, src_index, single_token, NULL,
-                      src, ds, sr, dst_kind, src_kind,
-                      0, src_dim, 1, size, stat, dst_type);
-         return;
-       }
-      switch (ref->u.a.mode[dst_dim])
-       {
-       case CAF_ARR_REF_VECTOR:
-         array_offset_dst = 0;
-         src_index[src_dim] = 0;
-         for (size_t idx = 0; idx < ref->u.a.dim[dst_dim].v.nvec;
-              ++idx)
-           {
-#define KINDCASE(kind, type) case kind: \
-            array_offset_dst = ((type *)ref->u.a.dim[dst_dim].v.vector)[idx]; \
-             break
-
-             switch (ref->u.a.dim[dst_dim].v.kind)
-               {
-               KINDCASE (1, GFC_INTEGER_1);
-               KINDCASE (2, GFC_INTEGER_2);
-               KINDCASE (4, GFC_INTEGER_4);
-#ifdef HAVE_GFC_INTEGER_8
-               KINDCASE (8, GFC_INTEGER_8);
-#endif
-#ifdef HAVE_GFC_INTEGER_16
-               KINDCASE (16, GFC_INTEGER_16);
-#endif
-               default:
-                 caf_runtime_error (unreachable);
-                 return;
-               }
-#undef KINDCASE
-
-             send_by_ref (ref, i, src_index, single_token, NULL, src,
-                          ds + array_offset_dst * ref->item_size, sr,
-                          dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-                          1, size, stat, dst_type);
-             src_index[src_dim]
-                 += GFC_DIMENSION_STRIDE (src->dim[src_dim]);
-           }
-         return;
-       case CAF_ARR_REF_FULL:
-         src_index[src_dim] = 0;
-         for (array_offset_dst = 0 ;
-              array_offset_dst <= ref->u.a.dim[dst_dim].s.end;
-              array_offset_dst += ref->u.a.dim[dst_dim].s.stride)
-           {
-             send_by_ref (ref, i, src_index, single_token, NULL, src,
-                          ds + array_offset_dst * ref->item_size, sr,
-                          dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-                          1, size, stat, dst_type);
-             if (src_rank > 0)
-               src_index[src_dim]
-                   += GFC_DIMENSION_STRIDE (src->dim[src_dim]);
-           }
-         return;
-       case CAF_ARR_REF_RANGE:
-         COMPUTE_NUM_ITEMS (extent_dst,
-                            ref->u.a.dim[dst_dim].s.stride,
-                            ref->u.a.dim[dst_dim].s.start,
-                            ref->u.a.dim[dst_dim].s.end);
-         array_offset_dst = ref->u.a.dim[dst_dim].s.start;
-         src_index[src_dim] = 0;
-         for (index_type idx = 0; idx < extent_dst; ++idx)
-           {
-             send_by_ref (ref, i, src_index, single_token, NULL, src,
-                          ds + array_offset_dst * ref->item_size, sr,
-                          dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-                          1, size, stat, dst_type);
-             if (src_rank > 0)
-               src_index[src_dim]
-                   += GFC_DIMENSION_STRIDE (src->dim[src_dim]);
-             array_offset_dst += ref->u.a.dim[dst_dim].s.stride;
-           }
-         return;
-       case CAF_ARR_REF_SINGLE:
-         array_offset_dst = ref->u.a.dim[dst_dim].s.start;
-         send_by_ref (ref, i, src_index, single_token, NULL, src,
-                      ds + array_offset_dst * ref->item_size, sr,
-                      dst_kind, src_kind, dst_dim + 1, src_dim, 1,
-                      size, stat, dst_type);
-         return;
-       /* The OPEN_* are mapped to a RANGE and therefore cannot occur.  */
-       case CAF_ARR_REF_OPEN_END:
-       case CAF_ARR_REF_OPEN_START:
-       default:
-         caf_runtime_error (unreachable);
-       }
-      return;
-    default:
-      caf_runtime_error (unreachable);
-    }
-}
-
-
-void
-_gfortran_caf_send_by_ref (caf_token_t token,
-                          int image_index __attribute__ ((unused)),
-                          gfc_descriptor_t *src, caf_reference_t *refs,
-                          int dst_kind, int src_kind,
-                          bool may_require_tmp __attribute__ ((unused)),
-                          bool dst_reallocatable, int *stat, int dst_type)
-{
-  const char vecrefunknownkind[] = "libcaf_single::caf_get_by_ref(): "
-                                  "unknown kind in vector-ref.\n";
-  const char unknownreftype[] = "libcaf_single::caf_send_by_ref(): "
-                               "unknown reference type.\n";
-  const char unknownarrreftype[] = "libcaf_single::caf_send_by_ref(): "
-                                  "unknown array reference type.\n";
-  const char rankoutofrange[] = "libcaf_single::caf_send_by_ref(): "
-                               "rank out of range.\n";
-  const char realloconinnerref[] = "libcaf_single::caf_send_by_ref(): "
-      "reallocation of array followed by component ref not allowed.\n";
-  const char cannotallocdst[] = "libcaf_single::caf_send_by_ref(): "
-                               "cannot allocate memory.\n";
-  const char nonallocextentmismatch[] = "libcaf_single::caf_send_by_ref(): "
-      "extent of non-allocatable array mismatch.\n";
-  const char innercompref[] = "libcaf_single::caf_send_by_ref(): "
-      "inner unallocated component detected.\n";
-  size_t size, i;
-  size_t dst_index[GFC_MAX_DIMENSIONS];
-  int src_rank = GFC_DESCRIPTOR_RANK (src);
-  int src_cur_dim = 0;
-  size_t src_size = 0;
-  caf_single_token_t single_token = TOKEN (token);
-  void *memptr = single_token->memptr;
-  gfc_descriptor_t *dst = single_token->desc;
-  caf_reference_t *riter = refs;
-  long delta;
-  bool extent_mismatch;
-  /* Note that the component is not allocated yet.  */
-  index_type new_component_idx = -1;
-
-  if (stat)
-    *stat = 0;
-
-  /* Compute the size of the result.  In the beginning size just counts the
-     number of elements.  */
-  size = 1;
-  while (riter)
-    {
-      switch (riter->type)
-       {
-       case CAF_REF_COMPONENT:
-         if (unlikely (new_component_idx != -1))
-           {
-             /* Allocating a component in the middle of a component ref is not
-                support.  We don't know the type to allocate.  */
-             caf_internal_error (innercompref, stat, NULL, 0);
-             return;
-           }
-         if (riter->u.c.caf_token_offset > 0)
-           {
-             /* Check whether the allocatable component is zero, then no
-                token is present, too.  The token's pointer is not cleared
-                when the structure is initialized.  */
-             if (*(void**)(memptr + riter->u.c.offset) == NULL)
-               {
-                 /* This component is not yet allocated.  Check that it is
-                    allocatable here.  */
-                 if (!dst_reallocatable)
-                   {
-                     caf_internal_error (cannotallocdst, stat, NULL, 0);
-                     return;
-                   }
-                 single_token = NULL;
-                 memptr = NULL;
-                 dst = NULL;
-                 break;
-               }
-             single_token = *(caf_single_token_t*)
-                                        (memptr + riter->u.c.caf_token_offset);
-             memptr += riter->u.c.offset;
-             dst = single_token->desc;
-           }
-         else
-           {
-             /* Regular component.  */
-             memptr += riter->u.c.offset;
-             dst = (gfc_descriptor_t *)memptr;
-           }
-         break;
-       case CAF_REF_ARRAY:
-         if (dst != NULL)
-           memptr = GFC_DESCRIPTOR_DATA (dst);
-         else
-           dst = src;
-         /* When the dst array needs to be allocated, then look at the
-            extent of the source array in the dimension dst_cur_dim.  */
-         for (i = 0; riter->u.a.mode[i] != CAF_ARR_REF_NONE; ++i)
-           {
-             switch (riter->u.a.mode[i])
-               {
-               case CAF_ARR_REF_VECTOR:
-                 delta = riter->u.a.dim[i].v.nvec;
-#define KINDCASE(kind, type) case kind: \
-                   memptr += (((index_type) \
-                       ((type *)riter->u.a.dim[i].v.vector)[0]) \
-                       - GFC_DIMENSION_LBOUND (dst->dim[i])) \
-                       * GFC_DIMENSION_STRIDE (dst->dim[i]) \
-                       * riter->item_size; \
-                   break
-
-                 switch (riter->u.a.dim[i].v.kind)
-                   {
-                   KINDCASE (1, GFC_INTEGER_1);
-                   KINDCASE (2, GFC_INTEGER_2);
-                   KINDCASE (4, GFC_INTEGER_4);
-#ifdef HAVE_GFC_INTEGER_8
-                   KINDCASE (8, GFC_INTEGER_8);
-#endif
-#ifdef HAVE_GFC_INTEGER_16
-                   KINDCASE (16, GFC_INTEGER_16);
-#endif
-                   default:
-                     caf_internal_error (vecrefunknownkind, stat, NULL, 0);
-                     return;
-                   }
-#undef KINDCASE
-                 break;
-               case CAF_ARR_REF_FULL:
-                 if (dst)
-                   COMPUTE_NUM_ITEMS (delta,
-                                      riter->u.a.dim[i].s.stride,
-                                      GFC_DIMENSION_LBOUND (dst->dim[i]),
-                                      GFC_DIMENSION_UBOUND (dst->dim[i]));
-                 else
-                   COMPUTE_NUM_ITEMS (delta,
-                                      riter->u.a.dim[i].s.stride,
-                                  GFC_DIMENSION_LBOUND (src->dim[src_cur_dim]),
-                                 GFC_DIMENSION_UBOUND (src->dim[src_cur_dim]));
-                 break;
-               case CAF_ARR_REF_RANGE:
-                 COMPUTE_NUM_ITEMS (delta,
-                                    riter->u.a.dim[i].s.stride,
-                                    riter->u.a.dim[i].s.start,
-                                    riter->u.a.dim[i].s.end);
-                 memptr += (riter->u.a.dim[i].s.start
-                            - dst->dim[i].lower_bound)
-                     * GFC_DIMENSION_STRIDE (dst->dim[i])
-                     * riter->item_size;
-                 break;
-               case CAF_ARR_REF_SINGLE:
-                 delta = 1;
-                 memptr += (riter->u.a.dim[i].s.start
-                            - dst->dim[i].lower_bound)
-                     * GFC_DIMENSION_STRIDE (dst->dim[i])
-                     * riter->item_size;
-                 break;
-               case CAF_ARR_REF_OPEN_END:
-                 if (dst)
-                   COMPUTE_NUM_ITEMS (delta,
-                                      riter->u.a.dim[i].s.stride,
-                                      riter->u.a.dim[i].s.start,
-                                      GFC_DIMENSION_UBOUND (dst->dim[i]));
-                 else
-                   COMPUTE_NUM_ITEMS (delta,
-                                      riter->u.a.dim[i].s.stride,
-                                      riter->u.a.dim[i].s.start,
-                                 GFC_DIMENSION_UBOUND (src->dim[src_cur_dim]));
-                 memptr += (riter->u.a.dim[i].s.start
-                            - dst->dim[i].lower_bound)
-                     * GFC_DIMENSION_STRIDE (dst->dim[i])
-                     * riter->item_size;
-                 break;
-               case CAF_ARR_REF_OPEN_START:
-                 if (dst)
-                   COMPUTE_NUM_ITEMS (delta,
-                                      riter->u.a.dim[i].s.stride,
-                                      GFC_DIMENSION_LBOUND (dst->dim[i]),
-                                      riter->u.a.dim[i].s.end);
-                 else
-                   COMPUTE_NUM_ITEMS (delta,
-                                      riter->u.a.dim[i].s.stride,
-                                  GFC_DIMENSION_LBOUND (src->dim[src_cur_dim]),
-                                      riter->u.a.dim[i].s.end);
-                 /* The memptr stays unchanged when ref'ing the first element
-                    in a dimension.  */
-                 break;
-               default:
-                 caf_internal_error (unknownarrreftype, stat, NULL, 0);
-                 return;
-               }
-
-             if (delta <= 0)
-               return;
-             /* Check the various properties of the source array.
-                When src is an array.  */
-             if (delta > 1 && src_rank > 0)
-               {
-                 /* Check that src_cur_dim is valid for src.  Can be
-                    superceeded only by scalar data.  */
-                 if (src_cur_dim >= src_rank)
-                   {
-                     caf_internal_error (rankoutofrange, stat, NULL, 0);
-                     return;
-                   }
-                 /* Do further checks, when the source is not scalar.  */
-                 else
-                   {
-                     /* When the realloc is required, then no extent may have
-                        been set.  */
-                     extent_mismatch = memptr == NULL
-                         || (dst
-                             && GFC_DESCRIPTOR_EXTENT (dst, src_cur_dim)
-                             != delta);
-                     /* When it already known, that a realloc is needed or
-                        the extent does not match the needed one.  */
-                     if (extent_mismatch)
-                       {
-                         /* Check whether dst is reallocatable.  */
-                         if (unlikely (!dst_reallocatable))
-                           {
-                             caf_internal_error (nonallocextentmismatch, stat,
-                                                 NULL, 0, delta,
-                                                 GFC_DESCRIPTOR_EXTENT (dst,
-                                                                 src_cur_dim));
-                             return;
-                           }
-                         /* Report error on allocatable but missing inner
-                            ref.  */
-                         else if (riter->next != NULL)
-                           {
-                             caf_internal_error (realloconinnerref, stat, NULL,
-                                                 0);
-                             return;
-                           }
-                       }
-                     /* Only change the extent when it does not match.  This is
-                        to prevent resetting given array bounds.  */
-                     if (extent_mismatch)
-                       GFC_DIMENSION_SET (dst->dim[src_cur_dim], 1, delta,
-                                          size);
-                   }
-                 /* Increase the dim-counter of the src only when the extent
-                    matches.  */
-                 if (src_cur_dim < src_rank
-                     && GFC_DESCRIPTOR_EXTENT (src, src_cur_dim) == delta)
-                   ++src_cur_dim;
-               }
-             size *= (index_type)delta;
-           }
-         break;
-       case CAF_REF_STATIC_ARRAY:
-         for (i = 0; riter->u.a.mode[i] != CAF_ARR_REF_NONE; ++i)
-           {
-             switch (riter->u.a.mode[i])
-               {
-               case CAF_ARR_REF_VECTOR:
-                 delta = riter->u.a.dim[i].v.nvec;
-#define KINDCASE(kind, type) case kind: \
-                   memptr += ((type *)riter->u.a.dim[i].v.vector)[0] \
-                       * riter->item_size; \
-                   break
-
-                 switch (riter->u.a.dim[i].v.kind)
-                   {
-                   KINDCASE (1, GFC_INTEGER_1);
-                   KINDCASE (2, GFC_INTEGER_2);
-                   KINDCASE (4, GFC_INTEGER_4);
-#ifdef HAVE_GFC_INTEGER_8
-                   KINDCASE (8, GFC_INTEGER_8);
-#endif
-#ifdef HAVE_GFC_INTEGER_16
-                   KINDCASE (16, GFC_INTEGER_16);
-#endif
-                   default:
-                     caf_internal_error (vecrefunknownkind, stat, NULL, 0);
-                     return;
-                   }
-#undef KINDCASE
-                 break;
-               case CAF_ARR_REF_FULL:
-                 delta = riter->u.a.dim[i].s.end / riter->u.a.dim[i].s.stride
-                     + 1;
-                 /* The memptr stays unchanged when ref'ing the first element
-                    in a dimension.  */
-                 break;
-               case CAF_ARR_REF_RANGE:
-                 COMPUTE_NUM_ITEMS (delta,
-                                    riter->u.a.dim[i].s.stride,
-                                    riter->u.a.dim[i].s.start,
-                                    riter->u.a.dim[i].s.end);
-                 memptr += riter->u.a.dim[i].s.start
-                     * riter->u.a.dim[i].s.stride
-                     * riter->item_size;
-                 break;
-               case CAF_ARR_REF_SINGLE:
-                 delta = 1;
-                 memptr += riter->u.a.dim[i].s.start
-                     * riter->u.a.dim[i].s.stride
-                     * riter->item_size;
-                 break;
-               case CAF_ARR_REF_OPEN_END:
-                 /* This and OPEN_START are mapped to a RANGE and therefore
-                    cannot occur here.  */
-               case CAF_ARR_REF_OPEN_START:
-               default:
-                 caf_internal_error (unknownarrreftype, stat, NULL, 0);
-                 return;
-               }
-             if (delta <= 0)
-               return;
-             /* Check the various properties of the source array.
-                Only when the source array is not scalar examine its
-                properties.  */
-             if (delta > 1 && src_rank > 0)
-               {
-                 /* Check that src_cur_dim is valid for src.  Can be
-                    superceeded only by scalar data.  */
-                 if (src_cur_dim >= src_rank)
-                   {
-                     caf_internal_error (rankoutofrange, stat, NULL, 0);
-                     return;
-                   }
-                 else
-                   {
-                     /* We will not be able to realloc the dst, because that's
-                        a fixed size array.  */
-                     extent_mismatch = GFC_DESCRIPTOR_EXTENT (src, src_cur_dim)
-                             != delta;
-                     /* When the extent does not match the needed one we can
-                        only stop here.  */
-                     if (extent_mismatch)
-                       {
-                         caf_internal_error (nonallocextentmismatch, stat,
-                                             NULL, 0, delta,
-                                             GFC_DESCRIPTOR_EXTENT (src,
-                                                                 src_cur_dim));
-                         return;
-                       }
-                   }
-                 ++src_cur_dim;
-               }
-             size *= (index_type)delta;
-           }
-         break;
-       default:
-         caf_internal_error (unknownreftype, stat, NULL, 0);
-         return;
-       }
-      src_size = riter->item_size;
-      riter = riter->next;
-    }
-  if (size == 0 || src_size == 0)
-    return;
-  /* Postcondition:
-     - size contains the number of elements to store in the destination array,
-     - src_size gives the size in bytes of each item in the destination array.
-  */
-
-  /* Reset the token.  */
-  single_token = TOKEN (token);
-  memptr = single_token->memptr;
-  dst = single_token->desc;
-  memset (dst_index, 0, sizeof (dst_index));
-  i = 0;
-  send_by_ref (refs, &i, dst_index, single_token, dst, src,
-              memptr, GFC_DESCRIPTOR_DATA (src), dst_kind, src_kind, 0, 0,
-              1, size, stat, dst_type);
-  assert (i == size);
-}
-
-
-void
-_gfortran_caf_sendget_by_ref (caf_token_t dst_token, int dst_image_index,
-                             caf_reference_t *dst_refs, caf_token_t src_token,
-                             int src_image_index,
-                             caf_reference_t *src_refs, int dst_kind,
-                             int src_kind, bool may_require_tmp, int *dst_stat,
-                             int *src_stat, int dst_type, int src_type)
-{
-  GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) temp;
-  GFC_DESCRIPTOR_DATA (&temp) = NULL;
-  GFC_DESCRIPTOR_RANK (&temp) = -1;
-  GFC_DESCRIPTOR_TYPE (&temp) = dst_type;
-
-  _gfortran_caf_get_by_ref (src_token, src_image_index,
-                           (gfc_descriptor_t *) &temp, src_refs,
-                           dst_kind, src_kind, may_require_tmp, true,
-                           src_stat, src_type);
-
-  if (src_stat && *src_stat != 0)
-    return;
-
-  _gfortran_caf_send_by_ref (dst_token, dst_image_index,
-                            (gfc_descriptor_t *) &temp, dst_refs,
-                            dst_kind, dst_kind, may_require_tmp, true,
-                            dst_stat, dst_type);
-  if (GFC_DESCRIPTOR_DATA (&temp))
-    free (GFC_DESCRIPTOR_DATA (&temp));
-}
-
 void
 _gfortran_caf_register_accessor (const int hash, getter_t accessor)
 {