Télécharger clstru.eso

Retour à la liste

Numérotation des lignes :

  1. C CLSTRU SOURCE CHAT 09/10/09 21:16:21 6519
  2. SUBROUTINE CLSTRU
  3. C
  4. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  5. C INDIQUE LA SS-STRUC ELEM A LAQUELLE APPARTIENT UN OBJET CL1 DDL FIXES
  6. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  7. C
  8. IMPLICIT INTEGER(I-N)
  9. -INC CCOPTIO
  10. -INC SMCLSTR
  11. -INC SMSTRUC
  12. -INC SMELEME
  13. -INC SMRIGID
  14. I22=22
  15. SEGMENT ITRAV(0)
  16. SEGMENT ITRA1(0)
  17. C
  18. C LECTURE DE L'OBJET RIGIDITE CL1
  19. C
  20. CALL LIROBJ('RIGIDITE',IRET,1,IRETOU)
  21. IF(IERR.EQ.0) GOTO 10
  22. MOTERR(1:8)='RIGIDITE'
  23. CALL ERREUR(37)
  24. C *** PAS D'OBJET DE TYPE RIGIDITE
  25. CALL ERREUR(37)
  26. RETURN
  27. 10 MRIGID=IRET
  28. C
  29. C LECTURE DE LA SOUS-STRUCTURE
  30. C
  31. CALL LIROBJ('STRUCTUR',KOBJET,1,IRETOU)
  32. IF(IERR.EQ.0) GOTO 25
  33. MOTERR(1:8)='STRUCTUR'
  34. C *** PAS D'OBJET DE TYPE STRUCTURE
  35. CALL ERREUR(37)
  36. RETURN
  37. 25 MSTRUC=KOBJET
  38. SEGACT MRIGID
  39. NRIGEL=IRIGEL(/2)
  40. SEGINI ITRAV
  41. DO 30 NR=1,NRIGEL
  42. MELEME=IRIGEL(1,NR)
  43. SEGACT MELEME
  44. IF(ITYPEL.EQ.I22) GOTO 26
  45. SEGSUP ITRAV
  46. SEGDES MELEME
  47. SEGDES MRIGID
  48. CALL ERREUR(99)
  49. C *** L'OBJET RIGIDITE N'EST PAS DE TYPE CL1
  50. RETURN
  51. 26 SEGDES MELEME
  52. ITRAV(**)=MELEME
  53. 30 CONTINUE
  54. SEGDES MRIGID
  55. SEGACT MSTRUC
  56. NSTRU=LISTRU(/1)
  57. IF(NSTRU.EQ.1) GOTO 35
  58. C
  59. C LECTURE DU NUMERO DE LA SOUS-STRUCTURE ELEMENTAIRE
  60. C
  61. CALL LIRENT(NSTRU,1,IRETOU)
  62. IF(IERR.EQ.0) GOTO 35
  63. SEGDES MSTRUC
  64. SEGSUP ITRAV
  65. C *** L'OBJET CL1 DOIT APPARTENIR A UNE SS STRUC ELEMENTAIRE
  66. INTERR(1)=MSTRUC
  67. CALL ERREUR(90)
  68. RETURN
  69. 35 MSOSTU=LISTRU(NSTRU)
  70. SEGACT MSOSTU
  71. MRIGID=ISRAID
  72. SEGACT MRIGID
  73. SEGINI ITRA1
  74. NRIGEL=IRIGEL(/2)
  75. DO 40 IAA=1,NRIGEL
  76. ITRA1(**)=IRIGEL(1,IAA)
  77. 40 CONTINUE
  78. SEGDES MRIGID
  79. SEGDES MSOSTU
  80. SEGDES MSTRUC
  81. NL=ITRA1(/1)
  82. NBPT=ITRAV(/1)
  83. DO 65 I=1,NBPT
  84. IKI=ITRAV(I)
  85. DO 60 J=1,NL
  86. IF(ITRA1(J).EQ.IKI) GOTO 65
  87. 60 CONTINUE
  88. C *** UN BLOCAGE N'APPARTIENT PAS A LA SOUS-STRUCTURE
  89. INTERR(1)=IKI
  90. INTERR(2)=MSTRUC
  91. CALL ERREUR(91)
  92. RETURN
  93. 65 CONTINUE
  94. SEGSUP ITRAV
  95. SEGSUP ITRA1
  96. N=1
  97. SEGINI MCLSTR
  98. IRIGCL(1)=IRET
  99. ISOSTR(1)=MSOSTU
  100. C
  101. C ECRITURE DU MCLSTR
  102. C
  103. CALL ECROBJ('BLOQSTRU',MCLSTR)
  104. SEGDES MCLSTR
  105. RETURN
  106. END
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  

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