COSMOS v7.655  COSMOSv7655
(AirShowerMC)
kgsub.f
Go to the documentation of this file.
1  subroutine kgsub(r, t, si, so)
2  implicit none
3 ! replace string r in si by t and put into so
4 ! old kgsub has bug if t is "" or " " ...
5 ! moved from Epics/prog/KKlib to Cosmos/KKlib/ 2014/Sep/27
6  character*(*) r ! input.
7  character*(*) t ! input.
8  character*(*) si ! input.
9  character*(*) so ! output.
10 
11  integer klena, ir, it, isi, iso, i, j
12 
13  ir = len(trim(r))
14  it = len(trim(t))
15  if(it == 0 ) it = len(t)
16 
17  isi =len(trim(si))
18  iso = len(so)
19 
20  i = 1
21  j = 0
22  so = ' '
23  do while ( i .le. isi )
24  if(i+ir-1 .le. isi) then
25  if( si(i:i+ir-1) .eq. r(1:ir)) then
26  j = j + 1
27  if(it > 0 ) then
28  so(j:j+it-1) = t(1:it)
29  j = j + it -1
30  endif
31  i = i + ir
32  else
33  j = j + 1
34  if( it> 0 ) then
35  so(j:j+it-1) = si(i:i)
36  else
37  so(j+it-1:j) = si(i:i)
38  endif
39  i = i + 1
40  endif
41  else
42  j = j + 1
43  if(it > 0 ) then
44  so(j:j+it-1) = si(i:i)
45  else
46  so(j+it-1:j) = si(i:i)
47  endif
48  i = i +1
49  endif
50  if(j .gt. iso) then
51  write(0,*)
52  * ' output string length is too short: kgsub'
53  stop 9999
54  endif
55  enddo
56  end
kgsub
subroutine kgsub(r, t, si, so)
Definition: kgsub.f:2