macro[75000 ; 
macro * 10 1500000 ; 
macro=; 
sec: rec 1 ; 
lquote [ ; 
if ( argnumber < 5 ) 
  errmsg 
------------------------------------------------------------
  Five arguments and a preexisting tree (in parenthetical 
  notation) needed for this script: 
     1 - data set (name only, extension must be &34.tnt&34).
         Tree file *must* have the same name, but extension 
         &34.tre&34 (iif there are multiple trees, tree 0 
         will be used.  Results are saved to file with the
         same name, but extension &34.sup&34. 
     2 - nchunks in parallel 
     3 - number of cycles in parallel 
     4 - nchunks in first round of parallel 
     5 - nchunks in last round of parallel 
------------------------------------------------------------
; 
end 

/***  Read data and tree(s), and (just in case) get rid of dupls.  ***/
tshrink ! ; 
rseed ! ; 
cost < ; 
p %1.tnt ;  
p %1.tre ; 
keep 1 ; 
ridd * ; 

/**  Variables and some settings... ****/ 
hold 105 ; 
rseed ! ; 
rseed 0 ; 
rseed * ;
var : 
  ris slopis intis bigclips redclips trueclips nodlist[ntax] numcycles num_fixed_nodes timesect i j bigvals[(nnodes[0]+1)] redvals[(2*ntax+1)] redntax killedit chunkincr nitseed ; 
txts 50000 ; 
set nitseed rseed ; 
set bigclips %2 ; 
set numcycles %3 ; 
set redclips %4 ; 
if ( %3 > 1 ) 
   set chunkincr ( %5 - %4 ) / ( %3 - 1 ) ; 
   end 
sect : chkroot noxeven ; 
set trueclips treeparts[ 'bigclips' 0 ] ; quote Actual parts: 'trueclips' ; 
resettime ; 
set killedit 0 ; 
loop root nnodes[0]
   set bigvals[ #1 ] 200 ;  /**  i.e. initialize as impossible value!  ***/ 
   stop 
report + 300 ; 
/**  Re-estimate as many times as requested... *****/
loop =cycle 1 'numcycles' 

  quote Breaking tree in 'bigclips'/'/.0redclips' pieces (cycle #cycle); 

  /**  Do calculations within slaves *****/ 
  ptnt begin divide 'trueclips' /sector -'bigclips' 0 /ram x1.4 = 
   macro-; 
   macro [ 75000 ; 
   macro * 10 1400000 ; 
   macro=;  
   var : 
      num_fixed_nodes  
      bigvals[(nnodes[0]+1)] 
      redvals[(bigntax*2+1)] 
      nodlist[(bigntax+2)] i j k ; 
   hold 105 ;  
   loop =nod root nnodes[0]
      set bigvals[ #nod ] 200 ;  
      stop 
   bb: clu 15 ; if ( ( ntax / '/.0redclips' ) > 3500 ) bb : clu 30 ; end 
   /**  First calculations ....*/ 
   sec = 
     track tree 0 chkroot 
     xss '/.0redclips'+1 [ 
       coll tbr ; 
       resample rep 100 [ mu1=ho1 ] from 0 savetree ; 
       tc 0 2. ; 
       coll none ; 
       set redvals freqlist [0] 1. ; 
       set nodlist biginsect[0] ; 
       loop 0 (listsize-1)
          set i "nodlist[#1]" ; 
          set j nodtosect[ "i" 0 ] ; 
          if ( "j" <= ntax ) continue ; end
          if ( "bigvals[ "i" ]" > "redvals[ "j" ]" )
            set bigvals[ "i" ]    "redvals[ "j" ]" ; 
            end 
          stop ] ; 
   /** Now make sure no nodes are left-over  ******/ 
   loop (root+1) nnodes[0] 
      if ( anc [ 0 #1 ] == root ) continue ; end 
      if ( "bigvals[#1]" < 200 ) continue ; end 
      sec = track tree 0 dss #1 8 
       [ coll tbr ; 
         resample rep 100 [ mu1=ho1 ] from 0 savetree ; 
         tc 0 2. ; 
         coll none ; 
         set redvals freqlist [0] 1. ; 
         set nodlist biginsect[0] ; 
         loop =n 0 (listsize-1)
           set i "nodlist[ #n ]" ; 
           set j nodtosect[ "i" 0 ] ; 
           if ( "j" <= ntax ) continue ; end
           if ( "bigvals[ "i" ]" > "redvals[ "j" ]" )
             set bigvals[ "i" ]    "redvals[ "j" ]" ; 
             end 
           stop ] ; 
      stop 
    /**  Copy in redvals the final values, for parent  ***/ 
    set nodlist biginsect[0] ; 
    loop (bigntax+1) (bigntax*2)
       set redvals [ #1 ] 200 ; 
       stop 
    loop 0 (listsize-1)
       set i "nodlist[#1]" ; 
       set j nodtosect[ "i" 0 ] ; 
       if ( "j" <= ntax ) continue ; end
       if ( "redvals[ "i" ]" > "bigvals[ "j" ]" )
         set redvals[ "i" ]    "bigvals[ "j" ]" ; 
         end 
       stop  
    /** Trash trees (not needed anymore) ****/ 
    keep 0 ; 
  return text ; 
  rseed * ; 

  /** Back in master ... **********/
  pt wait divide ; 
  /**  Retrieve values calculated by slaves...  *****/ 
  sil = all ; 
  loop =piece 0 ('trueclips'-1) 
     slaveget [ divide #piece ] redvals redvals ; 
     loop =nod root nnodes[0] 
        if ( 'bigvals[ #nod ]' > 'redvals[ #nod ]' )
           set bigvals[ #nod ]    'redvals[ #nod ]' ; 
           end 
        stop   /** nod **/ 
     stop   /** piece **/ 
  sil - all ; 

  /** ... and when this is the last cycle, then
           make sure no nodes are left-over...  ******/ 
  if ( #cycle == 'numcycles' ) 
     loop =nod (root+1) nnodes[0] 
      if ( anc [ 0 #nod ] == root ) continue ; end 
      if ( 'bigvals[#nod]' < 200 ) continue ; end 
      quote Fixing values for node #nod ... ; 
      sec = track tree 0 dss #nod 10
       [ coll tbr ; 
         ttag ) ; 
         resample rep 100 [ mu1=ho1 ] from 0 savetree ; 
         tc 0 2. ; 
         coll none ; 
         set redvals freqlist [0] 1. ; 
         set nodlist biginsect[0] ; 
         loop =n 0 (listsize-1)
           set i 'nodlist[ #n ]' ; 
           set j nodtosect[ 'i' 0 ] ; 
           if ( 'j' <= ntax ) continue ; end
           if ( 'bigvals[ 'i' ]' > 'redvals[ 'j' ]' )
             set bigvals[ 'i' ]    'redvals[ 'j' ]' ; 
             end 
           stop ] ; 
      stop  /** nod  **/ 
     end 

  if ( numerrors [ divide ] ) 
       set killedit 1 ; 
       clb ; 
       pt get divide ;  
       endloop ; 
  else pt kill divide ; end 

  set redclips += 'chunkincr' ; 
   
  stop /** cycle ***/ 

/**  Time for complete estimation ***/ 
set timesect time ; 
sil - buffer file ; 
sil = con ; 
report=; 

/** Check whether it went ok ... ********/
if ( 'killedit' ) 
   svtxt ; 
   errmsg SORRY, some error occured while calculating supports... (ran for 'timesect' secs.) ; 
end 

/** Output results and time  ****/ 
set bigvals [ root ] 100  ;
nak= ; 
ttag - ; 
ttag = ; 
tp 0 ; 
loop root nnodes[0] 
  if ( anc [ 0 #1 ] == root ) 
     set bigvals [ #1 ] 100 ; 
     continue ; 
     end 
  ttag +#1 '/.0bigvals[#1]'; 
  stop 
quote TIME USED: 'timesect' secs. (initial random seed: 'nitseed'); 
riddup /- ; /***  re-insert dupls. ... ***/
ttag ; 
sil - all ; 
tsav * %1.sup; sav * ; tsav / ; 

proc/;