diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index b373c25e5e1..e198506d58a 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -58,7 +58,16 @@ gfc_mpfr_to_mpz (mpz_t z, mpfr_t x, locus *where)
     mpz_tdiv_q_2exp (z, z, -e);
 }
 
+/* Reduce an unsigned number to within its range.  */
 
+void
+gfc_reduce_unsigned (gfc_expr *e)
+{
+  int k;
+  gcc_checking_assert (e->expr_type == EXPR_CONSTANT && e->ts.type == BT_UNSIGNED);
+  k = gfc_validate_kind (BT_UNSIGNED, e->ts.kind, false);
+  mpz_and (e->value.integer, e->value.integer, gfc_unsigned_kinds[k].huge);
+}
 /* Set the model number precision by the requested KIND.  */
 
 void
@@ -86,7 +95,7 @@ gfc_set_model (mpfr_t x)
 /* Given an arithmetic error code, return a pointer to a string that
    explains the error.  */
 
-static const char *
+const char *
 gfc_arith_error (arith code)
 {
   const char *p;
@@ -121,7 +130,12 @@ gfc_arith_error (arith code)
     case ARITH_INVALID_TYPE:
       p = G_("Invalid type in arithmetic operation at %L");
       break;
-
+    case ARITH_UNSIGNED_TRUNCATED:
+      p = G_("Unsigned constant truncated at %L");
+      break;
+    case ARITH_UNSIGNED_NEGATIVE:
+      p = G_("Negation of unsigned constant at %L not permitted");
+      break;
     default:
       gfc_internal_error ("gfc_arith_error(): Bad error code");
     }
@@ -160,6 +174,7 @@ void
 gfc_arith_init_1 (void)
 {
   gfc_integer_info *int_info;
+  gfc_unsigned_info *uint_info;
   gfc_real_info *real_info;
   mpfr_t a, b;
   int i;
@@ -202,6 +217,36 @@ gfc_arith_init_1 (void)
       int_info->range = (int) mpfr_get_si (a, GFC_RND_MODE);
     }
 
+  /* Similar, for UNSIGNED.  */
+  if (flag_unsigned)
+    {
+      for (uint_info = gfc_unsigned_kinds; uint_info->kind != 0; uint_info++)
+	{
+	  /* UNSIGNED is radix 2.  */
+	  gcc_assert (uint_info->radix == 2);
+	  /* Huge.  */
+	  mpz_init (uint_info->huge);
+	  mpz_set_ui (uint_info->huge, 2);
+	  mpz_pow_ui (uint_info->huge, uint_info->huge, uint_info->digits);
+	  mpz_sub_ui (uint_info->huge, uint_info->huge, 1);
+
+	  /* int_min - the smallest number we can reasonably convert from.  */
+
+	  mpz_init (uint_info->int_min);
+	  mpz_set_ui (uint_info->int_min, 2);
+	  mpz_pow_ui (uint_info->int_min, uint_info->int_min,
+		      uint_info->digits - 1);
+	  mpz_neg (uint_info->int_min, uint_info->int_min);
+
+	  /* Range.  */
+	  mpfr_set_z (a, uint_info->huge, GFC_RND_MODE);
+	  mpfr_log10 (a, a, GFC_RND_MODE);
+	  mpfr_trunc (a,a);
+	  uint_info->range = (int) mpfr_get_si (a, GFC_RND_MODE);
+	}
+
+    }
+
   mpfr_clear (a);
 
   for (real_info = gfc_real_kinds; real_info->kind != 0; real_info++)
@@ -344,6 +389,25 @@ gfc_check_integer_range (mpz_t p, int kind)
   return result;
 }
 
+/* Same as above.  */
+arith
+gfc_check_unsigned_range (mpz_t p, int kind)
+{
+  int i;
+
+  i = gfc_validate_kind (BT_UNSIGNED, kind, false);
+
+  if (pedantic && mpz_cmp_si (p, 0) < 0)
+    return ARITH_UNSIGNED_NEGATIVE;
+
+  if (mpz_cmp (p, gfc_unsigned_kinds[i].int_min) < 0)
+    return ARITH_UNSIGNED_TRUNCATED;
+
+  if (mpz_cmp (p, gfc_unsigned_kinds[i].huge) > 0)
+    return ARITH_UNSIGNED_TRUNCATED;
+
+  return ARITH_OK;
+}
 
 /* Given a real and a kind, make sure that the real lies within the
    range of the kind.  Returns ARITH_OK, ARITH_OVERFLOW or
@@ -541,6 +605,10 @@ gfc_range_check (gfc_expr *e)
       rc = gfc_check_integer_range (e->value.integer, e->ts.kind);
       break;
 
+    case BT_UNSIGNED:
+      rc = gfc_check_unsigned_range (e->value.integer, e->ts.kind);
+      break;
+
     case BT_REAL:
       rc = gfc_check_real_range (e->value.real, e->ts.kind);
       if (rc == ARITH_UNDERFLOW)
@@ -639,6 +707,23 @@ gfc_arith_uminus (gfc_expr *op1, gfc_expr **resultp)
       mpz_neg (result->value.integer, op1->value.integer);
       break;
 
+    case BT_UNSIGNED:
+      {
+	if (pedantic)
+	  return ARITH_UNSIGNED_NEGATIVE;
+
+	arith neg_rc;
+	mpz_neg (result->value.integer, op1->value.integer);
+	neg_rc = gfc_range_check (result);
+	if (neg_rc != ARITH_OK)
+	  gfc_warning (0, gfc_arith_error (neg_rc), &result->where);
+
+	gfc_reduce_unsigned (result);
+	if (pedantic)
+	  rc = neg_rc;
+      }
+      break;
+
     case BT_REAL:
       mpfr_neg (result->value.real, op1->value.real, GFC_RND_MODE);
       break;
@@ -674,6 +759,11 @@ gfc_arith_plus (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
       mpz_add (result->value.integer, op1->value.integer, op2->value.integer);
       break;
 
+    case BT_UNSIGNED:
+      mpz_add (result->value.integer, op1->value.integer, op2->value.integer);
+      gfc_reduce_unsigned (result);
+      break;
+
     case BT_REAL:
       mpfr_add (result->value.real, op1->value.real, op2->value.real,
 	       GFC_RND_MODE);
@@ -708,6 +798,7 @@ gfc_arith_minus (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
   switch (op1->ts.type)
     {
     case BT_INTEGER:
+    case BT_UNSIGNED:
       mpz_sub (result->value.integer, op1->value.integer, op2->value.integer);
       break;
 
@@ -748,6 +839,11 @@ gfc_arith_times (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
       mpz_mul (result->value.integer, op1->value.integer, op2->value.integer);
       break;
 
+    case BT_UNSIGNED:
+      mpz_mul (result->value.integer, op1->value.integer, op2->value.integer);
+      gfc_reduce_unsigned (result);
+      break;
+
     case BT_REAL:
       mpfr_mul (result->value.real, op1->value.real, op2->value.real,
 	       GFC_RND_MODE);
@@ -785,6 +881,7 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
   switch (op1->ts.type)
     {
     case BT_INTEGER:
+    case BT_UNSIGNED:
       if (mpz_sgn (op2->value.integer) == 0)
 	{
 	  rc = ARITH_DIV0;
@@ -1131,6 +1228,7 @@ gfc_compare_expr (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
   switch (op1->ts.type)
     {
     case BT_INTEGER:
+    case BT_UNSIGNED:
       rc = mpz_cmp (op1->value.integer, op2->value.integer);
       break;
 
@@ -1719,14 +1817,25 @@ eval_intrinsic (gfc_intrinsic_op op,
 
     gcc_fallthrough ();
     /* Numeric binary  */
+    case INTRINSIC_POWER:
+      if (flag_unsigned && op == INTRINSIC_POWER)
+	{
+	  if (op1->ts.type == BT_UNSIGNED || op2->ts.type == BT_UNSIGNED)
+	    goto runtime;
+	}
+
+      gcc_fallthrough();
+
     case INTRINSIC_PLUS:
     case INTRINSIC_MINUS:
     case INTRINSIC_TIMES:
     case INTRINSIC_DIVIDE:
-    case INTRINSIC_POWER:
       if (!gfc_numeric_ts (&op1->ts) || !gfc_numeric_ts (&op2->ts))
 	goto runtime;
 
+      if (flag_unsigned && gfc_invalid_unsigned_ops (op1, op2))
+	goto runtime;
+
       /* Do not perform conversions if operands are not conformable as
 	 required for the binary intrinsic operators (F2018:10.1.5).
 	 Defer to a possibly overloading user-defined operator.  */
@@ -2172,7 +2281,8 @@ wprecision_int_real (mpz_t n, mpfr_t r)
   return ret;
 }
 
-/* Convert integers to integers.  */
+/* Convert integers to integers; we can reuse this for also converting
+   unsigneds.  */
 
 gfc_expr *
 gfc_int2int (gfc_expr *src, int kind)
@@ -2180,7 +2290,7 @@ gfc_int2int (gfc_expr *src, int kind)
   gfc_expr *result;
   arith rc;
 
-  if (src->ts.type != BT_INTEGER)
+  if (src->ts.type != BT_INTEGER && src->ts.type != BT_UNSIGNED)
     return NULL;
 
   result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
@@ -2289,6 +2399,109 @@ gfc_int2complex (gfc_expr *src, int kind)
   return result;
 }
 
+/* Convert unsigned to unsigned, or integer to unsigned.  */
+
+gfc_expr *
+gfc_uint2uint (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  arith rc;
+
+  if (src->ts.type != BT_UNSIGNED && src->ts.type != BT_INTEGER)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_UNSIGNED, kind, &src->where);
+  mpz_set (result->value.integer, src->value.integer);
+
+  rc = gfc_range_check (result);
+  if (rc != ARITH_OK)
+    gfc_warning (OPT_Wconversion, gfc_arith_error (rc), &result->where);
+
+  gfc_reduce_unsigned (result);
+  return result;
+}
+
+gfc_expr *
+gfc_int2uint (gfc_expr *src, int kind)
+{
+  return gfc_uint2uint (src, kind);
+}
+
+gfc_expr *
+gfc_uint2int (gfc_expr *src, int kind)
+{
+  return gfc_int2int (src, kind);
+}
+
+/* Convert UNSIGNED to reals.  */
+
+gfc_expr *
+gfc_uint2real (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  arith rc;
+
+  if (src->ts.type != BT_UNSIGNED)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_REAL, kind, &src->where);
+
+  mpfr_set_z (result->value.real, src->value.integer, GFC_RND_MODE);
+
+  if ((rc = gfc_check_real_range (result->value.real, kind)) != ARITH_OK)
+    {
+      /* This should be rare, just in case.  */
+      arith_error (rc, &src->ts, &result->ts, &src->where);
+      gfc_free_expr (result);
+      return NULL;
+    }
+
+  if (warn_conversion
+      && wprecision_int_real (src->value.integer, result->value.real))
+    gfc_warning (OPT_Wconversion, "Change of value in conversion "
+		 "from %qs to %qs at %L",
+		 gfc_typename (&src->ts),
+		 gfc_typename (&result->ts),
+		 &src->where);
+
+  return result;
+}
+
+/* Convert default integer to default complex.  */
+
+gfc_expr *
+gfc_uint2complex (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  arith rc;
+
+  if (src->ts.type != BT_UNSIGNED)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);
+
+  mpc_set_z (result->value.complex, src->value.integer, GFC_MPC_RND_MODE);
+
+  if ((rc = gfc_check_real_range (mpc_realref (result->value.complex), kind))
+      != ARITH_OK)
+    {
+      /* This should be rare, just in case.  */
+      arith_error (rc, &src->ts, &result->ts, &src->where);
+      gfc_free_expr (result);
+      return NULL;
+    }
+
+  if (warn_conversion
+      && wprecision_int_real (src->value.integer,
+			      mpc_realref (result->value.complex)))
+      gfc_warning_now (OPT_Wconversion, "Change of value in conversion "
+		       "from %qs to %qs at %L",
+		       gfc_typename (&src->ts),
+		       gfc_typename (&result->ts),
+		       &src->where);
+
+  return result;
+}
 
 /* Convert default real to default integer.  */
 
@@ -2339,6 +2552,51 @@ gfc_real2int (gfc_expr *src, int kind)
   return result;
 }
 
+/* Convert real to unsigned.  */
+
+gfc_expr *
+gfc_real2uint (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  arith rc;
+  bool did_warn = false;
+
+  if (src->ts.type != BT_REAL)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_UNSIGNED, kind, &src->where);
+
+  gfc_mpfr_to_mpz (result->value.integer, src->value.real, &src->where);
+  if ((rc = gfc_check_unsigned_range (result->value.integer, kind)) != ARITH_OK)
+    gfc_warning (OPT_Wconversion, gfc_arith_error (rc), &result->where);
+
+  gfc_reduce_unsigned (result);
+
+  /* If there was a fractional part, warn about this.  */
+
+  if (warn_conversion)
+    {
+      mpfr_t f;
+      mpfr_init (f);
+      mpfr_frac (f, src->value.real, GFC_RND_MODE);
+      if (mpfr_cmp_si (f, 0) != 0)
+	{
+	  gfc_warning_now (OPT_Wconversion, "Change of value in conversion "
+			   "from %qs to %qs at %L", gfc_typename (&src->ts),
+			   gfc_typename (&result->ts), &src->where);
+	  did_warn = true;
+	}
+      mpfr_clear (f);
+    }
+  if (!did_warn && warn_conversion_extra)
+    {
+      gfc_warning_now (OPT_Wconversion_extra, "Conversion from %qs to %qs "
+		       "at %L", gfc_typename (&src->ts),
+		       gfc_typename (&result->ts), &src->where);
+    }
+
+  return result;
+}
 
 /* Convert real to real.  */
 
@@ -2521,6 +2779,68 @@ gfc_complex2int (gfc_expr *src, int kind)
   return result;
 }
 
+/* Convert complex to integer.  */
+
+gfc_expr *
+gfc_complex2uint (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  arith rc;
+  bool did_warn = false;
+
+  if (src->ts.type != BT_COMPLEX)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_UNSIGNED, kind, &src->where);
+
+  gfc_mpfr_to_mpz (result->value.integer, mpc_realref (src->value.complex),
+		   &src->where);
+
+  if ((rc = gfc_check_unsigned_range (result->value.integer, kind)) != ARITH_OK)
+    gfc_warning (OPT_Wconversion, gfc_arith_error (rc), &result->where);
+
+  gfc_reduce_unsigned (result);
+
+  if (warn_conversion || warn_conversion_extra)
+    {
+      int w = warn_conversion ? OPT_Wconversion : OPT_Wconversion_extra;
+
+      /* See if we discarded an imaginary part.  */
+      if (mpfr_cmp_si (mpc_imagref (src->value.complex), 0) != 0)
+	{
+	  gfc_warning_now (w, "Non-zero imaginary part discarded "
+			   "in conversion from %qs to %qs at %L",
+			   gfc_typename(&src->ts), gfc_typename (&result->ts),
+			   &src->where);
+	  did_warn = true;
+	}
+
+      else {
+	mpfr_t f;
+
+	mpfr_init (f);
+	mpfr_frac (f, src->value.real, GFC_RND_MODE);
+	if (mpfr_cmp_si (f, 0) != 0)
+	  {
+	    gfc_warning_now (w, "Change of value in conversion from "
+			     "%qs to %qs at %L", gfc_typename (&src->ts),
+			     gfc_typename (&result->ts), &src->where);
+	    did_warn = true;
+	  }
+	mpfr_clear (f);
+      }
+
+      if (!did_warn && warn_conversion_extra)
+	{
+	  gfc_warning_now (OPT_Wconversion_extra, "Conversion from %qs to %qs "
+			   "at %L", gfc_typename (&src->ts),
+			   gfc_typename (&result->ts), &src->where);
+	}
+    }
+
+  return result;
+}
+
 
 /* Convert complex to real.  */
 
@@ -2695,6 +3015,22 @@ gfc_log2int (gfc_expr *src, int kind)
   return result;
 }
 
+/* Convert logical to unsigned.  */
+
+gfc_expr *
+gfc_log2uint (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+
+  if (src->ts.type != BT_LOGICAL)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_UNSIGNED, kind, &src->where);
+  mpz_set_si (result->value.integer, src->value.logical);
+
+  return result;
+}
+
 
 /* Convert integer to logical.  */
 
@@ -2712,6 +3048,22 @@ gfc_int2log (gfc_expr *src, int kind)
   return result;
 }
 
+/* Convert unsigned to logical.  */
+
+gfc_expr *
+gfc_uint2log (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+
+  if (src->ts.type != BT_UNSIGNED)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_LOGICAL, kind, &src->where);
+  result->value.logical = (mpz_cmp_si (src->value.integer, 0) != 0);
+
+  return result;
+}
+
 /* Convert character to character. We only use wide strings internally,
    so we only set the kind.  */
 
diff --git a/gcc/fortran/arith.h b/gcc/fortran/arith.h
index f2e63bca215..95db799167a 100644
--- a/gcc/fortran/arith.h
+++ b/gcc/fortran/arith.h
@@ -63,15 +63,24 @@ gfc_expr *gfc_le (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
 gfc_expr *gfc_int2int (gfc_expr *, int);
 gfc_expr *gfc_int2real (gfc_expr *, int);
 gfc_expr *gfc_int2complex (gfc_expr *, int);
+gfc_expr *gfc_int2uint (gfc_expr *, int);
+gfc_expr *gfc_uint2uint (gfc_expr *, int);
+gfc_expr *gfc_uint2int (gfc_expr *, int);
+gfc_expr *gfc_uint2real (gfc_expr *, int);
+gfc_expr *gfc_uint2complex (gfc_expr *, int);
 gfc_expr *gfc_real2int (gfc_expr *, int);
+gfc_expr *gfc_real2uint (gfc_expr *, int);
 gfc_expr *gfc_real2real (gfc_expr *, int);
 gfc_expr *gfc_real2complex (gfc_expr *, int);
 gfc_expr *gfc_complex2int (gfc_expr *, int);
+gfc_expr *gfc_complex2uint (gfc_expr *, int);
 gfc_expr *gfc_complex2real (gfc_expr *, int);
 gfc_expr *gfc_complex2complex (gfc_expr *, int);
 gfc_expr *gfc_log2log (gfc_expr *, int);
 gfc_expr *gfc_log2int (gfc_expr *, int);
+gfc_expr *gfc_log2uint (gfc_expr *, int);
 gfc_expr *gfc_int2log (gfc_expr *, int);
+gfc_expr *gfc_uint2log (gfc_expr *, int);
 gfc_expr *gfc_hollerith2int (gfc_expr *, int);
 gfc_expr *gfc_hollerith2real (gfc_expr *, int);
 gfc_expr *gfc_hollerith2complex (gfc_expr *, int);
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 2f50d84b876..1020ba5342f 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -465,7 +465,34 @@ gfc_boz2int (gfc_expr *x, int kind)
   return true;
 }
 
+/* Same as above for UNSIGNED, but much simpler because
+   of wraparound.  */
+bool
+gfc_boz2uint (gfc_expr *x, int kind)
+{
+  int k;
+  if (!is_boz_constant(x))
+    return false;
+
+  mpz_init (x->value.integer);
+  mpz_set_str (x->value.integer, x->boz.str, x->boz.rdx);
+  k = gfc_validate_kind (BT_UNSIGNED, kind, false);
+  if (mpz_cmp (x->value.integer, gfc_unsigned_kinds[k].huge) > 0)
+    {
+      gfc_warning (0, _("BOZ contstant truncated at %L"), &x->where);
+      mpz_and (x->value.integer, x->value.integer, gfc_unsigned_kinds[k].huge);
+    }
+
+  x->ts.type = BT_UNSIGNED;
+  x->ts.kind = kind;
 
+  /* Clear boz info.  */
+  x->boz.rdx = 0;
+  x->boz.len = 0;
+  free (x->boz.str);
+
+  return true;
+}
 /* Make sure an expression is a scalar.  */
 
 static bool
@@ -497,6 +524,20 @@ type_check (gfc_expr *e, int n, bt type)
   return false;
 }
 
+/* Check the type of an expression which can be one of two.  */
+
+static bool
+type_check2 (gfc_expr *e, int n, bt type1, bt type2)
+{
+  if (e->ts.type == type1 || e->ts.type == type2)
+    return true;
+
+  gfc_error ("%qs argument of %qs intrinsic at %L must be %s or %s",
+	     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
+	     &e->where, gfc_basic_typename (type1), gfc_basic_typename (type2));
+
+  return false;
+}
 
 /* Check that the expression is a numeric type.  */
 
@@ -548,6 +589,23 @@ int_or_real_check (gfc_expr *e, int n)
   return true;
 }
 
+/* Check that an expression is integer or real... or unsigned.  */
+
+static bool
+int_or_real_or_unsigned_check (gfc_expr *e, int n)
+{
+  if (e->ts.type != BT_INTEGER && e->ts.type != BT_REAL
+      && e->ts.type != BT_UNSIGNED)
+    {
+      gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER, "
+		 "REAL or UNSIGNED", gfc_current_intrinsic_arg[n]->name,
+		 gfc_current_intrinsic, &e->where);
+      return false;
+    }
+
+  return true;
+}
+
 /* Check that an expression is integer or real; allow character for
    F2003 or later.  */
 
@@ -855,14 +913,20 @@ static bool
 less_than_bitsizekind (const char *arg, gfc_expr *expr, int k)
 {
   int i, val;
+  int bit_size;
 
   if (expr->expr_type != EXPR_CONSTANT)
     return true;
 
-  i = gfc_validate_kind (BT_INTEGER, k, false);
+  i = gfc_validate_kind (expr->ts.type, k, false);
   gfc_extract_int (expr, &val);
 
-  if (val > gfc_integer_kinds[i].bit_size)
+  if (expr->ts.type == BT_INTEGER)
+    bit_size = gfc_integer_kinds[i].bit_size;
+  else
+    bit_size = gfc_unsigned_kinds[i].bit_size;
+
+  if (val > bit_size)
     {
       gfc_error ("%qs at %L must be less than or equal to the BIT_SIZE of "
 		 "INTEGER(KIND=%d)", arg, &expr->where, k);
@@ -881,14 +945,21 @@ less_than_bitsize2 (const char *arg1, gfc_expr *expr1, const char *arg2,
 	       gfc_expr *expr2, const char *arg3, gfc_expr *expr3)
 {
   int i2, i3;
+  int k, bit_size;
 
   if (expr2->expr_type == EXPR_CONSTANT && expr3->expr_type == EXPR_CONSTANT)
     {
       gfc_extract_int (expr2, &i2);
       gfc_extract_int (expr3, &i3);
       i2 += i3;
-      i3 = gfc_validate_kind (BT_INTEGER, expr1->ts.kind, false);
-      if (i2 > gfc_integer_kinds[i3].bit_size)
+      k = gfc_validate_kind (expr1->ts.type, expr1->ts.kind, false);
+
+      if (expr1->ts.type == BT_INTEGER)
+	bit_size = gfc_integer_kinds[k].bit_size;
+      else
+	bit_size = gfc_unsigned_kinds[k].bit_size;
+
+      if (i2 > bit_size)
 	{
 	  gfc_error ("%<%s + %s%> at %L must be less than or equal "
 		     "to BIT_SIZE(%qs)",
@@ -1408,7 +1479,6 @@ gfc_check_allocated (gfc_expr *array)
   return true;
 }
 
-
 /* Common check function where the first argument must be real or
    integer and the second argument must be the same as the first.  */
 
@@ -1437,6 +1507,39 @@ gfc_check_a_p (gfc_expr *a, gfc_expr *p)
   return true;
 }
 
+/* Check function where the first argument must be real or integer (or
+   unsigned) and the second argument must be the same as the first.  */
+
+bool
+gfc_check_mod (gfc_expr *a, gfc_expr *p)
+{
+  if (flag_unsigned)
+    {
+      if (!int_or_real_or_unsigned_check (a,0))
+	return false;
+    }
+  else if (!int_or_real_check (a, 0))
+      return false;
+
+  if (a->ts.type != p->ts.type)
+    {
+      gfc_error ("%qs and %qs arguments of %qs intrinsic at %L must "
+		 "have the same type", gfc_current_intrinsic_arg[0]->name,
+		 gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+		 &p->where);
+      return false;
+    }
+
+  if (a->ts.kind != p->ts.kind)
+    {
+      if (!gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L",
+			   &p->where))
+       return false;
+    }
+
+  return true;
+}
+
 
 bool
 gfc_check_x_yd (gfc_expr *x, gfc_expr *y)
@@ -1957,11 +2060,36 @@ gfc_check_bge_bgt_ble_blt (gfc_expr *i, gfc_expr *j)
       && !gfc_boz2int (j, i->ts.kind))
     return false;
 
-  if (!type_check (i, 0, BT_INTEGER))
-    return false;
+  if (flag_unsigned)
+    {
+      /* If i is BOZ and j is UNSIGNED, convert i to type of j.  */
+      if (i->ts.type == BT_BOZ && j->ts.type == BT_UNSIGNED
+	  && !gfc_boz2uint (i, j->ts.kind))
+	return false;
 
-  if (!type_check (j, 1, BT_INTEGER))
-    return false;
+      /* If j is BOZ and i is UNSIGNED, convert j to type of i.  */
+      if (j->ts.type == BT_BOZ && i->ts.type == BT_UNSIGNED
+	  && !gfc_boz2uint (j, i->ts.kind))
+	return false;
+
+      if (gfc_invalid_unsigned_ops (i,j))
+	return false;
+
+      if (!type_check2 (i, 0, BT_INTEGER, BT_UNSIGNED))
+	return false;
+
+      if (!type_check2 (j, 1, BT_INTEGER, BT_UNSIGNED))
+	return false;
+
+    }
+  else
+    {
+      if (!type_check (i, 0, BT_INTEGER))
+	return false;
+
+      if (!type_check (j, 1, BT_INTEGER))
+	return false;
+    }
 
   return true;
 }
@@ -1970,8 +2098,16 @@ gfc_check_bge_bgt_ble_blt (gfc_expr *i, gfc_expr *j)
 bool
 gfc_check_bitfcn (gfc_expr *i, gfc_expr *pos)
 {
-  if (!type_check (i, 0, BT_INTEGER))
-    return false;
+  if (flag_unsigned)
+    {
+      if (!type_check2 (i, 0, BT_INTEGER, BT_UNSIGNED))
+	return false;
+    }
+  else
+    {
+      if (!type_check (i, 0, BT_INTEGER))
+	return false;
+    }
 
   if (!type_check (pos, 1, BT_INTEGER))
     return false;
@@ -2642,7 +2778,13 @@ gfc_check_dble (gfc_expr *x)
 bool
 gfc_check_digits (gfc_expr *x)
 {
-  if (!int_or_real_check (x, 0))
+
+  if (flag_unsigned)
+    {
+      if (!int_or_real_or_unsigned_check (x, 0))
+	return false;
+    }
+  else if (!int_or_real_check (x, 0))
     return false;
 
   return true;
@@ -2725,33 +2867,54 @@ gfc_check_dshift (gfc_expr *i, gfc_expr *j, gfc_expr *shift)
   if (!boz_args_check (i, j))
     return false;
 
-  /* If i is BOZ and j is integer, convert i to type of j.  If j is not
-     an integer, clear the BOZ; otherwise, check that i is an integer.  */
   if (i->ts.type == BT_BOZ)
     {
-      if (j->ts.type != BT_INTEGER)
-        reset_boz (i);
-      else if (!gfc_boz2int (i, j->ts.kind))
-	return false;
+      if (j->ts.type == BT_INTEGER)
+	{
+	  if (!gfc_boz2int (i, j->ts.kind))
+	    return false;
+	}
+      else if (flag_unsigned && j->ts.type == BT_UNSIGNED)
+	{
+	  if (!gfc_boz2uint (i, j->ts.kind))
+	    return false;
+	}
+      else
+	reset_boz (i);
     }
-  else if (!type_check (i, 0, BT_INTEGER))
+
+  if (j->ts.type == BT_BOZ)
     {
-      if (j->ts.type == BT_BOZ)
+      if (i->ts.type == BT_INTEGER)
+	{
+	  if (!gfc_boz2int (j, i->ts.kind))
+	    return false;
+	}
+      else if (flag_unsigned && i->ts.type == BT_UNSIGNED)
+	{
+	  if (!gfc_boz2uint (j, i->ts.kind))
+	    return false;
+	}
+      else
 	reset_boz (j);
-      return false;
     }
 
-  /* If j is BOZ and i is integer, convert j to type of i.  If i is not
-     an integer, clear the BOZ; otherwise, check that i is an integer.  */
-  if (j->ts.type == BT_BOZ)
+  if (flag_unsigned)
     {
-      if (i->ts.type != BT_INTEGER)
-        reset_boz (j);
-      else if (!gfc_boz2int (j, i->ts.kind))
+      if (!type_check2 (i, 0, BT_INTEGER, BT_UNSIGNED))
+	return false;
+
+      if (!type_check2 (j, 1, BT_INTEGER, BT_UNSIGNED))
+	return false;
+    }
+  else
+    {
+      if (!type_check (i, 0, BT_INTEGER))
+	return false;
+
+      if (!type_check (j, 1, BT_INTEGER))
 	return false;
     }
-  else if (!type_check (j, 1, BT_INTEGER))
-    return false;
 
   if (!same_type_check (i, 0, j, 1))
     return false;
@@ -3022,7 +3185,12 @@ gfc_check_fnum (gfc_expr *unit)
 bool
 gfc_check_huge (gfc_expr *x)
 {
-  if (!int_or_real_check (x, 0))
+  if (flag_unsigned)
+    {
+      if (!int_or_real_or_unsigned_check (x, 0))
+	return false;
+    }
+  else if (!int_or_real_check (x, 0))
     return false;
 
   return true;
@@ -3052,6 +3220,21 @@ gfc_check_i (gfc_expr *i)
   return true;
 }
 
+/* Check that the single argument is an integer or an UNSIGNED.  */
+
+bool
+gfc_check_iu (gfc_expr *i)
+{
+  if (flag_unsigned)
+    {
+      if (!type_check2 (i, 0, BT_INTEGER, BT_UNSIGNED))
+	return false;
+    }
+  else if (!type_check (i, 0, BT_INTEGER))
+    return false;
+
+  return true;
+}
 
 bool
 gfc_check_iand_ieor_ior (gfc_expr *i, gfc_expr *j)
@@ -3070,11 +3253,35 @@ gfc_check_iand_ieor_ior (gfc_expr *i, gfc_expr *j)
       && !gfc_boz2int (j, i->ts.kind))
     return false;
 
-  if (!type_check (i, 0, BT_INTEGER))
-    return false;
+  if (flag_unsigned)
+    {
+      /* If i is BOZ and j is UNSIGNED, convert i to type of j.  */
+      if (i->ts.type == BT_BOZ && j->ts.type == BT_UNSIGNED
+	  && !gfc_boz2uint (i, j->ts.kind))
+	return false;
 
-  if (!type_check (j, 1, BT_INTEGER))
-    return false;
+      /* If j is BOZ and i is UNSIGNED, convert j to type of i.  */
+      if (j->ts.type == BT_BOZ && i->ts.type == BT_UNSIGNED
+	  && !gfc_boz2uint (j, i->ts.kind))
+	return false;
+
+      if (gfc_invalid_unsigned_ops (i,j))
+	return false;
+
+      if (!type_check2 (i, 0, BT_INTEGER, BT_UNSIGNED))
+	return false;
+
+      if (!type_check2 (j, 1, BT_INTEGER, BT_UNSIGNED))
+	return false;
+    }
+  else
+    {
+      if (!type_check (i, 0, BT_INTEGER))
+	return false;
+
+      if (!type_check (j, 1, BT_INTEGER))
+	return false;
+    }
 
   if (i->ts.kind != j->ts.kind)
     {
@@ -3090,8 +3297,16 @@ gfc_check_iand_ieor_ior (gfc_expr *i, gfc_expr *j)
 bool
 gfc_check_ibits (gfc_expr *i, gfc_expr *pos, gfc_expr *len)
 {
-  if (!type_check (i, 0, BT_INTEGER))
-    return false;
+  if (flag_unsigned)
+    {
+      if (!type_check2 (i, 0, BT_INTEGER, BT_UNSIGNED))
+	return false;
+    }
+  else
+    {
+      if (!type_check (i, 0, BT_INTEGER))
+	return false;
+    }
 
   if (!type_check (pos, 1, BT_INTEGER))
     return false;
@@ -3240,6 +3455,29 @@ gfc_check_int (gfc_expr *x, gfc_expr *kind)
   return true;
 }
 
+bool
+gfc_check_uint (gfc_expr *x, gfc_expr *kind)
+{
+
+  if (!flag_unsigned)
+    {
+      gfc_error ("UINT intrinsic only valid with %<-funsigned%> at %L",
+		 &x->where);
+      return false;
+    }
+
+  /* BOZ is dealt within simplify_uint*.  */
+  if (x->ts.type == BT_BOZ)
+    return true;
+
+  if (!numeric_check (x, 0))
+    return false;
+
+  if (!kind_check (kind, 1, BT_INTEGER))
+    return false;
+
+  return true;
+}
 
 bool
 gfc_check_intconv (gfc_expr *x)
@@ -3266,8 +3504,18 @@ gfc_check_intconv (gfc_expr *x)
 bool
 gfc_check_ishft (gfc_expr *i, gfc_expr *shift)
 {
-  if (!type_check (i, 0, BT_INTEGER)
-      || !type_check (shift, 1, BT_INTEGER))
+  if (flag_unsigned)
+    {
+      if (!type_check2 (i, 0, BT_INTEGER, BT_UNSIGNED))
+	return false;
+    }
+  else
+    {
+      if (!type_check (i, 0, BT_INTEGER))
+	return false;
+    }
+
+  if (!type_check (shift, 1, BT_INTEGER))
     return false;
 
   if (!less_than_bitsize1 ("I", i, NULL, shift, true))
@@ -3280,9 +3528,16 @@ gfc_check_ishft (gfc_expr *i, gfc_expr *shift)
 bool
 gfc_check_ishftc (gfc_expr *i, gfc_expr *shift, gfc_expr *size)
 {
-  if (!type_check (i, 0, BT_INTEGER)
-      || !type_check (shift, 1, BT_INTEGER))
-    return false;
+  if (flag_unsigned)
+    {
+      if (!type_check2 (i, 0, BT_INTEGER, BT_UNSIGNED))
+	return false;
+    }
+  else
+    {
+      if (!type_check (i, 0, BT_INTEGER))
+	return false;
+    }
 
   if (size != NULL)
     {
@@ -3756,11 +4011,29 @@ gfc_check_min_max (gfc_actual_arglist *arg)
 			   gfc_current_intrinsic, &x->where))
 	return false;
     }
-  else if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL)
+  else
     {
-      gfc_error ("%<a1%> argument of %qs intrinsic at %L must be INTEGER, "
-		 "REAL or CHARACTER", gfc_current_intrinsic, &x->where);
-      return false;
+      if (flag_unsigned)
+	{
+	  if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL
+	      && x->ts.type != BT_UNSIGNED)
+	    {
+	      gfc_error ("%<a1%> argument of %qs intrinsic at %L must be "
+			 "INTEGER, REAL, CHARACTER or UNSIGNED",
+			 gfc_current_intrinsic, &x->where);
+	      return false;
+	    }
+	}
+      else
+	{
+	  if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL)
+	    {
+	      gfc_error ("%<a1%> argument of %qs intrinsic at %L must be "
+			 "INTEGER, REAL or CHARACTER",
+			 gfc_current_intrinsic, &x->where);
+	      return false;
+	    }
+	}
     }
 
   return check_rest (x->ts.type, x->ts.kind, arg);
@@ -4202,20 +4475,54 @@ gfc_check_merge_bits (gfc_expr *i, gfc_expr *j, gfc_expr *mask)
       && !gfc_boz2int (j, i->ts.kind))
     return false;
 
-  if (!type_check (i, 0, BT_INTEGER))
-    return false;
+  if (flag_unsigned)
+    {
+      /* If i is BOZ and j is unsigned, convert i to type of j.  */
+      if (i->ts.type == BT_BOZ && j->ts.type == BT_UNSIGNED
+	  && !gfc_boz2uint (i, j->ts.kind))
+	return false;
 
-  if (!type_check (j, 1, BT_INTEGER))
-    return false;
+      /* If j is BOZ and i is unsigned, convert j to type of i.  */
+      if (j->ts.type == BT_BOZ && i->ts.type == BT_UNSIGNED
+	  && !gfc_boz2int (j, i->ts.kind))
+	return false;
+
+      if (!type_check2 (i, 0, BT_INTEGER, BT_UNSIGNED))
+	return false;
+
+      if (!type_check2 (j, 1, BT_INTEGER, BT_UNSIGNED))
+	return false;
+    }
+  else
+    {
+      if (!type_check (i, 0, BT_INTEGER))
+	return false;
+
+      if (!type_check (j, 1, BT_INTEGER))
+	return false;
+    }
 
   if (!same_type_check (i, 0, j, 1))
     return false;
 
-  if (mask->ts.type == BT_BOZ && !gfc_boz2int(mask, i->ts.kind))
-    return false;
+  if (mask->ts.type == BT_BOZ)
+    {
+      if (i->ts.type == BT_INTEGER && !gfc_boz2int (mask, i->ts.kind))
+	return false;
+      if (i->ts.type == BT_UNSIGNED && !gfc_boz2uint (mask, i->ts.kind))
+	return false;
+    }
 
-  if (!type_check (mask, 2, BT_INTEGER))
-    return false;
+  if (flag_unsigned)
+    {
+      if (!type_check2 (mask, 2, BT_INTEGER, BT_UNSIGNED))
+	return false;
+    }
+  else
+    {
+      if (!type_check (mask, 2, BT_INTEGER))
+	return false;
+    }
 
   if (!same_type_check (i, 0, mask, 2))
     return false;
@@ -5012,7 +5319,6 @@ gfc_check_selected_int_kind (gfc_expr *r)
   return true;
 }
 
-
 bool
 gfc_check_selected_real_kind (gfc_expr *p, gfc_expr *r, gfc_expr *radix)
 {
@@ -5108,8 +5414,16 @@ gfc_check_shape (gfc_expr *source, gfc_expr *kind)
 bool
 gfc_check_shift (gfc_expr *i, gfc_expr *shift)
 {
-  if (!type_check (i, 0, BT_INTEGER))
-    return false;
+  if (flag_unsigned)
+    {
+      if (!type_check2 (i, 0, BT_INTEGER, BT_UNSIGNED))
+	return false;
+    }
+  else
+    {
+      if (!type_check (i, 0, BT_INTEGER))
+	return false;
+    }
 
   if (!type_check (shift, 0, BT_INTEGER))
     return false;
@@ -6604,8 +6918,17 @@ bool
 gfc_check_mvbits (gfc_expr *from, gfc_expr *frompos, gfc_expr *len,
 		  gfc_expr *to, gfc_expr *topos)
 {
-  if (!type_check (from, 0, BT_INTEGER))
-    return false;
+
+  if (flag_unsigned)
+    {
+      if (!type_check2 (from, 0, BT_INTEGER, BT_UNSIGNED))
+	return false;
+    }
+  else
+    {
+      if (!type_check (from, 0, BT_INTEGER))
+	return false;
+    }
 
   if (!type_check (frompos, 1, BT_INTEGER))
     return false;
@@ -7637,3 +7960,12 @@ gfc_check_storage_size (gfc_expr *a, gfc_expr *kind)
 
   return true;
 }
+
+/* Check two operands that either both or none of them can
+   be UNSIGNED.  */
+
+bool
+gfc_invalid_unsigned_ops (gfc_expr * op1, gfc_expr * op2)
+{
+  return (op1->ts.type == BT_UNSIGNED) + (op2->ts.type == BT_UNSIGNED) == 1;
+}
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index b8308aeee55..cc358f09b83 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -4342,6 +4342,17 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
       goto get_kind;
     }
 
+  if (flag_unsigned)
+    {
+      if ((matched_type && strcmp ("unsigned", name) == 0)
+	  || (!matched_type && gfc_match (" unsigned") == MATCH_YES))
+	{
+	  ts->type = BT_UNSIGNED;
+	  ts->kind = gfc_default_integer_kind;
+	  goto get_kind;
+	}
+    }
+
   if ((matched_type && strcmp ("character", name) == 0)
       || (!matched_type && gfc_match (" character") == MATCH_YES))
     {
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 80aa8ef84e7..e94dc495708 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -563,6 +563,14 @@ show_expr (gfc_expr *p)
 	    fprintf (dumpfile, "_%d", p->ts.kind);
 	  break;
 
+	case BT_UNSIGNED:
+	  mpz_out_str (dumpfile, 10, p->value.integer);
+	  fputc('u', dumpfile);
+
+	  if (p->ts.kind != gfc_default_integer_kind)
+	    fprintf (dumpfile, "_%d", p->ts.kind);
+	  break;
+
 	case BT_LOGICAL:
 	  if (p->value.logical)
 	    fputs (".true.", dumpfile);
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index be138d196a2..226e9da9a44 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -159,6 +159,7 @@ gfc_get_constant_expr (bt type, int kind, locus *where)
   switch (type)
     {
     case BT_INTEGER:
+    case BT_UNSIGNED:
       mpz_init (e->value.integer);
       break;
 
@@ -296,6 +297,7 @@ gfc_copy_expr (gfc_expr *p)
       switch (q->ts.type)
 	{
 	case BT_INTEGER:
+	case BT_UNSIGNED:
 	  mpz_init_set (q->value.integer, p->value.integer);
 	  break;
 
@@ -696,7 +698,6 @@ gfc_extract_int (gfc_expr *expr, int *result, int report_error)
   return false;
 }
 
-
 /* Same as gfc_extract_int, but use a HWI.  */
 
 bool
@@ -899,7 +900,8 @@ gfc_kind_max (gfc_expr *e1, gfc_expr *e2)
 static bool
 numeric_type (bt type)
 {
-  return type == BT_COMPLEX || type == BT_REAL || type == BT_INTEGER;
+  return type == BT_COMPLEX || type == BT_REAL || type == BT_INTEGER
+    || type == BT_UNSIGNED;
 }
 
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 8d89797412e..ff298af015b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -227,7 +227,8 @@ enum gfc_intrinsic_op
 enum arith
 { ARITH_OK = 1, ARITH_OVERFLOW, ARITH_UNDERFLOW, ARITH_NAN,
   ARITH_DIV0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC, ARITH_PROHIBIT,
-  ARITH_WRONGCONCAT, ARITH_INVALID_TYPE, ARITH_NOT_REDUCED
+  ARITH_WRONGCONCAT, ARITH_INVALID_TYPE, ARITH_NOT_REDUCED,
+  ARITH_UNSIGNED_TRUNCATED, ARITH_UNSIGNED_NEGATIVE
 };
 
 /* Statements.  */
@@ -705,7 +706,12 @@ enum gfc_isym_id
   GFC_ISYM_Y0,
   GFC_ISYM_Y1,
   GFC_ISYM_YN,
-  GFC_ISYM_YN2
+  GFC_ISYM_YN2,
+
+  /* Add this at the end, so maybe the module format
+     remains compatible.  */
+  GFC_ISYM_SU_KIND,
+  GFC_ISYM_UINT,
 };
 
 enum init_local_logical
@@ -2735,6 +2741,25 @@ gfc_integer_info;
 
 extern gfc_integer_info gfc_integer_kinds[];
 
+/* Unsigned numbers, experimental.  */
+
+typedef struct
+{
+  mpz_t huge, int_min;
+
+  int kind, radix, digits, bit_size, range;
+
+  /* True if the C type of the given name maps to this precision.  Note that
+     more than one bit can be set.  We will use this later on.  */
+  unsigned int c_unsigned_char : 1;
+  unsigned int c_unsigned_short : 1;
+  unsigned int c_unsigned_int : 1;
+  unsigned int c_unsigned_long : 1;
+  unsigned int c_unsigned_long_long : 1;
+}
+gfc_unsigned_info;
+
+extern gfc_unsigned_info gfc_unsigned_kinds[];
 
 typedef struct
 {
@@ -3447,7 +3472,10 @@ void gfc_errors_to_warnings (bool);
 void gfc_arith_init_1 (void);
 void gfc_arith_done_1 (void);
 arith gfc_check_integer_range (mpz_t p, int kind);
+arith gfc_check_unsigned_range (mpz_t p, int kind);
 bool gfc_check_character_range (gfc_char_t, int);
+const char *gfc_arith_error (arith);
+void gfc_reduce_unsigned (gfc_expr *e);
 
 extern bool gfc_seen_div0;
 
@@ -3459,6 +3487,7 @@ tree gfc_get_union_type (gfc_symbol *);
 tree gfc_get_derived_type (gfc_symbol * derived, int codimen = 0);
 extern int gfc_index_integer_kind;
 extern int gfc_default_integer_kind;
+extern int gfc_default_unsigned_kind;
 extern int gfc_max_integer_kind;
 extern int gfc_default_real_kind;
 extern int gfc_default_double_kind;
@@ -4001,10 +4030,12 @@ bool gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
 bool gfc_calculate_transfer_sizes (gfc_expr*, gfc_expr*, gfc_expr*,
 				      size_t*, size_t*, size_t*);
 bool gfc_boz2int (gfc_expr *, int);
+bool gfc_boz2uint (gfc_expr *, int);
 bool gfc_boz2real (gfc_expr *, int);
 bool gfc_invalid_boz (const char *, locus *);
 bool gfc_invalid_null_arg (gfc_expr *);
 
+bool gfc_invalid_unsigned_ops (gfc_expr *, gfc_expr *);
 
 /* class.cc */
 void gfc_fix_class_refs (gfc_expr *e);
@@ -4087,6 +4118,7 @@ void gfc_convert_mpz_to_signed (mpz_t, int);
 gfc_expr *gfc_simplify_ieee_functions (gfc_expr *);
 bool gfc_is_constant_array_expr (gfc_expr *);
 bool gfc_is_size_zero_array (gfc_expr *);
+void gfc_convert_mpz_to_unsigned (mpz_t, int, bool sign = true);
 
 /* trans-array.cc  */
 
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 7e8783a3690..9043fa321dc 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1192,6 +1192,7 @@ extensions.
 @menu
 * Extensions implemented in GNU Fortran::
 * Extensions not implemented in GNU Fortran::
+* Experimental features for Fortran 202Y::
 @end menu
 
 
@@ -2701,7 +2702,90 @@ descriptor occurred, use @code{INQUIRE} to get the file position,
 count the characters up to the next @code{NEW_LINE} and then start
 reading from the position marked previously.
 
+@node Experimental features for Fortran 202Y
+@section Experimental features for Fortran 202Y
+@cindex Fortran 202Y
 
+GNU Fortran supports some experimental features which have been
+proposed and accepted by the J3 standards committee.  These
+exist to give users a chance to try them out, and to provide
+a reference implementation.
+
+As these features have not been finalized, there is a chance that the
+version in the upcoming standard will differ from what GNU Fortran
+currently implements.  Stability of these implementations is therefore
+not guaranteed.
+
+@menu
+* Unsigned integers::
+@end menu
+
+@node Unsigned integers
+@subsection Unsigned integers
+@cindex Unsigned integers
+GNU Fortran supports unsigned integers according to
+@uref{https://j3-fortran.org/doc/year/24/24-116.txt, J3/24-116}.  The
+data type is called @code{UNSIGNED}.  For an unsigned type with $n$ bits,
+it implements integer arithmetic modulo @code{2**n}, comparable to the
+@code{unsigned} data type in C.
+
+The data type has @code{KIND} numbers comparable to other Fortran data
+types, which can be selected via the @code{SELECTED_UNSIGNED_KIND}
+function.
+
+Mixed arithmetic, comparisoins and assignment between @code{UNSIGNED}
+and other types are only possible via explicit conversion.  Conversion
+from @code{UNSIGNED} to other types is done via type conversion
+functions like @code{INT} or @code{REAL}. Conversion from other types
+to @code{UNSIGNED} is done via @code{UINT}. Unsigned variables cannot be
+used as index variables in @code{DO} loops or as array indices.
+
+Unsigned numbers have a trailing @code{u} as suffix, optionally followed
+by a @code{KIND} number separated by an underscore.
+
+Input and output can be done using the @code{I}, @code{B}, @code{O}
+and @code{Z} descriptors, plus unformatted I/O.
+
+Here is a small, somewhat contrived example of their use:
+@smallexample
+program main
+  unsigned(kind=8) :: v
+  v = huge(v) - 32u_8
+  print *,v
+end program main
+@end smallexample
+which will output the number 18446744073709551583.
+
+Arithmetic operations work on unsigned integers, except for exponentiation,
+which is prohibited.  Unary minus is not permitted when @code{-predantic}
+is in force; this prohibition is part of J3/24-116.txt.
+
+Generally, unsigned integers are only permitted as data in intrinsics.
+
+Unsigned numbers can be read and written using list-directed,
+formatted and unformatted I/O.  For formatted I/O, the @code{B},
+@code{I}, @code{O} and @code{Z} descriptors are valid.  Negative
+values and values which would overflow are rejected with
+@code{-pedantic}.
+
+As of now, the following intrinsics take unsigned arguments:
+@itemize @bullet
+@item @code{BLT}, @code{BLE}, @code{BGE} and @code{BGT}. These intrinsics
+      are actually redundant because comparison operators could be used
+      directly.
+@item @code{IAND}, @code{IOR}, @code{IEOR} and @code{NOT}
+@item @code{BIT_SIZE}, @code{DIGITS} and @code{HUGE}
+@item @code{DSHIFTL} and @code{DSHIFTR}
+@item @code{IBCLR}, @code{IBITS} and @code{IBITS}
+@item @code{MIN} and @code{MAX}
+@item @code{ISHFT}, @code{ISHFTC}, @code{SHIFTL}, @code{SHIFTR} and @code{SHIFTA}.
+@item @code{MERGE_BITS}
+@item @code{MOD} and @code{MODULO}
+@item @code{MVBITS}
+@item @code{RANGE}
+@item @code{TRANSFER}
+@end itemize
+This list will grow in the near future.
 @c ---------------------------------------------------------------------
 @c ---------------------------------------------------------------------
 @c Mixed-Language Programming
diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc
index 40f4c4f4b0b..926ac44dfd4 100644
--- a/gcc/fortran/intrinsic.cc
+++ b/gcc/fortran/intrinsic.cc
@@ -95,6 +95,12 @@ gfc_type_letter (bt type, bool logical_equals_int)
       c = 'h';
       break;
 
+      /* 'u' would be the logical choice, but it is used for
+	 "unknown", let's use m for "modulo".  */
+    case BT_UNSIGNED:
+      c = 'm';
+      break;
+
     default:
       c = 'u';
       break;
@@ -1655,7 +1661,7 @@ add_functions (void)
   make_generic ("bgt", GFC_ISYM_BGT, GFC_STD_F2008);
 
   add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
-	     gfc_check_i, gfc_simplify_bit_size, NULL,
+	     gfc_check_iu, gfc_simplify_bit_size, NULL,
 	     i, BT_INTEGER, di, REQUIRED);
 
   make_generic ("bit_size", GFC_ISYM_BIT_SIZE, GFC_STD_F95);
@@ -2256,6 +2262,12 @@ add_functions (void)
 
   make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
 
+  add_sym_2 ("uint", GFC_ISYM_UINT, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNSIGNED, di, GFC_STD_GNU,
+	     gfc_check_uint, gfc_simplify_uint, gfc_resolve_uint,
+	     a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("uint", GFC_ISYM_UINT, GFC_STD_GNU);
+
   add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
 	     GFC_STD_F95,
 	     gfc_check_iand_ieor_ior, gfc_simplify_ior, gfc_resolve_ior,
@@ -2685,7 +2697,7 @@ add_functions (void)
   make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
 
   add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
-	     gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
+	     gfc_check_mod, gfc_simplify_mod, gfc_resolve_mod,
 	     a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
 
   if (flag_dec_intrinsic_ints)
@@ -2707,7 +2719,7 @@ add_functions (void)
   make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
 
   add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
-	     gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
+	     gfc_check_mod, gfc_simplify_modulo, gfc_resolve_modulo,
 	     a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
 
   make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
@@ -2735,7 +2747,7 @@ add_functions (void)
   make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
 
   add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
-	     gfc_check_i, gfc_simplify_not, gfc_resolve_not,
+	     gfc_check_iu, gfc_simplify_not, gfc_resolve_not,
 	     i, BT_INTEGER, di, REQUIRED);
 
   if (flag_dec_intrinsic_ints)
@@ -2784,14 +2796,14 @@ add_functions (void)
 
   add_sym_1 ("popcnt", GFC_ISYM_POPCNT, CLASS_ELEMENTAL, ACTUAL_NO,
 	     BT_INTEGER, di, GFC_STD_F2008,
-	     gfc_check_i, gfc_simplify_popcnt, NULL,
+	     gfc_check_iu, gfc_simplify_popcnt, NULL,
 	     i, BT_INTEGER, di, REQUIRED);
 
   make_generic ("popcnt", GFC_ISYM_POPCNT, GFC_STD_F2008);
 
   add_sym_1 ("poppar", GFC_ISYM_POPPAR, CLASS_ELEMENTAL, ACTUAL_NO,
 	     BT_INTEGER, di, GFC_STD_F2008,
-	     gfc_check_i, gfc_simplify_poppar, NULL,
+	     gfc_check_iu, gfc_simplify_poppar, NULL,
 	     i, BT_INTEGER, di, REQUIRED);
 
   make_generic ("poppar", GFC_ISYM_POPPAR, GFC_STD_F2008);
@@ -2952,6 +2964,16 @@ add_functions (void)
 
   make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
 
+  if (flag_unsigned)
+    {
+
+      add_sym_1 ("selected_unsigned_kind", GFC_ISYM_SU_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
+		 BT_INTEGER, di, GFC_STD_GNU, gfc_check_selected_int_kind,
+		 gfc_simplify_selected_unsigned_kind, NULL, r, BT_INTEGER, di, REQUIRED);
+
+      make_generic ("selected_unsigned_kind", GFC_ISYM_SU_KIND, GFC_STD_GNU);
+    }
+
   add_sym_1 ("selected_logical_kind", GFC_ISYM_SL_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
 	     GFC_STD_F2023, /* it has the same requirements */ gfc_check_selected_int_kind,
 	     gfc_simplify_selected_logical_kind, NULL, r, BT_INTEGER, di, REQUIRED);
@@ -4043,6 +4065,15 @@ add_conversions (void)
 		  BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
       }
 
+  if (flag_unsigned)
+    {
+      for (i = 0; gfc_unsigned_kinds[i].kind != 0; i++)
+	for (j = 0; gfc_unsigned_kinds[j].kind != 0; j++)
+	  if (i != j)
+	    add_conv (BT_UNSIGNED, gfc_unsigned_kinds[i].kind,
+		      BT_UNSIGNED, gfc_unsigned_kinds[j].kind, GFC_STD_GNU);
+    }
+
   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
     {
       /* Hollerith-Integer conversions.  */
@@ -5316,7 +5347,8 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag,
       else if (from_ts.type == ts->type
 	       || (from_ts.type == BT_INTEGER && ts->type == BT_REAL)
 	       || (from_ts.type == BT_INTEGER && ts->type == BT_COMPLEX)
-	       || (from_ts.type == BT_REAL && ts->type == BT_COMPLEX))
+	       || (from_ts.type == BT_REAL && ts->type == BT_COMPLEX)
+	       || (from_ts.type == BT_UNSIGNED && ts->type == BT_UNSIGNED))
 	{
 	  /* Larger kinds can hold values of smaller kinds without problems.
 	     Hence, only warn if target kind is smaller than the source
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 2c287caa6ad..ea29219819d 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -89,6 +89,7 @@ bool gfc_check_hostnm (gfc_expr *);
 bool gfc_check_huge (gfc_expr *);
 bool gfc_check_hypot (gfc_expr *, gfc_expr *);
 bool gfc_check_i (gfc_expr *);
+bool gfc_check_iu (gfc_expr *);
 bool gfc_check_iand_ieor_ior (gfc_expr *, gfc_expr *);
 bool gfc_check_and (gfc_expr *, gfc_expr *);
 bool gfc_check_ibits (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -98,6 +99,7 @@ bool gfc_check_image_status (gfc_expr *, gfc_expr *);
 bool gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_int (gfc_expr *, gfc_expr *);
 bool gfc_check_intconv (gfc_expr *);
+bool gfc_check_uint (gfc_expr *, gfc_expr *);
 bool gfc_check_irand (gfc_expr *);
 bool gfc_check_is_contiguous (gfc_expr *);
 bool gfc_check_isatty (gfc_expr *);
@@ -124,6 +126,7 @@ bool gfc_check_merge (gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_merge_bits (gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_minloc_maxloc (gfc_actual_arglist *);
 bool gfc_check_minval_maxval (gfc_actual_arglist *);
+bool gfc_check_mod (gfc_expr *, gfc_expr *);
 bool gfc_check_nearest (gfc_expr *, gfc_expr *);
 bool gfc_check_new_line (gfc_expr *);
 bool gfc_check_norm2 (gfc_expr *, gfc_expr *);
@@ -324,6 +327,7 @@ gfc_expr *gfc_simplify_image_index (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_image_status (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_int (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_uint (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_int2 (gfc_expr *);
 gfc_expr *gfc_simplify_int8 (gfc_expr *);
 gfc_expr *gfc_simplify_long (gfc_expr *);
@@ -399,6 +403,7 @@ gfc_expr *gfc_simplify_scale (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_selected_char_kind (gfc_expr *);
 gfc_expr *gfc_simplify_selected_int_kind (gfc_expr *);
+gfc_expr *gfc_simplify_selected_unsigned_kind (gfc_expr *);
 gfc_expr *gfc_simplify_selected_logical_kind (gfc_expr *);
 gfc_expr *gfc_simplify_selected_real_kind (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_set_exponent (gfc_expr *, gfc_expr *);
@@ -530,6 +535,7 @@ void gfc_resolve_iall (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_iany (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_idnint (gfc_expr *, gfc_expr *);
 void gfc_resolve_int (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_uint (gfc_expr *, gfc_expr*, gfc_expr *);
 void gfc_resolve_int2 (gfc_expr *, gfc_expr *);
 void gfc_resolve_int8 (gfc_expr *, gfc_expr *);
 void gfc_resolve_long (gfc_expr *, gfc_expr *);
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 6bc42afe2c4..dcb5782ef4b 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -129,7 +129,7 @@ by type.  Explanations are in the following sections.
 -fmodule-private -ffixed-form -fno-range-check -fopenacc -fopenmp
 -fopenmp-allocators -fopenmp-simd -freal-4-real-10 -freal-4-real-16
 -freal-4-real-8 -freal-8-real-10 -freal-8-real-16 -freal-8-real-4
--std=@var{std} -ftest-forall-temp
+-std=@var{std} -ftest-forall-temp -funsigned
 }
 
 @item Preprocessing Options
@@ -611,6 +611,9 @@ earlier gfortran versions and should not be used any more.
 @item -ftest-forall-temp
 Enhance test coverage by forcing most forall assignments to use temporary.
 
+@opindex @code{funsigned}
+@item -funsigned
+Allow the experimental unsigned extension.
 @end table
 
 @node Preprocessing Options
diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index c63a4a8d38c..f466a473f15 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -895,11 +895,13 @@ void
 gfc_resolve_dshift (gfc_expr *f, gfc_expr *i, gfc_expr *j ATTRIBUTE_UNUSED,
 		    gfc_expr *shift ATTRIBUTE_UNUSED)
 {
+  char c = i->ts.type == BT_INTEGER ? 'i' : 'u';
+
   f->ts = i->ts;
   if (f->value.function.isym->id == GFC_ISYM_DSHIFTL)
-    f->value.function.name = gfc_get_string ("dshiftl_i%d", f->ts.kind);
+    f->value.function.name = gfc_get_string ("dshiftl_%c%d", c, f->ts.kind);
   else if (f->value.function.isym->id == GFC_ISYM_DSHIFTR)
-    f->value.function.name = gfc_get_string ("dshiftr_i%d", f->ts.kind);
+    f->value.function.name = gfc_get_string ("dshiftr_%c%d", c, f->ts.kind);
   else
     gcc_unreachable ();
 }
@@ -1182,6 +1184,7 @@ gfc_resolve_iand (gfc_expr *f, gfc_expr *i, gfc_expr *j)
   /* If the kind of i and j are different, then g77 cross-promoted the
      kinds to the largest value.  The Fortran 95 standard requires the
      kinds to match.  */
+
   if (i->ts.kind != j->ts.kind)
     {
       if (i->ts.kind == gfc_kind_max (i, j))
@@ -1191,7 +1194,8 @@ gfc_resolve_iand (gfc_expr *f, gfc_expr *i, gfc_expr *j)
     }
 
   f->ts = i->ts;
-  f->value.function.name = gfc_get_string ("__iand_%d", i->ts.kind);
+  const char *name = i->ts.kind == BT_UNSIGNED ? "__iand_m_%d" : "__iand_%d";
+  f->value.function.name = gfc_get_string (name, i->ts.kind);
 }
 
 
@@ -1206,7 +1210,8 @@ void
 gfc_resolve_ibclr (gfc_expr *f, gfc_expr *i, gfc_expr *pos ATTRIBUTE_UNUSED)
 {
   f->ts = i->ts;
-  f->value.function.name = gfc_get_string ("__ibclr_%d", i->ts.kind);
+  const char *name = i->ts.kind == BT_UNSIGNED ? "__ibclr_m_%d" : "__ibclr_%d";
+  f->value.function.name = gfc_get_string (name, i->ts.kind);
 }
 
 
@@ -1215,7 +1220,8 @@ gfc_resolve_ibits (gfc_expr *f, gfc_expr *i, gfc_expr *pos ATTRIBUTE_UNUSED,
 		   gfc_expr *len ATTRIBUTE_UNUSED)
 {
   f->ts = i->ts;
-  f->value.function.name = gfc_get_string ("__ibits_%d", i->ts.kind);
+  const char *name = i->ts.kind == BT_UNSIGNED ? "__ibits_m_%d" : "__ibits_%d";
+  f->value.function.name = gfc_get_string (name, i->ts.kind);
 }
 
 
@@ -1223,7 +1229,8 @@ void
 gfc_resolve_ibset (gfc_expr *f, gfc_expr *i, gfc_expr *pos ATTRIBUTE_UNUSED)
 {
   f->ts = i->ts;
-  f->value.function.name = gfc_get_string ("__ibset_%d", i->ts.kind);
+  const char *name = i->ts.kind == BT_UNSIGNED ? "__ibset_m_%d" : "__ibset_%d";
+  f->value.function.name = gfc_get_string (name, i->ts.kind);
 }
 
 
@@ -1273,6 +1280,7 @@ gfc_resolve_ieor (gfc_expr *f, gfc_expr *i, gfc_expr *j)
   /* If the kind of i and j are different, then g77 cross-promoted the
      kinds to the largest value.  The Fortran 95 standard requires the
      kinds to match.  */
+
   if (i->ts.kind != j->ts.kind)
     {
       if (i->ts.kind == gfc_kind_max (i, j))
@@ -1281,8 +1289,9 @@ gfc_resolve_ieor (gfc_expr *f, gfc_expr *i, gfc_expr *j)
 	gfc_convert_type (i, &j->ts, 2);
     }
 
+  const char *name = i->ts.kind == BT_UNSIGNED ? "__ieor_m_%d" : "__ieor_%d";
   f->ts = i->ts;
-  f->value.function.name = gfc_get_string ("__ieor_%d", i->ts.kind);
+  f->value.function.name = gfc_get_string (name, i->ts.kind);
 }
 
 
@@ -1292,6 +1301,7 @@ gfc_resolve_ior (gfc_expr *f, gfc_expr *i, gfc_expr *j)
   /* If the kind of i and j are different, then g77 cross-promoted the
      kinds to the largest value.  The Fortran 95 standard requires the
      kinds to match.  */
+
   if (i->ts.kind != j->ts.kind)
     {
       if (i->ts.kind == gfc_kind_max (i, j))
@@ -1300,8 +1310,9 @@ gfc_resolve_ior (gfc_expr *f, gfc_expr *i, gfc_expr *j)
 	gfc_convert_type (i, &j->ts, 2);
     }
 
+  const char *name = i->ts.kind == BT_UNSIGNED ? "__ior_m_%d" : "__ior_%d";
   f->ts = i->ts;
-  f->value.function.name = gfc_get_string ("__ior_%d", i->ts.kind);
+  f->value.function.name = gfc_get_string (name, i->ts.kind);
 }
 
 
@@ -1345,6 +1356,18 @@ gfc_resolve_int (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
 		      gfc_type_abi_kind (&a->ts));
 }
 
+void
+gfc_resolve_uint (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
+{
+  f->ts.type = BT_UNSIGNED;
+  f->ts.kind = (kind == NULL)
+	     ? gfc_default_integer_kind : mpz_get_si (kind->value.integer);
+  f->value.function.name
+    = gfc_get_string ("__uint_%d_%c%d", f->ts.kind,
+		      gfc_type_letter (a->ts.type),
+		      gfc_type_abi_kind (&a->ts));
+}
+
 
 void
 gfc_resolve_int2 (gfc_expr *f, gfc_expr *a)
@@ -1977,7 +2000,10 @@ gfc_resolve_merge_bits (gfc_expr *f, gfc_expr *i,
 			gfc_expr *mask ATTRIBUTE_UNUSED)
 {
   f->ts = i->ts;
-  f->value.function.name = gfc_get_string ("__merge_bits_i%d", i->ts.kind);
+
+  f->value.function.name =
+    gfc_get_string ("__merge_bits_%c%d", gfc_type_letter (i->ts.type),
+		    i->ts.kind);
 }
 
 
@@ -2213,7 +2239,8 @@ void
 gfc_resolve_not (gfc_expr *f, gfc_expr *i)
 {
   f->ts = i->ts;
-  f->value.function.name = gfc_get_string ("__not_%d", i->ts.kind);
+  const char *name = i->ts.kind == BT_UNSIGNED ? "__not_u_%d" : "__not_%d";
+  f->value.function.name = gfc_get_string (name, i->ts.kind);
 }
 
 
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 5cf7b492254..f5fbe47121c 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -788,6 +788,10 @@ frepack-arrays
 Fortran Var(flag_repack_arrays)
 Copy array sections into a contiguous block on procedure entry.
 
+funsigned
+Fortran Var(flag_unsigned)
+Experimental unsigned numbers.
+
 fcoarray=
 Fortran RejectNegative Joined Enum(gfc_fcoarray) Var(flag_coarray) Init(GFC_FCOARRAY_NONE)
 -fcoarray=<none|single|lib>	Specify which coarray parallelization should be used.
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index 2cb4a5a08ff..895629d6f80 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -190,7 +190,7 @@ typedef enum
 typedef enum
 { BT_UNKNOWN = 0, BT_INTEGER, BT_LOGICAL, BT_REAL, BT_COMPLEX,
   BT_DERIVED, BT_CHARACTER, BT_CLASS, BT_PROCEDURE, BT_HOLLERITH, BT_VOID,
-  BT_ASSUMED, BT_UNION, BT_BOZ
+  BT_ASSUMED, BT_UNION, BT_BOZ, BT_UNSIGNED
 }
 bt;
 
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 1851a8f94a5..e206da95bde 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -2131,6 +2131,13 @@ gfc_match_type_spec (gfc_typespec *ts)
       goto kind_selector;
     }
 
+  if (flag_unsigned && gfc_match ("unsigned") == MATCH_YES)
+    {
+      ts->type = BT_UNSIGNED;
+      ts->kind = gfc_default_integer_kind;
+      goto kind_selector;
+    }
+
   if (gfc_match ("double precision") == MATCH_YES)
     {
       ts->type = BT_REAL;
diff --git a/gcc/fortran/misc.cc b/gcc/fortran/misc.cc
index a365cec9b49..991829516ef 100644
--- a/gcc/fortran/misc.cc
+++ b/gcc/fortran/misc.cc
@@ -70,6 +70,9 @@ gfc_basic_typename (bt type)
     case BT_INTEGER:
       p = "INTEGER";
       break;
+    case BT_UNSIGNED:
+      p = "UNSIGNED";
+      break;
     case BT_REAL:
       p = "REAL";
       break;
@@ -145,6 +148,9 @@ gfc_typename (gfc_typespec *ts, bool for_hash)
       else
 	sprintf (buffer, "INTEGER(%d)", ts->kind);
       break;
+    case BT_UNSIGNED:
+      sprintf (buffer, "UNSIGNED(%d)", ts->kind);
+      break;
     case BT_REAL:
       sprintf (buffer, "REAL(%d)", ts->kind);
       break;
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 76f6bcb8a78..80cbf39a752 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -209,6 +209,44 @@ convert_integer (const char *buffer, int kind, int radix, locus *where)
 }
 
 
+/* Convert an unsigned string to an expression node.  XXX:
+   This needs a calculation modulo 2^n.  TODO: Implement restriction
+   that no unary minus is permitted.  */
+static gfc_expr *
+convert_unsigned (const char *buffer, int kind, int radix, locus *where)
+{
+  gfc_expr *e;
+  const char *t;
+  int k;
+  arith rc;
+
+  e = gfc_get_constant_expr (BT_UNSIGNED, kind, where);
+  /* A leading plus is allowed, but not by mpz_set_str.  */
+  if (buffer[0] == '+')
+    t = buffer + 1;
+  else
+    t = buffer;
+
+  mpz_set_str (e->value.integer, t, radix);
+
+  k = gfc_validate_kind (BT_UNSIGNED, kind, false);
+
+  /* XXX Maybe move this somewhere else.  */
+  rc = gfc_range_check (e);
+  if (rc != ARITH_OK)
+    {
+    if (pedantic)
+      gfc_error_now (gfc_arith_error (rc), &e->where);
+    else
+      gfc_warning (0, gfc_arith_error (rc), &e->where);
+    }
+
+  gfc_convert_mpz_to_unsigned (e->value.integer, gfc_unsigned_kinds[k].bit_size,
+			       false);
+
+  return e;
+}
+
 /* Convert a real string to an expression node.  */
 
 static gfc_expr *
@@ -296,6 +334,71 @@ match_integer_constant (gfc_expr **result, int signflag)
   return MATCH_YES;
 }
 
+/* Match an unsigned constant (an integer with suffixed u).  No sign
+   is currently accepted, in accordance with 24-116.txt, but that
+   could be changed later.  This is very much like the integer
+   constant matching above, but with enough differences to put it into
+   its own function.  */
+
+static match
+match_unsigned_constant (gfc_expr **result)
+{
+  int length, kind, is_iso_c;
+  locus old_loc;
+  char *buffer;
+  gfc_expr *e;
+  match m;
+
+  old_loc = gfc_current_locus;
+  gfc_gobble_whitespace ();
+
+  length = match_digits (/* signflag = */ false, 10, NULL);
+
+  if (length == -1)
+    goto fail;
+
+  m = gfc_match_char ('u');
+  if (m == MATCH_NO)
+    goto fail;
+
+  gfc_current_locus = old_loc;
+
+  buffer = (char *) alloca (length + 1);
+  memset (buffer, '\0', length + 1);
+
+  gfc_gobble_whitespace ();
+
+  match_digits (false, 10, buffer);
+
+  m = gfc_match_char ('u');
+  if (m == MATCH_NO)
+    goto fail;
+
+  kind = get_kind (&is_iso_c);
+  if (kind == -2)
+    kind = gfc_default_unsigned_kind;
+  if (kind == -1)
+    return MATCH_ERROR;
+
+  if (kind == 4 && flag_integer4_kind == 8)
+    kind = 8;
+
+  if (gfc_validate_kind (BT_UNSIGNED, kind, true) < 0)
+    {
+      gfc_error ("Unsigned kind %d at %C not available", kind);
+      return MATCH_ERROR;
+    }
+
+  e = convert_unsigned (buffer, kind, 10, &gfc_current_locus);
+  e->ts.is_c_interop = is_iso_c;
+
+  *result = e;
+  return MATCH_YES;
+
+ fail:
+  gfc_current_locus = old_loc;
+  return MATCH_NO;
+}
 
 /* Match a Hollerith constant.  */
 
@@ -1549,6 +1652,13 @@ gfc_match_literal_constant (gfc_expr **result, int signflag)
   if (m != MATCH_NO)
     return m;
 
+  if (flag_unsigned)
+    {
+      m = match_unsigned_constant (result);
+      if (m != MATCH_NO)
+	return m;
+    }
+
   m = match_integer_constant (result, signflag);
   if (m != MATCH_NO)
     return m;
@@ -4339,4 +4449,3 @@ gfc_match_equiv_variable (gfc_expr **result)
 {
   return match_variable (result, 1, 0);
 }
-
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index eb3085a05ca..f73cb86026c 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -4190,6 +4190,13 @@ resolve_operator (gfc_expr *e)
 		     gfc_op2string (e->value.op.op));
 	  return false;
 	}
+      if (flag_unsigned && pedantic && e->ts.type == BT_UNSIGNED
+	  && e->value.op.op == INTRINSIC_UMINUS)
+	{
+	  gfc_error ("Negation of unsigned expression at %L not permitted ",
+		     &e->value.op.op1->where);
+	  return false;
+	}
       break;
     }
 
@@ -4238,11 +4245,36 @@ resolve_operator (gfc_expr *e)
 		 gfc_op2string (e->value.op.op), &e->where, gfc_typename (e));
       return false;
 
+    case INTRINSIC_POWER:
+
+      if (flag_unsigned)
+	{
+	  if (op1->ts.type == BT_UNSIGNED || op2->ts.type == BT_UNSIGNED)
+	    {
+	      CHECK_INTERFACES
+	      gfc_error ("Exponentiation not valid at %L for %s and %s",
+			 &e->where, gfc_typename (op1), gfc_typename (op2));
+	      return false;
+	    }
+	}
+      gcc_fallthrough();
+
     case INTRINSIC_PLUS:
     case INTRINSIC_MINUS:
     case INTRINSIC_TIMES:
     case INTRINSIC_DIVIDE:
-    case INTRINSIC_POWER:
+
+      /* UNSIGNED cannot appear in a mixed expression without explicit
+	     conversion.  */
+      if (flag_unsigned &&  gfc_invalid_unsigned_ops (op1, op2))
+	{
+	  CHECK_INTERFACES
+	  gfc_error ("Operands of binary numeric operator %<%s%> at %L are %s/%s",
+		     gfc_op2string (e->value.op.op), &e->where,
+		     gfc_typename (op1), gfc_typename (op2));
+	  return false;
+	}
+
       if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts))
 	{
 	  /* Do not perform conversions if operands are not conformable as
@@ -4445,6 +4477,15 @@ resolve_operator (gfc_expr *e)
 	      return false;
 	    }
 
+	  if (flag_unsigned  && gfc_invalid_unsigned_ops (op1, op2))
+	    {
+	      CHECK_INTERFACES
+	      gfc_error ("Inconsistent types for operator at %L and %L: "
+			 "%s and %s", &op1->where, &op2->where,
+			 gfc_typename (op1), gfc_typename (op2));
+	      return false;
+	    }
+
 	  gfc_type_convert_binary (e, 1);
 
 	  e->ts.type = BT_LOGICAL;
@@ -11524,6 +11565,13 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
       return false;
     }
 
+  if (flag_unsigned && gfc_invalid_unsigned_ops (lhs, rhs))
+    {
+      gfc_error (_("Cannot assign %s to %s at %L"), gfc_typename (rhs),
+		   gfc_typename (lhs), &rhs->where);
+      return false;
+    }
+
   /* Handle the case of a BOZ literal on the RHS.  */
   if (rhs->ts.type == BT_BOZ)
     {
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 8ddd491de11..e339f7ebc06 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -147,8 +147,8 @@ get_kind (bt type, gfc_expr *k, const char *name, int default_kind)
    The conversion is a no-op unless x is negative; otherwise, it can
    be accomplished by masking out the high bits.  */
 
-static void
-convert_mpz_to_unsigned (mpz_t x, int bitsize)
+void
+gfc_convert_mpz_to_unsigned (mpz_t x, int bitsize, bool sign)
 {
   mpz_t mask;
 
@@ -156,7 +156,7 @@ convert_mpz_to_unsigned (mpz_t x, int bitsize)
     {
       /* Confirm that no bits above the signed range are unset if we
 	 are doing range checking.  */
-      if (flag_range_check != 0)
+      if (sign && flag_range_check != 0)
 	gcc_assert (mpz_scan0 (x, bitsize-1) == ULONG_MAX);
 
       mpz_init_set_ui (mask, 1);
@@ -171,7 +171,7 @@ convert_mpz_to_unsigned (mpz_t x, int bitsize)
     {
       /* Confirm that no bits above the signed range are set if we
 	 are doing range checking.  */
-      if (flag_range_check != 0)
+      if (sign && flag_range_check != 0)
 	gcc_assert (mpz_scan1 (x, bitsize-1) == ULONG_MAX);
     }
 }
@@ -1658,8 +1658,14 @@ gfc_expr *
 gfc_simplify_bit_size (gfc_expr *e)
 {
   int i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
-  return gfc_get_int_expr (e->ts.kind, &e->where,
-			   gfc_integer_kinds[i].bit_size);
+  int bit_size;
+
+  if (flag_unsigned && e->ts.type == BT_UNSIGNED)
+    bit_size = gfc_unsigned_kinds[i].bit_size;
+  else
+    bit_size = gfc_integer_kinds[i].bit_size;
+
+  return gfc_get_int_expr (e->ts.kind, &e->where, bit_size);
 }
 
 
@@ -1693,11 +1699,11 @@ compare_bitwise (gfc_expr *i, gfc_expr *j)
 
   mpz_init_set (x, i->value.integer);
   k = gfc_validate_kind (i->ts.type, i->ts.kind, false);
-  convert_mpz_to_unsigned (x, gfc_integer_kinds[k].bit_size);
+  gfc_convert_mpz_to_unsigned (x, gfc_integer_kinds[k].bit_size);
 
   mpz_init_set (y, j->value.integer);
   k = gfc_validate_kind (j->ts.type, j->ts.kind, false);
-  convert_mpz_to_unsigned (y, gfc_integer_kinds[k].bit_size);
+  gfc_convert_mpz_to_unsigned (y, gfc_integer_kinds[k].bit_size);
 
   res = mpz_cmp (x, y);
   mpz_clear (x);
@@ -1709,47 +1715,74 @@ compare_bitwise (gfc_expr *i, gfc_expr *j)
 gfc_expr *
 gfc_simplify_bge (gfc_expr *i, gfc_expr *j)
 {
+  bool result;
+
   if (i->expr_type != EXPR_CONSTANT || j->expr_type != EXPR_CONSTANT)
     return NULL;
 
+  if (flag_unsigned && i->ts.type == BT_UNSIGNED)
+    result = mpz_cmp (i->value.integer, j->value.integer) >= 0;
+  else
+    result = compare_bitwise (i, j) >= 0;
+
   return gfc_get_logical_expr (gfc_default_logical_kind, &i->where,
-			       compare_bitwise (i, j) >= 0);
+			       result);
 }
 
 
 gfc_expr *
 gfc_simplify_bgt (gfc_expr *i, gfc_expr *j)
 {
+  bool result;
+
   if (i->expr_type != EXPR_CONSTANT || j->expr_type != EXPR_CONSTANT)
     return NULL;
 
+  if (flag_unsigned && i->ts.type == BT_UNSIGNED)
+    result = mpz_cmp (i->value.integer, j->value.integer) > 0;
+  else
+    result = compare_bitwise (i, j) > 0;
+
   return gfc_get_logical_expr (gfc_default_logical_kind, &i->where,
-			       compare_bitwise (i, j) > 0);
+			       result);
 }
 
 
 gfc_expr *
 gfc_simplify_ble (gfc_expr *i, gfc_expr *j)
 {
+  bool result;
+
   if (i->expr_type != EXPR_CONSTANT || j->expr_type != EXPR_CONSTANT)
     return NULL;
 
+  if (flag_unsigned && i->ts.type == BT_UNSIGNED)
+    result = mpz_cmp (i->value.integer, j->value.integer) <= 0;
+  else
+    result = compare_bitwise (i, j) <= 0;
+
   return gfc_get_logical_expr (gfc_default_logical_kind, &i->where,
-			       compare_bitwise (i, j) <= 0);
+			       result);
 }
 
 
 gfc_expr *
 gfc_simplify_blt (gfc_expr *i, gfc_expr *j)
 {
+  bool result;
+
   if (i->expr_type != EXPR_CONSTANT || j->expr_type != EXPR_CONSTANT)
     return NULL;
 
+  if (flag_unsigned && i->ts.type == BT_UNSIGNED)
+    result = mpz_cmp (i->value.integer, j->value.integer) < 0;
+  else
+    result = compare_bitwise (i, j) < 0;
+
   return gfc_get_logical_expr (gfc_default_logical_kind, &i->where,
-			       compare_bitwise (i, j) < 0);
+			       result);
 }
 
-
 gfc_expr *
 gfc_simplify_ceiling (gfc_expr *e, gfc_expr *k)
 {
@@ -1798,6 +1831,7 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
   switch (x->ts.type)
     {
       case BT_INTEGER:
+      case BT_UNSIGNED:
 	mpc_set_z (result->value.complex, x->value.integer, GFC_MPC_RND_MODE);
 	break;
 
@@ -1819,6 +1853,7 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
   switch (y->ts.type)
     {
       case BT_INTEGER:
+      case BT_UNSIGNED:
 	mpfr_set_z (mpc_imagref (result->value.complex),
 		    y->value.integer, GFC_RND_MODE);
 	break;
@@ -2354,6 +2389,10 @@ gfc_simplify_digits (gfc_expr *x)
 	digits = gfc_integer_kinds[i].digits;
 	break;
 
+      case BT_UNSIGNED:
+	digits = gfc_unsigned_kinds[i].digits;
+	break;
+
       case BT_REAL:
       case BT_COMPLEX:
 	digits = gfc_real_kinds[i].digits;
@@ -2454,13 +2493,23 @@ simplify_dshift (gfc_expr *arg1, gfc_expr *arg2, gfc_expr *shiftarg,
 {
   gfc_expr *result;
   int i, k, size, shift;
+  bt type = BT_INTEGER;
 
   if (arg1->expr_type != EXPR_CONSTANT || arg2->expr_type != EXPR_CONSTANT
       || shiftarg->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  k = gfc_validate_kind (BT_INTEGER, arg1->ts.kind, false);
-  size = gfc_integer_kinds[k].bit_size;
+  if (flag_unsigned && arg1->ts.type == BT_UNSIGNED)
+    {
+      k = gfc_validate_kind (BT_UNSIGNED, arg1->ts.kind, false);
+      size = gfc_unsigned_kinds[k].bit_size;
+      type = BT_UNSIGNED;
+    }
+  else
+    {
+      k = gfc_validate_kind (BT_INTEGER, arg1->ts.kind, false);
+      size = gfc_integer_kinds[k].bit_size;
+    }
 
   gfc_extract_int (shiftarg, &shift);
 
@@ -2468,7 +2517,7 @@ simplify_dshift (gfc_expr *arg1, gfc_expr *arg2, gfc_expr *shiftarg,
   if (right)
     shift = size - shift;
 
-  result = gfc_get_constant_expr (BT_INTEGER, arg1->ts.kind, &arg1->where);
+  result = gfc_get_constant_expr (type, arg1->ts.kind, &arg1->where);
   mpz_set_ui (result->value.integer, 0);
 
   for (i = 0; i < shift; i++)
@@ -2479,8 +2528,11 @@ simplify_dshift (gfc_expr *arg1, gfc_expr *arg2, gfc_expr *shiftarg,
     if (mpz_tstbit (arg1->value.integer, i))
       mpz_setbit (result->value.integer, shift + i);
 
-  /* Convert to a signed value.  */
-  gfc_convert_mpz_to_signed (result->value.integer, size);
+  /* Convert to a signed value if needed.  */
+  if (type == BT_INTEGER)
+    gfc_convert_mpz_to_signed (result->value.integer, size);
+  else
+    gfc_reduce_unsigned (result);
 
   return result;
 }
@@ -3263,7 +3315,11 @@ gfc_simplify_huge (gfc_expr *e)
 	mpz_set (result->value.integer, gfc_integer_kinds[i].huge);
 	break;
 
-      case BT_REAL:
+      case BT_UNSIGNED:
+	mpz_set (result->value.integer, gfc_unsigned_kinds[i].huge);
+	break;
+
+    case BT_REAL:
 	mpfr_set (result->value.real, gfc_real_kinds[i].huge, GFC_RND_MODE);
 	break;
 
@@ -3367,11 +3423,13 @@ gfc_expr *
 gfc_simplify_iand (gfc_expr *x, gfc_expr *y)
 {
   gfc_expr *result;
+  bt type;
 
   if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  result = gfc_get_constant_expr (BT_INTEGER, x->ts.kind, &x->where);
+  type = x->ts.type == BT_UNSIGNED ? BT_UNSIGNED : BT_INTEGER;
+  result = gfc_get_constant_expr (type, x->ts.kind, &x->where);
   mpz_and (result->value.integer, x->value.integer, y->value.integer);
 
   return range_check (result, "IAND");
@@ -3403,13 +3461,18 @@ gfc_simplify_ibclr (gfc_expr *x, gfc_expr *y)
       result->representation.string = NULL;
     }
 
-  convert_mpz_to_unsigned (result->value.integer,
-			   gfc_integer_kinds[k].bit_size);
+  if (x->ts.type == BT_INTEGER)
+    {
+      gfc_convert_mpz_to_unsigned (result->value.integer,
+				   gfc_integer_kinds[k].bit_size);
 
-  mpz_clrbit (result->value.integer, pos);
+      mpz_clrbit (result->value.integer, pos);
 
-  gfc_convert_mpz_to_signed (result->value.integer,
-			 gfc_integer_kinds[k].bit_size);
+      gfc_convert_mpz_to_signed (result->value.integer,
+				 gfc_integer_kinds[k].bit_size);
+    }
+  else
+    mpz_clrbit (result->value.integer, pos);
 
   return result;
 }
@@ -3434,9 +3497,13 @@ gfc_simplify_ibits (gfc_expr *x, gfc_expr *y, gfc_expr *z)
   gfc_extract_int (y, &pos);
   gfc_extract_int (z, &len);
 
-  k = gfc_validate_kind (BT_INTEGER, x->ts.kind, false);
+  k = gfc_validate_kind (x->ts.type, x->ts.kind, false);
+
+  if (x->ts.type == BT_INTEGER)
+    bitsize = gfc_integer_kinds[k].bit_size;
+  else
+    bitsize = gfc_unsigned_kinds[k].bit_size;
 
-  bitsize = gfc_integer_kinds[k].bit_size;
 
   if (pos + len > bitsize)
     {
@@ -3446,8 +3513,10 @@ gfc_simplify_ibits (gfc_expr *x, gfc_expr *y, gfc_expr *z)
     }
 
   result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
-  convert_mpz_to_unsigned (result->value.integer,
-			   gfc_integer_kinds[k].bit_size);
+
+  if (x->ts.type == BT_INTEGER)
+    gfc_convert_mpz_to_unsigned (result->value.integer,
+				 gfc_integer_kinds[k].bit_size);
 
   bits = XCNEWVEC (int, bitsize);
 
@@ -3469,8 +3538,9 @@ gfc_simplify_ibits (gfc_expr *x, gfc_expr *y, gfc_expr *z)
 
   free (bits);
 
-  gfc_convert_mpz_to_signed (result->value.integer,
-			 gfc_integer_kinds[k].bit_size);
+  if (x->ts.type == BT_INTEGER)
+    gfc_convert_mpz_to_signed (result->value.integer,
+			       gfc_integer_kinds[k].bit_size);
 
   return result;
 }
@@ -3501,13 +3571,18 @@ gfc_simplify_ibset (gfc_expr *x, gfc_expr *y)
       result->representation.string = NULL;
     }
 
-  convert_mpz_to_unsigned (result->value.integer,
-			   gfc_integer_kinds[k].bit_size);
+  if (x->ts.type == BT_INTEGER)
+    {
+      gfc_convert_mpz_to_unsigned (result->value.integer,
+				   gfc_integer_kinds[k].bit_size);
 
-  mpz_setbit (result->value.integer, pos);
+      mpz_setbit (result->value.integer, pos);
 
-  gfc_convert_mpz_to_signed (result->value.integer,
-			 gfc_integer_kinds[k].bit_size);
+      gfc_convert_mpz_to_signed (result->value.integer,
+				 gfc_integer_kinds[k].bit_size);
+    }
+  else
+    mpz_setbit (result->value.integer, pos);
 
   return result;
 }
@@ -3545,11 +3620,13 @@ gfc_expr *
 gfc_simplify_ieor (gfc_expr *x, gfc_expr *y)
 {
   gfc_expr *result;
+  bt type;
 
   if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  result = gfc_get_constant_expr (BT_INTEGER, x->ts.kind, &x->where);
+  type = x->ts.type == BT_UNSIGNED ? BT_UNSIGNED : BT_INTEGER;
+  result = gfc_get_constant_expr (type, x->ts.kind, &x->where);
   mpz_xor (result->value.integer, x->value.integer, y->value.integer);
 
   return range_check (result, "IEOR");
@@ -3627,7 +3704,6 @@ done:
   return range_check (result, "INDEX");
 }
 
-
 static gfc_expr *
 simplify_intconv (gfc_expr *e, int kind, const char *name)
 {
@@ -3738,16 +3814,48 @@ gfc_simplify_idint (gfc_expr *e)
   return range_check (result, "IDINT");
 }
 
+gfc_expr *
+gfc_simplify_uint (gfc_expr *e, gfc_expr *k)
+{
+  gfc_expr *result = NULL;
+  int kind;
+
+  kind = get_kind (BT_INTEGER, k, "INT", gfc_default_integer_kind);
+  if (kind == -1)
+    return &gfc_bad_expr;
+
+  /* Convert BOZ to integer, and return without range checking.  */
+  if (e->ts.type == BT_BOZ)
+    {
+      if (!gfc_boz2uint (e, kind))
+	return NULL;
+      result = gfc_copy_expr (e);
+      return result;
+    }
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_convert_constant (e, BT_UNSIGNED, kind);
+
+  if (result == &gfc_bad_expr)
+    return &gfc_bad_expr;
+
+  return range_check (result, "UINT");
+}
+
 
 gfc_expr *
 gfc_simplify_ior (gfc_expr *x, gfc_expr *y)
 {
   gfc_expr *result;
+  bt type;
 
   if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  result = gfc_get_constant_expr (BT_INTEGER, x->ts.kind, &x->where);
+  type = x->ts.type == BT_UNSIGNED ? BT_UNSIGNED : BT_INTEGER;
+  result = gfc_get_constant_expr (type, x->ts.kind, &x->where);
   mpz_ior (result->value.integer, x->value.integer, y->value.integer);
 
   return range_check (result, "IOR");
@@ -3823,8 +3931,11 @@ simplify_shift (gfc_expr *e, gfc_expr *s, const char *name,
 
   gfc_extract_int (s, &shift);
 
-  k = gfc_validate_kind (BT_INTEGER, e->ts.kind, false);
-  bitsize = gfc_integer_kinds[k].bit_size;
+  k = gfc_validate_kind (e->ts.type, e->ts.kind, false);
+  if (e->ts.type == BT_INTEGER)
+    bitsize = gfc_integer_kinds[k].bit_size;
+  else
+    bitsize = gfc_unsigned_kinds[k].bit_size;
 
   result = gfc_get_constant_expr (e->ts.type, e->ts.kind, &e->where);
 
@@ -3900,7 +4011,11 @@ simplify_shift (gfc_expr *e, gfc_expr *s, const char *name,
 	}
     }
 
-  gfc_convert_mpz_to_signed (result->value.integer, bitsize);
+  if (result->ts.type == BT_INTEGER)
+    gfc_convert_mpz_to_signed (result->value.integer, bitsize);
+  else
+    gfc_reduce_unsigned(result);
+
   free (bits);
 
   return result;
@@ -4000,7 +4115,8 @@ gfc_simplify_ishftc (gfc_expr *e, gfc_expr *s, gfc_expr *sz)
   if (shift == 0)
     return result;
 
-  convert_mpz_to_unsigned (result->value.integer, isize);
+  if (result->ts.type == BT_INTEGER)
+    gfc_convert_mpz_to_unsigned (result->value.integer, isize);
 
   bits = XCNEWVEC (int, ssize);
 
@@ -4046,7 +4162,8 @@ gfc_simplify_ishftc (gfc_expr *e, gfc_expr *s, gfc_expr *sz)
 	}
     }
 
-  gfc_convert_mpz_to_signed (result->value.integer, isize);
+  if (result->ts.type == BT_INTEGER)
+    gfc_convert_mpz_to_signed (result->value.integer, isize);
 
   free (bits);
   return result;
@@ -5104,7 +5221,7 @@ gfc_simplify_merge_bits (gfc_expr *i, gfc_expr *j, gfc_expr *mask_expr)
       || mask_expr->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  result = gfc_get_constant_expr (BT_INTEGER, i->ts.kind, &i->where);
+  result = gfc_get_constant_expr (i->ts.type, i->ts.kind, &i->where);
 
   /* Convert all argument to unsigned.  */
   mpz_init_set (arg1, i->value.integer);
@@ -5135,6 +5252,7 @@ min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign, bool back_val)
   switch (arg->ts.type)
     {
       case BT_INTEGER:
+      case BT_UNSIGNED:
 	if (extremum->ts.kind < arg->ts.kind)
 	  extremum->ts.kind = arg->ts.kind;
 	ret = mpz_cmp (arg->value.integer,
@@ -6113,6 +6231,7 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p)
   switch (p->ts.type)
     {
       case BT_INTEGER:
+      case BT_UNSIGNED:
 	if (mpz_cmp_ui (p->value.integer, 0) == 0)
 	  {
 	    gfc_error ("Argument %qs of MOD at %L shall not be zero",
@@ -6138,7 +6257,7 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p)
   kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind;
   result = gfc_get_constant_expr (a->ts.type, kind, &a->where);
 
-  if (a->ts.type == BT_INTEGER)
+  if (a->ts.type == BT_INTEGER || a->ts.type == BT_UNSIGNED)
     mpz_tdiv_r (result->value.integer, a->value.integer, p->value.integer);
   else
     {
@@ -6165,6 +6284,7 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p)
   switch (p->ts.type)
     {
       case BT_INTEGER:
+      case BT_UNSIGNED:
 	if (mpz_cmp_ui (p->value.integer, 0) == 0)
 	  {
 	    gfc_error ("Argument %qs of MODULO at %L shall not be zero",
@@ -6190,8 +6310,8 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p)
   kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind;
   result = gfc_get_constant_expr (a->ts.type, kind, &a->where);
 
-  if (a->ts.type == BT_INTEGER)
-	mpz_fdiv_r (result->value.integer, a->value.integer, p->value.integer);
+  if (a->ts.type == BT_INTEGER || a->ts.type == BT_UNSIGNED)
+    mpz_fdiv_r (result->value.integer, a->value.integer, p->value.integer);
   else
     {
       gfc_set_model_kind (kind);
@@ -6646,11 +6766,16 @@ gfc_simplify_popcnt (gfc_expr *e)
 
   k = gfc_validate_kind (e->ts.type, e->ts.kind, false);
 
-  /* Convert argument to unsigned, then count the '1' bits.  */
-  mpz_init_set (x, e->value.integer);
-  convert_mpz_to_unsigned (x, gfc_integer_kinds[k].bit_size);
-  res = mpz_popcount (x);
-  mpz_clear (x);
+  if (flag_unsigned && e->ts.type == BT_UNSIGNED)
+    res = mpz_popcount (e->value.integer);
+  else
+    {
+      /* Convert argument to unsigned, then count the '1' bits.  */
+      mpz_init_set (x, e->value.integer);
+      gfc_convert_mpz_to_unsigned (x, gfc_integer_kinds[k].bit_size);
+      res = mpz_popcount (x);
+      mpz_clear (x);
+    }
 
   return gfc_get_int_expr (gfc_default_integer_kind, &e->where, res);
 }
@@ -6727,6 +6852,10 @@ gfc_simplify_range (gfc_expr *e)
 	i = gfc_integer_kinds[i].range;
 	break;
 
+      case BT_UNSIGNED:
+	i = gfc_unsigned_kinds[i].range;
+	break;
+
       case BT_REAL:
       case BT_COMPLEX:
 	i = gfc_real_kinds[i].range;
@@ -7404,6 +7533,29 @@ gfc_simplify_selected_int_kind (gfc_expr *e)
   return gfc_get_int_expr (gfc_default_integer_kind, &e->where, kind);
 }
 
+/* Same as above, but with unsigneds.  */
+
+gfc_expr *
+gfc_simplify_selected_unsigned_kind (gfc_expr *e)
+{
+  int i, kind, range;
+
+  if (e->expr_type != EXPR_CONSTANT || gfc_extract_int (e, &range))
+    return NULL;
+
+  kind = INT_MAX;
+
+  for (i = 0; gfc_unsigned_kinds[i].kind != 0; i++)
+    if (gfc_unsigned_kinds[i].range >= range
+	&& gfc_unsigned_kinds[i].kind < kind)
+      kind = gfc_unsigned_kinds[i].kind;
+
+  if (kind == INT_MAX)
+    kind = -1;
+
+  return gfc_get_int_expr (gfc_default_integer_kind, &e->where, kind);
+}
+
 
 gfc_expr *
 gfc_simplify_selected_logical_kind (gfc_expr *e)
@@ -8793,6 +8945,9 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind)
 	case BT_INTEGER:
 	  f = gfc_int2int;
 	  break;
+	case BT_UNSIGNED:
+	  f = gfc_int2uint;
+	  break;
 	case BT_REAL:
 	  f = gfc_int2real;
 	  break;
@@ -8807,12 +8962,38 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind)
 	}
       break;
 
+    case BT_UNSIGNED:
+      switch (type)
+	{
+	case BT_INTEGER:
+	  f = gfc_uint2int;
+	  break;
+	case BT_UNSIGNED:
+	  f = gfc_uint2uint;
+	  break;
+	case BT_REAL:
+	  f = gfc_uint2real;
+	  break;
+	case BT_COMPLEX:
+	  f = gfc_uint2complex;
+	  break;
+	case BT_LOGICAL:
+	  f = gfc_uint2log;
+	  break;
+	default:
+	  goto oops;
+	}
+      break;
+
     case BT_REAL:
       switch (type)
 	{
 	case BT_INTEGER:
 	  f = gfc_real2int;
 	  break;
+	case BT_UNSIGNED:
+	  f = gfc_real2uint;
+	  break;
 	case BT_REAL:
 	  f = gfc_real2real;
 	  break;
@@ -8830,6 +9011,9 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind)
 	case BT_INTEGER:
 	  f = gfc_complex2int;
 	  break;
+	case BT_UNSIGNED:
+	  f = gfc_complex2uint;
+	  break;
 	case BT_REAL:
 	  f = gfc_complex2real;
 	  break;
@@ -8848,6 +9032,9 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind)
 	case BT_INTEGER:
 	  f = gfc_log2int;
 	  break;
+	case BT_UNSIGNED:
+	  f = gfc_log2uint;
+	  break;
 	case BT_LOGICAL:
 	  f = gfc_log2log;
 	  break;
@@ -8863,6 +9050,11 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind)
 	  f = gfc_hollerith2int;
 	  break;
 
+	  /* Hollerith is for legacy code, we do not currently support
+	     converting this to UNSIGNED.  */
+	case BT_UNSIGNED:
+	  goto oops;
+
 	case BT_REAL:
 	  f = gfc_hollerith2real;
 	  break;
@@ -8891,6 +9083,9 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind)
 	  f = gfc_character2int;
 	  break;
 
+	case BT_UNSIGNED:
+	  goto oops;
+
 	case BT_REAL:
 	  f = gfc_character2real;
 	  break;
diff --git a/gcc/fortran/target-memory.cc b/gcc/fortran/target-memory.cc
index a02db7a06e4..53d360cd266 100644
--- a/gcc/fortran/target-memory.cc
+++ b/gcc/fortran/target-memory.cc
@@ -42,6 +42,11 @@ size_integer (int kind)
   return GET_MODE_SIZE (SCALAR_INT_TYPE_MODE (gfc_get_int_type (kind)));
 }
 
+static size_t
+size_unsigned (int kind)
+{
+  return GET_MODE_SIZE (SCALAR_INT_TYPE_MODE (gfc_get_unsigned_type (kind)));
+}
 
 static size_t
 size_float (int kind)
@@ -85,6 +90,9 @@ gfc_element_size (gfc_expr *e, size_t *siz)
     case BT_INTEGER:
       *siz = size_integer (e->ts.kind);
       return true;
+    case BT_UNSIGNED:
+      *siz = size_unsigned (e->ts.kind);
+      return true;
     case BT_REAL:
       *siz = size_float (e->ts.kind);
       return true;
diff --git a/gcc/fortran/trans-const.cc b/gcc/fortran/trans-const.cc
index fc5b6d03057..204f4df301c 100644
--- a/gcc/fortran/trans-const.cc
+++ b/gcc/fortran/trans-const.cc
@@ -206,6 +206,14 @@ gfc_conv_mpz_to_tree (mpz_t i, int kind)
   return wide_int_to_tree (gfc_get_int_type (kind), val);
 }
 
+/* Same, but for unsigned.  */
+
+tree
+gfc_conv_mpz_unsigned_to_tree (mpz_t i, int kind)
+{
+  wide_int val = wi:: from_mpz (gfc_get_unsigned_type (kind), i, true);
+  return wide_int_to_tree (gfc_get_unsigned_type (kind), val);
+}
 
 /* Convert a GMP integer into a tree node of type given by the type
    argument.  */
@@ -315,6 +323,9 @@ gfc_conv_constant_to_tree (gfc_expr * expr)
       else
 	return gfc_conv_mpz_to_tree (expr->value.integer, expr->ts.kind);
 
+    case BT_UNSIGNED:
+      return gfc_conv_mpz_unsigned_to_tree (expr->value.integer, expr->ts.kind);
+
     case BT_REAL:
       if (expr->representation.string)
 	return fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index ca6a515a180..dce56036540 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7098,6 +7098,10 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally,
 		  type = (sym->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR
 			? CFI_type_cfunptr : CFI_type_cptr);
 		  break;
+
+	      case BT_UNSIGNED:
+		gfc_internal_error ("Unsigned not yet implemented");
+
 		case BT_ASSUMED:
 		case BT_CLASS:
 		case BT_PROCEDURE:
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 3677e49a356..6a89bda9837 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5837,6 +5837,10 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
 	    }
 	  else
 	    gcc_unreachable ();
+
+	case BT_UNSIGNED:
+	  gfc_internal_error ("Unsigned not yet implemented");
+
 	case BT_PROCEDURE:
 	case BT_HOLLERITH:
 	case BT_UNION:
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 150cb9ff963..fef74c8364f 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -3423,6 +3423,13 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
 				   args[0], args[1]);
       break;
 
+    case BT_UNSIGNED:
+      /* Even easier, we only need one.  */
+      type = TREE_TYPE (args[0]);
+      se->expr = fold_build2_loc (input_location, TRUNC_MOD_EXPR, type,
+				  args[0], args[1]);
+      break;
+
     case BT_REAL:
       fmod = NULL_TREE;
       /* Check if we have a builtin fmod.  */
@@ -6772,6 +6779,7 @@ gfc_conv_intrinsic_shift (gfc_se * se, gfc_expr * expr, bool right_shift,
 {
   tree args[2], type, num_bits, cond;
   tree bigshift;
+  bool do_convert = false;
 
   gfc_conv_intrinsic_function_args (se, expr, args, 2);
 
@@ -6780,15 +6788,24 @@ gfc_conv_intrinsic_shift (gfc_se * se, gfc_expr * expr, bool right_shift,
   type = TREE_TYPE (args[0]);
 
   if (!arithmetic)
-    args[0] = fold_convert (unsigned_type_for (type), args[0]);
+    {
+      args[0] = fold_convert (unsigned_type_for (type), args[0]);
+      do_convert = true;
+    }
   else
     gcc_assert (right_shift);
 
+  if (flag_unsigned && arithmetic && expr->ts.type == BT_UNSIGNED)
+    {
+      do_convert = true;
+      args[0] = fold_convert (signed_type_for (type), args[0]);
+    }
+
   se->expr = fold_build2_loc (input_location,
 			      right_shift ? RSHIFT_EXPR : LSHIFT_EXPR,
 			      TREE_TYPE (args[0]), args[0], args[1]);
 
-  if (!arithmetic)
+  if (do_convert)
     se->expr = fold_convert (type, se->expr);
 
   if (!arithmetic)
@@ -10908,6 +10925,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
     case GFC_ISYM_INT2:
     case GFC_ISYM_INT8:
     case GFC_ISYM_LONG:
+    case GFC_ISYM_UINT:
       gfc_conv_intrinsic_int (se, expr, RND_TRUNC);
       break;
 
diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index 7ab82fa2f5b..e9e67a0d6b8 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -117,6 +117,8 @@ enum iocall
   IOCALL_WRITE_DONE,
   IOCALL_X_INTEGER,
   IOCALL_X_INTEGER_WRITE,
+  IOCALL_X_UNSIGNED,
+  IOCALL_X_UNSIGNED_WRITE,
   IOCALL_X_LOGICAL,
   IOCALL_X_LOGICAL_WRITE,
   IOCALL_X_CHARACTER,
@@ -335,6 +337,14 @@ gfc_build_io_library_fndecls (void)
 	get_identifier (PREFIX("transfer_integer_write")), ". w R . ",
 	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
 
+  iocall[IOCALL_X_UNSIGNED] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_unsigned")), ". w W . ",
+	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
+
+  iocall[IOCALL_X_UNSIGNED_WRITE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_unsigned_write")), ". w R . ",
+	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
+
   iocall[IOCALL_X_LOGICAL] = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("transfer_logical")), ". w W . ",
 	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
@@ -2341,6 +2351,15 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr,
 
       break;
 
+    case BT_UNSIGNED:
+      arg2 = build_int_cst (unsigned_type_node, kind);
+      if (last_dt == READ)
+	function = iocall[IOCALL_X_UNSIGNED];
+      else
+	function = iocall[IOCALL_X_UNSIGNED_WRITE];
+
+      break;
+
     case BT_REAL:
       arg2 = build_int_cst (integer_type_node, kind);
       if (last_dt == READ)
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index e6da8e1a58b..ad4939eb175 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -86,8 +86,10 @@ static GTY(()) tree gfc_cfi_descriptor_base[2 * (CFI_MAX_RANK + 2)];
 #define MAX_INT_KINDS 5
 gfc_integer_info gfc_integer_kinds[MAX_INT_KINDS + 1];
 gfc_logical_info gfc_logical_kinds[MAX_INT_KINDS + 1];
+gfc_unsigned_info gfc_unsigned_kinds[MAX_INT_KINDS + 1];
 static GTY(()) tree gfc_integer_types[MAX_INT_KINDS + 1];
 static GTY(()) tree gfc_logical_types[MAX_INT_KINDS + 1];
+static GTY(()) tree gfc_unsigned_types[MAX_INT_KINDS + 1];
 
 #define MAX_REAL_KINDS 5
 gfc_real_info gfc_real_kinds[MAX_REAL_KINDS + 1];
@@ -109,6 +111,7 @@ int gfc_index_integer_kind;
 /* The default kinds of the various types.  */
 
 int gfc_default_integer_kind;
+int gfc_default_unsigned_kind;
 int gfc_max_integer_kind;
 int gfc_default_real_kind;
 int gfc_default_double_kind;
@@ -413,6 +416,14 @@ gfc_init_kinds (void)
       gfc_integer_kinds[i_index].digits = bitsize - 1;
       gfc_integer_kinds[i_index].bit_size = bitsize;
 
+      if (flag_unsigned)
+	{
+	  gfc_unsigned_kinds[i_index].kind = kind;
+	  gfc_unsigned_kinds[i_index].radix = 2;
+	  gfc_unsigned_kinds[i_index].digits = bitsize;
+	  gfc_unsigned_kinds[i_index].bit_size = bitsize;
+	}
+
       gfc_logical_kinds[i_index].kind = kind;
       gfc_logical_kinds[i_index].bit_size = bitsize;
 
@@ -585,6 +596,8 @@ gfc_init_kinds (void)
       gfc_numeric_storage_size = gfc_integer_kinds[i_index - 1].bit_size;
     }
 
+  gfc_default_unsigned_kind = gfc_default_integer_kind;
+
   /* Choose the default real kind.  Again, we choose 4 when possible.  */
   if (flag_default_real_8)
     {
@@ -756,6 +769,18 @@ validate_integer (int kind)
   return -1;
 }
 
+static int
+validate_unsigned (int kind)
+{
+  int i;
+
+  for (i = 0; gfc_unsigned_kinds[i].kind != 0; i++)
+    if (gfc_unsigned_kinds[i].kind == kind)
+      return i;
+
+  return -1;
+}
+
 static int
 validate_real (int kind)
 {
@@ -810,6 +835,9 @@ gfc_validate_kind (bt type, int kind, bool may_fail)
     case BT_INTEGER:
       rc = validate_integer (kind);
       break;
+    case BT_UNSIGNED:
+      rc = validate_unsigned (kind);
+      break;
     case BT_LOGICAL:
       rc = validate_logical (kind);
       break;
@@ -880,6 +908,24 @@ gfc_build_uint_type (int size)
   return make_unsigned_type (size);
 }
 
+static tree
+gfc_build_unsigned_type (gfc_unsigned_info *info)
+{
+  int mode_precision = info->bit_size;
+
+  if (mode_precision == CHAR_TYPE_SIZE)
+    info->c_unsigned_char = 1;
+  if (mode_precision == SHORT_TYPE_SIZE)
+    info->c_unsigned_short = 1;
+  if (mode_precision == INT_TYPE_SIZE)
+    info->c_unsigned_int = 1;
+  if (mode_precision == LONG_TYPE_SIZE)
+    info->c_unsigned_long = 1;
+  if (mode_precision == LONG_LONG_TYPE_SIZE)
+    info->c_unsigned_long_long = 1;
+
+  return gfc_build_uint_type (mode_precision);
+}
 
 static tree
 gfc_build_real_type (gfc_real_info *info)
@@ -1034,6 +1080,40 @@ gfc_init_types (void)
     }
   gfc_character1_type_node = gfc_character_types[0];
 
+  /* The middle end only recognizes a single unsigned type.  For
+     compatibility of existing test cases, let's just use the
+     character type.  The reader of tree dumps is expected to be able
+     to deal with this.  */
+
+  if (flag_unsigned)
+    {
+      for (index = 0; gfc_unsigned_kinds[index].kind != 0;++index)
+	{
+	  int index_char = -1;
+	  for (int i=0; gfc_character_kinds[i].kind != 0; i++)
+	    {
+	      if (gfc_character_kinds[i].bit_size ==
+		  gfc_unsigned_kinds[index].bit_size)
+		{
+		  index_char = i;
+		  break;
+		}
+	    }
+	  if (index_char > 0)
+	    {
+	      gfc_unsigned_types[index] = gfc_character_types[index_char];
+	    }
+	  else
+	    {
+	      type = gfc_build_unsigned_type (&gfc_unsigned_kinds[index]);
+	      gfc_unsigned_types[index] = type;
+	      snprintf (name_buf, sizeof(name_buf), "unsigned(kind=%d)",
+			gfc_integer_kinds[index].kind);
+	      PUSH_TYPE (name_buf, type);
+	    }
+	}
+    }
+
   PUSH_TYPE ("byte", unsigned_char_type_node);
   PUSH_TYPE ("void", void_type_node);
 
@@ -1092,6 +1172,13 @@ gfc_get_int_type (int kind)
   return index < 0 ? 0 : gfc_integer_types[index];
 }
 
+tree
+gfc_get_unsigned_type (int kind)
+{
+  int index = gfc_validate_kind (BT_UNSIGNED, kind, true);
+  return index < 0 ? 0 : gfc_unsigned_types[index];
+}
+
 tree
 gfc_get_real_type (int kind)
 {
@@ -1192,6 +1279,10 @@ gfc_typenode_for_spec (gfc_typespec * spec, int codim)
         basetype = gfc_get_int_type (spec->kind);
       break;
 
+    case BT_UNSIGNED:
+      basetype = gfc_get_unsigned_type (spec->kind);
+      break;
+
     case BT_REAL:
       basetype = gfc_get_real_type (spec->kind);
       break;
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index 60096facde8..afc4da99526 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -76,6 +76,7 @@ void gfc_init_c_interop_kinds (void);
 
 tree get_dtype_type_node (void);
 tree gfc_get_int_type (int);
+tree gfc_get_unsigned_type (int);
 tree gfc_get_real_type (int);
 tree gfc_get_complex_type (int);
 tree gfc_get_logical_type (int);
diff --git a/gcc/testsuite/gfortran.dg/unsigned_1.f90 b/gcc/testsuite/gfortran.dg/unsigned_1.f90
new file mode 100644
index 00000000000..eefecab3715
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_1.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Test some arithmetic and selected_unsigned_kind.
+program memain
+  unsigned :: u, v
+  integer, parameter :: u1 = selected_unsigned_kind(2), &
+       u2 = selected_unsigned_kind(4), &
+       u4 = selected_unsigned_kind(6), &
+       u8 = selected_unsigned_kind(10)
+  u = 1u
+  v = 42u
+  if (u + v /= 43u) then
+     error stop 1
+  end if
+  if (u1 /= 1 .or. u2 /= 2 .or. u4 /= 4 .or. u8 /= 8) error stop 2
+end program memain
diff --git a/gcc/testsuite/gfortran.dg/unsigned_10.f90 b/gcc/testsuite/gfortran.dg/unsigned_10.f90
new file mode 100644
index 00000000000..df9167649fe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_10.f90
@@ -0,0 +1,56 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Test I/O with Z, O and B descriptors.
+
+program main
+  implicit none
+  unsigned(kind=8) :: u,v
+  integer :: i
+  open(10,status="scratch")
+  u = 3u
+  do i=0,63
+     write (10,'(Z16)') u
+     u = u + u
+  end do
+  rewind 10
+  u = 3u
+  do i=0,63
+     read (10,'(Z16)') v
+     if (u /= v) then
+        print *,u,v
+     end if
+     u = u + u
+  end do
+  rewind 10
+  u = 3u
+  do i=0,63
+     write (10,'(O22)') u
+     u = u + u
+  end do
+  rewind 10
+  u = 3u
+  do i=0,63
+     read (10,'(O22)') v
+     if (u /= v) then
+        print *,u,v
+     end if
+     u = u + u
+  end do
+
+  rewind 10
+  u = 3u
+  do i=0,63
+     write (10,'(B64)') u
+     u = u + u
+  end do
+  rewind 10
+  u = 3u
+  do i=0,63
+     read (10,'(B64)') v
+     if (u /= v) then
+        print *,u,v
+     end if
+     u = u + u
+  end do
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/unsigned_11.f90 b/gcc/testsuite/gfortran.dg/unsigned_11.f90
new file mode 100644
index 00000000000..ad817a843a9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_11.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Test min/max
+program main
+  unsigned :: u_a, u_b
+  if (max(1u,2u) /= 2u) error stop 1
+  if (max(2u,1u) /= 2u) error stop 2
+  if (min(1u,2u) /= 1u) error stop 3
+  if (min(2u,1u) /= 1u) error stop 4
+  u_a = 1u
+  u_b = 2u
+  if (max(u_a,u_b) /= u_b) error stop 5
+  if (max(u_b,u_a) /= u_b) error stop 6
+  if (min(u_a,u_b) /= u_a) error stop 7
+  if (min(u_b,u_a) /= u_a) error stop 8
+  if (max(4294967295u, 1u) /= 4294967295u) error stop 9
+  u_a = 4294967295u
+  u_b = 1u
+  if (max(u_a,u_b) /= 4294967295u) error stop 10
+  if (max(u_b,u_a) /= 4294967295u) error stop 11
+  if (min(u_a,u_b) /= 1u) error stop 12
+  if (min(u_b,u_a) /= 1u) error stop 13
+end program
diff --git a/gcc/testsuite/gfortran.dg/unsigned_12.f90 b/gcc/testsuite/gfortran.dg/unsigned_12.f90
new file mode 100644
index 00000000000..9a96b3cfb13
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_12.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Test some
+program main
+  unsigned :: u_a
+  u_a = 1u
+  if (ishft(1u,31) /= 2147483648u) error stop 1
+  if (ishft(u_a,31) /= 2147483648u) error stop 2
+
+  u_a = 3u
+  if (ishft(3u,2) /= 12u) error stop 3
+  if (ishft(u_a,2) /= 12u) error stop 4
+
+  u_a = huge(u_a)
+  if (ishftc(huge(u_a),1) /= huge(u_a)) error stop 5
+  if (ishftc(u_a,1) /= u_a) error stop 6
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/unsigned_13.f90 b/gcc/testsuite/gfortran.dg/unsigned_13.f90
new file mode 100644
index 00000000000..7bc2396a5c0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_13.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Test basic functionality of ishft and ishftc.
+program main
+  unsigned :: u_a
+  u_a = 1u
+  if (ishft(1u,31) /= 2147483648u) error stop 1
+  if (ishft(u_a,31) /= 2147483648u) error stop 2
+
+  u_a = 3u
+  if (ishft(3u,2) /= 12u) error stop 3
+  if (ishft(u_a,2) /= 12u) error stop 4
+
+  u_a = huge(u_a)
+  if (ishftc(huge(u_a),1) /= huge(u_a)) error stop 5
+  if (ishftc(u_a,1) /= u_a) error stop 6
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/unsigned_14.f90 b/gcc/testsuite/gfortran.dg/unsigned_14.f90
new file mode 100644
index 00000000000..81c200fd883
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_14.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Test basic functionality of merge_bits.
+program main
+  unsigned(kind=4) :: a, b, c
+  if (merge_bits(15u,51u,85u) /= 39u) error stop 1
+  a = 15u
+  b = 51u
+  c = 85u
+  if (merge_bits(a,b,c) /= 39u) error stop 2
+
+  if  (merge_bits(4026531840u,3422552064u,2852126720u) /= 3825205248u) error stop 3
+
+  a = 4026531840u_4
+  b = 3422552064u_4
+  c = 2852126720u_4
+  if (merge_bits(a,b,c) /= 3825205248u) error stop 4
+end program
diff --git a/gcc/testsuite/gfortran.dg/unsigned_15.f90 b/gcc/testsuite/gfortran.dg/unsigned_15.f90
new file mode 100644
index 00000000000..da4ccd2dc17
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_15.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-funsigned" }
+! Test different prohibited conversions.
+program main
+  integer :: i
+  unsigned :: u
+  print *,1 + 2u   ! { dg-error "Operands of binary numeric operator" }
+  print *,2u + 1   ! { dg-error "Operands of binary numeric operator" }
+  print *,2u ** 1  ! { dg-error "Exponentiation not valid" }
+  print *,2u ** 1u ! { dg-error "Exponentiation not valid" }
+  print *,1u < 2   ! { dg-error "Inconsistent types" }
+  print *,int(1u) < 2
+end program main
diff --git a/gcc/testsuite/gfortran.dg/unsigned_16.f90 b/gcc/testsuite/gfortran.dg/unsigned_16.f90
new file mode 100644
index 00000000000..34eb9d3f6c3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_16.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-funsigned -pedantic" }
+! Some checks with -pedantic.
+program main
+  unsigned :: u
+  print *,-129u_1 ! { dg-error "Negation of unsigned constant" }
+  print *,256u_1 ! { dg-error "Unsigned constant truncated" }
+  u = 1u
+  u = -u ! { dg-error "Negation of unsigned expression" }
+end program
diff --git a/gcc/testsuite/gfortran.dg/unsigned_17.f90 b/gcc/testsuite/gfortran.dg/unsigned_17.f90
new file mode 100644
index 00000000000..4557f1d30cb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_17.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Test modulo and mod intrinsics.
+program main
+  unsigned :: u1, u2
+  if (mod(5u,2u) /= 1u) error stop 1
+  if (modulo(5u,2u) /= 1u) error stop 2
+  u1 = 5u
+  u2 = 2u
+  if (mod(u1,u2) /= 1u) error stop 3
+  if (modulo(u1,u2) /= 1u) error stop 4
+
+  if (mod(4294967295u,4294967281u) /= 14u) error stop 5
+  if (mod(4294967281u,4294967295u) /= 4294967281u) error stop 6
+  if (modulo(4294967295u,4294967281u) /= 14u) error stop 7
+  if (modulo(4294967281u,4294967295u) /= 4294967281u) error stop 8
+  u1 = 4294967295u
+  u2 = 4294967281u
+  if (mod(u1,u2) /= 14u) error stop 9
+  if (mod(u2,u1) /= u2) error stop 10
+end program main
diff --git a/gcc/testsuite/gfortran.dg/unsigned_18.f90 b/gcc/testsuite/gfortran.dg/unsigned_18.f90
new file mode 100644
index 00000000000..f6207abd562
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_18.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+program memain
+  implicit none
+  unsigned(1) i1,j1
+  unsigned(2) i2,j2
+  unsigned(4) i4,j4
+  unsigned(8) i8,j8
+  integer ibits,n
+
+  ibits=bit_size(1u_1)
+  do n=1,ibits
+     i1=huge(i1)
+     call mvbits(1u_1, 0,n,i1,0)
+     j1=uint(-1-2_1**n+2)
+     if(i1.ne.j1) error stop 1
+  enddo
+  ibits=bit_size(1u_2)
+  do n=1,ibits
+     i2=huge(i2)
+     call mvbits(1u_2, 0,n,i2,0)
+     j2=uint(-1-2_2**n+2)
+     if(i2.ne.j2) error stop 2
+  enddo
+  ibits=bit_size(1u_4)
+  do n=1,ibits
+     i4=huge(i4)
+     call mvbits(1u_4, 0,n,i4,0)
+     j4=uint(-1-2_4**n+2)
+     if(i4.ne.j4) error stop 3
+  enddo
+  ibits=bit_size(1_8)
+  do n=1,ibits
+     i8=huge(i8)
+     call mvbits(1u_8, 0,n,i8,0)
+     j8=uint(-1-2_8**n+2,8)
+     if(i8.ne.j8) error stop 4
+  enddo
+
+end program memain
diff --git a/gcc/testsuite/gfortran.dg/unsigned_19.f90 b/gcc/testsuite/gfortran.dg/unsigned_19.f90
new file mode 100644
index 00000000000..2795ddf335e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_19.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+program memain
+  if (range(1u_1) /= 2) error stop 1
+  if (range(1u_2) /= 4) error stop 2
+  if (range(1u_4) /= 9) error stop 3
+  if (range(1u_8) /= 19) error stop 4
+end program memain
diff --git a/gcc/testsuite/gfortran.dg/unsigned_2.f90 b/gcc/testsuite/gfortran.dg/unsigned_2.f90
new file mode 100644
index 00000000000..499fd164786
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_2.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Test some list-directed I/O
+program main
+  implicit none
+  unsigned :: uw, ur, vr
+  unsigned(kind=8) :: u8
+  uw = 10u
+  open (10, status="scratch")
+  write (10,*) uw,-1
+  rewind 10
+  read (10,*) ur,vr
+  if (ur /= 10u .or. vr /= 4294967295u) error stop 1
+  rewind 10
+  write (10,*) 17179869184u_8
+  rewind 10
+  read (10,*) u8
+  if (u8 /= 17179869184u_8) error stop 2
+end program main
+  
diff --git a/gcc/testsuite/gfortran.dg/unsigned_20.f90 b/gcc/testsuite/gfortran.dg/unsigned_20.f90
new file mode 100644
index 00000000000..f66016c874c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_20.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+program memain
+
+  unsigned(1) :: u1
+  unsigned(2) :: u2
+  unsigned(4) :: u4
+  unsigned(8) :: u8
+
+  u1 = 1u_1
+  if (shifta (                 1u  , 1) /=                    0u_1) error stop 1
+  if (shifta (                 u1  , 1) /=                    0u_1) error stop 2
+
+  u1 = 128u_1
+  if (shifta (               128u_1, 1) /=                  192u_1) error stop 3
+  if (shiftl (               128u_1, 1) /=                    0u_1) error stop 4
+  if (shiftr (               128u_1, 1) /=                   64u_1) error stop 5
+
+  if (shifta (                   u1, 1) /=                  192u_1) error stop 6
+  if (shiftl (                   u1, 1) /=                    0u_1) error stop 7
+  if (shiftr (                   u1, 1) /=                   64u_1) error stop 8
+
+  u2 = 32768u_2
+  if (shifta (             32768u_2, 1) /=                49152u_2) error stop 9
+  if (shiftl (             32768u_2, 1) /=                    0u_2) error stop 10
+  if (shiftr (             32768u_2, 1) /=                16384u_2) error stop 11
+  if (shifta (                   u2, 1) /=                49152u_2) error stop 12
+  if (shiftl (                   u2, 1) /=                    0u_2) error stop 13
+  if (shiftr (                   u2, 1) /=                16384u_2) error stop 14
+
+  u4 = 2147483648u_4
+  if (shifta (        2147483648u_4, 1) /=           3221225472u_4) error stop 15
+  if (shiftl (        2147483648u_4, 1) /=                    0u_4) error stop 16
+  if (shiftr (        2147483648u_4, 1) /=           1073741824u_4) error stop 17
+  if (shifta (                   u4, 1) /=           3221225472u_4) error stop 18
+  if (shiftl (                   u4, 1) /=                    0u_4) error stop 19
+  if (shiftr (                   u4, 1) /=           1073741824u_4) error stop 20
+
+  u8 = 9223372036854775808u_8
+  if (shifta(9223372036854775808u_8, 1) /= 13835058055282163712u_8) error stop 21
+  if (shiftl(9223372036854775808u_8, 1) /=                    0u_8) error stop 22
+  if (shiftr(9223372036854775808u_8, 1) /=  4611686018427387904u_8) error stop 23
+  if (shifta(                    u8, 1) /= 13835058055282163712u_8) error stop 24
+  if (shiftl(                    u8, 1) /=                    0u_8) error stop 25
+  if (shiftr(                    u8, 1) /=  4611686018427387904u_8) error stop 26
+end program memain
diff --git a/gcc/testsuite/gfortran.dg/unsigned_21.f90 b/gcc/testsuite/gfortran.dg/unsigned_21.f90
new file mode 100644
index 00000000000..23302c7eabe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_21.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+program main
+  integer :: i
+  integer(2) :: j
+  unsigned :: u
+  i = -1
+  u = transfer(i,u)
+  if (u /= huge(u)) error stop 1
+  u = 40000u
+  j = transfer(u,j)
+  if (j /= -25536) error stop 2
+end program main
diff --git a/gcc/testsuite/gfortran.dg/unsigned_22.f90 b/gcc/testsuite/gfortran.dg/unsigned_22.f90
new file mode 100644
index 00000000000..bc2f810238d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_22.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-funsigned -pedantic" }
+program memain
+  implicit none
+  integer :: iostat
+  character(len=100) :: iomsg
+  unsigned :: u
+  open (10)
+  write (10,'(I10)') -1
+  write (10,'(I10)') 2_8**32
+  rewind 10
+  read (10,'(I10)',iostat=iostat,iomsg=iomsg) u
+  if (iostat == 0) error stop 1
+  if (iomsg /= "Negative sign for unsigned integer read") error stop 2
+  read (10,'(I10)',iostat=iostat,iomsg=iomsg) u
+  if (iostat == 0) error stop 3
+  if (iomsg /= "Value overflowed during unsigned integer read") error stop 4
+  rewind 10
+  read (10,*,iostat=iostat,iomsg=iomsg) u
+  if (iostat == 0) error stop 5
+  if (iomsg /= "Negative sign for unsigned integer in item 1 of list input ") error stop 6
+  read (10,*,iostat=iostat,iomsg=iomsg) u
+  if (iostat == 0) error stop 7
+  if (iomsg /= "Unsigned integer overflow while reading item 1 of list input") error stop 8
+ end program memain
diff --git a/gcc/testsuite/gfortran.dg/unsigned_3.f90 b/gcc/testsuite/gfortran.dg/unsigned_3.f90
new file mode 100644
index 00000000000..7d5b4d67cfd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_3.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-funsigned" }
+! Test that overflow warned about.
+program main
+  unsigned(1) :: u
+  u = 256u_1 ! { dg-warning "Unsigned constant truncated" }
+  u = -127u_1
+  u = 255u_1
+  u = -129u_1 ! { dg-warning "Unsigned constant truncated" }
+end
diff --git a/gcc/testsuite/gfortran.dg/unsigned_4.f90 b/gcc/testsuite/gfortran.dg/unsigned_4.f90
new file mode 100644
index 00000000000..46b08a3e81f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_4.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Test some basic formatted I/O.
+
+program main
+  unsigned :: u
+  open (10,status="scratch")
+  write (10,'(I4)') 1u
+  write (10,'(I4)') -1
+  rewind 10
+  read (10,'(I4)') u
+  if (u /= 1u) error stop 1
+  read (10,'(I4)') u
+  if (u /= 4294967295u) error stop 2
+end program main
diff --git a/gcc/testsuite/gfortran.dg/unsigned_5.f90 b/gcc/testsuite/gfortran.dg/unsigned_5.f90
new file mode 100644
index 00000000000..b8b956ecdf6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_5.f90
@@ -0,0 +1,123 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Test conversions from unsigned to different data types by
+! doing some I/O.
+program main
+  implicit none
+  integer :: vi,i
+  integer, parameter :: n_int = 16, n_real = 8
+  unsigned(kind=1) :: u1
+  unsigned(kind=2) :: u2
+  unsigned(kind=4) :: u4
+  unsigned(kind=8) :: u8
+  unsigned :: u
+  integer, dimension(n_int) :: ires
+  real(kind=8), dimension(n_real) :: rres
+  real(kind=8) :: vr
+  complex (kind=8) :: vc
+  data ires /11,12,14,18,21,22,24,28,41,42,44,48,81,82,84,88/
+  data rres /14., 18., 24., 28., 44., 48., 84., 88./
+  open (10,status="scratch")
+
+  write (10,*) int(11u_1,1)
+  write (10,*) int(12u_1,2)
+  write (10,*) int(14u_1,4)
+  write (10,*) int(18u_1,8)
+
+  write (10,*) int(21u_2,1)
+  write (10,*) int(22u_2,2)
+  write (10,*) int(24u_2,4)
+  write (10,*) int(28u_2,8)
+
+  write (10,*) int(41u_4,1)
+  write (10,*) int(42u_4,2)
+  write (10,*) int(44u_4,4)
+  write (10,*) int(48u_4,8)
+
+  write (10,*) int(81u_8,1)
+  write (10,*) int(82u_8,2)
+  write (10,*) int(84u_8,4)
+  write (10,*) int(88u_8,8)
+
+  rewind 10
+  do i=1,n_int
+     read (10,*) vi
+     if (vi /= ires(i)) error stop 1
+  end do
+
+  rewind 10
+  u1 = 11u; write (10,*) int(u1,1)
+  u1 = 12u; write (10,*) int(u1,2)
+  u1 = 14u; write (10,*) int(u1,4)
+  u1 = 18u; write (10,*) int(u1,8)
+
+  u2 = 21u; write (10,*) int(u2,1)
+  u2 = 22u; write (10,*) int(u2,2)
+  u2 = 24u; write (10,*) int(u2,4)
+  u2 = 28u; write (10,*) int(u2,8)
+
+  u4 = 41u; write (10,*) int(u4,1)
+  u4 = 42u; write (10,*) int(u4,2)
+  u4 = 44u; write (10,*) int(u4,4)
+  u4 = 48u; write (10,*) int(u4,8)
+
+  u8 = 81u; write (10,*) int(u8,1)
+  u8 = 82u; write (10,*) int(u8,2)
+  u8 = 84u; write (10,*) int(u8,4)
+  u8 = 88u; write (10,*) int(u8,8)
+
+  rewind 10
+  do i=1,n_int
+     read (10,*) vi
+     if (vi /= ires(i)) error stop 2
+  end do
+
+  rewind 10
+  write (10,*) real(14u_1,4)
+  write (10,*) real(18u_1,8)
+  write (10,*) real(24u_2,4)
+  write (10,*) real(28u_2,8)
+  write (10,*) real(44u_4,4)
+  write (10,*) real(48u_4,8)
+  write (10,*) real(84u_8,4)
+  write (10,*) real(88u_8,8)
+
+  rewind 10
+  do i=1, n_real
+     read (10, *) vr
+     if (vr /= rres(i)) error stop 3
+  end do
+
+  rewind 10
+  u1 = 14u_1; write (10,*) real(u1,4)
+  u1 = 18u_1; write (10,*) real(u1,8)
+  u2 = 24u_2; write (10,*) real(u2,4)
+  u2 = 28u_2; write (10,*) real(u2,8)
+  u4 = 44u_4; write (10,*) real(u4,4)
+  u4 = 48u_4; write (10,*) real(u4,8)
+  u8 = 84u_4; write (10,*) real(u8,4)
+  u8 = 88u_4; write (10,*) real(u8,8)
+
+  rewind 10
+  do i=1, n_real
+     read (10, *) vr
+     if (vr /= rres(i)) error stop 4
+  end do
+
+  rewind 10
+  u1 = 14u_1; write (10,*) cmplx(14u_1,u1,kind=4)
+  u1 = 18u_1; write (10,*) cmplx(18u_1,u1,kind=8)
+  u2 = 24u_2; write (10,*) cmplx(24u_2,u2,kind=4)
+  u2 = 28u_2; write (10,*) cmplx(28u_2,u2,kind=8)
+  u4 = 44u_4; write (10,*) cmplx(44u_4,u4,kind=4)
+  u4 = 48u_8; write (10,*) cmplx(48u_4,u4,kind=8)
+  u8 = 84u_8; write (10,*) cmplx(84u_8,u8,kind=4)
+  u8 = 88u_8; write (10,*) cmplx(88u_8,u8,kind=8)
+
+  rewind 10
+  do i=1,n_real
+     read (10, *) vc
+     if (real(vc) /= rres(i)) error stop 5
+     if (aimag(vc) /= rres(i)) error stop 6
+  end do
+end program main
diff --git a/gcc/testsuite/gfortran.dg/unsigned_6.f90 b/gcc/testsuite/gfortran.dg/unsigned_6.f90
new file mode 100644
index 00000000000..677fdddec21
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_6.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Test the uint intrinsic.
+program main
+  implicit none
+  integer :: i
+  real :: r
+  complex :: c
+  if (1u /= uint(1)) error stop 1
+  if (2u /= uint(2.0)) error stop 2
+  if (3u /= uint((3.2,0.))) error stop 3
+
+  i = 4
+  if (uint(i) /= 4u) error stop 4
+  r = 5.2
+  if (uint(r) /= 5u) error stop 5
+  c = (6.2,-1.2)
+  if (uint(c) /= 6u) error stop 6
+
+  if (uint(z'ff') /= 255u) error stop 7
+end program main
diff --git a/gcc/testsuite/gfortran.dg/unsigned_7.f90 b/gcc/testsuite/gfortran.dg/unsigned_7.f90
new file mode 100644
index 00000000000..703c8abcbf7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_7.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Test bit functions, huge and digits.
+  unsigned :: u1, u2, u3
+  u1 = 32u
+  u2 = 64u
+  if (ior (u1,u2) /= u1 + u2) error stop 1
+  if (ior (32u,64u) /= 32u + 64u) error stop 2
+  u1 = 234u
+  u2 = 221u
+  if (iand (u1,u2) /= 200u) error stop 3
+  if (iand (234u,221u) /= 200u) error stop 4
+  if (ieor (u1,u2) /= 55u) error stop 5
+  if (ieor (234u,221u) /= 55u) error stop 6
+  u1 = huge(u1)
+  if (u1 /= 4294967295u) error stop 7
+  u2 = not(0u)
+  u3 = u2 - u1
+  if (u3 /= 0u) error stop 8
+  u2 = not(255u);
+  if (u2 /= huge(u2) - 255u) error stop 9
+  u1 = 255u
+  u2 = not(u1)
+  if (u2 /= huge(u2) - 255u) error stop 9
+  if (digits(u1) /= 32) error stop 10
+end
diff --git a/gcc/testsuite/gfortran.dg/unsigned_8.f90 b/gcc/testsuite/gfortran.dg/unsigned_8.f90
new file mode 100644
index 00000000000..f23056ab3bb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_8.f90
@@ -0,0 +1,70 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Test bit_size, btest and bgt plus friends.
+program main
+  implicit none
+  unsigned :: u
+  integer :: i, j
+  unsigned :: ui, uj
+  logical:: test_i, test_u
+  if (bit_size(u) /= 32) error stop 1
+  if (.not. btest(32,5)) error stop 2
+  if (btest(32,4)) error stop 3
+  u = 32u
+  if (btest(u,4)) error stop 4
+  do i=1,3
+     ui = uint(i)
+     do j=1,3
+        uj = uint(j)
+        test_i = blt(i,j)
+        test_u = blt(ui,uj)
+        if (test_i .neqv. test_u) error stop 5
+        test_i = ble(i,j)
+        test_u = ble(ui,uj)
+        if (test_i .neqv. test_u) error stop 6
+        test_i = bge(i,j)
+        test_u = bge(ui,uj)
+        if (test_i .neqv. test_u) error stop 7
+        test_i = bgt(i,j)
+        test_u = bgt(ui,uj)
+        if (test_i .neqv. test_u) error stop 8
+     end do
+  end do
+  if (blt (1, 1) .neqv. blt (1u, 1u)) error stop 8
+  if (ble (1, 1) .neqv. ble (1u, 1u)) error stop 9
+  if (bge (1, 1) .neqv. bge (1u, 1u)) error stop 10
+  if (bgt (1, 1) .neqv. bgt (1u, 1u)) error stop 11
+  if (blt (1, 2) .neqv. blt (1u, 2u)) error stop 12
+  if (ble (1, 2) .neqv. ble (1u, 2u)) error stop 13
+  if (bge (1, 2) .neqv. bge (1u, 2u)) error stop 14
+  if (bgt (1, 2) .neqv. bgt (1u, 2u)) error stop 15
+  if (blt (1, 3) .neqv. blt (1u, 3u)) error stop 16
+  if (ble (1, 3) .neqv. ble (1u, 3u)) error stop 17
+  if (bge (1, 3) .neqv. bge (1u, 3u)) error stop 18
+  if (bgt (1, 3) .neqv. bgt (1u, 3u)) error stop 19
+  if (blt (2, 1) .neqv. blt (2u, 1u)) error stop 20
+  if (ble (2, 1) .neqv. ble (2u, 1u)) error stop 21
+  if (bge (2, 1) .neqv. bge (2u, 1u)) error stop 22
+  if (bgt (2, 1) .neqv. bgt (2u, 1u)) error stop 23
+  if (blt (2, 2) .neqv. blt (2u, 2u)) error stop 24
+  if (ble (2, 2) .neqv. ble (2u, 2u)) error stop 25
+  if (bge (2, 2) .neqv. bge (2u, 2u)) error stop 26
+  if (bgt (2, 2) .neqv. bgt (2u, 2u)) error stop 27
+  if (blt (2, 3) .neqv. blt (2u, 3u)) error stop 28
+  if (ble (2, 3) .neqv. ble (2u, 3u)) error stop 29
+  if (bge (2, 3) .neqv. bge (2u, 3u)) error stop 30
+  if (bgt (2, 3) .neqv. bgt (2u, 3u)) error stop 31
+  if (blt (3, 1) .neqv. blt (3u, 1u)) error stop 32
+  if (ble (3, 1) .neqv. ble (3u, 1u)) error stop 33
+  if (bge (3, 1) .neqv. bge (3u, 1u)) error stop 34
+  if (bgt (3, 1) .neqv. bgt (3u, 1u)) error stop 35
+  if (blt (3, 2) .neqv. blt (3u, 2u)) error stop 36
+  if (ble (3, 2) .neqv. ble (3u, 2u)) error stop 37
+  if (bge (3, 2) .neqv. bge (3u, 2u)) error stop 38
+  if (bgt (3, 2) .neqv. bgt (3u, 2u)) error stop 39
+  if (blt (3, 3) .neqv. blt (3u, 3u)) error stop 40
+  if (ble (3, 3) .neqv. ble (3u, 3u)) error stop 41
+  if (bge (3, 3) .neqv. bge (3u, 3u)) error stop 42
+  if (bgt (3, 3) .neqv. bgt (3u, 3u)) error stop 43
+
+end
diff --git a/gcc/testsuite/gfortran.dg/unsigned_9.f90 b/gcc/testsuite/gfortran.dg/unsigned_9.f90
new file mode 100644
index 00000000000..1b0f095b32c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_9.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Test dshiftl, dshiftr, ibclr, ibset and ibits intrinsics.
+program main
+  unsigned :: u, v, w
+  integer :: i, j, k
+
+  u = 1u;  v = 4u
+  i = 1;   j = 4
+  if (int(dshiftl(u,v,12)) /= dshiftl(i,j,12)) error stop 1
+  if (int(dshiftl(1u,4u,12)) /= dshiftl(1,4,12)) error stop 2
+  if (int(dshiftr(u,v,12)) /= dshiftr(i,j,12)) error stop 3
+  if (int(dshiftr(1u,4u,12)) /= dshiftr(1,4,12)) error stop 4
+
+  k = 14
+
+  if (int(dshiftl(u,v,k)) /= dshiftl(i,j,k)) error stop 5
+  if (int(dshiftl(1u,4u,k)) /= dshiftl(1,4,k)) error stop 6
+  if (int(dshiftr(u,v,k)) /= dshiftr(i,j,k)) error stop 7
+  if (int(dshiftr(1u,4u,k)) /= dshiftr(1,4,k)) error stop 8
+
+  u = 255u
+  i = 255
+  do k=0,8
+     if (ibclr(i,k) /= int(ibclr(u,k))) error stop  9
+     if (ibset(i,k+4) /= int(ibset(u,k+4))) error stop 10
+  end do
+  if (ibclr(255,5) /= int(ibclr(255u,5))) error stop 11
+  if (ibset(255,10) /= int(ibset(255u,10))) error stop 12
+
+  if (uint(ibits(6,6,2)) /= ibits(6u,6,2)) error stop 13
+end program main
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index 82f8f3c5e9c..e71cbcf2376 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1775,4 +1775,6 @@ GFORTRAN_15 {
   global:
     _gfortran_internal_pack_class;
     _gfortran_internal_unpack_class;
+    _gfortran_transfer_unsigned;
+    _gfortran_transfer_unsigned_write;
 } GFORTRAN_14;
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 1c23676cc4c..2677551b277 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -861,9 +861,15 @@ internal_proto (transfer_array_inner);
 extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
 internal_proto(set_integer);
 
+extern void set_unsigned (void *, GFC_UINTEGER_LARGEST, int);
+internal_proto(set_unsigned);
+
 extern GFC_UINTEGER_LARGEST si_max (int);
 internal_proto(si_max);
 
+extern GFC_UINTEGER_LARGEST us_max (int);
+internal_proto(us_max);
+
 extern int convert_real (st_parameter_dt *, void *, const char *, int);
 internal_proto(convert_real);
 
@@ -891,6 +897,10 @@ internal_proto(read_radix);
 extern void read_decimal (st_parameter_dt *, const fnode *, char *, int);
 internal_proto(read_decimal);
 
+extern void read_decimal_unsigned (st_parameter_dt *, const fnode *, char *,
+				   int);
+internal_proto(read_decimal_unsigned);
+
 extern void read_user_defined (st_parameter_dt *, void *);
 internal_proto(read_user_defined);
 
@@ -941,6 +951,9 @@ internal_proto(write_f);
 extern void write_i (st_parameter_dt *, const fnode *, const char *, int);
 internal_proto(write_i);
 
+extern void write_iu (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_iu);
+
 extern void write_l (st_parameter_dt *, const fnode *, char *, int);
 internal_proto(write_l);
 
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 96b2efe854f..ba6d0f1289f 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -722,6 +722,86 @@ convert_integer (st_parameter_dt *dtp, int length, int negative)
   return 1;
 }
 
+/* Same as above, but for unsigneds, where overflow checks are only
+   preformed with -pedantic, except on the repeat count.  */
+
+static int
+convert_unsigned (st_parameter_dt *dtp, int length, int negative)
+{
+  char c, *buffer, message[IOMSG_LEN];
+  GFC_UINTEGER_LARGEST v, value, max, v_old;
+  int m;
+
+  if (compile_options.pedantic && negative)
+    goto overflow;
+
+  buffer = dtp->u.p.saved_string;
+  max = length == -1 ? MAX_REPEAT : us_max(length);
+
+  v = 0;
+  for (;;)
+    {
+      c = *buffer++;
+      if (c == '\0')
+	break;
+      c -= '0';
+      v_old = v;
+      v = v * 10 + c;
+
+      if (length == -1 && v > max)
+	goto overflow;
+      else if (compile_options.pedantic && v < v_old)
+	goto overflow;
+    }
+
+  m = 0;
+
+  if (length != -1)
+    {
+      if (negative)
+	value = -v;
+      else
+	value = v;
+
+      if (compile_options.pedantic && value > max)
+	goto overflow;
+      else
+	value = value & max;
+
+      set_unsigned (dtp->u.p.value, value, length);
+    }
+  else
+    {
+      dtp->u.p.repeat_count = v;
+
+      if (dtp->u.p.repeat_count == 0)
+	{
+	  snprintf (message, IOMSG_LEN, "Zero repeat count in item %d of list input",
+		   dtp->u.p.item_count);
+
+	  generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
+	  m = 1;
+	}
+    }
+  free_saved (dtp);
+  return m;
+
+ overflow:
+  if (length== -1)
+    snprintf (message, IOMSG_LEN, "Repeat count overflow in item %d of list input",
+	      dtp->u.p.item_count);
+  else if (negative)
+    snprintf (message, IOMSG_LEN, "Negative sign for unsigned integer "
+	      "in item %d of list input", dtp->u.p.item_count);
+  else
+    snprintf (message, IOMSG_LEN, "Unsigned integer overflow while reading "
+	      "item %d of list input", dtp->u.p.item_count);
+
+  free_saved (dtp);
+  generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
+
+  return 1;
+}
 
 /* Parse a repeat count for logical and complex values which cannot
    begin with a digit.  Returns nonzero if we are done, zero if we
@@ -990,11 +1070,10 @@ read_logical (st_parameter_dt *dtp, int length)
    used for repeat counts.  */
 
 static void
-read_integer (st_parameter_dt *dtp, int length)
+read_integer (st_parameter_dt *dtp, int length, bt type)
 {
   char message[IOMSG_LEN];
   int c, negative;
-
   negative = 0;
 
   c = next_char (dtp);
@@ -1055,8 +1134,11 @@ read_integer (st_parameter_dt *dtp, int length)
     }
 
  repeat:
-  if (convert_integer (dtp, -1, 0))
-    return;
+  if (type == BT_INTEGER)
+    {
+      if (convert_integer (dtp, -1, 0))
+	return;
+    }
 
   /* Get the real integer.  */
 
@@ -1077,6 +1159,9 @@ read_integer (st_parameter_dt *dtp, int length)
       return;
 
     case '-':
+      if (compile_options.pedantic && type == BT_UNSIGNED)
+	goto bad_integer;
+
       negative = 1;
       /* Fall through...  */
 
@@ -1127,8 +1212,13 @@ read_integer (st_parameter_dt *dtp, int length)
   else if (c != '\n')
     eat_line (dtp);
 
-  snprintf (message, IOMSG_LEN, "Bad integer for item %d in list input",
+  if (type == BT_INTEGER)
+    snprintf (message, IOMSG_LEN, "Bad integer for item %d in list input",
 	      dtp->u.p.item_count);
+  else
+    snprintf (message, IOMSG_LEN, "Bad unsigned for item %d in list input",
+	      dtp->u.p.item_count);
+
   free_line (dtp);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
 
@@ -1139,17 +1229,27 @@ read_integer (st_parameter_dt *dtp, int length)
   eat_separator (dtp);
 
   push_char (dtp, '\0');
-  if (convert_integer (dtp, length, negative))
+  if (type == BT_INTEGER)
+    {
+      if (convert_integer (dtp, length, negative)) /* XXX */
+	{
+	  free_saved (dtp);
+	  return;
+	}
+    }
+  else
     {
-       free_saved (dtp);
-       return;
+      if (convert_unsigned (dtp, length, negative)) /* XXX */
+	{
+	  free_saved (dtp);
+	  return;
+	}
     }
 
   free_saved (dtp);
-  dtp->u.p.saved_type = BT_INTEGER;
+  dtp->u.p.saved_type = type;
 }
 
-
 /* Read a character variable.  */
 
 static void
@@ -2224,7 +2324,8 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p,
   switch (type)
     {
     case BT_INTEGER:
-      read_integer (dtp, kind);
+    case BT_UNSIGNED:
+      read_integer (dtp, kind, type);
       break;
     case BT_LOGICAL:
       read_logical (dtp, kind);
@@ -2318,6 +2419,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p,
       break;
 
     case BT_INTEGER:
+    case BT_UNSIGNED:
     case BT_LOGICAL:
       memcpy (p, dtp->u.p.value, size);
       break;
@@ -3029,7 +3131,8 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset,
           switch (nl->type)
 	  {
 	  case BT_INTEGER:
-	    read_integer (dtp, len);
+	  case BT_UNSIGNED:
+	    read_integer (dtp, len, nl->type);
             break;
 
 	  case BT_LOGICAL:
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 7a9e341d7d8..78014e2ffe5 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -92,6 +92,62 @@ set_integer (void *dest, GFC_INTEGER_LARGEST value, int length)
     }
 }
 
+/* set_integer()-- All of the integer assignments come here to
+   actually place the value into memory.  */
+
+void
+set_unsigned (void *dest, GFC_UINTEGER_LARGEST value, int length)
+{
+  NOTE ("set_integer: %lld %p", (long long int) value, dest);
+  switch (length)
+    {
+#ifdef HAVE_GFC_UINTEGER_16
+#ifdef HAVE_GFC_REAL_17
+    case 17:
+      {
+	GFC_UINTEGER_16 tmp = value;
+	memcpy (dest, (void *) &tmp, 16);
+      }
+      break;
+#endif
+/* length=10 comes about for kind=10 real/complex BOZ, cf. PR41711. */
+    case 10:
+    case 16:
+      {
+	GFC_UINTEGER_16 tmp = value;
+	memcpy (dest, (void *) &tmp, length);
+      }
+      break;
+#endif
+    case 8:
+      {
+	GFC_UINTEGER_8 tmp = value;
+	memcpy (dest, (void *) &tmp, length);
+      }
+      break;
+    case 4:
+      {
+	GFC_UINTEGER_4 tmp = value;
+	memcpy (dest, (void *) &tmp, length);
+      }
+      break;
+    case 2:
+      {
+	GFC_UINTEGER_2 tmp = value;
+	memcpy (dest, (void *) &tmp, length);
+      }
+      break;
+    case 1:
+      {
+	GFC_UINTEGER_1 tmp = value;
+	memcpy (dest, (void *) &tmp, length);
+      }
+      break;
+    default:
+      internal_error (NULL, "Bad integer kind");
+    }
+}
+
 
 /* Max signed value of size give by length argument.  */
 
@@ -132,6 +188,28 @@ si_max (int length)
     }
 }
 
+GFC_UINTEGER_LARGEST
+us_max (int length)
+{
+  switch (length)
+    {
+#ifdef HAVE_GFC_UINTEGER_16
+    case 17:
+    case 16:
+      return GFC_UINTEGER_16_HUGE;
+#endif
+    case 8:
+      return GFC_UINTEGER_8_HUGE;
+    case 4:
+      return GFC_UINTEGER_4_HUGE;
+    case 2:
+      return GFC_UINTEGER_2_HUGE;
+    case 1:
+      return GFC_UINTEGER_1_HUGE;
+    default:
+      internal_error (NULL, "Bad unsigned kind");
+    }
+}
 
 /* convert_real()-- Convert a character representation of a floating
    point number to the machine number.  Returns nonzero if there is an
@@ -392,7 +470,7 @@ read_utf8 (st_parameter_dt *dtp, size_t *nbytes)
     if ((c & ~masks[nb-1]) == patns[nb-1])
       goto found;
   goto invalid;
-	
+
  found:
   c = (c & masks[nb-1]);
   nread = nb - 1;
@@ -423,7 +501,7 @@ read_utf8 (st_parameter_dt *dtp, size_t *nbytes)
     goto invalid;
 
   return c;
-      
+
  invalid:
   generate_error (&dtp->common, LIBERROR_READ_VALUE, "Invalid UTF-8 encoding");
   return (gfc_char4_t) '?';
@@ -466,7 +544,7 @@ read_default_char1 (st_parameter_dt *dtp, char *p, size_t len, size_t width)
   size_t m;
 
   s = read_block_form (dtp, &width);
-  
+
   if (s == NULL)
     return;
   if (width > len)
@@ -610,7 +688,7 @@ read_a_char4 (st_parameter_dt *dtp, const fnode *f, char *p, size_t length)
     read_utf8_char4 (dtp, p, length, w);
   else
     read_default_char4 (dtp, p, length, w);
-  
+
   dtp->u.p.sf_read_comma =
     dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA ? 0 : 1;
 }
@@ -651,7 +729,7 @@ next_char (st_parameter_dt *dtp, char **p, size_t *w)
   if (c != ' ')
     return c;
   if (dtp->u.p.blank_status != BLANK_UNSPECIFIED)
-    return ' ';  /* return a blank to signal a null */ 
+    return ' ';  /* return a blank to signal a null */
 
   /* At this point, the rest of the field has to be trailing blanks */
 
@@ -730,19 +808,19 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
       c = next_char (dtp, &p, &w);
       if (c == '\0')
 	break;
-	
+
       if (c == ' ')
         {
 	  if (dtp->u.p.blank_status == BLANK_NULL)
 	    {
 	      /* Skip spaces.  */
 	      for ( ; w > 0; p++, w--)
-		if (*p != ' ') break; 
+		if (*p != ' ') break;
 	      continue;
 	    }
 	  if (dtp->u.p.blank_status == BLANK_ZERO) c = '0';
         }
-        
+
       if (c < '0' || c > '9')
 	goto bad;
 
@@ -778,6 +856,119 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 
 }
 
+/* read_decimal_unsigned() - almost the same as above.  Checks for sign
+   and overflow are performed with -pedantic.  */
+
+void
+read_decimal_unsigned (st_parameter_dt *dtp, const fnode *f, char *dest,
+		       int length)
+{
+  GFC_UINTEGER_LARGEST value, old_value;
+  size_t w;
+  int negative;
+  char c, *p;
+
+  w = f->u.w;
+
+  /* This is a legacy extension, and the frontend will only allow such cases
+   * through when -fdec-format-defaults is passed.
+   */
+  if (w == (size_t) DEFAULT_WIDTH)
+    w = default_width_for_integer (length);
+
+  p = read_block_form (dtp, &w);
+
+  if (p == NULL)
+    return;
+
+  p = eat_leading_spaces (&w, p);
+  if (w == 0)
+    {
+      set_unsigned (dest, (GFC_UINTEGER_LARGEST) 0, length);
+      return;
+    }
+
+  negative = 0;
+
+  switch (*p)
+    {
+    case '-':
+      if (compile_options.pedantic)
+	goto no_sign;
+
+      negative = 1;
+
+      /* Fall through */
+
+    case '+':
+      p++;
+      if (--w == 0)
+	goto bad;
+      /* Fall through */
+
+    default:
+      break;
+    }
+
+  /* At this point we have a digit-string */
+  value = 0;
+
+  for (;;)
+    {
+      c = next_char (dtp, &p, &w);
+      if (c == '\0')
+	break;
+
+      if (c == ' ')
+	{
+	  if (dtp->u.p.blank_status == BLANK_NULL)
+	    {
+	      /* Skip spaces.  */
+	      for ( ; w > 0; p++, w--)
+		if (*p != ' ') break;
+	      continue;
+	    }
+	  if (dtp->u.p.blank_status == BLANK_ZERO) c = '0';
+	}
+
+      if (c < '0' || c > '9')
+	goto bad;
+
+      c -= '0';
+      old_value = value;
+      value = 10 * value + c;
+      if (compile_options.pedantic && value < old_value)
+	goto overflow;
+    }
+
+  if (negative)
+    value = -value;
+
+  if (compile_options.pedantic && value > us_max (length))
+    goto overflow;
+
+  set_unsigned (dest, value, length);
+  return;
+
+ bad:
+  generate_error (&dtp->common, LIBERROR_READ_VALUE,
+		  "Bad value during unsigned integer read");
+  next_record (dtp, 1);
+  return;
+
+ no_sign:
+  generate_error (&dtp->common, LIBERROR_READ_VALUE,
+		  "Negative sign for unsigned integer read");
+  next_record (dtp, 1);
+  return;
+
+ overflow:
+  generate_error (&dtp->common, LIBERROR_READ_OVERFLOW,
+		  "Value overflowed during unsigned integer read");
+  next_record (dtp, 1);
+
+}
+
 
 /* read_radix()-- This function reads values for non-decimal radixes.
    The difference here is that we treat the values here as unsigned
@@ -992,7 +1183,7 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
   if (w == 0)
     goto zero;
 
-  /* Check for Infinity or NaN.  */    
+  /* Check for Infinity or NaN.  */
   if (unlikely ((w >= 3 && (*p == 'i' || *p == 'I' || *p == 'n' || *p == 'N'))))
     {
       int seen_paren = 0;
@@ -1034,9 +1225,9 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 	  ++p;
 	  ++out;
 	}
-	 
+
       *out = '\0';
-      
+
       if (seen_paren != 0 && seen_paren != 2)
 	goto bad_float;
 
@@ -1133,7 +1324,7 @@ found_digit:
       ++p;
       --w;
     }
-  
+
   /* No exponent has been seen, so we use the current scale factor.  */
   exponent = - dtp->u.p.scale_factor;
   goto done;
@@ -1171,7 +1362,7 @@ exponent:
 	  ++p;
 	  --w;
 	}
-	
+
       /* Only allow trailing blanks.  */
       while (w > 0)
 	{
@@ -1180,7 +1371,7 @@ exponent:
 	  ++p;
 	  --w;
 	}
-    }    
+    }
   else  /* BZ or BN status is enabled.  */
     {
       while (w > 0)
@@ -1220,7 +1411,7 @@ done:
      significand.  */
   else if (!seen_int_digit && !seen_dec_digit)
     {
-      notify_std (&dtp->common, GFC_STD_LEGACY, 
+      notify_std (&dtp->common, GFC_STD_LEGACY,
 		  "REAL input of style 'E+NN'");
       *(out++) = '0';
     }
@@ -1313,20 +1504,20 @@ read_x (st_parameter_dt *dtp, size_t n)
   if ((dtp->u.p.current_unit->pad_status == PAD_NO || is_internal_unit (dtp))
       && dtp->u.p.current_unit->bytes_left < (gfc_offset) n)
     n = dtp->u.p.current_unit->bytes_left;
-    
+
   if (n == 0)
     return;
-    
+
   if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8)
     {
       gfc_char4_t c;
       size_t nbytes, j;
-    
+
       /* Proceed with decoding one character at a time.  */
       for (j = 0; j < n; j++)
 	{
 	  c = read_utf8 (dtp, &nbytes);
-    
+
 	  /* Check for a short read and if so, break out.  */
 	  if (nbytes == 0 || c == (gfc_char4_t)0)
 	    break;
@@ -1363,7 +1554,7 @@ read_x (st_parameter_dt *dtp, size_t n)
 	     the rest of the I/O statement.  Set the corresponding flag.  */
 	  if (dtp->u.p.advance_status == ADVANCE_NO || dtp->u.p.seen_dollar)
 	    dtp->u.p.eor_condition = 1;
-	    
+
 	  /* If we encounter a CR, it might be a CRLF.  */
 	  if (q == '\r') /* Probably a CRLF */
 	    {
@@ -1377,7 +1568,7 @@ read_x (st_parameter_dt *dtp, size_t n)
 	  goto done;
 	}
       n++;
-    } 
+    }
 
  done:
   if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ||
@@ -1386,4 +1577,3 @@ read_x (st_parameter_dt *dtp, size_t n)
   dtp->u.p.current_unit->bytes_left -= n;
   dtp->u.p.current_unit->strm_pos += (gfc_offset) n;
 }
-
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index a86099d46f5..64f394dddc7 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -56,6 +56,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
       transfer_complex
       transfer_real128
       transfer_complex128
+      transfer_unsigned
 
     and for WRITE
 
@@ -67,6 +68,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
       transfer_complex_write
       transfer_real128_write
       transfer_complex128_write
+      transfer_unsigned_write
 
     These subroutines do not return status. The *128 functions
     are in the file transfer128.c.
@@ -82,6 +84,12 @@ export_proto(transfer_integer);
 extern void transfer_integer_write (st_parameter_dt *, void *, int);
 export_proto(transfer_integer_write);
 
+extern void transfer_unsigned (st_parameter_dt *, void *, int);
+export_proto(transfer_unsigned);
+
+extern void transfer_unsigned_write (st_parameter_dt *, void *, int);
+export_proto(transfer_unsigned_write);
+
 extern void transfer_real (st_parameter_dt *, void *, int);
 export_proto(transfer_real);
 
@@ -1410,6 +1418,9 @@ type_name (bt type)
     case BT_INTEGER:
       p = "INTEGER";
       break;
+    case BT_UNSIGNED:
+      p = "UNSIGNED";
+      break;
     case BT_LOGICAL:
       p = "LOGICAL";
       break;
@@ -1485,6 +1496,31 @@ require_type (st_parameter_dt *dtp, bt expected, bt actual, const fnode *f)
   return 1;
 }
 
+/* Check that the actual matches one of two expected types; issue an error
+   if that is not the case.  */
+
+
+static int
+require_one_of_two_types (st_parameter_dt *dtp, bt expected1, bt expected2,
+			  bt actual, const fnode *f)
+{
+  char buffer[BUFLEN];
+
+  if (actual == expected1)
+    return 0;
+
+  if (actual == expected2)
+    return 0;
+
+  snprintf (buffer, BUFLEN,
+	    "Expected %s or %s for item %d in formatted transfer, got %s",
+	    type_name (expected1), type_name (expected2),
+	    dtp->u.p.item_count - 1, type_name (actual));
+
+  format_error (dtp, f, buffer);
+  return 1;
+
+}
 
 /* Check that the dtio procedure required for formatted IO is present.  */
 
@@ -1627,9 +1663,12 @@ formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind
 	case FMT_I:
 	  if (n == 0)
 	    goto need_read_data;
-	  if (require_type (dtp, BT_INTEGER, type, f))
+	  if (require_one_of_two_types (dtp, BT_INTEGER, BT_UNSIGNED, type, f))
 	    return;
-	  read_decimal (dtp, f, p, kind);
+	  if (type == BT_INTEGER)
+	    read_decimal (dtp, f, p, kind);
+	  else
+	    read_decimal_unsigned (dtp, f, p, kind);
 	  break;
 
 	case FMT_B:
@@ -2123,9 +2162,12 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
 	case FMT_I:
 	  if (n == 0)
 	    goto need_data;
-	  if (require_type (dtp, BT_INTEGER, type, f))
+	  if (require_one_of_two_types (dtp, BT_INTEGER, BT_UNSIGNED, type, f))
 	    return;
-	  write_i (dtp, f, p, kind);
+	  if (type == BT_INTEGER)
+	    write_i (dtp, f, p, kind);
+	  else
+	    write_iu (dtp, f, p, kind);
 	  break;
 
 	case FMT_B:
@@ -2608,6 +2650,18 @@ transfer_integer_write (st_parameter_dt *dtp, void *p, int kind)
   transfer_integer (dtp, p, kind);
 }
 
+void
+transfer_unsigned (st_parameter_dt *dtp, void *p, int kind)
+{
+    wrap_scalar_transfer (dtp, BT_UNSIGNED, p, kind, kind, 1);
+}
+
+void
+transfer_unsigned_write (st_parameter_dt *dtp, void *p, int kind)
+{
+  transfer_unsigned (dtp, p, kind);
+}
+
 void
 transfer_real (st_parameter_dt *dtp, void *p, int kind)
 {
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 91d1da2007a..2f414c6b57d 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -949,7 +949,134 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
   return;
 }
 
+/* Same as above, but somewhat simpler because we only treat unsigned
+   numbers.  */
 
+static void
+write_decimal_unsigned (st_parameter_dt *dtp, const fnode *f,
+			const char *source, int len)
+{
+  GFC_UINTEGER_LARGEST n = 0;
+  int w, m, digits, nsign, nzero, nblank;
+  char *p;
+  const char *q;
+  sign_t sign;
+  char itoa_buf[GFC_BTOA_BUF_SIZE];
+
+  w = f->u.integer.w;
+  m = f->format == FMT_G ? -1 : f->u.integer.m;
+
+  n = extract_uint (source, len);
+
+  /* Special case:  */
+  if (m == 0 && n == 0)
+    {
+      if (w == 0)
+	w = 1;
+
+      p = write_block (dtp, w);
+      if (p == NULL)
+	return;
+
+      if (unlikely (is_char4_unit (dtp)))
+	{
+	  gfc_char4_t *p4 = (gfc_char4_t *) p;
+	  memset4 (p4, ' ', w);
+	}
+      else
+	memset (p, ' ', w);
+      goto done;
+    }
+
+  /* Just in case somebody wants a + sign.  */
+  sign = calculate_sign (dtp, false);
+  nsign = sign == S_NONE ? 0 : 1;
+
+  q = gfc_itoa (n, itoa_buf, sizeof (itoa_buf));
+  digits = strlen (q);
+
+  /* Select a width if none was specified.  The idea here is to always
+     print something.  */
+  if (w == DEFAULT_WIDTH)
+    w = default_width_for_integer (len);
+
+  if (w == 0)
+    w = ((digits < m) ? m : digits) + nsign;
+
+  p = write_block (dtp, w);
+  if (p == NULL)
+    return;
+
+  nzero = 0;
+  if (digits < m)
+    nzero = m - digits;
+
+  /* See if things will work.  */
+
+  nblank = w - (nsign + nzero + digits);
+
+  if (unlikely (is_char4_unit (dtp)))
+    {
+      gfc_char4_t *p4 = (gfc_char4_t *)p;
+      if (nblank < 0)
+	{
+	  memset4 (p4, '*', w);
+	  goto done;
+	}
+
+      if (!dtp->u.p.namelist_mode)
+	{
+	  memset4 (p4, ' ', nblank);
+	  p4 += nblank;
+	}
+
+      if (sign == S_PLUS)
+	*p4++ = '+';
+
+      memset4 (p4, '0', nzero);
+      p4 += nzero;
+
+      memcpy4 (p4, q, digits);
+
+      if (dtp->u.p.namelist_mode)
+	{
+	  p4 += digits;
+	  memset4 (p4, ' ', nblank);
+	}
+
+      return;
+    }
+
+  if (nblank < 0)
+    {
+      star_fill (p, w);
+      goto done;
+    }
+
+  if (!dtp->u.p.namelist_mode)
+    {
+      memset (p, ' ', nblank);
+      p += nblank;
+    }
+
+  if (sign == S_PLUS)
+    *p++ = '+';
+
+  memset (p, '0', nzero);
+  p += nzero;
+
+  memcpy (p, q, digits);
+
+  if (dtp->u.p.namelist_mode)
+    {
+      p += digits;
+      memset (p, ' ', nblank);
+    }
+
+ done:
+  return;
+
+}
 /* Convert hexadecimal to ASCII.  */
 
 static const char *
@@ -1240,6 +1367,11 @@ write_i (st_parameter_dt *dtp, const fnode *f, const char *p, int len)
   write_decimal (dtp, f, p, len);
 }
 
+void
+write_iu (st_parameter_dt *dtp, const fnode *f, const char *p, int len)
+{
+  write_decimal_unsigned (dtp, f, p, len);
+}
 
 void
 write_b (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
@@ -1404,6 +1536,47 @@ write_integer (st_parameter_dt *dtp, const char *source, int kind)
   write_decimal (dtp, &f, source, kind);
 }
 
+/* Write a list-directed unsigned value.  We use the same formatting
+   as for integer.  */
+
+static void
+write_unsigned (st_parameter_dt *dtp, const char *source, int kind)
+{
+  int width;
+  fnode f;
+
+  switch (kind)
+    {
+    case 1:
+      width = 4;
+      break;
+
+    case 2:
+      width = 6;
+      break;
+
+    case 4:
+      width = 11;
+      break;
+
+    case 8:
+      width = 20;
+      break;
+
+    case 16:
+      width = 40;
+      break;
+
+    default:
+      width = 0;
+      break;
+    }
+  f.u.integer.w = width;
+  f.u.integer.m = -1;
+  f.format = FMT_NONE;
+  write_decimal_unsigned (dtp, &f, source, kind);
+}
+
 
 /* Write a list-directed string.  We have to worry about delimiting
    the strings if the file has been opened in that mode.  */
@@ -1942,6 +2115,9 @@ list_formatted_write_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
     case BT_INTEGER:
       write_integer (dtp, p, kind);
       break;
+    case BT_UNSIGNED:
+      write_unsigned (dtp, p, kind);
+      break;
     case BT_LOGICAL:
       write_logical (dtp, p, kind);
       break;
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index effa3732c18..faf57a33358 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -307,6 +307,15 @@ typedef GFC_UINTEGER_4 gfc_char4_t;
   (GFC_INTEGER_16)((((GFC_UINTEGER_16)1) << 127) - 1)
 #endif
 
+#define GFC_UINTEGER_1_HUGE ((GFC_UINTEGER_1) -1)
+#define GFC_UINTEGER_2_HUGE ((GFC_UINTEGER_2) -1)
+#define GFC_UINTEGER_4_HUGE ((GFC_UINTEGER_4) -1)
+#define GFC_UINTEGER_8_HUGE ((GFC_UINTEGER_8) -1)
+#ifdef HAVE_GFC_UINTEGER_16
+#define GFC_UINTEGER_16_HUGE ((GFC_UINTEGER_16) -1)
+#endif
+
+
 /* M{IN,AX}{LOC,VAL} need also infinities and NaNs if supported.  */
 
 #if __FLT_HAS_INFINITY__
@@ -2042,9 +2051,4 @@ extern int __snprintfieee128 (char *, size_t, const char *, ...)
 
 #endif
 
-/* We always have these.  */
-
-#define HAVE_GFC_UINTEGER_1 1
-#define HAVE_GFC_UINTEGER_4 1
-
 #endif  /* LIBGFOR_H  */
diff --git a/libgfortran/mk-kinds-h.sh b/libgfortran/mk-kinds-h.sh
index 0e0ec195875..647b3b6eadb 100755
--- a/libgfortran/mk-kinds-h.sh
+++ b/libgfortran/mk-kinds-h.sh
@@ -38,6 +38,7 @@ for k in $possible_integer_kinds; do
     echo "typedef GFC_INTEGER_${k} GFC_LOGICAL_${k};"
     echo "#define HAVE_GFC_LOGICAL_${k}"
     echo "#define HAVE_GFC_INTEGER_${k}"
+    echo "#define HAVE_GFC_UINTEGER_${k}"
     echo ""
   fi
   rm -f tmp$$.*
