!
! *****************************************************************
! *                                                               *
! *    Copyright (c) Digital Equipment Corporation, 1995          *
! *                                                               *
! *   All Rights Reserved.  Unpublished rights  reserved  under   *
! *   the copyright laws of the United States.                    *
! *                                                               *
! *   The software contained on this media  is  proprietary  to   *
! *   and  embodies  the  confidential  technology  of  Digital   *
! *   Equipment Corporation.  Possession, use,  duplication  or   *
! *   dissemination of the software and media is authorized only  *
! *   pursuant to a valid written license from Digital Equipment  *
! *   Corporation.                                                *
! *                                                               *
! *   RESTRICTED RIGHTS LEGEND   Use, duplication, or disclosure  *
! *   by the U.S. Government is subject to restrictions  as  set  *
! *   forth in Subparagraph (c)(1)(ii)  of  DFARS  252.227-7013,  *
! *   or  in  FAR 52.227-19, as applicable.                       *
! *                                                               *
! *****************************************************************
!
! HISTORY
!
! $RCSfile: io_example.f90,v $ $Revision: 1.1.2.8 $ (DEC) $Date:
! 1994/08/12 15:0
! 1:37 $

module parallel_temporary_files
  integer, private :: highest_unit_number = 90
  integer, private :: maximum_unit_number = 99
contains
  extrinsic(hpf_local) subroutine parallel_open(unit_number, ok)
    integer, intent(out)           :: unit_number
    logical, optional, intent(out) :: ok
    character*8                    :: file_name
    integer                        :: mynode
    if(highest_unit_number <= maximum_unit_number) then
      unit_number = highest_unit_number
      highest_unit_number = highest_unit_number + 1
      mynode = my_processor()
      write(unit=file_name, fmt='(a3,i2.2,i3.3)')    &
        'tmp', unit_number, mynode
    else
      if (present(ok)) then
        ok = .false.
      else
        print *, 'error on open, too many temporary files'
        stop
      end if
    end if
    open(unit=unit_number,   status= 'new',         &
         form='unformatted', file=file_name,        &
         iostat=jj,          err=100)
    if (present(ok)) then
      ok = .true.
    end if
    return
    100 if (present(ok)) then
          ok = .false.
        else
          print *, 'error on open, iostat=', jj
          stop
        end if
  end subroutine parallel_open

  extrinsic(hpf_local) subroutine parallel_write(unit_number, a, ok)
    integer, intent(in)               :: unit_number
    integer, dimension(:), intent(in) :: a
      !hpf$ distribute *(block) :: a 
    logical, optional, intent(out)    :: ok
    character*60                      :: file_name

    inquire(unit=unit_number, name=file_name)
    write(unit_number, err=100, iostat=jj) a
    if (present(ok)) then
      ok = .true.
    end if
    return
    100 if (present(ok)) then
          ok = .false.
        else
          print *, 'error on write, iostat=', jj
          stop
        end if
  end subroutine parallel_write

  extrinsic(hpf_local) subroutine parallel_read(unit_number, a, ok)
    integer, intent(in)                :: unit_number
    integer, dimension(:), intent(out) :: a
      !hpf$ distribute *(block) :: a
    logical, optional, intent(out)     :: ok

    read(unit_number, err=100, iostat=jj) a
    if (present(ok)) then
      ok = .true.
    end if
    return
    100 if (present(ok)) then
          ok = .false.
        else
          print *, 'error on read, iostat=', jj
          stop
        end if
  end subroutine parallel_read

  extrinsic (hpf_local) subroutine parallel_rewind(unit_number, ok)
    integer, intent(in)            :: unit_number
    logical, optional, intent(out) :: ok
    rewind(unit=unit_number, iostat=jj, err=100)
    if (present(ok)) then
      ok = .true.
    end if
    return
    100 if (present(ok)) then
          ok = .false.
        else
          print *, 'error on rewind, iostat=', jj
          stop
        end if
  end subroutine parallel_rewind

  extrinsic (hpf_local) subroutine parallel_close(unit_number, ok)
    integer, intent(in)            :: unit_number
    logical, optional, intent(out) :: ok
    close(unit=unit_number, status='delete', iostat=jj, err=100)
    if (present(ok)) then
      ok = .true.
    end if
    return
    100 if (present(ok)) then
          ok = .false.
        else
          print *, 'error on close, iostat=', jj
          stop
        end if
  end subroutine parallel_close
end module parallel_temporary_files

program main
  use parallel_temporary_files
  integer, parameter    :: n=12
  integer               :: temp_unit
  logical               :: ok
  integer, dimension(n) :: data
    !hpf$ distribute data(block)
  integer, dimension(n) :: b
    !hpf$ distribute b(block)


  forall (i=1:n) data(i) = i

  do i=1,2
    b = 0
    call parallel_open(temp_unit, ok)
    print *, "in main:", "open", temp_unit
    call parallel_write(temp_unit, data, ok)
    print *, "in main:", "write", temp_unit, ok
    call parallel_rewind(temp_unit, ok)
    print *, "in main:", "rewind", temp_unit, ok
    if (ok) call parallel_read(temp_unit, b)
    call parallel_close(temp_unit)
    if(any(b /= (/ (i, i=1,n ) /))) then
      print *, 'ERROR'
    else
      print *, 'OK!!!'
    endif
  enddo

end program main
