mod_fileio.f90

Go to the documentation of this file.

 
 
!-----------------------------------------------------------------------------!
 
module m_fileio
!-----------------------------------------------------------------------------!
!
!   +-------+    ALKYON Hydraulic Consultancy & Research
!   |       |    Gerbrant van Vledder
!   |   +---+
!   |   | +---+  Last update: 8 Feb. 2003
!   +---+ |   |
!         +---+
!
! Module for storing file i/o related variables
!
! The values for the parameter i_log, i_prt and iw_tst must be set
! in one of the routines of the host program or in subroutine sys_init
!
! Version 1.1   29 May  2000   Initial version
!         1.2   21 Sep. 2001   Form=binary added (B)
!         1.3    5 Oct. 2001   Form=direct access, unformatted, fixed record (R)
!         1.4   24 Aug. 2002   Bug fixed and restructure of test output
!         1.5    8 Feb. 2003   Error check included when incorrect path (Z_FILEIO)
!
!-----------------------------------------------------------------------------!
! The following two parameters must be set by the user
! They define the overall test level and the output channel
!
integer,parameter :: i_print=0
!
integer,parameter :: i_out=6
!------------------------------------------------------------------------------
!
! Standard switches to activate Logging, Test and Print ouput
!
integer i_log
integer i_prt
integer i_tst
!
!
! Standard unit numbers of input & output files
!
integer lu_err
integer lu_inp
integer lu_log
integer lu_prt
integer lu_tst
!
contains
  
!-----------------------------------------------------------------------------!
  
subroutine z_fileio(filename,qual,iufind,iunit,iostat)                        !
!-----------------------------------------------------------------------------!
!
!   +-------+    ALKYON Hydraulic Consultancy & Research
!   |       |    Gerbrant van Vledder
!   |   +---+
!   |   | +---+
!   +---+ |   |
!         +---+
!
USE constants, ONLY: file_endian
implicit none
!
!  0. Update history
!
!     24/07/1999  First version
!     28/09/1999  Module name changed from FILEOPEN -> Z_FILEIO
!     27/10/1999  Option to delete an existing file added
!     18/11/1999  Argument IUNIT used to control use of Z_FLUNIT
!     22/11/1999  Parameter iunit not changed unless by z_flunit
!     28/12/1999  Interface with Z_FLUNIT updated and
!                 input parameter iufind added
!     14/04/2000  Module m_fileio included in this routine
!     25/05/2000  Module m_fileio excluded, if an already opened file is
!                 found, the corresponding unit number is assigned to output
!     21/09/2001  Form=binary added, extension to Fortran 95 standard
!      5/10/2001  Form=fixed Record length, as specified in input argument
!     17/06/2002  Initialisation of IUNIT=-1 included
!     24/08/2002  Bug fixed when routine called with IUFIND=0
!     08/02/2003  Bug fixed when file could not be created due to invalid path 
!
!  1. Purpose
!
!     Open file with name FILENAME and determine unit number IUNIT
!     With file type determined in QUAL
!
!     Depending on the value of IUFIND a search is performed for a
!     free unit number
!
!  2. Method
!
!     If file exists then
!       if QUAL = 'D'
!         delete file
!       Else
!         inquire if file opened
!         If opened
!           determine unit number
!         Else
!           If iunit >= 10 Find free unit number
!           Open file with unit number and file qualifier
!         End if
!       End if
!     Else
!       If QUAL='SNU'
!         If iunit >= 10 find free unit number
!         Open new file with unit number and qualifier
!       Else
!         Iunit = -1   File does not exist
!       End if
!     End if
!
!
!  3. Parameter list
!
!Type       I/O           Name           Description
!----------------------------------------------------
character(len=*), intent(in)  :: filename
character(len=2), intent(in)  :: qual
integer,   intent(in)         :: iufind
integer,   intent(inout)      :: iunit
integer,   intent(out)        :: iostat
!
!  4. Subroutines used
!
!     Z_FLUNIT
!
!  5. Error messages
!
!     IUNIT > 0    File exists, is (already) connected to unit number IUNIT, or is
!                  created and connected to unit number
!     IUNIT == 0   File has been deleted or does not exist
!           < 0    An error occurred, no file or unit number found
!
!     IOSTAT =  0   No errors detected
!              -1   Incorrect file qualifier
!              -2   Unit number does not exist
!              -3   Attempt to open non-existing file with status=OLD
!              -4   Attempt to open existing file with wrong FORMATTING
!              -5   Incorrect value for IUFIND: not in range [0,1]
!              -6   File could not be created due to,e.g. incorrect path
!
!  6. Remarks
!
!     1) Use of file qualifier:
!
!        1st char: O(ld),R(eplace),S(cratch),
!                  U(nknown),(D)elete
!        2nd char: F(ormatted),U(nformatted),B(inary)
!
!     2) Use of IUFIND
!
!        if IUFIND==0, No search is performed for a free unit number
!                 ==1, A search is performed in routine Z_FLUNIT
!
!     3) This routine is based on routine FOR from
!        SWAN version 40.00 of Delft University of Technology
!
!------------------------------------------------------------------------------
! Local variables
!
character(len=7)  :: cstat
character(len=11) :: cform
integer junit
logical lexist
logical lopen
integer iuerr
!-------------------------------------------------------------------------------------
! initialisations
!-------------------------------------------------------------------------------------
iostat = 0
if(iufind==1) iunit  = -1
!
!
!  Check value of IUFIND
!
if(iufind/=0 .and. iufind/=1) then
  if(i_print >0) write(i_out,*) 'Z_FILEIO: Incorrect value for IUFIND:',iufind
  iostat = -5
  goto 9999
end if
!
!
!  check input argument QUAL
!
if(i_print>=1) write(i_out,*) 'Z_FILEIO/A:',trim(filename),' ',qual,iunit,iostat
!
if (index('ORSUD',qual(1:1)) ==0 .or. index('FUB',qual(2:2)) ==0) then
  if(i_print > 0) write(i_out,*) 'Incorrect file qualifier'
  iostat = -1
else
  if(qual(1:1) == 'O') cstat = 'old'
  if(qual(1:1) == 'R') cstat = 'replace'
  if(qual(1:1) == 'S') cstat = 'scratch'
  if(qual(1:1) == 'U') cstat = 'unknown'
  if(qual(1:1) == 'D') cstat = 'delete'
!
  if(qual(2:2) == 'F') cform = 'formatted'
  if(qual(2:2) == 'U') cform = 'unformatted'
  if(qual(2:2) == 'B') cform = 'binary'          
  if(qual(2:2) == 'R') cform = 'unformatted'
!
!  Check if file exists
!
  inquire(file=filename,exist=lexist)
  if(i_print >=2) write(i_out,*) 'Z_FILEIO  file exists?:',trim(filename),':',lexist
!
!  delete file if it exists and qual == 'D'
!
  if(lexist .and. qual(1:1)=='D') then
    inquire(file=filename,opened=lopen)
    if(lopen) then
      inquire(file=filename,number=junit)
    else
      if(iufind == 1) call z_flunit(iunit,iuerr)
      junit = iunit
      if(junit > 0) then
        if( cform == 'unformatted') then
          open(file=filename,unit=junit,form=cform,convert=file_endian,iostat=iostat)
        else  
          open(file=filename,unit=junit,form=cform,iostat=iostat)
        end if 
        if(iostat/=0) then
          iostat = -4
          goto 9999
        end if
      end if
    end if
    close(junit,status=cstat)
    goto 9999
  end if
!
!  if the file exists, check if it is opened
!
  if(lexist) then
    if(i_print >=2) write(i_out,*) 'Z_FILEIO: File exists:',trim(filename)
    inquire(file=filename,opened=lopen)
    if(lopen) then
      if(i_print >=2) write(i_out,*) 'Z_FILEIO: File is opened:',trim(filename)
!
!  determine unit number to which this file is connected
!  and assign it to the output number
!
      inquire(file=filename,number=junit)
      if(i_print >=2) write(i_out,*) 'Z_FILEIO: File is connected to unit:', junit
      iunit = junit
    else
!
!  if the file exists and not connected to a unit number, search a free unit number
!
      if(i_print >=2) write(i_out,*) 'Z_FILEIO: File is not connected to a unit number'
      if(iufind==0) then
        if(i_print >=2) write(i_out,*) 'Z_FILEIO: Assign user defined unit number:',iunit
      elseif(iufind==1) then
        call z_flunit(iunit,iuerr)
        if(i_print >=2) write(i_out,*) 'Z_FILEIO: New unit number IUNIT:',iunit
      end if
      junit = iunit
!
      if(junit > 0) then
        if( cform == 'unformatted') then
          open(file=filename,unit=junit,form=cform,convert=file_endian,status=cstat)
        else
          open(file=filename,unit=junit,form=cform,status=cstat)
        end if
      else
        iostat = -2
      end if
   end if
!
!  the file does not exist, so open it and find a free unit number
!
  else
!
    if(i_print>=2) then
       write(i_out,*) 'Z_FILEIO: File does not exist !'
       write(i_out,*) 'Z_FILEIO: Qual:',qual(1:1)
    end if
!
    if(index('SRU',qual(1:1)) > 0) then
      if(iufind==1) then
        call z_flunit(iunit,iuerr)
        if(i_print >=1) write(i_out,*) 'Z_FILEIO: New unit number IUNIT:',iunit
      end if
      junit = iunit
!
!  open file to IUNIT, if possible
!
      if(junit > 0) then
        if( cform == 'unformatted') then
          open(file=filename,unit=junit,form=cform,convert=file_endian,iostat=iuerr)
        else
          open(file=filename,unit=junit,form=cform,iostat=iuerr)
        end if
!
! check added 8/2/2003
!
        if(iuerr/=0) then
          iunit = -1
          iostat = -6
        end if
      else
        iostat = -2
      end if
!
!  file cannot be opened because it does not exist
!
    elseif('O'==qual(1:1)) then   ! File should exist
      if(i_print>=2) write(i_out,*) 'Z_FILEIO: File cannot be opened because it does not exist'
      iostat = -3
    end if
  end if
end if
!
9999 continue
!
if(i_print>=1) write(i_out,*) 'Z_FILEIO/Z:',trim(filename),' ',qual,iunit,iostat
!
return
end  subroutine
!
!-----------------------------------------------------------------------------!
 
subroutine z_fclose(iunit)                                                    !
!-----------------------------------------------------------------------------!
!
!   +-------+    ALKYON Hydraulic Consultancy & Research
!   |       |    Gerbrant van Vledder
!   |   +---+
!   |   | +---+
!   +---+ |   |
!         +---+
!
implicit none
!
!  0. Update history
!
!     0.01 24/08/2000  First version
!
!  1. Purpose
!
!     Close file with unit number IUNIT, and set IUNIT=-1
!
!  2. Method
!
!
!  3. Parameter list
!
!Type       I/O           Name           Description
!-----------------------------------------------------------------------------
integer, intent(inout)  :: iunit          
!-----------------------------------------------------------------------------
close(iunit)
iunit = -1
!
return
end subroutine
!
!-----------------------------------------------------------------------------!
 
subroutine z_flunit(iunit,ierr)                                               !
!-----------------------------------------------------------------------------!
!
!   +-------+    ALKYON Hydraulic Consultancy & Research
!   |       |    Gerbrant van Vledder
!   |   +---+
!   |   | +---+
!   +---+ |   |
!         +---+
!
implicit none
!
!  0. Update history
!
!     Version   Date    Modification
!
!     0.01  24/07/1999  Initial version
!     0.02  01/10/1999  Extra check added to ensure maximum unit number
!     0.03  07/10/1999  Check of existence of uni number deleted,
!                       since this test produces different answer
!                       on Lahey compiler
!     0.04  25/11/1999  Intent added
!     0.05  24/12/1999  Module M_GENVAR added for information about range of unit numbers
!     0.06  27/12/1999  Module M_GENVAR replaced by M_FILEIO
!                       Check added for forbidden unit numbers
!     0.07  28/12/1999  Internal checks added and IERR added to parameter list
!     0.08  08/02/2000  User of lu_min & lu_max deleted
!     0.09  14/04/2000  Module m_fileio included in this routine
!
!  1. Purpose
!
!     Find a free unit number
!
!  2. Method
!
!     Starting at LU_MIN till LU_MAX are investigated until
!     a free (i.e. not connected to a file) is found.
!     Use is made of the standard fortran INQUIRE function.
!     The values of LU_MIN and LU_MAX should be specified
!     in an initialisation routine
!
!  3. Parameter list
!
!Type     I/O           Name         Description
!----------------------------------------------------------
integer, intent(out) :: iunit
integer, intent(out) :: ierr
!
!  4. Subroutines used
!
!     None
!
!  5. Error messages
!
!     ierr=0   No errors encountered
!          1   Invalud combination lu_low >= lu_high
!          2   Invalid value for lu_low
!          3   Invalid value for lu_high
!          4   No free unit number could be found
!
!  6. Remarks
!
!     If no free unit number if found in the range
!     lu_min - lu_high, then the function returns IUNIT = -1
!
!     The switch i_print can be used to generate test output
!
!----------------------------------------------------------------------------------
! local parameters
!
integer junit
logical lopen
logical lnot
integer i_not
!
!---------------------------------------------------------------------------------
!  range of unit numbers to search
!
integer, parameter :: lu_min=60
integer, parameter :: lu_max=200
!
! specification of forbidden unit numbers
!
integer, parameter :: lu_nr=3
integer lu_not(lu_nr)
!----------------------------------------------------------------------------------
lu_not(1) = 100
lu_not(2) = 101
lu_not(3) = 102
!-----------------------------------------------------------------------------------
!
ierr = 0
!
if(i_print >= 2) then
  write(i_out,*) 'Z_FLUNIT: forbidden     :',lu_not
  write(i_out,*) 'Z_FLUNIT: lu_min lu_max :',lu_min,lu_max
end if
!
!  check data specified in Module Z_FILEIO
!
if(lu_min >= lu_max) then
  ierr = 1
  write(i_out,*) 'Z_FLUNIT: Incorrect boundaries for LU_MIN & LU_MAX:',&
&            lu_min,lu_max
end if
!
junit = lu_min
!
iunit = -1
!
do while (iunit ==-1)
!
! Check if unit number is free, i.e. not in use by an opened file
!
   inquire(unit=junit,opened=lopen)
!
!  check if unit number is not a forbidden unit number
!
   lnot = .false.
   do i_not=1,lu_nr
     if(lu_not(i_not)==junit) then
       lnot = .true.
       if(i_print >= 1) write(i_out,*) 'Z_FLUNIT: a forbidden unit number was encountered:',junit
     end if
   end do
!
   if(lopen.or.lnot) then
      junit = junit + 1
   else
      iunit = junit
   end if
   if(junit > lu_max) exit
end do
!
if(iunit < 0) then
  write(i_out,*) 'ERROR in Z_FLUNIT: No free unit number could be found'
end if
!
return
end subroutine
!
end module