-
Notifications
You must be signed in to change notification settings - Fork 69
Expand file tree
/
Copy pathMOD_WRITE_BINARY_ARRAYS.F90
More file actions
205 lines (184 loc) · 6.84 KB
/
MOD_WRITE_BINARY_ARRAYS.F90
File metadata and controls
205 lines (184 loc) · 6.84 KB
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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
!==========================================================
!
!------------------------------------------------------------------------------------------
! useful interface (write_bin_array) for writing arbitary binary arrays into an opened file
MODULE MOD_WRITE_BINARY_ARRAYS
use o_PARAM
private
public :: write_bin_array, write1d_int_static
INTERFACE write_bin_array
MODULE PROCEDURE write1d_real, write1d_int, write1d_char, write2d_real, write2d_int, write3d_real, write3d_int, write4d_real, write4d_int
END INTERFACE
contains
subroutine write1d_real(arr, unit, iostat, iomsg)
real(kind=WP), intent(in), allocatable :: arr(:)
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
integer :: s1
if (allocated(arr)) then
s1=size(arr, 1)
write(unit, iostat=iostat, iomsg=iomsg) s1
write(unit, iostat=iostat, iomsg=iomsg) arr(1:s1)
else
s1=0
write(unit, iostat=iostat, iomsg=iomsg) s1
end if
end subroutine write1d_real
subroutine write1d_int(arr, unit, iostat, iomsg)
integer, intent(in), allocatable :: arr(:)
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
integer :: s1
if (allocated(arr)) then
s1=size(arr, 1)
write(unit, iostat=iostat, iomsg=iomsg) s1
write(unit, iostat=iostat, iomsg=iomsg) arr(1:s1)
else
s1=0
write(unit, iostat=iostat, iomsg=iomsg) s1
end if
end subroutine write1d_int
subroutine write1d_char(arr, unit, iostat, iomsg)
character, intent(in), allocatable :: arr(:)
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
integer :: s1
if (allocated(arr)) then
s1=size(arr, 1)
write(unit, iostat=iostat, iomsg=iomsg) s1
write(unit, iostat=iostat, iomsg=iomsg) arr(1:s1)
else
s1=0
write(unit, iostat=iostat, iomsg=iomsg) s1
end if
end subroutine write1d_char
subroutine write1d_int_static(arr, unit, iostat, iomsg)
IMPLICIT NONE
integer, intent(in) :: arr(:)
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
integer :: s1
s1=size(arr, 1)
write(unit, iostat=iostat, iomsg=iomsg) s1
write(unit, iostat=iostat, iomsg=iomsg) arr(1:s1)
end subroutine write1d_int_static
subroutine write2d_real(arr, unit, iostat, iomsg)
real(kind=WP), intent(in), allocatable :: arr(:,:)
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
integer :: s1, s2
if (allocated(arr)) then
s1=size(arr, 1)
s2=size(arr, 2)
write(unit, iostat=iostat, iomsg=iomsg) s1, s2
write(unit, iostat=iostat, iomsg=iomsg) arr(1:s1, 1:s2)
else
s1=0
s2=0
write(unit, iostat=iostat, iomsg=iomsg) s1, s2
end if
end subroutine write2d_real
subroutine write2d_int(arr, unit, iostat, iomsg)
integer, intent(in), allocatable :: arr(:,:)
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
integer :: s1, s2
if (allocated(arr)) then
s1=size(arr, 1)
s2=size(arr, 2)
write(unit, iostat=iostat, iomsg=iomsg) s1, s2
write(unit, iostat=iostat, iomsg=iomsg) arr(1:s1, 1:s2)
else
s1=0
s2=0
write(unit, iostat=iostat, iomsg=iomsg) s1, s2
end if
end subroutine write2d_int
subroutine write3d_real(arr, unit, iostat, iomsg)
real(kind=WP), intent(in), allocatable :: arr(:,:,:)
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
integer :: s1, s2, s3
if (allocated(arr)) then
s1=size(arr, 1)
s2=size(arr, 2)
s3=size(arr, 3)
write(unit, iostat=iostat, iomsg=iomsg) s1, s2, s3
write(unit, iostat=iostat, iomsg=iomsg) arr(1:s1, 1:s2, 1:s3)
else
s1=0
s2=0
s3=0
write(unit, iostat=iostat, iomsg=iomsg) s1, s2, s3
end if
end subroutine write3d_real
subroutine write3d_int(arr, unit, iostat, iomsg)
integer, intent(in), allocatable :: arr(:,:,:)
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
integer :: s1, s2, s3
if (allocated(arr)) then
s1=size(arr, 1)
s2=size(arr, 2)
s3=size(arr, 3)
write(unit, iostat=iostat, iomsg=iomsg) s1, s2, s3
write(unit, iostat=iostat, iomsg=iomsg) arr(1:s1, 1:s2, 1:s3)
else
s1=0
s2=0
s3=0
write(unit, iostat=iostat, iomsg=iomsg) s1, s2, s3
end if
end subroutine write3d_int
subroutine write4d_real(arr, unit, iostat, iomsg)
real(kind=WP), intent(in), allocatable :: arr(:,:,:,:)
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
integer :: s1, s2, s3, s4
if (allocated(arr)) then
s1=size(arr, 1)
s2=size(arr, 2)
s3=size(arr, 3)
s4=size(arr, 4)
write(unit, iostat=iostat, iomsg=iomsg) s1, s2, s3, s4
write(unit, iostat=iostat, iomsg=iomsg) arr(1:s1, 1:s2, 1:s3, 1:s4)
else
s1=0
s2=0
s3=0
s4=0
write(unit, iostat=iostat, iomsg=iomsg) s1, s2, s3, s4
end if
end subroutine write4d_real
subroutine write4d_int(arr, unit, iostat, iomsg)
integer, intent(in), allocatable :: arr(:,:,:,:)
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
integer :: s1, s2, s3, s4
if (allocated(arr)) then
s1=size(arr, 1)
s2=size(arr, 2)
s3=size(arr, 3)
s4=size(arr, 4)
write(unit, iostat=iostat, iomsg=iomsg) s1, s2, s3, s4
write(unit, iostat=iostat, iomsg=iomsg) arr(1:s1, 1:s2, 1:s3, 1:s4)
else
s1=0
s2=0
s3=0
s4=0
write(unit, iostat=iostat, iomsg=iomsg) s1, s2, s3, s4
end if
end subroutine write4d_int
end module MOD_WRITE_BINARY_ARRAYS
!==========================================================