Changes for Root6 (Mikolaj)
[u/mrichter/AliRoot.git] / HERWIG / str.f
1 c Utilities working on strings
2 c
3       function fk88strnoeq(str1,str2)
4 c Returns true if str1#str2, false otherwise. The comparison
5 c is case INSENSITIVE
6       logical fk88strnoeq,flag
7       character * (*) str1,str2
8       character * 70 strin,tmp1,tmp2
9 c
10       strin=str1
11       call fk88low_to_upp(strin,tmp1)
12       strin=str2
13       call fk88low_to_upp(strin,tmp2)
14       if(tmp1.eq.tmp2)then
15         flag=.false.
16       else
17         flag=.true.
18       endif
19       fk88strnoeq=flag
20       return
21       end
22
23
24       subroutine fk88low_to_upp(strin,strout)
25 c Converts lowercase to uppercase
26       implicit real*8(a-h,o-z)
27       character*70 strin,strout,tmp
28       character*1 ch,ch1
29 c
30       len=ifk88istrl(strin)
31       if(len.eq.0)then
32         return
33       elseif(len.eq.1)then
34         ch=strin
35         call fk88xgetchar1(ch,ch1)
36         strout=ch1
37       else
38         do i=1,len
39           ch=strin(i:i+1)
40           call fk88xgetchar1(ch,ch1)
41           if(i.eq.1)then
42             strout=ch1
43           else
44             call fk88strcat(strout,ch1,tmp)
45             strout=tmp
46           endif
47         enddo
48       endif
49       return
50       end
51
52
53       subroutine fk88xgetchar1(ch,ch1)
54 c Converts lowercase to uppercase (1 character only)
55       character*1 ch,ch1
56 c ia=ascii value of a
57       parameter (ia=97)
58 c iz=ascii value of z
59       parameter (iz=122)
60 c ishift=difference between the ascii value of a and A
61       parameter (ishift=32)
62 c
63       ic=ichar(ch)
64       if(ic.ge.ia.and.ic.le.iz)then
65         ch1=char(ic-ishift)
66       else
67         ch1=ch
68       endif
69       return
70       end
71
72
73       subroutine fk88strnum(string,num)
74 c- writes the number num on the string string starting at the blank
75 c- following the last non-blank character
76       character * (*) string
77       character * 20 tmp
78       l = len(string)
79       write(tmp,'(i15)')num
80       j=1
81       dowhile(tmp(j:j).eq.' ')
82         j=j+1
83       enddo
84       ipos = ifk88istrl(string)
85       ito = ipos+1+(15-j)
86       if(ito.gt.l) then
87          write(*,*)'error, string too short'
88          write(*,*) string
89          stop
90       endif
91       string(ipos+1:ito)=tmp(j:)
92       end
93
94
95       function ifk88istrl(string)
96 c returns the position of the last non-blank character in string
97       character * (*) string
98       i = len(string)
99       dowhile(i.gt.0.and.string(i:i).eq.' ')
100          i=i-1
101       enddo
102       ifk88istrl = i
103       end
104
105
106       subroutine fk88strcat(str1,str2,str)
107 c concatenates str1 and str2 into str. Ignores trailing blanks of str1,str2
108       character *(*) str1,str2,str
109       l1=ifk88istrl(str1)
110       l2=ifk88istrl(str2)
111       l =len(str)
112       if(l.lt.l1+l2) then
113           write(*,*) 'error: l1+l2>l in fk88strcat'
114           write(*,*) 'l1=',l1,' str1=',str1
115           write(*,*) 'l2=',l2,' str2=',str2
116           write(*,*) 'l=',l
117           stop
118       endif
119       if(l1.ne.0) str(1:l1)=str1(1:l1)
120       if(l2.ne.0) str(l1+1:l1+l2)=str2(1:l2)
121       if(l1+l2+1.le.l) str(l1+l2+1:l)= ' '
122       end