C# proc: buildprototree - creates a search tree for use with the optimized
C# proc:                  PNN from a set of prototype feature vectors.

C FTANGLE v1.22, tangled with SunOS/UNIX on "Saturday, September 21, 1991 at 12:
C 39." 
C COMMAND LINE: "ftangle -mSUN -v -# tree_build.web"
C RUN TIME: "Monday, May 16, 1994 at 11:20."
C WEB FILE:    "tree_build.web"
C CHANGE FILE: ""
      subroutine buildprototree(vK,idpatK,npatsK,ninp,Parent,Child,Idisc
     &r,Npts,Ipts,Vmin,Vmax,maxnode,nnodes,nchild,minpln)
        
        real vK(ninp,npatsK)
        integer idpatK(npatsK)
        integer Parent(maxnode)
C/ node index of parent 
        integer Child(maxnode,nchild)
C/ node indexes of children of node 
        integer Idiscr(maxnode)
C/ which dim this node is split on 
        integer Npts(maxnode)
C/ how many data points in this subtree 
        integer Ipts(maxnode)
C/ index of first data point in this subtree 
        real Vmin(maxnode)
C/ minimum values for split data at this node 
        real Vmax(maxnode)
C/ maximum values for split data at this node 
        
        integer stackptr
C/ index of last processed node in stack 
        integer stackend
C/ index of last node in the stack 
        integer kdmax
C/ tree depth; no more than log2(npatsK) 
        
        integer fpstd
        fpstd=6
        
        CONTINUE
C ---  "do" ---
        DO 90000 n=1,npatsK
          idpatK(n)=idpatK(n)+1
90000   CONTINUE
        
        
        kdmax=0
        n=npatsK
        CONTINUE
C ---  "while(n>0)" ---
90002   IF(n.GT.0)THEN
          kdmax=kdmax+1
          n=n/(2)
          GOTO 90002
        ENDIF
        kdmax=min(kdmax,ninp)
        stackptr=0
        stackend=1
        Idiscr(1)=0
        Parent(1)=0
        Npts(1)=npatsK
        Ipts(1)=1
        Vmin(1)=-1.e30
        Vmax(1)=+1.e30
        
        
        
        CONTINUE
C ---  "while(stackptr<stackend)" ---
90004   IF(stackptr.LT.stackend)THEN
          
          stackptr=stackptr+1
          ktotal=Npts(stackptr)
          kdiscr=Idiscr(stackptr)+1
C/if (kdiscr > kdmax) kdiscr = 1; 
          CONTINUE
C ---  "if" ---
          IF(ktotal.GE.2*minpln.AND.kdiscr.LE.kdmax)THEN
            CONTINUE
C ---  "if" ---
            IF(stackend+nchild.GT.maxnode)THEN
              write(fpstd,*)maxnode,' Out of node space; used '
              stop
C/ pointers 
            ENDIF
            CONTINUE
C ---  "do" ---
            DO 90006 kc=1,nchild
              Child(stackptr,kc)=stackend+kc
C/ children of parent 
              CONTINUE
C ---  "do" ---
              DO 90008 kk=1,nchild
                Child(stackend+kc,kk)=0
C/ no grandchilds yet 
90008         CONTINUE
              Parent(stackend+kc)=stackptr
              Idiscr(stackend+kc)=kdiscr
90006       CONTINUE
            
C/ generate up to |nchild - 1| dividing points 
            Vmin(stackend+1)=-1.e30
            kfirst=Ipts(stackptr)
            klast=kfirst+ktotal-1
            kpts=ktotal
            ncused=min(nchild,ktotal/minpln)
            kused=0
            CONTINUE
C ---  "do" ---
            DO 90010 kc=1,ncused-1
              kth=(kc*ktotal+1)/ncused-kused
              value=xkthp2(kth,vK,npatsK,ninp,kdiscr,idpatK,kfirst,klast
     &)
              
              Ipts(stackend+kc)=kfirst
              Npts(stackend+kc)=kth
              Vmax(stackend+kc)=value
              Vmin(stackend+kc+1)=value
              kused=kused+(Npts(stackend+kc))
              kfirst=kfirst+(Npts(stackend+kc))
              kpts=kpts-(Npts(stackend+kc))
90010       CONTINUE
            Ipts(stackend+ncused)=kfirst
            Npts(stackend+ncused)=kpts
            Vmax(stackend+ncused)=+1.e30
            
            stackend=stackend+(ncused)
          ENDIF
          
          
          
          GOTO 90004
        ENDIF
        nnodes=stackend+nchild
        
        
        CONTINUE
C ---  "do" ---
        DO 90012 n=1,maxnode
          Idiscr(n)=Idiscr(n)-1
          Ipts(n)=Ipts(n)-1
          CONTINUE
C ---  "do" ---
          DO 90014 kc=1,nchild
            Child(n,kc)=Child(n,kc)-1
90014     CONTINUE
90012   CONTINUE
        
        
        CONTINUE
C ---  "do" ---
        DO 90016 n=1,npatsK
          idpatK(n)=idpatK(n)-1
90016   CONTINUE
        
        
      END
      
      
