Télécharger mhybr.eso

Retour à la liste

Numérotation des lignes :

  1. C MHYBR SOURCE GF238795 18/02/05 21:15:31 9726
  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. INTEGER IPCHEL
  74. CHARACTER*8 TAPIND,TYPOBJ,CHARIN,CHARRE,LETYPE,LENOM
  75. CHARACTER*5 MCLE(3)
  76. CHARACTER*5 MOMO
  77. DATA NCLE /3/
  78. DATA MCLE /'DARCY','MASSE','LUMP '/
  79. CALL LIRMOT(MCLE,NCLE,ICLE,0)
  80. *
  81. * Initialisations
  82. *
  83. ILUMP = 0
  84. IPCHEL = 0
  85. IVALIN = 0
  86. XVALIN = 0.D0
  87. LOGIN = .TRUE.
  88. IOBIN = 0
  89. TAPIND = 'MOT '
  90. TYPOBJ = 'MAILLAGE'
  91. *
  92. * Lecture du MMODEL
  93. *
  94. CALL LIROBJ('MMODEL',IPMODE,1,IRET)
  95. IF (IERR.NE.0) RETURN
  96. MMODEL = IPMODE
  97. *
  98. * Lecture de la TABLE domaine
  99. *
  100. CALL LEKMOD(MMODEL,IPTABL,INEFMD)
  101. CHARIN = 'MAILLAGE'
  102. CALL LEKTAB(IPTABL,CHARIN, IOBRE)
  103. IF (IERR.NE.0) RETURN
  104. IPGEOM = IOBRE
  105. CALL LEKTAB(IPTABL,'ELTFA',IOBRE)
  106. IF (IERR.NE.0) RETURN
  107. IELTFA = IOBRE
  108. *
  109. * Lecture eventuelle du CHAMELEM de caracteristiques materielles
  110. *
  111. II=0
  112. IF(ICLE.NE.2)II=1
  113. CALL LIROBJ('MCHAML',IPIN,II,IRCHEL)
  114. IF (IERR.NE.0) RETURN
  115. IF (IRCHEL .EQ. 1) THEN
  116. CALL REDUAF(IPIN,IPMODE,IPCHEL,0,IR,KER)
  117. IF(IR .NE. 1) CALL ERREUR(KER)
  118. IF(IERR .NE. 0) RETURN
  119. ENDIF
  120. MCHELM = IPCHEL
  121. *
  122. * Lecture eventuelle des indications pour l'option LUMP
  123. *
  124. IF(ICLE.EQ.3)ILUMP=1
  125. IF(ICLE.EQ.1)THEN
  126. IRET=0
  127. CALL LIRCHA(MOMO,0,IRET)
  128. IF(IRET.GT.0) THEN
  129. IF(MOMO(1:4).NE.'LUMP')THEN
  130. MOTERR(1:4)=MOMO(1:4)
  131. CALL ERREUR(7)
  132. RETURN
  133. ENDIF
  134. ILUMP=1
  135. ENDIF
  136. ENDIF
  137. *
  138. *
  139. *- Controle de la formulation
  140. * Recuperation des pointeurs ELTFA pour les zones ou DARCY est defini
  141. *
  142. *
  143. SEGACT MMODEL
  144. NSOUS = KMODEL(/1)
  145. SEGINI IPMAHY
  146. IDARCY = 0
  147. DO 10 ISOUS=1,NSOUS
  148. IMODEL = KMODEL(ISOUS)
  149. SEGACT IMODEL
  150. LETYPE = FORMOD(1)
  151. IF (LETYPE.EQ.'DARCY') THEN
  152. IDARCY = IDARCY + 1
  153. IF(NSOUS.EQ.1) THEN
  154. IPT3=IELTFA
  155. ELSE
  156. IPT2= IELTFA
  157. SEGACT IPT2
  158. IPT3=IPT2.LISOUS(ISOUS)
  159. ENDIF
  160. MAHYBR(ISOUS) = IPT3
  161. ENDIF
  162. SEGDES IMODEL
  163. 10 CONTINUE
  164. SEGDES MMODEL
  165. IF (IDARCY.EQ.0) THEN
  166. MOTERR = LETYPE
  167. CALL ERREUR(193)
  168. GOTO 100
  169. ENDIF
  170. *
  171. IF(ICLE.NE.2)THEN
  172. *
  173. *- Controle du MCHAML
  174. *
  175. SEGACT MCHELM
  176. *
  177. * Test du sous type du MCHAML
  178. *
  179. LETYPE = TITCHE
  180. IF (LETYPE.NE.'CARACTER') THEN
  181. MOTERR = 'CARACTERISTIQUES'
  182. CALL ERREUR(291)
  183. SEGDES MCHELM
  184. GOTO 100
  185. ENDIF
  186. *
  187. * Il manque les CARACTERISTIQUES d'une ou plusieurs parties du MODELE
  188. *
  189. NBMAIC = IMACHE(/1)
  190. IF (NSOUS.GT.NBMAIC) THEN
  191. CALL ERREUR(404)
  192. SEGDES MCHELM
  193. GOTO 100
  194. ENDIF
  195. *
  196. * Test du support du MCHAML
  197. *
  198. ISUP = 0
  199. ICOND = 0
  200. CALL QUESUP(IPMODE,IPCHEL,ISUP,ICOND,IRET1,IRET2)
  201. IF (IRET1.GT.3) THEN
  202. MOTERR(1:8) = LETYPE
  203. CALL ERREUR(124)
  204. SEGDES MCHELM
  205. GOTO 100
  206. ENDIF
  207. *
  208. * Si support aux noeuds -> aux points de GAUSS
  209. *
  210. IF (IRET1.EQ.1) THEN
  211. CALL CHASUP(IPMODE,IPCHEL,IPCHE1,IRET,ISUP)
  212. IF (IRET.NE.0) THEN
  213. CALL ERREUR(IRET)
  214. SEGDES MCHELM
  215. IRET1 = 0
  216. GOTO 100
  217. ENDIF
  218. ELSE
  219. IPCHE1 = IPCHEL
  220. ENDIF
  221. SEGDES MCHELM
  222. *
  223. * Construction de la matrice masse hybride
  224. *
  225. CALL MHYBR1(IPMODE,IPCHE1,IPMAHY,IPRIGI,IPGEOM,ILUMP)
  226. ELSE
  227. IRET1 = 0
  228. IPCHE1 = 0
  229. IF(IRCHEL.NE.0)CALL ERREUR(21)
  230. CALL MHYBR1(IPMODE,IPCHE1,IPMAHY,IPRIGI,IPGEOM,ILUMP)
  231. ENDIF
  232. IF (IERR.EQ.0) CALL ECROBJ('RIGIDITE',IPRIGI)
  233. *
  234. * Ménage
  235. *
  236. 100 CONTINUE
  237. IF (IRET1.EQ.1) THEN
  238. CALL DTCHAM(IPCHE1)
  239. ENDIF
  240. SEGSUP IPMAHY
  241. RETURN
  242. END
  243.  
  244.  
  245.  
  246.  

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