algebra_set.F90

Go to the documentation of this file.

module algebra_set

  implicit none  
  private

  public :: shellsort_dec
  public :: sort                ! tested   
  public :: merge_sorted_set    ! tested  
  public :: cap_sorted_set      ! tested  
  public :: order_2             ! tested  
  public :: circperm
  
contains



  subroutine merge_sorted_set(cpt, t, n, t1, n1, t2, n2)
    integer, intent(out) :: cpt
    integer, dimension(n ), intent(out) :: t
    integer, dimension(n1), intent(in) :: t1
    integer, dimension(n2), intent(in) :: t2
    integer, intent(in) :: n, n1, n2

    integer :: ii, jj, ll

    cpt = 0
    ii = 1 ; jj = 1
    do while( (ii<=n1).AND.(jj<=n2) )

       if (t1(ii) < t2(jj)) then
          cpt = cpt + 1

#if DBG>0
          if ( cpt > n ) then
             write(*,*) "ERROR = algebra_set: merge_sorted_set: 1"
             stop -1 
          end if
#endif
          
          t(cpt) = t1(ii)
          ii = ii+1

       else if (t1(ii) > t2(jj)) then
          cpt = cpt + 1

#if DBG>0
          if ( cpt > n ) then
             write(*,*) "ERROR = algebra_set: merge_sorted_set: 2"
             stop -1 
          end if
#endif

          t(cpt) = t2(jj)
          jj = jj+1

       else   ! equality case
          cpt = cpt + 1

#if DBG>0
          if ( cpt > n ) then
             write(*,*) "ERROR = algebra_set: merge_sorted_set: 3"
             stop -1 
          end if
#endif

          t(cpt) = t1(ii)
          ii = ii+1
          jj = jj+1

       end if

    end do

    if (ii<=n1) then

       cpt = cpt + 1

       ll = n1 - ii

#if DBG>0
       if ( ll > n ) then
          write(*,*)  "ERROR = algebra_set: merge_sorted_set: 4"
          stop -1
       end if
#endif
       
       t(cpt:cpt+ll) = t1(ii:n1)
       cpt = cpt + ll

    else if (jj<=n2) then

       cpt = cpt + 1

       ll = n2 - jj

#if DBG>0
       if ( ll > n ) then
          write(*,*) "ERROR = algebra_set: merge_sorted_set: 5"
          stop -1 
       end if
#endif

       t(cpt:cpt+ll) = t2(jj:n2)
       cpt = cpt + ll 

    end if

  end subroutine merge_sorted_set


  subroutine cap_sorted_set(cpt, t, n, t1, n1, t2, n2)
    integer, intent(out) :: cpt
    integer, dimension(n ), intent(out) :: t
    integer, dimension(n1), intent(in) :: t1
    integer, dimension(n2), intent(in) :: t2
    integer, intent(in) :: n, n1, n2

    integer :: ii, jj

    cpt = 0
    ii = 1 ; jj = 1
    do while( (ii<=n1).AND.(jj<=n2) )

       if (t1(ii) < t2(jj)) then
          ii = ii+1

       else if (t1(ii) > t2(jj)) then
          jj = jj+1

       else   ! equality case
          cpt = cpt + 1

#if DBG>0
       if ( cpt > n ) then
          write(*,*) "ERROR = algebra_set: cap_sorted_set"
          stop -1 
       end if
#endif

          t(cpt) = t1(ii)
          ii = ii+1
          jj = jj+1

       end if

    end do

  end subroutine cap_sorted_set


  subroutine order_2(t)
    integer, dimension(2), intent(inout) :: t
    
    integer :: temp
  
    if (t(1) > t(2) ) then
       temp = t(1)
       t(1) = t(2)
       t(2) = temp
    end if

  end subroutine order_2


  subroutine sort(t, n)
    integer, dimension(n), intent(inout) :: t
    integer              , intent(in)    :: n

    integer :: ii, jj, a

    do jj=2, n       
       a=t(jj)

       do ii=jj-1,1,-1
          if (t(ii)<=a) goto 10
          t(ii+1)=t(ii)
       end do
       ii=0
10     t(ii+1)=a
    end do

  end subroutine sort


  subroutine shellsort_dec(t, new_i, n)
    integer, dimension(n), intent(in)   :: t
    integer, dimension(n), intent(out) :: new_i
    integer              , intent(in) :: n

    integer :: i,j,z,gap,i_z

    i = 0
    new_i = (/ (i, i=1,n) /)

    ! Recherche du Gap optimal, 
    ! defini par U(n) = 3U(n-1)+1 et U(n)<n
    gap = 0
    do while (gap<n)
       gap = 3*gap+1
    end do

    do while (gap>2)

       gap = gap/3                          ! Calcul du gap

       ! Tri par insertion
       do i=1+gap,n
          i_z = new_i(i)                    ! Indice de la valeur a inserer
          z = t(i_z)                        ! Valeur à insérer
          j = i-gap
          do while (j>=1)
             if (z>t(new_i(j))) then 
                new_i(j+gap)=new_i(j)       ! Decalage
                j = j-gap
             else
                exit
             end if
          end do
          new_i(j+gap)=i_z                  ! Insertion
       end do
    end do

  end subroutine shellsort_dec


  subroutine circperm(E)
    integer, dimension(:), intent(inout) :: E

    integer :: en, n

    n  = size(e, 1)
    en = e(n)

    e(2:n) = e(1:n-1)
    e(1)   = en

  end subroutine circperm

end module algebra_set