Sources Esope | Cast3M

fuseli
C FUSELI    SOURCE    PV        13/04/17    21:15:06     7767
      SUBROUTINE FUSELI(IPT1,IPT2,IPT3,LTELQ)
*=============================================================
*
* Ce sous-programme réalise l'operation "ET" sur les deux objets
* maillages IPT1 et IPT2.
* Le resultat est rangé dans IPT3
*
* Assure la continuité de parcours de la ligne résultat (sauf si 'TELQ')
*
*=============================================================
*
* Modifications :
*
*   PM 09/10/2007 : respecte l'ordre y compris si le sens de parcours
*                   aurait pu être continu avec mot-clef TELQUEL
*
*=============================================================
*
* Remarques :
*
*   IPT1 et IPT2 doivent etre de type LIGNE
*
*=============================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
      LOGICAL LTELQ
      segact ipt1,ipt2
      NBNN   = IPT1.NUM(/1)
      NBELE1 = IPT1.NUM(/2)
      NBELE2 = IPT2.NUM(/2)
      NBELEM = NBELE1+NBELE2
      nbnn2= ipt2.num(/1)
      NBSOUS = 0
      NBREF  = 0
      SEGINI IPT3
      IPT3.ITYPEL=IPT1.ITYPEL
 
* PM ?
      IF (NBELE1.EQ.0 .OR. NBELE2.EQ.0) GOTO 25
 
*     Faut-il mettre le 2e maillage en premier pour préserver un sens de
*     parcours ?
      IF ((.NOT.LTELQ).AND.
     $   (ipt1.num(1,1).eq.ipt2.num(nbnn2,nbele2)).and.
     $   (ipt2.num(1,1).ne.ipt1.num(nbnn,nbele1))) go to 25
*     #    (IPT1.NUM(1,1).EQ.IPT2.NUM(NBNN,NBELE2)).AND.
*     #    (IPT2.NUM(1,1).NE.IPT1.NUM(NBNN,NBELE1))) GOTO 25
 
*     Concaténation dans l'ordre donné
      DO J=1,NBELE1
         IPT3.ICOLOR(J)=IPT1.ICOLOR(J)
         DO I=1,NBNN
            IPT3.NUM(I,J)=IPT1.NUM(I,J)
         ENDDO
      ENDDO
      DO J=1,NBELE2
         IPT3.ICOLOR(J+NBELE1)=IPT2.ICOLOR(J)
         DO I=1,NBNN
            IPT3.NUM(I,J+NBELE1)=IPT2.NUM(I,J)
         ENDDO
      ENDDO
      if (ipt3.itypel.eq.1) call crech1(ipt3,1)
      RETURN
 
*     Concaténation avec le 2e en premier
  25  CONTINUE
      DO J=1,NBELE2
         IPT3.ICOLOR(J)=IPT2.ICOLOR(J)
         DO I=1,NBNN
            IPT3.NUM(I,J)=IPT2.NUM(I,J)
         ENDDO
      ENDDO
      DO J=1,NBELE1
         IPT3.ICOLOR(J+NBELE2)=IPT1.ICOLOR(J)
         DO I=1,NBNN
            IPT3.NUM(I,J+NBELE2)=IPT1.NUM(I,J)
         ENDDO
      ENDDO
      if (ipt3.itypel.eq.1) call crech1(ipt3,1)
 
      RETURN
      END