File: isova0.f

package info (click to toggle)
scilab 4.0-12
  • links: PTS
  • area: non-free
  • in suites: etch, etch-m68k
  • size: 100,640 kB
  • ctags: 57,333
  • sloc: ansic: 377,889; fortran: 242,862; xml: 179,819; tcl: 42,062; sh: 10,593; ml: 9,441; makefile: 4,377; cpp: 1,354; java: 621; csh: 260; yacc: 247; perl: 130; lex: 126; asm: 72; lisp: 30
file content (143 lines) | stat: -rw-r--r-- 3,260 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
      subroutine isova0(a,lda,m,n,path,kpath,ir,ic,dir,pend,
c     Copyright INRIA
     $     h,v,c)
c% but
c     Sous programme appele par le sous programme isoval
c%
      double precision a(lda,*),c,path(2,*)
      integer lda,m,n,h(m,*),v(m-1,*)
c     
      logical pend
      integer north,south,east,west,dir
      data north/0/,south/1/,east/2/,west/3/
      
c     extend the path at this level by one edge element
      
      if(dir.eq.north) then
         if(v(ir,ic).lt.0) then
            if(kpath.gt.1) h(ir,ic)=0
c     path to east
            goto 30
         else if(v(ir,ic+1).lt.0) then
            if(kpath.gt.1) h(ir,ic)=0
c     path to west
            goto 40
         else if(h(ir+1,ic).lt.0) then
            if(kpath.gt.1) h(ir,ic)=0
c     path to north
            goto 10
         else
            pend=.true.
         endif 
      else if(dir.eq.west) then
         if(h(ir+1,ic).lt.0) then
            if(kpath.gt.1) v(ir,ic)=0
c     path to north
            goto 10
         else if(h(ir,ic).lt.0) then
            if(kpath.gt.1) v(ir,ic)=0
c     path to south
            goto 20
         else if(v(ir,ic+1).lt.0) then
            if(kpath.gt.1) v(ir,ic)=0
c     path to west
            goto 40
         else
            pend=.true.
         endif
      else if( dir.eq.south) then
         if(v(ir,ic+1).lt.0) then
            if(kpath.gt.1) h(ir+1,ic)=0
c     path to west
            goto 40
         else if(v(ir,ic).lt.0) then
            if(kpath.gt.1) h(ir+1,ic)=0
c     path to east
            goto 30
         else if(h(ir,ic).lt.0) then
            if(kpath.gt.1) h(ir+1,ic)=0
c     path to south
            goto 20
         else
            pend=.true.
         endif
      else if(dir.eq.east) then
         if(h(ir,ic).lt.0) then
            if(kpath.gt.1) v(ir,ic+1)=0
c     path to south
            goto 20
         else if(h(ir+1,ic).lt.0) then
            if(kpath.gt.1) v(ir,ic+1)=0
c     path to north
            goto 10
         else if(v(ir,ic).lt.0) then
            if(kpath.gt.1) v(ir,ic+1)=0
c     path to east
            goto 30
         else
            pend=.true.
         endif
      endif
      return
c     
 10   continue
c     
c     NORTH
c     
      kpath=kpath+1
      path(2,kpath)=ir+1
      path(1,kpath)=ic+(c-a(ir+1,ic))/(a(ir+1,ic+1)-a(ir+1,ic))
      if(ir+1.lt.m) then
         ir=ir+1
         dir=north
      else
         pend=.true.
      endif
      return
 20   continue
c     
c     SOUTH
c     
      kpath=kpath+1
      path(2,kpath)=ir
      path(1,kpath)=ic+(c-a(ir,ic))/(a(ir,ic+1)-a(ir,ic))
      if(ir.gt.1) then
         ir=ir-1
         dir=south
      else
         pend=.true.
      endif
      return
c     
 30   continue
c     
c     EAST
c     
      kpath=kpath+1
      path(2,kpath)=ir+(c-a(ir,ic))/(a(ir+1,ic)-a(ir,ic))
      path(1,kpath)=ic
      if(ic.gt.1) then
         ic=ic-1
         dir=east
      else
         pend=.true.
      endif
      return
c     
 40   continue
c     
c     WEST
c     
      kpath=kpath+1
      path(2,kpath)=ir+(c-a(ir,ic+1))/(a(ir+1,ic+1)-a(ir,ic+1))
      path(1,kpath)=ic+1
      if(ic+1.lt.n) then
         ic=ic+1
         dir=west
      else
         pend=.true.
      endif
      return
c     
      end