Newer
Older
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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
module scm_io_default
implicit none
!type declaration
type io_struct
character(len = 160) :: fname
integer :: status ! 0 - closed, 1 - opened
integer :: unit_id
end type io_struct
character(len = 160) tmp_str
integer, public, parameter :: nunits_max = 70
public
contains
subroutine to_file_1d_2var(fname, var1, var2, n)
implicit none
character(*), intent(in):: fname
integer, intent(in):: n
real, dimension(n), intent(in):: var1, var2
integer i
integer istat
character(len = 7) sta
open(10, FILE=trim(fname))
do i =1, n
write(10,*) var1(i), var2(i)
end do
close(10,iostat = istat,STATUS = sta)
end subroutine to_file_1d_2var
subroutine to_file_1d_3var(fname, var1, var2, var3, n)
implicit none
character(*), intent(in):: fname
integer, intent(in):: n
real, dimension(n), intent(in):: var1, var2, var3
integer i
integer istat
character(len = 7) sta
open(10, FILE=trim(fname))
do i =1, n
write(10,*) var1(i), var2(i), var3(i)
end do
close(10,iostat = istat,STATUS = sta)
end subroutine to_file_1d_3var
subroutine set_file( f, fname )
implicit none
type(io_struct), intent(inout):: f
character(*), intent(in):: fname
f%unit_id = get_file_unit()
open(f%unit_id, FILE=trim(fname))
f%status = 1
f%fname = trim(fname)
write(*,*) 'file opened ', f%fname
write(*,*) ' unit: ',f%unit_id
write(*,*) 'max_units: ', nunits_max
end subroutine set_file
subroutine write_series(stamp, nlength, f)
implicit none
type(io_struct), intent(inout):: f
integer, intent(in):: nlength
real, intent(in), dimension(nlength)::stamp
write(f%unit_id,*) stamp(:)
end subroutine write_series
subroutine write_timescan(stamp,nz, nlength, f)
implicit none
type(io_struct), intent(in):: f
integer, intent(in):: nlength, nz
real, intent(in), dimension(nlength, nz)::stamp
integer k
do k=1,nz
write(f%unit_id,*) stamp(:, k)
end do
end subroutine write_timescan
subroutine close_file(f)
implicit none
type(io_struct), intent(inout):: f
close(f%unit_id)
write(*,*) 'file closed ', f%fname
f%status = 0
end subroutine close_file
! get_file_unit returns a unit number that is not in use
integer function get_file_unit ()
integer lu, iostat
integer, save:: m
logical, save:: initialized = .true.
logical opened
if (initialized) then
m = nunits_max
initialized = .false.
end if
if (m < 8 ) then
m = 2 * nunits_max
end if
do lu = m,7,-1
inquire (unit=lu, opened=opened, iostat=iostat)
if (iostat.ne.0) cycle
if (.not.opened) exit
end do
!
get_file_unit = lu
return
end function get_file_unit
subroutine read_1d_plain(x, val, nrows, fname)
implicit none
real, allocatable, intent(inout) :: x(:), val(:)
integer, intent(inout):: nrows
character(*), intent(in):: fname
integer :: i, io
! get number of rows
nrows = 0
open (1, file = trim(fname))
do
read(1,*,iostat=io)
if (io/=0) exit
nrows = nrows + 1
end do
close (1)
!check if arrays are already allocated
if (allocated(x)) deallocate(x)
if (allocated(val)) deallocate(val)
!allocate arrays
allocate(x(nrows))
allocate(val(nrows))
! reopen file and read data
open (1, file = trim(fname))
do i = 1,nrows
read(1,*) x(i), val(i)
end do
end subroutine read_1d_plain
end module scm_io_default