!-----------------------------------------------------------------------------!
module m_fileio
!-----------------------------------------------------------------------------!
!
! +-------+ ALKYON Hydraulic Consultancy & Research
! | | Gerbrant van Vledder
! | +---+
! | | +---+ Last update: 8 Feb. 2003
! +---+ | |
! +---+
!
!
! SWAN (Simulating WAves Nearshore); a third generation wave model
! Copyright (C) 1993-2014 Delft University of Technology
!
! This program is free software; you can redistribute it and/or
! modify it under the terms of the GNU General Public License as
! published by the Free Software Foundation; either version 2 of
! the License, or (at your option) any later version.
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU General Public License for more details.
!
! A copy of the GNU General Public License is available at
! http://www.gnu.org/copyleft/gpl.html#SEC3
! or by writing to the Free Software Foundation, Inc.,
! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
!
!
! 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 ! (0/1/2) Test output printing off/on
! ! Output channel defined by i_out
!
integer,parameter :: i_out=6 ! Output channel to screen
! ! ==1 screen output for Unix/Linux systems
! ! ==6 screen output for Windows
!------------------------------------------------------------------------------
!
! Standard switches to activate Logging, Test and Print ouput
!
integer i_log ! (0/1) Logging off/on
integer i_prt ! (0/1) Printing off/on
integer i_tst ! (0,1,2...) Test level off/on
!
!
! Standard unit numbers of input & output files
!
integer lu_err ! standard error file
integer lu_inp ! standard input file
integer lu_log ! standard logging
integer lu_prt ! standard print output
integer lu_tst ! standard test output
!
character(len=80) :: tempfile ! temporary file to be used for parallel computing
!
contains
!-----------------------------------------------------------------------------!
subroutine z_fileio(filename,qual,iufind,iunit,iostat) !
!-----------------------------------------------------------------------------!
!
! +-------+ ALKYON Hydraulic Consultancy & Research
! | | Gerbrant van Vledder
! | +---+
! | | +---+
! +---+ | |
! +---+
!
!
! SWAN (Simulating WAves Nearshore); a third generation wave model
! Copyright (C) 1993-2014 Delft University of Technology
!
! This program is free software; you can redistribute it and/or
! modify it under the terms of the GNU General Public License as
! published by the Free Software Foundation; either version 2 of
! the License, or (at your option) any later version.
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU General Public License for more details.
!
! A copy of the GNU General Public License is available at
! http://www.gnu.org/copyleft/gpl.html#SEC3
! or by writing to the Free Software Foundation, Inc.,
! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
!
!
use M_PARALL
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
! 27/08/2004 Appending node number to FILENAME in case of parallel computing
!
! 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(inout) :: filename ! File name
character(len=2), intent(in) :: qual ! File qualifyer
integer, intent(in) :: iufind ! Indicator for search of unit number
integer, intent(inout) :: iunit ! Unit number
integer, intent(out) :: iostat ! Error indicator
!
! 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 ! string with status of file I/O
character(len=11) :: cform ! string with format of file I/O
integer junit ! temporary unit number
logical lexist ! indicator if a file exists
logical lopen ! indicator if a file is opened
integer iuerr ! error indicator from Z_FLUNIT
integer ilpos ! start position for appending node number
!-------------------------------------------------------------------------------------
! 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
!
if ( PARLL .and. iunit <= 0 ) then
ilpos = index ( filename, ' ' )-1
write(filename(ilpos+1:ilpos+4),33) INODE
endif
33 format('-',i3.3)
!
!
! 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' ! extension to FORTRAN 95 standard
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
open(file=filename,unit=junit,form=cform,iostat=iostat)
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
open(file=filename,unit=junit,form=cform,status=cstat)
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
open(file=filename,unit=junit,form=cform,iostat=iuerr)
!
! 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
! | +---+
! | | +---+
! +---+ | |
! +---+
!
!
! SWAN (Simulating WAves Nearshore); a third generation wave model
! Copyright (C) 1993-2014 Delft University of Technology
!
! This program is free software; you can redistribute it and/or
! modify it under the terms of the GNU General Public License as
! published by the Free Software Foundation; either version 2 of
! the License, or (at your option) any later version.
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU General Public License for more details.
!
! A copy of the GNU General Public License is available at
! http://www.gnu.org/copyleft/gpl.html#SEC3
! or by writing to the Free Software Foundation, Inc.,
! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
!
!
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 ! Unit number
!-----------------------------------------------------------------------------
close(iunit)
iunit = -1
!
return
end subroutine
!
!-----------------------------------------------------------------------------!
subroutine z_flunit(iunit,ierr) !
!-----------------------------------------------------------------------------!
!
! +-------+ ALKYON Hydraulic Consultancy & Research
! | | Gerbrant van Vledder
! | +---+
! | | +---+
! +---+ | |
! +---+
!
!
! SWAN (Simulating WAves Nearshore); a third generation wave model
! Copyright (C) 1993-2014 Delft University of Technology
!
! This program is free software; you can redistribute it and/or
! modify it under the terms of the GNU General Public License as
! published by the Free Software Foundation; either version 2 of
! the License, or (at your option) any later version.
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU General Public License for more details.
!
! A copy of the GNU General Public License is available at
! http://www.gnu.org/copyleft/gpl.html#SEC3
! or by writing to the Free Software Foundation, Inc.,
! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
!
!
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 ! resulting unit number
integer, intent(out) :: ierr ! error level
!
! 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 ! counter for unit numbers
logical lopen ! indicator if a unit number is connected to a file
logical lnot ! indicates if a forbidden unit number is checked
integer i_not ! counter to check forbidded unit numbers
!
!---------------------------------------------------------------------------------
! range of unit numbers to search
!
integer, parameter :: lu_min=60 ! minimum unit number
integer, parameter :: lu_max=200 ! maximum unit number
!
! specification of forbidden unit numbers
!
integer, parameter :: lu_nr=3 ! number of forbidden unit numbers
integer lu_not(lu_nr) ! list of forbidden unit numbers
!----------------------------------------------------------------------------------
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