[1765] | 1 | module read_column_m |
---|
| 2 | |
---|
| 3 | implicit none |
---|
| 4 | |
---|
| 5 | private |
---|
| 6 | public read_column |
---|
| 7 | |
---|
| 8 | interface read_column |
---|
| 9 | ! This generic procedure reads a column of values in an external |
---|
| 10 | ! file. |
---|
| 11 | ! The records of the file shoud be formatted. |
---|
| 12 | ! If the argument "last" is 0 or is absent then the procedure |
---|
| 13 | ! reads to the last line in the file. |
---|
| 14 | ! The difference between the specific procedures is the type of |
---|
| 15 | ! argument "a". |
---|
| 16 | module procedure read_column_real, read_column_char |
---|
| 17 | end interface |
---|
| 18 | |
---|
| 19 | contains |
---|
| 20 | |
---|
| 21 | subroutine read_column_real(file, a, first, last) |
---|
| 22 | |
---|
| 23 | use new_unit_m, only: new_unit |
---|
| 24 | |
---|
| 25 | character(len=*), intent(in):: file |
---|
| 26 | real, pointer:: a(:) |
---|
| 27 | integer, intent(in), optional:: first ! (first line to read) |
---|
| 28 | integer, intent(in), optional:: last ! (last line to read) |
---|
| 29 | |
---|
| 30 | ! Variables local to the subprogram: |
---|
| 31 | integer unit ! external file unit |
---|
| 32 | integer first_not_opt ! first line to read, local variable |
---|
| 33 | integer last_not_opt ! last line to read, local variable |
---|
| 34 | |
---|
| 35 | !------------------------------------------------------ |
---|
| 36 | |
---|
| 37 | call new_unit(unit) |
---|
| 38 | open(unit, file=file, status='old', action='read', position='rewind') |
---|
| 39 | call prep_file(unit, first, last, first_not_opt, last_not_opt) |
---|
| 40 | allocate(a(last_not_opt - first_not_opt + 1)) |
---|
| 41 | read(unit, fmt=*) a |
---|
| 42 | close(unit) |
---|
| 43 | |
---|
| 44 | end subroutine read_column_real |
---|
| 45 | |
---|
| 46 | !*********************************************************** |
---|
| 47 | |
---|
| 48 | subroutine read_column_char(file, a, first, last) |
---|
| 49 | |
---|
| 50 | use new_unit_m, only: new_unit |
---|
| 51 | |
---|
| 52 | character(len=*), intent(in):: file |
---|
| 53 | character(len=*), pointer:: a(:) |
---|
| 54 | integer, intent(in), optional:: first ! (first line to read) |
---|
| 55 | integer, intent(in), optional:: last ! (last line to read) |
---|
| 56 | |
---|
| 57 | ! Variables local to the subprogram: |
---|
| 58 | integer unit |
---|
| 59 | integer first_not_opt ! first line to read, local variable |
---|
| 60 | integer last_not_opt ! last line to read, local variable |
---|
| 61 | |
---|
| 62 | !------------------------------------------------------ |
---|
| 63 | |
---|
| 64 | call new_unit(unit) |
---|
| 65 | open(unit, file=file, status='old', action='read', position='rewind') |
---|
| 66 | call prep_file(unit, first, last, first_not_opt, last_not_opt) |
---|
| 67 | allocate(a(last_not_opt - first_not_opt + 1)) |
---|
| 68 | read(unit, fmt=*) a |
---|
| 69 | close(unit) |
---|
| 70 | |
---|
| 71 | end subroutine read_column_char |
---|
| 72 | |
---|
| 73 | !*********************************************************** |
---|
| 74 | |
---|
| 75 | subroutine prep_file(unit, first, last, first_not_opt, last_not_opt) |
---|
| 76 | |
---|
| 77 | ! This subroutine is used by the various versions of "read_column". |
---|
| 78 | ! It fills non-optional arguments: first and last line which will |
---|
| 79 | ! actually be read, taking information from the file itself if necessary. |
---|
| 80 | ! It also positions the input file on the first line to read. |
---|
| 81 | |
---|
| 82 | use opt_merge_m, only: opt_merge |
---|
| 83 | |
---|
| 84 | integer, intent(in):: unit ! logical unit for input file |
---|
| 85 | integer, intent(in), optional:: first ! (first line to read) |
---|
| 86 | integer, intent(in), optional:: last ! (last line to read) |
---|
| 87 | integer, intent(out):: first_not_opt ! (first line to read, not optional) |
---|
| 88 | integer, intent(out):: last_not_opt ! (last line to read, not optional) |
---|
| 89 | |
---|
| 90 | ! Variables local to the subprogram: |
---|
| 91 | integer iostat, i |
---|
| 92 | |
---|
| 93 | !------------------------------------------------------ |
---|
| 94 | |
---|
| 95 | first_not_opt = opt_merge(first, 1) |
---|
| 96 | last_not_opt = opt_merge(last, 0) |
---|
| 97 | |
---|
| 98 | if (last_not_opt == 0) then |
---|
| 99 | ! Count the number of lines in the file: |
---|
| 100 | i = 0 |
---|
| 101 | do |
---|
| 102 | read(unit, fmt=*, iostat=iostat) |
---|
| 103 | if (iostat /= 0) exit |
---|
| 104 | i = i + 1 |
---|
| 105 | end do |
---|
| 106 | last_not_opt = i |
---|
| 107 | if (last_not_opt == 0) stop 'Empty file.' |
---|
| 108 | |
---|
| 109 | rewind(unit) |
---|
| 110 | end if |
---|
| 111 | |
---|
| 112 | ! Go to first line to read: |
---|
| 113 | do i = 1, first_not_opt - 1 |
---|
| 114 | read(unit, fmt=*) |
---|
| 115 | end do |
---|
| 116 | |
---|
| 117 | end subroutine prep_file |
---|
| 118 | |
---|
| 119 | end module read_column_m |
---|