  MODULE zorder
!=========================== DOCUMENTATION ============================= 
!DOCDEBm*    UTI/zorder  *
!
!    NOM
! zorder
!    DESCRIPTION  
!*
! Ensemble de routines necessaires aux codes de Morton
!
! Set of routines required for Morton codes
!*
! Interfaces:
! Subroutine
!  ->zordercurve3D
!  ->convertDecBin
!  ->convetrBinDec
!  ->mixBinXBinYBinZ
! Function
!  ->GETSIZE
!  ->COORD_REAL2INT
! 
!    SOURCE
! Ce logiciel est regi par la licence [CeCILL-B]
! This software is governed by the [CeCILL-B] license
!=========================== DEBUT DES DECLARATIONS ==================== 
!.1-----  Implicit, Use
  implicit none

!=========================== DEBUT DU CODE EXECUTABLE ==================

  contains
  
 SUBROUTINE zordercurve3d(nx,ny,nz,nt)
!=========================== DOCUMENTATION ============================= 
!
! zordercurve3d(nx,ny,nz,nt)
!      
! A partir des coordonnees, calculer le numero (id)
! associe a celle-ci a l aide du code de Morton
! 
!=========================== DEBUT DES DECLARATIONS ==================== 
!.1-----  Implicit, Use
  IMPLICIT NONE                                                        ;

!.2-----  Declaration
  INTEGER                          :: sizex,sizey,sizez,smax,sizet  ! SIZEX : Number of bits of the binary number associated at NX ; smax = max (sizex,y,z)
  INTEGER, INTENT(IN)              :: nx   ,ny   ,nz                ! NX    : Integer associated at the coordinate x (not in the routine)
  INTEGER(kind=16), INTENT(OUT)    :: nt                            ! NT    : Integer associated at the Morton s number
  LOGICAL,DIMENSION(:),ALLOCATABLE :: Tx   ,Ty   ,Tz   ,     Tt     ! TX    : Table (= binary number) associated at the integer NX
!=========================== DEBUT DU CODE EXECUTABLE ==================

! ************************************
! *** INITIALISATION DES VARIABLES ***
! ************************************

  ! ***** Trouver le nombre de fois que l on divise par 2, le nb x *****
  sizex = getsize(nx)
  sizey = getsize(ny)
  sizez = getsize(nz)
  
  ! **** Trouver le plus grand entre sizex et sizey ********************
  smax = max(sizex,sizey,sizez)
  ! **** Calculer la taille du tableau Tz  *****************************
  sizet = 3*smax
! ********************************
! *** ALLOCATION DES VARIABLES ***
! ********************************
  
  allocate(Tx(smax),Ty(smax),Tz(smax),Tt(sizet))

! ***************************
! *** FONCTION PRINCIPALE ***
! ***************************

! ##################################
! ### Passer de Entier à Binaire ###
! ##################################
  
  call convertDecBin(nx,Tx,smax,sizex)
  call convertDecBin(ny,Ty,smax,sizey)
  call convertDecBin(nz,Tz,smax,sizez)

! ######################################################
! ### Mixer les 2 binaires suivant le code de Morton ###
! ######################################################
  call mixBinXBinYBinZ(Tx,Ty,Tz,smax, Tt)

! ##################################
! ### Passer de Binaire à Entier ###
! ##################################
  call convertBinDec(Tt,sizet,nt)


! ***********************************
! *** DESALLOCATION DES VARIABLES ***
! ***********************************
  deallocate(Tx,Ty,Tz,Tt)

 end subroutine zordercurve3d

 SUBROUTINE zordercurve2d(nx,ny,nt)
!=========================== DOCUMENTATION ============================= 
!
! zordercurve3d(nx,ny,nt)
!      
! A partir des coordonnees, calculer le numero (id)
! associe a celle-ci a l aide du code de Morton
!=========================== DEBUT DES DECLARATIONS ==================== 
!.1-----  Implicit, Use
  implicit none

!.2-----  Declaration
  INTEGER                          :: sizex,sizey,smax,sizet ! SIZEX : Number of bits of the binary number associated at NX ; smax = max (sizex,y)
  INTEGER, INTENT(IN)              :: nx,   ny               ! NX    : Integer associated at the coordinate x (not in the routine)
  INTEGER(kind=16), INTENT(OUT)    :: nt                     ! NT    : Integer associated at the Morton s number
  LOGICAL,DIMENSION(:),ALLOCATABLE :: Tx, Ty, Tt             ! TX    : Table (= binary number) associated at the integer NX
!=========================== DEBUT DU CODE EXECUTABLE ==================

! *** INITIALISATION DES VARIABLES ***
  sizex = getsize(nx)
  sizey = getsize(ny)
  smax = max(sizex,sizey)
  sizet = 2*smax
  
  allocate(Tx(smax),Ty(smax),Tt(sizet))

! ### Passer de Entier à Binaire ###
  call convertDecBin(nx,Tx,smax,sizex)
  call convertDecBin(ny,Ty,smax,sizey)
! ### Mixer les 2 binaires suivant le code de Morton ###
  call mixBinXBinY(Tx,Ty,smax, Tt)

! ### Passer de Binaire à Entier ###
  call convertBinDec(Tt,sizet,nt)

  deallocate(Tx,Ty,Tt)

 END SUBROUTINE zordercurve2d   
! *****************
! *** FONCTIONS ***
! *****************
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 FUNCTION GETSIZE(N) ! What will be the size of the binary number associated at N ?
  INTEGER, INTENT(IN) :: N ! input
  INTEGER             :: NTEST ! var
  integer::getsize
  GETSIZE = 0     
  NTEST   = 0

  DO WHILE( NTEST< N )
     NTEST   = NTEST + 2**GETSIZE
     GETSIZE = GETSIZE+1
  ENDDO
  IF( N==0 ) GETSIZE = 1 

 END FUNCTION GETSIZE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! *******************
! *** SUBROUTINES ***
! *******************

! ****************************
! *** Convertir en Binaire ***
! ****************************
 SUBROUTINE convertDecBin(x,Tx,smax,sizex)
  IMPLICIT NONE                                                        ;
     integer::i
     integer::smax,sizex,x,xcopie
     logical,dimension(smax)::Tx
     logical::r
     xcopie = x
     Tx(:) = .false.
     r = (mod(2,2)==1)

  i = smax
    DO WHILE( i>=(smax-sizex+1))
       Tx(i) = (mod(xcopie,2) == 1)
       xcopie = (xcopie- mod(xcopie,2) ) /2
      i = i - 1 
    ENDDO 
    
  end subroutine convertDecBin
  
! ****************************
! *** Convertir en Decimal ***
! ****************************
   subroutine convertBinDec(Tz,sizez,numDec)
     implicit none
     integer::i,sizez
     integer(kind=16) :: numDec

     logical,dimension(sizez)::Tz
     numDec = 0
     numdec=0
     do i=1,sizez
       if(Tz(i))then
         numDec = numDec + (int(2,16))**(sizez - i)
       endif
      enddo
!===========================   FIN DE LA ROUTINE    ====================  
   end subroutine convertBinDec

! *******************************
! *** Mixer selon code Morton ***
! *******************************
  SUBROUTINE mixBinXBinYBinZ(Tx,Ty,Tz,smax,Tt)
    IMPLICIT NONE                                                     
    INTEGER, INTENT(IN)                             :: smax           
    LOGICAL, DIMENSION(:), ALLOCATABLE, INTENT(IN)  :: Tx, Ty, Tz     
    LOGICAL, DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: Tt             

    INTEGER              :: I, J, K                                   ! loop
    I = 1  
    J = 0      
    K = 0                                

  !                                        CHECK IF TX, TY, TZ, TT ALLOCATED
  IF( .NOT.ALLOCATED(TX) ) THEN
     WRITE(*,*) "ERROR   01 (mixBinXBinYBinZ) : TX NOT ALLOCATED "    
     STOP  
  ENDIF
  IF( .NOT.ALLOCATED(TY) ) THEN
     WRITE(*,*) "ERROR   02 (mixBinXBinYBinZ) : TY NOT ALLOCATED "    
     STOP  
  ENDIF
  IF( .NOT.ALLOCATED(TZ) ) THEN
     WRITE(*,*) "ERROR   03 (mixBinXBinYBinZ) : TZ NOT ALLOCATED "    
     STOP 
  ENDIF
  IF( .NOT.ALLOCATED(TT) ) ALLOCATE(TT(1:(3*SMAX)))                           


  !-----------------------------------------
  !--- Boucle pour remplir le tableau Tx ---
  !-----------------------------------------
 !                                                                COMPUTE TT

  DO WHILE( ( (I+J+K)<=(3*SMAX) ).AND.( I<=SMAX ).AND.( J<=SMAX ).AND.( K<=SMAX) )    ! Car J et K debutent a 0
     IF( MOD( (I+J+K),3 )==0 )THEN
        TT( I+J+K ) = TX( I )                                              
        !write(*,*) 'Tt(',i+j+k,') = ',TT(I+J+K)
        I = I + 1                                                          
     ELSE IF( MOD( (I+J+K),3 )==2 )THEN
        TT( I+J+K ) = TY( J+1 )                                                ! CAR ON A DEBUTE A J = 0
        !write(*,*) 'Tt(',i+j+k,') = ',TT(I+J+K)
        J = J + 1                                                          
     ELSE 
        TT( I+J+K ) = TZ( K+1 )                                            
        !write(*,*) 'Tt(',i+j+k,') = ',TT(I+J+K)
        K = K + 1                                                          
     ENDIF
  END DO
  !write(*,*)'numero en binaire : ',TT

  end subroutine mixBinXBinYBinZ
! *******************************
! *** Mixer selon code Morton en 2D***
! *******************************
 SUBROUTINE mixBinXBinY(Tx,Ty,smax,Tt)
    implicit none                                                     
    INTEGER, INTENT(IN)                             :: smax           
    LOGICAL, DIMENSION(:), ALLOCATABLE, INTENT(IN)  :: Tx, Ty
    LOGICAL, DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: Tt             

    INTEGER              :: I, J, K                                   ! loop
    I = 1  
    J = 0      
    K = 0                                

  !                                        CHECK IF TX, TY, TZ, TT ALLOCATED
  IF( .NOT.ALLOCATED(TX) ) THEN
     WRITE(*,*) "ERROR   01 (mixBinXBinY) : TX NOT ALLOCATED "    
     STOP  
  ENDIF
  IF( .NOT.ALLOCATED(TY) ) THEN
     WRITE(*,*) "ERROR   02 (mixBinXBinY) : TY NOT ALLOCATED "    
     STOP  
  ENDIF
  IF( .NOT.ALLOCATED(TT) ) ALLOCATE(TT(1:(2*SMAX)))                           

 !     COMPUTE TT

  DO WHILE( ( (I+J)<=(2*SMAX) ).AND.( I<=SMAX ).AND.( J<=SMAX ) )    ! Car J debute a 0
     IF( MOD( (I+J),2 )==0 )THEN
        TT( I+J ) = TX( I )                                              
        I = I + 1                                                          
     ELSE
        TT( I+J ) = TY( J+1 )                                                ! CAR ON A DEBUTE A J = 0
        J = J + 1                                                          
     ENDIF
  END DO

 END SUBROUTINE mixBinXBinY

 FUNCTION COORD_REAL2INT(X, XMIN, DC) 
  INTEGER::COORD_REAL2INT                                                 
  REAL(KIND = KIND(0.d0)), INTENT(IN) :: X, XMIN, DC                       ! DC = dimension caracteristique
  REAL(KIND=KIND(0.d0)), PARAMETER     :: RAF=10.0                         ! parametre de raffinage

  COORD_REAL2INT = 0                                                      

  IF(DC == 0)THEN
    WRITE(*,*) "ERROR 01 (COORD_REAL2INT) : DeltaX = 0"       
    STOP 
  ENDIF
  COORD_REAL2INT = NINT((X-XMIN)*RAF/DC)                                       ! 1/10 Dim caract : Vol/surf

 END FUNCTION COORD_REAL2INT

 subroutine parcoursR3(ch)
 use geo_typ
    implicit none
    Type(chaineR3), Pointer      :: ch
    Type(chaineR3), Pointer      :: dblech
    type (chaineR2), Pointer     :: ch2
    type (chaineR1), Pointer     :: ch1
    integer :: num


    
   num=0
    dblech=>ch
    do while (associated(dblech%prec))
       dblech=>dblech%prec
    end do
    do while (associated(dblech))
       ch2=>dblech%cr2
       do while (associated(ch2%prec))
          ch2=>ch2%prec
       end do
       do while(associated(ch2))
          ch1=>ch2%cr1
          do while (associated(ch1%prec))
             ch1=>ch1%prec
          end do
          do while(associated(ch1))
             ch1%num=num
             num=num+1             
             ch1=>ch1%suiv
          end do
          ch2=>ch2%suiv
       end do
       dblech=>dblech%suiv
    end do
 end subroutine parcoursR3
!

!================================================================================================================
 subroutine donne_num(x,y,z,R3,num,interieur)
    use geo_typ
    implicit none
    Type(chaineR3), Pointer   :: R3
    real*8, intent(in)        :: x,y,z
    integer, intent(inout)    :: num,interieur
    logical                   :: droite
    Type(chaineR3), Pointer   :: temp
    
    ! interdit de rentrer dans cette routine si la chaine pointe sur null
    droite=.false.
    if (x>=R3%x-petit) droite=.true.
    do while (associated(R3))
          temp=>R3
          if (x>R3%x+petit) then
             if (droite) then
                R3=>R3%suiv
             else
                R3=>temp
                return
             end if
          else
             if (abs(x-R3%x)<petit) then 
 !               print*,'avant R2'
                call donne_numR2(y,z,R3%cr2,num,interieur)

                return
             else
                if (droite) then 
                   R3=>temp
                    return
                else
                   R3=>R3%prec
                end if
             end if
          end if
       end do
       R3=>temp
       return
     end subroutine donne_num
!-----------------------------------------------
!-----------------------------------------------
 subroutine donne_numR2(y,z,R2,t,in)
      use geo_typ
    implicit none
 
 Type(chaineR2), Pointer     :: R2
 real*8, intent(in)          :: y,z
 integer, intent(inout)      :: t,in
 logical                     :: droite
 Type(chaineR2), Pointer     :: temp
   
    ! interdit de rentrer dans cette routine si la chaine pointe sur null
    droite=.false.
    if (y>=R2%y-petit) droite=.true.
    do while (associated(R2))
          temp=>R2
          if (y>R2%y+petit) then
             if (droite) then
                R2=>R2%suiv
             else
                R2=>temp
                return
             end if
          else
             if (abs(y-R2%y)<petit) then 
                call donne_numR1(z,R2%cr1,t,in)
                return
             else
                if (droite) then 
                   R2=>temp
                   return
                else
                   R2=>R2%prec
                end if
             end if
          end if
       end do
       R2=>temp
       return
     end subroutine donne_numR2
!--------------------------
!-----------------------------------------------
 subroutine donne_numR1(z,R1,t,in)
use geo_typ
 implicit none
 Type(chaineR1), Pointer   :: R1
 real*8, intent(in)        :: z
 integer, intent(inout)    :: t,in
 logical                   :: droite
 Type(chaineR1), Pointer   :: temp
    
    ! inrterdit de rentrer dans cette routine si la chaine pointe sur null
    droite=.false.
    if (z>=R1%z-petit) droite=.true.
    do while (associated(R1))
          temp=>R1
          if (z>R1%z+petit) then
             if (droite) then
                R1=>R1%suiv
             else
                R1=>temp
                return
             end if
          else
             if (abs(z-R1%z)<petit) then 
                t=R1%num
                in=R1%interieur
                return
             else
                if (droite) then 
                   R1=>temp
                   return
                else
                   R1=>R1%prec
                end if
             end if
          end if
       end do
       R1=>temp
!print*,'probleme'
       return
  end subroutine donne_numR1
!---------------------------
 subroutine rangeR3(x,y,z,R3,t)
   use geo_typ
   implicit none
   Type(chaineR3), Pointer     :: R3
   real*8, intent(in)          :: x,y,z
   integer, intent(inout)      :: t
   logical                     :: droite
   Type(chaineR3), Pointer     :: chloc,temp
   Type(chaineR2), Pointer     :: locR2 
   Type(chaineR1), Pointer     :: locR1

    ! inrterdit de rentrer dans cette routine si la chaine pointe sur null
    droite=.false.
    if (x>=R3%x-petit) droite=.true.
    do while (associated(R3))
          temp=>R3
          if (x>R3%x+petit) then
             if (droite) then
                R3=>R3%suiv
             else
                t=t+1
                call insertdroitex(x,y,z,R3)
                R3%cr2%cr1%num=t
                return
             end if
          else
             if (abs(x-R3%x).le.petit) then 
                call rangeR2(y,z,R3%cr2,t)
                return
             else
                if (droite) then 
                   t=t+1
                   call insertgauchex(x,y,z,R3)
                R3%cr2%cr1%num=t
                   return
                else
                   R3=>R3%prec
                end if
             end if
          end if
       end do
!cas du bout de liste droite ou gauche
       allocate (locR1)
       locR1%z=z
       Nullify(locR1%suiv) ; Nullify(locR1%prec)
       allocate (locR2)
       t=t+1
       locR1%num=t
       locR2%y=y
       locR2%cr1=>locR1
       nullify(locR2%suiv)
       nullify(locR2%prec)
       allocate(chloc)
       chloc%x=x
       chloc%cr2=>locR2
       if (droite) then
!ajout à droite de temp
          chloc%prec=>temp
          nullify(chloc%suiv)
          temp%suiv=>chloc
       else
!ajout à gauche  de temp
          chloc%suiv=>temp
          nullify(chloc%prec)
          temp%prec=>chloc
       end if
!!!modif
          R3=>chloc
!       R3=>temp
!       print*,'dans range',R3%x
       return
  end subroutine rangeR3
!-----------------------------------------------
 subroutine rangeR2(y,z,R2,t)
   use geo_typ
   !use geo, only: insertdroitey, rangeR1, insertgauchey
   implicit none
 
   Type(chaineR2), Pointer  :: R2
   real*8, intent(in)       :: y,z
   integer, intent(inout)   :: t
   logical                  :: droite
   Type(chaineR2), Pointer  :: chloc,temp
   Type(chaineR1), Pointer  :: locR1

   
    ! interdit de rentrer dans cette routine si la chaine pointe sur null
    droite=.false.
    if (y>=R2%y-petit) droite=.true.
    do while (associated(R2))
          temp=>R2
          if (y>R2%y+petit) then
             if (droite) then
                R2=>R2%suiv
             else
                t=t+1
                call insertdroitey(y,z,R2)
                R2%cr1%num=t
                return
             end if
          else
             if (abs(y-R2%y).le.petit) then 
                call rangeR1(z,R2%cr1,t)
                return
             else
                if (droite) then 
                   t=t+1
                   call insertgauchey(y,z,R2)
                   R2%cr1%num=t
                   return
                else
                   R2=>R2%prec
                end if
             end if
          end if
       end do
!cas du bout de liste droite ou gauche
       allocate (locR1)
       locR1%z=z
       Nullify(locR1%suiv) ; Nullify(locR1%prec)
       t=t+1
       locR1%num=t
       allocate(chloc)
       chloc%y=y 
       chloc%cr1=>locR1
       if (droite) then
!ajout à droite de temp
          chloc%prec=>temp
          nullify(chloc%suiv)
          temp%suiv=>chloc
       else
!ajout à gauche  de temp
          chloc%suiv=>temp
          nullify(chloc%prec)
          temp%prec=>chloc
       end if
!modif
       R2=>chloc!temp
       return
  end subroutine rangeR2

!-----------------------------------------------
 subroutine rangeR1(z,R1,t)
    use geo_typ
    !use geo, only: insertdroitez, insertgauchez
    implicit none
    Type(chaineR1), Pointer     :: R1
    real*8, intent(in)          :: z
    integer, intent(inout)      :: t
    logical                     :: droite
    Type(chaineR1), Pointer     :: chloc,temp
    
    ! interdit de rentrer dans cette routine si la chaine pointe sur null
    droite=.false.
    if (z>=R1%z-petit) droite=.true.
    do while (associated(R1))
          temp=>R1
          if (z>R1%z+petit) then
             if (droite) then
                R1=>R1%suiv
             else
                t=t+1
                call insertdroitez(z,R1)
                R1%num=t
                return
             end if
          else
             if (abs(z-R1%z).le.petit) then 
                return
             else
                if (droite) then 
                   t=t+1
                   call insertgauchez(z,R1)
                   R1%num=t
                   return
                else
                   R1=>R1%prec
                end if
             end if
          end if
       end do
!cas du bout de liste droite ou gauche
       t=t+1
       allocate(chloc)
       chloc%z=z 
       chloc%num=t
       if (droite) then
!ajout à droite de temp
          chloc%prec=>temp
          nullify(chloc%suiv)
          temp%suiv=>chloc
       else
!ajout à gauche  de temp
          chloc%suiv=>temp
          nullify(chloc%prec)
          temp%prec=>chloc
       end if
       R1=>chloc!temp
       return
  end subroutine rangeR1
!-----------------------------------------------

 subroutine insertgauchex(x,y,z,ch)
    use geo_typ
    implicit none
    real*8, intent(in)                   :: x,y,z
    Type(chaineR3), Pointer               :: ch
!
    Type(chaineR3), Pointer             :: temp, locch
    type(chaineR2), Pointer            :: locR2
    type(chaineR1), Pointer            :: locR1
    !
!cas du bout de liste droite ou gauche
    temp=>ch%prec
       allocate (locch)
       locch%x=x
       allocate (locR2)
       locR2%y=y
       nullify(locR2%suiv)
       nullify(locR2%prec)
       allocate (locR1)
       locR1%z=z
       nullify(locR1%suiv)
       nullify(locR1%prec)
       locR2%cr1=>locR1
       locch%cr2=>locR2
       locch%suiv=>ch
       ch%prec=>locch
       locch%prec=>temp
       temp%suiv=>locch
!modif
       ch=>locch
       return
  end subroutine insertgauchex
!-----------------------------------------------

 subroutine insertdroitex(x,y,z,ch)
    use geo_typ
    implicit none
    real*8, intent(in)                   :: x,y,z
    Type(chaineR3), Pointer               :: ch
!
    Type(chaineR3), Pointer             :: temp, locch
    type(chaineR2), Pointer            :: locR2
    type(chaineR1), Pointer            :: locR1
    ! 
    !
    !
!cas du bout de liste droite ou gauche
    temp=>ch%suiv
       allocate (locch)
       locch%x=x
       allocate (locR2)
       locR2%y=y
       nullify(locR2%suiv)
       nullify(locR2%prec)
       allocate (locR1)
       locR1%z=z
       nullify(locR1%suiv)
       nullify(locR1%prec)
       locR2%cr1=>locR1
       locch%cr2=>locR2
       locch%suiv=>temp
       temp%prec=>locch
       locch%prec=>ch
       ch%suiv=>locch
!modif
       ch=>locch
       return
  end subroutine insertdroitex

!-----------------------------------------------
 subroutine insertgauchey(y,z,ch)
    use geo_typ
    implicit none
    real*8, intent(in)                   :: y,z
    Type(chaineR2), Pointer               :: ch
!
    Type(chaineR2), Pointer             :: temp, locch
    type(chaineR1), Pointer            :: locR1
    ! 
    !
    !
!cas du bout de liste droite ou gauche
    temp=>ch%prec
       allocate (locch)
       locch%y=y
       allocate (locR1)
       locR1%z=z
       nullify(locR1%suiv)
       nullify(locR1%prec)
       locch%cr1=>locR1
       locch%suiv=>ch
       ch%prec=>locch
       locch%prec=>temp
       temp%suiv=>locch
!modif
       ch=>locch
       return
  end subroutine insertgauchey
!-----------------------------------------------

 subroutine insertdroitey(y,z,ch)
    use geo_typ
    implicit none
    real*8, intent(in)                   :: y,z
    Type(chaineR2), Pointer               :: ch
!
    Type(chaineR2), Pointer             :: temp, locch
    type(chaineR1), Pointer            :: locR1
    ! 
    !
    !
!cas du bout de liste droite ou gauche
    temp=>ch%suiv
       allocate (locch)
       locch%y=y
       allocate (locR1)
       locR1%z=z
       nullify(locR1%suiv)
       nullify(locR1%prec)
       locch%cr1=>locR1
       locch%suiv=>temp
       temp%prec=>locch
       locch%prec=>ch
       ch%suiv=>locch
!modif
       ch=>locch
       return
  end subroutine insertdroitey

!-----------------------------------------------
!-----------------------------------------------
 subroutine insertgauchez(z,ch)
    use geo_typ
    implicit none
    real*8, intent(in)                   :: z
    Type(chaineR1), Pointer               :: ch
!
    Type(chaineR1), Pointer             :: temp, locch
    ! 
    !
    !
!cas du bout de liste droite ou gauche
    temp=>ch%prec
       allocate (locch)
       locch%z=z
       locch%suiv=>ch
       ch%prec=>locch
       locch%prec=>temp
       temp%suiv=>locch
!modif
       ch=>locch
       return
  end subroutine insertgauchez
!-----------------------------------------------

 subroutine insertdroitez(z,ch)
    use geo_typ
    implicit none
    real*8, intent(in)                   :: z
    Type(chaineR1), Pointer               :: ch
!
    Type(chaineR1), Pointer             :: temp, locch
    ! 
    !
    !
!cas du bout de liste droite ou gauche
      temp=>ch%suiv
       allocate (locch)
       locch%z=z
       locch%suiv=>temp
       temp%prec=>locch
       locch%prec=>ch
       ch%suiv=>locch
!modif
       ch=>locch
       return
  end subroutine insertdroitez

!===========================   FIN DU MODULE   =========================
  END MODULE zorder
!DOCFIN 



