diff mbox

[Fortran] More coarray fixes

Message ID 53A7C9C9.6030009@net-b.de
State New
Headers show

Commit Message

Tobias Burnus June 23, 2014, 6:31 a.m. UTC 
The test case of this patch requires the trans*.c changes of 
https://gcc.gnu.org/ml/gcc-patches/2014-06/msg01662.html

At least for "coarray(:)[i] = coarray2(:)[j]" the library must handle 
string padding/trimming (previously implemented) and numeric-type and 
character-kind conversion. And instead of generating a temporary array 
for those in the compiler for the assignment case, I now also push the 
type conversion task always to the library.

The attached patch case implements the character-kind conversion and the 
numeric type conversion, it adds an extensive test case for the 
character handling. On the compiler side:
- resolve.c: We avoid a temporary for "var = caf[i]" and transform it 
into "caf_send(var, caf[i])"; however, this patch avoids this for "array 
= scalar_caf[i]" – leaving it to the normal code path (temporary + 
scalarizer)
- trans-intrinsic.c: If we assign a scalar (caf_send), there is no 
reason not to do the numeric type conversion in the compiler. Thus, this 
patch now does so. (Well, only if the RHS is neither a string nor coindexed)

Build and regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias

PS: The follow up patch(es) will add a test case for numeric type 
conversion and handle (and test) vector subscripts in the library. 
Afterward, I want to look into some issues with polymorphic coarrays; 
some are pre-existing, but I have the feeling the trunk port might have 
regressed compared with the fortran-caf version in some corner cases.
diff mbox

Patch

2014-06-19  Tobias Burnus  <burnus@net-b.de>

fortran/
	* resolve.c (resolve_ordinary_assign): Don't invoke caf_send
	when assigning a coindexed RHS scalar to a noncoindexed LHS
	array.
	* trans-intrinsic.c (conv_caf_send): Do numeric type conversion
	for a noncoindexed scalar RHS.

gcc/testsuite/
	* gfortran.dg/coarray/coindexed_1.f90: New.

libgfortran/
	* caf/single.c (assign_char4_from_char1, assign_char1_from_char4,
	convert_type): New static functions.
	(_gfortran_caf_get, _gfortran_caf_send): Use them.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 64f3489..d1e2abb 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9301,12 +9301,15 @@  resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
   /* Insert a GFC_ISYM_CAF_SEND intrinsic, when the LHS is a coindexed variable.
      Additionally, insert this code when the RHS is a CAF as we then use the
      GFC_ISYM_CAF_SEND intrinsic just to avoid a temporary; but do not do so if
-     the LHS is (re)allocatable or has a vector subscript.  */
+     the LHS is (re)allocatable or has a vector subscript.  If the LHS is a
+     noncoindexed array and the RHS is a coindexed scalar, use the normal code
+     path.  */
   if (gfc_option.coarray == GFC_FCOARRAY_LIB
       && (lhs_coindexed
 	  || (code->expr2->expr_type == EXPR_FUNCTION
 	      && code->expr2->value.function.isym
 	      && code->expr2->value.function.isym->id == GFC_ISYM_CAF_GET
+	      && (code->expr1->rank == 0 || code->expr2->rank != 0)
 	      && !gfc_expr_attr (rhs).allocatable
               && !gfc_has_vector_subscript (rhs))))
     {
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 548fd9f..a1dfdfb 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1348,6 +1349,7 @@  conv_caf_send (gfc_code *code) {
   gfc_se lhs_se, rhs_se;
   stmtblock_t block;
   tree caf_decl, token, offset, image_index, tmp, lhs_kind, rhs_kind;
+  tree lhs_type = NULL_TREE;
   tree vec = null_pointer_node, rhs_vec = null_pointer_node;
 
   gcc_assert (gfc_option.coarray == GFC_FCOARRAY_LIB);
@@ -1363,6 +1365,7 @@  conv_caf_send (gfc_code *code) {
       symbol_attribute attr;
       gfc_clear_attr (&attr);
       gfc_conv_expr (&lhs_se, lhs_expr);
+      lhs_type = TREE_TYPE (lhs_se.expr);
       lhs_se.expr = gfc_conv_scalar_to_descriptor (&lhs_se, lhs_se.expr, attr);
       lhs_se.expr = gfc_build_addr_expr (NULL_TREE, lhs_se.expr);
     }
@@ -1384,6 +1387,7 @@  conv_caf_send (gfc_code *code) {
 	}
       lhs_se.want_pointer = 1;
       gfc_conv_expr_descriptor (&lhs_se, lhs_expr);
+      lhs_type = gfc_get_element_type (TREE_TYPE (TREE_TYPE (lhs_se.expr)));
       if (has_vector)
 	{
 	  vec = conv_caf_vector_subscript (&block, lhs_se.expr, ar);
@@ -1417,11 +1421,16 @@  conv_caf_send (gfc_code *code) {
 
   /* RHS.  */
   gfc_init_se (&rhs_se, NULL);
+  if (rhs_expr->expr_type == EXPR_FUNCTION && rhs_expr->value.function.isym
+      && rhs_expr->value.function.isym->id == GFC_ISYM_CONVERSION)
+    rhs_expr = rhs_expr->value.function.actual->expr;
   if (rhs_expr->rank == 0)
     {
       symbol_attribute attr;
       gfc_clear_attr (&attr);
       gfc_conv_expr (&rhs_se, rhs_expr);
+      if (!gfc_is_coindexed (rhs_expr) && rhs_expr->ts.type != BT_CHARACTER)
+	 rhs_se.expr = fold_convert (lhs_type , rhs_se.expr);
       rhs_se.expr = gfc_conv_scalar_to_descriptor (&rhs_se, rhs_se.expr, attr);
       rhs_se.expr = gfc_build_addr_expr (NULL_TREE, rhs_se.expr);
     }
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_1.f90 b/gcc/testsuite/gfortran.dg/coarray/coindexed_1.f90
new file mode 100644
index 0000000..86f86d1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_1.f90
@@ -0,0 +1,1459 @@ 
+! { dg-do run }
+!
+!
+program test
+  implicit none
+  call char_test()
+contains
+subroutine char_test()
+  character(len=3, kind=1), save :: str1a[*], str1b(5)[*]
+  character(len=7, kind=1), save :: str2a[*], str2b(5)[*]
+  character(len=3, kind=4), save :: ustr1a[*], ustr1b(5)[*]
+  character(len=7, kind=4), save :: ustr2a[*], ustr2b(5)[*]
+
+  ! ---------- Assign to coindexed variable -------------
+
+  ! - - - - - scalar = scalar
+
+  ! SCALAR - kind 1 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str1a = 1_"abc"
+  str2a = 1_"XXXXXXX"
+  if (this_image() == num_images()) then
+    str2a[1] = str1a
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str2a /= 1_"abc    ") call abort()
+  else
+    if (str2a /= 1_"XXXXXXX") call abort()
+  end if
+
+  ! SCALAR - kind 4 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr1a = 4_"abc"
+  ustr2a = 4_"XXXXXXX"
+  if (this_image() == num_images()) then
+    ustr2a[1] = ustr1a
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr2a /= 4_"abc    ") call abort()
+  else
+    if (ustr2a /= 4_"XXXXXXX") call abort()
+  end if
+
+  ! SCALAR - kind 1 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str2a = 1_"abcde"
+  str1a = 1_"XXX"
+  if (this_image() == num_images()) then
+    str1a[1] = str2a
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str1a /= 1_"abc") call abort()
+  else
+    if (str1a /= 1_"XXX") call abort()
+  end if
+
+  ! SCALAR - kind 4 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr2a = 4_"abcde"
+  ustr1a = 4_"XXX"
+  if (this_image() == num_images()) then
+    ustr1a[1] = ustr2a
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr1a /= 4_"abc") call abort()
+  else
+    if (ustr1a /= 4_"XXX") call abort()
+  end if
+
+  ! - - - - - array = array
+
+  ! contiguous ARRAY - kind 1 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str1b(1) = 1_"abc"
+  str1b(2) = 1_"def"
+  str1b(3) = 1_"gjh"
+  str2b(1) = 1_"XXXXXXX"
+  str2b(2) = 1_"YYYYYYY"
+  str2b(3) = 1_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    str2b(:)[1] = str1b
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str2b(1) /= 1_"abc    " .or. str2b(2) /= 1_"def    " &
+        .or. str2b(3) /= 1_"gjh    ") call abort()
+  else
+    if (str2b(1) /= 1_"XXXXXXX" .or. str2b(2) /= 1_"YYYYYYY" &
+        .or. str2b(3) /= 1_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr1b(1) = 4_"abc"
+  ustr1b(2) = 4_"def"
+  ustr1b(3) = 4_"gjh"
+  ustr2b(1) = 4_"XXXXXXX"
+  ustr2b(2) = 4_"YYYYYYY"
+  ustr2b(3) = 4_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    ustr2b(:)[1] = ustr1b
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr2b(1) /= 4_"abc    " .or. ustr2b(2) /= 4_"def    " &
+        .or. ustr2b(3) /= 4_"gjh    ") call abort()
+  else
+    if (ustr2b(1) /= 4_"XXXXXXX" .or. ustr2b(2) /= 4_"YYYYYYY" &
+        .or. ustr2b(3) /= 4_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 1 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str2b(1) = 1_"abcdefg"
+  str2b(2) = 1_"hijklmn"
+  str2b(3) = 1_"opqrstu"
+  str1b(1) = 1_"XXX"
+  str1b(2) = 1_"YYY"
+  str1b(3) = 1_"ZZZ"
+  if (this_image() == num_images()) then
+    str1b(:)[1] = str2b
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str1b(1) /= 1_"abc" .or. str1b(2) /= 1_"hij" &
+        .or. str1b(3) /= 1_"opq") call abort()
+  else
+    if (str1b(1) /= 1_"XXX" .or. str1b(2) /= 1_"YYY" &
+        .or. str1b(3) /= 1_"ZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr2b(1) = 4_"abcdefg"
+  ustr2b(2) = 4_"hijklmn"
+  ustr2b(3) = 4_"opqrstu"
+  ustr1b(1) = 4_"XXX"
+  ustr1b(2) = 4_"YYY"
+  ustr1b(3) = 4_"ZZZ"
+  if (this_image() == num_images()) then
+    ustr1b(:)[1] = ustr2b
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr1b(1) /= 4_"abc" .or. ustr1b(2) /= 4_"hij" &
+        .or. ustr1b(3) /= 4_"opq") call abort()
+  else
+    if (ustr1b(1) /= 4_"XXX" .or. ustr1b(2) /= 4_"YYY" &
+        .or. ustr1b(3) /= 4_"ZZZ") call abort()
+  end if
+
+  ! - - - - - array = scalar
+
+  ! contiguous ARRAY - kind 1 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str1a = 1_"abc"
+  str2b(1) = 1_"XXXXXXX"
+  str2b(2) = 1_"YYYYYYY"
+  str2b(3) = 1_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    str2b(:)[1] = str1a
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str2b(1) /= 1_"abc    " .or. str2b(2) /= 1_"abc    " &
+        .or. str2b(3) /= 1_"abc    ") call abort()
+  else
+    if (str2b(1) /= 1_"XXXXXXX" .or. str2b(2) /= 1_"YYYYYYY" &
+        .or. str2b(3) /= 1_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr1a = 4_"abc"
+  ustr2b(1) = 4_"XXXXXXX"
+  ustr2b(2) = 4_"YYYYYYY"
+  ustr2b(3) = 4_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    ustr2b(:)[1] = ustr1a
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr2b(1) /= 4_"abc    " .or. ustr2b(2) /= 4_"abc    " &
+        .or. ustr2b(3) /= 4_"abc    ") call abort()
+  else
+    if (ustr2b(1) /= 4_"XXXXXXX" .or. ustr2b(2) /= 4_"YYYYYYY" &
+        .or. ustr2b(3) /= 4_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 1 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str2a = 1_"abcdefg"
+  str1b(1) = 1_"XXX"
+  str1b(2) = 1_"YYY"
+  str1b(3) = 1_"ZZZ"
+  if (this_image() == num_images()) then
+    str1b(:)[1] = str2a
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str1b(1) /= 1_"abc" .or. str1b(2) /= 1_"abc" &
+        .or. str1b(3) /= 1_"abc") call abort()
+  else
+    if (str1b(1) /= 1_"XXX" .or. str1b(2) /= 1_"YYY" &
+        .or. str1b(3) /= 1_"ZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr2a = 4_"abcdefg"
+  ustr1b(1) = 4_"XXX"
+  ustr1b(2) = 4_"YYY"
+  ustr1b(3) = 4_"ZZZ"
+  if (this_image() == num_images()) then
+    ustr1b(:)[1] = ustr2a
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr1b(1) /= 4_"abc" .or. ustr1b(2) /= 4_"abc" &
+        .or. ustr1b(3) /= 4_"abc") call abort()
+  else
+    if (ustr1b(1) /= 4_"XXX" .or. ustr1b(2) /= 4_"YYY" &
+        .or. ustr1b(3) /= 4_"ZZZ") call abort()
+  end if
+
+  ! ---------- Take from a coindexed variable -------------
+
+  ! - - - - - scalar = scalar
+
+  ! SCALAR - kind 1 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str1a = 1_"abc"
+  str2a = 1_"XXXXXXX"
+  if (this_image() == num_images()) then
+    str2a = str1a[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (str2a /= 1_"abc    ") call abort()
+  else
+    if (str2a /= 1_"XXXXXXX") call abort()
+  end if
+
+  ! SCALAR - kind 4 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr1a = 4_"abc"
+  ustr2a = 4_"XXXXXXX"
+  if (this_image() == num_images()) then
+    ustr2a = ustr1a[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (ustr2a /= 4_"abc    ") call abort()
+  else
+    if (ustr2a /= 4_"XXXXXXX") call abort()
+  end if
+
+  ! SCALAR - kind 1 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str2a = 1_"abcde"
+  str1a = 1_"XXX"
+  if (this_image() == num_images()) then
+    str1a = str2a[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (str1a /= 1_"abc") call abort()
+  else
+    if (str1a /= 1_"XXX") call abort()
+  end if
+
+  ! SCALAR - kind 4 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr2a = 4_"abcde"
+  ustr1a = 4_"XXX"
+  if (this_image() == num_images()) then
+    ustr1a = ustr2a[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (ustr1a /= 4_"abc") call abort()
+  else
+    if (ustr1a /= 4_"XXX") call abort()
+  end if
+
+  ! - - - - - array = array
+
+  ! contiguous ARRAY - kind 1 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str1b(1) = 1_"abc"
+  str1b(2) = 1_"def"
+  str1b(3) = 1_"gjh"
+  str2b(1) = 1_"XXXXXXX"
+  str2b(2) = 1_"YYYYYYY"
+  str2b(3) = 1_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    str2b = str1b(:)[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (str2b(1) /= 1_"abc    " .or. str2b(2) /= 1_"def    " &
+        .or. str2b(3) /= 1_"gjh    ") call abort()
+  else
+    if (str2b(1) /= 1_"XXXXXXX" .or. str2b(2) /= 1_"YYYYYYY" &
+        .or. str2b(3) /= 1_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr1b(1) = 4_"abc"
+  ustr1b(2) = 4_"def"
+  ustr1b(3) = 4_"gjh"
+  ustr2b(1) = 4_"XXXXXXX"
+  ustr2b(2) = 4_"YYYYYYY"
+  ustr2b(3) = 4_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    ustr2b = ustr1b(:)[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (ustr2b(1) /= 4_"abc    " .or. ustr2b(2) /= 4_"def    " &
+        .or. ustr2b(3) /= 4_"gjh    ") call abort()
+  else
+    if (ustr2b(1) /= 4_"XXXXXXX" .or. ustr2b(2) /= 4_"YYYYYYY" &
+        .or. ustr2b(3) /= 4_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 1 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str2b(1) = 1_"abcdefg"
+  str2b(2) = 1_"hijklmn"
+  str2b(3) = 1_"opqrstu"
+  str1b(1) = 1_"XXX"
+  str1b(2) = 1_"YYY"
+  str1b(3) = 1_"ZZZ"
+  if (this_image() == num_images()) then
+    str1b = str2b(:)[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (str1b(1) /= 1_"abc" .or. str1b(2) /= 1_"hij" &
+        .or. str1b(3) /= 1_"opq") call abort()
+  else
+    if (str1b(1) /= 1_"XXX" .or. str1b(2) /= 1_"YYY" &
+        .or. str1b(3) /= 1_"ZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr2b(1) = 4_"abcdefg"
+  ustr2b(2) = 4_"hijklmn"
+  ustr2b(3) = 4_"opqrstu"
+  ustr1b(1) = 4_"XXX"
+  ustr1b(2) = 4_"YYY"
+  ustr1b(3) = 4_"ZZZ"
+  if (this_image() == num_images()) then
+    ustr1b = ustr2b(:)[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (ustr1b(1) /= 4_"abc" .or. ustr1b(2) /= 4_"hij" &
+        .or. ustr1b(3) /= 4_"opq") call abort()
+  else
+    if (ustr1b(1) /= 4_"XXX" .or. ustr1b(2) /= 4_"YYY" &
+        .or. ustr1b(3) /= 4_"ZZZ") call abort()
+  end if
+
+  ! - - - - - array = scalar
+
+  ! contiguous ARRAY - kind 1 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str1a = 1_"abc"
+  str2b(1) = 1_"XXXXXXX"
+  str2b(2) = 1_"YYYYYYY"
+  str2b(3) = 1_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    str2b = str1a[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (str2b(1) /= 1_"abc    " .or. str2b(2) /= 1_"abc    " &
+        .or. str2b(3) /= 1_"abc    ") call abort()
+  else
+    if (str2b(1) /= 1_"XXXXXXX" .or. str2b(2) /= 1_"YYYYYYY" &
+        .or. str2b(3) /= 1_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr1a = 4_"abc"
+  ustr2b(1) = 4_"XXXXXXX"
+  ustr2b(2) = 4_"YYYYYYY"
+  ustr2b(3) = 4_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    ustr2b = ustr1a[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (ustr2b(1) /= 4_"abc    " .or. ustr2b(2) /= 4_"abc    " &
+        .or. ustr2b(3) /= 4_"abc    ") call abort()
+  else
+    if (ustr2b(1) /= 4_"XXXXXXX" .or. ustr2b(2) /= 4_"YYYYYYY" &
+        .or. ustr2b(3) /= 4_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 1 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str2a = 1_"abcdefg"
+  str1b(1) = 1_"XXX"
+  str1b(2) = 1_"YYY"
+  str1b(3) = 1_"ZZZ"
+  if (this_image() == num_images()) then
+    str1b = str2a[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (str1b(1) /= 1_"abc" .or. str1b(2) /= 1_"abc" &
+        .or. str1b(3) /= 1_"abc") call abort()
+  else
+    if (str1b(1) /= 1_"XXX" .or. str1b(2) /= 1_"YYY" &
+        .or. str1b(3) /= 1_"ZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr2a = 4_"abcdefg"
+  ustr1b(1) = 4_"XXX"
+  ustr1b(2) = 4_"YYY"
+  ustr1b(3) = 4_"ZZZ"
+  if (this_image() == num_images()) then
+    ustr1b = ustr2a[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (ustr1b(1) /= 4_"abc" .or. ustr1b(2) /= 4_"abc" &
+        .or. ustr1b(3) /= 4_"abc") call abort()
+  else
+    if (ustr1b(1) /= 4_"XXX" .or. ustr1b(2) /= 4_"YYY" &
+        .or. ustr1b(3) /= 4_"ZZZ") call abort()
+  end if
+
+
+  ! ---------- coindexed to coindexed variable -------------
+
+  ! - - - - - scalar = scalar
+
+  ! SCALAR - kind 1 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str1a = 1_"abc"
+  str2a = 1_"XXXXXXX"
+  if (this_image() == num_images()) then
+    str2a[1] = str1a[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str2a /= 1_"abc    ") call abort()
+  else
+    if (str2a /= 1_"XXXXXXX") call abort()
+  end if
+
+  ! SCALAR - kind 4 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr1a = 4_"abc"
+  ustr2a = 4_"XXXXXXX"
+  if (this_image() == num_images()) then
+    ustr2a[1] = ustr1a[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr2a /= 4_"abc    ") call abort()
+  else
+    if (ustr2a /= 4_"XXXXXXX") call abort()
+  end if
+
+  ! SCALAR - kind 1 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str2a = 1_"abcde"
+  str1a = 1_"XXX"
+  if (this_image() == num_images()) then
+    str1a[1] = str2a[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str1a /= 1_"abc") call abort()
+  else
+    if (str1a /= 1_"XXX") call abort()
+  end if
+
+  ! SCALAR - kind 4 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr2a = 4_"abcde"
+  ustr1a = 4_"XXX"
+  if (this_image() == num_images()) then
+    ustr1a[1] = ustr2a[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr1a /= 4_"abc") call abort()
+  else
+    if (ustr1a /= 4_"XXX") call abort()
+  end if
+
+  ! - - - - - array = array
+
+  ! contiguous ARRAY - kind 1 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str1b(1) = 1_"abc"
+  str1b(2) = 1_"def"
+  str1b(3) = 1_"gjh"
+  str2b(1) = 1_"XXXXXXX"
+  str2b(2) = 1_"YYYYYYY"
+  str2b(3) = 1_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    str2b(:)[1] = str1b(:)[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str2b(1) /= 1_"abc    " .or. str2b(2) /= 1_"def    " &
+        .or. str2b(3) /= 1_"gjh    ") call abort()
+  else
+    if (str2b(1) /= 1_"XXXXXXX" .or. str2b(2) /= 1_"YYYYYYY" &
+        .or. str2b(3) /= 1_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr1b(1) = 4_"abc"
+  ustr1b(2) = 4_"def"
+  ustr1b(3) = 4_"gjh"
+  ustr2b(1) = 4_"XXXXXXX"
+  ustr2b(2) = 4_"YYYYYYY"
+  ustr2b(3) = 4_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    ustr2b(:)[1] = ustr1b(:)[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr2b(1) /= 4_"abc    " .or. ustr2b(2) /= 4_"def    " &
+        .or. ustr2b(3) /= 4_"gjh    ") call abort()
+  else
+    if (ustr2b(1) /= 4_"XXXXXXX" .or. ustr2b(2) /= 4_"YYYYYYY" &
+        .or. ustr2b(3) /= 4_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 1 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str2b(1) = 1_"abcdefg"
+  str2b(2) = 1_"hijklmn"
+  str2b(3) = 1_"opqrstu"
+  str1b(1) = 1_"XXX"
+  str1b(2) = 1_"YYY"
+  str1b(3) = 1_"ZZZ"
+  if (this_image() == num_images()) then
+    str1b(:)[1] = str2b(:)[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str1b(1) /= 1_"abc" .or. str1b(2) /= 1_"hij" &
+        .or. str1b(3) /= 1_"opq") call abort()
+  else
+    if (str1b(1) /= 1_"XXX" .or. str1b(2) /= 1_"YYY" &
+        .or. str1b(3) /= 1_"ZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr2b(1) = 4_"abcdefg"
+  ustr2b(2) = 4_"hijklmn"
+  ustr2b(3) = 4_"opqrstu"
+  ustr1b(1) = 4_"XXX"
+  ustr1b(2) = 4_"YYY"
+  ustr1b(3) = 4_"ZZZ"
+  if (this_image() == num_images()) then
+    ustr1b(:)[1] = ustr2b(:)[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr1b(1) /= 4_"abc" .or. ustr1b(2) /= 4_"hij" &
+        .or. ustr1b(3) /= 4_"opq") call abort()
+  else
+    if (ustr1b(1) /= 4_"XXX" .or. ustr1b(2) /= 4_"YYY" &
+        .or. ustr1b(3) /= 4_"ZZZ") call abort()
+  end if
+
+  ! - - - - - array = scalar
+
+  ! contiguous ARRAY - kind 1 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str1a = 1_"abc"
+  str2b(1) = 1_"XXXXXXX"
+  str2b(2) = 1_"YYYYYYY"
+  str2b(3) = 1_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    str2b(:)[1] = str1a[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str2b(1) /= 1_"abc    " .or. str2b(2) /= 1_"abc    " &
+        .or. str2b(3) /= 1_"abc    ") call abort()
+  else
+    if (str2b(1) /= 1_"XXXXXXX" .or. str2b(2) /= 1_"YYYYYYY" &
+        .or. str2b(3) /= 1_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr1a = 4_"abc"
+  ustr2b(1) = 4_"XXXXXXX"
+  ustr2b(2) = 4_"YYYYYYY"
+  ustr2b(3) = 4_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    ustr2b(:)[1] = ustr1a[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr2b(1) /= 4_"abc    " .or. ustr2b(2) /= 4_"abc    " &
+        .or. ustr2b(3) /= 4_"abc    ") call abort()
+  else
+    if (ustr2b(1) /= 4_"XXXXXXX" .or. ustr2b(2) /= 4_"YYYYYYY" &
+        .or. ustr2b(3) /= 4_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 1 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str2a = 1_"abcdefg"
+  str1b(1) = 1_"XXX"
+  str1b(2) = 1_"YYY"
+  str1b(3) = 1_"ZZZ"
+  if (this_image() == num_images()) then
+    str1b(:)[1] = str2a[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str1b(1) /= 1_"abc" .or. str1b(2) /= 1_"abc" &
+        .or. str1b(3) /= 1_"abc") call abort()
+  else
+    if (str1b(1) /= 1_"XXX" .or. str1b(2) /= 1_"YYY" &
+        .or. str1b(3) /= 1_"ZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr2a = 4_"abcdefg"
+  ustr1b(1) = 4_"XXX"
+  ustr1b(2) = 4_"YYY"
+  ustr1b(3) = 4_"ZZZ"
+  if (this_image() == num_images()) then
+    ustr1b(:)[1] = ustr2a[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr1b(1) /= 4_"abc" .or. ustr1b(2) /= 4_"abc" &
+        .or. ustr1b(3) /= 4_"abc") call abort()
+  else
+    if (ustr1b(1) /= 4_"XXX" .or. ustr1b(2) /= 4_"YYY" &
+        .or. ustr1b(3) /= 4_"ZZZ") call abort()
+  end if
+
+  ! ============== char1 <-> char4 =====================
+
+  ! ---------- Assign to coindexed variable -------------
+
+  ! - - - - - scalar = scalar
+
+  ! SCALAR - kind 1 <- 4 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr1a = 4_"abc"
+  str1a = 1_"XXXXXXX"
+  if (this_image() == num_images()) then
+    str2a[1] = ustr1a
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str2a /= 1_"abc    ") call abort()
+  else
+    if (str2a /= 1_"XXXXXXX") call abort()
+  end if
+
+  ! SCALAR - kind 4 <- 1 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str1a = 4_"abc"
+  ustr2a = 1_"XXXXXXX"
+  if (this_image() == num_images()) then
+    ustr2a[1] = str1a
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr2a /= 4_"abc    ") call abort()
+  else
+    if (ustr2a /= 4_"XXXXXXX") call abort()
+  end if
+
+  ! SCALAR - kind 1 <- 4 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr2a = 4_"abcde"
+  str1a = 1_"XXX"
+  if (this_image() == num_images()) then
+    str1a[1] = ustr2a
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str1a /= 1_"abc") call abort()
+  else
+    if (str1a /= 1_"XXX") call abort()
+  end if
+
+  ! SCALAR - kind 4 <- 1 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str2a = 4_"abcde"
+  ustr1a = 1_"XXX"
+  if (this_image() == num_images()) then
+    ustr1a[1] = str2a
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr1a /= 4_"abc") call abort()
+  else
+    if (ustr1a /= 4_"XXX") call abort()
+  end if
+
+  ! - - - - - array = array
+
+  ! contiguous ARRAY - kind 1 <- 4 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr1b(1) = 4_"abc"
+  ustr1b(2) = 4_"def"
+  ustr1b(3) = 4_"gjh"
+  str2b(1) = 1_"XXXXXXX"
+  str2b(2) = 1_"YYYYYYY"
+  str2b(3) = 1_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    str2b(:)[1] = ustr1b
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str2b(1) /= 1_"abc    " .or. str2b(2) /= 1_"def    " &
+        .or. str2b(3) /= 1_"gjh    ") call abort()
+  else
+    if (str2b(1) /= 1_"XXXXXXX" .or. str2b(2) /= 1_"YYYYYYY" &
+        .or. str2b(3) /= 1_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 <- 1 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str1b(1) = 1_"abc"
+  str1b(2) = 1_"def"
+  str1b(3) = 1_"gjh"
+  ustr2b(1) = 4_"XXXXXXX"
+  ustr2b(2) = 4_"YYYYYYY"
+  ustr2b(3) = 4_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    ustr2b(:)[1] = str1b
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr2b(1) /= 4_"abc    " .or. ustr2b(2) /= 4_"def    " &
+        .or. ustr2b(3) /= 4_"gjh    ") call abort()
+  else
+    if (ustr2b(1) /= 4_"XXXXXXX" .or. ustr2b(2) /= 4_"YYYYYYY" &
+        .or. ustr2b(3) /= 4_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 1 <- 4 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr2b(1) = 4_"abcdefg"
+  ustr2b(2) = 4_"hijklmn"
+  ustr2b(3) = 4_"opqrstu"
+  str1b(1) = 1_"XXX"
+  str1b(2) = 1_"YYY"
+  str1b(3) = 1_"ZZZ"
+  if (this_image() == num_images()) then
+    str1b(:)[1] = ustr2b
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str1b(1) /= 1_"abc" .or. str1b(2) /= 1_"hij" &
+        .or. str1b(3) /= 1_"opq") call abort()
+  else
+    if (str1b(1) /= 1_"XXX" .or. str1b(2) /= 1_"YYY" &
+        .or. str1b(3) /= 1_"ZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 <- 1 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str2b(1) = 1_"abcdefg"
+  str2b(2) = 1_"hijklmn"
+  str2b(3) = 1_"opqrstu"
+  ustr1b(1) = 4_"XXX"
+  ustr1b(2) = 4_"YYY"
+  ustr1b(3) = 4_"ZZZ"
+  if (this_image() == num_images()) then
+    ustr1b(:)[1] = str2b
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr1b(1) /= 4_"abc" .or. ustr1b(2) /= 4_"hij" &
+        .or. ustr1b(3) /= 4_"opq") call abort()
+  else
+    if (ustr1b(1) /= 4_"XXX" .or. ustr1b(2) /= 4_"YYY" &
+        .or. ustr1b(3) /= 4_"ZZZ") call abort()
+  end if
+
+  ! - - - - - array = scalar
+
+  ! contiguous ARRAY - kind 1 <- 4 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr1a = 4_"abc"
+  str2b(1) = 1_"XXXXXXX"
+  str2b(2) = 1_"YYYYYYY"
+  str2b(3) = 1_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    str2b(:)[1] = ustr1a
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str2b(1) /= 1_"abc    " .or. str2b(2) /= 1_"abc    " &
+        .or. str2b(3) /= 1_"abc    ") call abort()
+  else
+    if (str2b(1) /= 1_"XXXXXXX" .or. str2b(2) /= 1_"YYYYYYY" &
+        .or. str2b(3) /= 1_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 <- 1 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str1a = 1_"abc"
+  ustr2b(1) = 4_"XXXXXXX"
+  ustr2b(2) = 4_"YYYYYYY"
+  ustr2b(3) = 4_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    ustr2b(:)[1] = str1a
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr2b(1) /= 4_"abc    " .or. ustr2b(2) /= 4_"abc    " &
+        .or. ustr2b(3) /= 4_"abc    ") call abort()
+  else
+    if (ustr2b(1) /= 4_"XXXXXXX" .or. ustr2b(2) /= 4_"YYYYYYY" &
+        .or. ustr2b(3) /= 4_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 1 <- 4 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr2a = 4_"abcdefg"
+  str1b(1) = 1_"XXX"
+  str1b(2) = 1_"YYY"
+  str1b(3) = 1_"ZZZ"
+  if (this_image() == num_images()) then
+    str1b(:)[1] = ustr2a
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str1b(1) /= 1_"abc" .or. str1b(2) /= 1_"abc" &
+        .or. str1b(3) /= 1_"abc") call abort()
+  else
+    if (str1b(1) /= 1_"XXX" .or. str1b(2) /= 1_"YYY" &
+        .or. str1b(3) /= 1_"ZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 <- 1 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str2a = 1_"abcdefg"
+  ustr1b(1) = 4_"XXX"
+  ustr1b(2) = 4_"YYY"
+  ustr1b(3) = 4_"ZZZ"
+  if (this_image() == num_images()) then
+    ustr1b(:)[1] = str2a
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr1b(1) /= 4_"abc" .or. ustr1b(2) /= 4_"abc" &
+        .or. ustr1b(3) /= 4_"abc") call abort()
+  else
+    if (ustr1b(1) /= 4_"XXX" .or. ustr1b(2) /= 4_"YYY" &
+        .or. ustr1b(3) /= 4_"ZZZ") call abort()
+  end if
+
+  ! ---------- Take from a coindexed variable -------------
+
+  ! - - - - - scalar = scalar
+
+  ! SCALAR - kind 1 <- 4 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr1a = 4_"abc"
+  str2a = 1_"XXXXXXX"
+  if (this_image() == num_images()) then
+    str2a = ustr1a[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (str2a /= 1_"abc    ") call abort()
+  else
+    if (str2a /= 1_"XXXXXXX") call abort()
+  end if
+
+  ! SCALAR - kind 4 <- 1 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str1a = 1_"abc"
+  ustr2a = 4_"XXXXXXX"
+  if (this_image() == num_images()) then
+    ustr2a = str1a[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (ustr2a /= 4_"abc    ") call abort()
+  else
+    if (ustr2a /= 4_"XXXXXXX") call abort()
+  end if
+
+  ! SCALAR - kind 1 <- 4 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr2a = 4_"abcde"
+  str1a = 1_"XXX"
+  if (this_image() == num_images()) then
+    str1a = ustr2a[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (str1a /= 1_"abc") call abort()
+  else
+    if (str1a /= 1_"XXX") call abort()
+  end if
+
+  ! SCALAR - kind 4 <- 1 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str2a = 1_"abcde"
+  ustr1a = 4_"XXX"
+  if (this_image() == num_images()) then
+    ustr1a = str2a[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (ustr1a /= 4_"abc") call abort()
+  else
+    if (ustr1a /= 4_"XXX") call abort()
+  end if
+
+  ! - - - - - array = array
+
+  ! contiguous ARRAY - kind 1 <- 4 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr1b(1) = 4_"abc"
+  ustr1b(2) = 4_"def"
+  ustr1b(3) = 4_"gjh"
+  str2b(1) = 1_"XXXXXXX"
+  str2b(2) = 1_"YYYYYYY"
+  str2b(3) = 1_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    str2b = ustr1b(:)[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (str2b(1) /= 1_"abc    " .or. str2b(2) /= 1_"def    " &
+        .or. str2b(3) /= 1_"gjh    ") call abort()
+  else
+    if (str2b(1) /= 1_"XXXXXXX" .or. str2b(2) /= 1_"YYYYYYY" &
+        .or. str2b(3) /= 1_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 <- 1 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str1b(1) = 1_"abc"
+  str1b(2) = 1_"def"
+  str1b(3) = 1_"gjh"
+  ustr2b(1) = 4_"XXXXXXX"
+  ustr2b(2) = 4_"YYYYYYY"
+  ustr2b(3) = 4_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    ustr2b = str1b(:)[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (ustr2b(1) /= 4_"abc    " .or. ustr2b(2) /= 4_"def    " &
+        .or. ustr2b(3) /= 4_"gjh    ") call abort()
+  else
+    if (ustr2b(1) /= 4_"XXXXXXX" .or. ustr2b(2) /= 4_"YYYYYYY" &
+        .or. ustr2b(3) /= 4_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 1 <- 4 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr2b(1) = 4_"abcdefg"
+  ustr2b(2) = 4_"hijklmn"
+  ustr2b(3) = 4_"opqrstu"
+  str1b(1) = 1_"XXX"
+  str1b(2) = 1_"YYY"
+  str1b(3) = 1_"ZZZ"
+  if (this_image() == num_images()) then
+    str1b = ustr2b(:)[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (str1b(1) /= 1_"abc" .or. str1b(2) /= 1_"hij" &
+        .or. str1b(3) /= 1_"opq") call abort()
+  else
+    if (str1b(1) /= 1_"XXX" .or. str1b(2) /= 1_"YYY" &
+        .or. str1b(3) /= 1_"ZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 <- 1 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str2b(1) = 1_"abcdefg"
+  str2b(2) = 1_"hijklmn"
+  str2b(3) = 1_"opqrstu"
+  ustr1b(1) = 4_"XXX"
+  ustr1b(2) = 4_"YYY"
+  ustr1b(3) = 4_"ZZZ"
+  if (this_image() == num_images()) then
+    ustr1b = str2b(:)[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (ustr1b(1) /= 4_"abc" .or. ustr1b(2) /= 4_"hij" &
+        .or. ustr1b(3) /= 4_"opq") call abort()
+  else
+    if (ustr1b(1) /= 4_"XXX" .or. ustr1b(2) /= 4_"YYY" &
+        .or. ustr1b(3) /= 4_"ZZZ") call abort()
+  end if
+
+  ! - - - - - array = scalar
+
+  ! contiguous ARRAY - kind 1 <- 4 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr1a = 4_"abc"
+  str2b(1) = 1_"XXXXXXX"
+  str2b(2) = 1_"YYYYYYY"
+  str2b(3) = 1_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    str2b = ustr1a[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (str2b(1) /= 1_"abc    " .or. str2b(2) /= 1_"abc    " &
+        .or. str2b(3) /= 1_"abc    ") call abort()
+  else
+    if (str2b(1) /= 1_"XXXXXXX" .or. str2b(2) /= 1_"YYYYYYY" &
+        .or. str2b(3) /= 1_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 <- 1 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str1a = 1_"abc"
+  ustr2b(1) = 4_"XXXXXXX"
+  ustr2b(2) = 4_"YYYYYYY"
+  ustr2b(3) = 4_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    ustr2b = str1a[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (ustr2b(1) /= 4_"abc    " .or. ustr2b(2) /= 4_"abc    " &
+        .or. ustr2b(3) /= 4_"abc    ") call abort()
+  else
+    if (ustr2b(1) /= 4_"XXXXXXX" .or. ustr2b(2) /= 4_"YYYYYYY" &
+        .or. ustr2b(3) /= 4_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 1 <- 4 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr2a = 4_"abcdefg"
+  str1b(1) = 1_"XXX"
+  str1b(2) = 1_"YYY"
+  str1b(3) = 1_"ZZZ"
+  if (this_image() == num_images()) then
+    str1b = ustr2a[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (str1b(1) /= 1_"abc" .or. str1b(2) /= 1_"abc" &
+        .or. str1b(3) /= 1_"abc") call abort()
+  else
+    if (str1b(1) /= 1_"XXX" .or. str1b(2) /= 1_"YYY" &
+        .or. str1b(3) /= 1_"ZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 <- 1 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str2a = 1_"abcdefg"
+  ustr1b(1) = 4_"XXX"
+  ustr1b(2) = 4_"YYY"
+  ustr1b(3) = 4_"ZZZ"
+  if (this_image() == num_images()) then
+    ustr1b = str2a[1]
+  end if
+  sync all
+  if (this_image() == num_images()) then
+    if (ustr1b(1) /= 4_"abc" .or. ustr1b(2) /= 4_"abc" &
+        .or. ustr1b(3) /= 4_"abc") call abort()
+  else
+    if (ustr1b(1) /= 4_"XXX" .or. ustr1b(2) /= 4_"YYY" &
+        .or. ustr1b(3) /= 4_"ZZZ") call abort()
+  end if
+
+
+  ! ---------- coindexed to coindexed variable -------------
+
+  ! - - - - - scalar = scalar
+
+  ! SCALAR - kind 1 <- 4 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr1a = 4_"abc"
+  str2a = 1_"XXXXXXX"
+  if (this_image() == num_images()) then
+    str2a[1] = ustr1a[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str2a /= 1_"abc    ") call abort()
+  else
+    if (str2a /= 1_"XXXXXXX") call abort()
+  end if
+
+  ! SCALAR - kind 4 <- 1 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str1a = 1_"abc"
+  ustr2a = 4_"XXXXXXX"
+  if (this_image() == num_images()) then
+    ustr2a[1] = str1a[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr2a /= 4_"abc    ") call abort()
+  else
+    if (ustr2a /= 4_"XXXXXXX") call abort()
+  end if
+
+  ! SCALAR - kind 1 <- 4 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr2a = 4_"abcde"
+  str1a = 1_"XXX"
+  if (this_image() == num_images()) then
+    str1a[1] = ustr2a[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str1a /= 1_"abc") call abort()
+  else
+    if (str1a /= 1_"XXX") call abort()
+  end if
+
+  ! SCALAR - kind 4 <- 1 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str2a = 1_"abcde"
+  ustr1a = 4_"XXX"
+  if (this_image() == num_images()) then
+    ustr1a[1] = str2a[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr1a /= 4_"abc") call abort()
+  else
+    if (ustr1a /= 4_"XXX") call abort()
+  end if
+
+  ! - - - - - array = array
+
+  ! contiguous ARRAY - kind 1 <- 4 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr1b(1) = 4_"abc"
+  ustr1b(2) = 4_"def"
+  ustr1b(3) = 4_"gjh"
+  str2b(1) = 1_"XXXXXXX"
+  str2b(2) = 1_"YYYYYYY"
+  str2b(3) = 1_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    str2b(:)[1] = ustr1b(:)[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str2b(1) /= 1_"abc    " .or. str2b(2) /= 1_"def    " &
+        .or. str2b(3) /= 1_"gjh    ") call abort()
+  else
+    if (str2b(1) /= 1_"XXXXXXX" .or. str2b(2) /= 1_"YYYYYYY" &
+        .or. str2b(3) /= 1_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 <- 1 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str1b(1) = 1_"abc"
+  str1b(2) = 1_"def"
+  str1b(3) = 1_"gjh"
+  ustr2b(1) = 4_"XXXXXXX"
+  ustr2b(2) = 4_"YYYYYYY"
+  ustr2b(3) = 4_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    ustr2b(:)[1] = str1b(:)[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr2b(1) /= 4_"abc    " .or. ustr2b(2) /= 4_"def    " &
+        .or. ustr2b(3) /= 4_"gjh    ") call abort()
+  else
+    if (ustr2b(1) /= 4_"XXXXXXX" .or. ustr2b(2) /= 4_"YYYYYYY" &
+        .or. ustr2b(3) /= 4_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 1 <- 4 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr2b(1) = 4_"abcdefg"
+  ustr2b(2) = 4_"hijklmn"
+  ustr2b(3) = 4_"opqrstu"
+  str1b(1) = 1_"XXX"
+  str1b(2) = 1_"YYY"
+  str1b(3) = 1_"ZZZ"
+  if (this_image() == num_images()) then
+    str1b(:)[1] = ustr2b(:)[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str1b(1) /= 1_"abc" .or. str1b(2) /= 1_"hij" &
+        .or. str1b(3) /= 1_"opq") call abort()
+  else
+    if (str1b(1) /= 1_"XXX" .or. str1b(2) /= 1_"YYY" &
+        .or. str1b(3) /= 1_"ZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 <- 1 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str2b(1) = 1_"abcdefg"
+  str2b(2) = 1_"hijklmn"
+  str2b(3) = 1_"opqrstu"
+  ustr1b(1) = 4_"XXX"
+  ustr1b(2) = 4_"YYY"
+  ustr1b(3) = 4_"ZZZ"
+  if (this_image() == num_images()) then
+    ustr1b(:)[1] = str2b(:)[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr1b(1) /= 4_"abc" .or. ustr1b(2) /= 4_"hij" &
+        .or. ustr1b(3) /= 4_"opq") call abort()
+  else
+    if (ustr1b(1) /= 4_"XXX" .or. ustr1b(2) /= 4_"YYY" &
+        .or. ustr1b(3) /= 4_"ZZZ") call abort()
+  end if
+
+  ! - - - - - array = scalar
+
+  ! contiguous ARRAY - kind 1 <- 4 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr1a = 4_"abc"
+  str2b(1) = 1_"XXXXXXX"
+  str2b(2) = 1_"YYYYYYY"
+  str2b(3) = 1_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    str2b(:)[1] = ustr1a[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str2b(1) /= 1_"abc    " .or. str2b(2) /= 1_"abc    " &
+        .or. str2b(3) /= 1_"abc    ") call abort()
+  else
+    if (str2b(1) /= 1_"XXXXXXX" .or. str2b(2) /= 1_"YYYYYYY" &
+        .or. str2b(3) /= 1_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 <- 1 - with padding
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str1a = 1_"abc"
+  ustr2b(1) = 4_"XXXXXXX"
+  ustr2b(2) = 4_"YYYYYYY"
+  ustr2b(3) = 4_"ZZZZZZZ"
+  if (this_image() == num_images()) then
+    ustr2b(:)[1] = str1a[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr2b(1) /= 4_"abc    " .or. ustr2b(2) /= 4_"abc    " &
+        .or. ustr2b(3) /= 4_"abc    ") call abort()
+  else
+    if (ustr2b(1) /= 4_"XXXXXXX" .or. ustr2b(2) /= 4_"YYYYYYY" &
+        .or. ustr2b(3) /= 4_"ZZZZZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 1 <- 4 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  ustr2a = 4_"abcdefg"
+  str1b(1) = 1_"XXX"
+  str1b(2) = 1_"YYY"
+  str1b(3) = 1_"ZZZ"
+  if (this_image() == num_images()) then
+    str1b(:)[1] = ustr2a[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (str1b(1) /= 1_"abc" .or. str1b(2) /= 1_"abc" &
+        .or. str1b(3) /= 1_"abc") call abort()
+  else
+    if (str1b(1) /= 1_"XXX" .or. str1b(2) /= 1_"YYY" &
+        .or. str1b(3) /= 1_"ZZZ") call abort()
+  end if
+
+  ! contiguous ARRAY - kind 4 <- 1 - with trimming
+  str1a = 1_"zzz"; str1b = 1_"zzz"; ustr1a = 4_"zzz"; ustr1b = 4_"zzz"
+  str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
+  ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
+  str2a = 1_"abcdefg"
+  ustr1b(1) = 4_"XXX"
+  ustr1b(2) = 4_"YYY"
+  ustr1b(3) = 4_"ZZZ"
+  if (this_image() == num_images()) then
+    ustr1b(:)[1] = str2a[mod(1, num_images())+1]
+  end if
+  sync all
+  if (this_image() == 1) then
+    if (ustr1b(1) /= 4_"abc" .or. ustr1b(2) /= 4_"abc" &
+        .or. ustr1b(3) /= 4_"abc") call abort()
+  else
+    if (ustr1b(1) /= 4_"XXX" .or. ustr1b(2) /= 4_"YYY" &
+        .or. ustr1b(3) /= 4_"ZZZ") call abort()
+  end if
+
+end subroutine char_test
+end program test
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index abb0a1f..d053c50 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -236,6 +236,292 @@  _gfortran_caf_co_max (gfc_descriptor_t *a __attribute__ ((unused)),
     *stat = 0;
 }
 
+
+static void
+assign_char4_from_char1 (size_t dst_size, size_t src_size, uint32_t *dst,
+			 unsigned char *src)
+{
+  size_t i, n;
+  n = dst_size/4 > src_size ? src_size : dst_size/4;
+  for (i = 0; i < n; ++i)
+    dst[i] = (int32_t) src[i];
+  for (; i < dst_size/4; ++i)
+    dst[i] = (int32_t) ' ';
+}
+
+
+static void
+assign_char1_from_char4 (size_t dst_size, size_t src_size, unsigned char *dst,
+			 uint32_t *src)
+{
+  size_t i, n;
+  n = dst_size > src_size/4 ? src_size/4 : dst_size;
+  for (i = 0; i < n; ++i)
+    dst[i] = src[i] > UINT8_MAX ? (unsigned char) '?' : (unsigned char) src[i];
+  if (dst_size > n)
+    memset(&dst[n], ' ', dst_size - n);
+}
+
+
+static void
+convert_type (void *dst, int dst_type, int dst_kind, void *src, int src_type,
+	      int src_kind)
+{
+#ifdef HAVE_GFC_INTEGER_16
+  typedef __int128 int128t;
+#else
+  typedef int64_t int128t;
+#endif
+
+#if defined(GFC_REAL_16_IS_LONG_DOUBLE)
+  typedef long double real128t;
+  typedef _Complex long double complex128t;
+#elif defined(HAVE_GFC_REAL_16)
+  typedef _Complex float __attribute__((mode(TC))) __complex128;
+  typedef __float128 real128t;
+  typedef __complex128 complex128t;
+#elif defined(HAVE_GFC_REAL_10)
+  typedef long double real128t;
+  typedef long double complex128t;
+#else
+  typedef double real128t;
+  typedef _Complex double complex128t;
+#endif
+
+  int128t int_val = 0;
+  real128t real_val = 0;
+  complex128t cmpx_val = 0;
+
+  switch (src_type)
+    {
+    case BT_INTEGER:
+      if (src_kind == 1)
+	int_val = *(int8_t*) src;
+      else if (src_kind == 2)
+	int_val = *(int16_t*) src;
+      else if (src_kind == 4)
+	int_val = *(int32_t*) src;
+      else if (src_kind == 8)
+	int_val = *(int64_t*) src;
+#ifdef HAVE_GFC_INTEGER_16
+      else if (src_kind == 16)
+	int_val = *(int128t*) src;
+#endif
+      else
+	goto error;
+      break;
+    case BT_REAL:
+      if (src_kind == 4)
+	real_val = *(float*) src;
+      else if (src_kind == 8)
+	real_val = *(double*) src;
+#ifdef HAVE_GFC_REAL_10
+      else if (src_kind == 10)
+	real_val = *(long double*) src;
+#endif
+#ifdef HAVE_GFC_REAL_16
+      else if (src_kind == 16)
+	real_val = *(real128t*) src;
+#endif
+      else
+	goto error;
+      break;
+    case BT_COMPLEX:
+      if (src_kind == 4)
+	cmpx_val = *(_Complex float*) src;
+      else if (src_kind == 8)
+	cmpx_val = *(_Complex double*) src;
+#ifdef HAVE_GFC_REAL_10
+      else if (src_kind == 10)
+	cmpx_val = *(_Complex long double*) src;
+#endif
+#ifdef HAVE_GFC_REAL_16
+      else if (src_kind == 16)
+	cmpx_val = *(complex128t*) src;
+#endif
+      else
+	goto error;
+      break;
+    default:
+      goto error;
+    }
+
+  switch (dst_type)
+    {
+    case BT_INTEGER:
+      if (src_type == BT_INTEGER)
+	{
+	  if (dst_kind == 1)
+	    *(int8_t*) dst = (int8_t) int_val;
+	  else if (dst_kind == 2)
+	    *(int16_t*) dst = (int16_t) int_val;
+	  else if (dst_kind == 4)
+	    *(int32_t*) dst = (int32_t) int_val;
+	  else if (dst_kind == 8)
+	    *(int64_t*) dst = (int64_t) int_val;
+#ifdef HAVE_GFC_INTEGER_16
+	  else if (dst_kind == 16)
+	    *(int128t*) dst = (int128t) int_val;
+#endif
+	  else
+	    goto error;
+	}
+      else if (src_type == BT_REAL)
+	{
+	  if (dst_kind == 1)
+	    *(int8_t*) dst = (int8_t) real_val;
+	  else if (dst_kind == 2)
+	    *(int16_t*) dst = (int16_t) real_val;
+	  else if (dst_kind == 4)
+	    *(int32_t*) dst = (int32_t) real_val;
+	  else if (dst_kind == 8)
+	    *(int64_t*) dst = (int64_t) real_val;
+#ifdef HAVE_GFC_INTEGER_16
+	  else if (dst_kind == 16)
+	    *(int128t*) dst = (int128t) real_val;
+#endif
+	  else
+	    goto error;
+	}
+      else if (src_type == BT_COMPLEX)
+	{
+	  if (dst_kind == 1)
+	    *(int8_t*) dst = (int8_t) cmpx_val;
+	  else if (dst_kind == 2)
+	    *(int16_t*) dst = (int16_t) cmpx_val;
+	  else if (dst_kind == 4)
+	    *(int32_t*) dst = (int32_t) cmpx_val;
+	  else if (dst_kind == 8)
+	    *(int64_t*) dst = (int64_t) cmpx_val;
+#ifdef HAVE_GFC_INTEGER_16
+	  else if (dst_kind == 16)
+	    *(int128t*) dst = (int128t) cmpx_val;
+#endif
+	  else
+	    goto error;
+	}
+      else
+	goto error;
+      break;
+    case BT_REAL:
+      if (src_type == BT_INTEGER)
+	{
+	  if (dst_kind == 4)
+	    *(float*) dst = (float) int_val;
+	  else if (dst_kind == 8)
+	    *(double*) dst = (double) int_val;
+#ifdef HAVE_GFC_REAL_10
+	  else if (dst_kind == 10)
+	    *(long double*) dst = (long double) int_val;
+#endif
+#ifdef HAVE_GFC_REAL_16
+	  else if (dst_kind == 16)
+	    *(real128t*) dst = (real128t) int_val;
+#endif
+	  else
+	    goto error;
+	}
+      else if (src_type == BT_REAL)
+	{
+	  if (dst_kind == 4)
+	    *(float*) dst = (float) real_val;
+	  else if (dst_kind == 8)
+	    *(double*) dst = (double) real_val;
+#ifdef HAVE_GFC_REAL_10
+	  else if (dst_kind == 10)
+	    *(long double*) dst = (long double) real_val;
+#endif
+#ifdef HAVE_GFC_REAL_16
+	  else if (dst_kind == 16)
+	    *(real128t*) dst = (real128t) real_val;
+#endif
+	  else
+	    goto error;
+	}
+      else if (src_type == BT_COMPLEX)
+	{
+	  if (dst_kind == 4)
+	    *(float*) dst = (float) cmpx_val;
+	  else if (dst_kind == 8)
+	    *(double*) dst = (double) cmpx_val;
+#ifdef HAVE_GFC_REAL_10
+	  else if (dst_kind == 10)
+	    *(long double*) dst = (long double) cmpx_val;
+#endif
+#ifdef HAVE_GFC_REAL_16
+	  else if (dst_kind == 16)
+	    *(real128t*) dst = (real128t) cmpx_val;
+#endif
+	  else
+	    goto error;
+	}
+      break;
+    case BT_COMPLEX:
+      if (src_type == BT_INTEGER)
+	{
+	  if (dst_kind == 4)
+	    *(_Complex float*) dst = (_Complex float) int_val;
+	  else if (dst_kind == 8)
+	    *(_Complex double*) dst = (_Complex double) int_val;
+#ifdef HAVE_GFC_REAL_10
+	  else if (dst_kind == 10)
+	    *(_Complex long double*) dst = (_Complex long double) int_val;
+#endif
+#ifdef HAVE_GFC_REAL_16
+	  else if (dst_kind == 16)
+	    *(complex128t*) dst = (complex128t) int_val;
+#endif
+	  else
+	    goto error;
+	}
+      else if (src_type == BT_REAL)
+	{
+	  if (dst_kind == 4)
+	    *(_Complex float*) dst = (_Complex float) real_val;
+	  else if (dst_kind == 8)
+	    *(_Complex double*) dst = (_Complex double) real_val;
+#ifdef HAVE_GFC_REAL_10
+	  else if (dst_kind == 10)
+	    *(_Complex long double*) dst = (_Complex long double) real_val;
+#endif
+#ifdef HAVE_GFC_REAL_16
+	  else if (dst_kind == 16)
+	    *(complex128t*) dst = (complex128t) real_val;
+#endif
+	  else
+	    goto error;
+	}
+      else if (src_type == BT_COMPLEX)
+	{
+	  if (dst_kind == 4)
+	    *(_Complex float*) dst = (_Complex float) cmpx_val;
+	  else if (dst_kind == 8)
+	    *(_Complex double*) dst = (_Complex double) cmpx_val;
+#ifdef HAVE_GFC_REAL_10
+	  else if (dst_kind == 10)
+	    *(_Complex long double*) dst = (_Complex long double) cmpx_val;
+#endif
+#ifdef HAVE_GFC_REAL_16
+	  else if (dst_kind == 16)
+	    *(complex128t*) dst = (complex128t) cmpx_val;
+#endif
+	  else
+	    goto error;
+	}
+      else
+	goto error;
+      break;
+    default:
+      goto error;
+    }
+
+error:
+  fprintf (stderr, "libcaf_single RUNTIME ERROR: Cannot convert type %d kind "
+	   "%d to type %d kind %d\n", src_type, src_kind, dst_type, dst_kind);
+  abort();
+}
+
+
 void
 _gfortran_caf_get (caf_token_t token, size_t offset,
 		   int image_index __attribute__ ((unused)),
@@ -243,9 +529,7 @@  _gfortran_caf_get (caf_token_t token, size_t offset,
 		   caf_vector_t *src_vector __attribute__ ((unused)),
 		   gfc_descriptor_t *dest, int src_kind, int dst_kind)
 {
-  /* FIXME: Handle vector subscript, type conversion and assignment "array = scalar".
-     check in particular whether strings of different kinds are permitted and
-     whether it makes sense to handle array = scalar.  */
+  /* FIXME: Handle vector subscripts.  */
   size_t i, k, size;
   int j;
   int rank = GFC_DESCRIPTOR_RANK (dest);
@@ -255,19 +539,30 @@  _gfortran_caf_get (caf_token_t token, size_t offset,
   if (rank == 0)
     {
       void *sr = (void *) ((char *) TOKEN (token) + offset);
-      if (dst_kind == src_kind)
-	memmove (GFC_DESCRIPTOR_DATA (dest), sr,
-		 dst_size > src_size ? src_size : dst_size);
-      /* else: FIXME: type conversion.  */
-      if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_size > src_size)
+      if (GFC_DESCRIPTOR_TYPE (dest) == GFC_DESCRIPTOR_TYPE (src)
+	  && dst_kind == src_kind)
 	{
-	  if (dst_kind == 1)
-	    memset ((void*)(char*) GFC_DESCRIPTOR_DATA (dest) + src_size, ' ',
-		    dst_size-src_size);
-	  else /* dst_kind == 4.  */
-	    for (i = src_size/4; i < dst_size/4; i++)
-	      ((int32_t*) GFC_DESCRIPTOR_DATA (dest))[i] = (int32_t)' ';
+	  memmove (GFC_DESCRIPTOR_DATA (dest), sr,
+		   dst_size > src_size ? src_size : dst_size);
+	  if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_size > src_size)
+	    {
+	      if (dst_kind == 1)
+		memset ((void*)(char*) GFC_DESCRIPTOR_DATA (dest) + src_size,
+			' ', dst_size - src_size);
+	      else /* dst_kind == 4.  */
+		for (i = src_size/4; i < dst_size/4; i++)
+		  ((int32_t*) GFC_DESCRIPTOR_DATA (dest))[i] = (int32_t) ' ';
+	    }
 	}
+      else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_kind == 1)
+	assign_char1_from_char4 (dst_size, src_size, GFC_DESCRIPTOR_DATA (dest),
+				 sr);
+      else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER)
+	assign_char4_from_char1 (dst_size, src_size, GFC_DESCRIPTOR_DATA (dest),
+				 sr);
+      else
+	convert_type (GFC_DESCRIPTOR_DATA (dest), GFC_DESCRIPTOR_TYPE (dest),
+		      dst_kind, sr, GFC_DESCRIPTOR_TYPE (src), src_kind);
       return;
     }
 
@@ -300,39 +595,42 @@  _gfortran_caf_get (caf_token_t token, size_t offset,
       array_offset_dst += (i / extent) * dest->dim[rank-1]._stride;
       void *dst = dest->base_addr + array_offset_dst*GFC_DESCRIPTOR_SIZE (dest);
 
-      void *sr;
-      if (GFC_DESCRIPTOR_RANK (src) != 0)
+      ptrdiff_t array_offset_sr = 0;
+      stride = 1;
+      extent = 1;
+      for (j = 0; j < GFC_DESCRIPTOR_RANK (src)-1; j++)
 	{
-	  ptrdiff_t array_offset_sr = 0;
-	  stride = 1;
-	  extent = 1;
-	  for (j = 0; j < GFC_DESCRIPTOR_RANK (src)-1; j++)
-	    {
-	      array_offset_sr += ((i / (extent*stride))
-				  % (src->dim[j]._ubound
-				     - src->dim[j].lower_bound + 1))
-				 * src->dim[j]._stride;
-	      extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1);
-	      stride = src->dim[j]._stride;
-	    }
-	  array_offset_sr += (i / extent) * src->dim[rank-1]._stride;
-	  sr = (void *)((char *) TOKEN (token) + offset
-			+ array_offset_sr*GFC_DESCRIPTOR_SIZE (src));
+	  array_offset_sr += ((i / (extent*stride))
+			       % (src->dim[j]._ubound
+				  - src->dim[j].lower_bound + 1))
+			      * src->dim[j]._stride;
+	  extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1);
+	  stride = src->dim[j]._stride;
 	}
-      else
-	sr = (void *)((char *) TOKEN (token) + offset);
+      array_offset_sr += (i / extent) * src->dim[rank-1]._stride;
+      void *sr = (void *)((char *) TOKEN (token) + offset
+			  + array_offset_sr*GFC_DESCRIPTOR_SIZE (src));
 
-      if (dst_kind == src_kind)
-	memmove (dst, sr, dst_size > src_size ? src_size : dst_size);
-      /* else: FIXME: type conversion.  */
-      if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_size > src_size)
+      if (GFC_DESCRIPTOR_TYPE (dest) == GFC_DESCRIPTOR_TYPE (src)
+	  && dst_kind == src_kind)
 	{
-	  if (dst_kind == 1)
-	    memset ((void*)(char*) dst + src_size, ' ', dst_size-src_size);
-	  else /* dst_kind == 4.  */
-	    for (k = src_size/4; k < dst_size/4; i++)
-	      ((int32_t*) dst)[i] = (int32_t)' ';
+	  memmove (dst, sr, dst_size > src_size ? src_size : dst_size);
+	  if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_size > src_size)
+	    {
+	      if (dst_kind == 1)
+		memset ((void*)(char*) dst + src_size, ' ', dst_size-src_size);
+	      else /* dst_kind == 4.  */
+		for (k = src_size/4; k < dst_size/4; k++)
+		  ((int32_t*) dst)[k] = (int32_t) ' ';
+	    }
 	}
+      else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_kind == 1)
+	assign_char1_from_char4 (dst_size, src_size, dst, sr);
+      else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER)
+	assign_char4_from_char1 (dst_size, src_size, dst, sr);
+      else
+	convert_type (dst, GFC_DESCRIPTOR_TYPE (dest), dst_kind,
+		      sr, GFC_DESCRIPTOR_TYPE (src), src_kind);
     }
 }
 
@@ -342,11 +640,9 @@  _gfortran_caf_send (caf_token_t token, size_t offset,
 		    int image_index __attribute__ ((unused)),
 		    gfc_descriptor_t *dest,
 		    caf_vector_t *dst_vector __attribute__ ((unused)),
-		    gfc_descriptor_t *src, int dst_kind,
-		    int src_kind __attribute__ ((unused)))
+		    gfc_descriptor_t *src, int dst_kind, int src_kind)
 {
-  /* FIXME: Handle vector subscript, type conversion and assignment "array = scalar".
-     check in particular whether strings of different kinds are permitted.  */
+  /* FIXME: Handle vector subscripts.  */
   size_t i, k, size;
   int j;
   int rank = GFC_DESCRIPTOR_RANK (dest);
@@ -356,18 +652,30 @@  _gfortran_caf_send (caf_token_t token, size_t offset,
   if (rank == 0)
     {
       void *dst = (void *) ((char *) TOKEN (token) + offset);
-      if (dst_kind == src_kind)
-	memmove (dst, GFC_DESCRIPTOR_DATA (src),
-		 dst_size > src_size ? src_size : dst_size);
-      /* else: FIXME: type conversion.  */
-      if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_size > src_size)
+      if (GFC_DESCRIPTOR_TYPE (dest) == GFC_DESCRIPTOR_TYPE (src)
+	  && dst_kind == src_kind)
 	{
-	  if (dst_kind == 1)
-	    memset ((void*)(char*) dst + src_size, ' ', dst_size-src_size);
-	  else /* dst_kind == 4.  */
-	    for (i = src_size/4; i < dst_size/4; i++)
-	      ((int32_t*) dst)[i] = (int32_t)' ';
+	  memmove (dst, GFC_DESCRIPTOR_DATA (src),
+		   dst_size > src_size ? src_size : dst_size);
+	  if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_size > src_size)
+	    {
+	      if (dst_kind == 1)
+		memset ((void*)(char*) dst + src_size, ' ', dst_size-src_size);
+	      else /* dst_kind == 4.  */
+		for (i = src_size/4; i < dst_size/4; i++)
+		  ((int32_t*) dst)[i] = (int32_t) ' ';
+	    }
 	}
+      else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_kind == 1)
+	assign_char1_from_char4 (dst_size, src_size, dst,
+				 GFC_DESCRIPTOR_DATA (src));
+      else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER)
+	assign_char4_from_char1 (dst_size, src_size, dst,
+				 GFC_DESCRIPTOR_DATA (src));
+      else
+	convert_type (dst, GFC_DESCRIPTOR_TYPE (dest), dst_kind,
+		      GFC_DESCRIPTOR_DATA (src), GFC_DESCRIPTOR_TYPE (src),
+		      src_kind);
       return;
     }
 
@@ -383,16 +691,6 @@  _gfortran_caf_send (caf_token_t token, size_t offset,
   if (size == 0)
     return;
 
-#if 0
-  if (dst_len == src_len && PREFIX (is_contiguous) (dest)
-      && PREFIX (is_contiguous) (src))
-    {
-      void *dst = (void *)((char *) TOKEN (token) + offset);
-      memmove (dst, src->base_addr, GFC_DESCRIPTOR_SIZE (dest)*size);
-      return;
-    }
-#endif
-
   for (i = 0; i < size; i++)
     {
       ptrdiff_t array_offset_dst = 0;
@@ -432,17 +730,27 @@  _gfortran_caf_send (caf_token_t token, size_t offset,
       else
 	sr = src->base_addr;
 
-      if (dst_kind == src_kind)
-	memmove (dst, sr, dst_size > src_size ? src_size : dst_size);
-      /* else: FIXME: type conversion.  */
-      if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_size > src_size)
+      if (GFC_DESCRIPTOR_TYPE (dest) == GFC_DESCRIPTOR_TYPE (src)
+	  && dst_kind == src_kind)
 	{
-	  if (dst_kind == 1)
-	    memset ((void*)(char*) dst + src_size, ' ', dst_size-src_size);
-	  else /* dst_kind == 4.  */
-	    for (k = src_size/4; k < dst_size/4; i++)
-	      ((int32_t*) dst)[i] = (int32_t)' ';
+	  memmove (dst, sr,
+		   dst_size > src_size ? src_size : dst_size);
+	  if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_size > src_size)
+	    {
+	      if (dst_kind == 1)
+		memset ((void*)(char*) dst + src_size, ' ', dst_size-src_size);
+	      else /* dst_kind == 4.  */
+		for (k = src_size/4; k < dst_size/4; k++)
+		  ((int32_t*) dst)[k] = (int32_t) ' ';
+	    }
 	}
+      else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_kind == 1)
+	assign_char1_from_char4 (dst_size, src_size, dst, sr);
+      else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER)
+	assign_char4_from_char1 (dst_size, src_size, dst, sr);
+      else
+	convert_type (dst, GFC_DESCRIPTOR_TYPE (dest), dst_kind,
+		      sr, GFC_DESCRIPTOR_TYPE (src), src_kind);
     }
 }