renum.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\renum.f
00002 !
00024                         SUBROUTINE RENUM
00025 !                       ****************
00026 !
00027      &(X,Y,W,IKLE,NBOR,TRAV1,TRAV2,TAB,NCOLOR,COLOR,NPTFR)
00028 !
00029 !***********************************************************************
00030 ! PROGICIEL : STBTEL V5.2                   19/04/91  J-C GALLAND  (LNH)
00031 !                                           19/02/93  J-M JANIN    (LNH)
00032 !***********************************************************************
00033 !
00034 ! FONCTION : DECOUPAGE DES TRIANGLES SURCONTRAINTS :
00035 !            ILS SONT COUPES EN TROIS PAR AJOUT D'UN POINT A
00036 !            LEUR BARYCENTRE
00037 !
00038 !
00039 !-----------------------------------------------------------------------
00040 !                             ARGUMENTS
00041 ! .________________.____.______________________________________________.
00042 ! |      NOM       |MODE|                   ROLE                       |
00043 ! |________________|____|______________________________________________|
00044 ! |   X,Y          |<-->| COORDONNEES DU MAILLAGE .
00045 ! |   IKLE         |<-->| LISTE DES POINTS DE CHAQUE ELEMENT
00046 ! |   TRAV1,2      |<-->| TABLEAUX DE TRAVAIL
00047 ! |   TAB          |<-->| TABLEAU DE TRAVAIL
00048 ! |   NCOLOR       |<-->| TABLEAU DES COULEURS DES POINTS
00049 ! |    COLOR       |<-->| STOCKAGE COULEURS DES NOEUDS SUR FICHIER GEO
00050 ! |________________|____|______________________________________________
00051 ! | COMMON:        |    |
00052 ! |  GEO:          |    |
00053 ! |    MESH        | -->| TYPE DES ELEMENTS DU MAILLAGE
00054 ! |    NDP         | -->| NOMBRE DE NOEUDS PAR ELEMENTS
00055 ! |    NPOIN       | -->| NOMBRE TOTAL DE NOEUDS DU MAILLAGE
00056 ! |    NELEM       | -->| NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
00057 ! |    NPMAX       | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
00058 ! |                |    | (NPMAX = NPOIN + 0.1*NELEM)
00059 ! |    NELMAX      | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
00060 ! |                |    | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
00061 ! |                |    |
00062 ! |________________|____|______________________________________________|
00063 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00064 !-----------------------------------------------------------------------
00065 ! APPELE PAR : SURCON
00066 ! APPEL DE : -
00067 !***********************************************************************
00068 !
00069       IMPLICIT NONE
00070       INTEGER LNG,LU
00071       COMMON/INFO/LNG,LU
00072 !
00073       DOUBLE PRECISION X(*) , Y(*) , W(*)
00074 !
00075       INTEGER MESH , NDP , NPOIN , NELEM , NPMAX , NELMAX , NPTFR
00076       INTEGER TAB(*) , IPOIN , IELEM , IPTFR , I1 , I2 , TABMAX
00077       INTEGER TRAV1(*) , TRAV2(*) , IKLE(NELMAX,3) , NCOLOR(*) , NBOR(*)
00078 !
00079       LOGICAL COLOR
00080 !
00081       COMMON/GEO/ MESH , NDP , NPOIN , NELEM , NPMAX , NELMAX
00082 !
00083 !=======================================================================
00084 ! CALCUL DU NOMBRE DE POINTS ET ELEMENTS VOISINS
00085 !=======================================================================
00086 !
00087       DO IPOIN = 1,NPOIN
00088         TRAV1(IPOIN) = 0
00089       ENDDO
00090 !
00091       DO IELEM = 1,NELEM
00092         TRAV1(IKLE(IELEM,1)) = TRAV1(IKLE(IELEM,1)) + 2
00093         TRAV1(IKLE(IELEM,2)) = TRAV1(IKLE(IELEM,2)) + 2
00094         TRAV1(IKLE(IELEM,3)) = TRAV1(IKLE(IELEM,3)) + 2
00095       ENDDO
00096 !
00097       DO IPTFR = 1,NPTFR
00098         TRAV1(NBOR(IPTFR)) = TRAV1(NBOR(IPTFR)) + 1
00099       ENDDO
00100 !
00101 !=======================================================================
00102 ! RENUMEROTATIONS DES POINTS SUIVANT ORDRE CROISSANT DE VOISINS
00103 !=======================================================================
00104 !
00105       TABMAX = 0
00106 !
00107       DO IPOIN = 1,NPOIN
00108 !
00109         I1 = TRAV1(IPOIN)
00110 !
00111         IF (I1.GT.TABMAX) THEN
00112           DO I2 = TABMAX+1,I1
00113             TAB(I2) = IPOIN - 1
00114           ENDDO
00115           TABMAX = I1
00116         ELSEIF (I1.LT.TABMAX) THEN
00117           DO I2 = TABMAX,I1+1,-1
00118             TAB(I2) = TAB(I2) + 1
00119             TRAV2(TAB(I2)) = TRAV2(TAB(I2-1)+1)
00120           ENDDO
00121         ENDIF
00122 !
00123         TAB(I1) = TAB(I1) + 1
00124         TRAV2(TAB(I1)) = IPOIN
00125 !
00126       ENDDO
00127 !
00128       DO I1 = 1,TABMAX
00129         PRINT*,'TAB(',I1,')=',TAB(I1)
00130       ENDDO
00131 !
00132 !=======================================================================
00133 ! MODIFICATIONS CORRESPONDANTES DANS LES DIFFERENTES VARIABLES
00134 !=======================================================================
00135 !
00136       DO IPOIN = 1,NPOIN
00137         TRAV1(TRAV2(IPOIN)) = IPOIN
00138       ENDDO
00139 !
00140       DO IELEM = 1,NELEM
00141         IKLE(IELEM,1) = TRAV1(IKLE(IELEM,1))
00142         IKLE(IELEM,2) = TRAV1(IKLE(IELEM,2))
00143         IKLE(IELEM,3) = TRAV1(IKLE(IELEM,3))
00144       ENDDO
00145 !
00146       DO IPTFR = 1,NPTFR
00147         NBOR(IPTFR) = TRAV1(NBOR(IPTFR))
00148         NBOR(NPTFR+IPTFR) = TRAV1(NBOR(NPTFR+IPTFR))
00149       ENDDO
00150 !
00151       DO IPOIN = 1,NPOIN
00152         W(IPOIN) = X(TRAV2(IPOIN))
00153       ENDDO
00154       DO IPOIN = 1,NPOIN
00155         X(IPOIN) = W(IPOIN)
00156       ENDDO
00157 !
00158       DO IPOIN = 1,NPOIN
00159         W(IPOIN) = Y(TRAV2(IPOIN))
00160       ENDDO
00161       DO IPOIN = 1,NPOIN
00162         Y(IPOIN) = W(IPOIN)
00163       ENDDO
00164 !
00165       IF (COLOR) THEN
00166 !
00167         DO IPOIN = 1,NPOIN
00168           TRAV1(IPOIN) = NCOLOR(TRAV2(IPOIN))
00169         ENDDO
00170         DO IPOIN = 1,NPOIN
00171           NCOLOR(IPOIN) = TRAV1(IPOIN)
00172         ENDDO
00173 !
00174       ENDIF
00175 !
00176 !=======================================================================
00177 !
00178       RETURN
00179       END

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