*==================================================================================================
*  MTREE:   Merger Tree for BDM/AHF output
*
*
*  input:    - how often to perform
*            - 2x _particles files
*
*  output:   - 1x _mtree file
*
*
*  you must set the 
*                   PARAMETERS in MergerTree.h
*  prior to compilation ... stupid Fortran ;-)
*
*
*
* it is checked what halos in file2 make up the halos in file1, i.e.
*
*   file1   file2
*
*    0        0
*    0       17
*    0       31    -> halo #0 in file1 shares particles with halos #0,17,31 in file2
*    1        2
*    1       12
*    1        4    -> halo #1 in file1 shares particles with halos #2,12,4  in file2
*       etc.
*
*==================================================================================================
      program MERGER_TREE

      parameter(MAXTIMES = 1000)

      character*512 HaloFile(MAXTIMES), OutFile(MAXTIMES)

      print*,'========================================================='
      print*,'  Merger Tree between two different Halo Finder Outputs'
      print*,'========================================================='
 	
      write(*,'(A,$)')' please give number of _particles files      => '
      read*,nFiles
      print*,nFiles

      do itime=1,nFiles
         write(*,'(A,i3,A,$)')' please give name of ',itime,
     &                   '. _particles file    => '
         read(*,'(A)')HaloFile(itime)
         call get_name(HaloFile(itime),id,jd)
         print*,HaloFile(itime)(id:jd)
      enddo
      
      do itime=1,nFiles-1
         write(*,'(A,i3,A,$)')' please give full name for ',itime,
     &                   '. output file  => '
         read(*,'(A)')OutFile(itime)
         call get_name(OutFile(itime),id,jd)
         print*,OutFile(itime)(id:jd)      
      enddo

      do itime=1,nFiles-1
         call create_mtree(HaloFile(itime),HaloFile(itime+1),
     &                     OutFile(itime))
      enddo

      print*,'STOP'
      STOP
      end
*=============================================================================
*  cl_analyse   analysiert das Merging der Cluster zwischen
*               zwei Zeitpunkten der N-Body-Simualtion.
*
*                     *******************************
*                        t=1 --> high z
*                        t=2 --> low  z
*                     *******************************
*
*    Die Bedeutung der verwendeten Variablen ist die folgende:
*    ---------------------------------------------------------
*
*            NCL(t)           Gesamtzahl der Cluster
*
*            N(t)             Gesamtzahl aller Teilchen in diesen Clustern
*
*            index(t,N)       Indizies der geclusterten Teilchen
*                             Die Teilchenindizes sind Ausgabe des 
*                             FoF-Programms und nach Clustern sortiert:
*
*                       index(t,1)   --> index(t,j) = groesster Cluster
*                       index(t,j+1) --> index(t,k) = naechstkleinerer Cluster
*                            usw. bis index(t,N(t)) = kleinster Cluster
*
*                           (Das Ende eines Clusters erkennt man daran,
*                            dass index(t,*) negativ ist !)
*                               
*            k_cl(t,i)        Nummer des Clusters, in dem das Teilchen i ist
*
*            npart(t,k)    Anzahl der Teilchen im Cluster Nr.k
*                            (Je kleiner die Clusternummer desto massiver
*                             der Cluster)
*
*            corr(k2)         Anzahl der Teilchen, die aus dem
*                             Cluster Nr.k1 (t=1) ins Cluster Nr.k2 (t=2)
*                             'gewandert' sind
*
*            icount           Anzahl der Eintraege im File 'cl_z(1)_z(2)_mtree',
*                             welches das 'Wandern' von Teilchen dokumentiert
*
*            list(icount)     Es empfiehlt sich, die Cluster nach ihrer Masse
*                             zur Zeit t=2 zu ordnen. Und da ist eine Liste
*                             effektiver als direktes Vertauschen von Zahlen-
*                             werten

*  Analyse-Arrays:
*  ---------------
*      verteilung(x,p)  x=1 Haeufigkeit dafuer, dass das Verhaeltnis der
*                           beiden groessten Satelliten eines Clusters
*                           zur Zeit t=2 gleich p ist.
*
*                       x=2 Haeufigkeit dafuer, dass das Verhaeltnis von
*                           Satellit zu Endcluster gleich p ist.
*
*                       x=3 Haeufigkeit dafuer, dass das Verhaeltnis von
*                           Satellit zu Vorlaeufercluster gleich p ist.
*
*                       p ist dabei wie folgt 'gebinnt':
*
*                                100 * npart(1, groesster Satellit)
*                       p = int  -------------------------------------
*                                 npart(1, zweitgroesster Satellit)
*
*
*     p_distrib(M1,M2)  Haeufigkeit dafuer, dass ein Cluster zur spaeten
*                       Zeit die Masse M1 und die Masse M2 'akkretiert'
*                       bzw. mit der Masse M2 'gemergt' hat.
*                       hatte.
*                       (Enthaelt o.g. Verteilungen als Spezialfaelle.)
*
*
*  Innere Eigenschaften der Cluster
*  --------------------------------
*            r(t,3,NCL)       Koordinaten des Clusters
*            vol(t,NCL)       Volumen des Clusters ([Mpc^3])
*        xlambda(t,NCL)       Drehimpulsparameter
*         axes(t,3,NCL)       Achsen des Traegheitstensors
*             usw.
*
*
*=============================================================================
      subroutine create_mtree(HaloFile1, HaloFile2, OutFile)
******************************************************************************

      character*512 HaloFile1, HaloFile2, OutFile

      include "MergerTree.h"

*  arrays for mtree file
*  ---------------------
      integer NCL(2),N(2),t,icount,ipoint,list(MAXNHALOS),
     |        index(2,MAXNPART),
     |        k_cl(2,MAXNPART),npart(2,MAXNHALOS),corr(0:MAXNHALOS)
*                                                       ^^^^^^^^^
*                                        Die Null ist wichtig, da die
*                                        Clusternr. fuer verlorengegangene
*                                        Teilchen Null ist.

*  arrays for _idx file
*  --------------------
      integer ihalo1(0:MAXNHALOS),npart1(0:MAXNHALOS)
      integer ihalo2(0:MAXNHALOS),npart2(0:MAXNHALOS)
      integer icorr(0:MAXNHALOS)


*  initialising
*  ------------
      NCL(1) = MAXNHALOS
      NCL(2) = MAXNHALOS              ! Vorabschaetzung fuer Anzahl d. Cluster
      N(1)   = MAXNPART
      N(2)   = MAXNPART             ! Vorabschaetzung fuer Gesamtzahl Teilchen


*---------------------------------------------------------------------------
*  Resetting all entries (VERY IMPORTANT IF nFiles != 2) 
*---------------------------------------------------------------------------
      do i=1,MAXNPART
         index(1,i) = 0
         index(2,i) = 0
         k_cl(1,i)  = 0
         k_cl(2,i)  = 0
      enddo
      do i=1,MAXNHALOS
         list(i)    = 0
         npart(1,i) = 0
         npart(2,i) = 0
      enddo
      do i=0,MAXNHALOS
         corr(i)    = 0
         ihalo1(i)  = 0
         ihalo2(i)  = 0
         npart1(i)  = 0
         npart2(i)  = 0
         icorr(i)   = 0
      enddo


*---------------------------------------------------------------------------
*  Einlesen der _particles Files
*---------------------------------------------------------------------------
      call read_particles(HaloFile1,index,N(1),npart,NCL(1),1)
      call read_particles(HaloFile2,index,N(2),npart,NCL(2),2)


*---------------------------------------------------------------------------
*     Teilchen <-> Halo Zuordnung
*---------------------------------------------------------------------------
      do t=1,2

         do i=1,MAXNPART
            k_cl(t,i)=0     ! Reseten der Eintraege
         end do
         
         k=1                ! Clusterzaehler (1:groesster, 2:naechstkleinerer, usw.)
         do i=1,N(t)        ! Schleife ueber alle Teilchen zu diesem Zeitpunkt
            ipart=index(t,i)     ! Teichenindex
            
            if(iSubstructure .EQ. 1)then
               ! this version is well suited for identifying substructre
               if(k_cl(t,abs(ipart)) .EQ. 0)then
                  k_cl(t,abs(ipart))=k
               endif
            else
               ! this assigns the particle to the lowest mass halo
               k_cl(t,abs(ipart))=k
            endif
            if(ipart.LT.0) then  ! Letztes Teilchen im Cluster Nr.k ?
               k=k+1             ! Uebergang zum naechsten Cluster
            end if
         end do
         
         NCL(t)=k-1
         
         if(MAXNHALOS.LT.NCL(t)) then
            print*,' number of clusters too small !'
            STOP
         end if
         
         call get_name(HaloFile1,id1,jd1)
         call get_name(HaloFile2,id2,jd2)

         if(t .EQ. 1) then
            print*,' o ',HaloFile1(id1:jd1)
         endif
         if(t .EQ. 2) then
            print*,' o ',HaloFile2(id2:jd2)
         endif

         print*,'    total number of clustered particles:      ',N(t)
         
         print*,'    number of particles in biggest cluster:   ',
     |        npart(t,1)
         print*,'    number of clusters:                       ',NCL(t)
         print*
         

      end do   ! t-loop


*-----------------------------------------------------------------------------
*  Cluster-Correlation:
*-----------------------------------------------------------------------------
*      Wieviele Teilchen aus dem Cluster Nr.k1 (t=1) befinden 
*      sich im Cluster Nr.k2 (t=2)
*      ------------------------------------------------------

      write(*,'(A,$)')'  o calculating halo correlation ...'

      call get_name(OutFile,id,jd)
      open(11,file=OutFile)
      do j=1,NCL(2)
         corr(j)=0     ! Reseten aller Eintraege
      end do
      lost=0           ! Reset

      icount=0            ! Zaehler fuer Anzahl der RECORDS in 'tmpdat'

*  Da die Cluster zum fruehen Zeitpunkt 'in' den Clustern zum spaeten
*  Zeitpunkt gesucht werden, ist der hier produzierte Output nach auf-
*  steigenden Clusternummern zur Zeit t=1 geordnet.
*  -------------------------------------------------------------------
      k1=1             ! Start mit Cluster Nr.1 zur Zeit t=1

      do i=1,N(1)                         ! Scheife ueber alle Teilchen zur Zeit t=1
         ipart    = index(1,i)            ! Teilchenindex im Cluster Nr. k1
         k2       = k_cl(2,abs(ipart))    ! Cl-Nr. des Teilchens zur Zeit t=2
         corr(k2) = corr(k2)+1            ! Cluster-Correlation

         if(ipart.LT.0) then              ! Letztes Teilchen im Cluster ?
            no_prog = 0
            do j=1,NCL(2)

*   Cluster nur beruecksichtigen, wenn genuegend Teilchen ausgetauscht wurden
*   -----------------------------------------------------------------------
               if(corr(j) .GE. ICOMMON) then
                  no_prog   = no_prog + 1
                  icount    = icount  + 1
                  write(11,987) k1-1,npart(1,k1),corr(j),j-1,npart(2,j)  ! store C indizes
 987              FORMAT(5i10)
               end if
               corr(j)=0
            end do

            ! this part also dumps halos that are NOT present at previous time
c            if(no_prog .EQ. 0)then
c               icount = icount + 1
c               write(11,REC=icount) 0,k1,0,0,npart(2,k1)
c            endif
            
            k1 = k1 + 1       ! naechster Cluster zur Zeit t=1
         end if
      end do

      close(11)

      print*,'finished'


      print*,' o wrote ',OutFile(id:jd),
     &'     (no. of entries =',icount,')'

*-----------------------------------------------------------------------------
*  writing the idx correlation file
*-----------------------------------------------------------------------------
      open(11,file=OutFile)
      open(12,file=OutFile(id:jd)//'_idx')

      ! read first halo
      ihalo1(1) = 1
      icount    = 0

 111  icount = icount + 1
      i1     = ihalo1(1)

c      print*,' o working on halo',ihalo1(1)

      ! read in all lines related to ihalo1
      do while(ihalo1(1) .EQ. i1)
         read(11,*,end=666)i1,n1,ic,i2,n2
         
         i1             = i1 + 1  ! back to Fortran indizes
         i2             = i2 + 1

         ihalo2(icount) = i2
         npart2(icount) = n2
         icorr(icount)  = ic
         ihalo1(icount) = i1
         npart1(icount) = n1

         icount         = icount + 1
      enddo
      icount = icount - 2

      ! search for highest icorr/npart2 value
      idx       = 0
      icorr_max = -1000
      ratio_max = -1000.
      do i=1,icount
         ratio = float(icorr(i))/float(npart1(i))
         if (ratio .GT. 1.0) ratio = 1.0/ratio
         
c         if (icorr(i) .GT. icorr_max) then
         if (ratio    .GT. ratio_max) then
            ratio_max = ratio
            icorr_max = icorr(i)
            idx       = i
         endif
      enddo

      ! search for second highest icorr value
      idx2       = 0
      icorr_max2 = -1000
      do i=1,icount
         if (icorr(i) .GT. icorr_max2 .AND. 
     &       icorr(i) .LT. icorr_max       ) then
            icorr_max2 = icorr(i)
            idx2       = i
         endif
      enddo

      if (idx2 .NE. 0)then
         write(12,*)ihalo1(idx)-1,ihalo2(idx)-1,
     &        float(icorr_max2)/float(icorr_max)  ! store C indizes
      else
         write(12,*)ihalo1(idx)-1,ihalo2(idx)-1,0.0
      endif

      ! we already read in the first line of the next halo1
      ihalo2(1) = ihalo2(icount+1)
      npart2(1) = npart2(icount+1)
      icorr(1)  = icorr(icount+1)
      ihalo1(1) = ihalo1(icount+1)
      npart1(1) = npart1(icount+1)
      icount    = 1

      goto 111

 666  close(11)
      close(12)

      print*,' o wrote ',OutFile(id:jd)//'_idx'

      RETURN
      end
*-----------------------------------------------------------------------------

******************************************************************************

*-----------------------------------------------------------------------------
      subroutine make_string(a,string)

      real a
      character*3 string
      write(string,123) a
 123  FORMAT(f3.1)
      do i=1,3
         if(string(i:i).EQ.' ') string(i:i)='0'
         if(string(i:i).EQ.'*') STOP 'Rotverschiebung nicht verwendbar'
      end do

      RETURN
      end
*----------------------------------------------------------------------------

******************************************************************************

*---------------------------------------------------------------------------
*  Read _particles - Subroutine
*---------------------------------------------------------------------------
      subroutine read_particles(infile,index,N,npart,NCL,t)

      integer       index(2,N),npart(2,N),t
      character*512 infile

      call get_name(infile,id,jd)

c      print*,' o reading ',infile(id:jd)

      NCL = 0
      NPT = 0

      open(99,FILE=infile(id:jd))
 1    NCL = NCL + 1
      NPH = 0
      read(99,*,end=666)npart(t,NCL)
      do i=1,npart(t,NCL)
         NPT = NPT + 1
         NPH = NPH + 1
         read(99,*)index(t,NPT)
      enddo
      index(t,NPT) = -index(t,NPT)
c      print*,NCL,NPH,NPT,index(t,NPT)
      goto 1
 666  close(99)
 
      NCL = NCL - 1
 
      if(N .LT. NPT) then
         print*,'not enough memory for particles'
         STOP
      endif
         
      N = NPT
c      print*,'   => ',N,' particles in ',NCL,' halos'
      
      RETURN
      END
*----------------------------------------------------------------------------

*****************************************************************************

*----------------------------------------------------------------------------
      SUBROUTINE get_name(name,i,j)
      CHARACTER name*(*)
      DO i=1,120
         IF(name(i:i).NE.' ') GOTO 1
      ENDDO
      i=1
      j=1
      RETURN
 1    CONTINUE
      DO j=i,120
         IF(name(j:j).EQ.' ') GOTO 2
      ENDDO
      j=121
 2    j=j-1
      IF(name(i:i).EQ.'''') i=i+1
      IF(name(j:j).EQ.'''') j=j-1
      END
*-----------------------------------------------------------------------------









