Télécharger fusrig.eso

Retour à la liste

Numérotation des lignes :

  1. C FUSRIG SOURCE BP208322 15/04/17 21:15:01 8494
  2.  
  3. C=======================================================================
  4. C= F U S R I G =
  5. C= ----------- =
  6. C= Ce sousprogramme realise la fusion ('ET') de deux objets RIGIDITE. =
  7. C=======================================================================
  8.  
  9. SUBROUTINE FUSRIG (IP1,IP2,IRETOU)
  10.  
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT REAL*8 (A-H,O-Z)
  13.  
  14. -INC CCOPTIO
  15. -INC SMRIGID
  16. -INC SMELEME
  17.  
  18. PARAMETER (IVA=2)
  19. DIMENSION ITTG(IVA)
  20.  
  21. ITTG(1)=IP1
  22. ITTG(2)=IP2
  23. if (ierr.ne.0) return
  24. cbp=8 NRIGE=0
  25. NRIGEL=0
  26. DO i=1,IVA
  27. MRIGID=ITTG(i)
  28. SEGACT,MRIGID
  29. cbp=8 NRIGE=MAX(IRIGEL(/1),NRIGE)
  30. NRIGEL=NRIGEL+IRIGEL(/2)
  31. C= SEGDES,MRIGID
  32. ENDDO
  33.  
  34. SEGINI,MRIGID
  35. ICHOLE=0
  36. IMGEO1=0
  37.  
  38. IC=1
  39. DO i=1,IVA
  40. RI1=ITTG(i)
  41. C= SEGACT,RI1
  42. JA=RI1.IRIGEL(/2)
  43. JB=RI1.IRIGEL(/1)
  44. DO k=1,JA
  45. MELEME=RI1.IRIGEL(1,k)
  46. SEGACT,MELEME
  47. IF (NUM(/2).NE.0) THEN
  48. COERIG(IC)=RI1.COERIG(k)
  49. DO l=1,JB
  50. IRIGEL(l,IC)=RI1.IRIGEL(l,k)
  51. ENDDO
  52. IC=IC+1
  53. ENDIF
  54. SEGDES,MELEME
  55. ENDDO
  56. C= SEGDES,RI1
  57. ENDDO
  58.  
  59. IF (NRIGEL.NE.(IC-1)) THEN
  60. NRIGEL=IC-1
  61. SEGADJ,MRIGID
  62. ENDIF
  63.  
  64. RI1=ITTG(1)
  65. RI2=ITTG(2)
  66. C= SEGACT,RI1,RI2
  67. IF (RI2.MTYMAT.NE.RI1.MTYMAT) THEN
  68. IF (RI1.MTYMAT.EQ.'RIGIDITE'.OR.RI2.MTYMAT.EQ.'RIGIDITE') THEN
  69. MTYMAT='RIGIDITE'
  70. ELSE
  71. MTYMAT='INDETERM'
  72. ENDIF
  73. ELSE
  74. MTYMAT=RI1.MTYMAT
  75. ENDIF
  76. SEGDES,RI1,RI2
  77.  
  78. C*OF RI1=MRIGID
  79. C= CALL COMPA(MRIGID)
  80. C*OF IF (RI1.NE.MRIGID) SEGSUP,RI1
  81.  
  82. SEGDES,MRIGID
  83. IRETOU=MRIGID
  84.  
  85. RETURN
  86. END
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  

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