File Utilities¶
Functions and subroutines for text files handling tasks.
file_exists¶
1 2 3 4 5 6 7 8 9 10 11 12 | !:=== Checks if file exists.
subroutine file_exists(ifile)
logical :: fexist
character(*) :: ifile
inquire(file=ifile, exist=fexist)
if(.not.fexist)then
write(*,*)"Header file don't exist"
stop
end if
end subroutine file_exists
|
count_keys¶
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | !:=== This subroutine counts existing keys within a file.
subroutine countkeys(ifile, nkeys)
character(*) :: ifile
character(300) :: inline
integer(kind = 4) :: stats, nkeys
open(100, file=ifile, status="old", action="read", position="rewind")
loop: do
read(100, '(a)', iostat=stats) inline
if(stats < 0)then
exit loop
end if
if(inline(1:1).eq.'[')then
nkeys = nkeys + 1
end if
end do loop
close(100)
end subroutine countkeys
|
readheader¶
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | !:=== Allocate attributes and contents into arrays.
subroutine readheader(hfile, attribute, content)
character(len=*) :: hfile
character(len=200) :: inline
character(len=*), dimension(:), allocatable :: attribute, content
integer :: stats, n
open(100, file=hfile, status="old", action="read", position="rewind")
!:==== Read number of attribute keylines and the content of all keylines
n = 0
keys: do
read(100, '(a)', iostat=stats) inline
if(stats < 0)then
exit keys
end if
!:==== Remove brackets '[ ]'
if(inline(1:1).eq.'[')then
n = n + 1
attribute(n) = trim(adjustl(inline(2:len_trim(inline)-1)))
end if
if(inline(1:1).ne.'['.and.len_trim(inline).ne.0)then
content(n) = trim(adjustl(inline))
end if
end do keys
close(100)
end subroutine readheader
|
numRows¶
1 2 3 4 5 6 7 8 9 10 11 | !:=== row number counter.
function numRows(fileunit) result(nrows)
integer(kind=4) :: fileunit, nrows
nrows = 0
do
read(fileunit, *, end=101)
nrows = nrows + 1
end do
101 continue
rewind(fileunit)
end function numRows
|
Time Utilities¶
Functions and subroutines for date and time tasks.
fdate_time¶
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | !Date and Time subroutine
subroutine fdate_time(sysdatetime)
integer(kind=4) :: date(3), systime(3)
integer :: i
character(len=3), dimension(12) :: month
character(len=3) :: sysmonth
character(len=2) :: strday
character(len=4) :: stryear
character(len=2) :: strhour
character(len=2) :: strmin
character(len=2) :: strsec
character(len=21), intent(out) :: sysdatetime
month = (/'Jan','Feb','Mar','Apr','May','Jun', 'Jul','Aug','Sep', &
'Oct','Nov','Dec'/)
call idate(date) !date(1) = day, date(2) = month, date(3) = year
call itime(systime) !systime(1) = hour, systime(2) = minute, systime(3) = second
do i = 1, 12
if(date(2).eq.i) sysmonth = month(i)
end do
!Integer to Character
write (strday, '(i2)') date(1)
write (stryear, '(i4)') date(3)
write (strhour, '(i2.2)') systime(1)
write (strmin, '(i2.2)') systime(2)
write (strsec, '(i2.2)') systime(3)
sysdatetime = sysmonth//" "//strday//" "//stryear//" "//strhour//':'//strmin//':'//strsec
end subroutine fdate_time
|
exec_time¶
1 2 3 4 5 6 7 | subroutine exec_time(time)
real(kind=4) :: time
character(len=10) :: t
call date_and_time(TIME=t)
read(t, *)time
end subroutine exec_time
|
Sorting Utilities¶
bubbleSort¶
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | Subroutine Order(p,q, dp, dq)
integer p,q,temp
character(len=100) :: dp, dq, tempd
if (p>q) then
temp=p
tempd=dp
p=q
dp=dq
q=temp
dq=tempd
end if
end subroutine Order
Subroutine bubbleSort(dimid, dimname, n)
integer dimid(1:n), j, n, i
character(len=100) :: dimname(1:n)
do i=1, n
do j=n, i+1, -1
call Order(dimid(j-1), dimid(j), dimname(j-1), dimname(j))
end do
end do
end subroutine bubbleSort
|