divise.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\divise.f
00002 !
00023                         SUBROUTINE DIVISE
00024 !                       *****************
00025 !
00026      &(X,Y,IKLE,NCOLOR,NPOIN,NELEM,NELMAX,NSOM2,SOM2,INDICP,INDICE)
00027 !
00028 !***********************************************************************
00029 ! PROGICIEL : STBTEL  V5.2                 J-M JANIN   (LNH) 30 87 72 84
00030 ! ORIGINE   : TELEMAC
00031 !***********************************************************************
00032 !
00033 !     FONCTION  :  DIVISION PAR 4 DE TOUTES LES MAILLES
00034 !
00035 !-----------------------------------------------------------------------
00036 !                             ARGUMENTS
00037 ! .________________.____.______________________________________________
00038 ! |      NOM       |MODE|                   ROLE
00039 ! |________________|____|______________________________________________
00040 ! |   X,Y          |<-->| COORDONNEES DU MAILLAGE .
00041 ! |   IKLE         |<-->| NUMEROS GLOBAUX DES NOEUDS DE CHAQUE ELEMENT
00042 ! |   NCOLOR       |<-->| TABLEAU DES COULEURS DES POINTS DU MAILLAGE
00043 ! |   NPOIN        |<-->| NOMBRE TOTAL DE NOEUDS DU MAILLAGE
00044 ! |   NELEM        |<-->| NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
00045 ! |   NELMAX       | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
00046 ! |________________|____|______________________________________________
00047 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00048 !----------------------------------------------------------------------
00049 ! APPELE PAR : STBTEL
00050 !***********************************************************************
00051 !
00052       IMPLICIT NONE
00053       INTEGER LNG,LU
00054       COMMON/INFO/LNG,LU
00055 !
00056       INTEGER NPOIN , NELEM , NELMAX , NSOM2 , IELEM , IPOIN , ISOM
00057       INTEGER IKLE(NELMAX,*) , NCOLOR(*) , INDICP(*) , INDICE(*)
00058       INTEGER NO1 , NO2 , NO3 , NP1 , NP2 , NP3 , NE1 , NE2 , NE3
00059 !
00060       DOUBLE PRECISION X(*) , Y(*) , SOM2(10,2) , DX , DY
00061 !
00062 !=======================================================================
00063 !      RECHERCHE DES ELEMENTS A DIVISER PAR 4 OU PAR 2
00064 !=======================================================================
00065 !
00066       DO IPOIN = 1,NPOIN
00067         INDICP(IPOIN) = 1
00068       ENDDO
00069 !
00070       IF (NSOM2.GE.3) THEN
00071 !
00072         DO ISOM = 1,NSOM2
00073 !
00074           DX = SOM2(ISOM+1,1) - SOM2(ISOM,1)
00075           DY = SOM2(ISOM+1,2) - SOM2(ISOM,2)
00076 !
00077           DO IPOIN = 1,NPOIN
00078             IF (DX*(Y(IPOIN)-SOM2(ISOM,2)).LT.
00079      &          DY*(X(IPOIN)-SOM2(ISOM,1))) INDICP(IPOIN) = 0
00080           ENDDO
00081 !
00082         ENDDO
00083 !
00084       ENDIF
00085 !
00086       DO IELEM = 1,NELEM
00087         INDICE(IELEM) = INDICP(IKLE(IELEM,1))
00088      &              + 2*INDICP(IKLE(IELEM,2))
00089      &              + 4*INDICP(IKLE(IELEM,3))
00090       ENDDO
00091 !
00092 !=======================================================================
00093 !      DIVISION DES ELEMENTS PAR 4 OU PAR 2
00094 !=======================================================================
00095 !
00096       IPOIN = 1
00097 !
00098       DO IELEM = 1,NELEM
00099 !
00100         IF (INDICE(IELEM).EQ.7) THEN
00101 !
00102           NO1 = IKLE(IELEM,1)
00103           NO2 = IKLE(IELEM,2)
00104           NO3 = IKLE(IELEM,3)
00105 !
00106           NP1 = NPOIN + IPOIN
00107           NP2 = NP1   + 1
00108           NP3 = NP2   + 1
00109 !
00110           NE1 = NELEM + IPOIN
00111           NE2 = NE1   + 1
00112           NE3 = NE2   + 1
00113 !
00114           IPOIN = IPOIN + 3
00115 !
00116           X(NP1) = 0.5D0 * ( X(NO1) + X(NO2) )
00117           X(NP2) = 0.5D0 * ( X(NO2) + X(NO3) )
00118           X(NP3) = 0.5D0 * ( X(NO3) + X(NO1) )
00119 !
00120           Y(NP1) = 0.5D0 * ( Y(NO1) + Y(NO2) )
00121           Y(NP2) = 0.5D0 * ( Y(NO2) + Y(NO3) )
00122           Y(NP3) = 0.5D0 * ( Y(NO3) + Y(NO1) )
00123 !
00124           NCOLOR(NP1) = NCOLOR(NO1)
00125           NCOLOR(NP2) = NCOLOR(NO2)
00126           NCOLOR(NP3) = NCOLOR(NO3)
00127 !
00128           IKLE(IELEM,2) = NP1
00129           IKLE(IELEM,3) = NP3
00130 !
00131           IKLE(  NE1,1) = NP1
00132           IKLE(  NE1,2) = NO2
00133           IKLE(  NE1,3) = NP2
00134 !
00135           IKLE(  NE2,1) = NP3
00136           IKLE(  NE2,2) = NP2
00137           IKLE(  NE2,3) = NO3
00138 !
00139           IKLE(  NE3,1) = NP2
00140           IKLE(  NE3,2) = NP3
00141           IKLE(  NE3,3) = NP1
00142 !
00143         ELSEIF (INDICE(IELEM).EQ.3.OR.
00144      &          INDICE(IELEM).EQ.5.OR.
00145      &          INDICE(IELEM).EQ.6) THEN
00146 !
00147           IF (INDICE(IELEM).EQ.3) THEN
00148             NO1 = IKLE(IELEM,1)
00149             NO2 = IKLE(IELEM,2)
00150             NO3 = IKLE(IELEM,3)
00151           ELSEIF (INDICE(IELEM).EQ.5) THEN
00152             NO1 = IKLE(IELEM,3)
00153             NO2 = IKLE(IELEM,1)
00154             NO3 = IKLE(IELEM,2)
00155           ELSE
00156             NO1 = IKLE(IELEM,2)
00157             NO2 = IKLE(IELEM,3)
00158             NO3 = IKLE(IELEM,1)
00159           ENDIF
00160 !
00161           NP1 = NPOIN + IPOIN
00162 !
00163           NE1 = NELEM + IPOIN
00164 !
00165           IPOIN = IPOIN + 1
00166 !
00167           X(NP1) = 0.5D0 * ( X(NO1) + X(NO2) )
00168 !
00169           Y(NP1) = 0.5D0 * ( Y(NO1) + Y(NO2) )
00170 !
00171           NCOLOR(NP1) = NCOLOR(NO1)
00172 !
00173           IKLE(IELEM,1) = NO1
00174           IKLE(IELEM,2) = NP1
00175           IKLE(IELEM,3) = NO3
00176 !
00177           IKLE(  NE1,1) = NO2
00178           IKLE(  NE1,2) = NO3
00179           IKLE(  NE1,3) = NP1
00180 !
00181         ENDIF
00182 !
00183       ENDDO !IELEM
00184 !
00185       NPOIN = NPOIN + IPOIN - 1
00186       NELEM = NELEM + IPOIN - 1
00187 !
00188 !=======================================================================
00189 !  SORTIE LISTING
00190 !=======================================================================
00191 !
00192       IF (LNG.EQ.1) WRITE(LU,40) NPOIN,NELEM
00193       IF (LNG.EQ.2) WRITE(LU,50) NPOIN,NELEM
00194 40    FORMAT(//,1X,'DIVISION PAR 4 DES ELEMENTS',
00195      &        /,1X,'---------------------------',/,
00196      &        /,1X,'NOUVEAU NOMBRE DE POINTS   :',I9,
00197      &        /,1X,'NOUVEAU NOMBRE D''ELEMENTS  :',I9)
00198 50    FORMAT(//,1X,'CUTTING ELEMENTS BY 4',
00199      &        /,1X,'---------------------',/,
00200      &        /,1X,'NEW NUMBER OF POINTS   : ',I9,
00201      &        /,1X,'NEW NUMBER OF ELEMENTS : ',I9)
00202 !
00203       RETURN
00204       END SUBROUTINE

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