← Back to branch summary

~nickpapior/siesta/trunk-buds-format0.92

« back to all changes in this revision

Viewing changes to Src/buds/src/File.F90

  • Committer: Nick Papior
  • Date: 2017-04-07 12:42:28 UTC
  • Revision ID: nickpapior@gmail.com-20170407124228-u5t08yr2p4fhzfeo
Initial commit of buds merged into siesta

Currently I have only enabled buds compilation.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Src/buds/src/File.F90
 
1
! @@LICENSE@@ see Copyright notice in the top-directory
 
2
 
 
3
! This extension currently uses these pre-processor flags:
 
4
!  - BUD_MOD_NAME name of the module
 
5
!  - BUD_TYPE_NAME name of the public type
 
6
!  - BUD_TYPE_NAME_ name of the internal data pointer
 
7
!  - BUD_TYPE_NAME_STR the routine name in "string" format (for IO)
 
8
 
 
9
#include "bud_utils.inc"
 
10
 
 
11
! This bud does not allow writing
 
12
#define BUD_NO_IO
 
13
 
 
14
! Define default variable for the file
 
15
#define BUD_MOD_NAME BUD_CC3(BUD_MOD,_,File)
 
16
#define BUD_TYPE_NAME BUD_CC2(BUD_TYPE,File)
 
17
 
 
18
!> @defgroup file File
 
19
!! @ingroup bud-intrinsic
 
20
!!
 
21
!! Perform file operations such as open/close/delete etc.
 
22
!!
 
23
!! This enables a consistent data-type which contains the
 
24
!! unit of a file while implementing specific queries
 
25
!! regarding files.
 
26
!!
 
27
!! I.e. one may create a file object and determine whether
 
28
!! it exists or not. One may also use the object to
 
29
!!
 
30
!!
 
31
!! Exposes functionality regarding files.
 
32
!! It allows interaction with the files in a standard way
 
33
!! by opening, closing, deleting files in a simple and clean
 
34
!! interface.
 
35
!! @{
 
36
module BUD_MOD_NAME
 
37
 
 
38
  ! This *MUST* be the first statement
 
39
  ! Common parameters and variables used
 
40
# include "bud_common_declarations.inc"
 
41
 
 
42
  !> Maximum path length for the filenames
 
43
  integer, parameter :: FILE_NAME_LEn = 256
 
44
 
 
45
  !> Initial unit to open files with
 
46
  integer, parameter :: FILE_UNIT_STARt = 1000
 
47
 
 
48
 
 
49
  !> File @bud
 
50
  !!
 
51
  !! This generic file type enables opening/closing/deleting
 
52
  !! etc. using a single file handle.
 
53
  !!
 
54
  !! It may also be used to retrieve a new file-unit.
 
55
  type BUD_TYPE_NAME
 
56
 
 
57
    !> Stored pointer which contains the reference counting etc.
 
58
    type(BUD_TYPE_NAME_), pointer :: D => null()
 
59
 
 
60
#   include "bud_common_type.inc"
 
61
#if BUD_FORTRAN >= 2003
 
62
 
 
63
    !> @iSee #new
 
64
    procedure, public :: new => new_
 
65
 
 
66
    !> @iSee open
 
67
    procedure, public :: open => open_
 
68
 
 
69
    !> @iSee close
 
70
    procedure, public :: close => close_
 
71
 
 
72
    !> @iSee rewind
 
73
    procedure, public :: rewind => rewind_
 
74
 
 
75
    !> @iSee backspace
 
76
    procedure, public :: backspace => backspace_
 
77
 
 
78
    !> @iSee filename
 
79
    procedure, public :: file => filename_
 
80
    !> @iSee filename
 
81
    procedure, public :: name => filename_
 
82
    !> @iSee filename
 
83
    procedure, public :: filename => filename_
 
84
 
 
85
    !> @iSee get_unit
 
86
    procedure, public :: unit => get_unit_
 
87
 
 
88
    !> @iSee unopened_unit
 
89
    procedure, public, nopass :: unopened_unit => unopened_unit_
 
90
 
 
91
    !> @iSee is_open
 
92
    procedure, public :: is_open => is_open_
 
93
    !> @iSee is_direct
 
94
    procedure, public :: is_direct => is_direct_
 
95
    !> @iSee is_sequential
 
96
    procedure, public :: is_sequential => is_sequential_
 
97
    !> @iSee is_formatted
 
98
    procedure, public :: is_formatted => is_formatted_
 
99
    !> @iSee is_unformatted
 
100
    procedure, public :: is_unformatted => is_unformatted_
 
101
 
 
102
    !> @iSee exists
 
103
    procedure, public :: exists => exists_
 
104
 
 
105
    !> @iSee delete_file
 
106
    procedure, public :: delete_file => delete_file_
 
107
 
 
108
    !> @iSee get_stat
 
109
    procedure, public :: stat => get_stat_
 
110
 
 
111
#endif
 
112
  end type BUD_TYPE_NAME
 
113
 
 
114
 
 
115
  !> @cond BUD_DEVELOPER
 
116
 
 
117
  !> @bud container for BUD_TYPE_NAME
 
118
  !!
 
119
  !! Contains information regarding a file.
 
120
  !!
 
121
  type BUD_TYPE_NAME_
 
122
 
 
123
    !> File name/path for this object
 
124
    character(len=FILE_NAME_LEN) :: file = ' '
 
125
 
 
126
    !> Unit for the file (negative if non-opened)
 
127
    integer :: unit = -1
 
128
 
 
129
    ! Consistent data in the reference counted object
 
130
#   include "bud_common_type_.inc"
 
131
 
 
132
  end type BUD_TYPE_NAME_
 
133
 
 
134
  !> @endcond BUD_DEVELOPER
 
135
 
 
136
 
 
137
 
 
138
  !> Create a new file @bud
 
139
  !!
 
140
  !! Initializes the file with the associated
 
141
  !! filename.
 
142
  !!
 
143
  !! @note
 
144
  !! This will _not_ open the file.
 
145
  interface new
 
146
    module procedure new_
 
147
  end interface
 
148
  public :: new
 
149
 
 
150
 
 
151
  !> Open file via object
 
152
  !!
 
153
  !! Equivalent to `open` statement.
 
154
  !!
 
155
  !! If the file is already opened, the file will be
 
156
  !! closed and subsequently re-opened with the passed
 
157
  !! options.
 
158
  !!
 
159
  !! Once a file is opened several procedures may
 
160
  !! be used to query information, in case one does not
 
161
  !! know the options used for opening the file.
 
162
  interface open
 
163
    module procedure open_
 
164
  end interface
 
165
  public :: open
 
166
 
 
167
  !> Close file via object
 
168
  !!
 
169
  !! This transforms the file into an un-opened
 
170
  !! state and several of the procedures will return
 
171
  !! default values in this case.
 
172
  interface close
 
173
    module procedure close_
 
174
  end interface
 
175
  public :: close
 
176
 
 
177
  !> Rewind file to the beginning of the file
 
178
  !!
 
179
  !! This is equivalent to the `rewind` statement.
 
180
  interface rewind
 
181
    module procedure rewind_
 
182
  end interface
 
183
  public :: rewind
 
184
 
 
185
  !> Backspace the file
 
186
  !!
 
187
  !! Move back in the file records.
 
188
  interface backspace
 
189
    module procedure backspace_
 
190
  end interface
 
191
  public :: backspace
 
192
 
 
193
 
 
194
  !> Retrieve new unused unit (global function)
 
195
  !!
 
196
  !! Will always return an integer > 1000 with a unit
 
197
  !! that is currently not in use.
 
198
  interface unopened_unit
 
199
    module procedure unopened_unit_
 
200
  end interface
 
201
  public :: unopened_unit
 
202
 
 
203
  !> Query filename of the file @bud
 
204
  !!
 
205
  !! This *MUST* only be called on an initialized
 
206
  !! @bud.
 
207
  !! The function will return a trimmed filename
 
208
  !! which is only possible by using `len_trim`.
 
209
  interface filename
 
210
    module procedure filename_
 
211
  end interface
 
212
  public :: filename
 
213
 
 
214
  !> Unit of opened file @bud
 
215
  !!
 
216
  !! Retrieve the unit of the file in case it is
 
217
  !! opened.
 
218
  !! If the file is not opened, `-1` will be returned.
 
219
  interface get_unit
 
220
    module procedure get_unit_
 
221
  end interface
 
222
  public :: get_unit
 
223
 
 
224
  !> @iSee get_unit
 
225
  interface unit
 
226
    module procedure get_unit_
 
227
  end interface
 
228
  public :: unit
 
229
 
 
230
  !> Query whether file is open
 
231
  !!
 
232
  !! Checks whether the file is opened by `open`.
 
233
  interface is_open
 
234
    module procedure is_open_
 
235
  end interface
 
236
  public :: is_open
 
237
 
 
238
  !> Query whether file exists
 
239
  !!
 
240
  !! Checks whether the file exists on disk.
 
241
  !! This is independent of `is_open` and may
 
242
  !! be called on unopened files.
 
243
  interface exists
 
244
    module procedure exists_
 
245
  end interface
 
246
  public :: exists
 
247
 
 
248
  !> Query file opened in DIRECT mode
 
249
  interface is_direct
 
250
    module procedure is_direct_
 
251
  end interface
 
252
  public :: is_direct
 
253
 
 
254
  !> Query file opened in SEQUENTIAL mode
 
255
  interface is_sequential
 
256
    module procedure is_sequential_
 
257
  end interface
 
258
  public :: is_sequential
 
259
 
 
260
  !> Query file opened in FORMATTED mode
 
261
  interface is_formatted
 
262
    module procedure is_formatted_
 
263
  end interface
 
264
  public :: is_formatted
 
265
 
 
266
  !> Query file opened in UNFORMATTED mode
 
267
  interface is_unformatted
 
268
    module procedure is_unformatted_
 
269
  end interface
 
270
  public :: is_unformatted
 
271
 
 
272
  !> Status of the latest action with iostat
 
273
  !!
 
274
  !! This may be to check the `iostat` of the last internal
 
275
  !! routine.
 
276
  !!
 
277
  !! Calling this immediately twice in a row will always return
 
278
  !! 0 on the second call.
 
279
  interface get_stat
 
280
    module procedure get_stat_
 
281
  end interface
 
282
  public :: get_stat
 
283
 
 
284
 
 
285
  !> Delete file on disk
 
286
  !!
 
287
  !! Perform an actual delete of the file.
 
288
  !! If the file is opened it will be closed afterwards.
 
289
  !!
 
290
  !! The file object will not be deleted as one may then query
 
291
  !! the status of the operation.
 
292
  interface delete_file
 
293
    module procedure delete_file_
 
294
  end interface
 
295
  public :: delete_file
 
296
 
 
297
# define BUD_NO_IO
 
298
  ! Include common data routines
 
299
  ! Note that 'CONTAINS' is present in this include file.
 
300
  ! the common_delete_ ensures a closed file
 
301
  ! Hence we *must* not use elemental
 
302
# include "bud_common.inc"
 
303
 
 
304
 
 
305
  !> @cond BUD_DEVELOPER
 
306
 
 
307
  !> Internal routine for cleaning up the data container.
 
308
  !!
 
309
  !! @dev_note
 
310
  !! This routine is only used internally to clean-up
 
311
  !! any data in the type.
 
312
  !! Should never be made public.
 
313
  !!
 
314
  !! @param[inout] this contained data to be deleted
 
315
  subroutine delete_(this)
 
316
    type(BUD_TYPE_NAME), intent(inout) :: this
 
317
    integer :: stat
 
318
 
 
319
    logical :: is_open
 
320
 
 
321
    inquire( this%D%unit , opened = is_open )
 
322
 
 
323
    ! Only close if the file is open
 
324
    if ( is_open ) then
 
325
      close( this%D%unit, iostat = stat )
 
326
    else
 
327
      stat = 0
 
328
    end if
 
329
 
 
330
    this%D%file = ' '
 
331
    this%D%unit = -1
 
332
    call set_error(this, stat)
 
333
 
 
334
  end subroutine delete_
 
335
 
 
336
  !> @param[inout] this force the status to be 0
 
337
  subroutine stat_reset_(this)
 
338
    BUD_CLASS(BUD_TYPE_NAME), intent(inout) :: this
 
339
    call set_error(this, 0)
 
340
  end subroutine stat_reset_
 
341
 
 
342
  !> @endcond BUD_DEVELOPER
 
343
 
 
344
 
 
345
  !> @param[in] from origin of data
 
346
  !> @param[inout] to copy data to this object
 
347
  subroutine copy_(from, to)
 
348
    BUD_CLASS(BUD_TYPE_NAME), intent(in) :: from
 
349
    BUD_CLASS(BUD_TYPE_NAME), intent(inout) :: to
 
350
 
 
351
    call delete(to)
 
352
    if ( .not. is_initd(from) ) return
 
353
 
 
354
    call initialize(to)
 
355
 
 
356
    call common_copy_(from, to)
 
357
 
 
358
    ! Copy data
 
359
    to%D%file = from%D%file
 
360
    to%D%unit = from%D%unit
 
361
 
 
362
  end subroutine copy_
 
363
 
 
364
 
 
365
 
 
366
  !> @param[inout] this file @bud
 
367
  !! @param[in] filename the path `this` will contain
 
368
  subroutine new_(this, filename)
 
369
    BUD_CLASS(BUD_TYPE_NAME), intent(inout) :: this
 
370
    character(len=*), intent(in) :: filename
 
371
 
 
372
    ! initialize object
 
373
    call initialize(this)
 
374
 
 
375
    if ( len_trim(filename) == 0 ) then
 
376
      ! show an error if there is no filename
 
377
      call set_error(this, -100)
 
378
    else
 
379
      this%D%file = trim(filename)
 
380
    end if
 
381
 
 
382
  end subroutine new_
 
383
 
 
384
 
 
385
  !> @return unit currently un-used
 
386
  function unopened_unit_() result(unit)
 
387
    integer :: unit
 
388
    logical :: is_open
 
389
 
 
390
    unit = FILE_UNIT_STARt - 1
 
391
    is_open = .true.
 
392
 
 
393
    do while ( is_open )
 
394
      unit = unit + 1
 
395
      inquire( unit , opened = is_open )
 
396
    end do
 
397
 
 
398
  end function unopened_unit_
 
399
 
 
400
  !> @param[in] this query filename from this file @bud
 
401
  !! @return filename of the file @bud
 
402
  pure function filename_(this) result(filename)
 
403
    BUD_CLASS(BUD_TYPE_NAME), intent(in) :: this
 
404
 
 
405
    character(len=len_trim(this%D%file)) :: filename
 
406
 
 
407
    filename = trim(this%D%file)
 
408
 
 
409
  end function filename_
 
410
 
 
411
  !> @param[in] this file @bud
 
412
  !! @return unit of the opened file (-1 if unopened)
 
413
  function get_unit_(this) result(unit)
 
414
    BUD_CLASS(BUD_TYPE_NAME), intent(inout) :: this
 
415
 
 
416
    integer :: unit
 
417
 
 
418
    if ( .not. is_initd(this) ) then
 
419
      unit = -1
 
420
      return
 
421
    end if
 
422
 
 
423
    call stat_reset_(this)
 
424
    unit = this%D%unit
 
425
 
 
426
  end function get_unit_
 
427
 
 
428
  !> @param[in] this file @bud
 
429
  !! @return `.true.` if the file is opened
 
430
  function is_open_(this) result(is)
 
431
    BUD_CLASS(BUD_TYPE_NAME), intent(inout) :: this
 
432
 
 
433
    integer :: stat
 
434
    logical :: is
 
435
 
 
436
    if ( .not. is_initd(this) ) then
 
437
      is = .false.
 
438
      return
 
439
    end if
 
440
 
 
441
    if ( this%D%unit < 0 ) then
 
442
      call stat_reset_(this)
 
443
      is = .false.
 
444
      return
 
445
    end if
 
446
 
 
447
    inquire( this%D%unit, opened = is, &
 
448
      iostat = stat)
 
449
    call set_error(this, stat)
 
450
 
 
451
    ! restore unit in case it really is not opened...
 
452
    ! this should only happen if the user closes the file
 
453
    ! without using the `close` function.
 
454
    if ( .not. is ) this%D%unit = -1
 
455
 
 
456
  end function is_open_
 
457
 
 
458
 
 
459
  !> @param[in] this file @bud
 
460
  !! @return `.true.` if the file exists on disk
 
461
  function exists_(this) result(exist)
 
462
    BUD_CLASS(BUD_TYPE_NAME), intent(inout) :: this
 
463
 
 
464
    logical :: exist
 
465
    integer :: stat
 
466
 
 
467
    if ( is_initd(this) ) then
 
468
      inquire( file = this%D%file, exist = exist, &
 
469
        iostat = stat)
 
470
      call set_error(this, stat)
 
471
    else
 
472
      exist = .false.
 
473
    end if
 
474
 
 
475
  end function exists_
 
476
 
 
477
 
 
478
  !> @param[in] this file @bud
 
479
  !! @return `.true.` if the file is opened in access=DIRECT mode
 
480
  function is_direct_(this) result(direct)
 
481
    BUD_CLASS(BUD_TYPE_NAME), intent(inout) :: this
 
482
 
 
483
    character(len=10) :: dir
 
484
    integer :: stat
 
485
    logical :: direct
 
486
 
 
487
    if ( is_open(this) ) then
 
488
      inquire( this%D%unit, direct = dir, &
 
489
        iostat = stat)
 
490
      call set_error(this, stat)
 
491
 
 
492
      direct = (dir == 'YES') .or. &
 
493
        (dir == 'yes')
 
494
 
 
495
    else
 
496
 
 
497
      call stat_reset_(this)
 
498
      direct = .false.
 
499
 
 
500
    end if
 
501
 
 
502
  end function is_direct_
 
503
 
 
504
 
 
505
  !> @param[in] this file @bud
 
506
  !! @return `.true.` if the file is opened in access=SEQUENTIAL mode
 
507
  function is_sequential_(this) result(sequential)
 
508
    BUD_CLASS(BUD_TYPE_NAME), intent(inout) :: this
 
509
 
 
510
    character(len=10) :: seq
 
511
    integer :: stat
 
512
    logical :: sequential
 
513
 
 
514
    if ( is_open(this) ) then
 
515
      inquire( this%D%unit, sequential = seq, &
 
516
        iostat = stat)
 
517
      call set_error(this, stat)
 
518
      sequential = (seq == 'YES') .or. &
 
519
        (seq == 'yes')
 
520
 
 
521
    else
 
522
 
 
523
      call stat_reset_(this)
 
524
      sequential = .false.
 
525
 
 
526
    end if
 
527
 
 
528
  end function is_sequential_
 
529
 
 
530
 
 
531
  !> @param[in] this file @bud
 
532
  !! @return `.true.` if the file is opened in form=FORMATTED mode
 
533
  function is_formatted_(this) result(formatted)
 
534
    BUD_CLASS(BUD_TYPE_NAME), intent(inout) :: this
 
535
 
 
536
    character(len=10) :: form
 
537
    integer :: stat
 
538
    logical :: formatted
 
539
 
 
540
    if ( is_open(this) ) then
 
541
      inquire( this%D%unit, formatted = form, &
 
542
        iostat = stat)
 
543
      call set_error(this, stat)
 
544
 
 
545
      formatted = (form == 'YES') .or. &
 
546
        (form == 'yes')
 
547
 
 
548
    else
 
549
 
 
550
      call stat_reset_(this)
 
551
      formatted = .false.
 
552
 
 
553
    end if
 
554
 
 
555
  end function is_formatted_
 
556
 
 
557
 
 
558
  !> @param[in] this file @bud
 
559
  !! @return `.true.` if the file is opened in form=UNFORMATTED mode
 
560
  function is_unformatted_(this) result(unformatted)
 
561
    BUD_CLASS(BUD_TYPE_NAME), intent(inout) :: this
 
562
 
 
563
    character(len=10) :: unform
 
564
    integer :: stat
 
565
    logical :: unformatted
 
566
 
 
567
    if ( is_open(this) ) then
 
568
      inquire( this%D%unit, unformatted = unform, &
 
569
        iostat = stat)
 
570
      call set_error(this, stat)
 
571
 
 
572
      unformatted = (unform == 'YES') .or. &
 
573
        (unform == 'yes')
 
574
 
 
575
    else
 
576
 
 
577
      call stat_reset_(this)
 
578
      unformatted = .false.
 
579
 
 
580
    end if
 
581
 
 
582
  end function is_unformatted_
 
583
 
 
584
 
 
585
  !> @param[in] this file @bud
 
586
  !! @return status from the last operation
 
587
  function get_stat_(this) result(stat)
 
588
    BUD_CLASS(BUD_TYPE_NAME), intent(inout) :: this
 
589
 
 
590
    integer :: stat
 
591
 
 
592
    if ( is_open(this) ) then
 
593
      stat = error(this)
 
594
      call stat_reset_(this)
 
595
    else
 
596
      stat = 0
 
597
    end if
 
598
 
 
599
  end function get_stat_
 
600
 
 
601
 
 
602
  !> @param[inout] this file @bud
 
603
  !! @param[in] D (dummy argument which should _NEVER_ be used, forces explicit interface usage)
 
604
  !! @param[in] form @opt='FORMATTED' format of opened file
 
605
  !! @param[in] access @opt='SEQUENTIAL' file access pattern
 
606
  !! @param[in] action @opt='READWRITE' file R/W access
 
607
  !! @param[in] status @opt='OLD' file-existance
 
608
  subroutine open_(this, D, form, access, action, status)
 
609
    BUD_CLASS(BUD_TYPE_NAME), intent(inout) :: this
 
610
    character(len=*), intent(in), optional :: D, form, access, action, status
 
611
 
 
612
    character(len=32) :: lform, laccess, laction, lstatus
 
613
    integer :: stat
 
614
 
 
615
    if ( .not. is_initd(this) ) return
 
616
 
 
617
    ! ensure that the file is closed
 
618
    call close(this)
 
619
 
 
620
    ! process options
 
621
    lform = 'FORMATTED'
 
622
    if ( present(form) ) lform = trim(form)
 
623
    laccess = 'SEQUENTIAL'
 
624
    if ( present(access) ) laccess = trim(access)
 
625
    laction = 'READWRITE'
 
626
    if ( present(action) ) laction = trim(action)
 
627
    lstatus = 'OLD'
 
628
    if ( present(status) ) lstatus = trim(status)
 
629
 
 
630
    ! Get new unit
 
631
    this%D%unit = unopened_unit()
 
632
 
 
633
    open( this%D%unit, file=trim(this%D%file), &
 
634
      form = lform, access = laccess, action = laction, &
 
635
      status = lstatus, &
 
636
      iostat = stat )
 
637
    call set_error(this, stat)
 
638
 
 
639
  end subroutine open_
 
640
 
 
641
  !> @param[inout] this file @bud
 
642
  subroutine close_(this)
 
643
    BUD_CLASS(BUD_TYPE_NAME), intent(inout) :: this
 
644
    integer :: stat
 
645
 
 
646
    if ( .not. is_open(this) ) then
 
647
      call stat_reset_(this)
 
648
      return
 
649
    end if
 
650
 
 
651
    ! Close file-unit
 
652
    close( this%D%unit, iostat = stat )
 
653
    call set_error(this, stat)
 
654
 
 
655
    this%D%unit = -1
 
656
 
 
657
  end subroutine close_
 
658
 
 
659
  !> @param[inout] this file @bud
 
660
  subroutine rewind_(this)
 
661
    BUD_CLASS(BUD_TYPE_NAME), intent(inout) :: this
 
662
    integer :: stat
 
663
 
 
664
    if ( .not. is_open(this) ) return
 
665
 
 
666
    rewind( this%D%unit, iostat = stat )
 
667
    call set_error(this, stat)
 
668
 
 
669
  end subroutine rewind_
 
670
 
 
671
  !> @param[inout] this file @bud
 
672
  !! @param[in] n @opt=1 number of times to backspace
 
673
  subroutine backspace_(this, n)
 
674
    BUD_CLASS(BUD_TYPE_NAME), intent(inout) :: this
 
675
    integer, intent(in), optional :: n
 
676
    integer :: stat
 
677
    integer :: i
 
678
 
 
679
    if ( .not. is_open(this) ) then
 
680
      call stat_reset_(this)
 
681
      return
 
682
    end if
 
683
 
 
684
    if ( present(n) ) then
 
685
 
 
686
      do i = 1, n
 
687
 
 
688
        backspace( this%D%unit, &
 
689
          iostat = stat )
 
690
        call set_error(this, stat)
 
691
 
 
692
        if ( error(this) /= 0 ) return
 
693
      end do
 
694
 
 
695
    else
 
696
 
 
697
      backspace( this%D%unit, &
 
698
        iostat = stat )
 
699
      call set_error(this, stat)
 
700
 
 
701
    end if
 
702
 
 
703
  end subroutine backspace_
 
704
 
 
705
  !> @param[inout] this file @bud
 
706
  subroutine delete_file_(this)
 
707
    BUD_CLASS(BUD_TYPE_NAME), intent(inout) :: this
 
708
    integer :: unit
 
709
    integer :: stat
 
710
 
 
711
    ! immediately return if the object
 
712
    ! has not been created.
 
713
    if ( .not. is_initd(this) ) return
 
714
 
 
715
    if ( is_open(this) ) then
 
716
 
 
717
      close( this%D%unit, STATUS = 'DELETE', &
 
718
        iostat = stat )
 
719
      call set_error(this, stat)
 
720
 
 
721
      ! reset status as not opened
 
722
      this%D%unit = -1
 
723
 
 
724
    else if ( exists(this) ) then
 
725
 
 
726
      unit = unopened_unit()
 
727
      ! it does not matter how it is opened
 
728
      open( unit, file = this%D%file )
 
729
      close( unit, STATUS = 'DELETE', &
 
730
        iostat = stat )
 
731
      call set_error(this, stat)
 
732
 
 
733
    end if
 
734
 
 
735
  end subroutine delete_file_
 
736
 
 
737
 
 
738
  !> @param[in] this data type
 
739
  !! @param[in] info @opt=BUD_TYPE_NAME_STR additional information printed
 
740
  !! @param[in] indent @opt=1 possible indentation of printed statement
 
741
  subroutine print_(this, info, indent)
 
742
    BUD_CLASS(BUD_TYPE_NAME), intent(inout) :: this
 
743
    character(len=*), intent(in), optional :: info
 
744
    integer, intent(in), optional :: indent
 
745
 
 
746
    integer :: lindent
 
747
 
 
748
    ! 4-byte variable
 
749
    character(len=32) :: fmt
 
750
    character(len=256) :: name
 
751
 
 
752
    name = BUD_TYPE_NAME_STR
 
753
    if ( present(info) ) name = info
 
754
    lindent = 1
 
755
    if ( present(indent) ) lindent = indent
 
756
 
 
757
    write(fmt, '(a,i0,a)') '(t',lindent,',3a)'
 
758
 
 
759
    if ( .not. is_initd(this) ) then
 
760
      write(*,fmt) "<", trim(name), " not initialized>"
 
761
      return
 
762
    end if
 
763
 
 
764
    ! Create fmt
 
765
    write(fmt, '(a,i0,a)') '(t',lindent,',4a,4(a,l1),a,i0,a)'
 
766
 
 
767
    write(*,fmt) "<", trim(name), &
 
768
      " file=", filename(this), &
 
769
      ", open=", is_open(this), &
 
770
      ", formatted=", is_formatted(this), &
 
771
      ", direct=", is_direct(this), &
 
772
      ", exists=", exists(this), &
 
773
      ", refs: ", references(this), ">"
 
774
 
 
775
    call stat_reset_(this)
 
776
 
 
777
  end subroutine print_
 
778
 
 
779
end module
 
780
!> @}
 
781
 
 
782
 
 
783
! project-buds -- local file settings
 
784
!     Anything below this line may be overwritten by scripts
 
785
!     Below are non-editable settings
 
786
 
 
787
! Local Variables:
 
788
!  mode: f90
 
789
!  f90-if-indent: 2
 
790
!  f90-type-indent: 2
 
791
!  f90-associate-indent: 2
 
792
!  f90-continuation-indent: 2
 
793
!  f90-structure-indent: 2
 
794
!  f90-critical-indent: 2
 
795
!  f90-program-indent: 2
 
796
!  f90-do-indent: 2
 
797
! End:
 
798