shufle.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE shufle
!                       *****************
!
     &(ikle,x)
!
!***********************************************************************
! PROGICIEL : STBTEL  V5.2       19/02/93  J-M JANIN   (LNH) 30 87 72 84
!***********************************************************************
!
! FONCTION : CHANGEMENT DE LA NUMEROTATION DES ELEMENTS
!
!-----------------------------------------------------------------------
!                             ARGUMENTS
! .________________.____.______________________________________________.
! |      NOM       |MODE|                   ROLE                       |
! |________________|____|______________________________________________|
! |  IKLE          |<-->|NUMEROS GLOBAUX DES NOEUDS DE CHAQUE ELEMENT  |
! |________________|____|______________________________________________
! | COMMON:        |    |
! |  GEO:          |    |
! |    MESH        | -->| TYPE DES ELEMENTS DU MAILLAGE
! |    NDP         | -->| NOMBRE DE NOEUDS PAR ELEMENTS
! |    NPOIN       | -->| NOMBRE TOTAL DE NOEUDS DU MAILLAGE
! |    NELEM       | -->| NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
! |    NPMAX       | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
! |                |    | (NPMAX = NPOIN + 0.1*NELEM)
! |    NELMAX      | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
! |                |    | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
! |________________|____|______________________________________________|
! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
!-----------------------------------------------------------------------
! APPELE PAR : STBTEL
! APPEL DE : ECHELE
!***********************************************************************
!
      USE declarations_special
      USE declarations_stbtel
      USE interface_stbtel, ex_shufle => shufle
      IMPLICIT NONE
!
      INTEGER, INTENT(INOUT) :: IKLE(nelmax,4)
      DOUBLE PRECISION, INTENT(IN) :: X(*)
!
      INTEGER IELEM , I1 , I2 , I3 , I4 , I
!
      DOUBLE PRECISION XA
!
!
!=======================================================================
!
      DO i = 1 , (nelem-4)/2 , 2
        CALL echele (ikle,i,nelem-i+1)
      ENDDO
!
!=======================================================================
!
      IF(ndp.EQ.4) THEN
!
        DO ielem = 1 , nelem
!
          i1 = ikle(ielem,1)
          i2 = ikle(ielem,2)
          i3 = ikle(ielem,3)
          i4 = ikle(ielem,4)
          xa = x(i1)
          IF(xa.LT.x(i2)) THEN
            xa = x(i2)
            ikle(ielem,1) = i2
            ikle(ielem,2) = i3
            ikle(ielem,3) = i4
            ikle(ielem,4) = i1
          ENDIF
          IF(xa.LT.x(i3)) THEN
            xa = x(i3)
            ikle(ielem,1) = i3
            ikle(ielem,2) = i4
            ikle(ielem,3) = i1
            ikle(ielem,4) = i2
          ENDIF
          IF(xa.LT.x(i4)) THEN
            ikle(ielem,1) = i4
            ikle(ielem,2) = i1
            ikle(ielem,3) = i2
            ikle(ielem,4) = i3
          ENDIF
!
        ENDDO
!
      ELSEIF(ndp.EQ.3) THEN
!
        DO ielem = 1 , nelem
!
          i1 = ikle(ielem,1)
          i2 = ikle(ielem,2)
          i3 = ikle(ielem,3)
          xa = x(i1)
          IF(xa.LT.x(i2)) THEN
            xa = x(i2)
            ikle(ielem,1) = i2
            ikle(ielem,2) = i3
            ikle(ielem,3) = i1
          ENDIF
          IF(xa.LT.x(i3)) THEN
            ikle(ielem,1) = i3
            ikle(ielem,2) = i1
            ikle(ielem,3) = i2
          ENDIF
!
        ENDDO
!
      ELSE
!
        WRITE(lu,*) 'UNKNOWN MESH IN SHUFLE'
        CALL plante(1)
        stop
!
      ENDIF
!
      RETURN
      END