Télécharger resi1.eso

Retour à la liste

Numérotation des lignes :

  1. C RESI1 SOURCE CB215821 19/08/20 21:21:38 10287
  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. *
  81. MMODEL=IPMODE
  82. SEGACT,MMODEL
  83. NBMAIM=KMODEL(/1)
  84. IF (NBMAIM.GT.NBMAIC) THEN
  85. *
  86. * IL MANQUE LES CARACTERISTIQUES D'UNE OU PLUSIEURS PARTIES
  87. * DU MODELE
  88. *
  89. CALL ERREUR(404)
  90. IF(ISUP.EQ.1)SEGSUP MCHELM
  91. RETURN
  92. ENDIF
  93. *
  94. NBMAIL=NBMAIM
  95. *
  96. * INITIALISATION DU CHAPEAU DE L'OBJET RIGIDITE
  97. *
  98. NRIGE=6
  99. NRIGEL=NBMAIL
  100. SEGINI,MRIGID
  101. IPRIGI=MRIGID
  102. ICHOLE=0
  103. IMGEO1=0
  104. IMGEO2=0
  105. IFORIG=IFOMOD
  106. ISUPEQ=0
  107. MTYMAT='RIGIDITE'
  108. NBGEOR=0
  109. *
  110. DO 40 IA=1,NBMAIL
  111. IRIGEL(4,IA)=0
  112. COERIG(IA)=1.D0
  113. 40 CONTINUE
  114. * END DO
  115. IFOI=0
  116. *
  117. * BOUCLE SUR LES MAILLAGES ELEMENTAIRES,ZONE IMAIL
  118. *
  119. DO 50 IMAIL=1,NBMAIL
  120. *
  121. IFOI=IFOI+1
  122. IMODEL=KMODEL(IMAIL)
  123. SEGACT,IMODEL
  124. ICOQ = 0
  125. NEF=NEFMOD
  126. MELEME=IMAMOD
  127. SEGACT,MELEME
  128. NBNN=NUM(/1)
  129. NBELEM=NUM(/2)
  130. *
  131. * REMPLIR LE SEGMENT DESCRIPTEUR DE L'OBJET RIGIDITE
  132. **
  133. CALL RESI2(NEF,NBNN,IDESCR)
  134. *
  135. IF(IMAIL.GT.1)THEN
  136. MRIGID=IPRIGI
  137. SEGACT,MRIGID*MOD
  138. ENDIF
  139. *
  140. NLIGRE=NBNN
  141. descr=idescr
  142. segact descr
  143. nligrp=noelep(/1)
  144. nligrd=noeled(/1)
  145. segdes descr
  146. LVAL=(NBNN*(NBNN+1))/2
  147. *
  148. NELRIG=NBELEM
  149. SEGINI,xMATRI
  150. IRIGEL(1,IMAIL)=IMAMOD
  151. IRIGEL(2,IMAIL)=0
  152. IRIGEL(3,IMAIL)=IDESCR
  153. IRIGEL(4,IMAIL)=xMATRI
  154. IRIGEL(5,IMAIL)=0
  155. IRIGEL(6,IMAIL)=0
  156. *
  157. SEGDES,xMATRI,MRIGID
  158. *
  159. CALL RESI3(NEF,IMAIL,IMODEL,IPCHE1,IPRIGI)
  160. IF (IERR.NE.0)GOTO 99
  161. 50 CONTINUE
  162. 99 CONTINUE
  163. IF(ISUP.EQ.1)SEGSUP MCHELM
  164. END
  165.  
  166.  
  167.  

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