Data Types | Functions/Subroutines | Variables
dc_iounit Module Reference

Data Types

interface  fileopen
 

Functions/Subroutines

subroutine, public fileopen (unit, file, mode, err)
 

Variables

character(*), parameter version = '$Name: $' // '$Id: dc_iounit.f90,v 1.1 2009-03-20 09:09:53 morikawa Exp $'
 

Function/Subroutine Documentation

◆ fileopen()

subroutine, public dc_iounit::fileopen ( integer, intent(out)  unit,
character(*), intent(in)  file,
character(*), intent(in), optional  mode,
logical, intent(out), optional  err 
)

Definition at line 103 of file dc_iounit.f90.

References dc_trace::beginsub(), dc_error::dc_ebadfileopmode, dc_error::dc_efilenameempty, dc_error::dc_enofileexist, dc_error::dc_enofileread, dc_error::dc_enofilewrite, dc_error::dc_enounitnum, dc_error::dc_noerr, dc_trace::endsub(), dc_present::present_and_not_empty(), dc_error::storeerror(), dc_types::string, dc_types::token, and version.

103  !
104  ! ファイル名を *file* へ, オープンする際のモードを *mode* へと
105  ! 与えることで, ファイルをオープンし, 装置番号を *unit* に返します.
106  ! *mode* には以下の文字列を指定します. 省略時は "r" が指定されたもの
107  ! とみなします.
108  !
109  ! "r" :: ファイルを読み込みモードでオープンします.
110  ! "w" :: ファイルを書き込みモードでオープンします.
111  ! オープン時にファイルがすでに存在していればその内容を空にします.
112  ! "a" :: ファイルを書き込みモードでオープンします.
113  ! 出力はファイルの末尾に追加されます.
114  ! "rw" :: ファイルを読み書き両用モードでオープンします.
115  ! オープン時にファイルがすでに
116  ! 存在していればその内容を空にします.
117  ! "ra" :: ファイルを読み書き両用モードでオープンします.
118  ! オープン時にファイルがすでに
119  ! 存在していれば読み書き位置がファイルの末尾にセットされます.
120  !
121  ! ファイルが *mode* で指定されるモードで開けない場合, プログラムは
122  ! 強制終了します. 引数 *err* が与えられる場合, プログラムは強制終了せず,
123  ! 代わりに *err* に .true. が, *unit* に -1 が代入されます.
124  !
125  ! Filename is given to *file*, and open mode is given to *mode*,
126  ! then the file is opened and unit number is returned.
127  !
128  ! "r" :: A file is opened with read-only mode
129  ! "w" :: A file is opened with writable mode.
130  ! If a file is exist already, the contest of the file is emptied.
131  ! "a" :: A file is opened with writable mode.
132  ! Output is appended at the end of the file.
133  ! "rw" :: A file is opened with read/write mode.
134  ! If a file is exist already, the contest of the file is emptied.
135  ! "ra" :: A file is opened with read/write mode.
136  ! If a file is exist already,
137  ! a position of read/write is set at the end of the file.
138  !
139  ! If the file can not be opened with the mode, the program aborts.
140  ! If this *err* argument is given, .true. is substituted to *err* and
141  ! -1 is substituted to *unit* and the program does not abort.
142  !
143  use dc_types, only: string, token
144  use dc_trace, only: beginsub, endsub
145  use dc_error, only: storeerror, dc_noerr, &
146  & dc_efilenameempty, dc_ebadfileopmode, dc_enounitnum, &
147  & dc_enofileexist, dc_enofileread, dc_enofilewrite
148  use dc_present, only: present_and_not_empty
149  use dc_string, only: tochar, tolower
150  implicit none
151  integer, intent(out):: unit
152  character(*), intent(in):: file
153  character(*), intent(in), optional:: mode
154  logical, intent(out), optional:: err
155 
156  !-----------------------------------
157  ! 作業変数
158  ! Work variables
159  integer, parameter:: max_unit = 99
160  ! NAMELIST ファイルをオープンするための
161  ! 装置番号の最大値. Fortran で使用可能な
162  ! 範囲 (0〜99) のうち,
163  ! 最大値が設定されている.
164  !
165  ! Maximum unit number for open of
166  ! NAMELIST file. An maximum
167  ! value within the bounds of available number
168  ! in Fortran (0 - 99) is specified.
169  integer, parameter:: min_unit = 0
170  ! NAMELIST ファイルをオープンするための
171  ! 装置番号の最小値. Fortran で使用可能な
172  ! 範囲 (0〜99) のうち,
173  ! 最小値が設定されている.
174  !
175  ! Minimum unit number for open of
176  ! NAMELIST file. An minimum
177  ! value within the bounds of available number
178  ! in Fortran (0 - 99) is specified.
179  character(TOKEN):: open_mode
180  integer:: unit_work
181  logical:: unit_exist_flag, unit_opend_flag
182  logical:: file_exist_flag
183  integer:: iostat
184  integer:: stat
185  character(STRING):: cause_c
186  character(*), parameter:: subname = 'FileOpen'
187  continue
188  call beginsub(subname, version)
189  stat = dc_noerr
190  cause_c = ''
191  unit = -1
192 
193  !-----------------------------------------------------------------
194  ! オプショナル引数のチェック
195  ! Check optional arguments
196  !-----------------------------------------------------------------
197  if (present_and_not_empty(mode)) then
198  open_mode = mode
199  else
200  open_mode = 'r'
201  end if
202  call tolower(open_mode)
203 
204  !-----------------------------------------------------------------
205  ! 引数の正当性のチェック
206  ! Validation of arguments
207  !-----------------------------------------------------------------
208  if ( trim(file) == '' ) then
209  stat = dc_efilenameempty
210  goto 999
211  end if
212 
213  !----------------------------------------------------------------
214  ! 使用可能な装置番号の探査
215  ! Search available unit number
216  !----------------------------------------------------------------
217  unit_work = max_unit
218  do
219  inquire(unit=unit_work, exist=unit_exist_flag, opened=unit_opend_flag)
220  if (unit_exist_flag .and. .not. unit_opend_flag) then
221  exit
222  endif
223  unit_work = unit_work - 1
224  if (unit_work < min_unit) then
225  cause_c = tochar(min_unit) // ' - ' // tochar(max_unit)
226  stat = dc_enounitnum
227  goto 999
228  end if
229  enddo
230 
231  !----------------------------------------------------------------
232  ! モードの書式のチェック
233  ! Check form of mode
234  !----------------------------------------------------------------
235  select case( trim(open_mode) )
236  case ('r', 'w', 'rw', 'a', 'ra')
237  case default
238  cause_c = open_mode
239  stat = dc_ebadfileopmode
240  goto 999
241  end select
242 
243  !----------------------------------------------------------------
244  ! ファイルの存在のチェック
245  ! Check existance of a file
246  !----------------------------------------------------------------
247  select case( trim(open_mode) )
248  case ('r')
249  inquire(file=file, exist=file_exist_flag)
250  if (.not. file_exist_flag) then
251  cause_c = file
252  stat = dc_enofileexist
253  goto 999
254  end if
255  end select
256 
257  !----------------------------------------------------------------
258  ! ファイルの読み込み可能のチェック
259  ! Check readable of a file
260  !----------------------------------------------------------------
261  select case( trim(open_mode) )
262  case ('r')
263  open(unit=unit_work, iostat=iostat, &
264  & file=file, status='OLD', action='READ')
265  if (.not. iostat == 0) then
266  cause_c = file
267  stat = dc_enofileread
268  goto 999
269  end if
270  close(unit=unit_work)
271  end select
272 
273  !----------------------------------------------------------------
274  ! ファイルの書き込み可能のチェック
275  ! Check writable of a file
276  !----------------------------------------------------------------
277  select case( trim(open_mode) )
278  case ('w', 'a', 'rw', 'ra')
279  open(unit=unit_work, iostat=iostat, &
280  & file=file, status='UNKNOWN', action='WRITE')
281  if (.not. iostat == 0) then
282  cause_c = file
283  stat = dc_enofilewrite
284  goto 999
285  end if
286  close(unit=unit_work)
287  end select
288 
289  !----------------------------------------------------------------
290  ! ファイルオープン
291  ! Open a file
292  !----------------------------------------------------------------
293  select case( trim(open_mode) )
294  case ('r')
295  open(unit=unit_work, file=file, &
296  & status='OLD', action='READ')
297 
298  case ('w')
299  open(unit=unit_work, file=file, &
300  & status='REPLACE', action='WRITE')
301 
302  case ('rw')
303  open(unit=unit_work, file=file, &
304  & status='REPLACE', action='READWRITE')
305 
306  case ('a')
307  open(unit=unit_work, file=file, &
308  & status='UNKNOWN', position='APPEND', action='WRITE')
309 
310  case ('ra')
311  open(unit=unit_work, file=file, &
312  & status='UNKNOWN', position='APPEND', action='READWRITE')
313 
314  end select
315 
316  unit = unit_work
317 
318 999 continue
319  call storeerror(stat, subname, err, cause_c)
320  call endsub(subname)
dc_trace
Definition: dc_trace.f90:11
dc_error::dc_enofilewrite
integer, parameter, public dc_enofilewrite
Definition: dc_error.f90:567
dc_error::dc_enounitnum
integer, parameter, public dc_enounitnum
Definition: dc_error.f90:564
dc_error::dc_enofileexist
integer, parameter, public dc_enofileexist
Definition: dc_error.f90:565
dc_string::tochar
Definition: dc_string.f90:73
dc_error
Definition: dc_error.f90:11
dc_error::dc_enofileread
integer, parameter, public dc_enofileread
Definition: dc_error.f90:566
dc_types::token
integer, parameter, public token
Character length for word, token.
Definition: dc_types.f90:109
dc_error::storeerror
subroutine, public storeerror(number, where, err, cause_c, cause_i)
Definition: dc_error.f90:830
dc_error::dc_noerr
integer, parameter, public dc_noerr
Definition: dc_error.f90:509
dc_present
Definition: dc_present.f90:26
dc_present::present_and_not_empty
logical function, public present_and_not_empty(arg)
Definition: dc_present.f90:276
dc_trace::beginsub
subroutine, public beginsub(name, fmt, i, r, d, L, n, c1, c2, c3, ca, version)
Definition: dc_trace.f90:351
dc_string
Handling character types.
Definition: dc_string.f90:24
dc_types
Provides kind type parameter values.
Definition: dc_types.f90:49
dc_string::tolower
Definition: dc_string.f90:138
dc_trace::endsub
subroutine, public endsub(name, fmt, i, r, d, L, n, c1, c2, c3, ca)
Definition: dc_trace.f90:446
dc_error::dc_ebadfileopmode
integer, parameter, public dc_ebadfileopmode
Definition: dc_error.f90:563
dc_error::dc_efilenameempty
integer, parameter, public dc_efilenameempty
Definition: dc_error.f90:562
dc_types::string
integer, parameter, public string
Character length for string.
Definition: dc_types.f90:118
Here is the call graph for this function:

Variable Documentation

◆ version

character(*), parameter dc_iounit::version = '$Name: $' // '$Id: dc_iounit.f90,v 1.1 2009-03-20 09:09:53 morikawa Exp $'
private

Definition at line 90 of file dc_iounit.f90.

Referenced by fileopen().

90  character(*), parameter:: version = &
91  & '$Name: $' // &
92  & '$Id: dc_iounit.f90,v 1.1 2009-03-20 09:09:53 morikawa Exp $'