Return to co.e CVS log

Up to [Research Unix] / researchv10no / cmd / view2d

Annotation of researchv10no/cmd/view2d/co.e, revision 1.1.1.1

1.1       root        1: #  simple contour plotting
                      2: #    connect-the-dots, rather than approximate hyperbolas.
                      3: #    contour (implicitly) perturbed downward by infinitesimal.
                      4: #  extensively revised 12 Apr 1985
                      5: #  added NaN  9 Jul 1985
                      6: 
                      7: procedure g2co(w,d,n1,n2,f,nc,cl,NaN)
                      8: integer n1, n2, j0, j1, j2, nc
                      9: real w(6), d(2,2), f(n1,n2), cl(nc)
                     10: real c, dx(2), ll(2), NaN
                     11: integer j, jj, xp, nt
                     12: real fl, fh, t(2,4)
                     13: real swap
                     14: real xx(2,60)
                     15: dx(1)=(d(1,2)-d(1,1))/(n1-1)
                     16: dx(2)=(d(2,2)-d(2,1))/(n2-1)
                     17: xp=0
                     18: do j0 = 1,nc{
                     19:    c=cl(j0)
                     20:    do j1 = 1,n1-1{
                     21:       ll(1)=d(1,1)+(j1-1)*dx(1)
                     22:       do j2 = 1,n2-1{
                     23:          ll(2)=d(2,1)+(j2-1)*dx(2)
                     24:          #write(,j1:i(4),j2:i(4))
                     25:          #write(,f(j1,j2+1):f(7,1),f(j1+1,j2+1):f(7,1))
                     26:          #write(,f(j1,j2  ):f(7,1),f(j1+1,j2  ):f(7,1))
                     27: 
                     28:          #   find intersections of contours with sides
                     29:          nt=0
                     30:          #   ... west ...
                     31:          fl=f(j1,j2)
                     32:          fh=f(j1,j2+1)
                     33:          if(fl<=NaN) next
                     34:          if(fh<=NaN) next
                     35:          if( (c-fl)*(c-fh)<0 |
                     36:                c==fl & fh<c  |
                     37:                c==fh & fl<c  ){
                     38:             nt=nt+1
                     39:             t(1,nt)=0
                     40:             t(2,nt)=(c-fl)/(fh-fl)
                     41:          }
                     42:          #   ... north ...
                     43:          fl=fh
                     44:          fh=f(j1+1,j2+1)
                     45:          if(fh<=NaN) next
                     46:          if( (c-fl)*(c-fh)<0 |
                     47:                c==fl & fh<c  |
                     48:                c==fh & fl<c  ){
                     49:             nt=nt+1
                     50:             t(1,nt)=(c-fl)/(fh-fl)
                     51:             t(2,nt)=1
                     52:          }
                     53:          #   ... south ...
                     54:          fl=f(j1,j2)
                     55:          fh=f(j1+1,j2)
                     56:          if(fh<=NaN) next
                     57:          if( (c-fl)*(c-fh)<0 |
                     58:                c==fl & fh<c  |
                     59:                c==fh & fl<c  ){
                     60:             nt=nt+1
                     61:             t(1,nt)=(c-fl)/(fh-fl)
                     62:             t(2,nt)=0
                     63:          }
                     64:          #   ... east ...
                     65:          fl=fh
                     66:          fh=f(j1+1,j2+1)
                     67:          if( (c-fl)*(c-fh)<0 |
                     68:                c==fl & fh<c  |
                     69:                c==fh & fl<c  ){
                     70:             nt=nt+1
                     71:             t(1,nt)=1
                     72:             t(2,nt)=(c-fl)/(fh-fl)
                     73:          }
                     74: 
                     75:          #  swap north and south to correctly match with east and west
                     76:          if(nt==4){
                     77:             if( t(1,2)>t(1,3) |
                     78:                 (t(1,2)==t(1,3) & f(j1,j2)<f(j1+1,j2))  ){
                     79:                swap=t(1,2)
                     80:                t(1,2)=t(1,3)
                     81:                t(1,3)=swap
                     82:                swap=t(2,2)
                     83:                t(2,2)=t(2,3)
                     84:                t(2,3)=swap
                     85:             }
                     86:          }
                     87: 
                     88:          if ( nt==2 | nt==4 ){
                     89:            do jj=1,nt/2{
                     90:              j=2*jj-1
                     91:              if( t(1,j+1)!=t(1,j) | t(2,j+1)!=t(2,j) ){
                     92:                xp=xp+2
                     93:                xx(1,xp-1)=ll(1)+dx(1)*(t(1,j))
                     94:                xx(2,xp-1)=ll(2)+dx(2)*(t(2,j))
                     95:                xx(1,xp)=ll(1)+dx(1)*(t(1,j+1))
                     96:                xx(2,xp)=ll(2)+dx(2)*(t(2,j+1))
                     97:              }
                     98:            }
                     99:          }else if( nt!=0 ){
                    100:            write(,"can't happen!  nt=",nt,j1,j2)
                    101:            write(,f(j1,j2+1),f(j1+1,j2+1))
                    102:            write(,f(j1,j2  ),f(j1+1,j2  ))
                    103:            stop
                    104:          }
                    105: 
                    106:          if(xp>=50){
                    107:             g2la(w,xx,xp)
                    108:             xp=0
                    109:             }
                    110: 
                    111:          }  # do j2
                    112:       } # do j1
                    113: 
                    114:    if(xp>0){
                    115:       g2la(w,xx,xp)
                    116:       xp=0
                    117:       }
                    118:    } # do j0
                    119: end

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.