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