Télécharger bsigma.eso

Retour à la liste

Numérotation des lignes :

  1. C BSIGMA SOURCE CB215821 16/12/05 21:15:04 9237
  2.  
  3. SUBROUTINE BSIGMA
  4.  
  5. C_______________________________________________________________________
  6. C
  7. C OPERATEUR FORCES INTERNES
  8. C
  9. C FOR1 = BSIGMA MODL1 SIG1 ( CAR1 ) (HOO1) ;
  10. C
  11. C MODL1 objet de type MMODEL
  12. C SIG1 MCHAML de contraintes
  13. C CAR1 MCHAML de caract{ristiques (facultatif)
  14. C HOO1 MCHAML DE MATERIAU OU DE HOOKE (FACULTATIF)
  15. C FOR1 CHPOINT donnant les foces nodales
  16. C_______________________________________________________________________
  17. C
  18. IMPLICIT INTEGER(I-N)
  19. IMPLICIT REAL*8(A-H,O-Z)
  20.  
  21. -INC CCOPTIO
  22. -INC SMCHPOI
  23. -INC SMCHAML
  24. -INC SMMODEL
  25.  
  26. IPCHE1 = 0
  27. IPCHE2 = 0
  28. IPCHE3 = 0
  29. IPCHP4 = 0
  30.  
  31. IPCHA2 = 0
  32. IPCHA3 = 0
  33.  
  34. CALL LIROBJ('MMODEL',IPMODL,1,irt1)
  35. IF (IERR.NE.0) RETURN
  36. C
  37. C S'AGIT-IL D'UN MODELE CHARGEMENT PRESSION
  38. C
  39. MMODEL=IPMODL
  40. SEGACT, MMODEL
  41. IMODEL = KMODEL(1)
  42. SEGDES, MMODEL
  43. SEGACT, IMODEL
  44. IF (FORMOD(1).EQ.'CHARGEMENT') GOTO 10
  45. SEGDES, IMODEL
  46. C_______________________________________________________________________
  47. C
  48. C CAS GENERAL
  49. C_______________________________________________________________________
  50. C
  51. C- 1 ER CHAMP/ELEMENT
  52. C
  53. CALL LIROBJ('MCHAML',IPIN,1,irt1)
  54. IF (IERR.NE.0) RETURN
  55.  
  56. CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  57. IF(IR .NE. 1) CALL ERREUR(KER)
  58. IF(IERR .NE. 0) RETURN
  59.  
  60. * Test sur le type du mchelm = CONTRAINTES
  61. C* On peut pas faire ce test a l'heure actuelle car les champs issus de
  62. C* COMP n'ont pas ce type...
  63. C* mchelm = IPCHE1
  64. C* SEGACT,mchelm
  65. C* IF (mchelm.titche.NE.'CONTRAINTES') THEN
  66. C* MOTERR(1:16) = 'CONTRAINTES '
  67. C* CALL ERREUR(291)
  68. C* RETURN
  69. C* ENDIF
  70.  
  71. C- 2 EME CHAMP/ELEMENT (FACULTATIF)
  72. C
  73. CALL LIROBJ('MCHAML',IPIN,0,irt1)
  74. IF (IERR.NE.0) RETURN
  75. IPCHA2=0
  76. IF (irt1 .EQ. 1) THEN
  77. CALL REDUAF(IPIN,IPMODL,IPCHA2,0,IR,KER)
  78. IF(IR .NE. 1) CALL ERREUR(KER)
  79. IF(IERR .NE. 0) RETURN
  80. ENDIF
  81.  
  82. C- 3 EME CHAMP/ELEMENT (FACULTATIF)
  83. C
  84. CALL LIROBJ('MCHAML',IPIN,0,irt1)
  85. IF (IERR.NE.0) RETURN
  86. IPCHA3=0
  87. IF (irt1 .EQ. 1) THEN
  88. CALL REDUAF(IPIN,IPMODL,IPCHA3,0,IR,KER)
  89. IF(IR .NE. 1) CALL ERREUR(KER)
  90. IF(IERR .NE. 0) RETURN
  91. ENDIF
  92. C
  93. IF (IPCHA2.NE.0 .OR. IPCHA3.NE.0) THEN
  94. CALL RNGCHA(IPCHA2, IPCHA3,
  95. & 'CARACTERISTIQUES', 'MATRICE DE HOOKE',
  96. & IPCHE2, IPCHE3)
  97. IF(IERR.NE.0) RETURN
  98. IF (IPCHE3.EQ.0) THEN
  99. IMAT = 1
  100. ELSE
  101. IMAT = 2
  102. ENDIF
  103. ELSE
  104. IMAT = 0
  105. IPCHE2 = 0
  106. IPCHE3 = 0
  107. ENDIF
  108. IRET = 0
  109.  
  110. CALL BSIGMP(IPMODL,IPCHE1,IPCHE2,IPCHE3,IMAT,
  111. & IPCHP4,IRET)
  112. C
  113. IF (IERR.NE.0 .OR. IRET.NE.1) RETURN
  114. GOTO 20
  115. C_______________________________________________________________________
  116. C
  117. C CAS DES MODELES CHARGEMENT PRESSION
  118. C_______________________________________________________________________
  119. C
  120. 10 CONTINUE
  121. SEGDES, IMODEL
  122. C
  123. C- 1 ER CHAMP/ELEMENT
  124. C
  125. CALL LIROBJ('MCHAML',IPIN,1,irt1)
  126. IF (IERR.NE.0) RETURN
  127. CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER)
  128. IF(IR .NE. 1) CALL ERREUR(KER)
  129. IF(IERR .NE. 0) RETURN
  130. C
  131. C- 2 EME CHAMP/ELEMENT (FACULTATIF)
  132. C
  133. CALL LIROBJ('MCHAML',IPIN,0,irt1)
  134. IF (IERR.NE.0) RETURN
  135. IPCHA2=0
  136. IF (irt1 .EQ. 1) THEN
  137. CALL REDUAF(IPIN,IPMODL,IPCHA2,0,IR,KER)
  138. IF(IR .NE. 1) CALL ERREUR(KER)
  139. IF(IERR .NE. 0) RETURN
  140. ENDIF
  141. C
  142. C ON TRIE LES MCHAML
  143. C
  144. IF (IPCHA2.EQ.0) THEN
  145. MCHELM=IPCHA1
  146. SEGACT MCHELM
  147. IF (MCHELM.TITCHE.EQ.'CARACTERISTIQUES') THEN
  148. IPCHE2=IPCHA1
  149. IPCHE1=0
  150. ELSE IF (MCHELM.TITCHE.EQ.'CONTRAINTES') THEN
  151. IPCHE2=0
  152. IPCHE1=IPCHA1
  153. ELSE
  154. SEGDES, MCHELM
  155. MOTERR(1:8)='CARACTER'
  156. MOTERR(9:16)='CONTRAIN'
  157. CALL ERREUR(109)
  158. RETURN
  159. ENDIF
  160. SEGDES, MCHELM
  161. ELSE
  162. CALL RNGCHA(IPCHA1,IPCHA2,'CONTRAINTES', 'CARACTERISTIQUES',
  163. & IPCHE1,IPCHE2)
  164. IF (IPCHE1.EQ.0) THEN
  165. MOTERR(1:16)='CONTRAINTES '
  166. CALL ERREUR(565)
  167. RETURN
  168. ENDIF
  169. IF (IPCHE2.EQ.0) THEN
  170. MOTERR(1:16)='CARACTERISTIQUES'
  171. CALL ERREUR(565)
  172. RETURN
  173. ENDIF
  174. ENDIF
  175. C
  176. CALL FEQPR(IPMODL,IPCHE1,IPCHE2,IPCHP4,IRET)
  177. IF (IERR.NE.0 .OR. IRET.NE.1) RETURN
  178. C_______________________________________________________________________
  179. C
  180. 20 CONTINUE
  181. C
  182. C- ATTRIBUTION D'UNE NATURE DISCRETE AU CHPO QUI SORT
  183. C
  184. MCHPOI = IPCHP4
  185. SEGACT,MCHPOI*MOD
  186. JATTRI(1) = 2
  187. SEGDES,MCHPOI
  188. C
  189. CALL ECROBJ('CHPOINT',IPCHP4)
  190. C
  191. RETURN
  192. END
  193.  
  194.  
  195.  

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