← Back to branch summary

~maddevelopers/mg5amcnlo/2.9.4

« back to all changes in this revision

Viewing changes to Template/NLO/MCatNLO/srcCommon/mcatnlo_str.f

pass to v2.0.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
Template/NLO/MCatNLO/srcCommon/mcatnlo_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