-
Notifications
You must be signed in to change notification settings - Fork 1
/
fortun_utils.f90
126 lines (84 loc) · 3.11 KB
/
fortun_utils.f90
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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
module fortun_utils
implicit none
private
public :: extend
public :: CHAR_LENGTH
public :: number_of_lines
public :: check_allocation, check_deallocation
integer, parameter :: CHAR_LENGTH = 256
interface extend
module procedure extend_char
end interface extend
contains
!------------------------------------------------------------------ extend_char
!> extends a character array
subroutine extend_char(array, extent)
implicit none
character(len=*), dimension(:), allocatable, intent(IN OUT) :: array
integer, intent(IN) :: extent
character(len=CHAR_LENGTH), dimension(:), allocatable :: tmp
integer :: length, error
if (.not.allocated(array)) then
allocate(array(extent), stat=error)
call check_allocation(error,"'array' in extend_char")
array = ""
else
length = size(array)
allocate(tmp(length), stat=error)
call check_allocation(error,"'tmp' in extend_char")
tmp = array
deallocate(array, stat=error)
call check_deallocation(error,"'array' in extend_char")
allocate(array(length+extent), stat=error)
call check_allocation(error,"'array' in extend_char")
array(1:length) = tmp
array(length+1:) = ""
end if
end subroutine extend_char
!-------------------------------------------------------------- number_of_lines
!> counts the number of lines in a file
!! inspired from FortranWiki
integer function number_of_lines(input_file) result(lines)
use iso_fortran_env, only : iostat_end
implicit none
character(len=*), intent(IN) :: input_file
integer, parameter :: io = 15
integer :: stat
character(len=100) :: buffer
lines = 0
open(io, file=trim(input_file), form="formatted")
do
read(io, fmt=*, iostat=stat) buffer
if (stat .eq. iostat_end) exit
lines = lines + 1
end do
close(io)
end function number_of_lines
!------------------------------------------------------------- check_allocation
subroutine check_allocation(stat, array_name)
implicit none
integer, intent(IN) :: stat
character(len=*), intent(IN) :: array_name
call stop_alloc(stat, array_name, "Allocation")
end subroutine check_allocation
!----------------------------------------------------------- check_deallocation
subroutine check_deallocation(stat, array_name)
implicit none
integer, intent(IN) :: stat
character(len=*), intent(IN) :: array_name
call stop_alloc(stat, array_name, "Deallocation")
end subroutine check_deallocation
!------------------------------------------------------------------- stop_alloc
!> helper subroutine for check_[de]alloc
subroutine stop_alloc(stat, array_name, sub)
integer, intent(IN) :: stat
character(len=*), intent(IN) :: array_name
character(len=*), intent(IN) :: sub
character(1024) :: error_msg
if (stat .ne. 0) then
error_msg = "Error: " // trim(sub) // " of " // trim(array_name) // " failed."
print *, trim(error_msg)
stop
end if
end subroutine stop_alloc
end module fortun_utils