example_p Program

program example_p
   use, intrinsic :: iso_fortran_env, only: rk => real64
   implicit none

   real(rk), dimension(:), allocatable :: a

   print*, " "
   print*, "Running example..."

   call pure_subroutine(10.0_rk, 7, a)

contains

#ifndef NOPURE_DEBUG
   pure subroutine pure_subroutine(x, n, y)
#else
   impure subroutine pure_subroutine(x, n, y)
#endif
      use fordebug, only: timer, pwrite, ptimer_start, ptimer_stop
      implicit none

      real(rk), intent(in)               :: x
      integer,  intent(in)               :: n
      real(rk), intent(out), allocatable :: y(:)
      integer                            :: i
      type(timer)                        :: t
      real(rk)                           :: yi

      ! Print Rank 0 real64 with a message and format. message and format are optional
      call pwrite(message="x = ", R0r64=x, format="(a,f7.3)")

      ! Write Rank 0 real64 with a message and format to a file. message and format are optional
      call pwrite(message="x = ", R0r64=x, format="(a,f7.3)", file="example/example_p.txt", access="append")

      ! Print Rank 0 int32 with a message and format. message and format are optional
      call pwrite(message="n = ", R0i32=n, format="(a,i3)")

      ! Write Rank 0 int32 with a message and format to a file. message and format are optional
      call pwrite(message="n = ", R0i32=n, format="(a,i3)", file="example/example_p.txt", access="append")

      ! Print Rank 0 character with a format. format is optional
      call pwrite(R0ch="start loop", format="(a)")

      ! Write Rank 0 character with a format to a file. format, access are optional
      call pwrite(R0ch="start loop", format="(a)", file="example/example_p.txt", access="append")

      allocate(y(n))
      y(1) = 0.0_rk

      ! start pure timer
      call ptimer_start(t)

! nvfortran 25.5.0 -> NVFORTRAN-S-1074-Procedure call in Do Concurrent is not supported yet
#if defined (__NVCOMPILER) || defined(NOPURE_DEBUG)
      do i=2,n
#else
      do concurrent (i=2:n) shared(x, y) local(yi)
#endif
         yi = real(i-1, kind=rk) * x
         y(i) = yi

         ! Print Rank 0 real64 with a message and format. message and format are optional
         call pwrite(message="y(i) = ", R0r64=y(i), format="(a,f7.3)")

         ! ! Write Rank 0 real64 with a message and format to a file. message and format are optional
         ! call pwrite(message="y(i) = ", R0r64=y(i), format="(a,f7.3)", file="example/example_p.txt", access="append")
      end do

      ! stop pure timer
      call ptimer_stop(t)

      ! Print Rank 0 real64 with a message and format. message and format are optional
      call pwrite(R0ch="end loop", format="(a)") ! format is optional

      ! Write Rank 0 real64 with a message and format to a file. message and format are optional
      call pwrite(R0ch="end loop", format="(a)", file="example/example_p.txt", access="append")

      ! Print Rank 0 real64 with a message and format. message and format are optional
      call pwrite(message="y = ",R1r64=y)

      ! Write Rank 0 real64 with a message and format to a file. message and format are optional
      call pwrite(message="y = ",R1r64=y, file="example/example_p.txt", access="append")
   end subroutine pure_subroutine
end program example_p