Index: libgfortran/caf/single.c
===================================================================
--- libgfortran/caf/single.c	(Revision 243020)
+++ libgfortran/caf/single.c	(Arbeitskopie)
@@ -144,11 +144,17 @@
       || type == CAF_REGTYPE_CRITICAL || type == CAF_REGTYPE_EVENT_STATIC
       || type == CAF_REGTYPE_EVENT_ALLOC)
     local = calloc (size, sizeof (bool));
+  else if (type == CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY)
+    local = NULL;
   else
     local = malloc (size);
-  *token = malloc (sizeof (struct caf_single_token));
 
-  if (unlikely (local == NULL || *token == NULL))
+  if (type != CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY)
+    *token = malloc (sizeof (struct caf_single_token));
+
+  if (unlikely (*token == NULL
+		|| (local == NULL
+		    && type != CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY)))
     {
       /* Freeing the memory conditionally seems pointless, but
 	 caf_internal_error () may return, when a stat is given and then the
@@ -163,7 +169,7 @@
 
   single_token = TOKEN (*token);
   single_token->memptr = local;
-  single_token->owning_memory = true;
+  single_token->owning_memory = type != CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY;
   single_token->desc = GFC_DESCRIPTOR_RANK (data) > 0 ? data : NULL;
 
 
@@ -184,7 +190,7 @@
 
 
 void
-_gfortran_caf_deregister (caf_token_t *token, int *stat,
+_gfortran_caf_deregister (caf_token_t *token, caf_deregister_t type, int *stat,
 			  char *errmsg __attribute__ ((unused)),
 			  int errmsg_len __attribute__ ((unused)))
 {
@@ -193,7 +199,16 @@
   if (single_token->owning_memory && single_token->memptr)
     free (single_token->memptr);
 
-  free (TOKEN (*token));
+  if (type != CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY)
+    {
+      free (TOKEN (*token));
+      *token = NULL;
+    }
+  else
+    {
+      single_token->memptr = NULL;
+      single_token->owning_memory = false;
+    }
 
   if (stat)
     *stat = 0;
@@ -2882,3 +2897,102 @@
     }
   _gfortran_caf_error_stop_str (msg, (int32_t) strlen (msg));
 }
+
+int
+_gfortran_caf_is_present (caf_token_t token,
+			  int image_index __attribute__ ((unused)),
+			  caf_reference_t *refs)
+{
+  const char arraddressingnotallowed[] = "libcaf_single::caf_is_present(): "
+				   "only scalar indexes allowed.\n";
+  const char unknownreftype[] = "libcaf_single::caf_get_by_ref(): "
+				"unknown reference type.\n";
+  const char unknownarrreftype[] = "libcaf_single::caf_get_by_ref(): "
+				   "unknown array reference type.\n";
+  size_t i;
+  caf_single_token_t single_token = TOKEN (token);
+  void *memptr = single_token->memptr;
+  gfc_descriptor_t *src = single_token->desc;
+  caf_reference_t *riter = refs;
+
+  while (riter)
+    {
+      switch (riter->type)
+	{
+	case CAF_REF_COMPONENT:
+	  if (riter->u.c.caf_token_offset)
+	    {
+	      single_token = *(caf_single_token_t*)
+					 (memptr + riter->u.c.caf_token_offset);
+	      memptr = single_token->memptr;
+	      src = single_token->desc;
+	    }
+	  else
+	    {
+	      memptr += riter->u.c.offset;
+	      src = (gfc_descriptor_t *)memptr;
+	    }
+	  break;
+	case CAF_REF_ARRAY:
+	  for (i = 0; riter->u.a.mode[i] != CAF_ARR_REF_NONE; ++i)
+	    {
+	      switch (riter->u.a.mode[i])
+		{
+		case CAF_ARR_REF_SINGLE:
+		  memptr += (riter->u.a.dim[i].s.start
+			     - GFC_DIMENSION_LBOUND (src->dim[i]))
+		      * GFC_DIMENSION_STRIDE (src->dim[i])
+		      * riter->item_size;
+		  break;
+		case CAF_ARR_REF_FULL:
+		  /* A full array ref is allowed on the last reference only.  */
+		  if (riter->next == NULL)
+		    break;
+		  /* else fall through reporting an error.  */
+		case CAF_ARR_REF_VECTOR:
+		case CAF_ARR_REF_RANGE:
+		case CAF_ARR_REF_OPEN_END:
+		case CAF_ARR_REF_OPEN_START:
+		  caf_internal_error (arraddressingnotallowed, 0, NULL, 0);
+		  return 0;
+		default:
+		  caf_internal_error (unknownarrreftype, 0, NULL, 0);
+		  return 0;
+		}
+	    }
+	  break;
+	case CAF_REF_STATIC_ARRAY:
+	  for (i = 0; riter->u.a.mode[i] != CAF_ARR_REF_NONE; ++i)
+	    {
+	      switch (riter->u.a.mode[i])
+		{
+		case CAF_ARR_REF_SINGLE:
+		  memptr += riter->u.a.dim[i].s.start
+		      * riter->u.a.dim[i].s.stride
+		      * riter->item_size;
+		  break;
+		case CAF_ARR_REF_FULL:
+		  /* A full array ref is allowed on the last reference only.  */
+		  if (riter->next == NULL)
+		    break;
+		  /* else fall through reporting an error.  */
+		case CAF_ARR_REF_VECTOR:
+		case CAF_ARR_REF_RANGE:
+		case CAF_ARR_REF_OPEN_END:
+		case CAF_ARR_REF_OPEN_START:
+		  caf_internal_error (arraddressingnotallowed, 0, NULL, 0);
+		  return 0;
+		default:
+		  caf_internal_error (unknownarrreftype, 0, NULL, 0);
+		  return 0;
+		}
+	    }
+	  break;
+	default:
+	  caf_internal_error (unknownreftype, 0, NULL, 0);
+	  return 0;
+	}
+      riter = riter->next;
+    }
+  return memptr != NULL;
+}
Index: libgfortran/caf/libcaf.h
===================================================================
--- libgfortran/caf/libcaf.h	(Revision 243020)
+++ libgfortran/caf/libcaf.h	(Arbeitskopie)
@@ -50,7 +50,7 @@
 #define STAT_STOPPED_IMAGE 	6000
 #endif
 
-/* Describes what type of array we are registerring. Keep in sync with
+/* Describes what type of array we are registerring.  Keep in sync with
    gcc/fortran/trans.h.  */
 typedef enum caf_register_t {
   CAF_REGTYPE_COARRAY_STATIC,
@@ -59,10 +59,20 @@
   CAF_REGTYPE_LOCK_ALLOC,
   CAF_REGTYPE_CRITICAL,
   CAF_REGTYPE_EVENT_STATIC,
-  CAF_REGTYPE_EVENT_ALLOC
+  CAF_REGTYPE_EVENT_ALLOC,
+  CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY,
+  CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY
 }
 caf_register_t;
 
+/* Describes the action to take on _caf_deregister.  Keep in sync with
+   gcc/fortran/trans.h.  */
+typedef enum caf_deregister_t {
+  CAF_DEREGTYPE_COARRAY_DEREGISTER,
+  CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY
+}
+caf_deregister_t;
+
 typedef void* caf_token_t;
 typedef gfc_array_void gfc_descriptor_t;
 
@@ -174,7 +184,8 @@
 
 void _gfortran_caf_register (size_t, caf_register_t, caf_token_t *,
 			     gfc_descriptor_t *, int *, char *, int);
-void _gfortran_caf_deregister (caf_token_t *, int *, char *, int);
+void _gfortran_caf_deregister (caf_token_t *, caf_deregister_t, int *, char *,
+			       int);
 
 void _gfortran_caf_sync_all (int *, char *, int);
 void _gfortran_caf_sync_memory (int *, char *, int);
@@ -232,4 +243,6 @@
 void _gfortran_caf_event_wait (caf_token_t, size_t, int, int *, char *, int);
 void _gfortran_caf_event_query (caf_token_t, size_t, int, int *, int *);
 
+int _gfortran_caf_is_present (caf_token_t, int, caf_reference_t *);
+
 #endif  /* LIBCAF_H  */
Index: libgfortran/ChangeLog
===================================================================
--- libgfortran/ChangeLog	(Revision 243020)
+++ libgfortran/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,17 @@
+2016-11-30  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	* caf/libcaf.h: Add new action types for (de-)registration of
+	allocatable components in derived type coarrays.  Add _caf_is_present
+	prototype.
+	* caf/single.c (_gfortran_caf_register): Add support for registration
+	only and allocation of already registered allocatable components in
+	derived type coarrays.
+	(_gfortran_caf_deregister): Add mode to deallocate but not deregister
+	an allocatable component in a derived type coarray.
+	(_gfortran_caf_is_present): New function.  Query whether an
+	allocatable component in a derived type coarray on a remote image is
+	allocated.
+
 2016-11-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libgfortran/51119
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(Revision 243020)
+++ gcc/testsuite/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,15 @@
+2016-11-30  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	* gfortran.dg/coarray/alloc_comp_1.f90: Fix tree-dump scans to adhere
+	to the changed interfaces.
+	* gfortran.dg/coarray_alloc_comp_1.f08: Likewise.
+	* gfortran.dg/coarray_allocate_7.f08: Likewise.
+	* gfortran.dg/coarray_lib_alloc_1.f90: Likewise.
+	* gfortran.dg/coarray_lib_alloc_2.f90: Likewise.
+	* gfortran.dg/coarray_lib_alloc_3.f90: Likewise.
+	* gfortran.dg/coarray_lib_comm_1.f90: Likewise.
+	* gfortran.dg/coarray_lib_alloc_4.f90: New test.
+
 2016-11-30  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/78593
Index: gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90	(Revision 243020)
+++ gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90	(Arbeitskopie)
@@ -18,7 +18,7 @@
 
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(1, 1, &xx._data.token, \\(void \\*\\) &xx._data, &stat.., &errmsg, 200\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(1, 1, &yy._data.token, \\(void \\*\\) &yy._data, &stat.., &errmsg, 200\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0B, 0B, 0.;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, 0B, 0B, 0.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, 0, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0, 0B, 0B, 0.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, 0, 0B, 0B, 0.;" 1 "original" } }
Index: gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90	(Revision 243020)
+++ gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90	(Arbeitskopie)
@@ -17,7 +17,7 @@
 
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(1, 1, &xx._data.token, \\(void \\*\\) &xx._data, &stat.., &errmsg, 200\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(1, 1, &yy._data.token, \\(void \\*\\) &yy._data, &stat.., &errmsg, 200\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0B, 0B, 0.;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, 0B, 0B, 0.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, 0, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0, 0B, 0B, 0.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, 0, 0B, 0B, 0.;" 1 "original" } }
Index: gcc/testsuite/gfortran.dg/coarray/alloc_comp_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/alloc_comp_1.f90	(Revision 243020)
+++ gcc/testsuite/gfortran.dg/coarray/alloc_comp_1.f90	(Arbeitskopie)
@@ -8,9 +8,9 @@
 type(t) :: a
 allocate (a%caf[3:*])
 a%caf = 7
-!print *, a%caf
 if (a%caf /= 7) call abort ()
 if (any (lcobound (a%caf) /= [ 3 ]) &
     .or. ucobound (a%caf, dim=1) /= this_image ()+2)  &
   call abort ()
+deallocate (a%caf)
 end
Index: gcc/testsuite/gfortran.dg/coarray_lib_alloc_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_lib_alloc_1.f90	(Revision 243020)
+++ gcc/testsuite/gfortran.dg/coarray_lib_alloc_1.f90	(Arbeitskopie)
@@ -15,7 +15,7 @@
 
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(4, 1, &xx.token, \\(void \\*\\) &xx, &stat.., &errmsg, 200\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(8, 1, &yy.token, \\(void \\*\\) &yy, &stat.., &errmsg, 200\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx.token, &stat.., &errmsg, 200.;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy.token, &stat.., &errmsg, 200.;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy.token, 0B, 0B, 0.;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx.token, 0B, 0B, 0.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx.token, 0, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy.token, 0, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy.token, 0, 0B, 0B, 0.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx.token, 0, 0B, 0B, 0.;" 1 "original" } }
Index: gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90	(Revision 243020)
+++ gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90	(Arbeitskopie)
@@ -38,8 +38,8 @@
 if (any (A-B /= 0)) call abort
 end
 
-! { dg-final { scan-tree-dump-times "_gfortran_caf_sendget \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, _gfortran_caf_this_image \\\(0\\\), &parm.\[0-9\]+, 0B, caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, 4, 4, 0, 0B\\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_sendget \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, _gfortran_caf_this_image \\\(0\\\), &parm.\[0-9\]+, 0B, caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, 4, 4, 1, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 0, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 1, 0B\\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 1, 0B\\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.1, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) b, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 0, 0B\\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_sendget \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, 4, 4, 0, 0B\\\);" 1 "original" } }
Index: gcc/testsuite/gfortran.dg/coarray_allocate_7.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_allocate_7.f08	(Revision 243020)
+++ gcc/testsuite/gfortran.dg/coarray_allocate_7.f08	(Arbeitskopie)
@@ -23,6 +23,7 @@
   if ( object%indices(1) /= 1 ) call abort()
 end program
 
-! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(D.\[0-9\]+, 1, &\\(\\(struct mytype\\) \\*object\\).indices.token, &\\(\\(struct mytype\\) \\*object\\).indices, 0B, 0B, 0\\);" 2 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister \\(&\\(\\(struct mytype\\) \\*object\\).indices.token, 0B, 0B, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(D.\[0-9\]+, 1, &\\(\\(struct mytype\\) \\*object\\).indices.token, &\\(\\(struct mytype\\) \\*object\\).indices, 0B, 0B, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(D.\[0-9\]+, 8, &\\(\\(struct mytype\\) \\*object\\).indices.token, &\\(\\(struct mytype\\) \\*object\\).indices, 0B, 0B, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister \\(&\\(\\(struct mytype\\) \\*object\\).indices.token, 1, 0B, 0B, 0\\);" 1 "original" } }
 
Index: gcc/testsuite/gfortran.dg/coarray_alloc_comp_1.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_alloc_comp_1.f08	(Revision 243020)
+++ gcc/testsuite/gfortran.dg/coarray_alloc_comp_1.f08	(Arbeitskopie)
@@ -90,4 +90,7 @@
 if (any(bar[me]%vec(2)%indices /= 89)) call abort()
 
 if (any (bar[neighbor]%vec(1)%indices /= [ 3,4,15])) call abort()
+
+deallocate(bar%vec(2)%indices, object%scalar, object%matrix)
+deallocate(bar%vec)
 end program
Index: gcc/fortran/trans-openmp.c
===================================================================
--- gcc/fortran/trans-openmp.c	(Revision 243020)
+++ gcc/fortran/trans-openmp.c	(Arbeitskopie)
@@ -420,8 +420,8 @@
 	  if (GFC_DESCRIPTOR_TYPE_P (ftype)
 	      && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
 	    {
-	      tem = gfc_trans_dealloc_allocated (unshare_expr (declf),
-						 false, NULL);
+	      tem = gfc_trans_dealloc_allocated (unshare_expr (declf), NULL,
+						 GFC_CAF_COARRAY_NOCOARRAY);
 	      gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem));
 	    }
 	  else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
@@ -812,7 +812,8 @@
       if (GFC_DESCRIPTOR_TYPE_P (type))
 	gfc_add_expr_to_block (&cond_block,
 			       gfc_trans_dealloc_allocated (unshare_expr (dest),
-							    false, NULL));
+							    NULL,
+						    GFC_CAF_COARRAY_NOCOARRAY));
       else
 	{
 	  destptr = gfc_evaluate_now (destptr, &cond_block);
@@ -988,7 +989,7 @@
   if (GFC_DESCRIPTOR_TYPE_P (type))
     /* Allocatable arrays in FIRSTPRIVATE/LASTPRIVATE etc. clauses need
        to be deallocated if they were allocated.  */
-    tem = gfc_trans_dealloc_allocated (decl, false, NULL);
+    tem = gfc_trans_dealloc_allocated (decl, NULL, GFC_CAF_COARRAY_NOCOARRAY);
   else
     tem = gfc_call_free (decl);
   tem = gfc_omp_unshare_expr (tem);
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(Revision 243020)
+++ gcc/fortran/gfortran.h	(Arbeitskopie)
@@ -3274,7 +3274,7 @@
 /* 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);
+symbol_attribute gfc_caf_attr (gfc_expr *, bool i = false, bool *r = NULL);
 match gfc_match_rvalue (gfc_expr **);
 match gfc_match_varspec (gfc_expr*, int, bool, bool);
 int gfc_check_digit (char, int);
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(Revision 243020)
+++ gcc/fortran/trans-stmt.c	(Arbeitskopie)
@@ -6409,6 +6409,9 @@
   for (al = code->ext.alloc.list; al != NULL; al = al->next)
     {
       gfc_expr *expr = gfc_copy_expr (al->expr);
+      bool is_coarray = false, is_coarray_array = false;
+      int caf_mode = 0;
+
       gcc_assert (expr->expr_type == EXPR_VARIABLE);
 
       if (expr->ts.type == BT_CLASS)
@@ -6421,11 +6424,32 @@
       se.descriptor_only = 1;
       gfc_conv_expr (&se, expr);
 
-      if (expr->rank || gfc_caf_attr (expr).codimension)
+      if (flag_coarray == GFC_FCOARRAY_LIB)
 	{
+	  bool comp_ref;
+	  symbol_attribute caf_attr = gfc_caf_attr (expr, false, &comp_ref);
+	  if (caf_attr.codimension)
+	    {
+	      is_coarray = true;
+	      is_coarray_array = caf_attr.dimension || !comp_ref
+		  || caf_attr.coarray_comp;
+
+	      /* When the expression to deallocate is referencing a
+		 component, then only deallocate it, but do not deregister.  */
+	      caf_mode = GFC_STRUCTURE_CAF_MODE_IN_COARRAY
+		  | (comp_ref && !caf_attr.coarray_comp
+		     ? GFC_STRUCTURE_CAF_MODE_DEALLOC_ONLY : 0);
+	    }
+	}
+      else if (flag_coarray == GFC_FCOARRAY_SINGLE)
+	is_coarray = is_coarray_array = gfc_caf_attr (expr).codimension;
+
+      if (expr->rank || is_coarray_array)
+	{
 	  gfc_ref *ref;
 
-	  if (gfc_bt_struct (expr->ts.type) && expr->ts.u.derived->attr.alloc_comp
+	  if (gfc_bt_struct (expr->ts.type)
+	      && expr->ts.u.derived->attr.alloc_comp
 	      && !gfc_is_finalizable (expr->ts.u.derived, NULL))
 	    {
 	      gfc_ref *last = NULL;
@@ -6439,8 +6463,18 @@
 	      if (!(last && last->u.c.component->attr.pointer)
 		    && !(!last && expr->symtree->n.sym->attr.pointer))
 		{
-		  tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, se.expr,
-						   expr->rank);
+		  if (is_coarray && expr->rank == 0
+		      && (!last || !last->u.c.component->attr.dimension))
+		    {
+		      /* Add the ref to the data member only, when this is not
+			 a regular array or deallocate_alloc_comp will try to
+			 add another one.  */
+		      tmp = gfc_conv_descriptor_data_get (se.expr);
+		    }
+		  else
+		    tmp = se.expr;
+		  tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp,
+						   expr->rank, caf_mode);
 		  gfc_add_expr_to_block (&se.pre, tmp);
 		}
 	    }
@@ -6447,8 +6481,16 @@
 
 	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)))
 	    {
+	      gfc_coarray_deregtype caf_dtype;
+
+	      if (is_coarray)
+		caf_dtype = gfc_caf_is_dealloc_only (caf_mode)
+		    ? GFC_CAF_COARRAY_DEALLOCATE_ONLY
+		    : GFC_CAF_COARRAY_DEREGISTER;
+	      else
+		caf_dtype = GFC_CAF_COARRAY_NOCOARRAY;
 	      tmp = gfc_array_deallocate (se.expr, pstat, errmsg, errlen,
-				          label_finish, expr);
+					  label_finish, expr, caf_dtype);
 	      gfc_add_expr_to_block (&se.pre, tmp);
 	    }
 	  else if (TREE_CODE (se.expr) == COMPONENT_REF
@@ -6491,8 +6533,9 @@
 	}
       else
 	{
-	  tmp = gfc_deallocate_scalar_with_status (se.expr, pstat, false,
-						   al->expr, al->expr->ts);
+	  tmp = gfc_deallocate_scalar_with_status (se.expr, pstat, label_finish,
+						   false, al->expr,
+						   al->expr->ts, is_coarray);
 	  gfc_add_expr_to_block (&se.pre, tmp);
 
 	  /* Set to zero after deallocation.  */
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c	(Revision 243020)
+++ gcc/fortran/check.c	(Arbeitskopie)
@@ -851,6 +851,17 @@
 bool
 gfc_check_allocated (gfc_expr *array)
 {
+  /* Tests on allocated components of coarrays need to detour the check to
+     argument of the _caf_get.  */
+  if (flag_coarray == GFC_FCOARRAY_LIB && array->expr_type == EXPR_FUNCTION
+      && array->value.function.isym
+      && array->value.function.isym->id == GFC_ISYM_CAF_GET)
+    {
+      array = array->value.function.actual->expr;
+      if (!array->ref)
+	return false;
+    }
+
   if (!variable_check (array, 0, false))
     return false;
   if (!allocatable_check (array, 0))
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c	(Revision 243020)
+++ gcc/fortran/primary.c	(Arbeitskopie)
@@ -2418,10 +2418,15 @@
    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.  */
+   "infectious" being propagated once set and never cleared.
+   The coarray_comp is only set, when the expression refs a coarray
+   component.  REFS_COMP is set when present to true only, when this EXPR
+   refs a (non-_data) component.  To check whether EXPR refs an allocatable
+   component in a derived type coarray *refs_comp needs to be set and
+   coarray_comp has to false.  */
 
 static symbol_attribute
-caf_variable_attr (gfc_expr *expr, bool in_allocate)
+caf_variable_attr (gfc_expr *expr, bool in_allocate, bool *refs_comp)
 {
   int dimension, codimension, pointer, allocatable, target, coarray_comp,
       alloc_comp;
@@ -2436,6 +2441,9 @@
   sym = expr->symtree->n.sym;
   gfc_clear_attr (&attr);
 
+  if (refs_comp)
+    *refs_comp = 0;
+
   if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
     {
       dimension = CLASS_DATA (sym)->attr.dimension;
@@ -2442,7 +2450,6 @@
       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
@@ -2451,12 +2458,11 @@
       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;
+  target = coarray_comp = 0;
   if (pointer || attr.proc_pointer)
     target = 1;
 
@@ -2494,19 +2500,26 @@
 
 	if (comp->ts.type == BT_CLASS)
 	  {
+	    /* Set coarray_comp only, when this component introduces the
+	       coarray.  */
+	    coarray_comp = !codimension && CLASS_DATA (comp)->attr.codimension;
 	    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
 	  {
+	    /* Set coarray_comp only, when this component introduces the
+	       coarray.  */
+	    coarray_comp = !codimension && comp->attr.codimension;
 	    codimension |= comp->attr.codimension;
 	    pointer = comp->attr.pointer;
 	    allocatable = comp->attr.allocatable;
-	    coarray_comp |= comp->attr.coarray_comp;
 	  }
 
+	if (refs_comp && strcmp (comp->name, "_data") != 0)
+	  *refs_comp = 1;
+
 	if (pointer || attr.proc_pointer)
 	  target = 1;
 
@@ -2531,7 +2544,7 @@
 
 
 symbol_attribute
-gfc_caf_attr (gfc_expr *e, bool in_allocate)
+gfc_caf_attr (gfc_expr *e, bool in_allocate, bool *refs_comp)
 {
   symbol_attribute attr;
 
@@ -2538,7 +2551,7 @@
   switch (e->expr_type)
     {
     case EXPR_VARIABLE:
-      attr = caf_variable_attr (e, in_allocate);
+      attr = caf_variable_attr (e, in_allocate, refs_comp);
       break;
 
     case EXPR_FUNCTION:
@@ -2557,7 +2570,7 @@
 	    }
 	}
       else if (e->symtree)
-	attr = caf_variable_attr (e, in_allocate);
+	attr = caf_variable_attr (e, in_allocate, refs_comp);
       else
 	gfc_clear_attr (&attr);
       break;
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c	(Revision 243020)
+++ gcc/fortran/trans-intrinsic.c	(Arbeitskopie)
@@ -1674,7 +1674,8 @@
 		      tmp = gfc_deallocate_with_status (tmp, NULL_TREE,
 							NULL_TREE, NULL_TREE,
 							NULL_TREE, true,
-							NULL, false);
+							NULL,
+						     GFC_CAF_COARRAY_NOCOARRAY);
 		      gfc_add_expr_to_block (&se->post, tmp);
 		    }
 		}
@@ -1764,6 +1765,7 @@
 	  ar->as = ar2.as;
 	  ar->type = AR_FULL;
 	}
+      // TODO: Check whether argse.want_coarray = 1 can help with the below.
       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.  */
@@ -1926,7 +1928,9 @@
 
   /* 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) && !lhs_caf_attr.codimension)
+  if (!gfc_is_coindexed (lhs_expr)
+      && (!lhs_caf_attr.codimension
+	  || !(lhs_expr->rank > 0 && lhs_caf_attr.allocatable)))
     {
       bool lhs_may_realloc = lhs_expr->rank > 0 && lhs_caf_attr.allocatable;
       gcc_assert (gfc_is_coindexed (rhs_expr));
@@ -1957,7 +1961,7 @@
       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, lhs_may_realloc,
-				  &lhs_caf_attr);
+				  &rhs_caf_attr);
       gfc_add_block_to_block (&block, &rhs_se.pre);
       gfc_add_block_to_block (&block, &rhs_se.post);
       gfc_add_block_to_block (&block, &lhs_se.post);
@@ -2059,7 +2063,7 @@
       gfc_add_block_to_block (&block, &stat_se.post);
     }
 
-  if (!gfc_is_coindexed (rhs_expr) && !rhs_caf_attr.codimension)
+  if (!gfc_is_coindexed (rhs_expr))
     {
       if (lhs_caf_attr.alloc_comp)
 	{
@@ -7318,6 +7322,42 @@
 }
 
 
+/* Generate a call to caf_is_present.  */
+
+static tree
+trans_caf_is_present (gfc_se *se, gfc_expr *expr)
+{
+  tree caf_reference, caf_decl, token, image_index;
+
+  /* Compile the reference chain.  */
+  caf_reference = conv_expr_ref_to_caf_ref (&se->pre, expr);
+  gcc_assert (caf_reference != NULL_TREE);
+
+  caf_decl = gfc_get_tree_for_caf_expr (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, expr, caf_decl);
+  gfc_get_caf_token_offset (se, &token, NULL, caf_decl, NULL,
+			    expr);
+
+  return build_call_expr_loc (input_location, gfor_fndecl_caf_is_present,
+			      3, token, image_index, caf_reference);
+}
+
+
+/* Test whether this ref-chain refs this image only.  */
+
+static bool
+caf_this_image_ref (gfc_ref *ref)
+{
+  for ( ; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY && ref->u.ar.codimen)
+      return ref->u.ar.dimen_type[ref->u.ar.dimen] == DIMEN_THIS_IMAGE;
+
+  return false;
+}
+
+
 /* Generate code for the ALLOCATED intrinsic.
    Generate inline code that directly check the address of the argument.  */
 
@@ -7327,6 +7367,7 @@
   gfc_actual_arglist *arg1;
   gfc_se arg1se;
   tree tmp;
+  symbol_attribute caf_attr;
 
   gfc_init_se (&arg1se, NULL);
   arg1 = expr->value.function.actual;
@@ -7342,23 +7383,37 @@
 	gfc_add_data_component (arg1->expr);
     }
 
-  if (arg1->expr->rank == 0)
-    {
-      /* Allocatable scalar.  */
-      arg1se.want_pointer = 1;
-      gfc_conv_expr (&arg1se, arg1->expr);
-      tmp = arg1se.expr;
-    }
+  /* When arg1 references an allocatable component in a coarray, then call
+     the caf-library function caf_is_present ().  */
+  if (flag_coarray == GFC_FCOARRAY_LIB && arg1->expr->expr_type == EXPR_FUNCTION
+      && arg1->expr->value.function.isym
+      && arg1->expr->value.function.isym->id == GFC_ISYM_CAF_GET)
+    caf_attr = gfc_caf_attr (arg1->expr->value.function.actual->expr);
   else
+    gfc_clear_attr (&caf_attr);
+  if (flag_coarray == GFC_FCOARRAY_LIB && caf_attr.codimension
+      && !caf_this_image_ref (arg1->expr->value.function.actual->expr->ref))
+    tmp = trans_caf_is_present (se, arg1->expr->value.function.actual->expr);
+  else
     {
-      /* Allocatable array.  */
-      arg1se.descriptor_only = 1;
-      gfc_conv_expr_descriptor (&arg1se, arg1->expr);
-      tmp = gfc_conv_descriptor_data_get (arg1se.expr);
+      if (arg1->expr->rank == 0)
+	{
+	  /* Allocatable scalar.  */
+	  arg1se.want_pointer = 1;
+	  gfc_conv_expr (&arg1se, arg1->expr);
+	  tmp = arg1se.expr;
+	}
+      else
+	{
+	  /* Allocatable array.  */
+	  arg1se.descriptor_only = 1;
+	  gfc_conv_expr_descriptor (&arg1se, arg1->expr);
+	  tmp = gfc_conv_descriptor_data_get (arg1se.expr);
+	}
+
+      tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp,
+			     fold_convert (TREE_TYPE (tmp), null_pointer_node));
     }
-
-  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp,
-			 fold_convert (TREE_TYPE (tmp), null_pointer_node));
   se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp);
 }
 
@@ -10270,8 +10325,8 @@
       gfc_add_block_to_block (&block, &to_se.pre);
 
       /* Deallocate "to".  */
-      tmp = gfc_deallocate_scalar_with_status (to_se.expr, NULL_TREE, true,
-					       to_expr, to_expr->ts);
+      tmp = gfc_deallocate_scalar_with_status (to_se.expr, NULL_TREE, NULL_TREE,
+					       true, to_expr, to_expr->ts);
       gfc_add_expr_to_block (&block, tmp);
 
       /* Assign (_data) pointers.  */
@@ -10429,7 +10484,7 @@
 
       tmp = gfc_deallocate_with_status (to_se.expr, NULL_TREE, NULL_TREE,
 					NULL_TREE, NULL_TREE, true, to_expr,
-					true);
+					GFC_CAF_COARRAY_DEALLOCATE_ONLY);
       gfc_add_expr_to_block (&block, tmp);
 
       tmp = gfc_conv_descriptor_data_get (to_se.expr);
@@ -10457,7 +10512,8 @@
 
       tmp = gfc_conv_descriptor_data_get (to_se.expr);
       tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE, NULL_TREE,
-					NULL_TREE, true, to_expr, false);
+					NULL_TREE, true, to_expr,
+					GFC_CAF_COARRAY_NOCOARRAY);
       gfc_add_expr_to_block (&block, tmp);
     }
 
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(Revision 243020)
+++ gcc/fortran/trans-array.c	(Arbeitskopie)
@@ -5633,12 +5633,13 @@
 
 tree
 gfc_array_deallocate (tree descriptor, tree pstat, tree errmsg, tree errlen,
-		      tree label_finish, gfc_expr* expr)
+		      tree label_finish, gfc_expr* expr,
+		      int coarray_dealloc_mode)
 {
   tree var;
   tree tmp;
   stmtblock_t block;
-  bool coarray = gfc_caf_attr (expr).codimension;
+  bool coarray = coarray_dealloc_mode != GFC_CAF_COARRAY_NOCOARRAY;
 
   gfc_start_block (&block);
 
@@ -5648,7 +5649,8 @@
 
   /* Parameter is the address of the data component.  */
   tmp = gfc_deallocate_with_status (coarray ? descriptor : var, pstat, errmsg,
-				    errlen, label_finish, false, expr, coarray);
+				    errlen, label_finish, false, expr,
+				    coarray_dealloc_mode);
   gfc_add_expr_to_block (&block, tmp);
 
   /* Zero the data pointer; only for coarrays an error can occur and then
@@ -7782,11 +7784,13 @@
 /* Generate code to deallocate an array, if it is allocated.  */
 
 tree
-gfc_trans_dealloc_allocated (tree descriptor, bool coarray, gfc_expr *expr)
+gfc_trans_dealloc_allocated (tree descriptor, gfc_expr *expr,
+			     int coarray_dealloc_mode)
 {
   tree tmp;
   tree var;
   stmtblock_t block;
+  bool coarray = coarray_dealloc_mode != GFC_CAF_COARRAY_NOCOARRAY;
 
   gfc_start_block (&block);
 
@@ -7797,8 +7801,8 @@
      Although it is ignored here, it's presence ensures that arrays that
      are already deallocated are ignored.  */
   tmp = gfc_deallocate_with_status (coarray ? descriptor : var, NULL_TREE,
-				    NULL_TREE, NULL_TREE, NULL_TREE, true,
-				    expr, coarray);
+				    NULL_TREE, NULL_TREE, NULL_TREE, true, expr,
+				    coarray_dealloc_mode);
   gfc_add_expr_to_block (&block, tmp);
 
   /* Zero the data pointer.  */
@@ -7855,9 +7859,7 @@
 
   if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest)))
     {
-      tmp = null_pointer_node;
-      tmp = fold_build2_loc (input_location, MODIFY_EXPR, type, dest, tmp);
-      gfc_add_expr_to_block (&block, tmp);
+      gfc_add_modify (&block, dest, fold_convert (type, null_pointer_node));
       null_data = gfc_finish_block (&block);
 
       gfc_init_block (&block);
@@ -7869,9 +7871,7 @@
       if (!no_malloc)
 	{
 	  tmp = gfc_call_malloc (&block, type, size);
-	  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
-				 dest, fold_convert (type, tmp));
-	  gfc_add_expr_to_block (&block, tmp);
+	  gfc_add_modify (&block, dest, fold_convert (type, tmp));
 	}
 
       if (!no_memcpy)
@@ -7967,17 +7967,152 @@
 }
 
 
+static tree
+duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src,
+			       tree type, int rank)
+{
+  tree tmp;
+  tree size;
+  tree nelems;
+  tree null_cond;
+  tree null_data;
+  stmtblock_t block, globalblock;
+
+  /* If the source is null, set the destination to null.  Then,
+     allocate memory to the destination.  */
+  gfc_init_block (&block);
+  gfc_init_block (&globalblock);
+
+  if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest)))
+    {
+      gfc_se se;
+      symbol_attribute attr;
+      tree dummy_desc;
+
+      gfc_init_se (&se, NULL);
+      dummy_desc = gfc_conv_scalar_to_descriptor (&se, dest, attr);
+      gfc_add_block_to_block (&globalblock, &se.pre);
+      size = TYPE_SIZE_UNIT (TREE_TYPE (type));
+
+      gfc_add_modify (&block, dest, fold_convert (type, null_pointer_node));
+      gfc_allocate_using_caf_lib (&block, dummy_desc, size,
+				  gfc_build_addr_expr (NULL_TREE, dest_tok),
+				  NULL_TREE, NULL_TREE, NULL_TREE,
+				  GFC_CAF_COARRAY_ALLOC_REGISTER_ONLY);
+      null_data = gfc_finish_block (&block);
+
+      gfc_init_block (&block);
+
+      gfc_allocate_using_caf_lib (&block, dummy_desc,
+				  fold_convert (size_type_node, size),
+				  gfc_build_addr_expr (NULL_TREE, dest_tok),
+				  NULL_TREE, NULL_TREE, NULL_TREE,
+				  GFC_CAF_COARRAY_ALLOC);
+
+      tmp = builtin_decl_explicit (BUILT_IN_MEMCPY);
+      tmp = build_call_expr_loc (input_location, tmp, 3, dest, src,
+				 fold_convert (size_type_node, size));
+      gfc_add_expr_to_block (&block, tmp);
+    }
+  else
+    {
+      /* Set the rank or unitialized memory access may be reported.  */
+      tmp = gfc_conv_descriptor_dtype (dest);
+      gfc_add_modify (&globalblock, tmp, build_int_cst (TREE_TYPE (tmp), rank));
+
+      if (rank)
+	nelems = gfc_full_array_size (&block, src, rank);
+      else
+	nelems = integer_one_node;
+
+      tmp = fold_convert (size_type_node,
+			  TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+      size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+			      fold_convert (size_type_node, nelems), tmp);
+
+      gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
+      gfc_allocate_using_caf_lib (&block, dest, fold_convert (size_type_node,
+							      size),
+				  gfc_build_addr_expr (NULL_TREE, dest_tok),
+				  NULL_TREE, NULL_TREE, NULL_TREE,
+				  GFC_CAF_COARRAY_ALLOC_REGISTER_ONLY);
+      null_data = gfc_finish_block (&block);
+
+      gfc_init_block (&block);
+      gfc_allocate_using_caf_lib (&block, dest,
+				  fold_convert (size_type_node, size),
+				  gfc_build_addr_expr (NULL_TREE, dest_tok),
+				  NULL_TREE, NULL_TREE, NULL_TREE,
+				  GFC_CAF_COARRAY_ALLOC);
+
+      tmp = builtin_decl_explicit (BUILT_IN_MEMCPY);
+      tmp = build_call_expr_loc (input_location, tmp, 3,
+				 gfc_conv_descriptor_data_get (dest),
+				 gfc_conv_descriptor_data_get (src),
+				 fold_convert (size_type_node, size));
+      gfc_add_expr_to_block (&block, tmp);
+    }
+
+  tmp = gfc_finish_block (&block);
+
+  /* Null the destination if the source is null; otherwise do
+     the register and copy.  */
+  if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (src)))
+    null_cond = src;
+  else
+    null_cond = gfc_conv_descriptor_data_get (src);
+
+  null_cond = convert (pvoid_type_node, null_cond);
+  null_cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			       null_cond, null_pointer_node);
+  gfc_add_expr_to_block (&globalblock, build3_v (COND_EXPR, null_cond, tmp,
+						 null_data));
+  return gfc_finish_block (&globalblock);
+}
+
+
+/* Helper function to abstract whether coarray processing is enabled.  */
+
+static bool
+caf_enabled (int caf_mode)
+{
+  return (caf_mode & GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY)
+      == GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY;
+}
+
+
+/* Helper function to abstract whether coarray processing is enabled
+   and we are in a derived type coarray.  */
+
+static bool
+caf_in_coarray (int caf_mode)
+{
+  static const int pat = GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY
+			 | GFC_STRUCTURE_CAF_MODE_IN_COARRAY;
+  return (caf_mode & pat) == pat;
+}
+
+
+/* Helper function to abstract whether coarray is to deallocate only.  */
+
+bool
+gfc_caf_is_dealloc_only (int caf_mode)
+{
+  return (caf_mode & GFC_STRUCTURE_CAF_MODE_DEALLOC_ONLY)
+      == GFC_STRUCTURE_CAF_MODE_DEALLOC_ONLY;
+}
+
+
 /* Recursively traverse an object of derived type, generating code to
    deallocate, nullify or copy allocatable components.  This is the work horse
    function for the functions named in this enum.  */
 
-enum {DEALLOCATE_ALLOC_COMP = 1, DEALLOCATE_ALLOC_COMP_NO_CAF,
-      NULLIFY_ALLOC_COMP, COPY_ALLOC_COMP, COPY_ONLY_ALLOC_COMP,
-      COPY_ALLOC_COMP_CAF};
+enum {DEALLOCATE_ALLOC_COMP = 1, NULLIFY_ALLOC_COMP,
+      COPY_ALLOC_COMP, COPY_ONLY_ALLOC_COMP, REASSIGN_CAF_COMP};
 
 static tree
 structure_alloc_comps (gfc_symbol * der_type, tree decl,
-		       tree dest, int rank, int purpose)
+		       tree dest, int rank, int purpose, int caf_mode)
 {
   gfc_component *c;
   gfc_loopinfo loop;
@@ -8011,11 +8146,11 @@
       /* Deref dest in sync with decl, but only when it is not NULL.  */
       if (dest)
 	dest = build_fold_indirect_ref_loc (input_location, dest);
+
+      /* Update the decl_type because it got dereferenced.  */
+      decl_type = TREE_TYPE (decl);
     }
 
-  /* Just in case it gets dereferenced.  */
-  decl_type = TREE_TYPE (decl);
-
   /* If this is an array of derived types with allocatable components
      build a loop and recursively call this function.  */
   if (TREE_CODE (decl_type) == ARRAY_TYPE
@@ -8056,16 +8191,18 @@
 
       vref = gfc_build_array_ref (var, index, NULL);
 
-      if (purpose == COPY_ALLOC_COMP || purpose == COPY_ONLY_ALLOC_COMP)
-        {
+      if ((purpose == COPY_ALLOC_COMP || purpose == COPY_ONLY_ALLOC_COMP)
+	  && !caf_enabled (caf_mode))
+	{
 	  tmp = build_fold_indirect_ref_loc (input_location,
 					 gfc_conv_array_data (dest));
 	  dref = gfc_build_array_ref (tmp, index, NULL);
 	  tmp = structure_alloc_comps (der_type, vref, dref, rank,
-				       COPY_ALLOC_COMP);
+				       COPY_ALLOC_COMP, 0);
 	}
       else
-        tmp = structure_alloc_comps (der_type, vref, NULL_TREE, rank, purpose);
+	tmp = structure_alloc_comps (der_type, vref, NULL_TREE, rank, purpose,
+				     caf_mode);
 
       gfc_add_expr_to_block (&loopbody, tmp);
 
@@ -8111,7 +8248,6 @@
       switch (purpose)
 	{
 	case DEALLOCATE_ALLOC_COMP:
-	case DEALLOCATE_ALLOC_COMP_NO_CAF:
 
 	  /* gfc_deallocate_scalar_with_status calls gfc_deallocate_alloc_comp
 	     (i.e. this function) so generate all the calls and suppress the
@@ -8128,21 +8264,57 @@
 	      /* The finalizer frees allocatable components.  */
 	      called_dealloc_with_status
 		= gfc_add_comp_finalizer_call (&tmpblock, comp, c,
-					       purpose == DEALLOCATE_ALLOC_COMP);
+					       purpose == DEALLOCATE_ALLOC_COMP
+					       && caf_enabled (caf_mode));
 	    }
 	  else
 	    comp = NULL_TREE;
 
-	  if (c->attr.allocatable && !c->attr.proc_pointer
+	  if (c->attr.allocatable && !c->attr.proc_pointer && !same_type
 	      && (c->attr.dimension
-		  || (c->attr.codimension
-		      && purpose != DEALLOCATE_ALLOC_COMP_NO_CAF))
-	      && !same_type)
+		  || (caf_enabled (caf_mode)
+		      && (caf_in_coarray (caf_mode) || c->attr.codimension))))
 	    {
+	      /* Allocatable arrays or coarray'ed components (scalar or
+		 array).  */
+	      int caf_dereg_mode
+		  = (caf_in_coarray (caf_mode) || c->attr.codimension)
+		  ? (gfc_caf_is_dealloc_only (caf_mode)
+		     ? GFC_CAF_COARRAY_DEALLOCATE_ONLY
+		     : GFC_CAF_COARRAY_DEREGISTER)
+		  : GFC_CAF_COARRAY_NOCOARRAY;
 	      if (comp == NULL_TREE)
 		comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
 					decl, cdecl, NULL_TREE);
-	      tmp = gfc_trans_dealloc_allocated (comp, c->attr.codimension, NULL);
+
+	      if (c->attr.dimension || c->attr.codimension)
+		/* Deallocate array.  */
+		tmp = gfc_trans_dealloc_allocated (comp, NULL, caf_dereg_mode);
+	      else
+		{
+		  /* Deallocate scalar.  */
+		  tree cond = fold_build2_loc (input_location, NE_EXPR,
+					       boolean_type_node, comp,
+					       build_int_cst (TREE_TYPE (comp),
+							      0));
+
+		  tmp = fold_build3_loc (input_location, COMPONENT_REF,
+					 pvoid_type_node, decl, c->caf_token,
+					 NULL_TREE);
+		  tmp = build_call_expr_loc (input_location,
+					     gfor_fndecl_caf_deregister, 5,
+					     gfc_build_addr_expr (NULL_TREE,
+								  tmp),
+					     build_int_cst (integer_type_node,
+							    caf_dereg_mode),
+					     null_pointer_node,
+					     null_pointer_node,
+					     integer_zero_node);
+		  tmp = fold_build3_loc (input_location, COND_EXPR,
+					 void_type_node, cond, tmp,
+					 build_empty_stmt (input_location));
+		}
+
 	      gfc_add_expr_to_block (&tmpblock, tmp);
 	    }
 	  else if (c->attr.allocatable && !c->attr.codimension && !same_type)
@@ -8152,7 +8324,8 @@
 		comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
 					decl, cdecl, NULL_TREE);
 
-	      tmp = gfc_deallocate_scalar_with_status (comp, NULL, true, NULL,
+	      tmp = gfc_deallocate_scalar_with_status (comp, NULL_TREE,
+						       NULL_TREE, true, NULL,
 						       c->ts);
 	      gfc_add_expr_to_block (&tmpblock, tmp);
 	      called_dealloc_with_status = true;
@@ -8168,8 +8341,6 @@
 	      tree is_allocated;
 	      tree ubound;
 	      tree cdesc;
-	      tree zero = build_int_cst (gfc_array_index_type, 0);
-	      tree unity = build_int_cst (gfc_array_index_type, 1);
 	      tree data;
 	      stmtblock_t dealloc_block;
 
@@ -8191,8 +8362,8 @@
 		  ubound = build_int_cst (gfc_array_index_type, 1);
 		}
 
-	      cdesc = gfc_get_array_type_bounds (tmp, 1, 0,
-						 &unity, &ubound, 1,
+	      cdesc = gfc_get_array_type_bounds (tmp, 1, 0, &gfc_index_one_node,
+						 &ubound, 1,
 						 GFC_ARRAY_ALLOCATABLE, false);
 
 	      cdesc = gfc_create_var (cdesc, "cdesc");
@@ -8201,11 +8372,13 @@
 	      gfc_add_modify (&dealloc_block, gfc_conv_descriptor_dtype (cdesc),
 			      gfc_get_dtype_rank_type (1, tmp));
 	      gfc_conv_descriptor_lbound_set (&dealloc_block, cdesc,
-					      zero, unity);
+					      gfc_index_zero_node,
+					      gfc_index_one_node);
 	      gfc_conv_descriptor_stride_set (&dealloc_block, cdesc,
-					      zero, unity);
+					      gfc_index_zero_node,
+					      gfc_index_one_node);
 	      gfc_conv_descriptor_ubound_set (&dealloc_block, cdesc,
-					      zero, ubound);
+					      gfc_index_zero_node, ubound);
 
 	      if (c->attr.dimension)
 		data = gfc_conv_descriptor_data_get (comp);
@@ -8247,7 +8420,7 @@
 
 	  else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable
 		   && (!CLASS_DATA (c)->attr.codimension
-		       || purpose != DEALLOCATE_ALLOC_COMP_NO_CAF))
+		    || !caf_enabled (caf_mode)))
 	    {
 	      /* Allocatable CLASS components.  */
 
@@ -8257,11 +8430,15 @@
 				      TREE_TYPE (tmp), comp, tmp, NULL_TREE);
 
 	      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)))
-	        tmp = gfc_trans_dealloc_allocated (comp,
-					CLASS_DATA (c)->attr.codimension, NULL);
+		tmp = gfc_trans_dealloc_allocated (comp, NULL,
+						CLASS_DATA (c)->attr.codimension
+						? GFC_CAF_COARRAY_DEREGISTER
+						: GFC_CAF_COARRAY_NOCOARRAY);
 	      else
 		{
-		  tmp = gfc_deallocate_scalar_with_status (comp, NULL_TREE, true, NULL,
+		  tmp = gfc_deallocate_scalar_with_status (comp, NULL_TREE,
+							   NULL_TREE, true,
+							   NULL,
 							   CLASS_DATA (c)->ts);
 		  gfc_add_expr_to_block (&tmpblock, tmp);
 		  called_dealloc_with_status = true;
@@ -8317,7 +8494,7 @@
 				      decl, cdecl, NULL_TREE);
 	      rank = c->as ? c->as->rank : 0;
 	      tmp = structure_alloc_comps (c->ts.u.derived, comp, NULL_TREE,
-					   rank, purpose);
+					   rank, purpose, caf_mode);
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	    }
 
@@ -8326,14 +8503,20 @@
 	  break;
 
 	case NULLIFY_ALLOC_COMP:
-	  if (c->attr.pointer || c->attr.proc_pointer)
+	  if (c->attr.pointer || c->attr.proc_pointer
+	      || !(c->attr.allocatable || (c->ts.type == BT_CLASS
+					   && CLASS_DATA (c)->attr.allocatable)
+		   || cmp_has_alloc_comps))
 	    continue;
-	  else if (c->attr.allocatable
-		   && (c->attr.dimension|| c->attr.codimension))
+
+	  /* Coarrays need the component to be initialized before the api-call
+	     is made.  */
+	  if (c->attr.allocatable && (c->attr.dimension || c->attr.codimension))
 	    {
 	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
 				      decl, cdecl, NULL_TREE);
 	      gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node);
+	      cmp_has_alloc_comps = false;
 	    }
 	  else if (c->attr.allocatable)
 	    {
@@ -8354,6 +8537,7 @@
 					 build_int_cst (TREE_TYPE (comp), 0));
 		  gfc_add_expr_to_block (&fnblock, tmp);
 		}
+	      cmp_has_alloc_comps = false;
 	    }
 	  else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable)
 	    {
@@ -8371,47 +8555,93 @@
 					 build_int_cst (TREE_TYPE (comp), 0));
 		  gfc_add_expr_to_block (&fnblock, tmp);
 		}
+	      cmp_has_alloc_comps = false;
 	    }
-          else if (cmp_has_alloc_comps)
+
+	  if (flag_coarray == GFC_FCOARRAY_LIB
+	      && (caf_in_coarray (caf_mode) || c->attr.codimension))
 	    {
+	      /* Register the component with the coarray library.  */
+	      tree token;
+
 	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
 				      decl, cdecl, NULL_TREE);
+	      if (c->attr.dimension || c->attr.codimension)
+		{
+		  tmp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+					 decl, cdecl, NULL_TREE);
+		  token = gfc_conv_descriptor_token (tmp);
+		}
+	      else
+		{
+		  gfc_se se;
+		  symbol_attribute attr;
+
+		  gfc_init_se (&se, NULL);
+		  gfc_clear_attr (&attr);
+		  token = fold_build3_loc (input_location, COMPONENT_REF,
+					   pvoid_type_node, decl, c->caf_token,
+					   NULL_TREE);
+		  comp = gfc_conv_scalar_to_descriptor (&se, comp, attr);
+		  gfc_add_block_to_block (&fnblock, &se.pre);
+		}
+
+	      /* NULL the member-token before registering it or uninitialized
+		 memory accesses may occur.  */
+	      gfc_add_modify (&fnblock, token, fold_convert (TREE_TYPE (token),
+							    null_pointer_node));
+	      gfc_allocate_using_caf_lib (&fnblock, comp, size_zero_node,
+					  gfc_build_addr_expr (NULL_TREE,
+							       token),
+					  NULL_TREE, NULL_TREE, NULL_TREE,
+					  GFC_CAF_COARRAY_ALLOC_REGISTER_ONLY);
+	    }
+
+	  if (cmp_has_alloc_comps)
+	    {
+	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+				      decl, cdecl, NULL_TREE);
 	      rank = c->as ? c->as->rank : 0;
 	      tmp = structure_alloc_comps (c->ts.u.derived, comp, NULL_TREE,
-					   rank, purpose);
+					   rank, purpose, caf_mode);
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	    }
 	  break;
 
-	case COPY_ALLOC_COMP_CAF:
-	  if (!c->attr.codimension
-	      && (c->ts.type != BT_CLASS || CLASS_DATA (c)->attr.coarray_comp)
-	      && (c->ts.type != BT_DERIVED
-		  || !c->ts.u.derived->attr.coarray_comp))
-	    continue;
+	case REASSIGN_CAF_COMP:
+	  if (caf_enabled (caf_mode)
+	      && (c->attr.codimension
+		  || (c->ts.type == BT_CLASS
+		      && (CLASS_DATA (c)->attr.coarray_comp
+			  || caf_in_coarray (caf_mode)))
+		  || (c->ts.type == BT_DERIVED
+		      && (c->ts.u.derived->attr.coarray_comp
+			  || caf_in_coarray (caf_mode))))
+	      && !same_type)
+	    {
+	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+				      decl, cdecl, NULL_TREE);
+	      dcmp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+				      dest, cdecl, NULL_TREE);
 
-	  comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl,
-				  cdecl, NULL_TREE);
-	  dcmp = fold_build3_loc (input_location, COMPONENT_REF, ctype, dest,
-				  cdecl, NULL_TREE);
-
-	  if (c->attr.codimension)
-	    {
-	      if (c->ts.type == BT_CLASS)
+	      if (c->attr.codimension)
 		{
-		  comp = gfc_class_data_get (comp);
-		  dcmp = gfc_class_data_get (dcmp);
+		  if (c->ts.type == BT_CLASS)
+		    {
+		      comp = gfc_class_data_get (comp);
+		      dcmp = gfc_class_data_get (dcmp);
+		    }
+		  gfc_conv_descriptor_data_set (&fnblock, dcmp,
+					   gfc_conv_descriptor_data_get (comp));
 		}
-	      gfc_conv_descriptor_data_set (&fnblock, dcmp,
-					   gfc_conv_descriptor_data_get (comp));
+	      else
+		{
+		  tmp = structure_alloc_comps (c->ts.u.derived, comp, dcmp,
+					       rank, purpose, caf_mode
+					   | GFC_STRUCTURE_CAF_MODE_IN_COARRAY);
+		  gfc_add_expr_to_block (&fnblock, tmp);
+		}
 	    }
-	  else
-	    {
-	      tmp = structure_alloc_comps (c->ts.u.derived, comp, dcmp,
-					   rank, purpose);
-	      gfc_add_expr_to_block (&fnblock, tmp);
-
-	    }
 	  break;
 
 	case COPY_ALLOC_COMP:
@@ -8503,7 +8733,8 @@
 	      gfc_add_modify (&fnblock, dcmp, tmp);
 	      add_when_allocated = structure_alloc_comps (c->ts.u.derived,
 							  comp, dcmp,
-							  rank, purpose);
+							  rank, purpose,
+							  caf_mode);
 	    }
 	  else
 	    add_when_allocated = NULL_TREE;
@@ -8530,11 +8761,24 @@
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	    }
 	  else if (c->attr.allocatable && !c->attr.proc_pointer && !same_type
-		   && (!(cmp_has_alloc_comps && c->as) || c->attr.codimension))
+		   && (!(cmp_has_alloc_comps && c->as) || c->attr.codimension
+		       || caf_in_coarray (caf_mode)))
 	    {
 	      rank = c->as ? c->as->rank : 0;
 	      if (c->attr.codimension)
 		tmp = gfc_copy_allocatable_data (dcmp, comp, ctype, rank);
+	      else if (flag_coarray == GFC_FCOARRAY_LIB
+		       && caf_in_coarray (caf_mode))
+		{
+		  tree dst_tok = c->as ? gfc_conv_descriptor_token (dcmp)
+				       : fold_build3_loc (input_location,
+							  COMPONENT_REF,
+							  pvoid_type_node, dest,
+							  c->caf_token,
+							  NULL_TREE);
+		  tmp = duplicate_allocatable_coarray (dcmp, dst_tok, comp,
+						       ctype, rank);
+		}
 	      else
 		tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank,
 						 add_when_allocated);
@@ -8562,7 +8806,8 @@
 gfc_nullify_alloc_comp (gfc_symbol * der_type, tree decl, int rank)
 {
   return structure_alloc_comps (der_type, decl, NULL_TREE, rank,
-				NULLIFY_ALLOC_COMP);
+				NULLIFY_ALLOC_COMP,
+				GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY);
 }
 
 
@@ -8570,10 +8815,12 @@
    deallocate allocatable components.  */
 
 tree
-gfc_deallocate_alloc_comp (gfc_symbol * der_type, tree decl, int rank)
+gfc_deallocate_alloc_comp (gfc_symbol * der_type, tree decl, int rank,
+			   int caf_mode)
 {
   return structure_alloc_comps (der_type, decl, NULL_TREE, rank,
-				DEALLOCATE_ALLOC_COMP);
+				DEALLOCATE_ALLOC_COMP,
+			      GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY | caf_mode);
 }
 
 
@@ -8586,7 +8833,7 @@
 gfc_deallocate_alloc_comp_no_caf (gfc_symbol * der_type, tree decl, int rank)
 {
   return structure_alloc_comps (der_type, decl, NULL_TREE, rank,
-				DEALLOCATE_ALLOC_COMP_NO_CAF);
+				DEALLOCATE_ALLOC_COMP, 0);
 }
 
 
@@ -8593,7 +8840,8 @@
 tree
 gfc_reassign_alloc_comp_caf (gfc_symbol *der_type, tree decl, tree dest)
 {
-  return structure_alloc_comps (der_type, decl, dest, 0, COPY_ALLOC_COMP_CAF);
+  return structure_alloc_comps (der_type, decl, dest, 0, REASSIGN_CAF_COMP,
+				GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY);
 }
 
 
@@ -8601,9 +8849,11 @@
    copy it and its allocatable components.  */
 
 tree
-gfc_copy_alloc_comp (gfc_symbol * der_type, tree decl, tree dest, int rank)
+gfc_copy_alloc_comp (gfc_symbol * der_type, tree decl, tree dest, int rank,
+		     int caf_mode)
 {
-  return structure_alloc_comps (der_type, decl, dest, rank, COPY_ALLOC_COMP);
+  return structure_alloc_comps (der_type, decl, dest, rank, COPY_ALLOC_COMP,
+				caf_mode);
 }
 
 
@@ -8613,7 +8863,8 @@
 tree
 gfc_copy_only_alloc_comp (gfc_symbol * der_type, tree decl, tree dest, int rank)
 {
-  return structure_alloc_comps (der_type, decl, dest, rank, COPY_ONLY_ALLOC_COMP);
+  return structure_alloc_comps (der_type, decl, dest, rank,
+				COPY_ONLY_ALLOC_COMP, 0);
 }
 
 
@@ -9205,15 +9456,17 @@
   else
     {
       tmp = build_call_expr_loc (input_location,
-				 gfor_fndecl_caf_deregister,
-				 4, token, null_pointer_node,
-				 null_pointer_node, integer_zero_node);
+				 gfor_fndecl_caf_deregister, 5, token,
+				 build_int_cst (integer_type_node,
+					       GFC_CAF_COARRAY_DEALLOCATE_ONLY),
+				 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),
+					   GFC_CAF_COARRAY_ALLOC_ALLOCATE_ONLY),
 				 token, gfc_build_addr_expr (NULL_TREE, desc),
 				 null_pointer_node, null_pointer_node,
 				 integer_zero_node);
@@ -9398,7 +9651,20 @@
 
   /* NULLIFY the data pointer, for non-saved allocatables.  */
   if (GFC_DESCRIPTOR_TYPE_P (type) && !sym->attr.save && sym->attr.allocatable)
-    gfc_conv_descriptor_data_set (&init, descriptor, null_pointer_node);
+    {
+      gfc_conv_descriptor_data_set (&init, descriptor, null_pointer_node);
+      if (flag_coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
+	{
+	  /* Declare the variable static so its array descriptor stays present
+	     after leaving the scope.  It may still be accessed through another
+	     image.  This may happen, for example, with the caf_mpi
+	     implementation.  */
+	  TREE_STATIC (descriptor) = 1;
+	  tmp = gfc_conv_descriptor_token (descriptor);
+	  gfc_add_modify (&init, tmp, fold_convert (TREE_TYPE (tmp),
+						    null_pointer_node));
+	}
+    }
 
   gfc_restore_backend_locus (&loc);
   gfc_init_block (&cleanup);
@@ -9432,8 +9698,10 @@
     {
       gfc_expr *e;
       e = has_finalizer ? gfc_lval_expr_from_sym (sym) : NULL;
-      tmp = gfc_trans_dealloc_allocated (sym->backend_decl,
-					 sym->attr.codimension, e);
+      tmp = gfc_trans_dealloc_allocated (sym->backend_decl, e,
+					 sym->attr.codimension
+					 ? GFC_CAF_COARRAY_DEREGISTER
+					 : GFC_CAF_COARRAY_NOCOARRAY);
       if (e)
 	gfc_free_expr (e);
       gfc_add_expr_to_block (&cleanup, tmp);
Index: gcc/fortran/trans-array.h
===================================================================
--- gcc/fortran/trans-array.h	(Revision 243020)
+++ gcc/fortran/trans-array.h	(Arbeitskopie)
@@ -19,7 +19,7 @@
 <http://www.gnu.org/licenses/>.  */
 
 /* Generate code to free an array.  */
-tree gfc_array_deallocate (tree, tree, tree, tree, tree, gfc_expr*);
+tree gfc_array_deallocate (tree, tree, tree, tree, tree, gfc_expr*, int c = -2);
 
 /* Generate code to initialize and allocate an array.  Statements are added to
    se, which should contain an expression for the array descriptor.  */
@@ -42,7 +42,7 @@
 /* Generate entry and exit code for g77 calling convention arrays.  */
 void gfc_trans_g77_array (gfc_symbol *, gfc_wrapped_block *);
 /* Generate code to deallocate an array, if it is allocated.  */
-tree gfc_trans_dealloc_allocated (tree, bool, gfc_expr *);
+tree gfc_trans_dealloc_allocated (tree, gfc_expr *, int);
 
 tree gfc_full_array_size (stmtblock_t *, tree, int);
 
@@ -52,13 +52,15 @@
 
 tree gfc_duplicate_allocatable_nocopy (tree, tree, tree, int);
 
+bool gfc_caf_is_dealloc_only (int);
+
 tree gfc_nullify_alloc_comp (gfc_symbol *, tree, int);
 
-tree gfc_deallocate_alloc_comp (gfc_symbol *, tree, int);
+tree gfc_deallocate_alloc_comp (gfc_symbol *, tree, int, int cm = 0);
 tree gfc_deallocate_alloc_comp_no_caf (gfc_symbol *, tree, int);
 tree gfc_reassign_alloc_comp_caf (gfc_symbol *, tree, tree);
 
-tree gfc_copy_alloc_comp (gfc_symbol *, tree, tree, int);
+tree gfc_copy_alloc_comp (gfc_symbol *, tree, tree, int, int);
 
 tree gfc_copy_only_alloc_comp (gfc_symbol *, tree, tree, int);
 
Index: gcc/fortran/gfortran.texi
===================================================================
--- gcc/fortran/gfortran.texi	(Revision 243020)
+++ gcc/fortran/gfortran.texi	(Arbeitskopie)
@@ -3871,6 +3871,7 @@
 @menu
 * caf_token_t::
 * caf_register_t::
+* caf_deregister_t::
 * caf_reference_t::
 @end menu
 
@@ -3893,11 +3894,39 @@
   CAF_REGTYPE_LOCK_ALLOC,
   CAF_REGTYPE_CRITICAL,
   CAF_REGTYPE_EVENT_STATIC,
-  CAF_REGTYPE_EVENT_ALLOC
+  CAF_REGTYPE_EVENT_ALLOC,
+  CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY,
+  CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY
 }
 caf_register_t;
 @end verbatim
 
+The values @code{CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY} and
+@code{CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY} are for allocatable components
+in derived type coarrays only.  The first one sets up the token without
+allocating memory for allocatable component.  The latter one only allocates the
+memory for an allocatable component in a derived type coarray.  The token
+needs to be setup previously by the REGISTER_ONLY.  This allows to have
+allocatable components un-allocated on some images.  The status whether an
+allocatable component is allocated on a remote image can be queried by
+@code{_caf_is_present} which used internally by the @code{ALLOCATED}
+intrinsic.
+
+@node caf_deregister_t
+@subsection @code{caf_deregister_t}
+
+@verbatim
+typedef enum caf_deregister_t {
+  CAF_DEREGTYPE_COARRAY_DEREGISTER,
+  CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY
+}
+caf_deregister_t;
+@end verbatim
+
+Allows to specifiy the type of deregistration of a coarray object.  The
+@code{CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY} flag is only allowed for
+allocatable components in derived type coarrays.
+
 @node caf_reference_t
 @subsection @code{caf_reference_t}
 
@@ -4017,6 +4046,7 @@
 * _gfortran_caf_num_images:: Querying the maximal number of images
 * _gfortran_caf_register:: Registering coarrays
 * _gfortran_caf_deregister:: Deregistering coarrays
+* _gfortran_caf_is_present:: Query whether an allocatable component in a derived type coarray is allocated
 * _gfortran_caf_send:: Sending data from a local image to a remote image
 * _gfortran_caf_get:: Getting data from a remote image
 * _gfortran_caf_sendget:: Sending data between remote images
@@ -4218,6 +4248,7 @@
 be no event, e.g. zero.
 @end table
 
+
 @node _gfortran_caf_deregister
 @subsection @code{_gfortran_caf_deregister} --- Deregistering coarrays
 @cindex Coarray, _gfortran_caf_deregister
@@ -4231,12 +4262,16 @@
 @code{_gfortran_caf_register}.
 
 @item @emph{Syntax}:
-@code{void caf_deregister (caf_token_t *token, int *stat, char *errmsg,
-int errmsg_len)}
+@code{void caf_deregister (caf_token_t *token, caf_deregister_t type,
+int *stat, char *errmsg, int errmsg_len)}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
 @item @var{token} @tab the token to free.
+@item @var{type} @tab the type of action to take for the coarray.  A
+@code{CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY} is allowed only for allocatable
+components of derived type coarrays.  The action only deallocates the local
+memory without deleting the token.
 @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
@@ -4250,6 +4285,31 @@
 @end table
 
 
+@node _gfortran_caf_is_present
+@subsection @code{_gfortran_caf_is_present} --- Query whether an allocatable component in a derived type coarray is allocated
+@cindex Coarray, _gfortran_caf_is_present
+
+@table @asis
+@item @emph{Description}:
+Used to query the coarray library whether an allocatable component in a derived
+type coarray is allocated on a remote image.
+
+@item @emph{Syntax}:
+@code{void _gfortran_caf_is_present (caf_token_t token, int image_index,
+gfc_reference_t *ref)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{token} @tab An opaque pointer identifying the coarray.
+@item @var{image_index} @tab The ID of the remote image; must be a positive
+number.
+@item @var{ref} @tab A chain of references to address the allocatable component
+in the derived type coarray.  The object reffed needs to be a scalar or a full
+array ref, respectively.
+@end multitable
+
+@end table
+
 @node _gfortran_caf_send
 @subsection @code{_gfortran_caf_send} --- Sending data from a local image to a remote image
 @cindex Coarray, _gfortran_caf_send
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(Revision 243020)
+++ gcc/fortran/trans-decl.c	(Arbeitskopie)
@@ -159,6 +159,7 @@
 tree gfor_fndecl_co_min;
 tree gfor_fndecl_co_reduce;
 tree gfor_fndecl_co_sum;
+tree gfor_fndecl_caf_is_present;
 
 
 /* Math functions.  Many other math functions are handled in
@@ -3573,8 +3574,9 @@
 	pint_type, pchar_type_node, integer_type_node);
 
       gfor_fndecl_caf_deregister = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("caf_deregister")), "WWWR", void_type_node, 4,
-	ppvoid_type_node, pint_type, pchar_type_node, integer_type_node);
+	get_identifier (PREFIX("caf_deregister")), "WRWWR", void_type_node, 5,
+	ppvoid_type_node, integer_type_node, pint_type, pchar_type_node,
+	integer_type_node);
 
       gfor_fndecl_caf_get = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_get")), ".R.RRWRRRW", void_type_node, 10,
@@ -3726,6 +3728,11 @@
 	get_identifier (PREFIX("caf_co_sum")), "W.WW",
 	void_type_node, 5, pvoid_type_node, integer_type_node,
 	pint_type, pchar_type_node, integer_type_node);
+
+      gfor_fndecl_caf_is_present = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("caf_is_present")), "RRR",
+	integer_type_node, 3, pvoid_type_node, integer_type_node,
+	pvoid_type_node);
     }
 
   gfc_build_intrinsic_function_decls ();
@@ -4447,12 +4454,15 @@
 		    tmp = gfc_deallocate_with_status (descriptor, NULL_TREE,
 						      NULL_TREE, NULL_TREE,
 						      NULL_TREE, true, NULL,
-						      true);
+						      GFC_CAF_COARRAY_ANALYZE);
 		  else
 		    {
 		      gfc_expr *expr = gfc_lval_expr_from_sym (sym);
-		      tmp = gfc_deallocate_scalar_with_status (se.expr, NULL_TREE,
-						   true, expr, sym->ts);
+		      tmp = gfc_deallocate_scalar_with_status (se.expr,
+							       NULL_TREE,
+							       NULL_TREE,
+							       true, expr,
+							       sym->ts);
 		      gfc_free_expr (expr);
 		    }
 		}
@@ -5093,8 +5103,8 @@
 			     build_int_cst (integer_type_node, reg_type),
 			     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));
+			     null_pointer_node, /* errgmsg.  */
+			     integer_zero_node); /* errmsg_len.  */
   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)));
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(Revision 243020)
+++ gcc/fortran/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,85 @@
+2016-11-30  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	* check.c (gfc_check_allocated): By pass the caf_get call and check on
+	the array.
+	* gfortran.h: Add optional flag to gfc_caf_attr.
+	* gfortran.texi: Document new enum values and _caf_is_present function.
+	* primary.c (caf_variable_attr): Add optional flag to indicate that the
+	expression is reffing a component.
+	(gfc_caf_attr): Likewise.
+	* trans-array.c (gfc_array_deallocate): Handle deallocation mode for
+	coarray deregistration.
+	(gfc_trans_dealloc_allocated): Likewise.
+	(duplicate_allocatable): Use constants instead of
+        creating custom constant tree node of zero or one.  Use gfc_add_modify
+        convenience function.
+	(duplicate_allocatable_coarray): This function is similar to
+	duplicate_allocatable but tailored to handle coarrays.
+	(caf_enabled): Check whether in-derived-type coarray processing is
+	enabled.
+	(caf_in_coarray): Check that in-derived-type coarray processing is
+	enabled and currently in a derived-typed coarray.
+	(gfc_caf_is_dealloc_only): Return true, when deallocate only is
+	desired for components in derived typed coarrays.
+	(structure_alloc_comps): A mode for handling coarrays, that is no
+	longer encode in the purpose.  This makes the use cases of the
+	routine more flexible without repeating.  Allocatable components in
+	derived type coarrays are now registered only when nullifying an
+	object and allocated before copying data into them.
+	(gfc_nullify_alloc_comp): Use the caf_mode of structure_alloc_comps
+	now.
+	(gfc_deallocate_alloc_comp): Likewise.
+	(gfc_deallocate_alloc_comp_no_caf): Likewise.
+	(gfc_reassign_alloc_comp_caf): Likewise.
+	(gfc_copy_alloc_comp): Likewise.
+	(gfc_copy_only_alloc_comp): Likewise.
+	(gfc_alloc_allocatable_for_assignment): Make use to the cheaper way of
+	reallocating a coarray without deregistering and reregistering it.
+	(gfc_trans_deferred_array): Initialize the coarray token correctly for
+	deferred variables and tear them down on exit.
+	* trans-array.h: Change some prototypes to add the coarray (de-)
+	registration modes.  Add prototype for checking if deallocate only is
+	selected for components in derived typed coarrays.
+	* trans-decl.c (gfc_build_builtin_function_decls): Generate the
+	declarations for the changed/new caf-lib routines.
+	(gfc_trans_deferred_vars): Ensure deferred variables are (de-)
+	registered correctly on procedure entry/exit.
+	(generate_coarray_sym_init): Use constants.
+	* trans-expr.c (gfc_conv_procedure_call): Propagate coarray allocation
+	modes accordingly.
+	(gfc_trans_alloc_subarray_assign): Likewise.
+	(gfc_trans_subcomponent_assign): Likewise.
+	(gfc_trans_structure_assign): Generate code to register the components
+	of a derived type coarray prior to initialization.
+	(gfc_conv_structure): Set flag that the structure is in a coarray.
+	(gfc_trans_scalar_assign): Add flag to indicate being in a coarray and
+	set the structure_alloc_comps modes correctly.
+	(gfc_trans_assignment_1): Figure being in a coarray expression.
+	* trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Adapt to new
+	structure_alloc_comps interface.
+	(conv_caf_send): Use the old API as long as possible.
+	(trans_caf_is_present): Generate code to check whether an allocatable
+	component in a derived typed coarray is allocated on a remote image.
+	(caf_this_image_ref): Return true, when only reffing this image.
+	(gfc_conv_allocated): Convert allocated queries on allocatable
+	components to the library API.
+	(conv_intrinsic_move_alloc): Adapt to new interface of
+	structure_alloc_comps.
+	* trans-openmp.c (gfc_walk_alloc_comps): Likewise.
+	(gfc_omp_clause_assign_op): Likewise.
+	(gfc_omp_clause_dtor): Likewise.
+	* trans-stmt.c (gfc_trans_deallocate): Figure which mode to use when
+	deallocating allocatable components in derived type coarras.
+	* trans.c (gfc_allocate_using_lib): Renamed to
+	gfc_allcate_using_caf_lib.
+	(gfc_allocate_allocatable): Set the registration mode/type of caf-
+	register calls adapting to all the possible allocatable objects.
+	(gfc_deallocate_with_status): Add deregistration mode for allocatable
+	components in derived type coarrays.
+	(gfc_deallocate_scalar_with_status): Likewise.
+	* trans.h (enum gfc_coarray_type): Renamed to gfc_coarray_regtype to
+	avoid collision with gfc_coarray_deregtype.
+
 2016-11-30  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/78593
Index: gcc/fortran/trans.c
===================================================================
--- gcc/fortran/trans.c	(Revision 243020)
+++ gcc/fortran/trans.c	(Arbeitskopie)
@@ -709,10 +709,10 @@
       newmem = _caf_register (size, regtype, token, &stat, errmsg, errlen);
       return newmem;
     }  */
-static void
-gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size,
-			tree token, tree status, tree errmsg, tree errlen,
-			bool lock_var, bool event_var)
+void
+gfc_allocate_using_caf_lib (stmtblock_t * block, tree pointer, tree size,
+			    tree token, tree status, tree errmsg, tree errlen,
+			    gfc_coarray_regtype alloc_type)
 {
   tree tmp, pstat;
 
@@ -735,12 +735,8 @@
   tmp = build_call_expr_loc (input_location,
 	     gfor_fndecl_caf_register, 7,
 	     fold_build2_loc (input_location,
-			      MAX_EXPR, size_type_node, size,
-			      build_int_cst (size_type_node, 1)),
-	     build_int_cst (integer_type_node,
-			    lock_var ? GFC_CAF_LOCK_ALLOC
-                            : event_var ? GFC_CAF_EVENT_ALLOC
-					: GFC_CAF_COARRAY_ALLOC),
+			      MAX_EXPR, size_type_node, size, size_one_node),
+	     build_int_cst (integer_type_node, alloc_type),
 	     token, gfc_build_addr_expr (pvoid_type_node, pointer),
 	     pstat, errmsg, errlen);
 
@@ -787,7 +783,8 @@
   tree tmp, null_mem, alloc, error;
   tree type = TREE_TYPE (mem);
   symbol_attribute caf_attr;
-  bool need_assign = false;
+  bool need_assign = false, refs_comp = false;
+  gfc_coarray_regtype caf_alloc_type = GFC_CAF_COARRAY_ALLOC;
 
   size = fold_convert (size_type_node, size);
   null_mem = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR,
@@ -800,27 +797,36 @@
   gfc_start_block (&alloc_block);
 
   if (flag_coarray == GFC_FCOARRAY_LIB)
-    caf_attr = gfc_caf_attr (expr, true);
+    caf_attr = gfc_caf_attr (expr, true, &refs_comp);
 
   if (flag_coarray == GFC_FCOARRAY_LIB
       && (corank > 0 || caf_attr.codimension))
     {
-      tree cond;
-      bool lock_var = expr->ts.type == BT_DERIVED
-		      && expr->ts.u.derived->from_intmod
-			 == INTMOD_ISO_FORTRAN_ENV
-		      && expr->ts.u.derived->intmod_sym_id
-		         == ISOFORTRAN_LOCK_TYPE;
-      bool event_var = expr->ts.type == BT_DERIVED
-		       && expr->ts.u.derived->from_intmod
-			 == INTMOD_ISO_FORTRAN_ENV
-		       && expr->ts.u.derived->intmod_sym_id
-		         == ISOFORTRAN_EVENT_TYPE;
+      tree cond, sub_caf_tree;
       gfc_se se;
+      bool compute_special_caf_types_size = false;
+
+      if (expr->ts.type == BT_DERIVED
+	  && expr->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
+	  && expr->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
+	{
+	  compute_special_caf_types_size = true;
+	  caf_alloc_type = GFC_CAF_LOCK_ALLOC;
+	}
+      else if (expr->ts.type == BT_DERIVED
+	       && expr->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
+	       && expr->ts.u.derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE)
+	{
+	  compute_special_caf_types_size = true;
+	  caf_alloc_type = GFC_CAF_EVENT_ALLOC;
+	}
+      else if (!caf_attr.coarray_comp && refs_comp)
+	/* Only allocatable components in a derived type coarray can be
+	   allocate only.  */
+	caf_alloc_type = GFC_CAF_COARRAY_ALLOC_ALLOCATE_ONLY;
+
       gfc_init_se (&se, NULL);
-
-      tree sub_caf_tree = gfc_get_ultimate_alloc_ptr_comps_caf_token (&se,
-								      expr);
+      sub_caf_tree = gfc_get_ultimate_alloc_ptr_comps_caf_token (&se, expr);
       if (sub_caf_tree == NULL_TREE)
 	sub_caf_tree = token;
 
@@ -847,12 +853,12 @@
 	 the FE only passes the pointer around and leaves the actual
 	 representation to the library. Hence, we have to convert back to the
 	 number of elements.  */
-      if (lock_var || event_var)
+      if (compute_special_caf_types_size)
 	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, tmp, size, sub_caf_tree,
-			      status, errmsg, errlen, lock_var, event_var);
+      gfc_allocate_using_caf_lib (&alloc_block, tmp, size, sub_caf_tree,
+				  status, errmsg, errlen, caf_alloc_type);
       if (need_assign)
 	gfc_add_modify (&alloc_block, mem, fold_convert (TREE_TYPE (mem),
 					   gfc_conv_descriptor_data_get (tmp)));
@@ -1265,23 +1271,40 @@
    expression being deallocated for its locus and variable name.
 
    For coarrays, "pointer" must be the array descriptor and not its
-   "data" component.  */
+   "data" component.
+
+   COARRAY_DEALLOC_MODE gives the mode unregister coarrays.  Available modes are
+   the ones of GFC_CAF_DEREGTYPE, -1 when the mode for deregistration is to be
+   analyzed and set by this routine, and -2 to indicate that a non-coarray is to
+   be deallocated.  */
 tree
 gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
 			    tree errlen, tree label_finish,
-			    bool can_fail, gfc_expr* expr, bool coarray)
+			    bool can_fail, gfc_expr* expr,
+			    int coarray_dealloc_mode)
 {
   stmtblock_t null, non_null;
   tree cond, tmp, error;
   tree status_type = NULL_TREE;
   tree caf_decl = NULL_TREE;
+  gfc_coarray_deregtype caf_dereg_type = GFC_CAF_COARRAY_DEREGISTER;
 
-  if (coarray)
+  if (coarray_dealloc_mode >= GFC_CAF_COARRAY_ANALYZE)
     {
       gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (pointer)));
       caf_decl = pointer;
       pointer = gfc_conv_descriptor_data_get (caf_decl);
       STRIP_NOPS (pointer);
+      if (coarray_dealloc_mode == GFC_CAF_COARRAY_ANALYZE)
+	{
+	  bool comp_ref;
+	  if (expr && !gfc_caf_attr (expr, false, &comp_ref).coarray_comp
+	      && comp_ref)
+	    caf_dereg_type = GFC_CAF_COARRAY_DEALLOCATE_ONLY;
+	  // else do a deregister as set by default.
+	}
+      else
+	caf_dereg_type = (enum gfc_coarray_deregtype) coarray_dealloc_mode;
     }
 
   cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, pointer,
@@ -1326,7 +1349,8 @@
   /* When POINTER is not NULL, we free it.  */
   gfc_start_block (&non_null);
   gfc_add_finalizer_call (&non_null, expr);
-  if (!coarray || flag_coarray != GFC_FCOARRAY_LIB)
+  if (coarray_dealloc_mode == GFC_CAF_COARRAY_NOCOARRAY
+      || flag_coarray != GFC_FCOARRAY_LIB)
     {
       tmp = build_call_expr_loc (input_location,
 				 builtin_decl_explicit (BUILT_IN_FREE), 1,
@@ -1392,9 +1416,12 @@
 	}
 
       token = gfc_build_addr_expr  (NULL_TREE, token);
+      gcc_assert (caf_dereg_type > GFC_CAF_COARRAY_ANALYZE);
       tmp = build_call_expr_loc (input_location,
-				 gfor_fndecl_caf_deregister, 4,
-				 token, pstat, errmsg, errlen);
+				 gfor_fndecl_caf_deregister, 5,
+				 token, build_int_cst (integer_type_node,
+						       caf_dereg_type),
+				 pstat, errmsg, errlen);
       gfc_add_expr_to_block (&non_null, tmp);
 
       /* It guarantees memory consistency within the same segment */
@@ -1431,13 +1458,19 @@
    subcomponents are being deallocated.  */
 
 tree
-gfc_deallocate_scalar_with_status (tree pointer, tree status, bool can_fail,
-				   gfc_expr* expr, gfc_typespec ts)
+gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish,
+				   bool can_fail, gfc_expr* expr,
+				   gfc_typespec ts, bool coarray)
 {
   stmtblock_t null, non_null;
   tree cond, tmp, error;
-  bool finalizable;
+  bool finalizable, comp_ref;
+  gfc_coarray_deregtype caf_dereg_type = GFC_CAF_COARRAY_DEREGISTER;
 
+  if (coarray && expr && !gfc_caf_attr (expr, false, &comp_ref).coarray_comp
+      && comp_ref)
+    caf_dereg_type = GFC_CAF_COARRAY_DEALLOCATE_ONLY;
+
   cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, pointer,
 			  build_int_cst (TREE_TYPE (pointer), 0));
 
@@ -1474,7 +1507,6 @@
       error = fold_build3_loc (input_location, COND_EXPR, void_type_node,
 			       cond2, tmp, error);
     }
-
   gfc_add_expr_to_block (&null, error);
 
   /* When POINTER is not NULL, we free it.  */
@@ -1484,31 +1516,84 @@
   finalizable = gfc_add_finalizer_call (&non_null, expr);
   if (!finalizable && ts.type == BT_DERIVED && ts.u.derived->attr.alloc_comp)
     {
-      tmp = build_fold_indirect_ref_loc (input_location, pointer);
+      if (coarray)
+	tmp = gfc_conv_descriptor_data_get (pointer);
+      else
+	tmp = build_fold_indirect_ref_loc (input_location, pointer);
       tmp = gfc_deallocate_alloc_comp (ts.u.derived, tmp, 0);
       gfc_add_expr_to_block (&non_null, tmp);
     }
 
-  tmp = build_call_expr_loc (input_location,
-			     builtin_decl_explicit (BUILT_IN_FREE), 1,
-			     fold_convert (pvoid_type_node, pointer));
-  gfc_add_expr_to_block (&non_null, tmp);
+  if (!coarray)
+    {
+      tmp = build_call_expr_loc (input_location,
+				 builtin_decl_explicit (BUILT_IN_FREE), 1,
+				 fold_convert (pvoid_type_node, pointer));
+      gfc_add_expr_to_block (&non_null, tmp);
 
-  if (status != NULL_TREE && !integer_zerop (status))
+      if (status != NULL_TREE && !integer_zerop (status))
+	{
+	  /* We set STATUS to zero if it is present.  */
+	  tree status_type = TREE_TYPE (TREE_TYPE (status));
+	  tree cond2;
+
+	  cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				   status,
+				   build_int_cst (TREE_TYPE (status), 0));
+	  tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
+				 fold_build1_loc (input_location, INDIRECT_REF,
+						  status_type, status),
+				 build_int_cst (status_type, 0));
+	  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+				 cond2, tmp, build_empty_stmt (input_location));
+	  gfc_add_expr_to_block (&non_null, tmp);
+	}
+    }
+  else
     {
-      /* We set STATUS to zero if it is present.  */
-      tree status_type = TREE_TYPE (TREE_TYPE (status));
-      tree cond2;
+      tree token;
+      tree pstat = null_pointer_node;
+      gfc_se se;
 
-      cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
-			       status, build_int_cst (TREE_TYPE (status), 0));
-      tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
-			     fold_build1_loc (input_location, INDIRECT_REF,
-					      status_type, status),
-			     build_int_cst (status_type, 0));
-      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond2,
-			     tmp, build_empty_stmt (input_location));
+      gfc_init_se (&se, NULL);
+      token = gfc_get_ultimate_alloc_ptr_comps_caf_token (&se, expr);
+      gcc_assert (token != NULL_TREE);
+
+      if (status != NULL_TREE && !integer_zerop (status))
+	{
+	  gcc_assert (TREE_TYPE (TREE_TYPE (status)) == integer_type_node);
+	  pstat = status;
+	}
+
+      tmp = build_call_expr_loc (input_location,
+				 gfor_fndecl_caf_deregister, 5,
+				 token, build_int_cst (integer_type_node,
+						       caf_dereg_type),
+				 pstat, null_pointer_node, integer_zero_node);
       gfc_add_expr_to_block (&non_null, tmp);
+
+      /* 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 (&non_null, tmp);
+
+      if (status != NULL_TREE)
+	{
+	  tree stat = build_fold_indirect_ref_loc (input_location, status);
+	  tree cond2;
+
+	  TREE_USED (label_finish) = 1;
+	  tmp = build1_v (GOTO_EXPR, label_finish);
+	  cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				   stat, build_zero_cst (TREE_TYPE (stat)));
+	  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+				 gfc_unlikely (cond2, PRED_FORTRAN_REALLOC),
+				 tmp, build_empty_stmt (input_location));
+	  gfc_add_expr_to_block (&non_null, tmp);
+	}
     }
 
   return fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
@@ -1516,7 +1601,6 @@
 			  gfc_finish_block (&non_null));
 }
 
-
 /* Reallocate MEM so it has SIZE bytes of data.  This behaves like the
    following pseudo-code:
 
Index: gcc/fortran/trans.h
===================================================================
--- gcc/fortran/trans.h	(Revision 243020)
+++ gcc/fortran/trans.h	(Arbeitskopie)
@@ -107,7 +107,7 @@
 
 /* Denotes different types of coarray.
    Please keep in sync with libgfortran/caf/libcaf.h.  */
-enum gfc_coarray_type
+enum gfc_coarray_regtype
 {
   GFC_CAF_COARRAY_STATIC,
   GFC_CAF_COARRAY_ALLOC,
@@ -115,10 +115,25 @@
   GFC_CAF_LOCK_ALLOC,
   GFC_CAF_CRITICAL,
   GFC_CAF_EVENT_STATIC,
-  GFC_CAF_EVENT_ALLOC
+  GFC_CAF_EVENT_ALLOC,
+  GFC_CAF_COARRAY_ALLOC_REGISTER_ONLY,
+  GFC_CAF_COARRAY_ALLOC_ALLOCATE_ONLY
 };
 
 
+/* Describes the action to take on _caf_deregister.  Keep in sync with
+   gcc/fortran/trans.h.  The negative values are not valid for the library and
+   are used by the drivers for building the correct call.  */
+enum gfc_coarray_deregtype {
+  /* This is no coarray, i.e. build a call to a free ().  */
+  GFC_CAF_COARRAY_NOCOARRAY = -2,
+  /* The driver is to analyze which _caf_deregister ()-call to generate.  */
+  GFC_CAF_COARRAY_ANALYZE = -1,
+  GFC_CAF_COARRAY_DEREGISTER = 0,
+  GFC_CAF_COARRAY_DEALLOCATE_ONLY
+};
+
+
 /* 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 {
@@ -140,6 +155,15 @@
   GFC_CAF_ARR_REF_OPEN_START
 };
 
+
+/* trans-array (structure_alloc_comps) caf_mode bits.  */
+enum gfc_structure_caf_mode_t {
+  GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY = 1 << 0,
+  GFC_STRUCTURE_CAF_MODE_IN_COARRAY = 1 << 1,
+  GFC_STRUCTURE_CAF_MODE_DEALLOC_ONLY = 1 << 2
+};
+
+
 /* The array-specific scalarization information.  The array members of
    this struct are indexed by actual array index, and thus can be sparse.  */
 
@@ -506,7 +530,8 @@
 void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool);
 
 /* Generate code for a scalar assignment.  */
-tree gfc_trans_scalar_assign (gfc_se *, gfc_se *, gfc_typespec, bool, bool);
+tree gfc_trans_scalar_assign (gfc_se *, gfc_se *, gfc_typespec, bool, bool,
+			      bool c = false);
 
 /* Translate COMMON blocks.  */
 void gfc_trans_common (gfc_namespace *);
@@ -681,6 +706,10 @@
 /* Build a memcpy call.  */
 tree gfc_build_memcpy_call (tree, tree, tree);
 
+/* Register memory with the coarray library.  */
+void gfc_allocate_using_caf_lib (stmtblock_t *, tree, tree, tree, tree, tree,
+				 tree, gfc_coarray_regtype);
+
 /* Allocate memory for allocatable variables, with optional status variable.  */
 void gfc_allocate_allocatable (stmtblock_t*, tree, tree, tree, tree,
 			       tree, tree, tree, gfc_expr*, int);
@@ -690,14 +719,15 @@
 
 /* Generate code to deallocate an array.  */
 tree gfc_deallocate_with_status (tree, tree, tree, tree, tree, bool,
-				 gfc_expr *, bool);
-tree gfc_deallocate_scalar_with_status (tree, tree, bool, gfc_expr*, gfc_typespec);
+				 gfc_expr *, int);
+tree gfc_deallocate_scalar_with_status (tree, tree, tree, bool, gfc_expr*,
+					gfc_typespec, bool c = false);
 
 /* Generate code to call realloc().  */
 tree gfc_call_realloc (stmtblock_t *, tree, tree);
 
 /* Assign a derived type constructor to a variable.  */
-tree gfc_trans_structure_assign (tree, gfc_expr *, bool);
+tree gfc_trans_structure_assign (tree, gfc_expr *, bool, bool c = false);
 
 /* Generate code for an assignment, includes scalarization.  */
 tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool, bool p = false,
@@ -808,8 +838,8 @@
 extern GTY(()) tree gfor_fndecl_co_min;
 extern GTY(()) tree gfor_fndecl_co_reduce;
 extern GTY(()) tree gfor_fndecl_co_sum;
+extern GTY(()) tree gfor_fndecl_caf_is_present;
 
-
 /* Math functions.  Many other math functions are handled in
    trans-intrinsic.c.  */
 
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(Revision 243020)
+++ gcc/fortran/trans-expr.c	(Arbeitskopie)
@@ -5208,7 +5208,8 @@
 			ptr = gfc_class_data_get (ptr);
 
 		      tmp = gfc_deallocate_scalar_with_status (ptr, NULL_TREE,
-							       true, e, e->ts);
+							       NULL_TREE, true,
+							       e, e->ts);
 		      gfc_add_expr_to_block (&block, tmp);
 		      tmp = fold_build2_loc (input_location, MODIFY_EXPR,
 					     void_type_node, ptr,
@@ -5317,7 +5318,7 @@
 		  tmp = gfc_deallocate_with_status (ptr, NULL_TREE,
 						    NULL_TREE, NULL_TREE,
 						    NULL_TREE, true, e,
-						    false);
+						    GFC_CAF_COARRAY_NOCOARRAY);
 		  gfc_add_expr_to_block (&block, tmp);
 		  tmp = fold_build2_loc (input_location, MODIFY_EXPR,
 					 void_type_node, ptr,
@@ -5440,7 +5441,8 @@
 		{
 		  tmp = build_fold_indirect_ref_loc (input_location,
 						     parmse.expr);
-		  tmp = gfc_trans_dealloc_allocated (tmp, false, e);
+		  tmp = gfc_trans_dealloc_allocated (tmp, e,
+						     GFC_CAF_COARRAY_NOCOARRAY);
 		  if (fsym->attr.optional
 		      && e->expr_type == EXPR_VARIABLE
 		      && e->symtree->n.sym->attr.optional)
@@ -5552,7 +5554,8 @@
 	    {
 	      tree local_tmp;
 	      local_tmp = gfc_evaluate_now (tmp, &se->pre);
-	      local_tmp = gfc_copy_alloc_comp (e->ts.u.derived, local_tmp, tmp, parm_rank);
+	      local_tmp = gfc_copy_alloc_comp (e->ts.u.derived, local_tmp, tmp,
+					       parm_rank, 0);
 	      gfc_add_expr_to_block (&se->post, local_tmp);
 	    }
 
@@ -6207,7 +6210,7 @@
 	     from being corrupted.  */
 	  tmp2 = gfc_evaluate_now (result, &se->pre);
 	  tmp = gfc_copy_alloc_comp (arg->expr->ts.u.derived,
-				     result, tmp2, expr->rank);
+				     result, tmp2, expr->rank, 0);
 	  gfc_add_expr_to_block (&se->pre, tmp);
 	  tmp = gfc_copy_allocatable_data (result, tmp2, TREE_TYPE(tmp2),
 				           expr->rank);
@@ -6217,7 +6220,7 @@
 	  tmp = gfc_conv_descriptor_data_get (tmp2);
 	  tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE,
 					    NULL_TREE, NULL_TREE, true,
-					    NULL, false);
+					    NULL, GFC_CAF_COARRAY_NOCOARRAY);
 	  gfc_add_expr_to_block (&se->pre, tmp);
 	}
     }
@@ -6932,16 +6935,18 @@
   /* Deal with arrays of derived types with allocatable components.  */
   if (gfc_bt_struct (cm->ts.type)
 	&& cm->ts.u.derived->attr.alloc_comp)
+    // TODO: Fix caf_mode
     tmp = gfc_copy_alloc_comp (cm->ts.u.derived,
 			       se.expr, dest,
-			       cm->as->rank);
+			       cm->as->rank, 0);
   else if (cm->ts.type == BT_CLASS && expr->ts.type == BT_DERIVED
 	   && CLASS_DATA(cm)->attr.allocatable)
     {
       if (cm->ts.u.derived->attr.alloc_comp)
+	// TODO: Fix caf_mode
 	tmp = gfc_copy_alloc_comp (expr->ts.u.derived,
 				   se.expr, dest,
-				   expr->rank);
+				   expr->rank, 0);
       else
 	{
 	  tmp = TREE_TYPE (dest);
@@ -7367,8 +7372,9 @@
 	  if (cm->ts.u.derived->attr.alloc_comp
 	      && expr->expr_type != EXPR_NULL)
 	    {
+	      // TODO: Fix caf_mode
 	      tmp = gfc_copy_alloc_comp (cm->ts.u.derived, se.expr,
-					 dest, expr->rank);
+					 dest, expr->rank, 0);
 	      gfc_add_expr_to_block (&block, tmp);
 	      if (dealloc != NULL_TREE)
 		gfc_add_expr_to_block (&block, dealloc);
@@ -7434,7 +7440,7 @@
 /* Assign a derived type constructor to a variable.  */
 
 tree
-gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init)
+gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init, bool coarray)
 {
   gfc_constructor *c;
   gfc_component *cm;
@@ -7441,6 +7447,7 @@
   stmtblock_t block;
   tree field;
   tree tmp;
+  gfc_se se;
 
   gfc_start_block (&block);
   cm = expr->ts.u.derived->components;
@@ -7449,7 +7456,7 @@
       && (expr->ts.u.derived->intmod_sym_id == ISOCBINDING_PTR
           || expr->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR))
     {
-      gfc_se se, lse;
+      gfc_se lse;
 
       gfc_init_se (&se, NULL);
       gfc_init_se (&lse, NULL);
@@ -7461,6 +7468,9 @@
       return gfc_finish_block (&block);
     }
 
+  if (coarray)
+    gfc_init_se (&se, NULL);
+
   for (c = gfc_constructor_first (expr->value.constructor);
        c; c = gfc_constructor_next (c), cm = cm->next)
     {
@@ -7468,6 +7478,62 @@
       if (!c->expr && !cm->attr.allocatable)
 	continue;
 
+      /* Register the component with the caf-lib before it is initialized.
+	 Register only allocatable components, that are not coarray'ed
+	 components (%comp[*]).  Only register when the constructor is not the
+	 null-expression.  */
+      if (coarray && !cm->attr.codimension && cm->attr.allocatable
+	  && (!c->expr || c->expr->expr_type == EXPR_NULL))
+	{
+	  tree token, desc, size;
+	  symbol_attribute attr;
+	  bool is_array = cm->ts.type == BT_CLASS
+	      ? CLASS_DATA (cm)->attr.dimension : cm->attr.dimension;
+
+	  field = cm->backend_decl;
+	  field = fold_build3_loc (input_location, COMPONENT_REF,
+				   TREE_TYPE (field), dest, field, NULL_TREE);
+	  if (cm->ts.type == BT_CLASS)
+	    field = gfc_class_data_get (field);
+
+	  token = is_array ? gfc_conv_descriptor_token (field)
+			   : fold_build3_loc (input_location, COMPONENT_REF,
+					      TREE_TYPE (cm->caf_token), dest,
+					      cm->caf_token, NULL_TREE);
+
+	  if (is_array)
+	    {
+	      /* The _caf_register routine looks at the rank of the array
+		 descriptor to decide whether the data registered is an array
+		 or not.  */
+	      int rank = cm->ts.type == BT_CLASS ? CLASS_DATA (cm)->as->rank
+						 : cm->as->rank;
+	      /* When the rank is not known just set a positive rank, which
+		 suffices to recognize the data as array.  */
+	      if (rank < 0)
+		rank = 1;
+	      size = integer_zero_node;
+	      desc = field;
+	      gfc_add_modify (&block, gfc_conv_descriptor_dtype (desc),
+			      build_int_cst (gfc_array_index_type, rank));
+	    }
+	  else
+	    {
+	      desc = gfc_conv_scalar_to_descriptor (&se, field, attr);
+	      size = TYPE_SIZE_UNIT (TREE_TYPE (field));
+	    }
+	  gfc_add_block_to_block (&block, &se.pre);
+	  tmp =  build_call_expr_loc (input_location, gfor_fndecl_caf_register,
+				      7, size, build_int_cst (
+					integer_type_node,
+					GFC_CAF_COARRAY_ALLOC_REGISTER_ONLY),
+				      gfc_build_addr_expr (pvoid_type_node,
+							   token),
+				      gfc_build_addr_expr (NULL_TREE, desc),
+				      null_pointer_node, null_pointer_node,
+				      integer_zero_node);
+	  gfc_add_expr_to_block (&block, tmp);
+	}
       field = cm->backend_decl;
       tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
 			     dest, field, NULL_TREE);
@@ -7546,7 +7612,8 @@
       se->expr = gfc_create_var (type, expr->ts.u.derived->name);
       /* The symtree in expr is NULL, if the code to generate is for
 	 initializing the static members only.  */
-      tmp = gfc_trans_structure_assign (se->expr, expr, expr->symtree != NULL);
+      tmp = gfc_trans_structure_assign (se->expr, expr, expr->symtree != NULL,
+					se->want_coarray);
       gfc_add_expr_to_block (&se->pre, tmp);
       return;
     }
@@ -8540,7 +8607,7 @@
 
 tree
 gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
-			 bool deep_copy, bool dealloc)
+			 bool deep_copy, bool dealloc, bool in_coarray)
 {
   stmtblock_t block;
   tree tmp;
@@ -8617,7 +8684,10 @@
 	 same as the lhs.  */
       if (deep_copy)
 	{
-	  tmp = gfc_copy_alloc_comp (ts.u.derived, rse->expr, lse->expr, 0);
+	  int caf_mode = in_coarray ? (GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY
+				       | GFC_STRUCTURE_CAF_MODE_IN_COARRAY) : 0;
+	  tmp = gfc_copy_alloc_comp (ts.u.derived, rse->expr, lse->expr, 0,
+				     caf_mode);
 	  tmp = build3_v (COND_EXPR, cond, build_empty_stmt (input_location),
 			  tmp);
 	  gfc_add_expr_to_block (&block, tmp);
@@ -9746,6 +9816,8 @@
   l_is_temp = (lss != gfc_ss_terminator && loop.temp_ss != NULL);
 
   /* Translate the expression.  */
+  rse.want_coarray = flag_coarray == GFC_FCOARRAY_LIB && init_flag
+      && lhs_caf_attr.codimension;
   gfc_conv_expr (&rse, expr2);
 
   /* Deal with the case of a scalar class function assigned to a derived type.  */
@@ -9882,7 +9954,8 @@
 				   gfc_expr_is_variable (expr2)
 				   || scalar_to_array
 				   || expr2->expr_type == EXPR_ARRAY,
-				   !(l_is_temp || init_flag) && dealloc);
+				   !(l_is_temp || init_flag) && dealloc,
+				   expr1->symtree->n.sym->attr.codimension);
   /* Add the pre blocks to the body.  */
   gfc_add_block_to_block (&body, &rse.pre);
   gfc_add_block_to_block (&body, &lse.pre);
