Esope source files

   1 : C FUSELI    SOURCE    PV        13/04/17    21:15:06     7767           
   2 :       SUBROUTINE FUSELI(IPT1,IPT2,IPT3,LTELQ)
   3 : *=============================================================
   4 : *
   5 : * Ce sous-programme réalise l'operation "ET" sur les deux objets
   6 : * maillages IPT1 et IPT2.
   7 : * Le resultat est rangé dans IPT3
   8 : *
   9 : * Assure la continuité de parcours de la ligne résultat (sauf si 'TELQ')
  10 : *
  11 : *=============================================================
  12 : *
  13 : * Modifications :
  14 : *
  15 : *   PM 09/10/2007 : respecte l'ordre y compris si le sens de parcours
  16 : *                   aurait pu être continu avec mot-clef TELQUEL
  17 : *
  18 : *=============================================================
  19 : *
  20 : * Remarques :
  21 : *
  22 : *   IPT1 et IPT2 doivent etre de type LIGNE
  23 : *
  24 : *=============================================================
  25 :       IMPLICIT INTEGER(I-N)
  26 :       IMPLICIT REAL*8(A-H,O-Z)
  27 : -INC CCOPTIO
  28 : -INC SMELEME
  29 :       LOGICAL LTELQ
  30 :       segact ipt1,ipt2
  31 :       NBNN   = IPT1.NUM(/1)
  32 :       NBELE1 = IPT1.NUM(/2)
  33 :       NBELE2 = IPT2.NUM(/2)
  34 :       NBELEM = NBELE1+NBELE2
  35 :       nbnn2= ipt2.num(/1)
  36 :       NBSOUS = 0
  37 :       NBREF  = 0
  38 :       SEGINI IPT3
  39 :       IPT3.ITYPEL=IPT1.ITYPEL
  40 : 
  41 : * PM ?
  42 :       IF (NBELE1.EQ.0 .OR. NBELE2.EQ.0) GOTO 25
  43 : 
  44 : *     Faut-il mettre le 2e maillage en premier pour préserver un sens de
  45 : *     parcours ?
  46 :       IF ((.NOT.LTELQ).AND.
  47 :      $   (ipt1.num(1,1).eq.ipt2.num(nbnn2,nbele2)).and.
  48 :      $   (ipt2.num(1,1).ne.ipt1.num(nbnn,nbele1))) go to 25
  49 : *     #    (IPT1.NUM(1,1).EQ.IPT2.NUM(NBNN,NBELE2)).AND.
  50 : *     #    (IPT2.NUM(1,1).NE.IPT1.NUM(NBNN,NBELE1))) GOTO 25
  51 : 
  52 : *     Concaténation dans l'ordre donné
  53 :       DO J=1,NBELE1
  54 :          IPT3.ICOLOR(J)=IPT1.ICOLOR(J)
  55 :          DO I=1,NBNN
  56 :             IPT3.NUM(I,J)=IPT1.NUM(I,J)
  57 :          ENDDO 
  58 :       ENDDO 
  59 :       DO J=1,NBELE2
  60 :          IPT3.ICOLOR(J+NBELE1)=IPT2.ICOLOR(J)
  61 :          DO I=1,NBNN
  62 :             IPT3.NUM(I,J+NBELE1)=IPT2.NUM(I,J)
  63 :          ENDDO 
  64 :       ENDDO 
  64 :       if (ipt3.itypel.eq.1) call crech1(ipt3,1)
  65 :       RETURN 
  66 : 
  67 : *     Concaténation avec le 2e en premier
  68 :   25  CONTINUE
  69 :       DO J=1,NBELE2
  70 :          IPT3.ICOLOR(J)=IPT2.ICOLOR(J)
  71 :          DO I=1,NBNN
  72 :             IPT3.NUM(I,J)=IPT2.NUM(I,J)
  73 :          ENDDO 
  74 :       ENDDO 
  75 :       DO J=1,NBELE1
  76 :          IPT3.ICOLOR(J+NBELE2)=IPT1.ICOLOR(J)
  77 :          DO I=1,NBNN
  78 :             IPT3.NUM(I,J+NBELE2)=IPT1.NUM(I,J)
  79 :          ENDDO 
  80 :       ENDDO 
  80 :       if (ipt3.itypel.eq.1) call crech1(ipt3,1)
  81 : 
  82 :       RETURN
  83 :       END
  84 : 
  85 : 
  86 :  
  87 :  
  88 :