Télécharger fuseli.eso

Retour à la liste

Numérotation des lignes :

  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
  65. if (ipt3.itypel.eq.1) call crech1(ipt3,1)
  66. RETURN
  67.  
  68. * Concaténation avec le 2e en premier
  69. 25 CONTINUE
  70. DO J=1,NBELE2
  71. IPT3.ICOLOR(J)=IPT2.ICOLOR(J)
  72. DO I=1,NBNN
  73. IPT3.NUM(I,J)=IPT2.NUM(I,J)
  74. ENDDO
  75. ENDDO
  76. DO J=1,NBELE1
  77. IPT3.ICOLOR(J+NBELE2)=IPT1.ICOLOR(J)
  78. DO I=1,NBNN
  79. IPT3.NUM(I,J+NBELE2)=IPT1.NUM(I,J)
  80. ENDDO
  81. ENDDO
  82. if (ipt3.itypel.eq.1) call crech1(ipt3,1)
  83.  
  84. RETURN
  85. END
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales