!program TestFile
!    use ifport
!    implicit none
!    integer :: UnitNo, length
!    character (len=$MAXPATH) :: dir
!    dir ='C:\'
!    length = GETDRIVEDIRQQ(dir)
!    open(file='Test.txt', newunit=UnitNo, status='unknown',encoding='utf-8')
!    write(UnitNo, "('Text')")
!    write(UnitNo, '(a)') trim(dir)
!    write(*, '(a)') trim(dir)
!    pause
!    close(UnitNo, status='keep')
!    stop
!end program TestFile 
       program UserOpenSample
      IMPLICIT NONE
      EXTERNAL UOPEN
      INTEGER(4) UOPEN
      CHARACTER*10 :: FileName="UOPEN.DAT"
      INTEGER*4 :: IOS
      Character*255 :: InqFullName
      Character*100 :: InqFileName
      Integer :: InqLun
      Character*30 :: WriteOutBuffer="Write_One_Record_to_the_File. "
      Character*30 :: ReadInBuffer  ="??????????????????????????????"
110   FORMAT( X,A, ": Created (iostat=",I0,")")
115   FORMAT( X,A, ": Creation Failed (iostat=",I0,")")
120   FORMAT( X,A, ": ERROR: INQUIRE Returned Wrong FileName")
130   FORMAT( X,A, ": ERROR: ReadIn and WriteOut Buffers Do Not Match")
190   FORMAT( X,A, ": Completed.")
      WRITE(*,'(X,"Test the USEROPEN Facility of Open")')
      OPEN(UNIT=10,FILE='UOPEN.DAT',STATUS='REPLACE',USEROPEN=UOPEN, &
           IOSTAT=ios, ACTION='READWRITE')
     
!     When the OPEN statement is executed,
!     the UOPEN function receives control.
!     The function opens the file by calling CreateFile( ),
!     performs whatever operations were specified, and subsequently
!     returns control (with the handle returned by CreateFile( ))
!     to the calling Fortran program.
      IF (IOS .EQ. 0)  THEN
         WRITE(*,110) TRIM(FileName), IOS
         INQUIRE(10, NAME=InqFullName)
         CALL ParseForFileName(InqFullName,InqFileName)
         IF (InqFileName .NE. FileName) THEN
            WRITE(*,120) TRIM(FileName)
         END IF
      ELSE
         WRITE(*,115) TRIM(FileName), IOS
         GOTO 9999
      END IF
      WRITE(10,*) WriteOutBuffer
      REWIND(10)
      READ(10,*)  ReadInBuffer
      IF (ReadInBuffer .NE. WriteOutbuffer) THEN
         WRITE(*,130) TRIM(FileName)
      END IF
      CLOSE(10, DISPOSE='DELETE')
      WRITE(*,190) TRIM(FileName)
      WRITE(*,'(X,"Test of USEROPEN Completed")')
9999  CONTINUE
      END
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
! Here is the UOPEN function for WIN32:
!
! The UOPEN function is declared to use the default calling convention,
! so it matches the Fortran RTL declaration of a USEROPEN routine.
!
! The following function definition and arguments are passed from the Intel
! FortranŽ Run-time Library to the function named in USEROPEN:
!
! The first 7 arguments correspond to the CreateFile( ) API arguments.
! The value of these arguments is set according the caller's OPEN( )
! arguments:
!
! FILENAME
!      Is the address of a null-terminated character string that
!      is the name of the file.
! DESIRED_ACCESS
!      Is the desired access (read-write) mode passed by reference.
! SHARE_MODE
!      Is the file sharing mode passed by reference.
! A_NULL
!      Is always null. The Fortran runtime library always passes a NULL
!      for the pointer to a SECURITY_ATTRIBUTES structure in its
!      CreateFile( ) call.
! CREATE_DISP
!      Is the creation disposition specifying what action to take on files
!      that exist, and what action to take on files that do not exist. 
!      It is passed by reference.
! FLAGS_ATTR
!      Specifies the file attributes and flags for the file. It is passed
!      by reference.
! B_NULL
!      Is always null. The Fortran runtime library always passes a NULL
!      for the handle to a template file in its CreateFile( ) call.
!
! The last 2 arguments are the Fortran unit number and length of the
! file name:
! UNIT
!      Is the Fortran unit number on which this OPEN is being done. It is
!      passed by reference.
! FLEN
!      Is the length of the file name, not counting the terminating null.
!      It is passed by value.
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      INTEGER(4) FUNCTION UOPEN( FILENAME,       &
                              DESIRED_ACCESS, &
                              SHARE_MODE, &
                              A_NULL, &
                              CREATE_DISP, &
                              FLAGS_ATTR, &
                              B_NULL, &
                              UNIT, &
                              FLEN )
      !DIR$ ATTRIBUTES DEFAULT :: UOPEN
      USE KERNEL32
      IMPLICIT NONE
      INTEGER(4) DESIRED_ACCESS
      INTEGER(4) SHARE_MODE
      INTEGER(4) A_NULL
      INTEGER(4) CREATE_DISP
      INTEGER(4) FLAGS_ATTR
      INTEGER(4) B_NULL
      INTEGER(4) UNIT
      INTEGER(4) FLEN
      CHARACTER*(FLEN) FILENAME
      INTEGER(4) ISTAT
      TYPE(T_SECURITY_ATTRIBUTES), POINTER :: NULL_SEC_ATTR
140   FORMAT( X, "ERROR: USEROPEN Passed Wrong Unit Number",I)
!     Sanity check
      IF (UNIT .NE. 10) THEN
         WRITE(*,140) UNIT
      END IF
      !! WRITE(*,*) "FILENAME=",FILENAME !! prints the full path of the filename
! Set the FILE_FLAG_WRITE_THROUGH bit in the flag attributes to CreateFile( )
! (for whatever reason)
!     FLAGS_ATTR = FLAGS_ATTR + FILE_FLAG_WRITE_THROUGH
! Do the CreateFile( ) call and return the status to the Fortran rtl
      ISTAT = CreateFile( FILENAME,       &
                          DESIRED_ACCESS, &
                          SHARE_MODE, &
                          NULL_SEC_ATTR, &
                          CREATE_DISP, &
                          FLAGS_ATTR, &
                          0 )
      if (ISTAT == INVALID_HANDLE_VALUE) then
          write(*,*) "Could not open file (error ", GetLastError(),")"
      endif
      UOPEN = ISTAT
      RETURN
      END
!---------------------------------------------------------------
! SUBROUTINE: ParseForFileName
!             Takes a full pathname and returns the filename
!             with its extension.
!---------------------------------------------------------------
      SUBROUTINE ParseForFileName(FullName,FileName)
      Character*255 :: FullName
      Character*100 :: FileName
      Integer       :: P
!DIR$ IF DEFINED(_WIN32)
      P = INDEX(FullName,'\',.TRUE.)
      FileName = FullName(P+1:)
!DIR$ ELSE ! LINUX OS/OS X
      P = INDEX(FullName,'/',.TRUE.)
      FileName = FullName(P+1:)
!DIR$ ENDIF
      END