shufle.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\shufle.f
00002 !
00031                         SUBROUTINE SHUFLE
00032 !                       *****************
00033 !
00034      &(IKLE,X)
00035 !
00036 !***********************************************************************
00037 ! PROGICIEL : STBTEL  V5.2       19/02/93  J-M JANIN   (LNH) 30 87 72 84
00038 !***********************************************************************
00039 !
00040 ! FONCTION : CHANGEMENT DE LA NUMEROTATION DES ELEMENTS
00041 !
00042 !-----------------------------------------------------------------------
00043 !                             ARGUMENTS
00044 ! .________________.____.______________________________________________.
00045 ! |      NOM       |MODE|                   ROLE                       |
00046 ! |________________|____|______________________________________________|
00047 ! |  IKLE          |<-->|NUMEROS GLOBAUX DES NOEUDS DE CHAQUE ELEMENT  |
00048 ! |________________|____|______________________________________________
00049 ! | COMMON:        |    |
00050 ! |  GEO:          |    |
00051 ! |    MESH        | -->| TYPE DES ELEMENTS DU MAILLAGE
00052 ! |    NDP         | -->| NOMBRE DE NOEUDS PAR ELEMENTS
00053 ! |    NPOIN       | -->| NOMBRE TOTAL DE NOEUDS DU MAILLAGE
00054 ! |    NELEM       | -->| NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
00055 ! |    NPMAX       | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
00056 ! |                |    | (NPMAX = NPOIN + 0.1*NELEM)
00057 ! |    NELMAX      | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
00058 ! |                |    | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
00059 ! |________________|____|______________________________________________|
00060 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00061 !-----------------------------------------------------------------------
00062 ! APPELE PAR : STBTEL
00063 ! APPEL DE : ECHELE
00064 !***********************************************************************
00065 !
00066       IMPLICIT NONE
00067       INTEGER LNG,LU
00068       COMMON/INFO/LNG,LU
00069 !
00070       INTEGER MESH , NDP , NELEM , NPMAX , NPOIN , NELMAX
00071       INTEGER IKLE(NELMAX,4) , I
00072 !
00073       INTEGER IELEM , I1 , I2 , I3 , I4
00074 !
00075       DOUBLE PRECISION X(*) , XA
00076 !
00077       COMMON/GEO/ MESH , NDP , NPOIN , NELEM , NPMAX , NELMAX
00078 !
00079 !=======================================================================
00080 !
00081       DO I = 1 , (NELEM-4)/2 , 2
00082         CALL ECHELE (IKLE,I,NELEM-I+1)
00083       ENDDO
00084 !
00085 !=======================================================================
00086 !
00087       IF(NDP.EQ.4) THEN
00088 !
00089         DO IELEM = 1 , NELEM
00090 !
00091           I1 = IKLE(IELEM,1)
00092           I2 = IKLE(IELEM,2)
00093           I3 = IKLE(IELEM,3)
00094           I4 = IKLE(IELEM,4)
00095           XA = X(I1)
00096           IF(XA.LT.X(I2)) THEN
00097             XA = X(I2)
00098             IKLE(IELEM,1) = I2
00099             IKLE(IELEM,2) = I3
00100             IKLE(IELEM,3) = I4
00101             IKLE(IELEM,4) = I1
00102           ENDIF
00103           IF(XA.LT.X(I3)) THEN
00104             XA = X(I3)
00105             IKLE(IELEM,1) = I3
00106             IKLE(IELEM,2) = I4
00107             IKLE(IELEM,3) = I1
00108             IKLE(IELEM,4) = I2
00109           ENDIF
00110           IF(XA.LT.X(I4)) THEN
00111             IKLE(IELEM,1) = I4
00112             IKLE(IELEM,2) = I1
00113             IKLE(IELEM,3) = I2
00114             IKLE(IELEM,4) = I3
00115           ENDIF
00116 !
00117         ENDDO
00118 !
00119       ELSEIF(NDP.EQ.3) THEN
00120 !
00121         DO IELEM = 1 , NELEM
00122 !
00123           I1 = IKLE(IELEM,1)
00124           I2 = IKLE(IELEM,2)
00125           I3 = IKLE(IELEM,3)
00126           XA = X(I1)
00127           IF(XA.LT.X(I2)) THEN
00128             XA = X(I2)
00129             IKLE(IELEM,1) = I2
00130             IKLE(IELEM,2) = I3
00131             IKLE(IELEM,3) = I1
00132           ENDIF
00133           IF(XA.LT.X(I3)) THEN
00134             IKLE(IELEM,1) = I3
00135             IKLE(IELEM,2) = I1
00136             IKLE(IELEM,3) = I2
00137           ENDIF
00138 !
00139         ENDDO
00140 !
00141       ELSE
00142 !
00143         IF(LNG.EQ.1) WRITE(LU,*) 'MAILLAGE INCONNU DANS SHUFLE'
00144         IF(LNG.EQ.2) WRITE(LU,*) 'UNKNOWN MESH IN SHUFLE'
00145         CALL PLANTE(1)
00146         STOP
00147 !
00148       ENDIF
00149 !
00150       RETURN
00151       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0