← Back to branch summary

~ubuntu-branches/ubuntu/karmic/scilab/karmic

« back to all changes in this revision

Viewing changes to routines/metanet/l2que.f

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2002-03-21 16:57:43 UTC
  • Revision ID: james.westby@ubuntu.com-20020321165743-e9mv12c1tb1plztg
Tags: upstream-2.6
Import upstream version 2.6

Show diffs side-by-side

added added

removed removed

Lines of Context:
routines/metanet/l2que.f
 
1
      subroutine l2que(r,fe,che,head,lngt,n,d,p,q)
 
2
      integer r,fe,che,head,lngt,d,p,q,u,v,dv,pntr
 
3
      dimension fe(n),d(n),p(n),q(*)
 
4
      dimension head(*),lngt(*),che(*)
 
5
      inf = 999999999
 
6
      do 10 i=1,n
 
7
         q(i) = 0
 
8
         d(i) = inf
 
9
 10   continue
 
10
      q(r) = - 1
 
11
      d(r)=0
 
12
      p(r) = 0
 
13
      nn = n + 1
 
14
      q(nn) = nn
 
15
      last = nn
 
16
      pntr = nn
 
17
      u = r
 
18
 20   continue
 
19
 
 
20
      j=fe(u)
 
21
 25   if (j.gt.0) then
 
22
         v = head(j)
 
23
         dv = d(u) + lngt(j)
 
24
         if ( d(v) .gt. dv ) then
 
25
            d(v) = dv
 
26
            p(v) = u
 
27
            if ( q(v) ) 30,40,50
 
28
 30         q(v) = q(pntr)
 
29
            q(pntr) = v
 
30
            if ( last .eq. pntr ) last=v
 
31
            pntr = v
 
32
            go to 50
 
33
 40         q(last) = v
 
34
            q(v) = nn
 
35
            last = v
 
36
 50         continue
 
37
         end if
 
38
         j=che(j)
 
39
         goto 25
 
40
      end if
 
41
 60   u = q(nn)
 
42
      q(nn) = q(u)
 
43
      q(u) = - 1
 
44
      if ( last .eq. u ) last = nn
 
45
      if ( pntr .eq. u ) pntr = nn
 
46
      if ( u .le. n ) go to 20
 
47
      return
 
48
      end