Télécharger bsigma.eso

Retour à la liste

Numérotation des lignes :

bsigma
  1. C BSIGMA SOURCE JK148537 23/08/21 21:15:04 11723
  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. IMAT = 0
  102. IPCHE2 = 0
  103. IPCHE3 = 0
  104. IF (IPCHA2.NE.0 .OR. IPCHA3.NE.0) THEN
  105. mchelm = ipcha2
  106. if (titche(1:16).eq.'CARACTERISTIQUES'.or.
  107. & titche(1:16).eq.'MATRICE DE HOOKE') then
  108. CALL RNGCHA(IPCHA2, IPCHA3,
  109. & 'CARACTERISTIQUES', 'MATRICE DE HOOKE',
  110. & IPCHE2, IPCHE3)
  111. IF(IERR.NE.0) RETURN
  112. else
  113. ipche2 = ipcha2
  114. endif
  115.  
  116. IF (IPCHE3.EQ.0) THEN
  117. IMAT = 1
  118. ELSE
  119. IMAT = 2
  120. ENDIF
  121. ELSE
  122. IMAT = 0
  123. IPCHE2 = 0
  124. IPCHE3 = 0
  125. ENDIF
  126. IRET = 0
  127.  
  128.  
  129. CALL BSIGMP(IPMODL,IPCHE1,IPCHE2,IPCHE3,IMAT,
  130. & IPCHP4,IRET,NOER)
  131. if (noer.eq.195) goto 30
  132. C
  133. IF (IERR.NE.0 .OR. IRET.NE.1) RETURN
  134. GOTO 20
  135. C_______________________________________________________________________
  136. C
  137. C CAS DES MODELES CHARGEMENT PRESSION
  138. C_______________________________________________________________________
  139. C
  140. 10 CONTINUE
  141. C
  142. C- 1 ER CHAMP/ELEMENT
  143. C
  144. CALL LIROBJ('MCHAML ',IPIN,1,irt1)
  145. IF(IERR .NE. 0) RETURN
  146. CALL ACTOBJ('MCHAML ',IPIN,1)
  147. CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER)
  148. IF(IR .NE. 1) CALL ERREUR(KER)
  149. IF(IERR .NE. 0) RETURN
  150. C
  151. C- 2 EME CHAMP/ELEMENT (FACULTATIF)
  152. C
  153. CALL LIROBJ('MCHAML ',IPIN,0,irt1)
  154. IF (IERR.NE.0) RETURN
  155. IPCHA2=0
  156. IF (irt1 .EQ. 1) THEN
  157. CALL ACTOBJ('MCHAML ',IPIN,1)
  158. CALL REDUAF(IPIN,IPMODL,IPCHA2,0,IR,KER)
  159. IF(IR .NE. 1) CALL ERREUR(KER)
  160. IF(IERR .NE. 0) RETURN
  161. ENDIF
  162. C
  163. C ON TRIE LES MCHAML
  164. C
  165. IF (IPCHA2.EQ.0) THEN
  166. MCHELM=IPCHA1
  167. IF (MCHELM.TITCHE.EQ.'CARACTERISTIQUES') THEN
  168. IPCHE2=IPCHA1
  169. IPCHE1=0
  170. ELSE IF (MCHELM.TITCHE.EQ.'CONTRAINTES') THEN
  171. IPCHE2=0
  172. IPCHE1=IPCHA1
  173. ELSE
  174. MOTERR(1:24)='CARACTERISTIQUES'
  175. MOTERR(25:48)='CONTRAINTES'
  176. CALL ERREUR(109)
  177. RETURN
  178. ENDIF
  179. ELSE
  180. CALL RNGCHA(IPCHA1,IPCHA2,'CONTRAINTES', 'CARACTERISTIQUES',
  181. & IPCHE1,IPCHE2)
  182. IF (IPCHE1.EQ.0) THEN
  183. MOTERR(1:32)='CONTRAINTES'
  184. CALL ERREUR(565)
  185. RETURN
  186. ENDIF
  187. IF (IPCHE2.EQ.0) THEN
  188. MOTERR(1:32)='CARACTERISTIQUES'
  189. CALL ERREUR(565)
  190. RETURN
  191. ENDIF
  192. ENDIF
  193. C
  194. CALL FEQPR(IPMODL,IPCHE1,IPCHE2,IPCHP4,IRET)
  195. IF (IERR.NE.0 .OR. IRET.NE.1) RETURN
  196. C_______________________________________________________________________
  197. C
  198. 20 CONTINUE
  199. MCHPOI = IPCHP4
  200. C
  201. CALL ACTOBJ('CHPOINT ',IPCHP4,1)
  202. CALL ECROBJ('CHPOINT ',IPCHP4)
  203. C
  204. RETURN
  205.  
  206. 30 continue
  207. * erreur changement de signe du jacobien si optio noer on rend un entier
  208. call ecrent(noer)
  209. call soucis(noer)
  210.  
  211. END
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  

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