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