Télécharger mhybr.eso

Retour à la liste

Numérotation des lignes :

  1. C MHYBR SOURCE CB215821 16/12/05 21:40:04 9237
  2. SUBROUTINE MHYBR
  3. C-----------------------------------------------------------------------
  4. C Cette subroutine permet de creer une matrice de type masse dans le
  5. C cadre d'une formulation variationnelle mixte.
  6. C-----------------------------------------------------------------------
  7. C
  8. C
  9. C-----------------------------------------------------------------------
  10. C OPTION DARCY
  11. C t--> =-1 -->
  12. C La matrice en question integre shp * k * shp
  13. C
  14. C Dans cette option, l'objet rigidite reçoit l'inverse de la matrice
  15. C Comme on ne se sert que de l'inverse de cette matrice, c'est cette
  16. C derniere qui est stockee dans l'objet rigidite.
  17. C
  18. C
  19. C---------------------------
  20. C Phrase d'appel (GIBIANE) :
  21. C---------------------------
  22. C
  23. C MHY1 = MHYB MMODEL CHMAT1 ('DARCY') ('LUMP');
  24. C
  25. C
  26. C
  27. C-----------------------------------------------------------------------
  28. C OPTION MASSE
  29. C t--> -->
  30. C La matrice en question integre shp * shp
  31. C
  32. C
  33. C Le resultat de l'integration est stocke dans l'objet rigidite
  34. C
  35. C---------------------------
  36. C Phrase d'appel (GIBIANE) :
  37. C---------------------------
  38. C
  39. C MHY1 = MHYB MMODEL 'MASSE' ;
  40. C
  41. C
  42. C------------------------
  43. C Operandes et resultat :
  44. C------------------------
  45. C
  46. C MHY1 : Matrice masse hybride
  47. C MMODEL : Objet modele specifiant la formulation
  48. C CHMAT1 : 'CHAMELEM' de sous type 'CARACTERISTIQUES'
  49. C
  50. C la table DOMAINE des connectivités est dans le modèle
  51. C-----------------------------------------------------------------------
  52. C
  53. C Langage : ESOPE + FORTRAN77
  54. C
  55. C Auteurs : 08/93 F.DABBENE
  56. C 12/94 F.DABBENE : Gestion des erreurs
  57. C 02/96 L.V.BENET : introduction de l'option 'MASSE'
  58. C
  59. C-----------------------------------------------------------------------
  60. IMPLICIT INTEGER(I-N)
  61. -INC CCOPTIO
  62. -INC SMCHAML
  63. -INC SMELEME
  64. -INC SMMODEL
  65. -INC SMTABLE
  66. *
  67. SEGMENT IPMAHY
  68. INTEGER MAHYBR(NSOUS)
  69. ENDSEGMENT
  70. *
  71. REAL*8 XVALIN,XVALRE
  72. LOGICAL LOGRE,LOGIN
  73. CHARACTER*8 TAPIND,TYPOBJ,CHARIN,CHARRE,LETYPE,LENOM
  74. CHARACTER*5 MCLE(3)
  75. CHARACTER*5 MOMO
  76. DATA NCLE /3/
  77. DATA MCLE /'DARCY','MASSE','LUMP '/
  78. CALL LIRMOT(MCLE,NCLE,ICLE,0)
  79. *
  80. * Initialisations
  81. *
  82. ILUMP= 0
  83. IVALIN = 0
  84. XVALIN = 0.D0
  85. LOGIN = .TRUE.
  86. IOBIN = 0
  87. TAPIND = 'MOT '
  88. TYPOBJ = 'MAILLAGE'
  89. *
  90. * Lecture du MMODEL
  91. *
  92. CALL LIROBJ('MMODEL',IPMODE,1,IRET)
  93. IF (IERR.NE.0) RETURN
  94. MMODEL = IPMODE
  95. *
  96. * Lecture de la TABLE domaine
  97. *
  98. CALL LEKMOD(MMODEL,IPTABL,INEFMD)
  99. CHARIN = 'MAILLAGE'
  100. CALL LEKTAB(IPTABL,CHARIN, IOBRE)
  101. IF (IERR.NE.0) RETURN
  102. IPGEOM = IOBRE
  103. CALL LEKTAB(IPTABL,'ELTFA',IOBRE)
  104. IF (IERR.NE.0) RETURN
  105. IELTFA = IOBRE
  106. *
  107. * Lecture eventuelle du CHAMELEM de caracteristiques materielles
  108. *
  109. II=0
  110. IF(ICLE.NE.2)II=1
  111. CALL LIROBJ('MCHAML',IPIN,II,IRCHEL)
  112. IF (IERR.NE.0) RETURN
  113. IF (IRCHEL .EQ. 1) THEN
  114. CALL REDUAF(IPIN,IPMODE,IPCHEL,0,IR,KER)
  115. IF(IR .NE. 1) CALL ERREUR(KER)
  116. IF(IERR .NE. 0) RETURN
  117. ENDIF
  118. MCHELM = IPCHEL
  119. *
  120. * Lecture eventuelle des indications pour l'option LUMP
  121. *
  122. IF(ICLE.EQ.3)ILUMP=1
  123. IF(ICLE.EQ.1)THEN
  124. IRET=0
  125. CALL LIRCHA(MOMO,0,IRET)
  126. IF(IRET.GT.0) THEN
  127. IF(MOMO(1:4).NE.'LUMP')THEN
  128. MOTERR(1:4)=MOMO(1:4)
  129. CALL ERREUR(7)
  130. RETURN
  131. ENDIF
  132. ILUMP=1
  133. ENDIF
  134. ENDIF
  135. *
  136. *
  137. *- Controle de la formulation
  138. * Recuperation des pointeurs ELTFA pour les zones ou DARCY est defini
  139. *
  140. *
  141. SEGACT MMODEL
  142. NSOUS = KMODEL(/1)
  143. SEGINI IPMAHY
  144. IDARCY = 0
  145. DO 10 ISOUS=1,NSOUS
  146. IMODEL = KMODEL(ISOUS)
  147. SEGACT IMODEL
  148. LETYPE = FORMOD(1)
  149. IF (LETYPE.EQ.'DARCY') THEN
  150. IDARCY = IDARCY + 1
  151. IF(NSOUS.EQ.1) THEN
  152. IPT3=IELTFA
  153. ELSE
  154. IPT2= IELTFA
  155. SEGACT IPT2
  156. IPT3=IPT2.LISOUS(ISOUS)
  157. ENDIF
  158. MAHYBR(ISOUS) = IPT3
  159. ENDIF
  160. SEGDES IMODEL
  161. 10 CONTINUE
  162. SEGDES MMODEL
  163. IF (IDARCY.EQ.0) THEN
  164. MOTERR = LETYPE
  165. CALL ERREUR(193)
  166. GOTO 100
  167. ENDIF
  168. *
  169. IF(ICLE.NE.2)THEN
  170. *
  171. *- Controle du MCHAML
  172. *
  173. SEGACT MCHELM
  174. *
  175. * Test du sous type du MCHAML
  176. *
  177. LETYPE = TITCHE
  178. IF (LETYPE.NE.'CARACTER') THEN
  179. MOTERR = 'CARACTERISTIQUES'
  180. CALL ERREUR(291)
  181. SEGDES MCHELM
  182. GOTO 100
  183. ENDIF
  184. *
  185. * Il manque les CARACTERISTIQUES d'une ou plusieurs parties du MODELE
  186. *
  187. NBMAIC = IMACHE(/1)
  188. IF (NSOUS.GT.NBMAIC) THEN
  189. CALL ERREUR(404)
  190. SEGDES MCHELM
  191. GOTO 100
  192. ENDIF
  193. *
  194. * Test du support du MCHAML
  195. *
  196. ISUP = 0
  197. ICOND = 0
  198. CALL QUESUP(IPMODE,IPCHEL,ISUP,ICOND,IRET1,IRET2)
  199. IF (IRET1.GT.3) THEN
  200. MOTERR(1:8) = LETYPE
  201. CALL ERREUR(124)
  202. SEGDES MCHELM
  203. GOTO 100
  204. ENDIF
  205. *
  206. * Si support aux noeuds -> aux points de GAUSS
  207. *
  208. IF (IRET1.EQ.1) THEN
  209. CALL CHASUP(IPMODE,IPCHEL,IPCHE1,IRET,ISUP)
  210. IF (IRET.NE.0) THEN
  211. CALL ERREUR(IRET)
  212. SEGDES MCHELM
  213. IRET1 = 0
  214. GOTO 100
  215. ENDIF
  216. ELSE
  217. IPCHE1 = IPCHEL
  218. ENDIF
  219. SEGDES MCHELM
  220. *
  221. * Construction de la matrice masse hybride
  222. *
  223. CALL MHYBR1(IPMODE,IPCHE1,IPMAHY,IPRIGI,IPGEOM,ILUMP)
  224. ELSE
  225. IRET1 = 0
  226. IPCHE1 = 0
  227. IF(IRCHEL.NE.0)CALL ERREUR(21)
  228. CALL MHYBR1(IPMODE,IPCHE1,IPMAHY,IPRIGI,IPGEOM,ILUMP)
  229. ENDIF
  230. IF (IERR.EQ.0) CALL ECROBJ('RIGIDITE',IPRIGI)
  231. *
  232. * Ménage
  233. *
  234. 100 CONTINUE
  235. IF (IRET1.EQ.1) THEN
  236. CALL DTCHAM(IPCHE1)
  237. ENDIF
  238. SEGSUP IPMAHY
  239. RETURN
  240. END
  241.  
  242.  
  243.  

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