Télécharger bsigma.eso

Retour à la liste

Numérotation des lignes :

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

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