libcaf.h: Add caf_reference_type.

libgfortran/ChangeLog:

2016-09-19  Andre Vehreschild  <vehre@gcc.gnu.org>

	* caf/libcaf.h: Add caf_reference_type.
	* caf/mpi.c: Adapted signature of caf_register().
	* caf/single.c (struct caf_single_token): Added to keep the pointer
	to the memory registered and array descriptor.
	(caf_internal_error): Added convenience interface.
	(_gfortran_caf_register): Adapted to work with caf_single_token and
	return memory in the array descriptor.
	(_gfortran_caf_deregister): Same.
	(assign_char1_from_char4): Fixed style.
	(convert_type): Fixed incorrect conversion.
	(_gfortran_caf_get): Adapted to work with caf_single_token.
	(_gfortran_caf_send): Same.
	(_gfortran_caf_sendget): Same.
	(copy_data): Added to stop repeating it in all _by_ref functions.
	(get_for_ref): Recursive getting of coarray data using a chain of
	references.
	(_gfortran_caf_get_by_ref): Driver for computing the memory needed for
	the get and checking properties of the operation.
	(send_by_ref): Same as get_for_ref but for sending data.
	(_gfortran_caf_send_by_ref): Same like caf_get_by_ref but for sending.
	(_gfortran_caf_sendget_by_ref): Uses get_by_ref and send_by_ref to
	implement sendget for reference chains.
	(_gfortran_caf_atomic_define): Adapted to work with caf_single_token.
	(_gfortran_caf_atomic_ref): Likewise.
	(_gfortran_caf_atomic_cas): Likewise.
	(_gfortran_caf_atomic_op): Likewise.
	(_gfortran_caf_event_post): Likewise.
	(_gfortran_caf_event_wait): Likewise.
	(_gfortran_caf_event_query): Likewise.
	(_gfortran_caf_lock): Likewise.
	(_gfortran_caf_unlock): Likewise.


gcc/testsuite/ChangeLog:

2016-09-19  Andre Vehreschild  <vehre@gcc.gnu.org>

	* gfortran.dg/coarray/alloc_comp_4.f90: New test.
	* gfortran.dg/coarray_38.f90:
	* gfortran.dg/coarray_alloc_comp_1.f08: New test.
	* gfortran.dg/coarray_alloc_comp_2.f08: New test.
	* gfortran.dg/coarray_allocate_7.f08: New test.
	* gfortran.dg/coarray_allocate_8.f08: New test.
	* gfortran.dg/coarray_allocate_9.f08: New test.
	* gfortran.dg/coarray_lib_alloc_1.f90: Adapted scan-tree-dumps to expect
	new caf_register.
	* gfortran.dg/coarray_lib_alloc_2.f90: Same.
	* gfortran.dg/coarray_lib_alloc_3.f90: Same.
	* gfortran.dg/coarray_lib_comm_1.f90: Adapted scan-tree-dumps to expect
	get_by_refs.
	* gfortran.dg/coarray_lib_token_3.f90: Same as for coarray_lib_alloc2.
	* gfortran.dg/coarray_lock_7.f90: Same.
	* gfortran.dg/coarray_poly_5.f90: Same.
	* gfortran.dg/coarray_poly_6.f90: Same.
	* gfortran.dg/coarray_poly_7.f90: Same.
	* gfortran.dg/coarray_poly_8.f90: Same.
	* gfortran.dg/coindexed_1.f90: Changed errors expected.

gcc/fortran/ChangeLog:

2016-09-19  Andre Vehreschild  <vehre@gcc.gnu.org>

	* expr.c (gfc_check_assign): Added flag to control whether datatype
	conversion is allowed.
	* gfortran.h: Added caf-token-tree to gfc_component.  Changed
	prototypes mostly to add whether datatype conversion is allowed.
	* gfortran.texi: Added documentation for the caf_reference_t and the
	caf_*_by_ref function.
	* primary.c (caf_variable_attr): Similar to gfc_variable_attr but
	focused on the needs of coarrays.
	(gfc_caf_attr): Same.
	* resolve.c (resolve_ordinary_assign): Set the conversion allowed
	flag when not in a coarray.
	* trans-array.c (gfc_array_init_size): Moved setting of array
	descriptor's datatype before the alloc, because caf_register needs it.
	(gfc_array_allocate): Changed notion of whether an array is a coarray.
	(gfc_array_deallocate): Same.
	(gfc_alloc_allocatable_for_assignment): Added setting of coarray's
	array descriptor datatype before the register.  And using deregister/
	register to mimmick a realloc for coarrays.
	* trans-decl.c (gfc_build_builtin_function_decls): Corrected signatures
	of old caf-functions and added signature definitions of the _by_ref
	ones.
	(generate_coarray_sym_init): Adapted to new caf_register signature.
	* trans-expr.c (gfc_conv_scalar_to_descriptor): Make sure a constant
	is translated to an lvalue expression before use in an array
	descriptor.
	(gfc_get_ultimate_alloc_ptr_comps_caf_token): New function.  Get the
	last allocatable component's coarray token.
	(gfc_get_tree_for_caf_expr): For top-level object get the coarray
	token and check for unsupported features.
	(gfc_get_caf_token_offset): Getting the offset might procude new
	statements, which now are stored in the pre and post of the current se.
	(gfc_caf_get_image_index): For this image return a call to
	caf_this_image.
	(expr_may_alias_variables): Check that the result is set for testing
	its properties.
	(alloc_scalar_allocatable_for_assignment): Added auto allocation of
	coarray components.
	(gfc_trans_assignment_1): Rewrite an assign to a coarray object to
	be a sendget.
	* trans-intrinsic.c (conv_caf_vector_subscript_elem): Corrected
	wrong comment.
	(compute_component_offset): Compute the correct offset a structure
	member.
	(conv_expr_ref_to_caf_ref): Convert to a chain of refs into
	caf_references.
	(gfc_conv_intrinsic_caf_get): Call caf_get_by_ref instead of caf_get.
	(conv_caf_send): Call caf_*_by_ref for coarrays that need
	reallocation.
	(gfc_conv_intrinsic_function): Adapted to new signuature of the caf
	drivers.
	(conv_intrinsic_atomic_op): Add pre and post statements correctly.
	(conv_intrinsic_atomic_ref): Same.
	(conv_intrinsic_atomic_cas): Same.
	(conv_intrinsic_event_query): Same.
	* trans-stmt.c (gfc_trans_lock_unlock): Same.
	(gfc_trans_event_post_wait): Same.
	(gfc_trans_allocate): Support allocation of allocatable coarrays.
	(gfc_trans_deallocate): And there deallocation.
	* trans-types.c (gfc_typenode_for_spec): Added flag to control whether
	a component is part of coarray.  When so, then add space to store a
	coarray token.
	(gfc_build_array_type): Same.
	(gfc_get_array_descriptor_base): Same.
	(gfc_get_array_type_bounds): Same.
	(gfc_sym_type): Same.
	(gfc_get_derived_type): Same.
	(gfc_get_caf_reference_type): Declare the caf_reference_type.
	* trans-types.h: Prototype changes only.
	* trans.c (gfc_allocate_using_lib): Use the updated caf_register
	signature.
	(gfc_allocate_allocatable): Same.
	(gfc_deallocate_with_status): Same.
	* trans.h: Defined the runtime types for caf_reference_t and the enums.

From-SVN: r240231

15 files changed, 1930 insertions, 226 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 973f615..a84e15e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,80 @@
+2016-09-19  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	PR fortran/71952
+	* expr.c (gfc_check_assign): Added flag to control whether datatype
+	conversion is allowed.
+	* gfortran.h: Added caf-token-tree to gfc_component.  Changed
+	prototypes mostly to add whether datatype conversion is allowed.
+	* gfortran.texi: Added documentation for the caf_reference_t and the
+	caf_*_by_ref function.
+	* primary.c (caf_variable_attr): Similar to gfc_variable_attr but
+	focused on the needs of coarrays.
+	(gfc_caf_attr): Same.
+	* resolve.c (resolve_ordinary_assign): Set the conversion allowed
+	flag when not in a coarray.
+	* trans-array.c (gfc_array_init_size): Moved setting of array
+	descriptor's datatype before the alloc, because caf_register needs it.
+	(gfc_array_allocate): Changed notion of whether an array is a coarray.
+	(gfc_array_deallocate): Same.
+	(gfc_alloc_allocatable_for_assignment): Added setting of coarray's
+	array descriptor datatype before the register.  And using deregister/
+	register to mimmick a realloc for coarrays.
+	* trans-decl.c (gfc_build_builtin_function_decls): Corrected signatures
+	of old caf-functions and added signature definitions of the _by_ref
+	ones.
+	(generate_coarray_sym_init): Adapted to new caf_register signature.
+	* trans-expr.c (gfc_conv_scalar_to_descriptor): Make sure a constant
+	is translated to an lvalue expression before use in an array
+	descriptor.
+	(gfc_get_ultimate_alloc_ptr_comps_caf_token): New function.  Get the
+	last allocatable component's coarray token.
+	(gfc_get_tree_for_caf_expr): For top-level object get the coarray
+	token and check for unsupported features.
+	(gfc_get_caf_token_offset): Getting the offset might procude new
+	statements, which now are stored in the pre and post of the current se.
+	(gfc_caf_get_image_index): For this image return a call to
+	caf_this_image.
+	(expr_may_alias_variables): Check that the result is set for testing
+	its properties.
+	(alloc_scalar_allocatable_for_assignment): Added auto allocation of
+	coarray components.
+	(gfc_trans_assignment_1): Rewrite an assign to a coarray object to
+	be a sendget.
+	* trans-intrinsic.c (conv_caf_vector_subscript_elem): Corrected
+	wrong comment.
+	(compute_component_offset): Compute the correct offset a structure
+	member.
+	(conv_expr_ref_to_caf_ref): Convert to a chain of refs into
+	caf_references.
+	(gfc_conv_intrinsic_caf_get): Call caf_get_by_ref instead of caf_get.
+	(conv_caf_send): Call caf_*_by_ref for coarrays that need
+	reallocation.
+	(gfc_conv_intrinsic_function): Adapted to new signuature of the caf
+	drivers.
+	(conv_intrinsic_atomic_op): Add pre and post statements correctly.
+	(conv_intrinsic_atomic_ref): Same.
+	(conv_intrinsic_atomic_cas): Same.
+	(conv_intrinsic_event_query): Same.
+	* trans-stmt.c (gfc_trans_lock_unlock): Same.
+	(gfc_trans_event_post_wait): Same.
+	(gfc_trans_allocate): Support allocation of allocatable coarrays.
+	(gfc_trans_deallocate): And there deallocation.
+	* trans-types.c (gfc_typenode_for_spec): Added flag to control whether
+	a component is part of coarray.  When so, then add space to store a
+	coarray token.
+	(gfc_build_array_type): Same.
+	(gfc_get_array_descriptor_base): Same.
+	(gfc_get_array_type_bounds): Same.
+	(gfc_sym_type): Same.
+	(gfc_get_derived_type): Same.
+	(gfc_get_caf_reference_type): Declare the caf_reference_type.
+	* trans-types.h: Prototype changes only.
+	* trans.c (gfc_allocate_using_lib): Use the updated caf_register
+	signature.
+	(gfc_allocate_allocatable): Same.
+	(gfc_deallocate_with_status): Same.
+	* trans.h: Defined the runtime types for caf_reference_t and the enums.
+
 2016-09-19  Fritz Reese  <fritzoreese@gmail.com>
 
 	PR fortran/77584
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 8e2b892..b3acf1d 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3128,10 +3128,14 @@ gfc_check_conformance (gfc_expr *op1, gfc_expr *op2, const char *optype_msgid, .
 
 
 /* Given an assignable expression and an arbitrary expression, make
-   sure that the assignment can take place.  */
+   sure that the assignment can take place.  Only add a call to the intrinsic
+   conversion routines, when allow_convert is set.  When this assign is a
+   coarray call, then the convert is done by the coarray routine implictly and
+   adding the intrinsic conversion would do harm in most cases.  */
 
 bool
-gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
+gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform,
+		  bool allow_convert)
 {
   gfc_symbol *sym;
   gfc_ref *ref;
@@ -3309,12 +3313,15 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
      kind values can be converted into one another.  */
   if (lvalue->ts.type == BT_CHARACTER && rvalue->ts.type == BT_CHARACTER)
     {
-      if (lvalue->ts.kind != rvalue->ts.kind)
+      if (lvalue->ts.kind != rvalue->ts.kind && allow_convert)
 	gfc_convert_chartype (rvalue, &lvalue->ts);
 
       return true;
     }
 
+  if (!allow_convert)
+    return true;
+
   return gfc_convert_type (rvalue, &lvalue->ts, 1);
 }
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 2acf64c..c3fb6ed 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1043,6 +1043,8 @@ typedef struct gfc_component
 
   /* Needed for procedure pointer components.  */
   struct gfc_typebound_proc *tb;
+  /* When allocatable/pointer and in a coarray the associated token.  */
+  tree caf_token;
 }
 gfc_component;
 
@@ -2768,7 +2770,7 @@ int gfc_validate_kind (bt, int, bool);
 int gfc_get_int_kind_from_width_isofortranenv (int size);
 int gfc_get_real_kind_from_width_isofortranenv (int size);
 tree gfc_get_union_type (gfc_symbol *);
-tree gfc_get_derived_type (gfc_symbol * derived);
+tree gfc_get_derived_type (gfc_symbol * derived, bool in_coarray = false);
 extern int gfc_index_integer_kind;
 extern int gfc_default_integer_kind;
 extern int gfc_max_integer_kind;
@@ -3047,7 +3049,7 @@ int gfc_numeric_ts (gfc_typespec *);
 int gfc_kind_max (gfc_expr *, gfc_expr *);
 
 bool gfc_check_conformance (gfc_expr *, gfc_expr *, const char *, ...) ATTRIBUTE_PRINTF_3;
-bool gfc_check_assign (gfc_expr *, gfc_expr *, int);
+bool gfc_check_assign (gfc_expr *, gfc_expr *, int, bool c = true);
 bool gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
 bool gfc_check_assign_symbol (gfc_symbol *, gfc_component *, gfc_expr *);
 
@@ -3212,6 +3214,7 @@ const char *gfc_dt_upper_string (const char *);
 /* primary.c */
 symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
 symbol_attribute gfc_expr_attr (gfc_expr *);
+symbol_attribute gfc_caf_attr (gfc_expr *, bool in_allocate = false);
 match gfc_match_rvalue (gfc_expr **);
 match gfc_match_varspec (gfc_expr*, int, bool, bool);
 int gfc_check_digit (char, int);
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index e80a1ea..85c1986 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -3571,6 +3571,7 @@ of such a type
 @menu
 * caf_token_t::
 * caf_register_t::
+* caf_reference_t::
 @end menu
 
 @node caf_token_t
@@ -3597,6 +3598,114 @@ typedef enum caf_register_t {
 caf_register_t;
 @end verbatim
 
+@node caf_reference_t
+@subsection @code{caf_reference_t}
+
+The structure used for implementing arbitrary reference chains.
+A @code{CAF_REFERENCE_T} allows to specify a component reference or any kind
+of array reference of any rank supported by gfortran.  For array references all
+kinds as known by the compiler/Fortran standard are supported indicated by
+a @code{MODE}.
+
+@verbatim
+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.  I.e., the coarray object
+     has no array descriptor associated and the addressing is done
+     completely using the ref.  */
+  CAF_REF_STATIC_ARRAY
+} caf_ref_type_t;
+@end verbatim
+
+@verbatim
+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;
+@end verbatim
+
+@verbatim
+/* 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.
+         Unused for allocatable or pointer components.  */
+      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;
+@end verbatim
+
+The references make up a single linked list of reference operations.  The
+@code{NEXT} member links to the next reference or NULL to indicate the end of
+the chain.  Component and array refs can be arbitrarly mixed as long as they
+comply to the Fortran standard.
+
+@emph{NOTES}
+The member @code{STATIC_ARRAY_TYPE} is used only when the @code{TYPE} is
+@code{CAF_REF_STATIC_ARRAY}.  The member gives the type of the data referenced.
+Because no array descriptor is available for a descriptor-less array and
+type conversion still needs to take place the type is transported here.
+
+At the moment @code{CAF_ARR_REF_VECTOR} is not implemented in the front end for
+descriptor-less arrays.  The library caf_single has untested support for it.
+
 
 @node Function ABI Documentation
 @section Function ABI Documentation
@@ -3611,6 +3720,9 @@ caf_register_t;
 * _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_sendget_by_ref:: Sending data between remote images using enhanced references
 * _gfortran_caf_lock:: Locking a lock variable
 * _gfortran_caf_unlock:: Unlocking a lock variable
 * _gfortran_caf_event_post:: Post an event
@@ -3742,19 +3854,24 @@ the the compiler passes @code{distance=0} and @code{failed=-1} to the function.
 
 @node _gfortran_caf_register
 @subsection @code{_gfortran_caf_register} --- Registering coarrays
-@cindex Coarray, _gfortran_caf_deregister
+@cindex Coarray, _gfortran_caf_register
 
 @table @asis
 @item @emph{Description}:
-Allocates memory for a coarray and creates a token to identify the coarray. The
-function is called for both coarrays with @code{SAVE} attribute and using an
-explicit @code{ALLOCATE} statement. If an error occurs and @var{STAT} is a
+Registers memory for a coarray and creates a token to identify the coarray.  The
+routine is called for both coarrays with @code{SAVE} attribute and using an
+explicit @code{ALLOCATE} statement.  If an error occurs and @var{STAT} is a
 @code{NULL} pointer, the function shall abort with printing an error message
 and starting the error termination.  If no error occurs and @var{STAT} is
-present, it shall be set to zero. Otherwise, it shall be set to a positive
+present, it shall be set to zero.  Otherwise, it shall be set to a positive
 value and, if not-@code{NULL}, @var{ERRMSG} shall be set to a string describing
-the failure. The function shall return a pointer to the requested memory
-for the local image as a call to @code{malloc} would do.
+the failure.  The routine shall register the memory provided in the
+@code{DATA}-component of the array descriptor @var{DESC}, when that component
+is non-@code{NULL}, else it shall allocate sufficient memory and provide a
+pointer to it in the @code{DATA}-component of @var{DESC}.  The array descriptor
+has rank zero, when a scalar object is to be registered and the array
+descriptor may be invalid after the call to @code{_gfortran_caf_register}.
+When an array is to be allocated the descriptor persists.
 
 For @code{CAF_REGTYPE_COARRAY_STATIC} and @code{CAF_REGTYPE_COARRAY_ALLOC},
 the passed size is the byte size requested.  For @code{CAF_REGTYPE_LOCK_STATIC},
@@ -3763,8 +3880,8 @@ size or one for a scalar.
 
 
 @item @emph{Syntax}:
-@code{void *caf_register (size_t size, caf_register_t type, caf_token_t *token,
-int *stat, char *errmsg, int errmsg_len)}
+@code{void caf_register (size_t size, caf_register_t type, caf_token_t *token,
+gfc_descriptor_t *desc, int *stat, char *errmsg, int errmsg_len)}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
@@ -3772,6 +3889,7 @@ int *stat, char *errmsg, int errmsg_len)}
 allocated; for lock types and event types, the number of elements.
 @item @var{type} @tab one of the caf_register_t types.
 @item @var{token} @tab intent(out) An opaque pointer identifying the coarray.
+@item @var{desc} @tab intent(inout) The (pseudo) array descriptor.
 @item @var{stat} @tab intent(out) For allocatable coarrays, stores the STAT=;
 may be NULL
 @item @var{errmsg} @tab intent(out) When an error occurs, this will be set to
@@ -3787,12 +3905,12 @@ GCC does such that also nonallocatable coarrays the memory is allocated and no
 static memory is used.  The token permits to identify the coarray; to the
 processor, the token is a nonaliasing pointer. The library can, for instance,
 store the base address of the coarray in the token, some handle or a more
-complicated struct.
+complicated struct.  The library may also store the array descriptor
+@var{DESC} when its rank is non-zero.
 
-For normal coarrays, the returned pointer is used for accesses on the local
-image. For lock types, the value shall only used for checking the allocation
+For lock types, the value shall only used for checking the allocation
 status. Note that for critical blocks, the locking is only required on one
-image; in the locking statement, the processor shall always pass always an
+image; in the locking statement, the processor shall always pass an
 image index of one for critical-block lock variables
 (@code{CAF_REGTYPE_CRITICAL}). For lock types and critical-block variables,
 the initial value shall be unlocked (or, respecitively, not in critical
@@ -3800,7 +3918,6 @@ section) such as the value false; for event types, the initial state should
 be no event, e.g. zero.
 @end table
 
-
 @node _gfortran_caf_deregister
 @subsection @code{_gfortran_caf_deregister} --- Deregistering coarrays
 @cindex Coarray, _gfortran_caf_deregister
@@ -3809,14 +3926,17 @@ be no event, e.g. zero.
 @item @emph{Description}:
 Called to free the memory of a coarray; the processor calls this function for
 automatic and explicit deallocation.  In case of an error, this function shall
-fail with an error message, unless the @var{STAT} variable is not null.
+fail with an error message, unless the @var{STAT} variable is not null.  The
+library is only expected to free memory it allocated itself during a call to
+@code{_gfortran_caf_register}.
 
 @item @emph{Syntax}:
-@code{void caf_deregister (const caf_token_t *token, int *stat, char *errmsg,
+@code{void caf_deregister (caf_token_t *token, int *stat, char *errmsg,
 int errmsg_len)}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
+@item @var{token} @tab the token to free.
 @item @var{stat} @tab intent(out) Stores the STAT=; may be NULL
 @item @var{errmsg} @tab intent(out) When an error occurs, this will be set
 to an error message; may be NULL
@@ -3997,6 +4117,186 @@ 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 whole array from a local to a
+remote image identified by the 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)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{token} @tab intent(in)  An opaque pointer identifying the coarray.
+@item @var{image_index} @tab 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 Kind of the destination argument
+@item @var{src_kind} @tab Kind of the source argument
+@item @var{may_require_tmp} @tab The variable is false 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 element wise
+element order (honoring the stride value) will not lead to wrong results.
+Otherwise, the value is true.
+@item @var{dst_reallocatable} @tab set when the destination is of allocatable
+or pointer type and the refs will 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 non-zero on error.  When @code{NULL} and
+error occurs, then an error message is printed and the program is terminated.
+@end multitable
+
+@item @emph{NOTES}
+It is permitted to have image_id 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 whole array from a a remote image
+identified by the 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)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{token} @tab intent(in)  An opaque pointer identifying the coarray.
+@item @var{image_index} @tab 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 Kind of the destination argument
+@item @var{src_kind} @tab Kind of the source argument
+@item @var{may_require_tmp} @tab The variable is false 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 element wise
+element order (honoring the stride value) will not lead to wrong results.
+Otherwise, the value is true.
+@item @var{dst_reallocatable} @tab 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 non-zero on error.  When @code{NULL} and
+error occurs, then an error message is printed and the program is terminated.
+@end multitable
+
+@item @emph{NOTES}
+It is permitted to have image_id 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_sendget_by_ref
+@subsection @code{_gfortran_caf_sendget_by_ref} --- Sending data between remote images using enhanced references on both sides
+@cindex Coarray, _gfortran_caf_sendget_by_ref
+
+@table @asis
+@item @emph{Description}:
+Called to send a scalar, an array section or whole array from a remote image
+identified by the src_image_index to a remote image identified by the
+dst_image_index.
+
+@item @emph{Syntax}:
+@code{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)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{dst_token} @tab intent(in)  An opaque pointer identifying the
+destination coarray.
+@item @var{dst_image_index} @tab The ID of the destination remote image; must
+be a positive number.
+@item @var{dst_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{src_token} @tab An opaque pointer identifying the source coarray.
+@item @var{src_image_index} @tab The ID of the source remote image; must be a
+positive number.
+@item @var{src_refs} @tab intent(in) the references to apply to the remote
+structure to get the data.
+@item @var{dst_kind} @tab Kind of the destination argument
+@item @var{src_kind} @tab Kind of the source argument
+@item @var{may_require_tmp} @tab The variable is false 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 element wise
+element order (honoring the stride value) will not lead to wrong results.
+Otherwise, the value is true.
+@item @var{dst_stat} @tab intent(out) when non-@code{NULL} give the result of
+the send-operation, i.e., zero on success and non-zero on error.  When
+@code{NULL} and an error occurs, then an error message is printed and the
+program is terminated.
+@item @var{src_stat} @tab intent(out) when non-@code{NULL} give the result of
+the get-operation, i.e., zero on success and non-zero on error.  When
+@code{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 image_ids equal; 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_lock
 @subsection @code{_gfortran_caf_lock} --- Locking a lock variable
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 396edf2..c5e9778 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2376,6 +2376,163 @@ gfc_expr_attr (gfc_expr *e)
 }
 
 
+/* Given an expression, figure out what the ultimate expression
+   attribute is.  This routine is similar to gfc_variable_attr with
+   parts of gfc_expr_attr, but focuses more on the needs of
+   coarrays.  For coarrays a codimension attribute is kind of
+   "infectious" being propagated once set and never cleared.  */
+
+static symbol_attribute
+caf_variable_attr (gfc_expr *expr, bool in_allocate)
+{
+  int dimension, codimension, pointer, allocatable, target, coarray_comp,
+      alloc_comp;
+  symbol_attribute attr;
+  gfc_ref *ref;
+  gfc_symbol *sym;
+  gfc_component *comp;
+
+  if (expr->expr_type != EXPR_VARIABLE && expr->expr_type != EXPR_FUNCTION)
+    gfc_internal_error ("gfc_caf_attr(): Expression isn't a variable");
+
+  sym = expr->symtree->n.sym;
+  gfc_clear_attr (&attr);
+
+  if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
+    {
+      dimension = CLASS_DATA (sym)->attr.dimension;
+      codimension = CLASS_DATA (sym)->attr.codimension;
+      pointer = CLASS_DATA (sym)->attr.class_pointer;
+      allocatable = CLASS_DATA (sym)->attr.allocatable;
+      coarray_comp = CLASS_DATA (sym)->attr.coarray_comp;
+      alloc_comp = CLASS_DATA (sym)->ts.u.derived->attr.alloc_comp;
+    }
+  else
+    {
+      dimension = sym->attr.dimension;
+      codimension = sym->attr.codimension;
+      pointer = sym->attr.pointer;
+      allocatable = sym->attr.allocatable;
+      coarray_comp = sym->attr.coarray_comp;
+      alloc_comp = sym->ts.type == BT_DERIVED
+	  ? sym->ts.u.derived->attr.alloc_comp : 0;
+    }
+
+  target = attr.target;
+  if (pointer || attr.proc_pointer)
+    target = 1;
+
+  for (ref = expr->ref; ref; ref = ref->next)
+    switch (ref->type)
+      {
+      case REF_ARRAY:
+
+	switch (ref->u.ar.type)
+	  {
+	  case AR_FULL:
+	  case AR_SECTION:
+	    dimension = 1;
+	    break;
+
+	  case AR_ELEMENT:
+	    /* Handle coarrays.  */
+	    if (ref->u.ar.dimen > 0 && !in_allocate)
+	      allocatable = pointer = 0;
+	    break;
+
+	  case AR_UNKNOWN:
+	    /* If any of start, end or stride is not integer, there will
+	       already have been an error issued.  */
+	    int errors;
+	    gfc_get_errors (NULL, &errors);
+	    if (errors == 0)
+	      gfc_internal_error ("gfc_caf_attr(): Bad array reference");
+	  }
+
+	break;
+
+      case REF_COMPONENT:
+	comp = ref->u.c.component;
+
+	if (comp->ts.type == BT_CLASS)
+	  {
+	    codimension |= CLASS_DATA (comp)->attr.codimension;
+	    pointer = CLASS_DATA (comp)->attr.class_pointer;
+	    allocatable = CLASS_DATA (comp)->attr.allocatable;
+	    coarray_comp |= CLASS_DATA (comp)->attr.coarray_comp;
+	  }
+	else
+	  {
+	    codimension |= comp->attr.codimension;
+	    pointer = comp->attr.pointer;
+	    allocatable = comp->attr.allocatable;
+	    coarray_comp |= comp->attr.coarray_comp;
+	  }
+
+	if (pointer || attr.proc_pointer)
+	  target = 1;
+
+	break;
+
+      case REF_SUBSTRING:
+	allocatable = pointer = 0;
+	break;
+      }
+
+  attr.dimension = dimension;
+  attr.codimension = codimension;
+  attr.pointer = pointer;
+  attr.allocatable = allocatable;
+  attr.target = target;
+  attr.save = sym->attr.save;
+  attr.coarray_comp = coarray_comp;
+  attr.alloc_comp = alloc_comp;
+
+  return attr;
+}
+
+
+symbol_attribute
+gfc_caf_attr (gfc_expr *e, bool in_allocate)
+{
+  symbol_attribute attr;
+
+  switch (e->expr_type)
+    {
+    case EXPR_VARIABLE:
+      attr = caf_variable_attr (e, in_allocate);
+      break;
+
+    case EXPR_FUNCTION:
+      gfc_clear_attr (&attr);
+
+      if (e->value.function.esym && e->value.function.esym->result)
+	{
+	  gfc_symbol *sym = e->value.function.esym->result;
+	  attr = sym->attr;
+	  if (sym->ts.type == BT_CLASS)
+	    {
+	      attr.dimension = CLASS_DATA (sym)->attr.dimension;
+	      attr.pointer = CLASS_DATA (sym)->attr.class_pointer;
+	      attr.allocatable = CLASS_DATA (sym)->attr.allocatable;
+	      attr.alloc_comp = CLASS_DATA (sym)->ts.u.derived->attr.alloc_comp;
+	    }
+	}
+      else if (e->symtree)
+	attr = caf_variable_attr (e, in_allocate);
+      else
+	gfc_clear_attr (&attr);
+      break;
+
+    default:
+      gfc_clear_attr (&attr);
+      break;
+    }
+
+  return attr;
+}
+
+
 /* Match a structure constructor.  The initial symbol has already been
    seen.  */
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 037c2fe..11b6a14 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9839,27 +9839,29 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
       return false;
     }
 
-  gfc_check_assign (lhs, rhs, 1);
-
   /* Assign the 'data' of a class object to a derived type.  */
   if (lhs->ts.type == BT_DERIVED
       && rhs->ts.type == BT_CLASS)
     gfc_add_data_component (rhs);
 
-  /* Insert a GFC_ISYM_CAF_SEND intrinsic, when the LHS is a coindexed variable.
-     Additionally, insert this code when the RHS is a CAF as we then use the
-     GFC_ISYM_CAF_SEND intrinsic just to avoid a temporary; but do not do so if
-     the LHS is (re)allocatable or has a vector subscript.  If the LHS is a
-     noncoindexed array and the RHS is a coindexed scalar, use the normal code
-     path.  */
-  if (flag_coarray == GFC_FCOARRAY_LIB
+  bool caf_convert_to_send = flag_coarray == GFC_FCOARRAY_LIB
       && (lhs_coindexed
 	  || (code->expr2->expr_type == EXPR_FUNCTION
 	      && code->expr2->value.function.isym
 	      && code->expr2->value.function.isym->id == GFC_ISYM_CAF_GET
 	      && (code->expr1->rank == 0 || code->expr2->rank != 0)
 	      && !gfc_expr_attr (rhs).allocatable
-              && !gfc_has_vector_subscript (rhs))))
+	      && !gfc_has_vector_subscript (rhs)));
+
+  gfc_check_assign (lhs, rhs, 1, !caf_convert_to_send);
+
+  /* Insert a GFC_ISYM_CAF_SEND intrinsic, when the LHS is a coindexed variable.
+     Additionally, insert this code when the RHS is a CAF as we then use the
+     GFC_ISYM_CAF_SEND intrinsic just to avoid a temporary; but do not do so if
+     the LHS is (re)allocatable or has a vector subscript.  If the LHS is a
+     noncoindexed array and the RHS is a coindexed scalar, use the normal code
+     path.  */
+  if (caf_convert_to_send)
     {
       if (code->expr2->expr_type == EXPR_FUNCTION
 	  && code->expr2->value.function.isym
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 2699a76..bb33a23 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5083,19 +5083,19 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
   stride = gfc_index_one_node;
   offset = gfc_index_zero_node;
 
-  /* Set the dtype.  */
+  /* Set the dtype before the alloc, because registration of coarrays needs
+     it initialized.  */
   if (expr->ts.type == BT_CHARACTER && expr->ts.deferred
       && TREE_CODE (expr->ts.u.cl->backend_decl) == VAR_DECL)
     {
       type = gfc_typenode_for_spec (&expr->ts);
       tmp = gfc_conv_descriptor_dtype (descriptor);
-      gfc_add_modify (descriptor_block, tmp,
-		      gfc_get_dtype_rank_type (rank, type));
+      gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type));
     }
   else
     {
       tmp = gfc_conv_descriptor_dtype (descriptor);
-      gfc_add_modify (descriptor_block, tmp, gfc_get_dtype (type));
+      gfc_add_modify (pblock, tmp, gfc_get_dtype (type));
     }
 
   or_expr = boolean_false_node;
@@ -5404,7 +5404,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
   stmtblock_t elseblock;
   gfc_expr **lower;
   gfc_expr **upper;
-  gfc_ref *ref, *prev_ref = NULL;
+  gfc_ref *ref, *prev_ref = NULL, *coref;
+  gfc_se caf_se;
   bool allocatable, coarray, dimension, alloc_w_e3_arr_spec = false;
 
   ref = expr->ref;
@@ -5418,16 +5419,25 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
   if (!prev_ref)
     {
       allocatable = expr->symtree->n.sym->attr.allocatable;
-      coarray = expr->symtree->n.sym->attr.codimension;
       dimension = expr->symtree->n.sym->attr.dimension;
     }
   else
     {
       allocatable = prev_ref->u.c.component->attr.allocatable;
-      coarray = prev_ref->u.c.component->attr.codimension;
       dimension = prev_ref->u.c.component->attr.dimension;
     }
 
+  /* For allocatable/pointer arrays in derived types, one of the refs has to be
+     a coarray.  In this case it does not matter whether we are on this_image
+     or not.  */
+  coarray = false;
+  for (coref = expr->ref; coref; coref = coref->next)
+    if (coref->type == REF_ARRAY && coref->u.ar.codimen > 0)
+      {
+	coarray = true;
+	break;
+      }
+
   if (!dimension)
     gcc_assert (coarray);
 
@@ -5482,6 +5492,9 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
   overflow = integer_zero_node;
 
   gfc_init_block (&set_descriptor_block);
+  /* Take the corank only from the actual ref and not from the coref.  The
+     later will mislead the generation of the array dimensions for allocatable/
+     pointer components in derived types.  */
   size = gfc_array_init_size (se->expr, alloc_w_e3_arr_spec ? expr->rank
 							   : ref->u.ar.as->rank,
 			      coarray ? ref->u.ar.as->corank : 0,
@@ -5517,6 +5530,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
 	}
     }
 
+  gfc_init_se (&caf_se, NULL);
   gfc_start_block (&elseblock);
 
   /* Allocate memory to store the data.  */
@@ -5527,16 +5541,22 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
   STRIP_NOPS (pointer);
 
   if (coarray && flag_coarray == GFC_FCOARRAY_LIB)
-    token = gfc_build_addr_expr (NULL_TREE,
-				 gfc_conv_descriptor_token (se->expr));
+    {
+      tmp = gfc_get_tree_for_caf_expr (expr);
+      gfc_get_caf_token_offset (&caf_se, &token, NULL, tmp, NULL_TREE, expr);
+      gfc_add_block_to_block (&elseblock, &caf_se.pre);
+      token = gfc_build_addr_expr (NULL_TREE, token);
+    }
 
   /* The allocatable variant takes the old pointer as first argument.  */
   if (allocatable)
     gfc_allocate_allocatable (&elseblock, pointer, size, token,
-			      status, errmsg, errlen, label_finish, expr);
+			      status, errmsg, errlen, label_finish, expr,
+			      coref != NULL ? coref->u.ar.as->corank : 0);
   else
     gfc_allocate_using_malloc (&elseblock, pointer, size, status);
 
+  gfc_add_block_to_block (&elseblock, &caf_se.post);
   if (dimension)
     {
       cond = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR,
@@ -5592,7 +5612,7 @@ gfc_array_deallocate (tree descriptor, tree pstat, tree errmsg, tree errlen,
   tree var;
   tree tmp;
   stmtblock_t block;
-  bool coarray = gfc_is_coarray (expr);
+  bool coarray = gfc_caf_attr (expr).codimension;
 
   gfc_start_block (&block);
 
@@ -8659,6 +8679,10 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
   int n;
   int dim;
   gfc_array_spec * as;
+  bool coarray = (flag_coarray == GFC_FCOARRAY_LIB
+		  && gfc_caf_attr (expr1, true).codimension);
+  tree token;
+  gfc_se caf_se;
 
   /* x = f(...) with x allocatable.  In this case, expr1 is the rhs.
      Find the lhs expression in the loop chain and set expr1 and
@@ -8973,11 +8997,30 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
       gfc_add_modify (&fblock, tmp,
 		      gfc_get_dtype_rank_type (expr1->rank,type));
     }
+  else if (coarray && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
+    {
+      gfc_add_modify (&fblock, gfc_conv_descriptor_dtype (desc),
+		      gfc_get_dtype (TREE_TYPE (desc)));
+    }
 
   /* Realloc expression.  Note that the scalarizer uses desc.data
      in the array reference - (*desc.data)[<element>].  */
   gfc_init_block (&realloc_block);
+  gfc_init_se (&caf_se, NULL);
 
+  if (coarray)
+    {
+      token = gfc_get_ultimate_alloc_ptr_comps_caf_token (&caf_se, expr1);
+      if (token == NULL_TREE)
+	{
+	  tmp = gfc_get_tree_for_caf_expr (expr1);
+	  gfc_get_caf_token_offset (&caf_se, &token, NULL, tmp, NULL_TREE,
+				    expr1);
+	  token = gfc_build_addr_expr (NULL_TREE, token);
+	}
+
+      gfc_add_block_to_block (&realloc_block, &caf_se.pre);
+    }
   if ((expr1->ts.type == BT_DERIVED)
 	&& expr1->ts.u.derived->attr.alloc_comp)
     {
@@ -8986,12 +9029,32 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
       gfc_add_expr_to_block (&realloc_block, tmp);
     }
 
-  tmp = build_call_expr_loc (input_location,
-			     builtin_decl_explicit (BUILT_IN_REALLOC), 2,
-			     fold_convert (pvoid_type_node, array1),
-			     size2);
-  gfc_conv_descriptor_data_set (&realloc_block,
-				desc, tmp);
+  if (!coarray)
+    {
+      tmp = build_call_expr_loc (input_location,
+				 builtin_decl_explicit (BUILT_IN_REALLOC), 2,
+				 fold_convert (pvoid_type_node, array1),
+				 size2);
+      gfc_conv_descriptor_data_set (&realloc_block,
+				    desc, tmp);
+    }
+  else
+    {
+      tmp = build_call_expr_loc (input_location,
+				 gfor_fndecl_caf_deregister,
+				 4, token, null_pointer_node,
+				 null_pointer_node, integer_zero_node);
+      gfc_add_expr_to_block (&realloc_block, tmp);
+      tmp = build_call_expr_loc (input_location,
+				 gfor_fndecl_caf_register,
+				 7, size2,
+				 build_int_cst (integer_type_node,
+						GFC_CAF_COARRAY_ALLOC),
+				 token, gfc_build_addr_expr (NULL_TREE, desc),
+				 null_pointer_node, null_pointer_node,
+				 integer_zero_node);
+      gfc_add_expr_to_block (&realloc_block, tmp);
+    }
 
   if ((expr1->ts.type == BT_DERIVED)
 	&& expr1->ts.u.derived->attr.alloc_comp)
@@ -9001,6 +9064,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
       gfc_add_expr_to_block (&realloc_block, tmp);
     }
 
+  gfc_add_block_to_block (&realloc_block, &caf_se.post);
   realloc_expr = gfc_finish_block (&realloc_block);
 
   /* Only reallocate if sizes are different.  */
@@ -9011,16 +9075,33 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
 
   /* Malloc expression.  */
   gfc_init_block (&alloc_block);
-  tmp = build_call_expr_loc (input_location,
-			     builtin_decl_explicit (BUILT_IN_MALLOC),
-			     1, size2);
-  gfc_conv_descriptor_data_set (&alloc_block,
-				desc, tmp);
+  if (!coarray)
+    {
+      tmp = build_call_expr_loc (input_location,
+				 builtin_decl_explicit (BUILT_IN_MALLOC),
+				 1, size2);
+      gfc_conv_descriptor_data_set (&alloc_block,
+				    desc, tmp);
+    }
+  else
+    {
+      tmp = build_call_expr_loc (input_location,
+				 gfor_fndecl_caf_register,
+				 7, size2,
+				 build_int_cst (integer_type_node,
+						GFC_CAF_COARRAY_ALLOC),
+				 token, gfc_build_addr_expr (NULL_TREE, desc),
+				 null_pointer_node, null_pointer_node,
+				 integer_zero_node);
+      gfc_add_expr_to_block (&alloc_block, tmp);
+    }
+
 
   /* We already set the dtype in the case of deferred character
      length arrays.  */
   if (!(GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))
-        && expr1->ts.type == BT_CHARACTER && expr1->ts.deferred))
+	&& ((expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
+	    || coarray)))
     {
       tmp = gfc_conv_descriptor_dtype (desc);
       gfc_add_modify (&alloc_block, tmp, gfc_get_dtype (TREE_TYPE (desc)));
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 5bae8ca..1bab5d5 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -135,6 +135,9 @@ tree gfor_fndecl_caf_deregister;
 tree gfor_fndecl_caf_get;
 tree gfor_fndecl_caf_send;
 tree gfor_fndecl_caf_sendget;
+tree gfor_fndecl_caf_get_by_ref;
+tree gfor_fndecl_caf_send_by_ref;
+tree gfor_fndecl_caf_sendget_by_ref;
 tree gfor_fndecl_caf_sync_all;
 tree gfor_fndecl_caf_sync_memory;
 tree gfor_fndecl_caf_sync_images;
@@ -3560,12 +3563,12 @@ gfc_build_builtin_function_decls (void)
 	2, integer_type_node, integer_type_node);
 
       gfor_fndecl_caf_register = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("caf_register")), "...WWW", pvoid_type_node, 6,
-	size_type_node, integer_type_node, ppvoid_type_node, pint_type,
-	pchar_type_node, integer_type_node);
+	get_identifier (PREFIX("caf_register")), "RRWWWWR", void_type_node, 7,
+	size_type_node, integer_type_node, ppvoid_type_node, pvoid_type_node,
+	pint_type, pchar_type_node, integer_type_node);
 
       gfor_fndecl_caf_deregister = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("caf_deregister")), ".WWW", void_type_node, 4,
+	get_identifier (PREFIX("caf_deregister")), "WWWR", void_type_node, 4,
 	ppvoid_type_node, pint_type, pchar_type_node, integer_type_node);
 
       gfor_fndecl_caf_get = gfc_build_library_function_decl_with_spec (
@@ -3581,11 +3584,31 @@ gfc_build_builtin_function_decls (void)
 	boolean_type_node, pint_type);
 
       gfor_fndecl_caf_sendget = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("caf_sendget")), ".R.RRRR.RRR", void_type_node,
-	13, 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);
+	get_identifier (PREFIX("caf_sendget")), ".R.RRRR.RRRRRR",
+	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_get_by_ref = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("caf_get_by_ref")), ".RWRRRRRW", void_type_node,
+	9, 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);
+
+      gfor_fndecl_caf_send_by_ref = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("caf_send_by_ref")), ".RRRRRRRW", void_type_node,
+	9, 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);
+
+      gfor_fndecl_caf_sendget_by_ref
+	  = gfc_build_library_function_decl_with_spec (
+	    get_identifier (PREFIX("caf_sendget_by_ref")), ".RR.RRRRRWW",
+	    void_type_node, 11, 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);
 
       gfor_fndecl_caf_sync_all = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_sync_all")), ".WW", void_type_node,
@@ -5002,9 +5025,11 @@ gfc_emit_parameter_debug_info (gfc_symbol *sym)
 static void
 generate_coarray_sym_init (gfc_symbol *sym)
 {
-  tree tmp, size, decl, token;
+  tree tmp, size, decl, token, desc;
   bool is_lock_type, is_event_type;
   int reg_type;
+  gfc_se se;
+  symbol_attribute attr;
 
   if (sym->attr.dummy || sym->attr.allocatable || !sym->attr.codimension
       || sym->attr.use_assoc || !sym->attr.referenced
@@ -5055,12 +5080,20 @@ generate_coarray_sym_init (gfc_symbol *sym)
     reg_type = GFC_CAF_EVENT_STATIC;
   else
     reg_type = GFC_CAF_COARRAY_STATIC;
-  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_register, 6, size,
+
+  gfc_init_se (&se, NULL);
+  desc = gfc_conv_scalar_to_descriptor (&se, decl, attr);
+  gfc_add_block_to_block (&caf_init_block, &se.pre);
+
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_register, 7, size,
 			     build_int_cst (integer_type_node, reg_type),
-			     token, null_pointer_node, /* token, stat.  */
+			     token, gfc_build_addr_expr (pvoid_type_node, desc),
+			     null_pointer_node, /* stat.  */
 			     null_pointer_node, /* errgmsg, errmsg_len.  */
 			     build_int_cst (integer_type_node, 0));
-  gfc_add_modify (&caf_init_block, decl, fold_convert (TREE_TYPE (decl), tmp));
+  gfc_add_expr_to_block (&caf_init_block, tmp);
+  gfc_add_modify (&caf_init_block, decl, fold_convert (TREE_TYPE (decl),
+					  gfc_conv_descriptor_data_get (desc)));
 
   /* Handle "static" initializer.  */
   if (sym->value)
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 19239fb..9fcd6a1 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -72,6 +72,13 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
   desc = gfc_create_var (type, "desc");
   DECL_ARTIFICIAL (desc) = 1;
 
+  if (CONSTANT_CLASS_P (scalar))
+    {
+      tree tmp;
+      tmp = gfc_create_var (TREE_TYPE (scalar), "scalar");
+      gfc_add_modify (&se->pre, tmp, scalar);
+      scalar = tmp;
+    }
   if (!POINTER_TYPE_P (TREE_TYPE (scalar)))
     scalar = gfc_build_addr_expr (NULL_TREE, scalar);
   gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (desc),
@@ -88,6 +95,56 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
 }
 
 
+/* Get the coarray token from the ultimate array or component ref.
+   Returns a NULL_TREE, when the ref object is not allocatable or pointer.  */
+
+tree
+gfc_get_ultimate_alloc_ptr_comps_caf_token (gfc_se *outerse, gfc_expr *expr)
+{
+  gfc_symbol *sym = expr->symtree->n.sym;
+  bool is_coarray = sym->attr.codimension;
+  gfc_expr *caf_expr = gfc_copy_expr (expr);
+  gfc_ref *ref = caf_expr->ref, *last_caf_ref = NULL;
+
+  while (ref)
+    {
+      if (ref->type == REF_COMPONENT
+	  && (ref->u.c.component->attr.allocatable
+	      || ref->u.c.component->attr.pointer)
+	  && (is_coarray || ref->u.c.component->attr.codimension))
+	  last_caf_ref = ref;
+      ref = ref->next;
+    }
+
+  if (last_caf_ref == NULL)
+    return NULL_TREE;
+
+  tree comp = last_caf_ref->u.c.component->caf_token, caf;
+  gfc_se se;
+  bool comp_ref = !last_caf_ref->u.c.component->attr.dimension;
+  if (comp == NULL_TREE && comp_ref)
+    return NULL_TREE;
+  gfc_init_se (&se, outerse);
+  gfc_free_ref_list (last_caf_ref->next);
+  last_caf_ref->next = NULL;
+  caf_expr->rank = comp_ref ? 0 : last_caf_ref->u.c.component->as->rank;
+  se.want_pointer = comp_ref;
+  gfc_conv_expr (&se, caf_expr);
+  gfc_add_block_to_block (&outerse->pre, &se.pre);
+
+  if (TREE_CODE (se.expr) == COMPONENT_REF && comp_ref)
+    se.expr = TREE_OPERAND (se.expr, 0);
+  gfc_free_expr (caf_expr);
+
+  if (comp_ref)
+    caf = fold_build3_loc (input_location, COMPONENT_REF,
+			   TREE_TYPE (comp), se.expr, comp, NULL_TREE);
+  else
+    caf = gfc_conv_descriptor_token (se.expr);
+  return gfc_build_addr_expr (NULL_TREE, caf);
+}
+
+
 /* This is the seed for an eventual trans-class.c
 
    The following parameters should not be used directly since they might
@@ -1827,69 +1884,51 @@ gfc_get_tree_for_caf_expr (gfc_expr *expr)
 {
   tree caf_decl;
   bool found = false;
-  gfc_ref *ref, *comp_ref = NULL;
+  gfc_ref *ref;
 
   gcc_assert (expr && expr->expr_type == EXPR_VARIABLE);
 
   /* Not-implemented diagnostic.  */
+  if (expr->symtree->n.sym->ts.type == BT_CLASS
+      && UNLIMITED_POLY (expr->symtree->n.sym)
+      && CLASS_DATA (expr->symtree->n.sym)->attr.codimension)
+    gfc_error ("Sorry, coindexed access to an unlimited polymorphic object at "
+	       "%L is not supported", &expr->where);
+
   for (ref = expr->ref; ref; ref = ref->next)
     if (ref->type == REF_COMPONENT)
       {
-        comp_ref = ref;
-	if ((ref->u.c.component->ts.type == BT_CLASS
-	     && !CLASS_DATA (ref->u.c.component)->attr.codimension
-	     && (CLASS_DATA (ref->u.c.component)->attr.pointer
-		 || CLASS_DATA (ref->u.c.component)->attr.allocatable))
-	    || (ref->u.c.component->ts.type != BT_CLASS
-		&& !ref->u.c.component->attr.codimension
-		&& (ref->u.c.component->attr.pointer
-		    || ref->u.c.component->attr.allocatable)))
-	  gfc_error ("Sorry, coindexed access to a pointer or allocatable "
-		     "component of the coindexed coarray at %L is not yet "
-		     "supported", &expr->where);
+	if (ref->u.c.component->ts.type == BT_CLASS
+	    && UNLIMITED_POLY (ref->u.c.component)
+	    && CLASS_DATA (ref->u.c.component)->attr.codimension)
+	  gfc_error ("Sorry, coindexed access to an unlimited polymorphic "
+		     "component at %L is not supported", &expr->where);
       }
-  if ((!comp_ref
-       && ((expr->symtree->n.sym->ts.type == BT_CLASS
-	    && CLASS_DATA (expr->symtree->n.sym)->attr.alloc_comp)
-	   || (expr->symtree->n.sym->ts.type == BT_DERIVED
-	       && expr->symtree->n.sym->ts.u.derived->attr.alloc_comp)))
-      || (comp_ref
-	  && ((comp_ref->u.c.component->ts.type == BT_CLASS
-	       && CLASS_DATA (comp_ref->u.c.component)->attr.alloc_comp)
-	      || (comp_ref->u.c.component->ts.type == BT_DERIVED
-		  && comp_ref->u.c.component->ts.u.derived->attr.alloc_comp))))
-    gfc_error ("Sorry, coindexed coarray at %L with allocatable component is "
-	       "not yet supported", &expr->where);
-
-  if (expr->rank)
-    {
-      /* Without the new array descriptor, access like "caf[i]%a(:)%b" is in
-	 general not possible as the required stride multiplier might be not
-	 a multiple of c_sizeof(b). In case of noncoindexed access, the
-	 scalarizer often takes care of it - for coarrays, it always fails.  */
-      for (ref = expr->ref; ref; ref = ref->next)
-        if (ref->type == REF_COMPONENT
-	    && ((ref->u.c.component->ts.type == BT_CLASS
-		 && CLASS_DATA (ref->u.c.component)->attr.codimension)
-	        || (ref->u.c.component->ts.type != BT_CLASS
-		    && ref->u.c.component->attr.codimension)))
-	  break;
-      if (ref == NULL)
-	ref = expr->ref;
-      for ( ; ref; ref = ref->next)
-	if (ref->type == REF_ARRAY && ref->u.ar.dimen)
-	  break;
-      for ( ; ref; ref = ref->next)
-	if (ref->type == REF_COMPONENT)
-	  gfc_error ("Sorry, coindexed access at %L to a scalar component "
-		     "with an array partref is not yet supported",
-		     &expr->where);
-    }
 
   caf_decl = expr->symtree->n.sym->backend_decl;
   gcc_assert (caf_decl);
   if (expr->symtree->n.sym->ts.type == BT_CLASS)
-    caf_decl = gfc_class_data_get (caf_decl);
+    {
+      if (expr->ref && expr->ref->type == REF_ARRAY)
+	{
+	  caf_decl = gfc_class_data_get (caf_decl);
+	  if (CLASS_DATA (expr->symtree->n.sym)->attr.codimension)
+	    return caf_decl;
+	}
+      for (ref = expr->ref; ref; ref = ref->next)
+	{
+	  if (ref->type == REF_COMPONENT
+	      && strcmp (ref->u.c.component->name, "_data") != 0)
+	    {
+	      caf_decl = gfc_class_data_get (caf_decl);
+	      if (CLASS_DATA (expr->symtree->n.sym)->attr.codimension)
+		return caf_decl;
+	      break;
+	    }
+	  else if (ref->type == REF_ARRAY && ref->u.ar.dimen)
+	    break;
+	}
+    }
   if (expr->symtree->n.sym->attr.codimension)
     return caf_decl;
 
@@ -1907,7 +1946,14 @@ gfc_get_tree_for_caf_expr (gfc_expr *expr)
 				    TREE_TYPE (comp->backend_decl), caf_decl,
 				    comp->backend_decl, NULL_TREE);
 	if (comp->ts.type == BT_CLASS)
-	  caf_decl = gfc_class_data_get (caf_decl);
+	  {
+	    caf_decl = gfc_class_data_get (caf_decl);
+	    if (CLASS_DATA (comp)->attr.codimension)
+	      {
+		found = true;
+		break;
+	      }
+	  }
 	if (comp->attr.codimension)
 	  {
 	    found = true;
@@ -1922,8 +1968,8 @@ gfc_get_tree_for_caf_expr (gfc_expr *expr)
 /* Obtain the Coarray token - and optionally also the offset.  */
 
 void
-gfc_get_caf_token_offset (tree *token, tree *offset, tree caf_decl, tree se_expr,
-			  gfc_expr *expr)
+gfc_get_caf_token_offset (gfc_se *se, tree *token, tree *offset, tree caf_decl,
+			  tree se_expr, gfc_expr *expr)
 {
   tree tmp;
 
@@ -1978,7 +2024,47 @@ gfc_get_caf_token_offset (tree *token, tree *offset, tree caf_decl, tree se_expr
   *offset = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
 			     *offset, fold_convert (gfc_array_index_type, tmp));
 
-  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl)))
+  if (expr->symtree->n.sym->ts.type == BT_DERIVED
+      && expr->symtree->n.sym->attr.codimension
+      && expr->symtree->n.sym->ts.u.derived->attr.alloc_comp)
+    {
+      gfc_expr *base_expr = gfc_copy_expr (expr);
+      gfc_ref *ref = base_expr->ref;
+      gfc_se base_se;
+
+      // Iterate through the refs until the last one.
+      while (ref->next)
+	  ref = ref->next;
+
+      if (ref->type == REF_ARRAY
+	  && ref->u.ar.type != AR_FULL)
+	{
+	  const int ranksum = ref->u.ar.dimen + ref->u.ar.codimen;
+	  int i;
+	  for (i = 0; i < ranksum; ++i)
+	    {
+	      ref->u.ar.start[i] = NULL;
+	      ref->u.ar.end[i] = NULL;
+	    }
+	  ref->u.ar.type = AR_FULL;
+	}
+      gfc_init_se (&base_se, NULL);
+      if (gfc_caf_attr (base_expr).dimension)
+	{
+	  gfc_conv_expr_descriptor (&base_se, base_expr);
+	  tmp = gfc_conv_descriptor_data_get (base_se.expr);
+	}
+      else
+	{
+	  gfc_conv_expr (&base_se, base_expr);
+	  tmp = base_se.expr;
+	}
+
+      gfc_free_expr (base_expr);
+      gfc_add_block_to_block (&se->pre, &base_se.pre);
+      gfc_add_block_to_block (&se->post, &base_se.post);
+    }
+  else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl)))
     tmp = gfc_conv_descriptor_data_get (caf_decl);
   else
    {
@@ -2009,6 +2095,12 @@ gfc_caf_get_image_index (stmtblock_t *block, gfc_expr *e, tree desc)
       break;
   gcc_assert (ref != NULL);
 
+  if (ref->u.ar.dimen_type[ref->u.ar.dimen] == DIMEN_THIS_IMAGE)
+    {
+      return build_call_expr_loc (input_location, gfor_fndecl_caf_this_image, 1,
+				  integer_zero_node);
+    }
+
   img_idx = integer_zero_node;
   extent = integer_one_node;
   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
@@ -4647,10 +4739,11 @@ expr_may_alias_variables (gfc_expr *e, bool array_may_alias)
     {
       gfc_symbol *proc_ifc = gfc_get_proc_ifc_for_expr (e);
 
-      if ((proc_ifc->result->ts.type == BT_CLASS
-	   && proc_ifc->result->ts.u.derived->attr.is_class
-	   && CLASS_DATA (proc_ifc->result)->attr.class_pointer)
-	  || proc_ifc->result->attr.pointer)
+      if (proc_ifc->result != NULL
+	  && ((proc_ifc->result->ts.type == BT_CLASS
+	       && proc_ifc->result->ts.u.derived->attr.is_class
+	       && CLASS_DATA (proc_ifc->result)->attr.class_pointer)
+	      || proc_ifc->result->attr.pointer))
 	return true;
       else
 	return false;
@@ -9064,7 +9157,25 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block,
   size_in_bytes = fold_build2_loc (input_location, MAX_EXPR, size_type_node,
 				   size_in_bytes, size_one_node);
 
-  if (expr1->ts.type == BT_DERIVED && expr1->ts.u.derived->attr.alloc_comp)
+  if (gfc_caf_attr (expr1).codimension && flag_coarray == GFC_FCOARRAY_LIB)
+    {
+      tree caf_decl, token;
+      gfc_se caf_se;
+      symbol_attribute attr;
+
+      gfc_clear_attr (&attr);
+      gfc_init_se (&caf_se, NULL);
+
+      caf_decl = gfc_get_tree_for_caf_expr (expr1);
+      gfc_get_caf_token_offset (&caf_se, &token, NULL, caf_decl, NULL_TREE,
+				NULL);
+      gfc_add_block_to_block (block, &caf_se.pre);
+      gfc_allocate_allocatable (block, lse.expr, size_in_bytes,
+				gfc_build_addr_expr (NULL_TREE, token),
+				NULL_TREE, NULL_TREE, NULL_TREE, jump_label1,
+				expr1, 1);
+    }
+  else if (expr1->ts.type == BT_DERIVED && expr1->ts.u.derived->attr.alloc_comp)
     {
       tmp = build_call_expr_loc (input_location,
 				 builtin_decl_explicit (BUILT_IN_CALLOC),
@@ -9242,6 +9353,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
   tree string_length;
   int n;
   bool maybe_workshare = false;
+  symbol_attribute lhs_caf_attr, rhs_caf_attr;
 
   /* Assignment of the form lhs = rhs.  */
   gfc_start_block (&block);
@@ -9262,6 +9374,9 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
 	  || gfc_is_alloc_class_scalar_function (expr2)))
     expr2->must_finalize = 1;
 
+  lhs_caf_attr = gfc_caf_attr (expr1);
+  rhs_caf_attr = gfc_caf_attr (expr2);
+
   if (lss != gfc_ss_terminator)
     {
       /* The assignment needs scalarization.  */
@@ -9440,10 +9555,26 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
 	gfc_add_block_to_block (&loop.post, &rse.post);
     }
 
-  tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts,
-				 gfc_expr_is_variable (expr2) || scalar_to_array
-				 || expr2->expr_type == EXPR_ARRAY,
-				 !(l_is_temp || init_flag) && dealloc);
+  if (flag_coarray == GFC_FCOARRAY_LIB
+      && lhs_caf_attr.codimension && rhs_caf_attr.codimension
+      && lhs_caf_attr.alloc_comp && rhs_caf_attr.alloc_comp)
+    {
+      gfc_code code;
+      gfc_actual_arglist a1, a2;
+      a1.expr = expr1;
+      a1.next = &a2;
+      a2.expr = expr2;
+      a2.next = NULL;
+      code.ext.actual = &a1;
+      code.resolved_isym = gfc_intrinsic_subroutine_by_id (GFC_ISYM_CAF_SEND);
+      tmp = gfc_conv_intrinsic_subroutine (&code);
+    }
+  else
+    tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts,
+				   gfc_expr_is_variable (expr2)
+				   || scalar_to_array
+				   || expr2->expr_type == EXPR_ARRAY,
+				   !(l_is_temp || init_flag) && dealloc);
   gfc_add_expr_to_block (&body, tmp);
 
   if (lss == gfc_ss_terminator)
@@ -9490,11 +9621,9 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
 
       /* F2003: Allocate or reallocate lhs of allocatable array.  */
       if (flag_realloc_lhs
-	    && gfc_is_reallocatable_lhs (expr1)
-	    && !gfc_expr_attr (expr1).codimension
-	    && !gfc_is_coindexed (expr1)
-	    && expr2->rank
-	    && !is_runtime_conformable (expr1, expr2))
+	  && gfc_is_reallocatable_lhs (expr1)
+	  && expr2->rank
+	  && !is_runtime_conformable (expr1, expr2))
 	{
 	  realloc_lhs_warning (expr1->ts.type, true, &expr1->where);
 	  ompws_flags &= ~OMPWS_SCALARIZER_WS;
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 8167842..d6453c5 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -982,7 +982,7 @@ conv_caf_vector_subscript_elem (stmtblock_t *block, int i, tree desc,
 
   if (vector != NULL_TREE)
     {
-      /* Set dim.lower/upper/stride.  */
+      /* 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);
@@ -994,7 +994,7 @@ conv_caf_vector_subscript_elem (stmtblock_t *block, int i, tree desc,
     }
   else
     {
-      /* Set vector and kind.  */
+      /* 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);
@@ -1094,16 +1094,481 @@ conv_caf_vector_subscript (stmtblock_t *block, tree desc, gfc_array_ref *ar)
 }
 
 
+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;
+  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;
+    }
+
+  /* Prevent uninit-warning.  */
+  reference_type = NULL_TREE;
+  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.dimension)
+	    {
+	      tree arr_desc_token_offset;
+	      /* Get the token from the descriptor.  */
+	      arr_desc_token_offset = gfc_advance_chain (
+		    TYPE_FIELDS (TREE_TYPE (ref->u.c.component->backend_decl)),
+		    4 /* CAF_TOKEN_FIELD  */);
+	      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 (ref->u.c.component->caf_token,
+					     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;
+	  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 can not 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;
+
+		  /* Intentionally 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;
+}
+
 /* Get data from a remote coarray.  */
 
 static void
 gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
-			    tree may_require_tmp)
+			    tree may_require_tmp, bool may_realloc,
+			    symbol_attribute *caf_attr)
 {
   gfc_expr *array_expr, *tmp_stat;
   gfc_se argse;
   tree caf_decl, token, offset, image_index, tmp;
   tree res_var, dst_var, type, kind, vec, stat;
+  tree caf_reference;
+  symbol_attribute caf_attr_store;
 
   gcc_assert (flag_coarray == GFC_FCOARRAY_LIB);
 
@@ -1118,6 +1583,12 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
   array_expr = (lhs == NULL_TREE) ? expr->value.function.actual->expr : expr;
   type = gfc_typenode_for_spec (&array_expr->ts);
 
+  if (caf_attr == NULL)
+    {
+      caf_attr_store = gfc_caf_attr (array_expr);
+      caf_attr = &caf_attr_store;
+    }
+
   res_var = lhs;
   dst_var = lhs;
 
@@ -1136,6 +1607,108 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
   else
     stat = null_pointer_node;
 
+  /* Always use the new get_by_ref ().  When no allocatable components are
+     present and the lhs does not reallocation then the "old" get () might
+     suffice.  */
+  if (true) //caf_attr->alloc_comp && !may_realloc)
+    {
+      /* Get using caf_get_by_ref.  */
+      caf_reference = conv_expr_ref_to_caf_ref (&se->pre, array_expr);
+
+      if (caf_reference != NULL_TREE)
+	{
+	  if (lhs == NULL_TREE)
+	    {
+	      if (array_expr->ts.type == BT_CHARACTER)
+		gfc_init_se (&argse, NULL);
+	      if (array_expr->rank == 0)
+		{
+		  symbol_attribute attr;
+		  gfc_clear_attr (&attr);
+		  if (array_expr->ts.type == BT_CHARACTER)
+		    {
+		      res_var = gfc_conv_string_tmp (se,
+						     build_pointer_type (type),
+					     array_expr->ts.u.cl->backend_decl);
+		      argse.string_length = array_expr->ts.u.cl->backend_decl;
+		    }
+		  else
+		    res_var = gfc_create_var (type, "caf_res");
+		  dst_var = gfc_conv_scalar_to_descriptor (se, res_var, attr);
+		  dst_var = gfc_build_addr_expr (NULL_TREE, dst_var);
+		}
+	      else
+		{
+		  /* Create temporary.  */
+		  if (array_expr->ts.type == BT_CHARACTER)
+		    gfc_conv_expr_descriptor (&argse, array_expr);
+		  may_realloc = gfc_trans_create_temp_array (&se->pre,
+							     &se->post,
+							     se->ss, type,
+							     NULL_TREE, false,
+							     false, false,
+							     &array_expr->where)
+		      == NULL_TREE;
+		  res_var = se->ss->info->data.array.descriptor;
+		  dst_var = gfc_build_addr_expr (NULL_TREE, res_var);
+		  if (may_realloc)
+		    {
+		      tmp = gfc_conv_descriptor_data_get (res_var);
+		      tmp = gfc_deallocate_with_status (tmp, NULL_TREE,
+							NULL_TREE, NULL_TREE,
+							NULL_TREE, true,
+							NULL, false);
+		      gfc_add_expr_to_block (&se->post, tmp);
+		    }
+		}
+	    }
+
+	  kind = build_int_cst (integer_type_node, expr->ts.kind);
+	  if (lhs_kind == NULL_TREE)
+	    lhs_kind = kind;
+
+	  caf_decl = gfc_get_tree_for_caf_expr (array_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 (&se->pre, array_expr,
+						 caf_decl);
+	  gfc_get_caf_token_offset (se, &token, NULL, caf_decl, NULL,
+				    array_expr);
+
+	  /* No overlap possible as we have generated a temporary.  */
+	  if (lhs == NULL_TREE)
+	    may_require_tmp = boolean_false_node;
+
+	  /* 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 (&se->pre, tmp);
+
+	  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get_by_ref,
+				     9, token, image_index, dst_var,
+				     caf_reference, lhs_kind, kind,
+				     may_require_tmp,
+				     may_realloc ? boolean_true_node :
+						   boolean_false_node,
+				     stat);
+
+	  gfc_add_expr_to_block (&se->pre, tmp);
+
+	  if (se->ss)
+	    gfc_advance_se_ss_chain (se);
+
+	  se->expr = res_var;
+	  if (array_expr->ts.type == BT_CHARACTER)
+	    se->string_length = argse.string_length;
+
+	  return;
+	}
+    }
+
   gfc_init_se (&argse, NULL);
   if (array_expr->rank == 0)
     {
@@ -1176,9 +1749,9 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
 	}
       gfc_conv_expr_descriptor (&argse, array_expr);
       /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that
-         has the wrong type if component references are done.  */
+	 has the wrong type if component references are done.  */
       gfc_add_modify (&argse.pre, gfc_conv_descriptor_dtype (argse.expr),
-                      gfc_get_dtype_rank_type (has_vector ? ar2.dimen
+		      gfc_get_dtype_rank_type (has_vector ? ar2.dimen
 							  : array_expr->rank,
 					       type));
       if (has_vector)
@@ -1193,10 +1766,10 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
 	  for (int n = 0; n < se->ss->loop->dimen; n++)
 	    if (se->loop->to[n] == NULL_TREE)
 	      {
-		se->loop->from[n] =
-			gfc_conv_descriptor_lbound_get (argse.expr, gfc_rank_cst[n]);
-		se->loop->to[n] =
-			gfc_conv_descriptor_ubound_get (argse.expr, gfc_rank_cst[n]);
+		se->loop->from[n] = gfc_conv_descriptor_lbound_get (argse.expr,
+							       gfc_rank_cst[n]);
+		se->loop->to[n] = gfc_conv_descriptor_ubound_get (argse.expr,
+							       gfc_rank_cst[n]);
 	      }
 	  gfc_trans_create_temp_array (&argse.pre, &argse.post, se->ss, type,
 				       NULL_TREE, false, true, false,
@@ -1218,14 +1791,15 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
   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 (&se->pre, array_expr, caf_decl);
-  gfc_get_caf_token_offset (&token, &offset, caf_decl, argse.expr, array_expr);
+  gfc_get_caf_token_offset (se, &token, &offset, caf_decl, argse.expr,
+			    array_expr);
 
   /* No overlap possible as we have generated a temporary.  */
   if (lhs == NULL_TREE)
     may_require_tmp = boolean_false_node;
 
-  /* It guarantees memory consistency within the same segment */
-  tmp = gfc_build_string_const (strlen ("memory") + 1, "memory"),
+  /* 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);
@@ -1235,6 +1809,7 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
   tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 10,
 			     token, offset, image_index, argse.expr, vec,
 			     dst_var, kind, lhs_kind, may_require_tmp, stat);
+
   gfc_add_expr_to_block (&se->pre, tmp);
 
   if (se->ss)
@@ -1246,7 +1821,7 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
 }
 
 
-/* Send data to a remove coarray.  */
+/* Send data to a remote coarray.  */
 
 static tree
 conv_caf_send (gfc_code *code) {
@@ -1254,9 +1829,10 @@ conv_caf_send (gfc_code *code) {
   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, stat;
+  tree may_require_tmp, src_stat, dst_stat;
   tree lhs_type = NULL_TREE;
   tree vec = null_pointer_node, rhs_vec = null_pointer_node;
+  symbol_attribute lhs_caf_attr, rhs_caf_attr;
 
   gcc_assert (flag_coarray == GFC_FCOARRAY_LIB);
 
@@ -1266,7 +1842,9 @@ conv_caf_send (gfc_code *code) {
 		    ? boolean_false_node : boolean_true_node;
   gfc_init_block (&block);
 
-  stat = null_pointer_node;
+  lhs_caf_attr = gfc_caf_attr (lhs_expr);
+  rhs_caf_attr = gfc_caf_attr (rhs_expr);
+  src_stat = dst_stat = null_pointer_node;
 
   /* LHS.  */
   gfc_init_se (&lhs_se, NULL);
@@ -1279,6 +1857,21 @@ conv_caf_send (gfc_code *code) {
       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.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
     {
       /* If has_vector, pass descriptor for whole array and the
@@ -1313,29 +1906,62 @@ conv_caf_send (gfc_code *code) {
     }
 
   lhs_kind = build_int_cst (integer_type_node, lhs_expr->ts.kind);
-  gfc_add_block_to_block (&block, &lhs_se.pre);
 
   /* Special case: RHS is a coarray but LHS is not; this code path avoids a
      temporary and a loop.  */
-  if (!gfc_is_coindexed (lhs_expr))
+  if (!gfc_is_coindexed (lhs_expr) && !lhs_caf_attr.codimension)
     {
+      bool lhs_may_realloc = lhs_expr->rank > 0 && lhs_caf_attr.allocatable;
       gcc_assert (gfc_is_coindexed (rhs_expr));
       gfc_init_se (&rhs_se, NULL);
+      if (lhs_expr->rank == 0 && gfc_expr_attr (lhs_expr).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, boolean_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, rhs_expr, lhs_se.expr, lhs_kind,
-				  may_require_tmp);
+				  may_require_tmp, lhs_may_realloc,
+				  &lhs_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);
     }
 
-  /* Obtain token, offset and image index for the LHS.  */
+  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);
-  gfc_get_caf_token_offset (&token, &offset, caf_decl, lhs_se.expr, lhs_expr);
+  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);
@@ -1347,11 +1973,25 @@ conv_caf_send (gfc_code *code) {
       symbol_attribute attr;
       gfc_clear_attr (&attr);
       gfc_conv_expr (&rhs_se, rhs_expr);
-      if (!gfc_is_coindexed (rhs_expr) && rhs_expr->ts.type != BT_CHARACTER)
-	 rhs_se.expr = fold_convert (lhs_type , rhs_se.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.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
@@ -1397,24 +2037,37 @@ conv_caf_send (gfc_code *code) {
       gfc_se stat_se;
       gfc_init_se (&stat_se, NULL);
       gfc_conv_expr_reference (&stat_se, tmp_stat);
-      stat = stat_se.expr;
+      dst_stat = stat_se.expr;
       gfc_add_block_to_block (&block, &stat_se.pre);
       gfc_add_block_to_block (&block, &stat_se.post);
     }
-  else
-    stat = null_pointer_node;
 
-  if (!gfc_is_coindexed (rhs_expr))
-    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 10, token,
-			       offset, image_index, lhs_se.expr, vec,
-			       rhs_se.expr, lhs_kind, rhs_kind, may_require_tmp,
-			       stat);
+  if (!gfc_is_coindexed (rhs_expr) && !rhs_caf_attr.codimension)
+    {
+      if (lhs_caf_attr.alloc_comp)
+	{
+	  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,
+				     9, token, image_index, rhs_se.expr,
+				     reference, lhs_kind, rhs_kind,
+				     may_require_tmp, dst_realloc, src_stat);
+	  }
+      else
+	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 10,
+				   token, offset, image_index, lhs_se.expr, vec,
+				   rhs_se.expr, lhs_kind, rhs_kind,
+				   may_require_tmp, src_stat);
+    }
   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"),
+      /* 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);
@@ -1425,20 +2078,50 @@ conv_caf_send (gfc_code *code) {
       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);
-      gfc_get_caf_token_offset (&rhs_token, &rhs_offset, caf_decl, rhs_se.expr,
-				rhs_expr);
-      tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sendget, 13,
-				 token, offset, image_index, lhs_se.expr, vec,
-				 rhs_token, rhs_offset, rhs_image_index,
-				 rhs_se.expr, rhs_vec, lhs_kind, rhs_kind,
-				 may_require_tmp);
+      tmp = rhs_se.expr;
+      if (rhs_caf_attr.alloc_comp)
+	{
+	  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, 11,
+				     token, image_index, lhs_reference,
+				     rhs_token, rhs_image_index, rhs_reference,
+				     lhs_kind, rhs_kind, may_require_tmp,
+				     dst_stat, src_stat);
+	}
+      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"),
+  /* 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);
@@ -7962,7 +8645,8 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       break;
 
     case GFC_ISYM_CAF_GET:
-      gfc_conv_intrinsic_caf_get (se, expr, NULL_TREE, NULL_TREE, NULL_TREE);
+      gfc_conv_intrinsic_caf_get (se, expr, NULL_TREE, NULL_TREE, NULL_TREE,
+				  false, NULL);
       break;
 
     case GFC_ISYM_CMPLX:
@@ -9033,8 +9717,11 @@ conv_intrinsic_atomic_op (gfc_code *code)
           value = gfc_build_addr_expr (NULL_TREE, tmp);
 	}
 
-      gfc_get_caf_token_offset (&token, &offset, caf_decl, atom, atom_expr);
+      gfc_init_se (&argse, NULL);
+      gfc_get_caf_token_offset (&argse, &token, &offset, caf_decl, atom,
+				atom_expr);
 
+      gfc_add_block_to_block (&block, &argse.pre);
       if (code->resolved_isym->id == GFC_ISYM_ATOMIC_DEF)
 	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_atomic_def, 7,
 				   token, offset, image_index, value, stat,
@@ -9052,6 +9739,7 @@ conv_intrinsic_atomic_op (gfc_code *code)
 						  (int) atom_expr->ts.kind));
 
       gfc_add_expr_to_block (&block, tmp);
+      gfc_add_block_to_block (&block, &argse.post);
       gfc_add_block_to_block (&block, &post_block);
       return gfc_finish_block (&block);
     }
@@ -9179,7 +9867,10 @@ conv_intrinsic_atomic_ref (gfc_code *code)
       else
 	image_index = integer_zero_node;
 
-      gfc_get_caf_token_offset (&token, &offset, caf_decl, atom, atom_expr);
+      gfc_init_se (&argse, NULL);
+      gfc_get_caf_token_offset (&argse, &token, &offset, caf_decl, atom,
+				atom_expr);
+      gfc_add_block_to_block (&block, &argse.pre);
 
       /* Different type, need type conversion.  */
       if (!POINTER_TYPE_P (TREE_TYPE (value)))
@@ -9199,6 +9890,7 @@ conv_intrinsic_atomic_ref (gfc_code *code)
       if (vardecl != NULL_TREE)
 	gfc_add_modify (&block, orig_value,
 			fold_convert (TREE_TYPE (orig_value), vardecl));
+      gfc_add_block_to_block (&block, &argse.post);
       gfc_add_block_to_block (&block, &post_block);
       return gfc_finish_block (&block);
     }
@@ -9312,7 +10004,10 @@ conv_intrinsic_atomic_cas (gfc_code *code)
           comp = gfc_build_addr_expr (NULL_TREE, tmp);
 	}
 
-      gfc_get_caf_token_offset (&token, &offset, caf_decl, atom, atom_expr);
+      gfc_init_se (&argse, NULL);
+      gfc_get_caf_token_offset (&argse, &token, &offset, caf_decl, atom,
+				atom_expr);
+      gfc_add_block_to_block (&block, &argse.pre);
 
       tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_atomic_cas, 9,
 				 token, offset, image_index, old, comp, new_val,
@@ -9321,6 +10016,7 @@ conv_intrinsic_atomic_cas (gfc_code *code)
 				 build_int_cst (integer_type_node,
 						(int) atom_expr->ts.kind));
       gfc_add_expr_to_block (&block, tmp);
+      gfc_add_block_to_block (&block, &argse.post);
       gfc_add_block_to_block (&block, &post_block);
       return gfc_finish_block (&block);
     }
@@ -9407,7 +10103,8 @@ conv_intrinsic_event_query (gfc_code *code)
 
       image_index = integer_zero_node;
 
-      gfc_get_caf_token_offset (&token, NULL, caf_decl, NULL_TREE, event_expr);
+      gfc_get_caf_token_offset (&se, &token, NULL, caf_decl, NULL_TREE,
+				event_expr);
 
       /* For arrays, obtain the array index.  */
       if (gfc_expr_attr (event_expr).dimension)
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 5884e7a..9fdacc1 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -725,7 +725,8 @@ gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op)
 	  return NULL_TREE;
 	}
 
-      gfc_get_caf_token_offset (&token, NULL, caf_decl, NULL_TREE, code->expr1);
+      gfc_get_caf_token_offset (&se, &token, NULL, caf_decl, NULL_TREE,
+				code->expr1);
 
       if (gfc_is_coindexed (code->expr1))
 	image_index = gfc_caf_get_image_index (&se.pre, code->expr1, caf_decl);
@@ -921,7 +922,10 @@ gfc_trans_event_post_wait (gfc_code *code, gfc_exec_op op)
       return NULL_TREE;
     }
 
-  gfc_get_caf_token_offset (&token, NULL, caf_decl, NULL_TREE, code->expr1);
+  gfc_init_se (&argse, NULL);
+  gfc_get_caf_token_offset (&argse, &token, NULL, caf_decl, NULL_TREE,
+			    code->expr1);
+  gfc_add_block_to_block (&se.pre, &argse.pre);
 
   if (gfc_is_coindexed (code->expr1))
     image_index = gfc_caf_get_image_index (&se.pre, code->expr1, caf_decl);
@@ -5876,11 +5880,30 @@ gfc_trans_allocate (gfc_code * code)
 	    /* Handle size computation of the type declared to alloc.  */
 	    memsz = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr)));
 
+	  if (gfc_caf_attr (expr).codimension
+	      && flag_coarray == GFC_FCOARRAY_LIB)
+	    {
+	      /* Scalar allocatable components in coarray'ed derived types make
+		 it here and are treated now.  */
+	      tree caf_decl, token;
+	      gfc_se caf_se;
+
+	      gfc_init_se (&caf_se, NULL);
+
+	      caf_decl = gfc_get_tree_for_caf_expr (expr);
+	      gfc_get_caf_token_offset (&caf_se, &token, NULL, caf_decl,
+					NULL_TREE, NULL);
+	      gfc_add_block_to_block (&se.pre, &caf_se.pre);
+	      gfc_allocate_allocatable (&se.pre, se.expr, memsz,
+					gfc_build_addr_expr (NULL_TREE, token),
+					NULL_TREE, NULL_TREE, NULL_TREE,
+					label_finish, expr, 1);
+	    }
 	  /* Allocate - for non-pointers with re-alloc checking.  */
-	  if (gfc_expr_attr (expr).allocatable)
-	    gfc_allocate_allocatable (&se.pre, se.expr, memsz, NULL_TREE,
-				      stat, errmsg, errlen, label_finish,
-				      expr);
+	  else if (gfc_expr_attr (expr).allocatable)
+	    gfc_allocate_allocatable (&se.pre, se.expr, memsz,
+				      NULL_TREE, stat, errmsg, errlen,
+				      label_finish, expr, 0);
 	  else
 	    gfc_allocate_using_malloc (&se.pre, se.expr, memsz, stat);
 
@@ -6147,10 +6170,12 @@ gfc_trans_allocate (gfc_code * code)
 	      /* Switch off automatic reallocation since we have just
 		 done the ALLOCATE.  */
 	      int realloc_lhs = flag_realloc_lhs;
+	      gfc_expr *init_expr = gfc_expr_to_initialize (expr);
 	      flag_realloc_lhs = 0;
-	      tmp = gfc_trans_assignment (gfc_expr_to_initialize (expr),
-					  e3rhs, false, false);
+	      tmp = gfc_trans_assignment (init_expr, e3rhs, false, false);
 	      flag_realloc_lhs = realloc_lhs;
+	      /* Free the expression allocated for init_expr.  */
+	      gfc_free_expr (init_expr);
 	    }
 	  gfc_add_expr_to_block (&block, tmp);
 	}
@@ -6298,7 +6323,7 @@ gfc_trans_deallocate (gfc_code *code)
       se.descriptor_only = 1;
       gfc_conv_expr (&se, expr);
 
-      if (expr->rank || gfc_is_coarray (expr))
+      if (expr->rank || gfc_caf_attr (expr).codimension)
 	{
 	  gfc_ref *ref;
 
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 6a89b30..27a6bab 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1054,7 +1054,7 @@ gfc_get_character_type (int kind, gfc_charlen * cl)
 /* Convert a basic type.  This will be an array for character types.  */
 
 tree
-gfc_typenode_for_spec (gfc_typespec * spec)
+gfc_typenode_for_spec (gfc_typespec * spec, bool in_coarray)
 {
   tree basetype;
 
@@ -1107,7 +1107,7 @@ gfc_typenode_for_spec (gfc_typespec * spec)
 
     case BT_DERIVED:
     case BT_CLASS:
-      basetype = gfc_get_derived_type (spec->u.derived);
+      basetype = gfc_get_derived_type (spec->u.derived, in_coarray);
 
       if (spec->type == BT_CLASS)
 	GFC_CLASS_TYPE_P (basetype) = 1;
@@ -1311,7 +1311,7 @@ gfc_is_nodesc_array (gfc_symbol * sym)
 static tree
 gfc_build_array_type (tree type, gfc_array_spec * as,
 		      enum gfc_array_kind akind, bool restricted,
-		      bool contiguous)
+		      bool contiguous, bool in_coarray)
 {
   tree lbound[GFC_MAX_DIMENSIONS];
   tree ubound[GFC_MAX_DIMENSIONS];
@@ -1361,7 +1361,7 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
   return gfc_get_array_type_bounds (type, as->rank == -1
 					  ? GFC_MAX_DIMENSIONS : as->rank,
 				    corank, lbound,
-				    ubound, 0, akind, restricted);
+				    ubound, 0, akind, restricted, in_coarray);
 }
 
 /* Returns the struct descriptor_dimension type.  */
@@ -1724,7 +1724,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
 
 static tree
 gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted,
-			       enum gfc_array_kind akind)
+			       enum gfc_array_kind akind, bool in_coarray)
 {
   tree fat_type, decl, arraytype, *chain = NULL;
   char name[16 + 2*GFC_RANK_DIGITS + 1 + 1];
@@ -1786,7 +1786,7 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted,
       TREE_NO_WARNING (decl) = 1;
     }
 
-  if (flag_coarray == GFC_FCOARRAY_LIB && codimen
+  if (flag_coarray == GFC_FCOARRAY_LIB && (codimen || in_coarray)
       && akind == GFC_ARRAY_ALLOCATABLE)
     {
       decl = gfc_add_field_to_struct_1 (fat_type,
@@ -1814,18 +1814,21 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted,
 tree
 gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound,
 			   tree * ubound, int packed,
-			   enum gfc_array_kind akind, bool restricted)
+			   enum gfc_array_kind akind, bool restricted,
+			   bool in_coarray)
 {
   char name[8 + 2*GFC_RANK_DIGITS + 1 + GFC_MAX_SYMBOL_LEN];
   tree fat_type, base_type, arraytype, lower, upper, stride, tmp, rtype;
   const char *type_name;
   int n;
 
-  base_type = gfc_get_array_descriptor_base (dimen, codimen, restricted, akind);
+  base_type = gfc_get_array_descriptor_base (dimen, codimen, restricted, akind,
+					     in_coarray);
   fat_type = build_distinct_type_copy (base_type);
   /* Make sure that nontarget and target array type have the same canonical
      type (and same stub decl for debug info).  */
-  base_type = gfc_get_array_descriptor_base (dimen, codimen, false, akind);
+  base_type = gfc_get_array_descriptor_base (dimen, codimen, false, akind,
+					     in_coarray);
   TYPE_CANONICAL (fat_type) = base_type;
   TYPE_STUB_DECL (fat_type) = TYPE_STUB_DECL (base_type);
 
@@ -2161,7 +2164,7 @@ gfc_sym_type (gfc_symbol * sym)
 				   || !sym->ts.u.cl->backend_decl))))
     type = gfc_character1_type_node;
   else
-    type = gfc_typenode_for_spec (&sym->ts);
+    type = gfc_typenode_for_spec (&sym->ts, sym->attr.codimension);
 
   if (sym->attr.dummy && !sym->attr.function && !sym->attr.value)
     byref = 1;
@@ -2199,7 +2202,7 @@ gfc_sym_type (gfc_symbol * sym)
 	  else if (sym->attr.allocatable)
 	    akind = GFC_ARRAY_ALLOCATABLE;
 	  type = gfc_build_array_type (type, sym->as, akind, restricted,
-				       sym->attr.contiguous);
+				       sym->attr.contiguous, false);
 	}
     }
   else
@@ -2417,7 +2420,7 @@ gfc_get_union_type (gfc_symbol *un)
    in a parent namespace, this is used.  */
 
 tree
-gfc_get_derived_type (gfc_symbol * derived)
+gfc_get_derived_type (gfc_symbol * derived, bool in_coarray)
 {
   tree typenode = NULL, field = NULL, field_type = NULL;
   tree canonical = NULL_TREE;
@@ -2561,7 +2564,8 @@ gfc_get_derived_type (gfc_symbol * derived)
 
       if ((!c->attr.pointer && !c->attr.proc_pointer)
 	  || c->ts.u.derived->backend_decl == NULL)
-	c->ts.u.derived->backend_decl = gfc_get_derived_type (c->ts.u.derived);
+	c->ts.u.derived->backend_decl = gfc_get_derived_type (c->ts.u.derived,
+							      in_coarray);
 
       if (c->ts.u.derived->attr.is_iso_c)
         {
@@ -2618,7 +2622,7 @@ gfc_get_derived_type (gfc_symbol * derived)
 	    c->ts.u.cl->backend_decl
 			= build_int_cst (gfc_charlen_type_node, 0);
 
-	  field_type = gfc_typenode_for_spec (&c->ts);
+	  field_type = gfc_typenode_for_spec (&c->ts, in_coarray);
 	}
 
       /* This returns an array descriptor type.  Initialization may be
@@ -2638,7 +2642,8 @@ gfc_get_derived_type (gfc_symbol * derived)
 	      field_type = gfc_build_array_type (field_type, c->as, akind,
 						 !c->attr.target
 						 && !c->attr.pointer,
-						 c->attr.contiguous);
+						 c->attr.contiguous,
+						 in_coarray);
 	    }
 	  else
 	    field_type = gfc_get_nodesc_array_type (field_type, c->as,
@@ -2683,6 +2688,19 @@ gfc_get_derived_type (gfc_symbol * derived)
       gcc_assert (field);
       if (!c->backend_decl)
 	c->backend_decl = field;
+
+      /* Do not add a caf_token field for classes' data components.  */
+      if (in_coarray && !c->attr.dimension && !c->attr.codimension
+	  && c->attr.allocatable && c->caf_token == NULL_TREE
+	  && strcmp ("_data", c->name) != 0)
+	{
+	  char caf_name[GFC_MAX_SYMBOL_LEN];
+	  snprintf (caf_name, GFC_MAX_SYMBOL_LEN, "_caf_%s", c->name);
+	  c->caf_token = gfc_add_field_to_struct (typenode,
+						  get_identifier (caf_name),
+						  pvoid_type_node, &chain);
+	  TREE_NO_WARNING (c->caf_token) = 1;
+	}
     }
 
   /* Now lay out the derived type, including the fields.  */
@@ -3324,4 +3342,121 @@ gfc_get_caf_vector_type (int dim)
   return vector_types[dim-1];
 }
 
+
+tree
+gfc_get_caf_reference_type ()
+{
+  static tree reference_type = NULL_TREE;
+  tree c_struct_type, s_struct_type, v_struct_type, union_type, dim_union_type,
+      a_struct_type, u_union_type, tmp, *chain;
+
+  if (reference_type != NULL_TREE)
+    return reference_type;
+
+  chain = 0;
+  c_struct_type = make_node (RECORD_TYPE);
+  tmp = gfc_add_field_to_struct_1 (c_struct_type,
+				   get_identifier ("offset"),
+				   gfc_array_index_type, &chain);
+  TREE_NO_WARNING (tmp) = 1;
+  tmp = gfc_add_field_to_struct_1 (c_struct_type,
+				   get_identifier ("caf_token_offset"),
+				   gfc_array_index_type, &chain);
+  TREE_NO_WARNING (tmp) = 1;
+  gfc_finish_type (c_struct_type);
+
+  chain = 0;
+  s_struct_type = make_node (RECORD_TYPE);
+  tmp = gfc_add_field_to_struct_1 (s_struct_type,
+				   get_identifier ("start"),
+				   gfc_array_index_type, &chain);
+  TREE_NO_WARNING (tmp) = 1;
+  tmp = gfc_add_field_to_struct_1 (s_struct_type,
+				   get_identifier ("end"),
+				   gfc_array_index_type, &chain);
+  TREE_NO_WARNING (tmp) = 1;
+  tmp = gfc_add_field_to_struct_1 (s_struct_type,
+				   get_identifier ("stride"),
+				   gfc_array_index_type, &chain);
+  TREE_NO_WARNING (tmp) = 1;
+  gfc_finish_type (s_struct_type);
+
+  chain = 0;
+  v_struct_type = make_node (RECORD_TYPE);
+  tmp = gfc_add_field_to_struct_1 (v_struct_type,
+				   get_identifier ("vector"),
+				   pvoid_type_node, &chain);
+  TREE_NO_WARNING (tmp) = 1;
+  tmp = gfc_add_field_to_struct_1 (v_struct_type,
+				   get_identifier ("nvec"),
+				   size_type_node, &chain);
+  TREE_NO_WARNING (tmp) = 1;
+  tmp = gfc_add_field_to_struct_1 (v_struct_type,
+				   get_identifier ("kind"),
+				   integer_type_node, &chain);
+  TREE_NO_WARNING (tmp) = 1;
+  gfc_finish_type (v_struct_type);
+
+  chain = 0;
+  union_type = make_node (UNION_TYPE);
+  tmp = gfc_add_field_to_struct_1 (union_type, get_identifier ("s"),
+				   s_struct_type, &chain);
+  TREE_NO_WARNING (tmp) = 1;
+  tmp = gfc_add_field_to_struct_1 (union_type, get_identifier ("v"),
+				   v_struct_type, &chain);
+  TREE_NO_WARNING (tmp) = 1;
+  gfc_finish_type (union_type);
+
+  tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node,
+			  gfc_rank_cst[GFC_MAX_DIMENSIONS - 1]);
+  dim_union_type = build_array_type (union_type, tmp);
+
+  chain = 0;
+  a_struct_type = make_node (RECORD_TYPE);
+  tmp = gfc_add_field_to_struct_1 (a_struct_type, get_identifier ("mode"),
+		build_array_type (unsigned_char_type_node,
+				  build_range_type (gfc_array_index_type,
+						    gfc_index_zero_node,
+					 gfc_rank_cst[GFC_MAX_DIMENSIONS - 1])),
+		&chain);
+  TREE_NO_WARNING (tmp) = 1;
+  tmp = gfc_add_field_to_struct_1 (a_struct_type,
+				   get_identifier ("static_array_type"),
+				   integer_type_node, &chain);
+  TREE_NO_WARNING (tmp) = 1;
+  tmp = gfc_add_field_to_struct_1 (a_struct_type, get_identifier ("dim"),
+				   dim_union_type, &chain);
+  TREE_NO_WARNING (tmp) = 1;
+  gfc_finish_type (a_struct_type);
+
+  chain = 0;
+  u_union_type = make_node (UNION_TYPE);
+  tmp = gfc_add_field_to_struct_1 (u_union_type, get_identifier ("c"),
+				   c_struct_type, &chain);
+  TREE_NO_WARNING (tmp) = 1;
+  tmp = gfc_add_field_to_struct_1 (u_union_type, get_identifier ("a"),
+				   a_struct_type, &chain);
+  TREE_NO_WARNING (tmp) = 1;
+  gfc_finish_type (u_union_type);
+
+  chain = 0;
+  reference_type = make_node (RECORD_TYPE);
+  tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("next"),
+				   build_pointer_type (reference_type), &chain);
+  TREE_NO_WARNING (tmp) = 1;
+  tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("type"),
+				   integer_type_node, &chain);
+  TREE_NO_WARNING (tmp) = 1;
+  tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("item_size"),
+				   size_type_node, &chain);
+  TREE_NO_WARNING (tmp) = 1;
+  tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("u"),
+				   u_union_type, &chain);
+  TREE_NO_WARNING (tmp) = 1;
+  gfc_finish_type (reference_type);
+  TYPE_NAME (reference_type) = get_identifier ("caf_reference_t");
+
+  return reference_type;
+}
+
 #include "gt-fortran-trans-types.h"
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index c518cc1..e8e92bf 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -70,7 +70,7 @@ tree gfc_get_character_type_len (int, tree);
 tree gfc_get_character_type_len_for_eltype (tree, tree);
 
 tree gfc_sym_type (gfc_symbol *);
-tree gfc_typenode_for_spec (gfc_typespec *);
+tree gfc_typenode_for_spec (gfc_typespec *, bool in_coarray = false);
 int gfc_copy_dt_decls_ifequal (gfc_symbol *, gfc_symbol *, bool);
 
 tree gfc_get_function_type (gfc_symbol *);
@@ -81,7 +81,8 @@ tree gfc_build_uint_type (int);
 
 tree gfc_get_element_type (tree);
 tree gfc_get_array_type_bounds (tree, int, int, tree *, tree *, int,
-				enum gfc_array_kind, bool);
+				enum gfc_array_kind, bool,
+				bool in_coarray = false);
 tree gfc_get_nodesc_array_type (tree, gfc_array_spec *, gfc_packed, bool);
 
 /* Add a field of given name and type to a UNION_TYPE or RECORD_TYPE.  */
@@ -102,5 +103,6 @@ tree gfc_get_dtype (tree);
 
 tree gfc_get_ppc_type (gfc_component *);
 tree gfc_get_caf_vector_type (int dim);
+tree gfc_get_caf_reference_type ();
 
 #endif
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 28d1341..9210e0f 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -734,7 +734,7 @@ gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size,
 
   size = fold_convert (size_type_node, size);
   tmp = build_call_expr_loc (input_location,
-	     gfor_fndecl_caf_register, 6,
+	     gfor_fndecl_caf_register, 7,
 	     fold_build2_loc (input_location,
 			      MAX_EXPR, size_type_node, size,
 			      build_int_cst (size_type_node, 1)),
@@ -742,11 +742,9 @@ gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size,
 			    lock_var ? GFC_CAF_LOCK_ALLOC
                             : event_var ? GFC_CAF_EVENT_ALLOC
 					: GFC_CAF_COARRAY_ALLOC),
-	     token, pstat, errmsg, errlen);
+	     token, gfc_build_addr_expr (pvoid_type_node, pointer),
+	     pstat, errmsg, errlen);
 
-  tmp = fold_build2_loc (input_location, MODIFY_EXPR,
-			 TREE_TYPE (pointer), pointer,
-			 fold_convert ( TREE_TYPE (pointer), tmp));
   gfc_add_expr_to_block (block, tmp);
 
   /* It guarantees memory consistency within the same segment */
@@ -782,13 +780,15 @@ gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size,
     expr must be set to the original expression being allocated for its locus
     and variable name in case a runtime error has to be printed.  */
 void
-gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token,
-			  tree status, tree errmsg, tree errlen, tree label_finish,
-			  gfc_expr* expr)
+gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size,
+			  tree token, tree status, tree errmsg, tree errlen,
+			  tree label_finish, gfc_expr* expr, int corank)
 {
   stmtblock_t alloc_block;
   tree tmp, null_mem, alloc, error;
   tree type = TREE_TYPE (mem);
+  symbol_attribute caf_attr;
+  bool need_assign = false;
 
   size = fold_convert (size_type_node, size);
   null_mem = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR,
@@ -800,8 +800,11 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token,
      gfc_allocate_using_lib.  */
   gfc_start_block (&alloc_block);
 
+  if (flag_coarray == GFC_FCOARRAY_LIB)
+    caf_attr = gfc_caf_attr (expr, true);
+
   if (flag_coarray == GFC_FCOARRAY_LIB
-      && gfc_expr_attr (expr).codimension)
+      && (corank > 0 || caf_attr.codimension))
     {
       tree cond;
       bool lock_var = expr->ts.type == BT_DERIVED
@@ -814,6 +817,33 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token,
 			 == INTMOD_ISO_FORTRAN_ENV
 		       && expr->ts.u.derived->intmod_sym_id
 		         == ISOFORTRAN_EVENT_TYPE;
+      gfc_se se;
+      gfc_init_se (&se, NULL);
+
+      tree sub_caf_tree = gfc_get_ultimate_alloc_ptr_comps_caf_token (&se,
+								      expr);
+      if (sub_caf_tree == NULL_TREE)
+	sub_caf_tree = token;
+
+      /* When mem is an array ref, then strip the .data-ref.  */
+      if (TREE_CODE (mem) == COMPONENT_REF
+	  && !(GFC_ARRAY_TYPE_P (TREE_TYPE (mem))))
+	tmp = TREE_OPERAND (mem, 0);
+      else
+	tmp = mem;
+
+      if (!(GFC_ARRAY_TYPE_P (TREE_TYPE (tmp))
+	    && TYPE_LANG_SPECIFIC (TREE_TYPE (tmp))->corank == 0)
+	  && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+	{
+	  symbol_attribute attr;
+
+	  gfc_clear_attr (&attr);
+	  tmp = gfc_conv_scalar_to_descriptor (&se, mem, attr);
+	  need_assign = true;
+	}
+      gfc_add_block_to_block (&alloc_block, &se.pre);
+
       /* In the front end, we represent the lock variable as pointer. However,
 	 the FE only passes the pointer around and leaves the actual
 	 representation to the library. Hence, we have to convert back to the
@@ -822,9 +852,11 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token,
 	size = fold_build2_loc (input_location, TRUNC_DIV_EXPR, size_type_node,
 				size, TYPE_SIZE_UNIT (ptr_type_node));
 
-      gfc_allocate_using_lib (&alloc_block, mem, size, token, status,
-			      errmsg, errlen, lock_var, event_var);
-
+      gfc_allocate_using_lib (&alloc_block, tmp, size, sub_caf_tree,
+			      status, errmsg, errlen, lock_var, event_var);
+      if (need_assign)
+	gfc_add_modify (&alloc_block, mem, fold_convert (TREE_TYPE (mem),
+					   gfc_conv_descriptor_data_get (tmp)));
       if (status != NULL_TREE)
 	{
 	  TREE_USED (label_finish) = 1;
@@ -1362,8 +1394,8 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
 
       token = gfc_build_addr_expr  (NULL_TREE, token);
       tmp = build_call_expr_loc (input_location,
-	     gfor_fndecl_caf_deregister, 4,
-	     token, pstat, errmsg, errlen);
+				 gfor_fndecl_caf_deregister, 4,
+				 token, pstat, errmsg, errlen);
       gfc_add_expr_to_block (&non_null, tmp);
 
       /* It guarantees memory consistency within the same segment */
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 512615a..4d3d207 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -119,6 +119,27 @@ enum gfc_coarray_type
 };
 
 
+/* Specify the type of ref handed to the caf communication functions.
+   Please keep in sync with libgfortran/caf/libcaf.h.  */
+enum gfc_caf_ref_type_t {
+  GFC_CAF_REF_COMPONENT,
+  GFC_CAF_REF_ARRAY,
+  GFC_CAF_REF_STATIC_ARRAY
+};
+
+
+/* Give the reference type of an array ref.
+   Please keep in sync with libgfortran/caf/libcaf.h.  */
+enum gfc_caf_array_ref_t {
+  GFC_CAF_ARR_REF_NONE = 0,
+  GFC_CAF_ARR_REF_VECTOR,
+  GFC_CAF_ARR_REF_FULL,
+  GFC_CAF_ARR_REF_RANGE,
+  GFC_CAF_ARR_REF_SINGLE,
+  GFC_CAF_ARR_REF_OPEN_END,
+  GFC_CAF_ARR_REF_OPEN_START
+};
+
 /* The array-specific scalarization information.  The array members of
    this struct are indexed by actual array index, and thus can be sparse.  */
 
@@ -441,14 +462,14 @@ void gfc_conv_expr_lhs (gfc_se * se, gfc_expr * expr);
 void gfc_conv_expr_reference (gfc_se * se, gfc_expr *);
 void gfc_conv_expr_type (gfc_se * se, gfc_expr *, tree);
 
-tree gfc_conv_scalar_to_descriptor (gfc_se *, tree, symbol_attribute);
-
 
 /* trans-expr.c */
+tree gfc_conv_scalar_to_descriptor (gfc_se *, tree, symbol_attribute);
+tree gfc_get_ultimate_alloc_ptr_comps_caf_token (gfc_se *, gfc_expr *);
 void gfc_conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr);
 tree gfc_string_to_single_character (tree len, tree str, int kind);
 tree gfc_get_tree_for_caf_expr (gfc_expr *);
-void gfc_get_caf_token_offset (tree *, tree *, tree, tree, gfc_expr *);
+void gfc_get_caf_token_offset (gfc_se*, tree *, tree *, tree, tree, gfc_expr *);
 tree gfc_caf_get_image_index (stmtblock_t *, gfc_expr *, tree);
 
 /* Find the decl containing the auxiliary variables for assigned variables.  */
@@ -661,7 +682,7 @@ tree gfc_build_memcpy_call (tree, tree, tree);
 
 /* Allocate memory for allocatable variables, with optional status variable.  */
 void gfc_allocate_allocatable (stmtblock_t*, tree, tree, tree, tree,
-			       tree, tree, tree, gfc_expr*);
+			       tree, tree, tree, gfc_expr*, int);
 
 /* Allocate memory, with optional status variable.  */
 void gfc_allocate_using_malloc (stmtblock_t *, tree, tree, tree);
@@ -760,6 +781,9 @@ extern GTY(()) tree gfor_fndecl_caf_deregister;
 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_get_by_ref;
+extern GTY(()) tree gfor_fndecl_caf_send_by_ref;
+extern GTY(()) tree gfor_fndecl_caf_sendget_by_ref;
 extern GTY(()) tree gfor_fndecl_caf_sync_all;
 extern GTY(()) tree gfor_fndecl_caf_sync_memory;
 extern GTY(()) tree gfor_fndecl_caf_sync_images;