Consider the subroutine
subroutine test()
open(unit=1, file="test.txt", status="new")
end subroutine
Does the file automatically close at the end of subroutine test
? Or do files always need to be closed?
Thanks!
Consider the subroutine
subroutine test()
open(unit=1, file="test.txt", status="new")
end subroutine
Does the file automatically close at the end of subroutine test
? Or do files always need to be closed?
Thanks!
The file stays connected. Any other program unit can access the file through the logical unit 1. That is, no other information such as file descriptors or file handles are necessary to access the file.
My experience is, no they donât close automatically. You do need to close them manually.
It does not. But that behavior is very easy to achieve by wrapping the file unit number in a type with a finalizer:
type :: file
integer :: unit = -1
contains
final :: close_file
end type file
subroutine close_file(this)
type(file), intent(inout) :: this
if (this%unit /= -1) then
close(this%unit)
end if
end subroutine close_file
Your subroutine would then look as
subroutine test()
type(file) :: myfile
open(newunit=myfile%unit, file="test.txt", status="new")
end subroutine
and the file would be warranted to close, whenever myfile
goes out of scope.
Just curious @aradi , why in this case the file would be warranted to close? I mean, how do the subroutine test
know that it needs to call myfile%close_file
? Thanks.
Is it because the final
statement?
Looks very cool!
Yes, it is the final
statement, which is warranted to be executed when the instance goes out of scope.
Thanks! A follow up question: what is wrong with opening a file two times in a row with the same unit, without closing it? In general, why should a file be closed?
I guess the question is what are you trying to accomplish with this? Do you want two different sequences of i/o operations to occur on that file (i.e. two different file pointers)? Do you want file operations such as backspace, read, write, rewind that occur with one open statement to be independent of those that occur with the other statement? If they share the same unit number, how would that be accomplished? If the fortran program sees, for example backspace iunit
, then which file pointer is supposed to be reset?
As a practical matter, the file needs to be closed in order to change the i/o characteristics of the file. Just to give an example, what should happen if one open statement specified formatted i/o and the other open statement specifies unformatted i/o? The data structure that contains that information is associated with the unit number, so there is usually only one of those at a time. Having multiple units associated with the same file is also not allowed because, for example, a tape file has only one physical position at any one time. If you read/write/backspace/rewind the file through one unit number, then the other unit number cannot possibly continue to work as before unaffected. Even disk files would be like this if the file is truncted with one unit number, then i/o through the other unit number would be affected too.
@aradi - If there are multiple files to be opened and closed. Wouldnât this become more verbose? More statements like below with different unit numbers for each file (however close(unit) would be shorter in comparison):
type :: file1
integer :: unit = -1 ! for file 1
contains
final :: close_file
end type file
Similarly for another file ⌠and so on:
type :: file2
integer :: unit = -2 ! for file 2
contains
final :: close_file
end type file
Is there a better way to do this (may be take integer âunitâ as an allocatable variable and then use the same derived type )?
Nope. Use the same type, with a separate variable declaration of course, every place you want this behavior.
i.e.
type :: file
integer :: unit = -1
contains
final :: close_file
end type file
subroutine close_file(this)
type(file), intent(inout) :: this
if (this%unit /= -1) then
close(this%unit)
end if
end subroutine close_file
subroutine test()
type(file) :: file1, file2
open(newunit=file1%unit, file="test1.txt", status="new")
open(newunit=file2%unit, file="test2.txt", status="new")
end subroutine
and both files will automatically be close.
thank you @everythingfunctional.
unit = -2 is a valid unit number that can be returned using the NEWUNIT= specifier in an OPEN statement.
A value of unit = -1 is specifically excluded by Fortran 2008 section 9.5.6.12
Actually, to make it really robust, it should be made sure, that you never call close()
on the %unit
of an instance, but always let the finalizer to close an open file. We usually achieve that by always making the type(file)
instances allocatable, allocate them when a file is opened, and deallocate them, when a file should be closed. The %unit
field of an instance is never modified directly from outside, only used in read/write operations as unit identifier. (It would optimally have the protected
attribute, if that existed for derived type componentsâŚ)
subroutine open_file(fname, ..., newfile)
character(*), intent(in) :: fname
...
type(file), allocatable :: newfile
allocate(newfile)
open(newunit=newfile%unit, file=fname, ...)
end subroutine open_file
subroutine test()
type(file), allocatable :: file1, file2
call open_file("myfile1.dat", ..., file1)
call open_file("myfile2.dat", ..., file2)
! Use the unit numbers in the allocated descriptors
write(file1%unit, "(a)") "Hello"
write(file2%unit, "(a)") "Something else"
! If you want to close a file explicitely, deallocate descriptor
deallocate(file1)
! file2 is still allocated, it will be deallocated and closed, when leaving scope
end subroutine test
(The ...
marks further possible options you want to pass/use when opening the file.)
Does the file automatically close at the end of subroutine test
? NO
Or do files always need to be closed? NO
Why use âunit=1â ? Using unit numbers in the range 1 to 7 (possibly 10) can interfere with operating system defaults.
It is cleaner to close the file, as it does indicate the file access is no longer required.
All OSes (that I know, at least) put some, not-so-high-as-one-could-expect, limit on the number of files that a process can simultaneously open. So if you have to analyze data from several hundred or thousand files, you will have to close some of them to be able to open the other.
Some OSes allow the user to set higher limit, some donât (e.g. Ubuntu 20.04 has 1024 files soft limit, 1M files hard limit but older CentOS 6.10 has 4096 files as both soft and hard limit), so YMMV
A related question: Do opened files close automatically at the end of the program? For example, is it okay to assume that the OS closes opened files automatically at the end of the whole execution of a program?
Yes, AFAIK always.
Yes, both preconnected files and files explicitly opened are closed at normal program termination, which can be a stop statement anywhere in the program or when the main program terminates without a stop statement. An exception to this is when something like âcall exit()â occurs, where exit is the POSIX operating system function. In this case, the program just stops without flushing buffers or closing files. However, some fortran compilers overload âexitâ so it does do file cleanup before stopping. I think ERROR STOP also cleans up files before program termination.
Thanks very much for the info! Because I was not sure about this, I always wrote explicit close
statements even for files opened throughout the program. Assuming the OS closes those files automatically, do you think it is not particularly risky to omit such close
statements? (Of course, if files are used for a given scope or a given time in the program, I will explicitly close them.)
I too always close explicitly, and use iostat and iomsg clauses but I cannot recall any situation where iostat has come back non-zero except possibly if I closed the file already!
I think the root of this issue is about âwho is Fortran forâ; a professional computer scientist might be quite happy to let things drop silently out of scope, or close on completion, but a domain expert might be much happier doing things explicitly so the code makes sense years later. Even when they have done no Fortran since they wrote the original program.
I am reminded of the phrase about two types of code - so complex it is not obviously wrong, or so simple that it is obviously not wrong.