! Copyright (C) 2001 by Fortran Library
!
! This source may be freely copied, modified, or distributed so long as the original
! copyright statement remains intact.
!
! Suggestions for improvment to the original posted version are welcome.  Comments
! should be sent to mailto:webmaster@fortranlib.com
!
! Version:  1.0, 4 August 2001, 21:20:00
!
! Purpose:  Routine to generate a Universally Unique Identifier
!
! A UUID is a 128 bit unique value.  It takes the following hexadecimal
! form:
!
!    6B29FC40-CA47-1067-B31D-00DD010662DA
!
! This routine returns the UUID value as an array of 16 8-bit integers
!
! System Requirements:  Requires Digital/Compaq/Intel) Visual Fortran (x86)
!                       Requires companion routine OSCALL.F90 (V2.0 or later/CREATEPROCESS version)
!                       Requires Win32 utility UUIDGEN.EXE, normally part of MS Visual Studio
!                       located in the COMMON/TOOLS directory.
!
! Routine Name:  uuIDGen
!
! lfn:  Default integer, unit number for work file open
!
! uuID:  Array of 16 8-bit bytes in the form of a signed integer
!
! iRet:  Default integer return code
!        0 = successful completion
!       -1 = size of uuID is incorrect
!       -2 = invalid hexadecimal data on UUID input
!       -3 = UUID work file open error
!
subroutine uuIDGen(LFN,uuID,iRet)

   implicit none

   character(16)             :: uuIDWorkFile = 'uuidwxyz.tmp' !Work file name to hold the UUID

   integer(1), intent(out)   :: uuID(16) !Array of 8-bit bytes
   integer, intent(in)       :: LFN      !Logical file number
   integer, intent(out)      :: iRet     !Return code
   integer                   :: ios      !IO return code (internal)
   integer                   :: k        !Loop counter
!
! Initialize return code
!
   iRet = 0
!
! Check buffer size
!
   if (size(uuID) .ne. 16) then
      iRet = -1
      return
   end if
!
! Generate the unique id (written to a scratch file)
!
   call oscall(-1,'UUIDGEN.EXE','/o' // trim(uuIDWorkFile),iRet) !-1= Wait for execution completion

   if (iRet .lt. 0 .or. iRet .eq. 4) return

   open(LFN,file=uuIDWorkFile,iostat=ios)

   if (ios .ne. 0) then
      iRet = -3
      return
   end if

   read(LFN,'(4z2,1x,2z2,1x,2z2,1x,2z2,1x,6z2)',iostat=ios) &
      (uuID(k),k= 1, 4), &
      (uuID(k),k= 5, 6), &
      (uuID(k),k= 7, 8), &
      (uuID(k),k= 9,10), &
      (uuID(k),k=11,16)

   if (ios .ne. 0) iRet = -2

   close(LFN,status='delete',iostat=ios)

   return

end subroutine