[1765] | 1 | module csvread_m |
---|
| 2 | |
---|
| 3 | use new_unit_m, only: new_unit |
---|
| 4 | use prep_file_m, only: prep_file |
---|
| 5 | |
---|
| 6 | implicit none |
---|
| 7 | |
---|
| 8 | private |
---|
| 9 | public csvread |
---|
| 10 | |
---|
| 11 | interface csvread |
---|
| 12 | ! Reads numeric values from a file. |
---|
| 13 | ! Values must be separated by comma and/or blanks. |
---|
| 14 | ! Values are read into a default real kind or double precision array. |
---|
| 15 | ! The last column and/or last row parameters may be 0. |
---|
| 16 | ! This is interpreted as "last in the file". |
---|
| 17 | ! The only difference between the interfaces of the specific |
---|
| 18 | ! procedures is the type of "a". |
---|
| 19 | module procedure csvread_sp, csvread_dp |
---|
| 20 | end interface |
---|
| 21 | |
---|
| 22 | contains |
---|
| 23 | |
---|
| 24 | subroutine csvread_sp(file, a, first_r, first_c, last_r, last_c) |
---|
| 25 | |
---|
| 26 | character(len=*), intent(in):: file |
---|
| 27 | real, pointer:: a(:,:) |
---|
| 28 | integer, intent(in), optional:: first_r ! (first row to read) |
---|
| 29 | integer, intent(in), optional:: first_c ! (first column to read) |
---|
| 30 | integer, intent(in), optional:: last_r ! (last row to read) |
---|
| 31 | integer, intent(in), optional:: last_c ! (last column to read) |
---|
| 32 | |
---|
| 33 | ! Variables local to the subprogram: |
---|
| 34 | integer i, j, unit |
---|
| 35 | integer f_r_loc ! (first row to read, local variable) |
---|
| 36 | integer f_c_loc ! (first column to read, local variable) |
---|
| 37 | integer l_r_loc ! (last row to read, local variable) |
---|
| 38 | integer l_c_loc ! (last column to read, local variable) |
---|
| 39 | real trash |
---|
| 40 | |
---|
| 41 | !------------------------------------------------------ |
---|
| 42 | |
---|
| 43 | print *, 'Reading data from file "' // file // '"' |
---|
| 44 | call new_unit(unit) |
---|
| 45 | open(unit, file=file, status='old', action='read', position='rewind') |
---|
| 46 | |
---|
| 47 | call prep_file(unit, first_r, first_c, last_r, last_c, f_r_loc, & |
---|
| 48 | f_c_loc, l_r_loc, l_c_loc) |
---|
| 49 | |
---|
| 50 | allocate(a(l_r_loc - f_r_loc + 1, l_c_loc - f_c_loc + 1)) |
---|
| 51 | |
---|
| 52 | do i = 1, l_r_loc - f_r_loc + 1 |
---|
| 53 | read(unit, fmt=*) (trash, j = 1, f_c_loc - 1), a(i, :) |
---|
| 54 | end do |
---|
| 55 | |
---|
| 56 | close(unit) |
---|
| 57 | |
---|
| 58 | end subroutine csvread_sp |
---|
| 59 | |
---|
| 60 | !*********************************************************** |
---|
| 61 | |
---|
| 62 | subroutine csvread_dp(file, a, first_r, first_c, last_r, last_c) |
---|
| 63 | |
---|
| 64 | character(len=*), intent(in):: file |
---|
| 65 | double precision, pointer:: a(:,:) |
---|
| 66 | integer, intent(in), optional:: first_r ! (first row to read) |
---|
| 67 | integer, intent(in), optional:: first_c ! (first column to read) |
---|
| 68 | integer, intent(in), optional:: last_r ! (last row to read) |
---|
| 69 | integer, intent(in), optional:: last_c ! (last column to read) |
---|
| 70 | |
---|
| 71 | ! Variables local to the subprogram: |
---|
| 72 | integer i, j, unit |
---|
| 73 | integer f_r_loc ! (first row to read, local variable) |
---|
| 74 | integer f_c_loc ! (first column to read, local variable) |
---|
| 75 | integer l_r_loc ! (last row to read, local variable) |
---|
| 76 | integer l_c_loc ! (last column to read, local variable) |
---|
| 77 | double precision trash |
---|
| 78 | |
---|
| 79 | !------------------------------------------------------ |
---|
| 80 | |
---|
| 81 | print *, 'Reading data from file "' // file // '"' |
---|
| 82 | call new_unit(unit) |
---|
| 83 | open(unit, file=file, status='old', action='read', position='rewind') |
---|
| 84 | |
---|
| 85 | call prep_file(unit, first_r, first_c, last_r, last_c, f_r_loc, & |
---|
| 86 | f_c_loc, l_r_loc, l_c_loc) |
---|
| 87 | |
---|
| 88 | allocate(a(l_r_loc - f_r_loc + 1, l_c_loc - f_c_loc + 1)) |
---|
| 89 | |
---|
| 90 | do i = 1, l_r_loc - f_r_loc + 1 |
---|
| 91 | read(unit, fmt=*) (trash, j = 1, f_c_loc - 1), a(i, :) |
---|
| 92 | end do |
---|
| 93 | |
---|
| 94 | close(unit) |
---|
| 95 | |
---|
| 96 | end subroutine csvread_dp |
---|
| 97 | |
---|
| 98 | end module csvread_m |
---|