Télécharger bsigma.eso

Retour à la liste

Numérotation des lignes :

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

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