
! Copyright (C) 2002 - Observatoire de Paris/Meudon
!                      Universite Paris 7
!                      CNRS (France)
!                      Contact : Jacques.Lebourlot@obspm.fr
!
! This program is free software; you can redistribute it and/or
! modify it under the terms of the GNU General Public License version 2
! as published by the Free Software Foundation.
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this program; if not, write to the Free Software
! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

 PROGRAM fractal_grid

  implicit none

  INTEGER, parameter                        :: DP    = selected_real_kind(P=15)
  INTEGER                                   :: nres  ! Number of recursive steps
  INTEGER                                   :: npt   ! Number of intervals (nb of points - 1)
  INTEGER                                   :: nbnpt ! Number of new points
  REAL (KIND=DP)                            :: frac  ! Final positions
  REAL (KIND=DP)                            :: dup   ! Density enhancement factor
  REAL (KIND=DP)                            :: dlo   ! Density dilution factor
  REAL (KIND=DP)                            :: toto  ! longueur

  REAL (KIND=DP), allocatable, dimension(:) :: tau   ! Final positions
  REAL (KIND=DP), allocatable, dimension(:) :: ptau  ! work space
  REAL (KIND=DP), allocatable, dimension(:) :: ntau  ! New positions
  REAL (KIND=DP), allocatable, dimension(:) :: den   ! Final density
  REAL (KIND=DP), allocatable, dimension(:) :: pden  ! work space
  REAL (KIND=DP), allocatable, dimension(:) :: nden  ! New density

  INTEGER :: i, j, nnpt

!  Initialisation

  npt = 1
  ALLOCATE (tau(0:npt))
  tau(0) = 0.0_dp
  tau(1) = 1.0_dp
  ALLOCATE (den(0:npt))
  den(0) = 1.0_dp
  den(1) = 1.0_dp

  print *, "#  Enter number of recursion"
  read *, nres
  print *, "#  Enter fraction of high density"
  read *, frac
  print *, "#  Enter density enhancement factor"
  read *, dup

  dlo = (1.0_dp - dup*frac) / (1.0_dp - frac)

  nbnpt = 2

!  Loop on refinement process

  do i=1,nres
    ALLOCATE (ntau(nbnpt))
    do j=1,npt
      ntau(2*j-1) = tau(j-1) + 0.5_dp * (tau(j)-tau(j-1)) * (1.0_dp-frac)
      ntau(2*j) = ntau(2*j-1) + (tau(j)-tau(j-1)) * frac
    end do
    ALLOCATE (ptau(0:npt))
    ptau = tau
    ALLOCATE (pden(0:npt))
    pden = den
    DEALLOCATE(tau, den)
    nnpt = npt + nbnpt
    nbnpt = nbnpt * 3
    ALLOCATE  (tau(0:nnpt))
    ALLOCATE  (den(0:nnpt))
    tau(0) = ptau(0)
    do j=1,npt
      tau(3*j-2) = ntau(2*j-1)
      tau(3*j-1) = ntau(2*j)
      tau(3*j) = ptau(j)
      den(3*j-2) = pden(j) * dlo
      den(3*j-1) = pden(j) * dup
      den(3*j) = pden(j) * dlo
    end do
    den(0) = den(1)
    DEALLOCATE (ntau, ptau)
    npt = nnpt
!   print *, " "
!   do j=0,npt
!     print *, j, tau(j), den(j)
!   end do
  end do

   print *, tau(0), den(0)
   toto = 0.0_dp
   do j=1,npt-1
     print *, tau(j), den(j)
     print *, tau(j), den(j+1)
     toto = toto + abs(den(j+1) - den(j))
   end do
   print *, tau(npt), den(npt)

   print *, "#", nres, toto

! do j=0,npt
!   print *, tau(j), den(j)
! end do

 END PROGRAM fractal_grid
