Sources Esope | Cast3M

interb
C INTERB    SOURCE    CB215821  19/07/30    21:16:54     10273          
 
      SUBROUTINE INTERB(IMAMA1,IMAMA2,IRET,IMAMA3)
 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
C
C     INTERSECTION (sens ensembliste) DE DEUX MAILLAGES
C
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
C
c     IPT1,IPT2 : les 2 maillages
c     IRET      : code de retour (0 = OK, 1 = intersection vide)
C     IPT3      : maillage de l'intersection (=0 si IRET = 1)
C
C     Suppose que chaque maillage n'a pas 2 sous-zones de même type
C
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      IMPLICIT INTEGER(I-N)
      LOGICAL VERIF
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
 
      IRET = 0
      ipt1 = IMAMA1
      ipt2 = IMAMA2
      ipt3 = 0
 
      SEGACT,IPT1,IPT2
      NBSOU1=IPT1.LISOUS(/1)
      NBSOU2=IPT2.LISOUS(/1)
 
C     Structure 1er maillage ?
      IF (NBSOU1.NE.0) THEN
C       il est composé
        GOTO 10
      ELSE
C       IPT1 est simple, INTERC verifiera s'il est vide
      ENDIF
 
C     Structure 2e maillage ?
      IF (NBSOU2.NE.0) THEN
C       il est composé
        GOTO 11
      ELSE
C       IPT2 est simple, INTERC verifiera s'il est vide
      ENDIF
 
C     LES DEUX MAILLAGES SONT SIMPLES
C     ===============================
      CALL INTERC(IPT1,IPT2,IPT3)
      GOTO 1000
 
C     UN DES DEUX EST COMPOSÉ, L'AUTRE SIMPLE
C     =======================================
  10  IF (NBSOU2.NE.0) THEN
        GOTO 20
      ELSE
        GOTO 12
      ENDIF
C     LE 2e EST COMPOSÉ, LE 1ER SIMPLE : on les intervertit
  11  IS   = IPT2
      IPT2 = IPT1
      IPT1 = IS
 
C     on les a dans l'ordre IPT1=composé, IPT2=simple ...
  12  CONTINUE
      NBSOU1 = IPT1.LISOUS(/1)
C     Recherche de la sous-zone de même type dans IPT2
      ITYP2 = IPT2.ITYPEL
      DO IS = 1, NBSOU1
        IPT4 = IPT1.LISOUS(IS)
        SEGACT,IPT4
        IF (IPT4.ITYPEL .EQ. ITYP2) THEN
          IF (IPT2.EQ.IPT4) THEN
C       le petit est inclus dans le grand
            IPT3 = IPT2
          ELSE
C       on determine l'intersection pour cette seule sous-zone
            CALL INTERC(IPT2,IPT4,IPT3)
          ENDIF
          GOTO 1000
        ENDIF
      ENDDO
c     on n'en a pas trouvé
      GOTO 1000
 
C     LES DEUX MAILLAGES SONT COMPOSÉS
C     ================================
  20  CONTINUE
      NBELEM=0
      NBNN  =0
      NBREF =0
      NBSOUS=MIN(NBSOU1,NBSOU2)
      SEGINI,IPT4
 
      I3=0
      DO 21 I1=1,NBSOU1
        IPT5=IPT1.LISOUS(I1)
        SEGACT IPT5
C       Recherche de la sous-zone de même type dans IPT2
        ITYP5 = IPT5.ITYPEL
        DO 22 I2=1,NBSOU2
          IPT6=IPT2.LISOUS(I2)
          SEGACT IPT6
          IF (ITYP5.EQ.IPT6.ITYPEL) THEN
C           on l'a trouvée, on fait l'intersection
            IF (IPT5.EQ.IPT6) THEN
C             les deux sous-maillages sont confondus
              IPT7=IPT5
            ELSE
              CALL INTERC(IPT5,IPT6,IPT7)
            ENDIF
            IF (IPT7.NE.0) THEN
C             intersection non vide, on stocke le maillage obtenu
              I3 = I3+1
              IPT4.LISOUS(I3)=IPT7
            ENDIF
            GOTO 23
          ENDIF
 22     CONTINUE
 23     CONTINUE
 21   CONTINUE
 
C     Maillage résultat
C     Aucune sous-zone ...
      IF (I3.EQ.0) THEN
        SEGSUP,IPT4
      ELSE
        NBSOUS = I3
        SEGADJ,IPT4
        IPT3 = IPT4
C     Si une seule sous-zone ...
        IF (I3.EQ.1) THEN
          IPT3 = IPT4.LISOUS(1)
          SEGSUP,IPT4
        ENDIF
      ENDIF
 
 1000 CONTINUE
      IF (IPT3.EQ.0) THEN
        IRET = 1
      ELSE
        IRET = 0
      ENDIF
      IMAMA3 = IPT3
 
      END