← Back to branch summary

~maddevelopers/mg5amcnlo/3.0.2-alpha0

« back to all changes in this revision

Viewing changes to Template/SubProcesses/shrinktops.f

Added Template and HELAS into bzr

Show diffs side-by-side

added added

removed removed

Lines of Context:
Template/SubProcesses/shrinktops.f
 
1
      program ShrinkTops
 
2
c*******************************************************************************
 
3
c     Program that takes topologies from configs.inc and writes
 
4
c     out new topologies with last particle removed in file
 
5
c     configs-1.inc and props-1.inc
 
6
c******************************************************************************
 
7
      implicit none
 
8
c
 
9
c     Constants
 
10
c     
 
11
      include 'genps.inc'
 
12
      include 'nexternal.inc'
 
13
c
 
14
c     Local
 
15
c
 
16
      integer iconfig,igraph,i,jbranch,ibranch,jconfig
 
17
      integer isubprop, isubval
 
18
      integer iforest(2,-max_branch:-1,lmaxconfigs)
 
19
      integer iforest2(2,-max_branch:-1,lmaxconfigs)
 
20
      integer t_chan
 
21
      integer            mapconfig(0:lmaxconfigs)
 
22
      integer            mapconfig2(0:lmaxconfigs)
 
23
      double precision      spole(maxinvar),swidth(maxinvar),bwjac
 
24
      integer sprop(-max_branch:-1,lmaxconfigs)
 
25
      integer tprid(-max_branch:-1,lmaxconfigs)
 
26
      integer sprop2(-max_branch:-1,lmaxconfigs)
 
27
      integer tprid2(-max_branch:-1,lmaxconfigs)
 
28
      character*50 buff_pmass 
 
29
      character*50 buff_pwidth 
 
30
      character*50 buff_pow
 
31
      character*10 oniumtype
 
32
      integer nchars
 
33
c
 
34
c     external
 
35
c
 
36
      logical one_gluon_config
 
37
      logical two_gluon_config
 
38
c
 
39
c     data
 
40
c
 
41
      include 'configs.inc'
 
42
c-----
 
43
c  Begin Code
 
44
c----
 
45
      open(unit=35, file="configs_temp.inc",status="unknown",err=999)
 
46
      open(unit=36, file="props.inc",status="old",err=999)
 
47
      open(unit=37, file="props_temp.inc",status="unknown",err=999)
 
48
 
 
49
      open(unit=38, file="oniumtype.mg",status="unknown",err=999)
 
50
      read(38,'(a)') oniumtype
 
51
      close(38)
 
52
      call no_spaces(oniumtype,nchars)
 
53
 
 
54
      jconfig=0
 
55
 
 
56
      do iconfig = 1, mapconfig(0)     !Loop over all configurations
 
57
c
 
58
c     first quick check if we need to keep the conf.
 
59
c
 
60
 
 
61
      if(oniumtype(4:4).eq.'1') then
 
62
        if(one_gluon_config(iforest,
 
63
     & sprop,tprid,iconfig)) then
 
64
c
 
65
c      jump lines in props.inc
 
66
c
 
67
        ibranch = 0
 
68
         do while (ibranch .lt. nexternal-2)
 
69
            ibranch = ibranch + 1 
 
70
              read(36,'(a)') buff_pmass
 
71
              read(36,'(a)') buff_pwidth
 
72
              read(36,'(a)') buff_pow
 
73
         enddo
 
74
c
 
75
c     jump to the next config
 
76
c
 
77
        goto 12
 
78
        endif
 
79
      endif 
 
80
 
 
81
      if(oniumtype(1:1).eq.'3'.and.oniumtype(2:2).eq.'S') then
 
82
        if (two_gluon_config(iforest,
 
83
     & sprop,tprid,iconfig)) then
 
84
c
 
85
c      jump lines in props.inc
 
86
c
 
87
        ibranch = 0
 
88
         do while (ibranch .lt. nexternal-2)
 
89
            ibranch = ibranch + 1
 
90
              read(36,'(a)') buff_pmass
 
91
              read(36,'(a)') buff_pwidth
 
92
              read(36,'(a)') buff_pow
 
93
         enddo
 
94
c
 
95
c     jump to the next config
 
96
c
 
97
        goto 12
 
98
        endif
 
99
 
 
100
      endif
 
101
 
 
102
      jconfig=jconfig+1
 
103
      mapconfig2(jconfig)=mapconfig(iconfig)
 
104
 
 
105
c
 
106
c        Second  write out configuration # and graphs
 
107
c
 
108
         igraph = mapconfig(iconfig)       
 
109
 
 
110
         write(35,'(a,i6)') 'c   Graph ',igraph
 
111
         write(35,'(6x,a,i4,a,i4,a)')
 
112
     $        'data mapconfig(',jconfig,') /',igraph,'/'
 
113
c
 
114
c        Reset all parameters for configuration
 
115
c
 
116
         t_chan = 0
 
117
         isubprop = 0
 
118
         isubval  = 0
 
119
         jbranch = 0
 
120
         ibranch = 0
 
121
         do while (ibranch .lt. nexternal-2+t_chan)
 
122
            ibranch = ibranch + 1
 
123
c
 
124
            if (iforest(1,-ibranch,iconfig) .eq. 1) t_chan=1
 
125
c             sometimes there is 1 branch less in props.inc 
 
126
              if(t_chan.ne.1.or. ibranch.ne.nexternal-1) then
 
127
              read(36,'(a)') buff_pmass
 
128
              read(36,'(a)') buff_pwidth
 
129
              read(36,'(a)') buff_pow
 
130
c              write(*,'(i2,a)') ibranch, buff_pmass
 
131
              endif
 
132
            if (iforest(1,-ibranch,iconfig) .eq. (nexternal+1) .or.
 
133
     $          iforest(2,-ibranch,iconfig) .eq. (nexternal+1)) then   !Remove this one
 
134
c   isubprop records the index of the removed branch 
 
135
c   isubval records the index of the particle initially grouped with particle nexternal+1
 
136
c   isubprop is to be replaced by isubval later on
 
137
               isubprop  = -ibranch
 
138
               isubval = iforest(1,-ibranch,iconfig)+
 
139
     $              iforest(2,-ibranch,iconfig)-nexternal-1
 
140
            else   !write out this line
 
141
               jbranch=jbranch+1  !new ordering for branches
 
142
               do i=1,2
 
143
                  if (iforest(i,-ibranch,iconfig) .eq. isubprop) then
 
144
                     iforest(i,-ibranch,iconfig) = isubval
 
145
cPierre: here we have to add another condition
 
146
                  elseif(isubprop.ne.0.and. ! we have already met part. nexternal+1            
 
147
     &             isubprop.gt.iforest(i,-ibranch,iconfig)) then ! i.e iforest(i,-ibr) is an intermediate part with an index smaller then isubprop 
 
148
                     iforest(i,-ibranch,iconfig)=
 
149
     &               iforest(i,-ibranch,iconfig)+1
 
150
c end modif Pierre
 
151
                  endif
 
152
               enddo
 
153
 
 
154
              if(jbranch.ne.ibranch) then
 
155
                write(buff_pmass(13:15),'(i3)') -jbranch
 
156
                write(buff_pwidth(14:16),'(i3)') -jbranch
 
157
                write(buff_pow(11:13),'(i3)') -jbranch
 
158
              endif
 
159
               write(buff_pmass(17:20),'(i4)') jconfig
 
160
               write(buff_pwidth(18:21),'(i4)') jconfig
 
161
               write(buff_pow(15:18),'(i4)') jconfig
 
162
 
 
163
 
 
164
c write info in configs-1.inc
 
165
               write(35,99) -jbranch,jconfig,iforest(1,-ibranch,iconfig)
 
166
     $              ,iforest(2,-ibranch,iconfig),"?","?"
 
167
               iforest2(1,-jbranch,jconfig)=iforest(1,-ibranch,iconfig)
 
168
               iforest2(2,-jbranch,jconfig)=iforest(2,-ibranch,iconfig)
 
169
               if(t_chan.eq.0) then
 
170
               write(35,92) -jbranch,jconfig,sprop(-ibranch,iconfig) 
 
171
               sprop2(-jbranch,jconfig)=sprop(-ibranch,iconfig)
 
172
               elseif(jbranch.lt.nexternal-2) then
 
173
               write(35,93) -jbranch,jconfig,tprid(-ibranch,iconfig)  
 
174
               tprid2(-jbranch,jconfig)=tprid(-ibranch,iconfig)
 
175
               endif
 
176
c             here we should also write pmass,pwidth,pow
 
177
c             (sometimes there is 1 branch less in props.inc > condition on jbranch)
 
178
              if(t_chan.ne.1.or. ibranch.ne.nexternal-1) then
 
179
 
 
180
c               here break the loop in case we have just read the one-to-last branch 
 
181
c               and haven't met particle nexternal
 
182
                if(isubprop.eq.0.and.ibranch.eq.nexternal-2) then
 
183
                  goto 11 
 
184
                endif
 
185
 
 
186
               write(37,'(a)') buff_pmass
 
187
               write(37,'(a)') buff_pwidth
 
188
               write(37,'(a)') buff_pow
 
189
             endif
 
190
              endif
 
191
11          continue
 
192
         enddo
 
193
 
 
194
12    enddo
 
195
cPierre: add forgotten line
 
196
      write(35,'(6x,a,i4,a,i4,a)')
 
197
     $        'data mapconfig(',0,') /',jconfig,'/'
 
198
      mapconfig2(0)=jconfig
 
199
c end modif Pierre
 
200
      close(35)
 
201
      close(36)
 
202
      close(37)
 
203
 
 
204
 
 
205
c here we should remove equivalent configs
 
206
      call check_equivalent_configs(mapconfig2,iforest2,sprop2,tprid2)
 
207
 
 
208
 
 
209
 99   format(6x,'data(iforest(i,',i3,',',i4,'),i=1,2) /',i3,',',i3,'/',
 
210
     &     10x,'!  ',2a)
 
211
 
 
212
 
 
213
 92   format(6x,'data sprop(',i4,',',i4,') /',i8,'/')
 
214
 93   format(6x,'data tprid(',i4,',',i4,') /',i8,'/')
 
215
 
 
216
 
 
217
 
 
218
 999  continue
 
219
      end
 
220
         
 
221
 
 
222
      subroutine check_equivalent_configs(mapconfig,iforest,sprop,
 
223
     & tprid)
 
224
c*******************************************************************************
 
225
c     Program that removes redundant topologies from configs_temp.inc 
 
226
c     and props_temp.inc. Results written in configs-1.inc
 
227
c******************************************************************************
 
228
      implicit none
 
229
c
 
230
c     Constants
 
231
c
 
232
      include 'genps.inc'
 
233
      include 'nexternal.inc'
 
234
c
 
235
c     argument
 
236
c
 
237
      integer            mapconfig(0:lmaxconfigs)
 
238
      integer iforest(2,-max_branch:-1,lmaxconfigs)
 
239
      integer sprop(-max_branch:-1,lmaxconfigs)
 
240
      integer tprid(-max_branch:-1,lmaxconfigs)
 
241
c
 
242
c     Local
 
243
c
 
244
      integer iconfig,igraph,i,jbranch,ibranch,temp_config
 
245
      integer t_chan,nb_configs
 
246
      character*50 buff_pmass(-nexternal:0,lmaxconfigs)
 
247
      character*50 buff_pwidth(-nexternal:0,lmaxconfigs)
 
248
      character*50 buff_pow(-nexternal:0,lmaxconfigs)
 
249
      character*50 buff_pmass_temp 
 
250
      character*50 buff_pwidth_temp
 
251
      character*50 buff_pow_temp
 
252
      logical foundmatch,foundmatch2
 
253
c
 
254
c     data
 
255
c
 
256
c-----
 
257
c  Begin Code
 
258
c----
 
259
      open(unit=35, file="configs-1.inc",status="unknown",err=998)
 
260
      open(unit=36, file="props_temp.inc",status="old",err=998)
 
261
      open(unit=37, file="props-1.inc",status="unknown",err=998)
 
262
 
 
263
 
 
264
      nb_configs=0
 
265
 
 
266
c      write(*,*) 'nb of configs before check equiv: ',mapconfig(0)
 
267
 
 
268
      do iconfig = 1, mapconfig(0)     !Loop over all configurations
 
269
        foundmatch2=.false.
 
270
        ibranch = 0
 
271
        t_chan = 0
 
272
      do while (ibranch .lt. nexternal-3+t_chan)
 
273
        ibranch = ibranch + 1
 
274
        if (iforest(1,-ibranch,iconfig) .eq. 1) t_chan=1
 
275
c       sometimes there is 1 branch less in props.inc
 
276
        if((t_chan.ne.1).or. (ibranch.lt.(nexternal-2))) then
 
277
          read(36,'(a)') buff_pmass(ibranch,iconfig)
 
278
          read(36,'(a)') buff_pwidth(ibranch,iconfig)
 
279
          read(36,'(a)') buff_pow(ibranch,iconfig)
 
280
        endif
 
281
      enddo
 
282
 
 
283
        temp_config=1
 
284
        do while (temp_config .lt. iconfig.and..not.foundmatch2)
 
285
         ibranch=0
 
286
         t_chan=0
 
287
            foundmatch=.true.
 
288
         do while (ibranch .lt. nexternal-3+t_chan)
 
289
            ibranch = ibranch + 1
 
290
            if (iforest(1,-ibranch,iconfig) .eq. 1) t_chan=1
 
291
            if(iforest(1,-ibranch, temp_config).ne.
 
292
     & iforest(1,-ibranch,iconfig).and.iforest(1,-ibranch,temp_config)
 
293
     & .ne. iforest(2,-ibranch,iconfig)) foundmatch=.false.
 
294
 
 
295
            if(iforest(2,-ibranch, temp_config).ne.
 
296
     & iforest(1,-ibranch,iconfig).and.iforest(2,-ibranch,temp_config)
 
297
     & .ne. iforest(2,-ibranch,iconfig)) foundmatch=.false.
 
298
 
 
299
            if (t_chan.eq.0) then
 
300
              if(sprop(-ibranch, temp_config).ne.
 
301
     & sprop(-ibranch,iconfig)) foundmatch=.false.
 
302
            else
 
303
              if(tprid(-ibranch, temp_config).ne.
 
304
     & tprid(-ibranch,iconfig)) foundmatch=.false.
 
305
            endif
 
306
 
 
307
c now check props.inc
 
308
            if(.false.) then
 
309
         if (buff_pmass(ibranch,temp_config)(23:50).ne.
 
310
     & buff_pmass(ibranch,iconfig)(23:50))  foundmatch=.false.
 
311
         if (buff_pwidth(ibranch,temp_config)(24:50).ne.
 
312
     & buff_pwidth(ibranch,iconfig)(24:50)) foundmatch=.false.
 
313
         if (buff_pow(ibranch,temp_config)(21:50).ne.
 
314
     & buff_pow(ibranch,iconfig)(21:50)) foundmatch=.false.
 
315
 
 
316
         if (buff_pmass(ibranch,temp_config)(1:16).ne.
 
317
     & buff_pmass(ibranch,iconfig)(1:16))  foundmatch=.false.
 
318
         if (buff_pwidth(ibranch,temp_config)(1:17).ne.
 
319
     & buff_pwidth(ibranch,iconfig)(1:17)) foundmatch=.false.
 
320
         if (buff_pow(ibranch,temp_config)(1:14).ne.
 
321
     & buff_pow(ibranch,iconfig)(1:14)) foundmatch=.false.
 
322
             endif           
 
323
 
 
324
         enddo  ! end loop over branches
 
325
         if (foundmatch) then 
 
326
          foundmatch2=.true.
 
327
c          write(*,*) 'Removing config ',iconfig
 
328
         endif
 
329
 
 
330
         temp_config=temp_config+1
 
331
        enddo ! inner loop over configs
 
332
        if(.not.foundmatch2) then !write config
 
333
         nb_configs=nb_configs+1
 
334
         igraph = mapconfig(iconfig)
 
335
         write(35,'(a,i6)') 'c   Graph ',igraph
 
336
         write(35,'(6x,a,i4,a,i4,a)')
 
337
     $        'data mapconfig(',nb_configs,') /',igraph,'/'
 
338
         ibranch=0
 
339
         t_chan=0
 
340
         do while (ibranch .lt. nexternal-3+t_chan)
 
341
            ibranch = ibranch + 1
 
342
            if (iforest(1,-ibranch,iconfig) .eq. 1) t_chan=1
 
343
 
 
344
            write(35,20) -ibranch,nb_configs,iforest(1,-ibranch,iconfig)
 
345
     $       ,iforest(2,-ibranch,iconfig),"?","?"
 
346
               if(t_chan.eq.0) then
 
347
               write(35,21) -ibranch,nb_configs,sprop(-ibranch,iconfig)
 
348
               elseif(ibranch.lt.nexternal-2) then
 
349
               write(35,22) -ibranch,nb_configs,tprid(-ibranch,iconfig)
 
350
               endif
 
351
 
 
352
              if(t_chan.ne.1.or. ibranch.lt.nexternal-2) then
 
353
               buff_pmass_temp=buff_pmass(ibranch,iconfig)             
 
354
               buff_pwidth_temp=buff_pwidth(ibranch,iconfig)             
 
355
               buff_pow_temp=buff_pow(ibranch,iconfig)    
 
356
               write(buff_pmass_temp(17:20),'(i4)') nb_configs        
 
357
               write(buff_pwidth_temp(18:21),'(i4)') nb_configs        
 
358
               write(buff_pow_temp(15:18),'(i4)') nb_configs       
 
359
c              
 
360
              write(37,'(a)') buff_pmass_temp
 
361
              write(37,'(a)') buff_pwidth_temp
 
362
              write(37,'(a)') buff_pow_temp
 
363
              endif 
 
364
         enddo
 
365
        endif
 
366
 
 
367
      enddo
 
368
      write(35,'(6x,a,i4,a,i4,a)')
 
369
     $        'data mapconfig(',0,') /',nb_configs,'/'
 
370
 
 
371
      close(35)
 
372
      close(36)
 
373
      close(37)
 
374
 
 
375
 21   format(6x,'data sprop(',i4,',',i4,') /',i8,'/')
 
376
 22   format(6x,'data tprid(',i4,',',i4,') /',i8,'/')
 
377
 
 
378
 20   format(6x,'data(iforest(i,',i3,',',i4,'),i=1,2) /',i3,',',i3,'/',
 
379
     &     10x,'!  ',2a)
 
380
 998  continue
 
381
      end
 
382
 
 
383
      logical function one_gluon_config(iforest,sprop,tprid,iconfig)
 
384
 
 
385
      implicit none
 
386
      include 'genps.inc'
 
387
      include 'nexternal.inc'
 
388
      integer iforest(2,-max_branch:-1,lmaxconfigs)
 
389
      integer iforest2(2,-max_branch:-1,lmaxconfigs)
 
390
      integer sprop(-max_branch:-1,lmaxconfigs)
 
391
      integer tprid(-max_branch:-1,lmaxconfigs)
 
392
      integer iconfig
 
393
c
 
394
c     local
 
395
c
 
396
      integer ibranch,t_chan
 
397
 
 
398
      one_gluon_config=.false.
 
399
         t_chan = 0
 
400
         ibranch = 0
 
401
c              write(*,*) 'iconfig',iconfig
 
402
         do while (ibranch .lt. nexternal-2+t_chan)
 
403
            ibranch = ibranch + 1
 
404
c
 
405
         if (iforest(1,-ibranch,iconfig) .eq. 1) t_chan=1
 
406
c
 
407
         if (iforest(1,-ibranch,iconfig).eq.(nexternal+1)) then
 
408
           if(iforest(2,-ibranch,iconfig).eq.(nexternal).and.
 
409
     & sprop(-ibranch,iconfig).eq.21) then
 
410
          one_gluon_config=.true.
 
411
          return
 
412
          endif
 
413
     
 
414
         endif    
 
415
c
 
416
         if (iforest(1,-ibranch,iconfig).eq.nexternal) then
 
417
           if(iforest(2,-ibranch,iconfig).eq.(nexternal+1).and.
 
418
     & sprop(-ibranch,iconfig).eq.21) then
 
419
          one_gluon_config=.true.
 
420
          return
 
421
          endif
 
422
           
 
423
         endif     
 
424
         enddo
 
425
      end
 
426
 
 
427
      logical function two_gluon_config(iforest,sprop,tprid,iconfig)
 
428
 
 
429
      implicit none
 
430
      include 'maxamps.inc'
 
431
      include 'genps.inc'
 
432
      include 'nexternal.inc'
 
433
      integer iforest(2,-max_branch:-1,lmaxconfigs)
 
434
      integer iforest2(2,-max_branch:-1,lmaxconfigs)
 
435
      integer sprop(-max_branch:-1,lmaxconfigs)
 
436
      integer tprid(-max_branch:-1,lmaxconfigs)
 
437
      integer iconfig
 
438
      integer q_ass,qb_ass,prop_qb, prop_q
 
439
c
 
440
c     local
 
441
c
 
442
      integer ibranch,t_chan,i
 
443
      integer idup(nexternal,maxproc)
 
444
      integer mothup(2,nexternal,maxproc)
 
445
      integer icolup(2,nexternal,maxflow)
 
446
      include 'leshouche.inc'
 
447
      two_gluon_config=.false.
 
448
 
 
449
         t_chan = 0
 
450
         ibranch = 0
 
451
         do while (ibranch .lt. nexternal-2+t_chan)
 
452
            ibranch = ibranch + 1
 
453
c
 
454
         if (iforest(1,-ibranch,iconfig) .eq. 1) t_chan=1
 
455
 
 
456
            if (iforest(1,-ibranch,iconfig) .eq. (nexternal+1) .or.
 
457
     $          iforest(2,-ibranch,iconfig) .eq. (nexternal+1)) then
 
458
               prop_qb  = -ibranch
 
459
               qb_ass = iforest(1,-ibranch,iconfig)+
 
460
     $              iforest(2,-ibranch,iconfig)-nexternal-1
 
461
            endif
 
462
 
 
463
            if (iforest(1,-ibranch,iconfig) .eq. (nexternal) .or.
 
464
     $          iforest(2,-ibranch,iconfig) .eq. (nexternal)) then
 
465
               prop_q  = -ibranch
 
466
               q_ass = iforest(1,-ibranch,iconfig)+
 
467
     $              iforest(2,-ibranch,iconfig)-nexternal
 
468
            endif
 
469
         enddo
 
470
 
 
471
      if(qb_ass.eq.prop_q) then
 
472
 
 
473
        if(q_ass.gt.0) then
 
474
          if (idup(q_ass,1).ne.21) return     
 
475
        endif    
 
476
 
 
477
        if(q_ass.lt.0) then
 
478
          if(sprop(q_ass,iconfig).ne.21.and.tprid(q_ass,iconfig).ne.21) return         
 
479
        endif
 
480
       
 
481
        if(t_chan.eq.1.and.prop_qb.eq.(-nexternal+1) ) then
 
482
          if(idup(2,1).ne.21) return
 
483
        else
 
484
           if(sprop(prop_qb,iconfig).ne.21.and.tprid(prop_qb,iconfig).ne.21) return
 
485
        endif
 
486
 
 
487
      two_gluon_config=.true.
 
488
      endif
 
489
 
 
490
      if(q_ass.eq.prop_qb) then
 
491
        if(qb_ass.gt.0) then 
 
492
         if (idup(qb_ass,1).ne.21) return
 
493
        endif
 
494
 
 
495
        if(qb_ass.lt.0) then
 
496
          if(sprop(qb_ass,iconfig).ne.21.and.tprid(qb_ass,iconfig).ne.21) return
 
497
        endif
 
498
 
 
499
        if(t_chan.eq.1.and.prop_q.eq.(-nexternal+1) ) then
 
500
           if(idup(2,1).ne.21) return
 
501
        else
 
502
          if(sprop(prop_q,iconfig).ne.21.and.tprid(prop_q,iconfig).ne.21) return
 
503
        endif
 
504
 
 
505
       two_gluon_config=.true.
 
506
       endif
 
507
 
 
508
      return
 
509
      end
 
510
 
 
511
 
 
512
      subroutine no_spaces(buff,nchars)
 
513
c**********************************************************************
 
514
c     Given buff a buffer of words separated by spaces
 
515
c     returns it where all space are moved to the right
 
516
c     returns also the length of the single word.
 
517
c     maxlength is the length of the buffer
 
518
c     AUTHOR: FABIO MALTONI
 
519
c**********************************************************************
 
520
      implicit none
 
521
c
 
522
c     Constants
 
523
c
 
524
      integer    maxline
 
525
      parameter (maxline=10)
 
526
      character*1 null
 
527
      parameter  (null=' ')
 
528
c
 
529
c     Arguments
 
530
c
 
531
      character*(maxline) buff
 
532
      integer nchars,maxlength
 
533
c
 
534
c     Local
 
535
c
 
536
      integer i,j
 
537
      character*(maxline) temp
 
538
c-----
 
539
c  Begin Code
 
540
c-----
 
541
      nchars=0
 
542
c      write (*,*) "buff=",buff(1:maxlength)
 
543
      do i=1,maxline
 
544
         if(buff(i:i).ne.null) then
 
545
            nchars=nchars+1
 
546
            temp(nchars:nchars)=buff(i:i)
 
547
         endif
 
548
c         write(*,*) i,":",buff(1:maxlength),":",temp(1:nchars),":"
 
549
      enddo
 
550
      buff=temp
 
551
      end
 
552