Esope source files

   1 : C DISJO     SOURCE    CHAT      10/12/21    21:15:07     6831           
   2 :            SUBROUTINE disjo(IPT1,IPT2,MELEME,ipt4,ipt5,icpr)
   3 : *
   4 : * a partir de deux maillages elementaires de meme itypel (ipt1,ipt2)
   5 : * realise trois maillages : meleme intersection de ipt1 et ipt2
   6 : *                           ipt4 partie de ipt1 pas dans ipt2
   7 : *                           ipt5 partiere de ipt2 pas dans ipt1
   8 : * les pointeurs valent zero si rien dedans
   9 : 
  10 :       IMPLICIT INTEGER(I-N)
  11 : -INC CCOPTIO
  12 : -INC SMELEME
  13 : -INC SMCOORD
  14 :       SEGMENT INV(NBT)
  15 :       SEGMENT NINV(NBNO)
  16 :       SEGMENT NPOS(NBNO)
  17 : 
  18 :       SEGMENT IVU(NBVU)
  19 :       segment icpr(ino)
  20 : 
  21 :       SEGACT IPT1,IPT2
  22 : 
  23 : *     Type d'élément incorrect ?
  23 :       IF (IPT1.ITYPEL .NE.IPT2.ITYPEL ) CALL ERREUR(16)
  23 :       IF (IPT1.NUM(/1).NE.IPT2.NUM(/1)) CALL ERREUR(16)
  24 :       IF (IERR.NE.0) RETURN
  25 : 
  26 :       NBREF  = 0
  27 :       NBNN   = IPT1.NUM(/1)
  28 :       NBELE1 = IPT1.NUM(/2)
  29 :       NBELE2 = IPT2.NUM(/2)
  30 : 
  31 : *     DETERMINATION DU NOMBRE DE NOEUDS
  32 :       SEGACT MCOORD
  33 : *      SEGINI ICPR
  34 :       do io=1,icpr(/1)
  35 :        icpr(io)=0
  36 :       enddo
  37 :       NBNO=0
  38 :       DO I=1,NBELE1
  39 :          DO 15 J=1,NBNN
  40 :             IPT=IPT1.NUM(J,I)
  41 :             IF (ICPR(IPT).NE.0) GOTO 15
  42 :             NBNO=NBNO+1
  43 :             ICPR(IPT)=NBNO
  44 :  15      CONTINUE
  45 :       ENDDO 
  46 : 
  47 : *     NB MAX ELEMENTS TOUCHANT UN NOEUD
  48 :       SEGINI NINV,NPOS
  49 :       DO I=1,NBELE1
  50 :          DO J=1,NBNN
  51 :             NINV(ICPR(IPT1.NUM(J,I)))=NINV(ICPR(IPT1.NUM(J,I)))+1
  52 :          ENDDO 
  53 :       ENDDO 
  54 :       NBC=0
  55 :       NBT=0
  56 :       DO I=1,NBNO
  57 :          NBC=MAX(NBC,NINV(I))
  58 :          NPOS(I)=NBT
  59 :          NBT=NBT+NINV(I)
  60 :          NINV(I)=0
  61 :       ENDDO 
  62 :       SEGINI INV
  63 :       DO I=1,NBELE1
  64 :          DO J=1,NBNN
  65 :             IPP=ICPR(IPT1.NUM(J,I))
  66 :             NINV(IPP)=NINV(IPP)+1
  67 :             INV(NPOS(IPP)+NINV(IPP))=I
  68 :          ENDDO 
  69 :       ENDDO 
  70 : 
  71 : *     Création table d'indicateur de noeud déjà trouvé
  72 :       NBVU=NBNN
  73 :       SEGINI, IVU
  74 : 
  75 : *     CREATION DE LA DIFFERENCE SYMETRIQUE
  76 :       NBSOUS=0
  77 :       nbref=0
  78 :       NBELEM=NBELE1+NBELE2
  79 :       SEGINI MELEME
  80 :       DO I=1,NBELE1
  81 :          ICOLOR(I)=IPT1.ICOLOR(I)
  82 :          DO J=1,NBNN
  83 :             NUM(J,I)=IPT1.NUM(J,I)
  84 :          ENDDO 
  85 :       ENDDO 
  86 : 
  87 :       DO I=1,NBELE2
  88 :          ICOLOR(I+NBELE1)=IPT2.ICOLOR(I)
  89 :          DO J=1,NBNN
  90 :             NUM(J,I+NBELE1)=IPT2.NUM(J,I)
  91 :          ENDDO 
  92 :       ENDDO 
  93 :       nbelem=0
  94 :       DO 2 I=1,NBELE2
  95 :          DO J=1,NBNN
  96 : *            write(6,* ) 'NUM(J,I+NBELE1)',NUM(J,I+NBELE1)
  97 :             IPP=ICPR(NUM(J,I+NBELE1))
  98 :             IF (IPP.EQ.0) GOTO 2
  99 :             DO 23 K=1,NINV(IPP)
 100 :                IEL=INV(NPOS(IPP)+K)
 101 : *              Comparaison des numéros de noeud de l'élément
 102 : *              ICOIN=nb de noeuds qui conviennent
 103 :                ICOIN=0
 104 :                DO M=1,NBNN
 105 :                   IVU(M)=0
 106 :                ENDDO
 107 :                DO 24 L=1,NBNN
 108 :                   DO M=1,NBNN
 109 : *PM                  On ne teste que les noeuds non encore identifiés. 
 110 :                      IF (NUM(M,IEL).EQ.NUM(L,I+NBELE1) .AND. 
 111 :      &                   IVU(M).EQ.0) THEN 
 112 :                         ICOIN  = ICOIN + 1
 113 :                         IVU(M) = 1 
 114 :                         GOTO 24
 115 :                      ENDIF 
 116 :                   ENDDO 
 117 :  24            CONTINUE
 118 : 
 119 :                IF (ICOIN.NE.NBNN) GOTO 23
 120 : *              Les deux élements coincident
 121 :                NUM(1,I+NBELE1)=-NUM(1,I+NBELE1)
 122 :                NUM(1,IEL)=0
 123 :                NBELEM=NBELEM+1
 124 : *              WRITE (6,*) ' COINCIDE ',I,IEL,NBELEM,NBELE1,NBELE2,NBNN
 125 :                GOTO 2
 126 :  23         CONTINUE
 127 :          ENDDO 
 128 :  2    CONTINUE
 129 : 
 130 : *     RETASSER LE MELEME RÉSULTAT
 131 :       IPT3=MELEME  
 132 : *      write(6,*) 'nbelem ',nbelem    
 133 :       IF(NBELEM.EQ.0) then
 134 : * les maillages sont disjoints pas d'intersection
 135 :        meleme=0 
 136 :       else
 137 :        nbmil=nbelem             
 138 :        SEGINI MELEME
 139 :        nbnn=ipt1.num(/1)
 140 :        nbelem= nbele1 - nbmil  
 141 :        if( nbelem.eq.0) then 
 142 : *   le premier ipt1 etait inclus dans ipt2
 143 :         ipt4=0
 144 :        else
 145 :         segini ipt4 
 146 :         ipt4.itypel=IPT1.ITYPEL
 147 :        endif      
 148 :        nbelem= nbele2 - nbmil
 149 :        if( nbelem.eq.0) then 
 150 : *   le  ipt2 etait inclus dans ipt1
 151 :         ipt5=0
 152 :        else
 153 :         segini ipt5 
 154 :         ipt5.itypel=IPT1.ITYPEL
 155 :        endif    
 156 :        ITYPEL=IPT1.ITYPEL
 157 :        I=0
 158 :        I4=0
 159 :        I5=0
 160 :       DO J=1,NBELE1+nbele2
 161 :         IF(ipt3.num(1,j).eq.0) go to 36
 162 :         IF (IPT3.NUM(1,J).lt.0) then
 163 :            I=I+1
 164 :            DO K=1,NBNN
 165 :             NUM(K,I)=abs(IPT3.NUM(K,J))
 166 :            ENDDO
 167 :            ICOLOR(I)=IPT3.ICOLOR(J)
 168 :          ELSEIF (J.le.nbele1) then
 169 :            I4=I4+1 
 170 :            DO K=1,NBNN
 171 :             ipt4.NUM(K,I4)=IPT3.NUM(K,J)
 172 :            ENDDO
 173 :            ipt4.ICOLOR(I4)=IPT3.ICOLOR(J)
 174 :          ELSE  
 175 :            I5=I5+1 
 176 :            DO K=1,NBNN
 177 :             ipt5.NUM(K,I5)=IPT3.NUM(K,J)
 178 :            ENDDO
 179 :            ipt5.ICOLOR(I5)=IPT3.ICOLOR(J)
 180 :          ENDIF  
 181 :    36 continue            
 182 :       ENDDO 
 183 :       endif
 184 : *      write(6,*) ' sortir disjo ', ipt4,ipt5,meleme
 185 :       SEGSUP IPT3,INV,NINV,NPOS,IVU
 186 :       RETURN
 187 :       END
 188 : 
 189 : 
 190 : 
 191 : 
 192 :  
 193 :