Sources Esope | Cast3M

rlexvc
C RLEXVC    SOURCE    OF166741  24/12/13    21:17:34     12097          
      SUBROUTINE RLEXVC(MELEMM,MELCEN,MELSOM,MLELEM)
C
      IMPLICIT INTEGER(I-N)
      INTEGER  NSOMM, ICEN, NBSOUS, ISOUS, NBELEM, NBNO, IELEM, INOEU
     &       , NLS1, NGS1, NGC, IPOS, NGC2
C
-INC SMELEME
      INTEGER JG
-INC SMLENTI
 
-INC PPARAM
-INC CCOPTIO
C
      INTEGER NBL, NBTPOI
      SEGMENT MLELEM
      INTEGER INDEX(NBL+1)
      INTEGER LESPOI(NBTPOI)
      ENDSEGMENT
C
      POINTEUR MELSOM.MELEME, MELEMM.MELEME, MELCEN.MELEME
     &         ,MLESOM.MLENTI, MTOUC.MLENTI, MLEMAI.MLENTI
C
C**** Le MELEME SOMMET
C
      CALL KRIPAD(MELSOM,MLESOM)
C
C     MLESOM: numerotation globale -> locale
C
C**** En KRIPAD
C     SEGACT MELSOM
C     SEGINI MLESOM
C
      NSOMM = MELSOM.NUM(/2)
      JG=NSOMM
      SEGINI MTOUC
C     MTOUC.LECT(NLS1) = estimation de nombre des centres voisins de
C        NLS1
      SEGACT MELEMM
      NBSOUS=MELEMM.LISOUS(/1)
C     NBSOUS=0 fait un peux chier!
      JG=MAX(NBSOUS,1)
      SEGINI MLEMAI
      IF(NBSOUS .EQ. 0)THEN
         MLEMAI.LECT(1)=MELEMM
      ELSE
         DO ISOUS=1,NBSOUS,1
            MLEMAI.LECT(ISOUS)=MELEMM.LISOUS(ISOUS)
         ENDDO
      ENDIF
      SEGDES MELEMM
C
C**** Combien de fois chaque sommet est touché par un centre?
C
      NBSOUS=JG
      NBTPOI=0
      DO ISOUS = 1, NBSOUS, 1
         MELEMM=MLEMAI.LECT(ISOUS)
         SEGACT MELEMM
         NBELEM=MELEMM.NUM(/2)
         NBNO=MELEMM.NUM(/1)
         DO IELEM = 1, NBELEM,1
            DO INOEU = 1, NBNO, 1
               NGS1 = MELEMM.NUM(INOEU,IELEM)
               NLS1 = MLESOM.LECT(NGS1)
               MTOUC.LECT(NLS1)=MTOUC.LECT(NLS1)+1
               NBTPOI=NBTPOI+1
            ENDDO
         ENDDO
      ENDDO
C
      NBL=NSOMM
      NBTPOI=NBTPOI+NSOMM
      SEGINI MLELEM
C
C**** Les sommets dedans MLELEM dans le meme ordre que dedans  MLESOM
C
      MLELEM.INDEX(1)=1
      DO IELEM=1, NBL, 1
         MLELEM.LESPOI(MLELEM.INDEX(IELEM))=MELSOM.NUM(1,IELEM)
         MLELEM.INDEX(IELEM+1)=MLELEM.INDEX(IELEM)+1+MTOUC.LECT(IELEM)
         MTOUC.LECT(IELEM)=0
      ENDDO
C
C**** MTOUC.LECT(IELEM)=0 \forall IELEM
C
      ICEN = 0
      SEGACT MELCEN
      DO ISOUS = 1, NBSOUS, 1
         MELEMM=MLEMAI.LECT(ISOUS)
         NBELEM=MELEMM.NUM(/2)
         NBNO=MELEMM.NUM(/1)
         DO IELEM = 1, NBELEM,1
            ICEN=ICEN+1
            NGC=MELCEN.NUM(1,ICEN)
            DO INOEU = 1, NBNO, 1
               NGS1 = MELEMM.NUM(INOEU,IELEM)
               NLS1 = MLESOM.LECT(NGS1)
               MTOUC.LECT(NLS1)=MTOUC.LECT(NLS1)+1
               IPOS = MLELEM.INDEX(NLS1)+MTOUC.LECT(NLS1)
               NGC2 = MLELEM.LESPOI(IPOS)
               IF(NGC2 .NE. 0)THEN
                  WRITE(IOIMP,*) 'Subroutine rlexvc.eso'
                  CALL ERREUR(5)
                  GOTO 9999
               ELSE
                  MLELEM.LESPOI(IPOS)=NGC
               ENDIF
            ENDDO
         ENDDO
         SEGDES MELEMM
      ENDDO
C
      SEGDES MLELEM
      SEGDES MELCEN
      SEGDES MELSOM
      SEGSUP MTOUC
      SEGSUP MLESOM
      SEGSUP MLEMAI
C
 9999 RETURN
      END