Re: [Patch, Fortran] -fcoarray=single implementation of the atomic subroutines

[Tobias Burnus <burnus at net-b dot de>]

Daniel Kraft wrote:
> > Build and regtested on x86-64-linux.
> > OK for the trunk?
> Ok.  Just one thought:
>
> +  if (!(atom->ts.type == BT_INTEGER&&  atom->ts.kind == gfc_c_int_kind)
> +&&  !(atom->ts.type == BT_LOGICAL&&  atom->ts.kind == gfc_c_int_kind))
>
> What about defining another constant for atomic_int_kind rather than
> gfc_c_int_kind, in case we want to change this in the future?

I did so now - as discussed in #gfortran; cf. trans-types.c.

Comitted as Rev. 174510; cf. attachment.

Tobais
Index: gcc/testsuite/gfortran.dg/coarray_atomic_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_atomic_1.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/coarray_atomic_1.f90	(Revision 0)
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single -std=f2008" }
+!
+! PR fortran/18918
+!
+! Diagnostic for atomic subroutines
+!
+use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
+implicit none
+integer(atomic_int_kind) :: a(1)[*]
+logical(1) :: c[*]
+integer(atomic_int_kind) :: b
+logical(atomic_logical_kind) :: d, e[*]
+
+call atomic_define(a, 7_2) ! { dg-error "must be a scalar" }
+call atomic_ref(b, b) ! { dg-error "shall be a coarray" }
+
+call atomic_define(c, 7) ! { dg-error "an integer of ATOMIC_INT_KIND or a logical of ATOMIC_LOGICAL_KIND" }
+call atomic_ref(d, a(1)) ! { dg-error "shall have the same type" }
+call atomic_ref(.true., e) ! { dg-error "shall be definable" }
+end
Index: gcc/testsuite/gfortran.dg/coarray/atomic_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/atomic_1.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/coarray/atomic_1.f90	(Revision 0)
@@ -0,0 +1,27 @@
+! { dg-do run }
+!
+! PR fortran/18918
+!
+! Basic atomic def/ref test
+!
+
+use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
+implicit none
+integer(atomic_int_kind) :: a(1)[*]
+logical(atomic_logical_kind) :: c[*]
+intrinsic :: atomic_define
+intrinsic :: atomic_ref
+integer(8) :: b
+logical(1) :: d
+
+call atomic_define(a(1), 7_2)
+call atomic_ref(b, a(1))
+if (b /= a(1)) call abort()
+
+call atomic_define(c, .false.)
+call atomic_ref(d, c[this_image()])
+if (d .neqv. .false.) call abort()
+call atomic_define(c[this_image()], .true.)
+call atomic_ref(d, c)
+if (d .neqv. .true.) call abort()
+end
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(Revision 174509)
+++ gcc/testsuite/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,9 @@
+2011-05-31  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/18918
+	* gfortran.dg/coarray_atomic_1.f90: New.
+	* gfortran.dg/coarray/atomic_1.f90: New.
+
 2011-05-31  Jakub Jelinek  <jakub@redhat.com>
 
 	* gcc.dg/guality/bswaptest.c: New test.
Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c	(Revision 174509)
+++ gcc/fortran/intrinsic.c	(Arbeitskopie)
@@ -51,7 +51,7 @@
 
 enum klass
 { CLASS_IMPURE = 0, CLASS_PURE, CLASS_ELEMENTAL,
-  CLASS_INQUIRY, CLASS_TRANSFORMATIONAL };
+  CLASS_INQUIRY, CLASS_TRANSFORMATIONAL, CLASS_ATOMIC };
 
 #define ACTUAL_NO	0
 #define ACTUAL_YES	1
@@ -2880,6 +2880,18 @@
 
   make_noreturn();
 
+  add_sym_2s ("atomic_define", GFC_ISYM_ATOMIC_DEF, CLASS_ATOMIC,
+	      BT_UNKNOWN, 0, GFC_STD_F2008,
+	      gfc_check_atomic_def, NULL, gfc_resolve_atomic_def,
+	      "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
+	      "value", BT_INTEGER, di, REQUIRED, INTENT_IN);
+
+  add_sym_2s ("atomic_ref", GFC_ISYM_ATOMIC_REF, CLASS_ATOMIC,
+	      BT_UNKNOWN, 0, GFC_STD_F2008,
+	      gfc_check_atomic_ref, NULL, gfc_resolve_atomic_ref,
+	      "value", BT_INTEGER, di, REQUIRED, INTENT_OUT,
+	      "atom", BT_INTEGER, di, REQUIRED, INTENT_IN);
+
   add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME, CLASS_IMPURE, BT_UNKNOWN, 0,
 	      GFC_STD_F95, gfc_check_cpu_time, NULL, gfc_resolve_cpu_time,
 	      tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
Index: gcc/fortran/iso-fortran-env.def
===================================================================
--- gcc/fortran/iso-fortran-env.def	(Revision 174509)
+++ gcc/fortran/iso-fortran-env.def	(Arbeitskopie)
@@ -38,9 +38,9 @@
      -- the standard that supports this type  */ 
 
 NAMED_INTCST (ISOFORTRANENV_FILE_ATOMIC_INT_KIND, "atomic_int_kind", \
-              gfc_default_integer_kind, GFC_STD_F2008)
+              gfc_atomic_int_kind, GFC_STD_F2008)
 NAMED_INTCST (ISOFORTRANENV_FILE_ATOMIC_LOGICAL_KIND, "atomic_logical_kind", \
-              gfc_default_logical_kind, GFC_STD_F2008)
+              gfc_atomic_logical_kind, GFC_STD_F2008)
 NAMED_INTCST (ISOFORTRANENV_CHARACTER_STORAGE_SIZE, "character_storage_size", \
               gfc_character_storage_size, GFC_STD_F2003)
 NAMED_INTCST (ISOFORTRANENV_ERROR_UNIT, "error_unit", GFC_STDERR_UNIT_NUMBER, \
Index: gcc/fortran/intrinsic.h
===================================================================
--- gcc/fortran/intrinsic.h	(Revision 174509)
+++ gcc/fortran/intrinsic.h	(Arbeitskopie)
@@ -39,6 +39,8 @@
 gfc_try gfc_check_associated (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_atan_2 (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_atan2 (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_atomic_def (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_atomic_ref (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_besn (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_bessel_n2 (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_try gfc_check_bge_bgt_ble_blt (gfc_expr *, gfc_expr *);
@@ -414,6 +416,8 @@
 void gfc_resolve_atan (gfc_expr *, gfc_expr *);
 void gfc_resolve_atanh (gfc_expr *, gfc_expr *);
 void gfc_resolve_atan2 (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_atomic_def (gfc_code *);
+void gfc_resolve_atomic_ref (gfc_code *);
 void gfc_resolve_besn (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_bessel_n2 (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *a);
 void gfc_resolve_btest (gfc_expr *, gfc_expr *, gfc_expr *);
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(Revision 174509)
+++ gcc/fortran/gfortran.h	(Arbeitskopie)
@@ -306,6 +306,8 @@
   GFC_ISYM_ATAN,
   GFC_ISYM_ATAN2,
   GFC_ISYM_ATANH,
+  GFC_ISYM_ATOMIC_DEF,
+  GFC_ISYM_ATOMIC_REF,
   GFC_ISYM_BGE,
   GFC_ISYM_BGT,
   GFC_ISYM_BIT_SIZE,
@@ -2464,6 +2466,8 @@
 extern int gfc_default_logical_kind;
 extern int gfc_default_complex_kind;
 extern int gfc_c_int_kind;
+extern int gfc_atomic_int_kind;
+extern int gfc_atomic_logical_kind;
 extern int gfc_intio_kind;
 extern int gfc_charlen_int_kind;
 extern int gfc_numeric_storage_size;
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(Revision 174509)
+++ gcc/fortran/ChangeLog	(Arbeitskopie)
@@ -1,6 +1,35 @@
 2011-05-31  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/18918
+	* intrinsic.c (klass): Add CLASS_ATOMIC.
+	(add_subroutines): Add atomic_ref/atomic_define.
+	* intrinsic.texi (ATOMIC_REF, ATOMIC_DEFINE): Document.
+	* intrinsic.h (gfc_check_atomic_def, gfc_check_atomic_ref,
+	gfc_resolve_atomic_def, gfc_resolve_atomic_ref): New prototypes.
+	* gfortran.h (gfc_isym_id): Add GFC_ISYM_ATOMIC_DEF
+	and GFC_ISYM_ATOMIC_REF.
+	(gfc_atomic_int_kind, gfc_atomic_logical_kind): New global vars.
+	* iresolve.c (gfc_resolve_atomic_def, gfc_resolve_atomic_ref): New
+	functions.
+	* check.c (gfc_check_atomic, gfc_check_atomic_def,
+	gfc_check_atomic_ref): New functions.
+	* iso-fortran-env.def (ISOFORTRANENV_FILE_ATOMIC_INT_KIND,
+	ISOFORTRANENV_FILE_ATOMIC_LOGICAL_KIND): Change kind value.
+	* trans-intrinsic.c (conv_intrinsic_atomic_def,
+	conv_intrinsic_atomic_ref, gfc_conv_intrinsic_subroutine): New
+	functions.
+	(conv_intrinsic_move_alloc) Renamed from
+	gfc_conv_intrinsic_move_alloc - and made static.
+	* trans.h (gfc_conv_intrinsic_move_alloc): Remove.
+	(gfc_conv_intrinsic_subroutine) Add prototype.
+	* trans.c (trans_code): Call gfc_conv_intrinsic_subroutine.
+	* trans-types (gfc_atomic_int_kind, gfc_atomic_logical_kind): New
+	global vars.
+	(gfc_init_kinds): Set them.
+
+2011-05-31  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/18918
 	* trans-array.c (gfc_trans_dummy_array_bias): Handle
 	cobounds of assumed-shape arrays.
 
Index: gcc/fortran/trans.c
===================================================================
--- gcc/fortran/trans.c	(Revision 174509)
+++ gcc/fortran/trans.c	(Arbeitskopie)
@@ -1245,15 +1245,20 @@
 	     dependency check, too.  */
 	  {
 	    bool is_mvbits = false;
+
+	    if (code->resolved_isym)
+	      {
+		res = gfc_conv_intrinsic_subroutine (code);
+		if (res != NULL_TREE)
+		  break;
+	      }
+
 	    if (code->resolved_isym
 		&& code->resolved_isym->id == GFC_ISYM_MVBITS)
 	      is_mvbits = true;
-	    if (code->resolved_isym
-		&& code->resolved_isym->id == GFC_ISYM_MOVE_ALLOC)
-	      res = gfc_conv_intrinsic_move_alloc (code);
-	    else
-	      res = gfc_trans_call (code, is_mvbits, NULL_TREE,
-				    NULL_TREE, false);
+
+	    res = gfc_trans_call (code, is_mvbits, NULL_TREE,
+				  NULL_TREE, false);
 	  }
 	  break;
 
Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c	(Revision 174509)
+++ gcc/fortran/trans-types.c	(Arbeitskopie)
@@ -118,6 +118,8 @@
 int gfc_default_logical_kind;
 int gfc_default_complex_kind;
 int gfc_c_int_kind;
+int gfc_atomic_int_kind;
+int gfc_atomic_logical_kind;
 
 /* The kind size used for record offsets. If the target system supports
    kind=8, this will be set to 8, otherwise it is set to 4.  */
@@ -578,6 +580,10 @@
   /* Pick a kind the same size as the C "int" type.  */
   gfc_c_int_kind = INT_TYPE_SIZE / 8;
 
+  /* Choose atomic kinds to match C's int.  */
+  gfc_atomic_int_kind = gfc_c_int_kind;
+  gfc_atomic_logical_kind = gfc_c_int_kind;
+
   /* initialize the C interoperable kinds  */
   init_c_interop_kinds();
 }
Index: gcc/fortran/trans.h
===================================================================
--- gcc/fortran/trans.h	(Revision 174509)
+++ gcc/fortran/trans.h	(Arbeitskopie)
@@ -345,7 +345,8 @@
 /* Find the appropriate variant of a math intrinsic.  */
 tree gfc_builtin_decl_for_float_kind (enum built_in_function, int);
 
-/* Intrinsic function handling.  */
+/* Intrinsic procedure handling.  */
+tree gfc_conv_intrinsic_subroutine (gfc_code *);
 void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *);
 
 /* Is the intrinsic expanded inline.  */
@@ -356,8 +357,6 @@
    gfc_inline_intrinsic_function_p returns true.  */
 int gfc_is_intrinsic_libcall (gfc_expr *);
 
-tree gfc_conv_intrinsic_move_alloc (gfc_code *);
-
 /* Used to call ordinary functions/subroutines
    and procedure pointer components.  */
 int gfc_conv_procedure_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *,
Index: gcc/fortran/iresolve.c
===================================================================
--- gcc/fortran/iresolve.c	(Revision 174509)
+++ gcc/fortran/iresolve.c	(Arbeitskopie)
@@ -2895,6 +2895,22 @@
 
 
 void
+gfc_resolve_atomic_def (gfc_code *c)
+{
+  const char *name = "atomic_define";
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_atomic_ref (gfc_code *c)
+{
+  const char *name = "atomic_ref";
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
 gfc_resolve_mvbits (gfc_code *c)
 {
   static const sym_intent INTENTS[] = {INTENT_IN, INTENT_IN, INTENT_IN,
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c	(Revision 174509)
+++ gcc/fortran/check.c	(Arbeitskopie)
@@ -973,6 +973,72 @@
 }
 
 
+static gfc_try
+gfc_check_atomic (gfc_expr *atom, gfc_expr *value)
+{
+  if (!(atom->ts.type == BT_INTEGER && atom->ts.kind == gfc_atomic_int_kind)
+      && !(atom->ts.type == BT_LOGICAL
+	   && atom->ts.kind == gfc_atomic_logical_kind))
+    {
+      gfc_error ("ATOM argument at %L to intrinsic function %s shall be an "
+		 "integer of ATOMIC_INT_KIND or a logical of "
+		 "ATOMIC_LOGICAL_KIND", &atom->where, gfc_current_intrinsic);
+      return FAILURE;
+    }
+
+  if (!gfc_expr_attr (atom).codimension)
+    {
+      gfc_error ("ATOM argument at %L of the %s intrinsic function shall be a "
+		 "coarray or coindexed", &atom->where, gfc_current_intrinsic);
+      return FAILURE;
+    }
+
+  if (atom->ts.type != value->ts.type)
+    {
+      gfc_error ("ATOM and VALUE argument of the %s intrinsic function shall "
+		 "have the same type at %L", gfc_current_intrinsic,
+		 &value->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_atomic_def (gfc_expr *atom, gfc_expr *value)
+{
+  if (scalar_check (atom, 0) == FAILURE || scalar_check (value, 1) == FAILURE)
+    return FAILURE;
+
+  if (gfc_check_vardef_context (atom, false, NULL) == FAILURE)
+    {
+      gfc_error ("ATOM argument of the %s intrinsic function at %L shall be "
+		 "definable", gfc_current_intrinsic, &atom->where);
+      return FAILURE;
+    }
+
+  return gfc_check_atomic (atom, value);
+}
+
+
+gfc_try
+gfc_check_atomic_ref (gfc_expr *value, gfc_expr *atom)
+{
+  if (scalar_check (value, 0) == FAILURE || scalar_check (atom, 1) == FAILURE)
+    return FAILURE;
+
+  if (gfc_check_vardef_context (value, false, NULL) == FAILURE)
+    {
+      gfc_error ("VALUE argument of the %s intrinsic function at %L shall be "
+		 "definable", gfc_current_intrinsic, &value->where);
+      return FAILURE;
+    }
+
+  return gfc_check_atomic (atom, value);
+}
+
+
 /* BESJN and BESYN functions.  */
 
 gfc_try
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c	(Revision 174509)
+++ gcc/fortran/trans-intrinsic.c	(Arbeitskopie)
@@ -6952,9 +6952,45 @@
 }
 
 
-tree
-gfc_conv_intrinsic_move_alloc (gfc_code *code)
+static tree
+conv_intrinsic_atomic_def (gfc_code *code)
 {
+  gfc_se atom, value;
+  stmtblock_t block;
+
+  gfc_init_se (&atom, NULL);
+  gfc_init_se (&value, NULL);
+  gfc_conv_expr (&atom, code->ext.actual->expr);
+  gfc_conv_expr (&value, code->ext.actual->next->expr);
+
+  gfc_init_block (&block);
+  gfc_add_modify (&block, atom.expr,
+		  fold_convert (TREE_TYPE (atom.expr), value.expr));
+  return gfc_finish_block (&block);
+}
+
+
+static tree
+conv_intrinsic_atomic_ref (gfc_code *code)
+{
+  gfc_se atom, value;
+  stmtblock_t block;
+
+  gfc_init_se (&atom, NULL);
+  gfc_init_se (&value, NULL);
+  gfc_conv_expr (&value, code->ext.actual->expr);
+  gfc_conv_expr (&atom, code->ext.actual->next->expr);
+
+  gfc_init_block (&block);
+  gfc_add_modify (&block, value.expr,
+		  fold_convert (TREE_TYPE (value.expr), atom.expr));
+  return gfc_finish_block (&block);
+}
+
+
+static tree
+conv_intrinsic_move_alloc (gfc_code *code)
+{
   if (code->ext.actual->expr->rank == 0)
     {
       /* Scalar arguments: Generate pointer assignments.  */
@@ -7002,4 +7038,33 @@
 }
 
 
+tree
+gfc_conv_intrinsic_subroutine (gfc_code *code)
+{
+  tree res;
+
+  gcc_assert (code->resolved_isym);
+
+  switch (code->resolved_isym->id)
+    {
+    case GFC_ISYM_MOVE_ALLOC:
+      res = conv_intrinsic_move_alloc (code);
+      break;
+
+    case GFC_ISYM_ATOMIC_DEF:
+      res = conv_intrinsic_atomic_def (code);
+      break;
+
+    case GFC_ISYM_ATOMIC_REF:
+      res = conv_intrinsic_atomic_ref (code);
+      break;
+
+    default:
+      res = NULL_TREE;
+      break;
+    }
+
+  return res;
+}
+
 #include "gt-fortran-trans-intrinsic.h"
Index: gcc/fortran/intrinsic.texi
===================================================================
--- gcc/fortran/intrinsic.texi	(Revision 174509)
+++ gcc/fortran/intrinsic.texi	(Arbeitskopie)
@@ -61,6 +61,8 @@
 * @code{ATAN}:          ATAN,      Arctangent function
 * @code{ATAN2}:         ATAN2,     Arctangent function
 * @code{ATANH}:         ATANH,     Inverse hyperbolic tangent function
+* @code{ATOMIC_DEFINE}: ATOMIC_DEFINE, Setting a variable atomically
+* @code{ATOMIC_REF}:    ATOMIC_REF, Obtaining the value of a variable atomically
 * @code{BESSEL_J0}:     BESSEL_J0, Bessel function of the first kind of order 0
 * @code{BESSEL_J1}:     BESSEL_J1, Bessel function of the first kind of order 1
 * @code{BESSEL_JN}:     BESSEL_JN, Bessel function of the first kind
@@ -1546,6 +1548,100 @@
 
 
 
+@node ATOMIC_DEFINE
+@section @code{ATOMIC_DEFINE} --- Setting a variable atomically
+@fnindex ATOMIC_DEFINE
+@cindex Atomic subroutine, define
+
+@table @asis
+@item @emph{Description}:
+@code{ATOMIC_DEFINE(ATOM, VALUE)} defines the variable @var{ATOM} with the value
+@var{VALUE} atomically.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Atomic subroutine
+
+@item @emph{Syntax}:
+@code{CALL ATOMIC_DEFINE(ATOM, VALUE)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ATOM}   @tab Scalar coarray or coindexed variable of either integer
+                        type with @code{ATOMIC_INT_KIND} kind or logical type
+                        with @code{ATOMIC_LOGICAL_KIND} kind.
+@item @var{VALURE} @tab Scalar and of the same type as @var{ATOM}. If the kind
+                        is different, the value is converted to the kind of
+                        @var{ATOM}.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program atomic
+  use iso_fortran_env
+  integer(atomic_int_kind) :: atom[*]
+  call atomic_define (atom[1], this_image())
+end program atomic
+@end smallexample
+
+@item @emph{See also}:
+@ref{ATOMIC_REF}, @ref{ISO_FORTRAN_ENV}
+@end table
+
+
+
+@node ATOMIC_REF
+@section @code{ATOMIC_REF} --- Obtaining the value of a variable atomically
+@fnindex ATOMIC_REF
+@cindex Atomic subroutine, reference
+
+@table @asis
+@item @emph{Description}:
+@code{ATOMIC_DEFINE(ATOM, VALUE)} atomically assigns the value of the
+variable @var{ATOM} to @var{VALUE}.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Atomic subroutine
+
+@item @emph{Syntax}:
+@code{CALL ATOMIC_REF(VALUE, ATOM)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{VALURE} @tab Scalar and of the same type as @var{ATOM}. If the kind
+                        is different, the value is converted to the kind of
+                        @var{ATOM}.
+@item @var{ATOM}   @tab Scalar coarray or coindexed variable of either integer
+                        type with @code{ATOMIC_INT_KIND} kind or logical type
+                        with @code{ATOMIC_LOGICAL_KIND} kind.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program atomic
+  use iso_fortran_env
+  logical(atomic_logical_kind) :: atom[*]
+  logical :: val
+  call atomic_ref (atom, .false.)
+  ! ...
+  call atomic_ref (atom, val)
+  if (val) then
+    print *, "Obtained"
+  end if
+end program atomic
+@end smallexample
+
+@item @emph{See also}:
+@ref{ATOMIC_DEFINE}, @ref{ISO_FORTRAN_ENV}
+@end table
+
+
+
 @node BESSEL_J0
 @section @code{BESSEL_J0} --- Bessel function of the first kind of order 0
 @fnindex BESSEL_J0