1 : C SORMAT SOURCE JC220346 13/12/16 21:16:07 7884
2 : ************************************************************************
3 : * NOM : sormat.eso
4 : * DESCRIPTION : Sortie d'objets de type RIGIDITE/CHPOINT définissant
5 : * un problème physique sous forme matricielle
6 : * REFERENCES : - The Matrix Market Exchange Formats: Initial Design,
7 : * Boisvert R. F., Pozo R., Remington K. A. (Dec 1996)
8 : * - The Rutherford-Boeing Sparse Matrix Collection,
9 : * Duff I. S., Grimes R. G., Lewis G. L. (Sep 1997)
10 : ************************************************************************
11 : * HISTORIQUE : 7/06/2012 : JCARDO : création de la subroutine
12 : * HISTORIQUE : 4/12/2012 : JCARDO : ajout de la sortie RB
13 : * + formes ELEMEN et TRIANG
14 : * + mots-clés RHS, SOL et RES
15 : * HISTORIQUE :
16 : ************************************************************************
17 : * Prière de PRENDRE LE TEMPS DE COMPLÉTER LES COMMENTAIRES
18 : * en cas de modification de ce sous-programme afin de faciliter
19 : * la maintenance !
20 : ************************************************************************
21 : * APPELÉ PAR : opérateur SORTir (prsort.eso)
22 : * APPELLE : - subroutine SORMA1 => MM assemblée
23 : * - subroutine SORMA2 =>
24 : ************************************************************************
25 : * ENTRÉES :: aucune
26 : * SORTIES :: aucune (sur fichier uniquement)
27 : ************************************************************************
28 : * SYNTAXE (GIBIANE) :
29 : *
30 : * SORT 'MAT' MOT1 MOT2 RIG1
31 : * ('TITR' MOT3)
32 : * ('INCO')
33 : * ('GEOM')
34 : * ('FORC' CHP1)
35 : * ('CONN' CHP2)
36 : * ('RESU' CHP3)
37 : * ('SOLU' CHP4) ;
38 : *
39 : ************************************************************************
40 : SUBROUTINE SORMAT
41 :
42 : IMPLICIT INTEGER(I-N)
43 : IMPLICIT REAL*8(A-H,O-Z)
44 :
45 : EXTERNAL LONG
46 :
47 : -INC CCOPTIO
48 :
49 : -INC SMLMOTS
50 : -INC SMCHPOI
51 : -INC SMRIGID
52 : -INC SMMATRI
53 : -INC SMELEME
54 : -INC SMCOORD
55 :
56 : *
57 : * NPOTOT = nombre de noeuds distincts au total
58 : * NELTOT = nombre d'éléments au total
59 : * NINTOT = nombre d'indices au total
60 : * NVATOT = nombre de valeurs au total dans la matrice creuse
61 : * NBCOPR = nombre de composantes primales
62 : * NBCODU = nombre de composantes duales
63 : * NBPTOT = nombre d'inconnues primales au total
64 : * NBDTOT = nombre d'inconnues duales au total
65 : *
66 : *
67 : * DECLARATIONS DES SEGMENTS ET DES POINTEURS
68 : * ------------------------------------------
69 :
70 : * Stockage morse provenant de l'include SMMATRIK
71 : SEGMENT PMORS
72 : INTEGER IA(NTT+1)
73 : INTEGER JA(NJA)
74 : ENDSEGMENT
75 : SEGMENT IZA
76 : REAL*8 A(NBVA)
77 : ENDSEGMENT
78 : POINTEUR KMORS.PMORS,KMOR2.PMORS
79 : POINTEUR KIZA.IZA
80 :
81 : * Tableaux temporaires permettant de concatener des données avant
82 : * de les imprimer en un seul bloc
83 : SEGMENT MIDATA
84 : INTEGER IWRIT(NBWR)
85 : ENDSEGMENT
86 : SEGMENT MRDATA
87 : REAL*8 XWRIT(NBWR)
88 : ENDSEGMENT
89 :
90 : * Correspondance local/global pour les noeuds
91 : SEGMENT IPOG2L(NPOMAX)
92 :
93 : * Tableaux temporaires permettant de mémoriser les indices des
94 : * composantes primales/duales de chaque sous-matrice dans la liste
95 : * globale IMIK/IDUA
96 : SEGMENT MCONUM(NRIGEL)
97 : SEGMENT ICONUM
98 : INTEGER IICOPR(NLIGRP),IICODU(NLIGRD)
99 : ENDSEGMENT
100 :
101 : * Tableaux indiquant le numéro du d.d.l. primal/dual en fonction du
102 : * numéro du noeud et du numéro de la composante
103 : POINTEUR IDDLPR.MINCPO,IDDLDU.MINCPO
104 :
105 : * Maillage répertoriant tous les noeuds supportant la matrice
106 : POINTEUR MNOEUD.MELEME
107 :
108 :
109 : * LISTES DE MOTS-CLÉS
110 : * -------------------
111 : PARAMETER (NCLE=7)
112 : CHARACTER*4 LCLE(NCLE)
113 : DATA LCLE/'TITR','GEOM','INCO','FORC','CONN','SOLU','RESU'/
114 :
115 : PARAMETER (NTYP=2)
116 : CHARACTER*4 LTYP(NTYP)
117 : DATA LTYP/'ELEM','ASSE'/
118 :
119 : CHARACTER*20 MYFMT
120 :
121 : CHARACTER*16 PTRFMT,INDFMT
122 : CHARACTER*20 VALFMT
123 : INTEGER PTRCRD,INDCRD,VALCRD,TOTCRD
124 : PARAMETER (PTRFMT='(6I12)')
125 : PARAMETER (INDFMT='(6I12)')
126 : PARAMETER (VALFMT='(3E25.16)')
127 : PARAMETER (NPTRFMT=5)
128 : PARAMETER (NINDFMT=5)
129 : PARAMETER (NVALFMT=3)
130 :
131 : * VARIABLES BOOLÉENNES
132 : * --------------------
133 : LOGICAL ZTITR,ZGEOM,ZINCO,ZFORC,ZELEM,ZSOLU,ZRESU,ZNZER
134 : LOGICAL ZOPEN
135 :
136 :
137 : * AUTRES DÉCLARATIONS
138 : * -------------------
139 :
140 : * Format de sortie des fichiers
141 : CHARACTER*17 CEXTN
142 :
143 : * Chaîne imprimée dans la section TITRE
144 : CHARACTER*128 CTITR,CTIT2
145 : DATA CTITR/' '/
146 :
147 : * Nom du fichier
148 : CHARACTER*256 NOMFI2
149 :
150 :
151 : IDIM1=IDIM+1
152 :
153 :
154 :
155 : * +---------------------------------------------------------------+
156 : * | |
157 : * | L E C T U R E D E S A R G U M E N T S |
158 : * | |
159 : * +---------------------------------------------------------------+
160 :
161 : * =========================
162 : * FORMAT STANDARD DE SORTIE
163 : * =========================
164 :
165 : * CEXTN='mm' / IEXTN=1 : format Matrix Market
166 : * CEXTN='rb' / IEXTN=2 : format Rutherford Boeing
166 : CALL LIRCHA(CEXTN,1,LEXTN)
167 : IF (CEXTN(1:LEXTN).EQ.'MM'.OR.
168 : & CEXTN(1:LEXTN).EQ.'MATRIX_MARKET') THEN
169 : CEXTN='mm'
170 : IEXTN=1
171 : ELSEIF (CEXTN(1:LEXTN).EQ.'RB'.OR.
172 : & CEXTN(1:LEXTN).EQ.'RUTHERFORD_BOEING') THEN
173 : CEXTN='rb'
174 : IEXTN=2
175 : ELSE
176 : WRITE(*,*) 'erreur : mm ou rb ?'
176 : CALL ERREUR(21)
177 : RETURN
178 : ENDIF
179 :
180 :
181 : * =========================
182 : * TYPE DE MATRICE EN SORTIE
183 : * =========================
184 :
185 : * ITYP=1 : matrices élémentaires
186 : * ITYP=2 : matrice assemblée
186 : CALL LIRMOT(LTYP,NTYP,ITYP,1)
187 : IF (IERR.NE.0) RETURN
188 :
189 :
190 : * ===========================
191 : * LECTURE DE L'OBJET RIGIDITE
192 : * ===========================
193 :
193 : CALL LIROBJ('RIGIDITE',MRIGID,1,IRETOU)
194 : IF (IERR.NE.0) RETURN
195 :
196 :
197 : * =====================
198 : * LECTURE DES MOTS-CLÉS
199 : * =====================
200 :
201 : ZTITR=.FALSE.
202 : ZGEOM=.FALSE.
203 : ZINCO=.FALSE.
204 : ZFORC=.FALSE.
205 : ZELEM=.FALSE.
206 : ZSOLU=.FALSE.
207 : ZRESU=.FALSE.
208 :
208 : 1 CALL LIRMOT(LCLE,NCLE,ICLE,0)
209 : IF (ICLE.EQ.0) GOTO 100
210 :
211 : GOTO (10,11,12,13,14,15,16),ICLE
212 :
213 : * Mot-clé TITR
214 : 10 CONTINUE
214 : CALL LIRCHA(CTITR,1,LTITR)
215 : IF (IERR.NE.0) RETURN
216 : ZTITR=.TRUE.
217 : GOTO 1
218 :
219 : * Mot-clé GEOM
220 : 11 CONTINUE
221 : ZGEOM=.TRUE.
222 : GOTO 1
223 :
224 : * Mot-clé INCO
225 : 12 CONTINUE
226 : ZINCO=.TRUE.
227 : GOTO 1
228 :
229 : * Mot-clé FORC
230 : 13 CONTINUE
230 : CALL LIROBJ('CHPOINT',IFORC,1,IRETOU)
231 : IF (IERR.NE.0) RETURN
232 : ZFORC=.TRUE.
233 : GOTO 1
234 :
235 : * Mot-clé ELEM
236 : 14 CONTINUE
237 : ZELEM=.TRUE.
238 : GOTO 1
239 :
240 : * Mot-clé SOLU
241 : 15 CONTINUE
241 : CALL LIROBJ('CHPOINT',ISOLU,1,IRETOU)
242 : IF (IERR.NE.0) RETURN
243 : ZSOLU=.TRUE.
244 : GOTO 1
245 :
246 : * Mot-clé RESU
247 : 16 CONTINUE
247 : CALL LIROBJ('CHPOINT',IRESU,1,IRETOU)
248 : IF (IERR.NE.0) RETURN
249 : ZRESU=.TRUE.
250 : GOTO 1
251 :
252 :
253 :
254 :
255 : c WRITE(*,*) 'IEXTN=',IEXTN
256 : c WRITE(*,*) 'ITYP=',ITYP
257 : c WRITE(*,*) 'ZTITR=',ZTITR
258 : c WRITE(*,*) 'ZGEOM=',ZGEOM
259 : c WRITE(*,*) 'ZINCO=',ZINCO
260 : c WRITE(*,*) 'ZFORC=',ZFORC
261 : c WRITE(*,*) 'ZELEM=',ZELEM
262 : c WRITE(*,*) 'ZSOLU=',ZSOLU
263 : c WRITE(*,*) 'ZRESU=',ZRESU
264 :
265 :
266 :
267 :
268 :
269 : * +---------------------------------------------------------------+
270 : * | |
271 : * | M A T R I C E = F I C H I E R . M T X |
272 : * | |
273 : * +---------------------------------------------------------------+
274 : *
275 :
276 : 100 CONTINUE
277 :
278 :
279 : * On s'assure que la matrice n'est pas vide
280 : SEGACT,MRIGID
281 : NRIGEL=IRIGEL(/2)
282 : IF (NRIGEL.EQ.0) THEN
283 : write(IOIMP,*) 'La matrice est vide, opération annulée'
284 : RETURN
285 : ENDIF
286 :
287 :
288 :
289 : * ======================================
290 : * RÉCUPÉRATION DU NOM DE BASE DU FICHIER
291 : * ======================================
292 :
293 : INQUIRE(UNIT=IOPER,OPENED=ZOPEN)
294 : IF (.NOT.ZOPEN) THEN
294 : CALL ERREUR(-212)
295 : WRITE(IOIMP,*) '(via OPTI "SORT")'
296 : MOTERR(1:8)='.'//CEXTN(1:7)
296 : CALL ERREUR(705)
297 : RETURN
298 : ENDIF
299 :
300 : INQUIRE(UNIT=IOPER,NAME=NOMFIC)
301 : CLOSE(UNIT=IOPER,STATUS='DELETE')
301 : CALL LENCHA(NOMFIC,LC)
302 :
303 :
304 :
305 : * ========================================
306 : * SORTIE DE MATRICE SOUS FORME ÉLÉMENTAIRE
307 : * ========================================
308 :
309 : IF (ITYP.EQ.1) THEN
310 :
311 :
312 : * ***********************************
313 : * LISTE DES NOEUDS ET DES COMPOSANTES
314 : * ***********************************
315 :
316 : * On stocke les noeuds rencontrés dans un MELEME
317 : NPOMAX=XCOOR(/1)/IDIM1
318 : NBSOUS=0
319 : NBREF=0
320 : NBNN=1
321 : NBELEM=NPOMAX
322 : SEGINI,IPOG2L,MNOEUD
323 : MNOEUD.ITYPEL=1
324 :
325 : * On stocke les noms des composantes primales/duales dans les
326 : * tableaux IMIK et IDUA (analogues à ceux existant dans SMMATRI
327 : * pour les matrices assemblées). Les tableaux ICONUM (un par
328 : * sous-rigidité) mémorisent pour chaque variable primale/duale
329 : * l'indice de la composante correspondante dans IMIK/IDUA.
330 : SEGINI,MIMIK,MIDUA,MCONUM
331 :
332 : * (boucle sur les sous-rigidités)
333 : NPOTOT=0
334 : NELTOT=0
335 : NVATOT=0
336 : NINTOT=0
337 : DO IRIG=1,NRIGEL
338 :
339 : * Construction du MELEME
340 : * ----------------------
341 : IPT1=IRIGEL(1,IRIG)
342 : SEGACT,IPT1
343 : NEL1=IPT1.NUM(/2)
344 : NNO1=IPT1.NUM(/1)
345 : NELTOT=NELTOT+NEL1
346 : DO I=1,NEL1
347 : DO J=1,NNO1
348 : IF (IPOG2L(IPT1.NUM(J,I)).EQ.0) THEN
349 : NPOTOT=NPOTOT+1
350 : IPOG2L(IPT1.NUM(J,I))=NPOTOT
351 : MNOEUD.NUM(1,NPOTOT)=IPT1.NUM(J,I)
352 : ENDIF
353 : ENDDO
354 : ENDDO
355 :
356 :
357 : * Construction des listes IMIK/IDUA
358 : * ---------------------------------
359 : DESCR=IRIGEL(3,IRIG)
360 : SEGACT,DESCR
361 : NLIGRP=LISINC(/2)
362 : NLIGRD=LISDUA(/2)
363 : NINTOT=NINTOT+((NLIGRP+NLIGRD)*NEL1)
364 : NVATOT=NVATOT+(NLIGRP*NLIGRD*NEL1)
365 : SEGINI,ICONUM
366 : MCONUM(IRIG)=ICONUM
367 :
368 : * composantes primales
369 : DO 101 K=1,NLIGRP
370 : DO J=1,IMIK(/2)
371 : IF (IMIK(J).EQ.LISINC(K)) THEN
372 : IICOPR(K)=J
373 : GOTO 101
374 : ENDIF
375 : ENDDO
376 : IMIK(**)=LISINC(K)
377 : IICOPR(K)=IMIK(/2)
378 : 101 CONTINUE
379 :
380 : * composantes duales
381 : DO 102 K=1,NLIGRD
382 : DO J=1,IDUA(/2)
383 : IF (IDUA(J).EQ.LISDUA(K)) THEN
384 : IICODU(K)=J
385 : GOTO 102
386 : ENDIF
387 : ENDDO
388 : IDUA(**)=LISDUA(K)
389 : IICODU(K)=IDUA(/2)
390 : 102 CONTINUE
391 :
392 : ENDDO
393 : NBELEM=NPOTOT
394 : SEGADJ,MNOEUD
395 :
396 :
397 : * *********************************************************
398 : * LISTE DES INCONNUES (= DDL) PRIMALES/DUALES DE LA MATRICE
399 : * *********************************************************
400 :
401 : NBPTOT=0
402 : NBDTOT=0
403 :
404 : NNOE=NPOTOT
405 : MAXI=IMIK(/2)
406 : SEGINI,IDDLPR
407 : MAXI=IDUA(/2)
408 : SEGINI,IDDLDU
409 :
410 : DO IRIG=1,NRIGEL
411 :
412 : IPT1=IRIGEL(1,IRIG)
413 : DESCR=IRIGEL(3,IRIG)
414 : ICONUM=MCONUM(IRIG)
415 : NEL1=IPT1.NUM(/2)
416 : NBP1=IICOPR(/1)
417 : NBD1=IICODU(/1)
418 : DO I=1,NEL1
419 :
420 : * inconnues primales
421 : DO K=1,NBP1
422 : ICOP=IICOPR(K)
423 : INOP=IPOG2L(IPT1.NUM(NOELEP(K),I))
424 : IF (IDDLPR.INCPO(ICOP,INOP).EQ.0) THEN
425 : NBPTOT=NBPTOT+1
426 : IDDLPR.INCPO(ICOP,INOP)=NBPTOT
427 : ENDIF
428 : ENDDO
429 :
430 : * inconnues duales
431 : DO K=1,NBD1
432 : ICOD=IICODU(K)
433 : INOD=IPOG2L(IPT1.NUM(NOELED(K),I))
434 : IF (IDDLDU.INCPO(ICOD,INOD).EQ.0) THEN
435 : NBDTOT=NBDTOT+1
436 : IDDLDU.INCPO(ICOD,INOD)=NBDTOT
437 : ENDIF
438 : ENDDO
439 :
440 : ENDDO
441 :
442 : ENDDO
443 :
444 :
445 :
446 : * ********************************
447 : * => Sortie MATRIX_MARKET élémentaire
448 : * ********************************
449 :
450 : IF (IEXTN.EQ.1) THEN
451 :
452 : * Création du fichier .mtx.mm
453 : M=NBPTOT
454 : N=NBDTOT
455 : NNZER=NELTOT
455 : CALL OPENMM(NOMFIC,'mtx',CTITR,
456 : & M,N,NNZER,'matrix elemental real general')
457 :
458 :
459 : DO IRIG=1,NRIGEL
460 :
461 : IPT1=IRIGEL(1,IRIG)
462 : DESCR=IRIGEL(3,IRIG)
463 : XMATRI=IRIGEL(4,IRIG)
464 : ICONUM=MCONUM(IRIG)
465 : SEGACT,XMATRI
466 :
467 : DO KEL=1,IPT1.NUM(/2)
468 :
469 : NPR1=LISINC(/2)
470 : NDU1=LISDUA(/2)
471 : WRITE(IOPER,FMT='(I5,1X,I5)')
472 : & NPR1,NDU1
473 :
474 : DO KDU=1,NDU1
475 : ICOD=IICODU(KDU)
476 : INOD=IPOG2L(IPT1.NUM(NOELED(KDU),KEL))
477 : WRITE(IOPER,FMT='(I15)')
478 : & IDDLDU.INCPO(ICOD,INOD)
479 : ENDDO
480 :
481 : DO KPR=1,NPR1
482 : ICOP=IICOPR(KPR)
483 : INOP=IPOG2L(IPT1.NUM(NOELEP(KPR),KEL))
484 : WRITE(IOPER,FMT='(I15)')
485 : & IDDLPR.INCPO(ICOP,INOP)
486 : ENDDO
487 :
488 : DO KDU=1,NDU1
489 : DO KPR=1,NPR1
490 : WRITE(IOPER,FMT='(E25.16)')
491 : & RE(KDU,KPR,KEL)
492 : ENDDO
493 : ENDDO
494 :
495 : ENDDO
496 :
497 : SEGDES,IPT1,DESCR,XMATRI
498 : SEGSUP,ICONUM
499 :
500 : ENDDO
501 :
502 :
503 : * ************************************
504 : * => Sortie RUTHERFORD_BOEING élémentaire
505 : * ************************************
506 :
507 : ELSEIF (IEXTN.EQ.2) THEN
508 :
509 : * Création du fichier .mtx.rb
510 : PTRCRD=2*NELTOT+1
511 : INDCRD=NBPTOT+NBDTOT
512 : VALCRD=NVATOT
513 : TOTCRD=PTRCRD+INDCRD+VALCRD
514 : MVAR=MAX(NBPTOT,NBDTOT)
515 : NELT=NELTOT
516 : NVARIX=NINTOT
517 : NELTVL=NVATOT
517 : CALL OPENRB(NOMFIC,'mtx',CTITR,
518 : & TOTCRD,PTRCRD,INDCRD,VALCRD,
519 : & MVAR,NELT,NVARIX,NELTVL,
520 : & 'rre','(I15)','(I15)','(E25.16)')
521 : IF (IERR.NE.0) RETURN
522 :
523 :
524 : * ECRITURE DES POINTEURS
525 : * ----------------------
526 : IPTR=1
527 : WRITE(IOPER,FMT='(I15)')
528 : & IPTR
529 : DO IRIG=1,NRIGEL
530 :
531 : IPT1=IRIGEL(1,IRIG)
532 : DESCR=IRIGEL(3,IRIG)
533 :
534 : DO KEL=1,IPT1.NUM(/2)
535 : IPTR=IPTR+LISINC(/2)
536 : WRITE(IOPER,FMT='(I15)')
537 : & IPTR
538 : IPTR=IPTR+LISDUA(/2)
539 : WRITE(IOPER,FMT='(I15)')
540 : & IPTR
541 : ENDDO
542 :
543 : ENDDO
544 :
545 : * ECRITURE DES NUMEROS D'INCONNUES
546 : * --------------------------------
547 : DO IRIG=1,NRIGEL
548 :
549 : IPT1=IRIGEL(1,IRIG)
550 : DESCR=IRIGEL(3,IRIG)
551 : ICONUM=MCONUM(IRIG)
552 :
553 : DO KEL=1,IPT1.NUM(/2)
554 :
555 : DO KDU=1,LISDUA(/2)
556 : ICOD=IICODU(KDU)
557 : INOD=IPOG2L(IPT1.NUM(NOELED(KDU),KEL))
558 : WRITE(IOPER,FMT='(I15)')
559 : & IDDLDU.INCPO(ICOD,INOD)
560 : ENDDO
561 :
562 : DO KPR=1,LISINC(/2)
563 : ICOP=IICOPR(KPR)
564 : INOP=IPOG2L(IPT1.NUM(NOELEP(KPR),KEL))
565 : WRITE(IOPER,FMT='(I15)')
566 : & IDDLPR.INCPO(ICOP,INOP)
567 : ENDDO
568 :
569 : ENDDO
570 :
571 : SEGSUP,ICONUM
572 :
573 : ENDDO
574 :
575 : * ECRITURE DES VALEURS
576 : * --------------------
577 : DO IRIG=1,NRIGEL
578 :
579 : IPT1=IRIGEL(1,IRIG)
580 : DESCR=IRIGEL(3,IRIG)
581 : XMATRI=IRIGEL(4,IRIG)
582 : SEGACT,XMATRI
583 :
584 : DO KEL=1,IPT1.NUM(/2)
585 : DO KDU=1,LISDUA(/2)
586 : DO KPR=1,LISINC(/2)
587 : WRITE(IOPER,FMT='(E25.16)')
588 : & RE(KDU,KPR,KEL)
589 : ENDDO
590 : ENDDO
591 : ENDDO
592 :
593 : SEGDES,IPT1,DESCR,XMATRI
594 :
595 : ENDDO
596 :
597 : ENDIF
598 :
599 : SEGSUP,IPOG2L,MCONUM
600 :
601 :
602 :
603 : * ======================================
604 : * SORTIE DE MATRICE SOUS FORME ASSEMBLÉE
605 : * ======================================
606 : *
607 :
608 : ELSEIF (ITYP.EQ.2) THEN
609 :
610 : * Assemblage des matrices élémentaires
611 : * ************************************
612 : IF (NORINC.EQ.0.AND.NORIND.EQ.0) THEN
613 : INORMU=0
614 : ELSE
615 : INORMU=1
616 : ENDIF
616 : CALL KRES9(MRIGID,INORMU)
617 : IF (IERR.NE.0) RETURN
618 :
619 : * Mise sous forme morse = CSR (Compressed Sparse Column)
620 : * ******************************************************
621 : * /!\ Même après transformation en morse, les inconnues restent
622 : * decrites par les segments IINCPO et IDUAPO du SMMATRI
623 : * pointé par ICHOLE dans le MRIGID d'origine.
624 : * En theorie, la matrice qui sort de l'assemblage par KRES9
625 : * est carrée, structurellement symétrique. On forcera alors
626 : * NBDTOT = NBPTOT mais on distinguera tout de meme les
627 : * variables les inconnues primales et duales via IINCPO et
628 : * IDUAPO.
628 : CALL KRES10(MRIGID,KMORS,KIZA)
629 : IF (IERR.NE.0) RETURN
630 : SEGACT,KMORS,KIZA
631 : NBPTOT=KMORS.IA(/1)-1
632 : NBDTOT=NBPTOT
633 : * /!\ KIZA.A est rempli de 0 inutiles en fin
634 : * => à ne pas utiliser pour déterminer NVATOT
635 : NVATOT=KMORS.JA(/1)
636 :
637 : * Conversion du stockage CSR (Compressed Sparse Row) vers
638 : * CSC (Compressed Sparse Column)
639 : * *******************************************************
640 : NTT=NBPTOT
641 : NJA=NVATOT
642 : SEGINI,KMOR2
642 : CALL TRPMOR(NTT,NJA,KMORS.JA,KMORS.IA,KMOR2.JA,KMOR2.IA,
643 : & 0,IRET)
644 : SEGSUP,KMORS
645 :
646 : * On (re)active les segments pour la suite de la subroutine
647 : * *********************************************************
648 : SEGACT,MRIGID
649 : MMATRI=ICHOLE
650 : SEGACT,MMATRI
651 :
652 :
653 : * ******************************
654 : * => Sortie MATRIX_MARKET assemblée
655 : * ******************************
656 :
657 : IF (IEXTN.EQ.1) THEN
658 :
659 : * Création du fichier .mtx.mm
660 : M=NBDTOT
661 : N=NBPTOT
662 : NNZER=NVATOT
662 : CALL OPENMM(NOMFIC,'mtx',CTITR,
663 : & M,N,NNZER,'matrix coordinate real general')
664 : &
665 :
666 : * Ecriture de la matrice
667 : NTVA=0
668 : DO I=1,M
669 : NIVA=KMOR2.IA(I+1)-KMOR2.IA(I)
670 : DO J=1,NIVA
671 : WRITE(IOPER,FMT='(I12,1X,I12,1X,E25.16)')
672 : & I,KMOR2.JA(NTVA+J),KIZA.A(NTVA+J)
673 : ENDDO
674 : NTVA=NTVA+NIVA
675 : ENDDO
676 :
677 :
678 : * **********************************
679 : * => Sortie RUTHERFORD_BOEING assemblée
680 : * **********************************
681 :
682 : ELSEIF (IEXTN.EQ.2) THEN
683 :
684 : * Création du fichier .mtx.rb
685 : M=NBDTOT
686 : NVEC=NBPTOT
687 : NAUXD=NVATOT
688 : c PTRCRD=CEILING((NBPTOT+1)/NPTRFMT)
689 : c INDCRD=CEILING(NVATOT/NINDFMT)
690 : c VALCRD=CEILING(NVATOT/NVALFMT)
691 : PTRCRD=(NBPTOT+1)/NPTRFMT
692 : INDCRD=NVATOT/NINDFMT
693 : VALCRD=NVATOT/NVALFMT
694 : IF (MOD((NBPTOT+1),NPTRFMT).GT.0) PTRCRD=PTRCRD+1
695 : IF (MOD(NVATOT,NINDFMT).GT.0) INDCRD=INDCRD+1
696 : IF (MOD(NVATOT,NVALFMT).GT.0) VALCRD=VALCRD+1
697 : TOTCRD=PTRCRD+INDCRD+VALCRD
698 :
698 : CALL OPENRB(NOMFIC,'mtx',CTITR,
699 : & TOTCRD,PTRCRD,INDCRD,VALCRD,
700 : & M,NVEC,NAUXD,0,
701 : & 'rua',PTRFMT,INDFMT,VALFMT)
702 : IF (IERR.NE.0) RETURN
703 :
704 : * Ecriture de la matrice
705 : WRITE(IOPER,PTRFMT) (KMOR2.IA(K),K=1,NBPTOT+1)
706 : WRITE(IOPER,INDFMT) (KMOR2.JA(K),K=1,NVATOT)
707 : WRITE(IOPER,VALFMT) (KIZA.A(K),K=1,NVATOT)
708 :
709 : ENDIF
710 :
711 : SEGSUP,KMOR2,KIZA
712 :
713 : ENDIF
714 :
715 : CLOSE(UNIT=IOPER)
716 :
717 :
718 :
719 : * +---------------------------------------------------------------+
720 : * | |
721 : * | G E O M E T R I E = F I C H I E R . G E O M |
722 : * | |
723 : * +---------------------------------------------------------------+
724 :
725 : 200 CONTINUE
726 : IF (.NOT.ZGEOM) THEN
727 : OPEN(UNIT=IOPER,FILE=NOMFIC(1:LONG(NOMFIC))//'.geom'//CEXTN)
728 : CLOSE(UNIT=IOPER,STATUS='DELETE')
729 : GOTO 300
730 : ENDIF
731 :
732 : IF (ITYP.EQ.2) THEN
733 : MNOEUD=IGEOMA
734 : SEGACT,MNOEUD
735 : NPOTOT=MNOEUD.NUM(/2)
736 : ENDIF
737 :
738 : MYFMT='(E25.16)'
739 :
740 : * Création du fichier .geom.mm
741 : * ****************************
742 : IF (IEXTN.EQ.1) THEN
743 : M=NPOTOT
744 : N=IDIM
745 : NNZER=0
745 : CALL OPENMM(NOMFIC,'geom',CTITR,
746 : & M,N,NNZER,'matrix array real general')
747 :
748 : * Création du fichier .geom.rb
749 : * ****************************
750 : ELSEIF (IEXTN.EQ.2) THEN
751 : M=NPOTOT
752 : NVEC=IDIM
753 : NAUXD=0
753 : CALL OPENRB(NOMFIC,'geom',CTITR,
754 : & M,NVEC,NAUXD,0,
755 : & 0,0,0,0,
756 : & 'geos r',MYFMT,' ',' ')
757 : IF (IERR.NE.0) RETURN
758 : ENDIF
759 :
760 : * Ecriture des coordonnées du maillage
761 : WRITE(IOPER,FMT=MYFMT)
762 : &((XCOOR((MNOEUD.NUM(1,K)-1)*IDIM1+J),K=1,NPOTOT),J=1,IDIM)
763 :
764 :
765 : IF (ITYP.EQ.2) SEGDES,MNOEUD
766 : CLOSE(UNIT=IOPER)
767 :
768 :
769 :
770 : * +---------------------------------------------------------------+
771 : * | |
772 : * | I N C O N N U E S = F I C H I E R . I N C O |
773 : * | |
774 : * +---------------------------------------------------------------+
775 :
776 : 300 CONTINUE
777 : IF (.NOT.ZINCO) THEN
778 : OPEN(UNIT=IOPER,FILE=NOMFIC(1:LONG(NOMFIC))//'.inco'//CEXTN)
779 : CLOSE(UNIT=IOPER,STATUS='DELETE')
780 : GOTO 400
781 : ENDIF
782 :
783 : IF (ITYP.EQ.2) THEN
784 : IDDLPR=IINCPO
785 : IDDLDU=IDUAPO
786 : SEGACT,IDDLPR,IDDLDU
787 :
788 : MIMIK=IIMIK
789 : MIDUA=IIDUA
790 : SEGACT,MIMIK,MIDUA
791 : ENDIF
792 :
793 : NBVAR=NBPTOT+NBDTOT
794 : NBWR=2*NBVAR
795 : SEGINI,MIDATA
796 :
797 : NBCOPR=IDDLPR.INCPO(/1)
798 : NBNOPR=IDDLPR.INCPO(/2)
799 : NBCODU=IDDLDU.INCPO(/1)
800 : NBNODU=IDDLDU.INCPO(/2)
801 :
802 : * Inconnues primales
803 : DO J=1,NBCOPR
804 : DO I=1,NBNOPR
805 : IINC=IDDLPR.INCPO(J,I)
806 : IF (IINC.GT.0) THEN
807 : IWRIT(IINC)=I
808 : IWRIT(NBVAR+IINC)=J
809 : ENDIF
810 : ENDDO
811 : ENDDO
812 :
813 : * Inconnues duales
814 : DO J=1,NBCODU
815 : DO I=1,NBNODU
816 : IINC=IDDLDU.INCPO(J,I)
817 : IF (IINC.GT.0) THEN
818 : IWRIT(NBPTOT+IINC)=I
819 : IWRIT(NBVAR+NBPTOT+IINC)=J
820 : ENDIF
821 : ENDDO
822 : ENDDO
823 :
824 :
825 : * Création du fichier .inco.mm
826 : * ****************************
827 : IF (IEXTN.EQ.1) THEN
828 : M=NBVAR
829 : N=2
830 : NNZER=0
831 : MYFMT='(I12)'
831 : CALL OPENMM(NOMFIC,'inco',CTITR,
832 : & M,N,NNZER,'matrix array real general')
833 :
834 : * On ajoute le nom des composantes dans l'entête...
835 : BACKSPACE(UNIT=IOPER)
836 : WRITE(UNIT=IOPER,FMT='("%",/,A)')
837 : & '% COMPOSANTES'
838 : WRITE(UNIT=IOPER,FMT='("% PRIM ",I3," ",A4)')
839 : & (J,IMIK(J),J=1,NBCOPR)
840 : WRITE(UNIT=IOPER,FMT='("% DUAL ",I3," ",A4)')
841 : & (J,IDUA(J),J=1,NBCODU)
842 :
843 : * ...puis on reecrit ce que l'on avait effacé
844 : WRITE(UNIT=IOPER,FMT='("%")')
845 : WRITE(IOPER,FMT='(I6,1X,I6)') M,N
846 :
847 : * Ecriture des noeud et composante associés à chaque variable
848 : WRITE(IOPER,FMT=MYFMT) (IWRIT(K),K=1,NBWR)
849 :
850 :
851 : * Création du fichier .inco.rb
852 : * ****************************
853 : ELSEIF (IEXTN.EQ.2) THEN
854 : M=NBVAR
855 : NVEC=2
856 : NAUXD=0
857 : MYFMT='(I12)'
857 : CALL OPENRB(NOMFIC,'inco',CTITR,
858 : & M,NVEC,NAUXD,0,
859 : & 0,0,0,0,
860 : & 'avl r',MYFMT,' ',' ')
861 : IF (IERR.NE.0) RETURN
862 :
863 : * Ecriture des noeud et composante associés à chaque variable
864 : WRITE(IOPER,FMT=MYFMT) (IWRIT(K),K=1,NBWR)
865 :
866 : * On ajoute le nom des composantes en fin de fichier
867 : WRITE(UNIT=IOPER,FMT='("%",/,A)')
868 : & '% COMPOSANTES'
869 : WRITE(UNIT=IOPER,FMT='("% PRIM ",I3," ",A4)')
870 : & (J,IMIK(J),J=1,NBCOPR)
871 : WRITE(UNIT=IOPER,FMT='("% DUAL ",I3," ",A4)')
872 : & (J,IDUA(J),J=1,NBCODU)
873 :
874 : ENDIF
875 :
876 :
877 : CLOSE(UNIT=IOPER)
878 : IF (ITYP.EQ.2) SEGDES,MIMIK,MIDUA,IDDLPR,IDDLDU
879 : SEGSUP,MIDATA
880 :
881 :
882 :
883 :
884 :
885 :
886 : * +---------------------------------------------------------------+
887 : * | |
888 : * | S E C O N D - M E M B R E = F I C H I E R . R H S |
889 : * | |
890 : * +---------------------------------------------------------------+
891 :
892 : 400 CONTINUE
893 : IF (.NOT.ZFORC) GOTO 500
894 : WRITE(IOIMP,*) 'Pas de sortie FORC pour le moment'
894 : CALL ERREUR(251)
895 :
896 :
897 :
898 : * +---------------------------------------------------------------+
899 : * | |
900 : * | C O N N E C T I V I T É = F I C H I E R . C O N N |
901 : * | |
902 : * +---------------------------------------------------------------+
903 :
904 : 500 CONTINUE
905 : IF (.NOT.ZELEM) GOTO 600
906 : WRITE(IOIMP,*) 'Pas de sortie CONN pour le moment'
906 : CALL ERREUR(251)
907 : IF (IERR.NE.0) RETURN
908 :
909 :
910 :
911 : * +---------------------------------------------------------------+
912 : * | |
913 : * | S O L U T I O N D E R E F E R E N C E |
914 : * | = F I C H I E R . S O L U |
915 : * | |
916 : * +---------------------------------------------------------------+
917 :
918 : 600 CONTINUE
919 : IF (.NOT.ZSOLU) GOTO 700
920 : WRITE(IOIMP,*) 'Pas de sortie SOLU pour le moment'
920 : CALL ERREUR(251)
921 : IF (IERR.NE.0) RETURN
922 :
923 :
924 : * +---------------------------------------------------------------+
925 : * | |
926 : * | R É S U L T A T D E C A L C U L |
927 : * | = F I C H I E R . R E S U |
928 : * | |
929 : * +---------------------------------------------------------------+
930 :
931 : 700 CONTINUE
932 : IF (.NOT.ZRESU) GOTO 999
933 : WRITE(IOIMP,*) 'Pas de sortie RESU pour le moment'
933 : CALL ERREUR(251)
934 : IF (IERR.NE.0) RETURN
935 :
936 :
937 :
938 :
939 :
940 :
941 :
942 : * +---------------------------------------------------------------+
943 : * | |
944 : * | M É N A G E E T S O R T I E |
945 : * | |
946 : * +---------------------------------------------------------------+
947 :
948 : 999 CONTINUE
949 :
950 :
951 : IF (ITYP.EQ.1) SEGSUP,MNOEUD,MIMIK,MIDUA,IDDLPR,IDDLDU
952 : IF (ITYP.EQ.2) SEGDES,MMATRI
953 : SEGDES,MRIGID
954 :
955 : RETURN
956 :
957 : END
958 :
959 :
© Cast3M 2003 - All rights reserved.
Disclaimer