Télécharger resi1.eso

Retour à la liste

Numérotation des lignes :

  1. C RESI1 SOURCE BP208322 15/06/22 21:21:55 8543
  2. SUBROUTINE RESI1(IPMODE,IPCHEL,IPRIGI)
  3. ************************************************************************
  4. *
  5. * R E S I 1
  6. * ---------
  7. *
  8. *
  9. * FONCTION:
  10. * ---------
  11. * CREATION DE LA MATRICE DE RESISTANCE
  12. * GESTION DES SEGMENTS ET TESTS DE COMPATIBILITE
  13. *
  14. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+)=CONTENU DANS UN COMMUN
  15. * -----------
  16. *
  17. * IPMODE (E) POINTEUR SUR LE SEGMENT MMODEL
  18. * IPCHEL (E) POINTEUR SUR LE SEGMENT MCHELM
  19. * IPRIGI (S) POINTEUR SUR LE SEGMENT MRIGID
  20. * +IFOMOD (E) VOIR CCOPTIO
  21. *
  22. * MODULES UTILISES:
  23. * -----------------
  24. *
  25. IMPLICIT INTEGER(I-N)
  26. -INC CCOPTIO
  27. -INC CCHAMP
  28. -INC SMRIGID
  29. -INC SMCHAML
  30. -INC SMELEME
  31. -INC SMMODEL
  32. *
  33. *
  34. * VARIABLES:
  35. * ----------
  36. *
  37. * NBNN NOMBRE DE NOEUDS DANS L'ELEMENT CONSIDERE
  38. * NEF NUMERO DE L'ELEMENT FINI DANS NOMTP
  39. * NBMAIL NOMBRE DE MAILLAGES ELEMENTAIRES
  40. * NBELEM NOMBRE D'ELEMENTS DANS LE MAILLAGE ELEMENTAIRE
  41. *
  42. LOGICAL OK
  43. *
  44. * AUTEUR, DATE DE CREATION:
  45. * -------------------------
  46. *
  47. * YANN STEPHAN, LE 28 JANVIER 1997 (COPIE DE TCOND1).
  48. *
  49. * LANGAGE:
  50. * --------
  51. *
  52. * ESOPE + FORTRAN77
  53. *
  54. ************************************************************************
  55. *
  56. *
  57. * VERIFICATION DU LIEU SUPPORT DU CHAMELEM DE CARACTERISTIQUES
  58. *
  59. CALL QUESUP(IPMODE,IPCHEL,2,0,ISUP,IRETCA)
  60. IF(ISUP.GT.1)RETURN
  61. *
  62. * SI LE CHAMELEM EST APPUYE AUX NOEUDS ,ON CHANGE LE SUPPORT
  63. * POUR LES CENTRES DE GRAVITE
  64. *
  65. IF(ISUP.EQ.1)THEN
  66. CALL CHASUP(IPMODE,IPCHEL,IPCHE1,IRET,2)
  67. IF(IRET.NE.0)THEN
  68. CALL ERREUR(IRET)
  69. RETURN
  70. ENDIF
  71. ELSE
  72. IPCHE1=IPCHEL
  73. ENDIF
  74. *
  75. * ACTIVATION DES SEGMENTS MCHELM ET MMODEL
  76. *
  77. MCHELM=IPCHE1
  78. SEGACT,MCHELM
  79. NBMAIC=IMACHE(/1)
  80. SEGDES MCHELM
  81. *
  82. MMODEL=IPMODE
  83. SEGACT,MMODEL
  84. NBMAIM=KMODEL(/1)
  85. IF (NBMAIM.GT.NBMAIC) THEN
  86. *
  87. * IL MANQUE LES CARACTERISTIQUES D'UNE OU PLUSIEURS PARTIES
  88. * DU MODELE
  89. *
  90. CALL ERREUR(404)
  91. SEGDES,MMODEL
  92. IF(ISUP.EQ.1)SEGSUP MCHELM
  93. RETURN
  94. ENDIF
  95. *
  96. NBMAIL=NBMAIM
  97. *
  98. * INITIALISATION DU CHAPEAU DE L'OBJET RIGIDITE
  99. *
  100. NRIGE=6
  101. NRIGEL=NBMAIL
  102. SEGINI,MRIGID
  103. IPRIGI=MRIGID
  104. ICHOLE=0
  105. IMGEO1=0
  106. IMGEO2=0
  107. IFORIG=IFOMOD
  108. ISUPEQ=0
  109. MTYMAT='RIGIDITE'
  110. NBGEOR=0
  111. *
  112. DO 40 IA=1,NBMAIL
  113. IRIGEL(4,IA)=0
  114. COERIG(IA)=1.D0
  115. 40 CONTINUE
  116. * END DO
  117. IFOI=0
  118. *
  119. * BOUCLE SUR LES MAILLAGES ELEMENTAIRES,ZONE IMAIL
  120. *
  121. DO 50 IMAIL=1,NBMAIL
  122. *
  123. IFOI=IFOI+1
  124. IMODEL=KMODEL(IMAIL)
  125. SEGACT,IMODEL
  126. ICOQ = 0
  127. NEF=NEFMOD
  128. MELEME=IMAMOD
  129. SEGACT,MELEME
  130. NBNN=NUM(/1)
  131. NBELEM=NUM(/2)
  132. *
  133. * REMPLIR LE SEGMENT DESCRIPTEUR DE L'OBJET RIGIDITE
  134. **
  135. CALL RESI2(NEF,NBNN,IDESCR)
  136. *
  137. IF(IMAIL.GT.1)THEN
  138. MRIGID=IPRIGI
  139. SEGACT,MRIGID*MOD
  140. ENDIF
  141. *
  142. NLIGRE=NBNN
  143. descr=idescr
  144. segact descr
  145. nligrp=noelep(/1)
  146. nligrd=noeled(/1)
  147. segdes descr
  148. LVAL=(NBNN*(NBNN+1))/2
  149. *
  150. NELRIG=NBELEM
  151. SEGINI,xMATRI
  152. IRIGEL(1,IMAIL)=IMAMOD
  153. IRIGEL(2,IMAIL)=0
  154. IRIGEL(3,IMAIL)=IDESCR
  155. IRIGEL(4,IMAIL)=xMATRI
  156. IRIGEL(5,IMAIL)=0
  157. IRIGEL(6,IMAIL)=0
  158. *
  159. SEGDES,xMATRI,MRIGID
  160. SEGDES,MELEME
  161. *
  162. CALL RESI3(NEF,IMAIL,IMODEL,IPCHE1,IPRIGI)
  163. IF (IERR.NE.0)GOTO 99
  164. 50 CONTINUE
  165. 99 CONTINUE
  166. DO 60 I=1,IFOI
  167. IMODEL=KMODEL(I)
  168. SEGDES,IMODEL
  169. 60 CONTINUE
  170. * END DO
  171. SEGDES,MMODEL
  172. IF(ISUP.EQ.1)SEGSUP MCHELM
  173. *
  174. RETURN
  175. END
  176.  
  177.  
  178.  
  179.  
  180.  

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