Download manuri.eso
Back to the list
1 : C MANURI SOURCE BP208322 12/03/08 21:15:03 7293
2 : SUBROUTINE MANURI
3 : ************************************************************************
4 : *
5 : * M A N U R I
6 : * -----------
7 : *
8 : * SOUS-PROGRAMME ASSOCIE A L'OPTION "RIGIDITE" DE L'OPERATEUR
9 : * "MANUEL".
10 : *
11 : * FONCTION:
12 : * ---------
13 : *
14 : * CREER, EN LISANT EXPLICITEMENT SES COMPOSANTS, UN OBJET 'RIGIDITE'
15 : * DANS LEQUEL TOUTES LES MATRICES DE RIGIDITE ELEMENTAIRES SONT LES
16 : * MEMES.
17 : * CAS PARTICULIER FREQUENT: LA 'RIGIDITE' S'APPUIE SUR UN SEUL
18 : * ELEMENT GEOMETRIQUE ET ELLE NE CONTIENDRA QU'UNE SEULE MATRICE
19 : * ELEMENTAIRE.
20 : *
21 : * PHRASE D'APPEL (EN GIBIANE):
22 : * ----------------------------
23 : *
24 : * AA = MANUEL RIGIDITE (BB) CC
('DUAL' ) ('ANTI') ;
25 : *
26 : * LES PARENTHESES INDIQUANT DES OPERANDES FACULTATIFS ET LES
27 : * CROCHETS DES OPERANDES POUVANT ETRE REPETES.
28 : *
29 : * OPERANDES ET RESULTATS:
30 : * -----------------------
31 : *
32 : * BB 'MOT ' SOUS-TYPE DE LA 'RIGIDITE' QUE L'ON CREE.
33 : * CE SOUS-TYPE S'ECRIVANT SUR 8 CARACTERES, ET
34 : * UN 'MOT' NE COMPORTANT ACTUELLEMENT QUE 4
35 : * CARACTERES, ON DOIT PROVISOIREMENT FOURNIR
36 : * NON PAS 1 MAIS 2 MOTS "BB1" ET "BB2".
37 : * CC 'MAILLAGE' SUPPORT GEOMETRIQUE.
38 : * DD 'LISTMOTS' CONTIENT LES NOMS DES COMPOSANTES POUR UN
39 : * NOEUD D'UN ELEMENT DE "CC".
40 : * SI TOUS LES NOEUDS D'UN MEME ELEMENT DE "CC"
41 : * N'ONT PAS LES MEMES COMPOSANTES, ON DONNE
42 : * PLUSIEURS 'LISTMOTS' (PLUS PRECISEMENT
43 : * AUTANT DE 'LISTMOTS' QU'IL Y A DE NOEUDS
44 : * PAR ELEMENT).
45 : C+PP
46 : C ILS PEUVENT ETRE CONTENUS DANS UNE TABLE
47 : C (IDEM POUR FF)
48 : C+PP
49 : * FF 'LISTMOTS' CONTIENT LES NOMS DES INCONNUES DUALES
50 : * AUTANT DE 'LISTMOTS' QUE POUR LES INCONNUES
51 : * EE 'LISTREEL' SI 1 SEUL "EE" EST FOURNI:
52 : * IL CONTIENT TOUS LES TERMES DU TRIANGLE
53 : * INFERIEUR DE LA MATRICE ELEMENTAIRE, LIGNE
54 : * PAR LIGNE.
55 : * SI PLUSIEURS "EE" SONT FOURNIS:
56 : * IL DOIT Y AVOIR AUTANT DE 'LISTREEL' QU'IL
57 : * Y A DE LIGNES DANS LA MATRICE ELEMENTAIRE,
58 : * LE N-IEME 'LISTREEL' DECRIVANT LA N-IEME
59 : * LIGNE DE LA MATRICE DU BORD GAUCHE JUSQU'A
60 : * LA DIAGONALE.
61 : * AA 'RIGIDITE' OBJET CREE.
62 : *
63 : * EXEMPLE D'ENTREE DE LA MATRICE ELEMENTAIRE:
64 : *
65 : * | A B C |
66 : * | B D E |
67 : * | C E F |
68 : *
69 : * PEUT ETRE DONNEE PAR: (PROG A B D C E F)
70 : * OU BIEN PAR: (PROG A) (PROG B D) (PROG C E F)
71 : *
72 : * "PROG" ETANT L'OPERATEUR DE CREATION D'UN 'LISTREEL'.
73 : *
74 : * LEXIQUE: (ORDRE ALPHABETIQUE)
75 : * --------
76 : *
77 : * IPELEM ENTIER POINTEUR DU SUPPORT GEOMETRIQUE "CC".
78 : * IPRIGI ENTIER POINTEUR DE LA 'RIGIDITE' "AA".
79 : * LETYPE ENTIER SOUS-TYPE DE L'OBJET 'RIGIDITE' (CONTIENT UNE
80 : * CHAINE DE CARACTERES).
81 : * MTEMP3 SEGMENT CONTIENT LE(S) POINTEUR(S) DU (DES) 'LISTMOTS'
82 : * "DD".
83 : * MTEMP4 SEGMENT CONTIENT LE(S) POINTEUR(S) DU (DES) 'LISTREEL'
84 : * "EE".
85 : *
86 : * SOUS-PROGRAMMES APPELES:
87 : * ------------------------
88 : *
89 : * ECRIRE, LIRE, LIRMO8, MANUR1.
90 : *
91 : * REMARQUES:
92 : * ----------
93 : *
94 : * ACTUELLEMENT, L'OBJET 'MAILLAGE' "CC" DOIT CONTENIR DES ELEMENTS
95 : * GEOMETRIQUES TOUS DE MEME TYPE.
96 : *
97 : * AUTEUR, DATE DE CREATION:
98 : * -------------------------
99 : *
100 : * PASCAL MANIGOT 19 FEVRIER 1985
101 : * Lionel VIVAN 12 juin 1991, ajout du mot clé ANTI
102 : * Michel BULIK 29 novembre 1995, ajout du mot clé QUEL
103 : * Stephane Gounand 08 mai 2011, ajout de la syntaxe MANU RIGI
104 : * CHPO1 permettant de créer une rigidité
105 : * diagonale
106 : * Benoit Prabel 16 fevrier 2012 : ajout des options COLOnnes
107 : * et LIGNes pour la syntaxe avec un chpoint
108 : * + possibilité rigidité vide
109 : *
110 : * LANGAGE:
111 : * --------
112 : *
113 : * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS
114 : *
115 : ************************************************************************
116 : *
117 : IMPLICIT INTEGER(I-N)
118 : -INC CCOPTIO
119 : -INC SMRIGID
120 : C+PP
121 : -INC SMTABLE
122 : CHARACTER*8 TYPOBJ,CH0,CH1
123 : REAL*8 X0,X1
124 : INTEGER I1
125 : LOGICAL L0,L1
126 : C+PP
127 : *
128 : SEGMENT /MTEMP3/ (ILMOTS(0)),MTEM3.MTEMP3
129 : SEGMENT /MTEMP4/ (ILREEL(0))
130 : *
131 : PARAMETER (INFINI = 9999)
132 : *
133 : CHARACTER*8 LETYPE,CTYP
134 : CHARACTER*4 MODUA(1),MOTYP(2),MOMOT(1)
135 : CHARACTER*4 MOCLE(3)
136 : *
137 : DATA MODUA(1) /'DUAL'/
138 : DATA MOTYP(1),MOTYP(2) /'ANTI','QUEL'/
139 : DATA MOMOT(1) /'TYPE'/
140 : DATA MOCLE(1),MOCLE(2),MOCLE(3) /'DIAG','COLO','LIGN'/
141 : C
142 : c
143 : C=== Syntaxe b : Rig1 = MANU RIGI (mocle) CHPO1 (...) ====================
144 : c
145 : *
146 : * -- LECTURE EVENTUELLE DU MOT CLE : DIAG ou COLO ou LIGN ... --
147 : *
148 : ICLE = 0
148 : CALL LIRMOT(MOCLE,3,ICLE,0)
149 : if(iimpi.ge.1) write(IOIMP,*) 'ICLE=',ICLE
150 : *
151 : * -- LECTURE DU CHPOINT ? --
152 : *
153 : IF (ICLE.NE.0) THEN
154 : c cas ou on a lu DIAG, COLO ou LIGN
154 : CALL LIROBJ('CHPOINT ',MCHPOI,1,IRET)
155 : IF (IERR.NE.0) RETURN
156 : ELSE
157 : c si aucun mot clé mais présence d'un chpoint, option DIAG par défaut
157 : CALL QUETYP(CTYP,0,IRETOU)
158 : IF (IRETOU.EQ.0) THEN
158 : c CALL ERREUR(533)
159 : c si rien du tout, CREATION D'UNE RIGIDITE VIDE
160 : NRIGEL=0
161 : segini,MRIGID
162 : IPRIGI=MRIGID
163 : MTYMAT='MANUELLE'
164 : IFORIG= IFOMOD
165 : ICHOLE = 0
166 : IMGEO1 = 0
167 : IMGEO2 = 0
168 : IFORIG = 0
169 : c ISUPEQ,JRCOND,JRDEPP,JRDEPD = 0
170 : c JRELIM,JRGARD,JRTOT,IMLAG = 0
171 : c IPROFO,IVECRI = 0
172 : segdes,MRIGID
172 : CALL ECROBJ ('RIGIDITE',IPRIGI)
173 : RETURN
174 : ENDIF
175 : IF(CTYP.EQ.'CHPOINT ') THEN
176 : ICLE = 1
176 : CALL LIROBJ(CTYP,MCHPOI,1,IRET)
177 : IF (IERR.NE.0) RETURN
178 : ENDIF
179 : ENDIF
180 : *
181 : * -- CREATION RIGIDITE DEPUIS UN CHPOINT --
182 : *
183 : IF (ICLE.NE.0) THEN
184 : IF (ICLE.eq.1) THEN
185 : c rigidite diagonale
185 : CALL KOPDIR(MCHPOI,MRIGID)
186 : ELSE
187 : c rigidite colonne ou ligne
187 : CALL RICOLO(MCHPOI,ICLE,MRIGID)
188 : ENDIF
189 : IF (IERR.NE.0) RETURN
189 : CALL ECROBJ('RIGIDITE',MRIGID)
190 : RETURN
191 : ENDIF
192 : c
193 : c
194 : C=== Syntaxe a : Rig1 = MANU RIGI (TYPE mot1) GEO1 LMOT1 (...) LREEL1 ====
195 : c
196 : *
197 : * -- LECTURE DU SOUS-TYPE DE LA "RIGIDITE" A CREER --
198 : *
199 : ITYP = 0
199 : CALL LIRMOT(MOMOT,1,ITYP,0)
200 : IF(ITYP.EQ.1) THEN
201 : ICODE = 1
201 : CALL LIRCHA (LETYPE,ICODE,IRETOU)
202 : IF (IERR .NE. 0) RETURN
203 : ELSE
204 : C ... Si on n'a rien trouvé, on met les blancs dedans,
205 : C sinon il y a des cochonneries ...
206 : LETYPE=' '
207 : ENDIF
208 : *
209 : * -- LECTURE DU SUPPORT GEOMETRIQUE --
210 : *
210 : CALL LIROBJ('POINT ',KPOINT,0,IRETOU)
211 : IF(IRETOU.NE.0) THEN
211 : CALL CRELEM(KPOINT)
212 : IPELEM=KPOINT
213 : ELSE
214 : ICODE = 1
214 : CALL LIROBJ ('MAILLAGE',IPELEM,ICODE,IRETOU)
215 : IF (IERR .NE. 0) RETURN
216 : ENDIF
217 : *
218 : * -- LECTURE DU (OU DES) "LISTMOTS" CONTENANT LES NOMS DES
219 : * COMPOSANTES DES NOEUDS D'UN ELEMENT DU SUPPORT GEOMETRIQUE --
220 : *
221 : SEGINI,MTEMP3
222 : IINCO=MTEMP3
223 : C+PP
223 : CALL LIROBJ ('TABLE',MTABLE,0,IRETOU)
224 : IF (IRETOU.EQ.1)THEN
225 : DO IE1=1,INFINI
226 : TYPOBJ=' '
226 : CALL ACCTAB(MTABLE,'ENTIER',IE1,X0,CH0,L0,IOBIN,
227 : $ TYPOBJ ,I1 ,X1,CH1,L1,IPLMOT)
228 : IF (TYPOBJ .EQ. 'LISTMOTS')THEN
229 : ILMOTS(**) = IPLMOT
230 : ELSE
231 : IF (IE1 .EQ. 1)THEN
231 : CALL ERREUR(314)
232 : SEGSUP MTEMP3
233 : RETURN
234 : ENDIF
235 : * --> SORTIE DE BOUCLE N.100
236 : GOTO 102
237 : ENDIF
238 : ENDDO
239 : ENDIF
240 : C+PP
241 : ICODE = 1
242 : DO 100 IB100=1,INFINI
242 : CALL LIROBJ ('LISTMOTS',IPLMOT,ICODE,IRETOU)
243 : IF(IERR.NE.0) THEN
244 : SEGSUP MTEMP3
245 : RETURN
246 : ENDIF
247 : IF (IRETOU .EQ. 1) THEN
248 : ILMOTS(**) = IPLMOT
249 : ELSE
250 : * --> SORTIE DE BOUCLE N.100
251 : GOTO 102
252 : END IF
253 : ICODE = 0
254 : 100 CONTINUE
255 : * END DO
256 : 102 CONTINUE
257 : SEGDES,MTEMP3
258 : *
259 : * -- LECTURE DU (OU DES) "LISTMOTS" CONTENANT LES NOMS DES
260 : * DUALES
261 : *
262 : IDUAL=0
262 : CALL LIRMOT(MODUA,1,IDU,0)
263 : IF (IDU.EQ.0) GOTO 400
264 : SEGINI,MTEM3
265 : C+PP
265 : CALL LIROBJ ('TABLE',MTABLE,0,IRETOU)
266 : IF (IRETOU.EQ.1)THEN
267 : DO IE1=1,INFINI
268 : TYPOBJ=' '
268 : CALL ACCTAB(MTABLE,'ENTIER',IE1,X0,CH0,L0,IOBIN,
269 : $ TYPOBJ ,I1 ,X1,CH1,L1,IPLMOT)
270 : IF (TYPOBJ .EQ. 'LISTMOTS')THEN
271 : MTEM3.ILMOTS(**) = IPLMOT
272 : ELSE
273 : IF (IE1 .EQ. 1)THEN
273 : CALL ERREUR(314)
274 : SEGSUP MTEMP3,MTEM3
275 : RETURN
276 : ENDIF
277 : GOTO 302
278 : ENDIF
279 : ENDDO
280 : ENDIF
281 : C+PP
282 : ICODE = 1
283 : DO 300 IB300=1,INFINI
283 : CALL LIROBJ ('LISTMOTS',IPLMOT,ICODE,IRETOU)
284 : IF(IERR.NE.0) THEN
285 : SEGSUP MTEMP3,MTEM3
286 : RETURN
287 : ENDIF
288 : IF (IRETOU .EQ. 1) THEN
289 : MTEM3.ILMOTS(**) = IPLMOT
290 : ELSE
291 : GOTO 302
292 : END IF
293 : ICODE = 0
294 : 300 CONTINUE
295 : 302 CONTINUE
296 :
297 : SEGACT MTEMP3
298 : IF (ILMOTS(/1).NE.MTEM3.ILMOTS(/1)) THEN
299 : SEGSUP MTEMP3
300 : SEGSUP MTEM3
300 : CALL ERREUR(730)
301 : RETURN
302 : ENDIF
303 : IDUAL=MTEM3
304 : SEGDES MTEM3
305 : SEGDES MTEMP3
306 : *
307 : * Lecture du mot clé 'ANTI' ou 'QUEL'
308 : *
309 : 400 CONTINUE
310 : IAN = 0
310 : CALL LIRMOT(MOTYP,2,IAN,0)
311 : IANTI = IAN
312 : *
313 : * -- LECTURE DU (OU DES) "LISTREEL" CONTENANT LA MATRICE
314 : * ELEMENTAIRE DE RIGIDITE --
315 : *
316 : 500 CONTINUE
317 : SEGINI,MTEMP4
318 : ICODE = 1
319 : DO 200 IB200=1,INFINI
319 : CALL LIROBJ ('LISTREEL',IPLREE,ICODE,IRETOU)
320 : IF(IERR.NE.0) THEN
321 : SEGSUP MTEMP3,MTEM3
322 : SEGSUP MTEMP4
323 : RETURN
324 : ENDIF
325 : IF (IRETOU .EQ. 1) THEN
326 : ILREEL(**) = IPLREE
327 : ELSE
328 : * --> SORTIE DE BOUCLE N.200
329 : GOTO 202
330 : END IF
331 : ICODE = 0
332 : 200 CONTINUE
333 : * END DO
334 : 202 CONTINUE
335 : SEGDES,MTEMP4
336 : *
337 : * -- CREATION DE LA "RIGIDITE" --
338 : *
338 : CALL MANUR1 (LETYPE,IPELEM,IINCO,IDUAL,MTEMP4,IPRIGI,IANTI)
339 : IF (IERR .NE. 0) RETURN
340 : *
341 : * SUPPRESSION DES SEGMENTS DE TRAVAIL:
342 : MTEMP3=IINCO
343 : SEGSUP MTEMP3
344 : IF (IDUAL.NE.0) THEN
345 : MTEMP3=IDUAL
346 : SEGSUP MTEMP3
347 : ENDIF
348 : SEGSUP,MTEMP4
349 : *
349 : CALL ECROBJ ('RIGIDITE',IPRIGI)
350 : *
351 : END
352 :
353 :
354 :
355 :
356 :
357 :
358 :