mod_zorder.f90

### TABLE OF CONTENTS

- 1. UTI/zorder

## UTI/zorder [ Methods ]

[ Top ] [ Methods ]

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