Esope source files

   1 : C RLEXVC    SOURCE    CHAT      05/01/13    03:03:19     5004           
   2 :       SUBROUTINE RLEXVC(MELEMM,MELCEN,MELSOM,MLELEM)
   3 : C
   4 : C**** Variables de COOPTIO
   5 : C
   6 : C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
   7 : C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
   8 : C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
   9 : C     &        ,IECHO,   IIMPI,  IOSPI
  10 : C     &        ,IDIM
  11 : C     &        ,MCOORD      
  12 : C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  13 : C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  14 : C     &        ,NORINC,NORVAL,NORIND,NORVAD
  15 : C     &        ,NUCROU, IPSAUV
  16 : C
  17 :       IMPLICIT INTEGER(I-N)
  18 :       INTEGER  NSOMM, ICEN, NBSOUS, ISOUS, NBELEM, NBNO, IELEM, INOEU
  19 :      &       , NLS1, NGS1, NGC, IPOS, NGC2
  20 : C
  21 : -INC SMELEME
  22 :       INTEGER JG
  23 : -INC SMLENTI
  24 : -INC CCOPTIO
  25 : C
  26 :       INTEGER NBL, NBTPOI
  27 :       SEGMENT MLELEM
  28 :       INTEGER INDEX(NBL+1)
  29 :       INTEGER LESPOI(NBTPOI)
  30 :       ENDSEGMENT
  31 : C
  32 :       POINTEUR MELSOM.MELEME, MELEMM.MELEME, MELCEN.MELEME
  33 :      &         ,MLESOM.MLENTI, MTOUC.MLENTI, MLEMAI.MLENTI
  34 : C
  35 : C**** Le MELEME SOMMET
  36 : C     
  36 :       CALL KRIPAD(MELSOM,MLESOM)
  37 : C
  38 : C     MLESOM: numerotation globale -> locale
  39 : C
  40 : C**** En KRIPAD
  41 : C     SEGACT MELSOM
  42 : C     SEGINI MLESOM
  43 : C
  44 :       NSOMM = MELSOM.NUM(/2)
  45 :       JG=NSOMM
  46 :       SEGINI MTOUC
  47 : C     MTOUC.LECT(NLS1) = estimation de nombre des centres voisins de
  48 : C        NLS1
  49 :       SEGACT MELEMM
  50 :       NBSOUS=MELEMM.LISOUS(/1)
  51 : C     NBSOUS=0 fait un peux chier!
  52 :       JG=MAX(NBSOUS,1)
  53 :       SEGINI MLEMAI
  54 :       IF(NBSOUS .EQ. 0)THEN
  55 :          MLEMAI.LECT(1)=MELEMM
  56 :       ELSE
  57 :          DO ISOUS=1,NBSOUS,1
  58 :             MLEMAI.LECT(ISOUS)=MELEMM.LISOUS(ISOUS)
  59 :          ENDDO
  60 :       ENDIF
  61 :       SEGDES MELEMM
  62 : C
  63 : C**** Combien de fois chaque sommet est touché par un centre?
  64 : C
  65 :       NBSOUS=JG
  66 :       NBTPOI=0
  67 :       DO ISOUS = 1, NBSOUS, 1
  68 :          MELEMM=MLEMAI.LECT(ISOUS)
  69 :          SEGACT MELEMM
  70 :          NBELEM=MELEMM.NUM(/2)
  71 :          NBNO=MELEMM.NUM(/1)
  72 :          DO IELEM = 1, NBELEM,1
  73 :             DO INOEU = 1, NBNO, 1
  74 :                NGS1 = MELEMM.NUM(INOEU,IELEM)
  75 :                NLS1 = MLESOM.LECT(NGS1)
  76 :                MTOUC.LECT(NLS1)=MTOUC.LECT(NLS1)+1
  77 :                NBTPOI=NBTPOI+1
  78 :             ENDDO
  79 :          ENDDO
  80 :       ENDDO
  81 : C
  82 :       NBL=NSOMM
  83 :       NBTPOI=NBTPOI+NSOMM
  84 :       SEGINI MLELEM
  85 : C
  86 : C**** Les sommets dedans MLELEM dans le meme ordre que dedans  MLESOM
  87 : C
  88 :       MLELEM.INDEX(1)=1
  89 :       DO IELEM=1, NBL, 1
  90 :          MLELEM.LESPOI(MLELEM.INDEX(IELEM))=MELSOM.NUM(1,IELEM)
  91 :          MLELEM.INDEX(IELEM+1)=MLELEM.INDEX(IELEM)+1+MTOUC.LECT(IELEM)
  92 :          MTOUC.LECT(IELEM)=0
  93 :       ENDDO
  94 : C
  95 : C**** MTOUC.LECT(IELEM)=0 \forall IELEM
  96 : C
  97 :       ICEN = 0
  98 :       SEGACT MELCEN
  99 :       DO ISOUS = 1, NBSOUS, 1
 100 :          MELEMM=MLEMAI.LECT(ISOUS)
 101 :          NBELEM=MELEMM.NUM(/2)
 102 :          NBNO=MELEMM.NUM(/1)
 103 :          DO IELEM = 1, NBELEM,1
 104 :             ICEN=ICEN+1
 105 :             NGC=MELCEN.NUM(1,ICEN)
 106 :             DO INOEU = 1, NBNO, 1
 107 :                NGS1 = MELEMM.NUM(INOEU,IELEM)
 108 :                NLS1 = MLESOM.LECT(NGS1)
 109 :                MTOUC.LECT(NLS1)=MTOUC.LECT(NLS1)+1
 110 :                IPOS = MLELEM.INDEX(NLS1)+MTOUC.LECT(NLS1)
 111 :                NGC2 = MLELEM.LESPOI(IPOS)
 112 :                IF(NGC2 .NE. 0)THEN
 113 :                   WRITE(IOIMP,*) 'Subroutine rlexvc.eso'
 113 :                   CALL ERREUR(5)
 114 :                   GOTO 9999
 115 :                ELSE
 116 :                   MLELEM.LESPOI(IPOS)=NGC
 117 :                ENDIF
 118 :             ENDDO
 119 :          ENDDO
 120 :          SEGDES MELEMM
 121 :       ENDDO
 122 : C
 123 :       SEGDES MLELEM
 124 :       SEGDES MELCEN
 125 :       SEGDES MELSOM
 126 :       SEGSUP MTOUC
 127 :       SEGSUP MLESOM
 128 :       SEGSUP MLEMAI
 129 : C
 130 :  9999 RETURN
 131 :       END
 132 :          
 133 : 
 134 :       
 135 : 
 136 : 
 137 :  
 138 :