Télécharger bsigma.eso

Retour à la liste

Numérotation des lignes :

bsigma
  1. C BSIGMA SOURCE CB215821 20/11/25 13:18:55 10792
  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.  
  22. -INC PPARAM
  23. -INC CCOPTIO
  24. -INC SMCHPOI
  25. -INC SMCHAML
  26. -INC SMMODEL
  27. -INC SMCOORD
  28.  
  29. character*4 mcle(1)
  30. data mcle/'NOER'/
  31.  
  32. segact mcoord
  33. IPCHE1 = 0
  34. IPCHE2 = 0
  35. IPCHE3 = 0
  36. IPCHP4 = 0
  37.  
  38. IPCHA2 = 0
  39. IPCHA3 = 0
  40. noer=0
  41. call lirmot(mcle,1,noer,0)
  42.  
  43. CALL LIROBJ('MMODEL ',IPMODL,1,irt1)
  44. IF (IERR.NE.0) RETURN
  45. CALL ACTOBJ('MMODEL ',IPMODL,1)
  46. C
  47. C S'AGIT-IL D'UN MODELE CHARGEMENT PRESSION
  48. C
  49. MMODEL = IPMODL
  50. IMODEL = KMODEL(1)
  51. IF (FORMOD(1).EQ.'CHARGEMENT') GOTO 10
  52. C_______________________________________________________________________
  53. C
  54. C CAS GENERAL
  55. C_______________________________________________________________________
  56. C
  57. C- 1 ER CHAMP/ELEMENT
  58. C
  59. CALL LIROBJ('MCHAML ',IPIN,1,irt1)
  60. IF (IERR.NE.0) RETURN
  61. CALL ACTOBJ('MCHAML ',IPIN,1)
  62. CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  63. IF(IR .NE. 1) CALL ERREUR(KER)
  64. IF(IERR .NE. 0) RETURN
  65.  
  66. * Test sur le type du mchelm = CONTRAINTES
  67. C* On peut pas faire ce test a l'heure actuelle car les champs issus de
  68. C* COMP n'ont pas ce type...
  69. C* mchelm = IPCHE1
  70. C* SEGACT,mchelm
  71. C* IF (mchelm.titche.NE.'CONTRAINTES') THEN
  72. C* MOTERR(1:16) = 'CONTRAINTES '
  73. C* CALL ERREUR(291)
  74. C* RETURN
  75. C* ENDIF
  76.  
  77. C- 2 EME CHAMP/ELEMENT (FACULTATIF)
  78. C
  79. CALL LIROBJ('MCHAML ',IPIN,0,irt1)
  80. IF (IERR.NE.0) RETURN
  81. IPCHA2=0
  82. IF (irt1 .EQ. 1) THEN
  83. CALL ACTOBJ('MCHAML ',IPIN,1)
  84. CALL REDUAF(IPIN,IPMODL,IPCHA2,0,IR,KER)
  85. IF(IR .NE. 1) CALL ERREUR(KER)
  86. IF(IERR .NE. 0) RETURN
  87. ENDIF
  88.  
  89. C- 3 EME CHAMP/ELEMENT (FACULTATIF)
  90. C
  91. CALL LIROBJ('MCHAML',IPIN,0,irt1)
  92. IF (IERR.NE.0) RETURN
  93. IPCHA3=0
  94. IF (irt1 .EQ. 1) THEN
  95. CALL ACTOBJ('MCHAML ',IPIN,1)
  96. CALL REDUAF(IPIN,IPMODL,IPCHA3,0,IR,KER)
  97. IF(IR .NE. 1) CALL ERREUR(KER)
  98. IF(IERR .NE. 0) RETURN
  99. ENDIF
  100. C
  101. IF (IPCHA2.NE.0 .OR. IPCHA3.NE.0) THEN
  102. CALL RNGCHA(IPCHA2, IPCHA3,
  103. & 'CARACTERISTIQUES', 'MATRICE DE HOOKE',
  104. & IPCHE2, IPCHE3)
  105. IF(IERR.NE.0) RETURN
  106. IF (IPCHE3.EQ.0) THEN
  107. IMAT = 1
  108. ELSE
  109. IMAT = 2
  110. ENDIF
  111. ELSE
  112. IMAT = 0
  113. IPCHE2 = 0
  114. IPCHE3 = 0
  115. ENDIF
  116. IRET = 0
  117.  
  118.  
  119. CALL BSIGMP(IPMODL,IPCHE1,IPCHE2,IPCHE3,IMAT,
  120. & IPCHP4,IRET,NOER)
  121. if (noer.eq.195) goto 30
  122. C
  123. IF (IERR.NE.0 .OR. IRET.NE.1) RETURN
  124. GOTO 20
  125. C_______________________________________________________________________
  126. C
  127. C CAS DES MODELES CHARGEMENT PRESSION
  128. C_______________________________________________________________________
  129. C
  130. 10 CONTINUE
  131. C
  132. C- 1 ER CHAMP/ELEMENT
  133. C
  134. CALL LIROBJ('MCHAML ',IPIN,1,irt1)
  135. IF(IERR .NE. 0) RETURN
  136. CALL ACTOBJ('MCHAML ',IPIN,1)
  137. CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER)
  138. IF(IR .NE. 1) CALL ERREUR(KER)
  139. IF(IERR .NE. 0) RETURN
  140. C
  141. C- 2 EME CHAMP/ELEMENT (FACULTATIF)
  142. C
  143. CALL LIROBJ('MCHAML ',IPIN,0,irt1)
  144. IF (IERR.NE.0) RETURN
  145. IPCHA2=0
  146. IF (irt1 .EQ. 1) THEN
  147. CALL ACTOBJ('MCHAML ',IPIN,1)
  148. CALL REDUAF(IPIN,IPMODL,IPCHA2,0,IR,KER)
  149. IF(IR .NE. 1) CALL ERREUR(KER)
  150. IF(IERR .NE. 0) RETURN
  151. ENDIF
  152. C
  153. C ON TRIE LES MCHAML
  154. C
  155. IF (IPCHA2.EQ.0) THEN
  156. MCHELM=IPCHA1
  157. IF (MCHELM.TITCHE.EQ.'CARACTERISTIQUES') THEN
  158. IPCHE2=IPCHA1
  159. IPCHE1=0
  160. ELSE IF (MCHELM.TITCHE.EQ.'CONTRAINTES') THEN
  161. IPCHE2=0
  162. IPCHE1=IPCHA1
  163. ELSE
  164. MOTERR(1:8)='CARACTER'
  165. MOTERR(9:16)='CONTRAIN'
  166. CALL ERREUR(109)
  167. RETURN
  168. ENDIF
  169. ELSE
  170. CALL RNGCHA(IPCHA1,IPCHA2,'CONTRAINTES', 'CARACTERISTIQUES',
  171. & IPCHE1,IPCHE2)
  172. IF (IPCHE1.EQ.0) THEN
  173. MOTERR(1:16)='CONTRAINTES '
  174. CALL ERREUR(565)
  175. RETURN
  176. ENDIF
  177. IF (IPCHE2.EQ.0) THEN
  178. MOTERR(1:16)='CARACTERISTIQUES'
  179. CALL ERREUR(565)
  180. RETURN
  181. ENDIF
  182. ENDIF
  183. C
  184. CALL FEQPR(IPMODL,IPCHE1,IPCHE2,IPCHP4,IRET)
  185. IF (IERR.NE.0 .OR. IRET.NE.1) RETURN
  186. C_______________________________________________________________________
  187. C
  188. 20 CONTINUE
  189. C
  190. C- ATTRIBUTION D'UNE NATURE DISCRETE AU CHPO QUI SORT
  191. C
  192. MCHPOI = IPCHP4
  193. JATTRI(1) = 2
  194. C
  195. CALL ACTOBJ('CHPOINT ',IPCHP4,1)
  196. CALL ECROBJ('CHPOINT ',IPCHP4)
  197. C
  198. RETURN
  199.  
  200. 30 continue
  201. * erreur changement de signe du jacobien si optio noer on rend un entier
  202. call ecrent(noer)
  203. call soucis(noer)
  204.  
  205. END
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  

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