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     ! 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.