Skip to content

Commit

Permalink
update File
Browse files Browse the repository at this point in the history 
- added an exist test when using loadbin and loadtxt
  • Loading branch information
@keurfonluu
keurfonluu committed Jan 15, 2018
1 parent 3c80383 commit 318b68b
Show file tree
Hide file tree
Showing 2 changed files with 167 additions and 115 deletions.
2 changes: 1 addition & 1 deletion README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@ Forlab is a Fortran module that provides a lot of functions for scientific compu

| | |
|:-:|---|
| **Version:** | 1.0.1 |
| **Version:** | 1.0.2 |
| **Author:** | Keurfon Luu |
| **Web site:** | https://github.com/keurfonluu/forlab |
| **Copyright:** | This document has been placed in the public domain. |
Expand Down
280 changes: 166 additions & 114 deletions src/lib/forlab.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -63,11 +63,11 @@ module forlab
integer(kind = IPRE) :: unit
character(len = CLEN) :: filename
contains
generic, public :: open => open1, open2
procedure, private :: open1, open2
procedure, private :: open1, open2, countlines1, file_exist
procedure, public :: close
generic, public :: open => open1, open2
generic, public :: countlines => countlines1
procedure, private :: countlines1
generic, public :: exist => file_exist
end type File

!=======================================================================
Expand Down Expand Up @@ -3065,6 +3065,28 @@ subroutine eig(A, V, d, itermax)
return
end subroutine eig

!=======================================================================
! file_exist
!-----------------------------------------------------------------------
! file_exist determines whether a File object already exists.
!
! Syntax
!-----------------------------------------------------------------------
! exist = ofile % exist()
!
! Description
!-----------------------------------------------------------------------
! call ofile % exist() returns .true. if the File object ofile exists,
! .false. otherwise.
!=======================================================================

logical function file_exist(self)
class(File), intent(inout) :: self

inquire(file = trim(self % filename), exist = file_exist)
return
end function file_exist

!=======================================================================
! eye
!-----------------------------------------------------------------------
Expand Down Expand Up @@ -3150,8 +3172,8 @@ type(File) function init_File(unit, filename)
integer(kind = IPRE), intent(in) :: unit
character(len = *), intent(in) :: filename

init_File%unit = unit
init_File%filename = trim(filename)
init_File % unit = unit
init_File % filename = trim(filename)
return
end function init_File

Expand Down Expand Up @@ -5139,33 +5161,38 @@ function loadbin0(filename, kind)
if (present(kind)) opt_kind = kind

infile = File(999, trim(filename))
inquire(file = filename, size = fs)
select case(opt_kind)
case(4)
if ( mod(fs, 4) .eq. 0 ) then
dim1 = fs / 4
allocate(tmp4(dim1), loadbin0(dim1))
call infile%open(4*dim1)
read(infile%unit, rec = 1) tmp4
call infile%close()
loadbin0 = tmp4
else
print *, "Error: in loadbin, file size mismatches kind."
stop
end if
case(8)
if ( mod(fs, 8) .eq. 0 ) then
dim1 = fs / 8
allocate(tmp8(dim1), loadbin0(dim1))
call infile%open(8*dim1)
read(infile%unit, rec = 1) tmp8
call infile%close()
loadbin0 = tmp8
else
print *, "Error: in loadbin, file size mismatches kind."
stop
end if
end select
if ( infile % exist() ) then
inquire(file = filename, size = fs)
select case(opt_kind)
case(4)
if ( mod(fs, 4) .eq. 0 ) then
dim1 = fs / 4
allocate(tmp4(dim1), loadbin0(dim1))
call infile % open(4*dim1)
read(infile % unit, rec = 1) tmp4
call infile % close()
loadbin0 = tmp4
else
print *, "Error: in loadbin, file size mismatches kind."
stop
end if
case(8)
if ( mod(fs, 8) .eq. 0 ) then
dim1 = fs / 8
allocate(tmp8(dim1), loadbin0(dim1))
call infile % open(8*dim1)
read(infile % unit, rec = 1) tmp8
call infile % close()
loadbin0 = tmp8
else
print *, "Error: in loadbin, file size mismatches kind."
stop
end if
end select
else
print *, "Error: '" // trim(filename) // "' not found"
stop
end if
return
end function loadbin0

Expand All @@ -5177,22 +5204,27 @@ function loadbin1(filename, kind, dim1)
real(kind = 8), dimension(:), allocatable :: tmp8
type(File) :: infile

allocate(loadbin1(dim1))
infile = File(999, trim(filename))
select case(kind)
case(4)
allocate(tmp4(dim1))
call infile%open(4*dim1)
read(infile%unit, rec = 1) tmp4
call infile%close()
loadbin1 = tmp4
case(8)
allocate(tmp8(dim1))
call infile%open(8*dim1)
read(infile%unit, rec = 1) tmp8
call infile%close()
loadbin1 = tmp8
end select
if ( infile % exist() ) then
allocate(loadbin1(dim1))
select case(kind)
case(4)
allocate(tmp4(dim1))
call infile % open(4*dim1)
read(infile % unit, rec = 1) tmp4
call infile % close()
loadbin1 = tmp4
case(8)
allocate(tmp8(dim1))
call infile % open(8*dim1)
read(infile % unit, rec = 1) tmp8
call infile % close()
loadbin1 = tmp8
end select
else
print *, "Error: '" // trim(filename) // "' not found"
stop
end if
return
end function loadbin1

Expand All @@ -5204,22 +5236,27 @@ function loadbin2(filename, kind, dim1, dim2)
real(kind = 8), dimension(:,:), allocatable :: tmp8
type(File) :: infile

allocate(loadbin2(dim1, dim2))
infile = File(999, trim(filename))
select case(kind)
case(4)
allocate(tmp4(dim1, dim2))
call infile%open(4*dim1*dim2)
read(infile%unit, rec = 1) tmp4
call infile%close()
loadbin2 = tmp4
case(8)
allocate(tmp8(dim1, dim2))
call infile%open(8*dim1*dim2)
read(infile%unit, rec = 1) tmp8
call infile%close()
loadbin2 = tmp8
end select
if ( infile % exist() ) then
allocate(loadbin2(dim1, dim2))
select case(kind)
case(4)
allocate(tmp4(dim1, dim2))
call infile % open(4*dim1*dim2)
read(infile % unit, rec = 1) tmp4
call infile % close()
loadbin2 = tmp4
case(8)
allocate(tmp8(dim1, dim2))
call infile % open(8*dim1*dim2)
read(infile % unit, rec = 1) tmp8
call infile % close()
loadbin2 = tmp8
end select
else
print *, "Error: '" // trim(filename) // "' not found"
stop
end if
return
end function loadbin2

Expand All @@ -5231,22 +5268,27 @@ function loadbin3(filename, kind, dim1, dim2, dim3)
real(kind = 8), dimension(:,:,:), allocatable :: tmp8
type(File) :: infile

allocate(loadbin3(dim1, dim2, dim3))
infile = File(999, trim(filename))
select case(kind)
case(4)
allocate(tmp4(dim1, dim2, dim3))
call infile%open(4*dim1*dim2*dim3)
read(infile%unit, rec = 1) tmp4
call infile%close()
loadbin3 = tmp4
case(8)
allocate(tmp8(dim1, dim2, dim3))
call infile%open(8*dim1*dim2*dim3)
read(infile%unit, rec = 1) tmp8
call infile%close()
loadbin3 = tmp8
end select
if ( infile % exist() ) then
allocate(loadbin3(dim1, dim2, dim3))
select case(kind)
case(4)
allocate(tmp4(dim1, dim2, dim3))
call infile % open(4*dim1*dim2*dim3)
read(infile % unit, rec = 1) tmp4
call infile % close()
loadbin3 = tmp4
case(8)
allocate(tmp8(dim1, dim2, dim3))
call infile % open(8*dim1*dim2*dim3)
read(infile % unit, rec = 1) tmp8
call infile % close()
loadbin3 = tmp8
end select
else
print *, "Error: '" // trim(filename) // "' not found"
stop
end if
return
end function loadbin3

Expand All @@ -5269,40 +5311,50 @@ end function loadbin3
! txt file filename. dim2 indicates the number of columns of the array.
!=======================================================================

function loadtxt1(filename)
real(kind = RPRE), dimension(:), allocatable :: loadtxt1
character(len = *), intent(in) :: filename
integer(kind = IPRE) :: i, m
type(File) :: infile
function loadtxt1(filename)
real(kind = RPRE), dimension(:), allocatable :: loadtxt1
character(len = *), intent(in) :: filename
integer(kind = IPRE) :: i, m
type(File) :: infile

infile = File(999, trim(filename))
m = infile%countlines()
infile = File(999, trim(filename))
if ( infile % exist() ) then
m = infile % countlines()
allocate(loadtxt1(m))
call infile%open()
call infile % open()
do i = 1, m
read(infile%unit,*) loadtxt1(i)
read(infile % unit, *) loadtxt1(i)
end do
call infile%close()
return
end function loadtxt1

function loadtxt2(filename, dim2)
real(kind = RPRE), dimension(:,:), allocatable :: loadtxt2
character(len = *), intent(in) :: filename
integer(kind = IPRE), intent(in) :: dim2
integer(kind = IPRE) :: i, j, m
type(File) :: infile

infile = File(999, trim(filename))
m = infile%countlines()
call infile % close()
else
print *, "Error: '" // trim(filename) // "' not found"
stop
end if
return
end function loadtxt1

function loadtxt2(filename, dim2)
real(kind = RPRE), dimension(:,:), allocatable :: loadtxt2
character(len = *), intent(in) :: filename
integer(kind = IPRE), intent(in) :: dim2
integer(kind = IPRE) :: i, j, m
type(File) :: infile

infile = File(999, trim(filename))
if ( infile % exist() ) then
m = infile % countlines()
allocate(loadtxt2(m, dim2))
call infile%open()
call infile % open()
do i = 1, m
read(infile%unit,*) (loadtxt2(i,j), j = 1, dim2)
read(infile % unit, *) (loadtxt2(i,j), j = 1, dim2)
end do
call infile%close()
return
end function loadtxt2
call infile % close()
else
print *, "Error: '" // trim(filename) // "' not found"
stop
end if
return
end function loadtxt2

!=======================================================================
! log2
Expand Down Expand Up @@ -6444,25 +6496,25 @@ end function ones3
!
! Syntax
!-----------------------------------------------------------------------
! call ofile%open()
! call ofile%open(r)
! call ofile % open()
! call ofile % open(r)
!
! Description
!-----------------------------------------------------------------------
! call ofile%open() open the File object ofile with sequential access.
! call ofile % open() open the File object ofile with sequential access.
!
! call ofile%open(r) open the File object ofile with direct access,
! call ofile % open(r) open the File object ofile with direct access,
! where r is the record length.
!=======================================================================

subroutine open1(self)
class(File), intent(inout) :: self
integer(kind = IPRE) :: ierr

open(unit = self%unit, file = self%filename, access = "sequential", &
open(unit = self % unit, file = self % filename, access = "sequential", &
form = "formatted", status = "unknown", iostat = ierr)
if (ierr .ne. 0) then
print *, "Error: Cannot read "//self%filename//" ."
if ( ierr .ne. 0 ) then
print *, "Error: cannot read '" // trim(self % filename) // "'"
stop
end if
return
Expand All @@ -6473,10 +6525,10 @@ subroutine open2(self, r)
integer(kind = IPRE), intent(in) :: r
integer(kind = IPRE) :: ierr

open(unit = self%unit, file = self%filename, access = "direct", &
open(unit = self % unit, file = self % filename, access = "direct", &
form = "unformatted", status = "unknown", recl = r, iostat = ierr)
if (ierr .ne. 0) then
print *, "Error: Cannot read "//self%filename//" ."
if ( ierr .ne. 0 ) then
print *, "Error: cannot read '" // trim(self % filename) // "'"
stop
end if
return
Expand Down

0 comments on commit 318b68b

Please sign in to comment.