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
| module split_string_index
! Rem : pb alloc. dyn. des chaines avec version de gfortran (gcc 4.7.3)
! character(len=:), allocatable :: value
! 1
! Error: Deferred-length character component 'value' at (1) is not yet supported
implicit none
integer, parameter :: NBCHAR = 64
type word
character(len=NBCHAR) :: value
type(word), pointer :: p_next => null()
end type word
type(word), pointer :: p_first => null()
type(word), pointer :: p_curr => null()
type(word), pointer, private :: p_prec => null()
integer :: nb_elt
private :: record
contains
subroutine split (line,delim)
character(len=*), intent(in) :: line
character(len=*), intent(in) :: delim
integer :: idx1 ! position 1er charact. après delim
integer :: idx2 ! position du delim finissant le mot
integer :: step ! nb char de fin du delim au debut nv delim
integer :: l_delim
l_delim = len(delim)
idx1 = 1 ; idx2 = 0 ; nb_elt = 0
do
step = index(line(idx1:),delim) - 1
if (step==-1) exit
idx2 = idx1 + step
call record (line(idx1:idx2-1))
idx1 = idx2 + l_delim
enddo
if (idx2>0) then
idx1 = idx2 + l_delim
idx2 = len_trim(line)
call record (line(idx1:idx2))
else
call record (trim(line))
endif
end subroutine split
subroutine record (a_string)
character(len=*), intent(in) :: a_string
if (.not. associated(p_first)) then
allocate(p_first)
p_curr => p_first
else
allocate(p_curr)
p_prec%p_next => p_curr
endif
p_curr%value = a_string
p_prec => p_curr
nb_elt = nb_elt + 1
end subroutine record
recursive subroutine libere (ptr)
type(word), pointer :: ptr
if (associated(ptr%p_next)) call libere(ptr%p_next)
deallocate(ptr)
end subroutine libere
function get_item (idx)
character(len=NBCHAR) :: get_item
integer, intent(in) :: idx
integer :: i
get_item = ""
if (idx<=0 .or. idx>nb_elt) goto 101
if (.not. associated(p_first)) goto 102
p_curr => p_first
do i = 1, idx-1
p_curr => p_curr%p_next
if (.not. associated(p_curr)) goto 102
enddo
get_item = p_curr%value
return
101 print '(/,"--- Error : index",x,i3,x,"out of range",/)', idx
return
102 print '(/,"--- Error : pointer not associated",/)'
return
end function get_item
end module split_string_index |
Partager