-
Notifications
You must be signed in to change notification settings - Fork 0
/
string_helpers.f90
77 lines (64 loc) · 1.97 KB
/
string_helpers.f90
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
module string_helpers
implicit none
contains
subroutine compact(str)
! Converts multiple spaces and tabs to single spaces; deletes control characters;
! removes initial spaces.
character(len=*):: str
character(len=1):: ch
character(len=len_trim(str)):: outstr
integer::isp,k,ich,lenstr,i
str=adjustl(str)
lenstr=len_trim(str)
outstr=' '
isp=0
k=0
do i=1,lenstr
ch=str(i:i)
ich=iachar(ch)
select case(ich)
case(9,32) ! space or tab character
if(isp==0) then
k=k+1
outstr(k:k)=' '
end if
! isp=1
case(33:) ! not a space, quote, or control character
k=k+1
outstr(k:k)=ch
isp=0
end select
end do
str=adjustl(outstr)
end subroutine compact
subroutine string_insert( string, pos, second )
character(len=*), intent(inout) :: string
integer, intent(in) :: pos
character(len=*), intent(in) :: second
integer :: length
length = len( second )
string(pos+length:) = string(pos:)
string(pos:pos+length-1) = second
end subroutine string_insert
subroutine string_delete( string, pos, length )
character(len=*), intent(inout) :: string
integer, intent(in) :: pos
integer, intent(in) :: length
string(pos:) = string(pos+length:)
end subroutine string_delete
subroutine string_replace( string, substr, replace )
character(len=*), intent(inout) :: string
character(len=*), intent(in) :: substr
character(len=*), intent(in) :: replace
integer :: k
do
k = index( string, substr )
if ( k > 0 ) then
call string_delete( string, k, len(substr) )
call string_insert( string, k, replace )
else
exit
endif
enddo
end subroutine string_replace
endmodule