1 : C SORVTK SOURCE JC220346 13/11/19 21:15:00 7867
2 : ************************************************************************
3 : * NOM : sorvtk.eso
4 : * DESCRIPTION : Sortie d'objets de type MAILLAGE, CHPOINT et/ou MCHAML
5 : * au format VTK
6 : * REFERENCE : VTK File Formats for VTK Version 4.2, extrait de
7 : * The VTK User's Guide, Kitware
8 : * (www.vtk.org/VTK/img/file-formats.pdf)
9 : ************************************************************************
10 : * HISTORIQUE : 18/06/2012 : JCARDO : création de la subroutine
11 : * HISTORIQUE : 20/06/2012 : JCARDO : bug impression ITYEL en BINA
12 : * HISTORIQUE :
13 : * HISTORIQUE :
14 : ************************************************************************
15 : * Prière de PRENDRE LE TEMPS DE COMPLÉTER LES COMMENTAIRES
16 : * en cas de modification de ce sous-programme afin de faciliter
17 : * la maintenance !
18 : ************************************************************************
19 : * APPELÉ PAR : opérateur SORTir (prsort.eso)
20 : ************************************************************************
21 : * ENTRÉES :: aucune
22 : * SORTIES :: aucune (sur fichiers uniquement)
23 : ************************************************************************
24 : * SYNTAXE (GIBIANE) :
25 : *
26 : * SORT 'VTK' OBJ1 (MOT1) ... (OBJn) (MOTn)
27 : * (|'FORM'|) (|'AUTO'|) ('TEMP' FLOT1) ('DOUBLE_PRECISION')
28 : * |'BINA'| |'NOUV'|
29 : * |'ZIP' | |'SUIT'|
30 : * |'NPVD'|
31 : *
32 : * avec OBJi = [ MAILi | CHPOi | CHMLi | TABi ]
33 : *
34 : ************************************************************************
35 : SUBROUTINE SORVTK
36 :
37 : IMPLICIT INTEGER(I-N)
38 : IMPLICIT REAL*8(A-H,O-Z)
39 :
40 : -INC CCGEOME
41 : -INC CCOPTIO
42 : -INC SMCOORD
43 :
44 : -INC SMELEME
45 : -INC SMCHPOI
46 : -INC SMCHAML
47 : -INC SMLMOTS
48 : -INC SMTABLE
49 :
50 : -INC CCNOYAU
51 : -INC CCASSIS
52 : -INC CCFXDR
53 :
54 : EXTERNAL LONG
55 :
56 :
57 : * CARACTERE DOUBLE-QUOTE (")
58 : * --------------------------
59 : * Bug dans le traducteur ESOPE pour qui ' et " ont le même rôle
60 : * => lors de la traduction d'une chaine 'xxxx"yyyy"zzzz', la chaine
61 : * yyyy est mise en majuscule
62 : * => Paraview n'arrive pas à relire les .vtu car il ne reconnait
63 : * pas la valeur de certains attributs ("BigEndian", "Appended",
64 : * "UnstructuredGrid"...)
65 : CHARACTER*1 DQ
66 : c PARAMETER(DQ=ACHAR(34))
67 :
68 :
69 : * OCTETS PRE-DEFINIS A ECRIRE DANS LA SECTION
70 : * ----------------------------------------------------------
71 : * IXDR1=représentation décimale BigEndian de la chaîne ' _'
72 : * IXDR2=représentation décimale BigEndian du marqueur End-Of-Record
73 : INTEGER*4 IXDR1,IXDR2
74 : DATA IXDR1/538976351/
75 : DATA IXDR2/10/
76 :
77 :
78 : * SEGMENTS DE TRAVAIL TEMPORAIRES
79 : * -------------------------------
80 : * SMAIL = données sur les maillages lus (pointeur et nom)
81 : * SCHPO = données sur les champs par points lus (pointeur et nom)
82 : * SCHML = données sur les champs par éléments lus (pointeur et nom)
83 : * ICONN,IOFFS,ITYEL = données sur les cellules du maillage courant
84 : * IPOL2G|= Tables de correspondance entre la numérotation (globale)
85 : * IPOG2L| des noeuds dans XCOOR et la numérotation (locale) des
86 : * noeuds du maillage dans le fichier .vtu
87 : * IELL2G = Table de correspondance entre la numérotation (globale)
88 : * des cellules du MAILLAGE courant et la numérotation
89 : * (locale) des cellules du MCHAML courant
90 : * ITYPII = donne le sous-maillage formé d'un type donné d'élément
91 : * INECUM = donne le nombre cumulé d'éléments des sous-maillages
92 : * TCHCO = liste des composantes du CHPOINT ou du MCHAML courant
93 : * ICOOK = liste des composantes à sortir (au moins 1 valeur)
94 : * SCHPV = tableau compacté des valeurs du CHPOINT courant
95 : * SCHMV = tableau compacté des valeurs du MCHAML courant
96 :
97 : SEGMENT SMAIL
98 : INTEGER IMAIL(NBMAIL)
99 : CHARACTER*4 TMAIL(NBMAIL)
100 : ENDSEGMENT
101 : SEGMENT SCHPO
102 : INTEGER ICHPO(NBCHPO)
103 : CHARACTER*8 TCHPO(NBCHPO)
104 : ENDSEGMENT
105 : SEGMENT SCHML
106 : INTEGER ICHML(NBCHML)
107 : CHARACTER*8 TCHML(NBCHML)
108 : ENDSEGMENT
109 :
110 : SEGMENT IPOL2G(NNO)
111 : SEGMENT IPOG2L(NPMAX)
112 : SEGMENT IELL2G(NEL2)
113 : SEGMENT ICONN(NBCON)
114 : SEGMENT IOFFS(NEL)
115 : SEGMENT ITYEL(NEL1)
116 : SEGMENT ITYPII(NOMBR)
117 : SEGMENT INECUM(NBSOU1)
118 :
119 : POINTEUR TCHCO.MLMOTS
120 : SEGMENT ICOOK(0)
121 :
122 : SEGMENT SCHPV
123 : REAL*8 XPOCHA(NCO,NNO)
124 : ENDSEGMENT
125 : SEGMENT SCHMV
126 : REAL*8 XELCHE(NCO,NEL)
127 : ENDSEGMENT
128 :
129 :
130 : * MOTS-CLÉS DE L'OPÉRATEUR
131 : * ------------------------
132 : PARAMETER(LMCLE=9)
133 : CHARACTER*4 MCLE(LMCLE)
134 : DATA MCLE/'AUTO','SUIT','NOUV','NPVD',
135 : & 'FORM','BINA','ZIP',
136 : & 'TEMP',
137 : & 'DOUB'/
138 :
139 :
140 : * VARIABLES BOOLÉENNES
141 : * --------------------
142 : * ZEXIS = vrai si le fichier .pvd existe déjà (et est compatible)
143 : * ZTEMP = vrai si le pas de temps a été indiqué (mot-clé 'TEMP')
144 : * ZPART = vrai si plusieurs maillages ont été transmis
145 : * ZOPT1,ZOPT2 = utilisés pour s'assurer que plusieurs mots-clés
146 : * d'une même option n'ont pas été lus
147 : * ZOPEN = vrai si OPTI 'SORT' a bien été appelé au préalable
148 : * ZDOUB = vrai si on écrit les données en double précision
149 : LOGICAL ZEXIS,ZTEMP,ZPART,ZOPT1,ZOPT2,ZOPEN,ZDOUB
150 :
151 :
152 : * TABLEAUX DE CORRESPONDANCE entre les éléments géométriques de
153 : * CAST3M et ceux de VTK (www.vtk.org/VTK/img/file-formats.pdf)
154 : * --------------------
155 : INTEGER*2 ITYVTK(48)
156 : DATA ITYVTK
157 : * POI1 SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5
158 : . / 1 , 3 , 21 , 5 , 0 , 22 , 0 , 9 , 0 ,
159 : * QUA8 QUA9 RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3
160 : . 23 , 0 , 0 , 0 , 12 , 25 , 13 , 0 , 0 ,
161 : * LIA4 LIA6 LIA8 MULT TET4 TE10 PYR5 PY13 ATTA
162 : . 0 , 0 , 0 , 0 , 10 , 24 , 14 , 0 , 0 ,
163 : * SUPE RAP3 LIP6 LIP8 POLY CU27 PR21 TE15 PY19
164 : . 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,
165 : * SEG4 QU16 TR12 PR18 SEG6 TR21 QU36 C216 P126
166 : . 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,
167 : * TE56 PY91 SURE
168 : . 0 , 0 , 0 /
169 :
170 : * Correspondance des numerotations pour les elements quadratiques
171 : INTEGER*2 INUVTK(20, 5)
172 : INTEGER*2 NUSEG3(3), NUTRI6(6), NUQUA8(8), NUTE10(10), NUCU20(20)
173 : DATA NUSEG3 / 1, 3, 2 /
174 : DATA NUTRI6 / 1, 3, 5, 2, 4, 6 /
175 : DATA NUQUA8 / 1, 3, 5, 7, 2, 4, 6, 8 /
176 : DATA NUTE10 / 1, 3, 5, 10, 2, 4, 6, 7, 8, 9 /
177 : DATA NUCU20 / 1, 3, 5, 7, 13, 15, 17, 19, 2, 4, 6, 8, 14, 16, 18,
178 : . 20, 9, 10, 11, 12 /
179 : EQUIVALENCE (INUVTK(1,1),NUSEG3(1)),
180 : . (INUVTK(1,2),NUTRI6(1)),
181 : . (INUVTK(1,3),NUQUA8(1)),
182 : . (INUVTK(1,4),NUTE10(1)),
183 : . (INUVTK(1,5),NUCU20(1))
184 :
185 :
186 :
187 : * AUTRES DÉCLARATIONS
188 : * -------------------
189 :
190 : * Chaînes de caractères génériques
191 : CHARACTER*4 CHA4
192 : CHARACTER*8 CHA8
193 : CHARACTER*9 CHA9
194 :
195 : * Chaînes de caractères pour la conversion de nombres
196 : CHARACTER*15 CNU1,CNU2
197 :
198 : * Variables pour la manipulation des noms de fichiers
199 : CHARACTER*72 NOM1,NOM2,NOM3
200 :
201 : * Variable pour les formats I/O dynamiques
202 : CHARACTER*30 MYFMT
203 :
204 : * Buffer utilisé lors de la lecture préliminaire du fichier .pvd
205 : CHARACTER*200 CBUF
206 :
207 : * Ligne de commentaire écrite en-tête de tous les fichiers
208 : CHARACTER*120 CHEAD
209 :
210 :
211 : * *****************************************************************
212 : * CONTRÔLE DE LA TAILLE ET DE LA PRÉCISION DES DONNÉES NUMÉRIQUES
213 : * ÉCRITES SUR LES UNITÉS DE SORTIE IOXML ET IOBIN
214 : * *****************************************************************
215 : *
216 : * /!\ CHOIX NON MODIFIABLES PAR 'DOUBLE_PRECISION' :
217 : *
218 : * - En BINAire :
219 : * => les connectivités et offsets des cellules sont écrits sur
220 : * 4 octets, ce qui "limite" le nombre de noeuds à 2 milliards
221 : * => les types des cellules sont codés sur 1 octet (puis groupés
222 : * par 4 pour pouvoir être écrits par XDR)
223 : * => Le standard VTK impose que la variable NBYTES ci-dessous
224 : * soit écrite sur 4 octets (soit ISIZNB=4)
225 : *
226 : * - En FORMaté :
227 : * => les CHPOINT et MCHAML sont écrits sur N colonnes, où N est
228 : * le nombre de composantes : il y aura une erreur si N est
229 : * un multiple de 100 car N est écrit au format I2.
230 : *
231 : * ------------------------------
232 :
233 : * NBYTES=Nombre d'octets écrits jusqu'alors dans la section AppendedData (hors caractère '_' initial)
234 : * ISIZNB=Taille (en octets) sur laquelle écrire la variable NBYTES
235 : INTEGER NBYTES
236 : PARAMETER(ISIZNB=4)
237 :
238 : * Formats numériques prédéfinis pour l'écriture de réels
239 : CHARACTER*8 FMR4,FMR8
240 : PARAMETER(FMR4='E14.6E2 ')
241 : PARAMETER(FMR8='E24.15E3')
242 :
243 : * Variables à modifier selon la valeur de ZDOUB
244 : * - FMDAT=[FMR4|FMR8]
245 : * - FLDAT=['Float32'|'Float64']
246 : * - ISIZDA=[4|8]
247 : CHARACTER*8 FMDAT
248 : CHARACTER*7 FLDAT
249 : INTEGER ISIZDA
250 :
251 : * Variables génériques de précision donnée
252 : INTEGER*4 INT4
253 : REAL*4 XRE4,YRE4,ZRE4
254 : REAL*8 XRE8,YRE8,ZRE8
255 :
256 :
257 : * (FIN DES DECLARATIONS)
258 : * *****************************************************************
259 : * *****************************************************************
260 :
261 :
262 : * Caractère DOUBLE-QUOTE (certains compilateurs ne supportent pas
263 : * qu'il soit défini en PARAMETER...)
264 : * => obligatoire du fait d'un preprocesseur ESOPE trop gourmand qui
265 : * convertit en majuscules tout ce qui est entre guillemets (")
266 : DQ=ACHAR(34)
267 :
268 : * Numéro de la sortie logique vers le fichier .vtu
269 : * (le numéro de l'éventuel .bin sera renvoyé par INITXDR)
270 : IOXML=IOPER
271 :
272 : * Nombre max. de noeuds (pour dimensionner les tableaux)
273 : IDIM1=IDIM+1
274 : NPMAX=XCOOR(/1)/IDIM1
275 :
276 : * Nom de base des fichiers à sortir
277 : INQUIRE(UNIT=IOPER,OPENED=ZOPEN)
278 : IF (.NOT.ZOPEN) THEN
278 : CALL ERREUR(-212)
279 : WRITE(IOIMP,*) '(via OPTI "SORT")'
280 : MOTERR(1:8)='VTK '
280 : CALL ERREUR(705)
281 : RETURN
282 : ENDIF
283 : INQUIRE(UNIT=IOPER,NAME=NOMFIC)
284 : CLOSE(UNIT=IOPER,STATUS='DELETE')
285 : * ---------------------------------------
286 : * /!\ On ferme immediatement le fichier ouvert par OPTI 'SORT'...
287 : * CE N'ETAIT PAS L'APPROCHE GÉNÉRALEMENT ADOPTÉE quand on utilisait
288 : * l'opérateur SORTir, mais ici il devient beaucoup plus commode de
289 : * procéder ainsi, pour plusieurs raisons :
290 : * - éventuellement plusieurs fichiers .vtu seront écrits
291 : * - le fichier .pvd peut être ou ne pas être écrit
292 : * - les fichiers .vtu peuvent être en mode ASCII ou BINAIRE
293 : * - il faut rajouter l'extension !
294 : * ---------------------------------------
295 :
296 : * On récupère le nom du répertoire dans NOM1, s'il existe
297 : IREP=INDEX(NOMFIC,'/',BACK=.TRUE.)
298 : NOM1='./'
299 : IF (IREP.GT.0) THEN
300 : NOM1=NOMFIC(1:IREP)
301 : NOMFIC=NOMFIC(IREP+1:LONG(NOMFIC))
302 : ENDIF
303 :
304 :
305 :
306 :
307 : ************************************************************************
308 : ************************************************************************
309 : ************************************************************************
310 : ************************************************************************
311 :
312 :
313 :
314 :
315 : * +---------------------------------------------------------------+
316 : * | |
317 : * | L E C T U R E D E S A R G U M E N T S |
318 : * | |
319 : * +---------------------------------------------------------------+
320 :
321 :
322 : * NBMAIL :: nombre d'objets 'MAILLAGE' lus
323 : * NBCHPO :: nombre d'objets 'CHPOINT' lus
324 : * NBCHML :: nombre d'objets 'MCHAML' lus
325 : NBMAIL=0
326 : NBCHPO=0
327 : NBCHML=0
328 : SEGINI,SMAIL,SCHPO,SCHML
329 :
330 : * IPVD=0 :: option 'AUTO' => complétion du .pvd si possible, création d'un nouveau sinon
331 : * IPVD=1 :: option 'SUIT' => force la complétion du .pvd (erreur s'il n'existe pas ou s'il est incompatible)
332 : * IPVD=2 :: option 'NOUV' => force l'écriture d'un nouveau .pvd
333 : * IPVD=3 :: option 'NPVD' => pas de fichier .pvd
334 : IPVD=0
335 :
336 : * IVTU=0 :: option 'FORMATE' => écriture du .vtu en formaté (ascii)
337 : * IVTU=1 :: option 'BINAIRE' => écriture du .vtu en binaire (section AppendedData)
338 : * IVTU=2 :: option 'ZIP' => idem que 'BINA', avec compression zlib en plus
339 : IVTU=1
340 :
341 : * ZTEMP :: option 'TEMP'
342 : XTPS=0.D0
343 : ZTEMP=.FALSE.
344 :
345 : * ZDOUB :: option 'DOUBLE_PRECISION'
346 : ZDOUB=.FALSE.
347 : FMDAT=FMR4
348 : FLDAT='Float32'
349 : ISIZDA=4
350 :
351 : * ZOPT1 evite les ambiguites sur la valeur de IPVD
352 : * ZOPT2 evite les ambiguites sur la valeur de IVTU
353 : ZOPT1=.FALSE.
354 : ZOPT2=.FALSE.
355 :
356 :
357 :
358 : * (branchement vers les etiquettes de lecture d'objets =LIROBJ)
359 : 10 CONTINUE
360 :
360 : CALL QUETYP(CHA8,0,IRETOU)
361 : IF (IRETOU.EQ.0) GOTO 99
362 :
363 : ILAB=0
364 : IF (CHA8.EQ.'MAILLAGE') ILAB=1
365 : IF (CHA8.EQ.'CHPOINT' ) ILAB=2
366 : IF (CHA8.EQ.'MCHAML' ) ILAB=3
367 : IF (CHA8.EQ.'TABLE' ) ILAB=4
368 : IF (ILAB.GT.0) GOTO(20,30,40,50),ILAB
369 :
370 : IF (CHA8.EQ.'MOT') THEN
370 : CALL LIRCHA(CHA4,1,LCHA)
370 : CALL CHRMOT(MCLE,LMCLE,CHA4,ICLE)
371 : IF (ICLE.GT.0) GOTO 11
372 :
373 : * ERREUR CRITIQUE 7 (On ne comprend pas le mot %m1:4)
374 : MOTERR(1:4)=CHA4
374 : CALL ERREUR(7)
375 : RETURN
376 : ENDIF
377 :
378 : * ERREUR CRITIQUE 39 (On ne veut pas d'objet de type %m1:8)
379 : MOTERR(1:8)=CHA8
379 : CALL ERREUR(39)
380 : RETURN
381 :
382 :
383 :
384 : * (branchement vers les étiquettes de traitement des mots-clés)
385 : 11 GOTO( 70, 70, 70, 70, 71, 71, 71, 72, 73 ),ICLE
386 : * AUTO SUIT NOUV NPVD FORM BINA ZIP TEMP DOUB
387 :
388 :
389 :
390 : * =============================================
391 : * LECTURE ET MÉMORISATION D'UN OBJET 'MAILLAGE'
392 : * =============================================
393 :
394 : 20 CONTINUE
395 :
396 : * Lecture d'un nouveau MELEME
396 : CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
397 : IF (IERR.NE.0) GOTO 999
398 :
399 : * Vérification que le MELEME n'est pas déjà dans la liste
400 : DO I1=1,NBMAIL
401 : IF (IMAIL(I1).EQ.IPT1) GOTO 60
402 : ENDDO
403 : NBMAIL=NBMAIL+1
404 :
405 : * Attribution d'un nom par défaut à l'objet lu
406 : WRITE(CHA4,FMT='(I4.4)') NBMAIL
407 :
408 : * Mémorisation des informations
409 : SEGADJ,SMAIL
410 : IMAIL(NBMAIL)=IPT1
411 : TMAIL(NBMAIL)=CHA4
412 :
413 : GOTO 60
414 :
415 :
416 : * ============================================
417 : * LECTURE ET MÉMORISATION D'UN OBJET 'CHPOINT'
418 : * ============================================
419 :
420 : 30 CONTINUE
421 :
422 : * Lecture d'un nouveau CHPOINT
422 : CALL LIROBJ('CHPOINT',MCHPO1,1,IRETOU)
423 : IF (IERR.NE.0) GOTO 999
424 :
425 : * Vérification que le CHPOINT n'est pas déjà dans la liste
426 : DO I1=1,NBCHPO
427 : IF (ICHPO(I1).EQ.MCHPO1) GOTO 60
428 : ENDDO
429 : NBCHPO=NBCHPO+1
430 :
431 : * Attribution d'un nom par défaut à l'objet lu
431 : CALL QUENOM(CHA8)
432 : IF (CHA8.EQ.' ') WRITE(CHA8,FMT='("CHPO",I4.4)') NBCHPO
433 :
434 : * Mémorisation des informations
435 : SEGADJ,SCHPO
436 : ICHPO(NBCHPO)=MCHPO1
437 : TCHPO(NBCHPO)=CHA8
438 :
439 : GOTO 60
440 :
441 :
442 : * ===========================================
443 : * LECTURE ET MÉMORISATION D'UN OBJET 'MCHAML'
444 : * ===========================================
445 :
446 : 40 CONTINUE
447 :
448 : * Lecture d'un nouveau MCHAML
448 : CALL LIROBJ('MCHAML',MCHEL1,1,IRETOU)
449 : IF (IERR.NE.0) GOTO 999
450 :
451 : * Vérification que le MCHAML n'est pas déjà dans la liste
452 : DO I1=1,NBCHML
453 : IF (ICHML(I1).EQ.MCHEL1) GOTO 60
454 : ENDDO
455 : NBCHML=NBCHML+1
456 :
457 : * Attribution d'un nom par défaut à l'objet lu
457 : CALL QUENOM(CHA8)
458 : IF (CHA8.EQ.' ') WRITE(CHA8,FMT='("CHML",I4.4)') NBCHML
459 :
460 : * Mémorisation des informations
461 : SEGADJ,SCHML
462 : ICHML(NBCHML)=MCHEL1
463 : TCHML(NBCHML)=CHA8
464 :
465 : GOTO 60
466 :
467 :
468 : * ===========================================
469 : * LECTURE ET DECOMPOSITION D'UN OBJET 'TABLE'
470 : * ===========================================
471 :
472 : 50 CONTINUE
473 :
474 : * Lecture d'une TABLE
474 : CALL LIROBJ('TABLE',MTABLE,1,IRETOU)
475 : IF (IERR.NE.0) GOTO 999
476 :
477 : * Décomposition de la TABLE en objets MAILLAGE, CHPOINT et MCHAML
478 : SEGACT,MTABLE
479 : DO K=MLOTAB,1,-1
480 :
481 : * Conversion de l'indice en chaine de caracteres
482 : CHA4=MTABTI(K)(1:4)
483 : IF (CHA4.EQ.'ENTI') WRITE(CHA8,FMT='(I8.8)') MTABII(K)
484 : IF (CHA4.EQ.'FLOT') WRITE(CHA8,FMT='(F8.4)') RMTABI(K)
485 : IF (CHA4.EQ.'MOT') THEN
486 : CHA8=' '
487 : IF (NBESC.NE.0) SEGACT IPILOC
488 : IMO1=IPCHAR(MTABII(K))
489 : IMO2=IPCHAR(MTABII(K)+1)
490 : ILON=MIN(8,IMO2-IMO1)
491 : CHA8(1:ILON)=ICHARA(IMO1:IMO1+ILON-1)
492 : IF (NBESC.NE.0) SEGDES IPILOC
493 : ENDIF
494 :
495 : * Vérification que le type d'objet est valide
496 : ITYPOK=0
497 : IF (MTABTV(K).EQ.'MAILLAGE') THEN
498 : ITYPOK=4
499 : IF (CHA4.EQ.'ENTI') CHA8(1:4)=CHA8(5:8)
500 : IF (CHA4.EQ.'FLOT') CHA8(1:4)=CHA8(2:5)
501 : ELSEIF (MTABTV(K).EQ.'CHPOINT'.OR.MTABTV(K).EQ.'MCHAML') THEN
502 : ITYPOK=8
503 : ENDIF
504 :
505 : * Ecriture du nom puis du pointeur vers l'objet
506 : IF (ITYPOK.GT.0) THEN
506 : CALL ECRCHA(CHA8(1:ITYPOK))
506 : CALL ECROBJ(MTABTV(K),MTABIV(K))
507 : ELSE
508 : * ERREUR CRITIQUE 763 (Dans la table %m1:8, l'objet d'indice %m9:16 n'est pas de type %m17:40)
508 : CALL QUENOM(CHA8)
509 : MOTERR(1:8)=CHA8
510 : WRITE(MOTERR(9:16),FMT='("n°",I6)') K
511 : MOTERR(17:40)=' MAILLAGE/CHPOINT/MCHAML'
511 : CALL ERREUR(763)
512 : RETURN
513 : ENDIF
514 : ENDDO
515 : SEGDES,MTABLE
516 :
517 : GOTO 10
518 :
519 :
520 : * ========================================
521 : * ATTRIBUTION D'UN NOM AU DERNIER OBJET LU
522 : * ========================================
523 :
524 : 60 CONTINUE
525 :
525 : CALL QUETYP(CHA8,0,IRETOU)
526 : IF (IRETOU.NE.0.AND.CHA8.EQ.'MOT') THEN
526 : CALL LIRCHA(CHA8,0,LCHA)
526 : CALL CHRMOT(MCLE,LMCLE,CHA8(1:4),ICLE)
527 : IF (ICLE.GT.0) GOTO 11
528 : * Remarque : On utilise le fait que I1 est incrémenté au passage sur ENDDO
529 : * Ainsi, I1 reste figé si on sort prématurement, et vaut bien N+1
530 : * si les N itérations se sont déroulées sans encombre
531 : IF (ILAB.EQ.1) THEN
532 : TMAIL(I1)='____'
533 : TMAIL(I1)(1:LCHA)=CHA8(1:LCHA)
534 : ENDIF
535 : IF (ILAB.EQ.2) TCHPO(I1)=CHA8
536 : IF (ILAB.EQ.3) TCHML(I1)=CHA8
537 : ENDIF
538 :
539 : GOTO 10
540 :
541 :
542 : * ====================
543 : * LECTURE D'UN MOT-CLÉ
544 : * ====================
545 :
546 : * Mots-clés 'AUTO, 'NOUV', 'SUIT' ou 'NPVD'
547 : 70 CONTINUE
548 : ICLE1=ICLE-1
549 : IF (ZOPT1.AND.IPVD.NE.ICLE1) THEN
550 : * ERREUR CRITIQUE 880 (Syntaxe incorrecte, voir notice)
550 : CALL ERREUR(880)
551 : WRITE(IOIMP,*) '(options ',MCLE(IPVD),' et ',MCLE(ICLE),
552 : . ' incompatibles)'
553 : RETURN
554 : ENDIF
555 : ZOPT1=.TRUE.
556 : IPVD=ICLE1
557 : GOTO 10
558 :
559 : * Mots-clés 'FORM, 'BINA' ou 'ZIP'
560 : 71 CONTINUE
561 : ICLE1=ICLE-5
562 : IF (ZOPT2.AND.IVTU.NE.ICLE1) THEN
563 : * ERREUR CRITIQUE 880 (Syntaxe incorrecte, voir notice)
563 : CALL ERREUR(880)
564 : WRITE(IOIMP,*) '(options ',MCLE(IVTU+4),' et ',MCLE(ICLE),
565 : . ' incompatibles)'
566 : RETURN
567 : ENDIF
568 : ZOPT2=.TRUE.
569 : IVTU=ICLE1
570 :
571 : IF (IVTU.EQ.2) THEN
572 : * ERREUR CRITIQUE 251 (Tentative d'utilisation d'une option non implémentée)
572 : CALL ERREUR(251)
573 : WRITE(IOIMP,*) '(option ZIP indisponible pour le moment)'
574 : RETURN
575 : ENDIF
576 : GOTO 10
577 :
578 : * Mot-clé 'TEMP'
579 : 72 CONTINUE
580 : ZTEMP=.TRUE.
580 : CALL LIRREE(XTPS,0,IRETOU)
581 : IF (IRETOU.EQ.0) THEN
582 : * ERREUR CRITIQUE 166 (Le mot-clé %m1:4 n'est pas suivi de la donnée correspondante)
583 : MOTERR(1:4)='TEMP'
583 : CALL ERREUR(166)
584 : RETURN
585 : ENDIF
586 : GOTO 10
587 :
588 : * Mot-clé 'DOUB'
589 : 73 CONTINUE
590 : ZDOUB=.TRUE.
591 : FMDAT=FMR8
592 : FLDAT='Float64'
593 : ISIZDA=8
594 : GOTO 10
595 :
596 :
597 :
598 :
599 : 99 CONTINUE
600 :
601 :
602 : * Vérification : il faut au moins 1 objet MAILLAGE pour continuer
603 : IF (NBMAIL.EQ.0) THEN
604 : * ERREUR CRITIQUE 37 (On ne trouve pas d'objet de type %m1:8)
605 : MOTERR(1:8)='MAILLAGE'
605 : CALL ERREUR(37)
606 : RETURN
607 : ENDIF
608 :
609 : * Il y a-t-il plusieurs objets MAILLAGE ?
610 : ZPART=(NBMAIL.GT.1)
611 :
612 :
613 :
614 : * IMPRESSIONS POUR DEBOGAGE
615 : * #########################
616 : IF (IIMPI.NE.0) THEN
617 : WRITE(IOIMP,FMT='(I2,A)') NBMAIL,' MAILLAGE(s) lu(s)'
618 : WRITE(IOIMP,FMT='(5X,I7,2X,A4)') (IMAIL(I),TMAIL(I),I=1,NBMAIL)
619 :
620 : WRITE(IOIMP,FMT='(I2,A)') NBCHPO,' CHPOINT(s) lu(s)'
621 : WRITE(IOIMP,FMT='(5X,I7,2X,A8)') (ICHPO(I),TCHPO(I),I=1,NBCHPO)
622 :
623 : WRITE(IOIMP,FMT='(I2,A)') NBCHML,' MCHAML(s) lu(s)'
624 : WRITE(IOIMP,FMT='(5X,I7,2X,A8)') (ICHML(I),TCHML(I),I=1,NBCHML)
625 : ENDIF
626 : * #########################
627 :
628 :
629 :
630 :
631 : ************************************************************************
632 : ************************************************************************
633 : ************************************************************************
634 : ************************************************************************
635 :
636 :
637 :
638 :
639 : * +---------------------------------------------------------------+
640 : * | |
641 : * | V É R I F I C A T I O N S D A N S L E . P V D |
642 : * | |
643 : * +---------------------------------------------------------------+
644 :
645 :
646 : NOM3=NOM1(1:LONG(NOM1))//NOMFIC(1:LONG(NOMFIC))//'.pvd'
647 :
648 : INQUIRE(FILE=NOM3,EXIST=ZEXIS)
649 :
650 :
651 : * Option 'AUTO' ou 'SUIT' : on vérifie que le .pvd pré-existant
652 : * est compatible avec les données que l'on veut rajouter
653 : * (cette vérification n'a pas vocation à être infaillible, elle
654 : * permet seulement d'éviter aux étourdis de corrompre le .pvd)
655 : *
656 : * Après lecture du .pvd : ITF=dernier indice enregistré
657 : * XTF=dernier instant enregistré
658 : ITF=0
659 : IF (IPVD.LT.2.AND.ZEXIS) THEN
660 : OPEN(UNIT = IOXML ,
661 : . FILE = NOM3 ,
662 : . STATUS = 'OLD' ,
663 : . FORM = 'FORMATTED' ,
664 : . ACCESS = 'SEQUENTIAL',
665 : . IOSTAT = IOS )
665 : CALL FINFIC(IOXML)
666 :
667 : * a) Si 'TEMP' est spécifié, on vérifie que le .pvd contient un
668 : * champ 'timestep' et que la chronologie est respectée. Si en
669 : * outre plusieurs maillages sont fournis, on vérifie que la
670 : * partition est identique (vérif. du nom et du nombre seult.)
671 :
672 : IF (ZTEMP) THEN
673 :
674 : * On va devoir vérifier les NBMAIL derniers items (+2 balises de fermeture du .pvd)
675 : DO I1=1,NBMAIL+2
676 : BACKSPACE(IOXML)
677 : ENDDO
678 :
679 : DO IMAI=1,NBMAIL
680 :
681 : * Lecture de l'item puis recherche des champs 'timestep', 'part' et 'file'
682 : READ(UNIT=IOXML,FMT='(A)') CBUF
683 : II1=INDEX(CBUF,'timestep=')
684 : II2=INDEX(CBUF,'part=')
685 : II3=INDEX(CBUF,'file='//DQ//NOMFIC(1:LONG(NOMFIC)))
686 :
687 :
688 : * DÉCLENCHEMENT D'UNE ERREUR SI :
689 :
690 : * - le champ 'file' ne contient pas le nom du fichier lu => 9004
691 : IF (II3.EQ.0) GOTO 9004
692 :
693 : * - les NBMAIL derniers items n'ont pas le même 'timestep' => 9001
694 : * - pas de champ 'timestep' trouvé => 9002
695 : * - le 'timestep' lu est supérieur à la valeur spécifiée dans 'TEMP' => 9003
696 : * - le format du fichier n'est pas reconnu => 9004
697 : IF (II1.GT.0) THEN
698 : WRITE(MYFMT,FMT='("(",A8,")")') FMDAT
699 : READ(CBUF(II1+10:II1+23),FMT=MYFMT,IOSTAT=IOS) XTF
700 : IF (IOS.NE.0) GOTO 9004
701 : IF (IMAI.GT.1.AND.XTF1.NE.XTF) GOTO 9001
702 : IF (XTF.GE.XTPS) GOTO 9003
703 : XTF1=XTF
704 : ELSE
705 : GOTO 9002
706 : ENDIF
707 :
708 : * - un seul maillage spécifié alors qu'on a trouvé un champ 'part' => 9001
709 : * - plusieurs maillages spécifiés alors qu'on ne trouve aucun champ 'part' => 9001
710 : * - le i-ème champ 'part' n'a pas le même nom que le i-ème maillage spécifié => 9001
711 : * - le format du fichier n'est pas reconnu => 9004
712 : IF (ZPART.AND.(II2.GT.0)) THEN
713 : READ(CBUF(II2+6:II2+9),FMT='(A4)',IOSTAT=IOS) CHA4
714 : IF (IOS.NE.0) GOTO 9004
715 : IF (CHA4.NE.TMAIL(IMAI)) GOTO 9001
716 : ELSEIF (ZPART.OR.(II2.GT.0)) THEN
717 : GOTO 9001
718 : ENDIF
719 :
720 : ENDDO
721 :
722 : * PAS D'ERREUR : on récupère l'indice du dernier p.d.t.
722 : CALL LENCHA(NOMFIC,NC)
723 : READ(CBUF(II3+NC+7:II3+NC+15),FMT='(A9)',IOSTAT=IOS) CHA9
724 : II4=INDEX(CHA9,'.')-1
725 : WRITE(MYFMT,FMT='("(I",I1,".",I1,")")',IOSTAT=IOS) II4,II4
726 : READ(CHA9(1:II4),FMT=MYFMT,IOSTAT=IO3) ITF
727 : IF (IOS.NE.0.OR.II4.EQ.-1) GOTO 9004
728 :
729 :
730 : * b) Si 'TEMP' est absent, on vérifie que le .pvd ne contient pas
731 : * de champ 'timestep' mais uniquement un champ 'part'
732 : ELSE
733 : BACKSPACE(IOXML)
734 : BACKSPACE(IOXML)
735 : BACKSPACE(IOXML)
736 :
737 : * Lecture du dernier item puis recherche des champs 'timestep' et 'part'
738 : READ(UNIT=IOXML,FMT='(A)') CBUF
739 : II1=INDEX(CBUF,'timestep=')
740 : II2=INDEX(CBUF,'part=')
741 :
742 : * DÉCLENCHEMENT D'UNE ERREUR SI :
743 : * - un champ 'timestep' est trouvé => 9005
744 : * - aucun champ 'part' ni 'timestep' n'est trouvé => 9004
745 : IF (II1.GT.0) GOTO 9005
746 : IF (II2.EQ.0) GOTO 9004
747 :
748 : ENDIF
749 :
750 : CLOSE(UNIT=IOXML)
751 : ENDIF
752 :
753 :
754 : * Pas d'erreur => on passe à la suite
755 : GOTO 9000
756 :
757 :
758 : * MESSAGES D'ERREUR : fichier .pvd incompatible et option 'SUIT'
759 : * ***************************************************************
760 : * ERREUR CRITIQUE 26 (Tache impossible. Probablement données erronées)
761 :
762 : 9001 IF (IPVD.EQ.0) GOTO 9050
762 : CALL ERREUR(26)
763 : WRITE(IOIMP,*) 'VTK ''SUIT'' : le fichier existe déjà et la ',
764 : . 'partition spécifiée diffère du p.d.t. précédent'
765 : GOTO 999
766 :
767 : 9002 IF (IPVD.EQ.0) GOTO 9050
767 : CALL ERREUR(26)
768 : WRITE(IOIMP,*) 'VTK ''SUIT'' : le fichier existe déjà et ',
769 : . 'n''est pas compatible avec l''option ''TEMP'''
770 : GOTO 999
771 :
772 : 9003 IF (IPVD.EQ.0) GOTO 9050
772 : CALL ERREUR(26)
773 : WRITE(IOIMP,*) 'VTK ''SUIT'' : le fichier existe déjà et la ',
774 : . 'valeur spécifiée pour ''TEMP'' est trop petite'
775 : GOTO 999
776 :
777 : 9004 IF (IPVD.EQ.0) GOTO 9050
777 : CALL ERREUR(26)
778 : WRITE(IOIMP,*) 'VTK ''SUIT'' : le fichier existe déjà mais ',
779 : . 'il semble corrompu...'
780 : GOTO 999
781 :
782 : 9005 IF (IPVD.EQ.0) GOTO 9050
782 : CALL ERREUR(26)
783 : WRITE(IOIMP,*) 'VTK ''SUIT'' : le fichier existe déjà et ',
784 : . 'requiert l''utilisation du mot-clé ''TEMP'''
785 : GOTO 999
786 : * ***************************************************************
787 :
788 :
789 : * Fichier .pvd incompatible et option 'AUTO'
790 : * => on continue mais le .pvd existant sera écrasé
791 : 9050 ZEXIS=.FALSE.
792 :
793 :
794 :
795 :
796 :
797 : ************************************************************************
798 : ************************************************************************
799 : ************************************************************************
800 : ************************************************************************
801 :
802 :
803 :
804 :
805 : * +---------------------------------------------------------------+
806 : * | |
807 : * | É C R I T U R E D E S F I C H I E R S . V T U |
808 : * | |
809 : * +---------------------------------------------------------------+
810 :
811 : 9000 CONTINUE
812 :
813 : * Lorsqu'il y a déjà deux unités logiques XDR ouvertes (REST et
814 : * SAUV en l'occurence), l'ouverture d'une troisième unité engendre
815 : * un bug critique (redémarrage du jeu de données !). On s'assure
816 : * que le fichier de RESTitution est bien fermé pour éviter cela.
817 : IF (IVTU.GT.0.AND.IXDRR.NE.0) THEN
817 : CALL IXDRCLOSE(IXDRR,.TRUE.)
818 : IXDRR=0
819 : ENDIF
820 :
821 :
822 : * Préparation de l'entête des fichiers
822 : CALL GIBDAT(IJOUR,IMOIS,IANNEE)
823 : IANNEE=MOD(IANNEE,100)+2000
823 : CALL GIBNAM(CHA8)
823 : CALL NETCHA(CHA8)
824 : WRITE(CHEAD,FMT='(A,I2.2,A1,I2.2,A1,I4,A)')
825 : . ''
828 : CALL LENCHA(CHEAD,LHEAD)
829 :
830 :
831 : * ---------------------
832 : * NOM DES FICHIERS .vtu
833 : * ---------------------
834 : *
835 : * repetoire/ nom_de_base.XXXXxxxx.YYYY.vtu
836 : * |__________||___________|
837 : * NOM1 NOMFIC |
838 : * |____________________| |
839 : * NOM2 |
840 : * |_____________________________|
841 : * NOM3
842 : *
843 : * - XXXXxxxx : /!\ SEULEMENT SI L'OPTION 'TEMP' EST PRÉSENTE
844 : * => entier écrit sur 4 à 8 caractères et incrémenté
845 : * à chaque pas de temps sorti
846 : *
847 : * - YYYY : /!\ SEULMENT SI PLUSIEURS MAILLAGES SONT FOURNIS
848 : * OU SI ON SORT UN .PVD SANS OPTION 'TEMP'
849 : * => chaine de 4 caractères alpha-numériques indiquant
850 : * le nom de la partition géométrie sortie
851 : *
852 : NOM2=NOMFIC
853 : IF (ZTEMP) THEN
854 : IPDT=ITF+1
855 : WRITE(CHA8,FMT='(I8.8)') IPDT
856 : LPDT=MAX(4,INT(LOG10(DBLE(IPDT)))+1)
857 : NOM2=NOM2(1:LONG(NOM2))//'.'//CHA8(9-LPDT:8)
858 : ENDIF
859 :
860 :
861 : * (BOUCLE SUR LES MAILLAGES)
862 : DO 100 IMAI=1,NBMAIL
863 :
864 : * =============================================================
865 : * I N I T I A L I S A T I O N D U F I C H I E R . V T U
866 : * =============================================================
867 :
868 : * Détermination du nom complet du fichier .vtu
869 : NOM3=NOM1(1:LONG(NOM1))//NOM2
870 : IF ((.NOT.ZTEMP.AND.IPVD.LT.3).OR.ZPART) THEN
871 : NOM3=NOM3(1:LONG(NOM3))//'.'//TMAIL(IMAI)
872 : ENDIF
873 : NOM3=NOM3(1:LONG(NOM3))//'.vtu'
874 :
875 :
876 : * Commande d'ouverture du fichier XML
877 : OPEN(UNIT = IOXML,
878 : . FILE = NOM3,
879 : . STATUS = 'UNKNOWN',
880 : . FORM = 'FORMATTED',
881 : . ACCESS = 'SEQUENTIAL',
882 : . IOSTAT = IOS)
883 :
884 :
885 : * Commande d'ouverture du fichier binaire
886 : IF (IVTU.GT.0) THEN
887 : IOBIN=INITXDR(NOM3(1:LONG(NOM3))//'.bin','w',.FALSE.)
888 :
889 : * Début de la section binaire AppendedData
889 : CALL IXDRINT(IOBIN,IXDR1)
890 : IPOS=0
891 : ENDIF
892 :
893 :
894 : * Ecriture des entêtes
895 : WRITE(UNIT=IOXML,FMT='(A)',IOSTAT=IOS)
896 : . ''
897 :
898 : WRITE(UNIT=IOXML,FMT='(A)',IOSTAT=IOS)
899 : . CHEAD(1:LHEAD)
900 :
901 : IF (IVTU.EQ.0) THEN
902 : WRITE(UNIT=IOXML,FMT='(A)',IOSTAT=IOS)
903 : . ''
905 : ELSE
906 : WRITE(UNIT=IOXML,FMT='(A)',IOSTAT=IOS)
907 : . ''
909 : ENDIF
910 :
911 : WRITE(UNIT=IOXML,FMT='(4X,A)',IOSTAT=IOS)
912 : . ''
913 :
914 :
915 :
916 :
917 : * =============================================================
918 : * D O N N É E S G É O M É T R I Q U E S
919 : * =============================================================
920 : * NEL = nombre d'éléments du maillage au total
921 : * NNO = nombre de noeuds du maillage au total
922 : * NBSOU = nombre de sous-maillages (un par type d'élément)
923 :
924 : IPT1=IMAIL(IMAI)
925 : SEGACT,IPT1
926 : NBSOU=IPT1.LISOUS(/1)
927 : NBSOU1=MAX(1,NBSOU)
928 :
929 : * Pour chaque MAILLAGE passé en argument, on doit :
930 : * - remplir les tables de correspondance LOCAL <--> GLOBAL
931 : * - déterminer le nombre de noeuds au total
932 : * - déterminer le nombre d'éléments au total
933 : * - mémoriser les caractéristiques des cellules (connectivité,
934 : * offset, type d'élément VTK)
935 : * - si des MCHAML sont à sortir, mémoriser le type et le nombre
936 : * d'éléments dans chaque sous-maillage
937 :
938 : NEL=0
939 : NEL1=0
940 : NNO=0
941 : NBCON=0
942 : IOF=0
943 : SEGINI,IPOG2L,IOFFS,ITYEL,ICONN
944 : IF (NBCHML.GT.0) SEGINI,ITYPII,INECUM
945 :
946 : * (BOUCLE SUR LES SOUS-MAILLAGES)
947 : IPT2=IPT1
948 : DO ISOU=1,NBSOU1
949 : IF (NBSOU.GT.0) THEN
950 : IPT2=IPT1.LISOUS(ISOU)
951 : SEGACT,IPT2
952 : ENDIF
953 :
954 : * L'élément est-il représentable par VTK ?
955 : ITYP=IPT2.ITYPEL
956 : ITY=ITYVTK(ITYP)
957 : IF (ITY.EQ.0) THEN
958 : * ERREUR CRITIQUE 21 (Données incompatibles)
958 : CALL ERREUR(21)
959 : WRITE(IOIMP,*) 'Le maillage ',TMAIL(IMAI),
960 : . ' comporte des éléments ',NOMS(ITYP),
961 : . ' incompatibles avec VTK'
962 : GOTO 999
963 : ENDIF
964 :
965 : * On mémorise les infos ci-dessous pour aller plus vite
966 : * lors du traitement ultérieur des MCHAML
967 : IF (NBCHML.GT.0) THEN
968 : ITYPII(ITYP)=ISOU
969 : INECUM(ISOU)=NEL
970 : ENDIF
971 :
972 : * (BOUCLE SUR LES ÉLÉMENTS DU SOUS-MAILLAGE)
973 : NN1=IPT2.NUM(/1)
974 : NN2=IPT2.NUM(/2)
975 : NEL=NEL+NN2
976 : NEL1=NEL
977 : NBCON=NBCON+(NN1*NN2)
978 : SEGADJ,ICONN,IOFFS,ITYEL
979 :
980 : DO I2=1,NN2
981 : DO I1=1,NN1
982 : IF (ITY.GE.20) THEN
983 : * Correction pour les elements quadratiques
984 : I3 = INUVTK(I1,ITY-20)
985 : ELSE
986 : I3 = I1
987 : ENDIF
988 : INUM=IPT2.NUM(I3,I2)
989 : IPOG2L(INUM)=1
990 : ICONN(IOF+I1)=INUM
991 : ENDDO
992 : IOF=IOF+NN1
993 : IOFFS(NEL-NN2+I2)=IOF
994 : ITYEL(NEL-NN2+I2)=ITY
995 : ENDDO
996 :
997 : IF (NBSOU.GT.0) SEGDES,IPT2
998 : ENDDO
999 :
1000 :
1001 : * (BOUCLE SUR LA TABLE GLOBALE IPOG2L)
1002 : NNO=NBCON
1003 : SEGINI,IPOL2G
1004 : NNO=0
1005 : DO I3=1,NPMAX
1006 : IF (IPOG2L(I3).EQ.1) THEN
1007 : NNO=NNO+1
1008 : IPOL2G(NNO)=I3
1009 : IPOG2L(I3)=NNO
1010 : ENDIF
1011 : ENDDO
1012 : IF (NNO.NE.NBCON) SEGADJ,IPOL2G
1013 :
1014 : c
1015 :
1016 :
1017 : * ÉCRITURE DANS LE FICHIER
1018 : * *************************************************************
1019 : * *************************************************************
1020 :
1021 : WRITE(CNU1,FMT='(I15)') NNO
1022 : WRITE(CNU2,FMT='(I15)') NEL
1022 : CALL LIMCHA(CNU1,ID1,IF1)
1022 : CALL LIMCHA(CNU2,ID2,IF2)
1023 : WRITE(UNIT=IOXML,FMT='(8X,A)',IOSTAT=IOS)
1024 : . ''
1026 :
1027 :
1028 :
1029 : * *****************************************************
1030 : * S E C T I O N P O I N T S
1031 : * *****************************************************
1032 :
1033 : WRITE(UNIT=IOXML,FMT='(12X,A)',IOSTAT=IOS)
1034 : . ''
1035 :
1036 : * ===================== FORMATÉ =====================
1037 : IF (IVTU.EQ.0) THEN
1038 : WRITE(UNIT=IOXML,FMT='(16X,A)',IOSTAT=IOS)
1039 : . ''
1041 :
1042 : DO IK=1,NNO
1043 : II=IPOL2G(IK)-1
1044 :
1045 : XRE8=XCOOR(II*IDIM1+1)
1046 : YRE8=XCOOR(II*IDIM1+2)
1047 : ZRE8=0.D0
1048 : IF (IDIM.EQ.3) ZRE8=XCOOR(II*IDIM1+3)
1049 :
1050 : WRITE(MYFMT,FMT='("(20X,3",A8,")")') FMDAT
1051 : WRITE(UNIT=IOXML,FMT=MYFMT,IOSTAT=IOS)
1052 : . XRE8,YRE8,ZRE8
1053 : ENDDO
1054 :
1055 : WRITE(UNIT=IOXML,FMT='(16X,A)',IOSTAT=IOS)
1056 : . ' '
1057 :
1058 :
1059 : * ===================== BINAIRE =====================
1060 : ELSE
1061 :
1062 : NBYTES=(3*NNO)*ISIZDA
1063 :
1064 : WRITE(CNU1,FMT='(I15)') IPOS
1065 : IPOS=IPOS+ISIZNB+NBYTES
1066 :
1066 : CALL LIMCHA(CNU1,ID1,IF1)
1067 : WRITE(UNIT=IOXML,FMT='(16X,A)',IOSTAT=IOS)
1068 : . ' '
1099 :
1100 :
1101 : * *****************************************************
1102 : * S E C T I O N C E L L S
1103 : * *****************************************************
1104 :
1105 : WRITE(UNIT=IOXML,FMT='(12X,A)',IOSTAT=IOS)
1106 : . ''
1107 :
1108 : * ===================== FORMATÉ =====================
1109 : IF (IVTU.EQ.0) THEN
1110 : WRITE(UNIT=IOXML,FMT='(16X,A)',IOSTAT=IOS)
1111 : . ''
1113 :
1114 : WRITE(UNIT=IOXML,FMT='(20X,8I10)',IOSTAT=IOS)
1115 : . ((IPOG2L(ICONN(K))-1),K=1,ICONN(/1))
1116 :
1117 : WRITE(UNIT=IOXML,FMT='(16X,A)',IOSTAT=IOS)
1118 : . ' '
1119 :
1120 : * ----------------------
1121 :
1122 : WRITE(UNIT=IOXML,FMT='(16X,A)',IOSTAT=IOS)
1123 : . ''
1125 :
1126 : WRITE(UNIT=IOXML,FMT='(20X,8I10)',IOSTAT=IOS)
1127 : . (IOFFS(K),K=1,NEL)
1128 :
1129 : WRITE(UNIT=IOXML,FMT='(16X,A)',IOSTAT=IOS)
1130 : . ' '
1131 :
1132 : * ----------------------
1133 :
1134 : WRITE(UNIT=IOXML,FMT='(16X,A)',IOSTAT=IOS)
1135 : . ''
1137 :
1138 : WRITE(UNIT=IOXML,FMT='(20X,20I4)',IOSTAT=IOS)
1139 : . (ITYEL(K),K=1,NEL)
1140 :
1141 : WRITE(UNIT=IOXML,FMT='(16X,A)',IOSTAT=IOS)
1142 : . ' '
1143 :
1144 :
1145 : * ===================== BINAIRE =====================
1146 : ELSE
1147 : NBYTES=ICONN(/1)*4
1148 :
1149 : WRITE(CNU1,FMT='(I15)') IPOS
1150 : IPOS=IPOS+ISIZNB+NBYTES
1151 :
1151 : CALL LIMCHA(CNU1,ID1,IF1)
1152 : WRITE(UNIT=IOXML,FMT='(16X,A)',IOSTAT=IOS)
1153 : . ' '
1211 :
1212 : * *************************************************************
1213 : * *************************************************************
1214 : * FIN D'ÉCRITURE DANS LE FICHIER
1215 :
1216 :
1217 : SEGSUP,IPOL2G,ICONN,IOFFS,ITYEL
1218 :
1219 :
1220 :
1221 :
1222 :
1223 : * =============================================================
1224 : * G R A N D E U R S D É F I N I E S A U X N O E U D S
1225 : * =============================================================
1226 :
1227 : WRITE(UNIT=IOXML,FMT='(12X,A)',IOSTAT=IOS)
1228 : . ''
1229 :
1230 : * (BOUCLE SUR LES CHAMPS PAR POINTS)
1231 : DO 200 ICHP=1,NBCHPO
1232 :
1233 : MCHPO1=ICHPO(ICHP)
1234 : SEGACT,MCHPO1
1235 :
1236 : * NSOUPO = Nombre de sous-champs
1237 : NSOUPO=MCHPO1.IPCHP(/1)
1238 : IF (NSOUPO.EQ.0) GOTO 200
1239 :
1240 :
1241 : * 1) CRÉATION DE LA LISTE DES COMPOSANTES DANS TCHCO
1242 : * On crée cette liste avant toute chose et non pas au fur
1243 : * et à mesure pour éviter de faire des SEGADJ sur le gros
1244 : * segment SCHPV
1245 : JGN=4
1246 : JGM=0
1247 : SEGINI,TCHCO
1248 : DO I1=1,NSOUPO
1249 : MSOUP1=MCHPO1.IPCHP(I1)
1250 : SEGACT,MSOUP1
1251 : NC=MSOUP1.NOCOMP(/2)
1252 : JGM1=JGM
1253 : DO 210 I2=1,NC
1254 : CHA4=MSOUP1.NOCOMP(I2)
1255 : DO I3=1,JGM1
1256 : IF (TCHCO.MOTS(I3).EQ.CHA4) GOTO 210
1257 : ENDDO
1258 : JGM=JGM+1
1259 : SEGADJ,TCHCO
1260 : TCHCO.MOTS(JGM)=CHA4
1261 : 210 CONTINUE
1262 : SEGDES,MSOUP1
1263 : ENDDO
1264 :
1265 :
1266 : * 2) CONCATÉNATION DE TOUS LES VPOCHA DANS XPOCHA
1267 : * - on écrase la structure compliquée du CHPOINT dans un simple tableau (n°comp.;n°noeud)
1268 : * - on passe de la numérotation globale à la numérotation locale
1269 : NCO=JGM
1270 : SEGINI,SCHPV,ICOOK
1271 : DO 220 ISOU=1,NSOUPO
1272 : MSOUP1=MCHPO1.IPCHP(ISOU)
1273 : SEGACT,MSOUP1
1274 :
1275 : MPOVA1=MSOUP1.IPOVAL
1276 : IF (MPOVA1.EQ.0) GOTO 219
1277 : SEGACT,MPOVA1
1278 :
1279 : IPT2=MSOUP1.IGEOC
1280 : IF (IPT2.EQ.0) GOTO 218
1281 : SEGACT,IPT2
1282 :
1283 : NN1=MPOVA1.VPOCHA(/1)
1284 : NC1=MPOVA1.VPOCHA(/2)
1285 :
1286 : DO I1=1,NC1
1287 : * Recherche de la composante dans la liste TCHCO
1288 : CHA4=MSOUP1.NOCOMP(I1)
1289 : DO ICO=1,NCO
1290 : IF (TCHCO.MOTS(ICO).EQ.CHA4) GOTO 240
1291 : ENDDO
1292 :
1293 : * MISE À JOUR DE SCHPV
1294 : * - si un noeud du support du SOUPO n'appartient pas au maillage courant, on passe au suivant
1295 : * - si un noeud du MAILLAGE courant n'est pas présent dans le support du SOUPO, sa valeur reste à zéro
1296 : 240 NTROUV=0
1297 : DO 250 I2=1,NN1
1298 : INO=IPOG2L(IPT2.NUM(1,I2))
1299 : IF (INO.EQ.0) GOTO 250
1300 : SCHPV.XPOCHA(ICO,INO)=SCHPV.XPOCHA(ICO,INO)
1301 : & +MPOVA1.VPOCHA(I2,I1)
1302 : NTROUV=1
1303 : 250 CONTINUE
1303 : IF (NTROUV.EQ.1) CALL AJOU(ICOOK,ICO)
1304 : ENDDO
1305 :
1306 : SEGDES,IPT2
1307 : 218 SEGDES,MPOVA1
1308 : 219 SEGDES,MSOUP1
1309 : 220 CONTINUE
1310 :
1311 : SEGDES,MCHPO1
1312 :
1313 :
1314 : * S'il n'y a rien à sortir, on passe au CHPOINT suivant
1315 : NCOK=ICOOK(/1)
1316 : IF (NCOK.EQ.0) GOTO 299
1316 : IF (NCOK.LT.NCO) CALL ORDO01(ICOOK(1),NCOK,.TRUE.)
1317 :
1318 :
1319 :
1320 : * ÉCRITURE DANS LE FICHIER
1321 : * *********************************************************
1322 : * *********************************************************
1323 :
1324 : WRITE(MYFMT,FMT='("(16X,A,",I2,"A5,A)")') NCOK
1325 : WRITE(UNIT=IOXML,FMT=MYFMT,IOSTAT=IOS)
1326 : . ''
1329 :
1330 :
1331 : CHA8=TCHPO(ICHP)
1332 :
1333 : * ===================== FORMATÉ =====================
1334 : IF (IVTU.EQ.0) THEN
1335 :
1336 : WRITE(CNU1,FMT='(I15)') NCOK
1336 : CALL LIMCHA(CNU1,ID1,IF1)
1337 : WRITE(UNIT=IOXML,FMT='(16X,A)',IOSTAT=IOS)
1338 : . ''
1341 :
1342 : WRITE(MYFMT,FMT='("(20X,",I2,A8,")")') NCOK,FMDAT
1343 : WRITE(UNIT=IOXML,FMT=MYFMT,IOSTAT=IOS)
1344 : . ((SCHPV.XPOCHA(ICOOK(K),J),K=1,NCOK),J=1,NNO)
1345 :
1346 : WRITE(UNIT=IOXML,FMT='(16X,A)',IOSTAT=IOS)
1347 : . ' '
1348 :
1349 :
1350 : * ===================== BINAIRE =====================
1351 : ELSE
1352 : NBYTES=(NCOK*NNO)*ISIZDA
1353 :
1354 : WRITE(CNU1,FMT='(I15)') IPOS
1355 : IPOS=IPOS+ISIZNB+NBYTES
1356 :
1357 : WRITE(CNU2,FMT='(I15)') NCOK
1357 : CALL LIMCHA(CNU1,ID1,IF1)
1357 : CALL LIMCHA(CNU2,ID2,IF2)
1358 : WRITE(UNIT=IOXML,FMT='(16X,A)',IOSTAT=IOS)
1359 : . ' '
1393 :
1394 :
1395 : SEGSUP,IPOG2L
1396 :
1397 :
1398 :
1399 :
1400 :
1401 : * =============================================================
1402 : * G R A N D E U R S D É F I N I E S P A R É L É M E N T
1403 : * =============================================================
1404 :
1405 : WRITE(UNIT=IOXML,FMT='(12X,A)',IOSTAT=IOS)
1406 : . ''
1407 :
1408 : * (BOUCLE SUR LES CHAMPS PAR ÉLÉMENTS)
1409 : DO 300 ICHE=1,NBCHML
1410 :
1411 : MCHEL1=ICHML(ICHE)
1412 : SEGACT,MCHEL1
1413 :
1414 : * NSOCHA = Nombre de sous-champs
1415 : NSOCHA=MCHEL1.ICHAML(/1)
1416 : IF (NSOCHA.EQ.0) GOTO 300
1417 :
1418 :
1419 : * 1) CRÉATION DE LA LISTE DES COMPOSANTES DANS TCHCO
1420 : * On crée cette liste avant toute chose et non pas au fur
1421 : * et à mesure pour éviter de faire des SEGADJ sur le gros
1422 : * segment SCHMV
1423 : * + VÉRIFICATIONS SUR LE TYPE DE MCHAML
1424 : JGN=8
1425 : JGM=0
1426 : SEGINI,TCHCO
1427 : DO I1=1,NSOCHA
1428 : MCHAM1=MCHEL1.ICHAML(I1)
1429 : SEGACT,MCHAM1
1430 :
1431 : NC1=MCHAM1.IELVAL(/1)
1432 : JGM1=JGM
1433 : DO 310 I2=1,NC1
1434 :
1435 : * VÉRIFICATION 1 : composante de type scalaire ?
1436 : IF (MCHAM1.TYPCHE(I2).NE.'REAL*8') THEN
1437 : * ERREUR CRITIQUE 679 (Le type de la composante %m1:8 du MCHAML est incorrect)
1438 : MOTERR(1:8)=MCHAM1.NOMCHE(I2)
1438 : CALL ERREUR(679)
1439 : WRITE(IOIMP,*) '(le champ par éléments "',
1440 : . TCHML(ICHE),'" contient des ',
1441 : . 'composantes non scalaires'
1442 : GOTO 999
1443 : ENDIF
1444 :
1445 : * VÉRIFICATION 2 : une seule valeur par cellule ?
1446 : MELVA1=MCHAM1.IELVAL(I2)
1447 : SEGACT,MELVA1
1448 : IF (MELVA1.VELCHE(/1).NE.1) THEN
1449 : * ERREUR CRITIQUE 707 (Le MCHAML doit contenir une valeur (de chaque composante) par élément)
1449 : CALL ERREUR(707)
1450 : WRITE(IOIMP,*) '(le champ par éléments "',
1451 : . TCHML(ICHE),'" n''est pas de',
1452 : . ' type "GRAVITE")'
1453 : GOTO 999
1454 : ENDIF
1455 : SEGDES,MELVA1
1456 :
1457 : * CRÉATION DE LA LISTE TCHCO
1458 : CHA8=MCHAM1.NOMCHE(I2)
1459 : DO I3=1,JGM1
1460 : IF (TCHCO.MOTS(I3).EQ.CHA8) GOTO 310
1461 : ENDDO
1462 : JGM=JGM+1
1463 : SEGADJ,TCHCO
1464 : TCHCO.MOTS(JGM)=CHA8
1465 : 310 CONTINUE
1466 :
1467 : SEGDES,MCHAM1
1468 : ENDDO
1469 :
1470 :
1471 :
1472 : * 2) CONCATÉNATION DE TOUS LES VELCHE DANS XELCHE
1473 : * - on écrase la structure compliquée du MCHAML dans un simple tableau (n°comp.;n°cell.)
1474 : * - on passe de la numérotation globale à la numérotation locale
1475 : NCO=JGM
1476 : SEGINI,SCHMV,ICOOK
1477 : DO 320 I1=1,NSOCHA
1478 : MCHAM1=MCHEL1.ICHAML(I1)
1479 : SEGACT,MCHAM1
1480 :
1481 : * IPT2 = SUPPORT DU SOUS-CHAMP DU MCHAML
1482 : IPT2=MCHEL1.IMACHE(I1)
1483 : SEGACT,IPT2
1484 : ITYP2=IPT2.ITYPEL
1485 : ITY2=ITYVTK(ITYP2)
1486 : IF (ITY2.EQ.0) THEN
1487 : C ERREUR CRITIQUE 21 (Données incompatibles)
1487 : CALL ERREUR(21)
1488 : WRITE(IOIMP,*) 'Le champ "',TCHML(ICHE),
1489 : . '" s''appuye sur des éléments ',
1490 : . NOMS(ITYP),' incompatibles avec VTK'
1491 : GOTO 999
1492 : ENDIF
1493 : NEL2=IPT2.NUM(/2)
1494 :
1495 :
1496 : * IPT3 = SOUS-MELEME DU MAILLAGE COURANT CONSTITUE DU
1497 : * MEME TYPE D'ELEMENTS QUE IPT2
1498 : I3=ITYPII(ITYP2)
1499 : IF (I3.EQ.0) GOTO 319
1500 : IPT3=IPT1
1501 : IF (NBSOU.GT.0) THEN
1502 : IPT3=IPT1.LISOUS(I3)
1503 : SEGACT,IPT3
1504 : ENDIF
1505 : NNN3=IPT3.NUM(/1)
1506 : NEL3=IPT3.NUM(/2)
1507 :
1508 :
1509 : * On cherche pour chaque élément de IPT2 un élément de
1510 : * IPT3 qui possède les mêmes noeuds, dans le même ordre
1511 : SEGINI,IELL2G
1512 : DO 330 IEL2=1,NEL2
1513 : DO 331 IEL3=1,NEL3
1514 : DO INO=1,NNN3
1515 : INUM2=IPT2.NUM(INO,IEL2)
1516 : INUM3=IPT3.NUM(INO,IEL3)
1517 : IF (INUM2.NE.INUM3) GOTO 331
1518 : ENDDO
1519 :
1520 : * ON A TROUVÉ UN ÉLÉMENT COMMUN A IPT2 ET IPT3
1521 : IELL2G(IEL2)=INECUM(I3)+IEL3
1522 : GOTO 330
1523 : 331 CONTINUE
1524 : 330 CONTINUE
1525 :
1526 :
1527 : * Remplissage de SCHMV pour chaque composante du SOCHA
1528 : DO 340 J1=1,NCO
1529 : MELVA1=MCHAM1.IELVAL(J1)
1530 : IF (MELVA1.EQ.0) GOTO 340
1531 : SEGACT,MELVA1
1532 : NBVAL=MELVA1.VELCHE(/2)
1533 :
1534 : * Recherche de la composante dans la liste TCHCO
1535 : CHA8=MCHAM1.NOMCHE(J1)
1536 : DO ICO=1,NCO
1537 : IF (TCHCO.MOTS(ICO).EQ.CHA8) GOTO 350
1538 : ENDDO
1539 :
1540 : * MISE À JOUR DE SCHMV
1541 : * - si une cellule du support du SOCHA n'appartient pas au maillage courant, on passe à la suivante
1542 : * - si une cellule du MAILLAGE courant n'est pas présente dans le support du SOCHA, sa valeur reste à zéro
1543 : 350 NTROUV=0
1544 : DO 360 J2=1,NEL2
1545 : IEL=IELL2G(J2)
1546 : IF (IEL.EQ.0) GOTO 360
1547 : IF (NBVAL.EQ.1) THEN
1548 : * ATTENTION, le MELVA1 est uniforme !
1549 : SCHMV.XELCHE(ICO,IEL)=MELVA1.VELCHE(1,1)
1550 : ELSE
1551 : SCHMV.XELCHE(ICO,IEL)=MELVA1.VELCHE(1,J2)
1552 : ENDIF
1553 : NTROUV=1
1554 : 360 CONTINUE
1554 : IF (NTROUV.EQ.1) CALL AJOU(ICOOK,ICO)
1555 :
1556 : SEGDES,MELVA1
1557 : 340 CONTINUE
1558 :
1559 :
1560 : SEGSUP,IELL2G
1561 :
1562 : * /!\ IPT2 et IPT3 peuvent être égaux à IPT1, or IPT1 doit rester actif !!
1563 : IF (NBSOU.GT.0) SEGDES,IPT3
1564 : 319 IF (IPT2.NE.IPT1) SEGDES,IPT2
1565 :
1566 : SEGDES,MCHAM1
1567 :
1568 : 320 CONTINUE
1569 :
1570 : SEGDES,MCHEL1
1571 :
1572 :
1573 : * S'il n'y a rien à sortir, on passe au MCHAML suivant
1574 : NCOK=ICOOK(/1)
1575 : IF (NCOK.EQ.0) GOTO 399
1575 : IF (NCOK.LT.NCO) CALL ORDO01(ICOOK(1),NCOK,.TRUE.)
1576 :
1577 :
1578 :
1579 :
1580 : * ÉCRITURE DANS LE FICHIER
1581 : * *********************************************************
1582 : * *********************************************************
1583 :
1584 : WRITE(MYFMT,FMT='("(16X,A,",I2,"A9,A)")') NCOK
1585 : WRITE(UNIT=IOXML,FMT=MYFMT,IOSTAT=IOS)
1586 : . ''
1589 :
1590 :
1591 : CHA8=TCHML(ICHE)
1592 :
1593 : * ===================== FORMATÉ =====================
1594 : IF (IVTU.EQ.0) THEN
1595 :
1596 : WRITE(CNU1,FMT='(I15)') NCOK
1596 : CALL LIMCHA(CNU1,ID1,IF1)
1597 : WRITE(UNIT=IOXML,FMT='(16X,A,I2,A)',IOSTAT=IOS)
1598 : . ''
1601 :
1602 : WRITE(MYFMT,FMT='("(20X,",I2,A8,")")') NCOK,FMDAT
1603 : WRITE(UNIT=IOXML,FMT=MYFMT,IOSTAT=IOS)
1604 : . ((SCHMV.XELCHE(ICOOK(K),J),K=1,NCOK),J=1,NEL)
1605 :
1606 : WRITE(UNIT=IOXML,FMT='(16X,A)',IOSTAT=IOS)
1607 : . ' '
1608 :
1609 :
1610 : * ===================== BINAIRE =====================
1611 : ELSE
1612 : NBYTES=(NCOK*NEL)*ISIZDA
1613 :
1614 : WRITE(CNU1,FMT='(I15)') IPOS
1615 : IPOS=IPOS+ISIZNB+NBYTES
1616 :
1617 : WRITE(CNU2,FMT='(I15)') NCOK
1617 : CALL LIMCHA(CNU1,ID1,IF1)
1617 : CALL LIMCHA(CNU2,ID2,IF2)
1618 : WRITE(UNIT=IOXML,FMT='(16X,A,I2,A)',IOSTAT=IOS)
1619 : . ' '
1653 :
1654 :
1655 :
1656 : SEGDES,IPT1
1657 : IF (NBCHML.GT.0) SEGSUP,ITYPII,INECUM
1658 :
1659 :
1660 :
1661 :
1662 : * =============================================================
1663 : * F E R M E T U R E D U F I C H I E R . V T U
1664 : * =============================================================
1665 :
1666 : WRITE(UNIT=IOXML,FMT='(8X,A)',IOSTAT=IOS)
1667 : . ' '
1668 :
1669 : WRITE(UNIT=IOXML,FMT='(4X,A)',IOSTAT=IOS)
1670 : . ' '
1671 :
1672 :
1673 : * CAS DES FICHIERS BINAIRES (OPTIONS 'BINA' OU 'ZIP')
1674 : * On doit recopier le contenu du fichier .bin dans la balise
1675 : * du fichier .vtu
1676 : IF (IVTU.GT.0) THEN
1677 :
1678 : WRITE(UNIT=IOXML,FMT='(4X,A)',IOSTAT=IOS)
1679 : . ''
1680 :
1681 : * Changement de mode d'écriture ASCII->BINAIRE pour le .vtu
1682 : CLOSE(UNIT=IOXML)
1683 : IOBIN2=INITXDR(NOM3,'a',.FALSE.)
1684 :
1685 : * Relecture et copie du fichier binaire
1686 : * (par paquets de 4 octets, "brique de base" de XDR)
1686 : CALL IXDRCLOSE(IOBIN,.FALSE.)
1687 : IOBIN=INITXDR(NOM3(1:LONG(NOM3))//'.bin','r',.FALSE.)
1688 : DO I=1,(1+(IPOS/4))
1688 : CALL IXDRINT(IOBIN ,INT4)
1688 : CALL IXDRINT(IOBIN2,INT4)
1689 : ENDDO
1690 :
1691 : * Suppression du fichier binaire temporaire
1691 : CALL IXDRCLOSE(IOBIN,.FALSE.)
1692 : OPEN(UNIT = IOBIN,
1693 : . FILE = NOM3(1:LONG(NOM3))//'.bin')
1694 : CLOSE(UNIT=IOBIN,STATUS='DELETE')
1695 :
1696 : * Insertion des marqueurs EOR et EOF pour que le contenu de
1697 : * la section binaire ne soit pas écrasé lors de la fermeture
1698 : * de la balise (effectuée ci-après)
1698 : CALL IXDRINT(IOBIN2,IXDR2)
1698 : CALL IXDRINT(IOBIN2,IXDR2)
1699 :
1700 : * Changement de mode d'écriture BINAIRE->ASCII pour le .vtu
1700 : CALL IXDRCLOSE(IOBIN2,.FALSE.)
1701 : OPEN(UNIT = IOXML ,
1702 : . FILE = NOM3 ,
1703 : . STATUS = 'UNKNOWN' ,
1704 : . FORM = 'FORMATTED' ,
1705 : . ACCESS = 'SEQUENTIAL' ,
1706 : . IOSTAT = IOS )
1706 : CALL FINFIC(IOXML)
1707 :
1708 : WRITE(UNIT=IOXML,FMT='(4X,A)',IOSTAT=IOS)
1709 : . ' '
1710 :
1711 : ENDIF
1712 :
1713 : WRITE(UNIT=IOXML,FMT='(A)',IOSTAT=IOS)
1714 : . ' '
1715 :
1716 :
1717 : CLOSE(UNIT=IOXML)
1718 :
1719 :
1720 : 100 CONTINUE
1721 : * (FIN DE LA BOUCLE SUR LES MAILLAGES)
1722 :
1723 :
1724 :
1725 :
1726 :
1727 : ************************************************************************
1728 : ************************************************************************
1729 : ************************************************************************
1730 : ************************************************************************
1731 :
1732 :
1733 :
1734 :
1735 : * +---------------------------------------------------------------+
1736 : * | |
1737 : * | É C R I T U R E D U F I C H I E R . P V D |
1738 : * | |
1739 : * +---------------------------------------------------------------+
1740 :
1741 : * Nom du fichier .pvd
1742 : NOM3=NOM1(1:LONG(NOM1))//NOMFIC(1:LONG(NOMFIC))//'.pvd'
1743 :
1744 :
1745 : * 1) Option 'NPVD'
1746 : * => fin de la subroutine
1747 : IF (IPVD.EQ.3) GOTO 999
1748 :
1749 :
1750 : * 2) Option 'AUTO' ou 'SUIT' quand le .pvd existe et est compatible
1751 : * => on complète le .pvd
1752 :
1753 : IF (IPVD.LT.2.AND.ZEXIS) THEN
1754 :
1755 : * On se place à la fin du fichier existant puis...
1756 : OPEN(UNIT = IOXML ,
1757 : . FILE = NOM3 ,
1758 : . STATUS = 'OLD' ,
1759 : . FORM = 'FORMATTED' ,
1760 : . ACCESS = 'SEQUENTIAL' ,
1761 : . IOSTAT = IOS )
1761 : CALL FINFIC(IOXML)
1762 :
1763 : * ...on recule de 2 enregistrements pour écraser les balises de
1764 : * fermeture
1765 : BACKSPACE(IOXML)
1766 : BACKSPACE(IOXML)
1767 :
1768 :
1769 : * 3) Option 'NOUV', ou pas de fichier existant et compatible
1770 : * => on crée le .pvd (ou on l'écrase)
1771 : ELSE
1772 : OPEN(UNIT = IOXML ,
1773 : . FILE = NOM3 ,
1774 : . STATUS = 'UNKNOWN' ,
1775 : . FORM = 'FORMATTED' ,
1776 : . ACCESS = 'SEQUENTIAL' ,
1777 : . IOSTAT = IOS )
1778 : REWIND(IOXML)
1779 :
1780 : WRITE(UNIT=IOXML,FMT='(A)',IOSTAT=IOS)
1781 : . ''
1782 :
1783 : WRITE(UNIT=IOXML,FMT='(A)',IOSTAT=IOS)
1784 : . CHEAD(1:LHEAD)
1785 :
1786 : WRITE(UNIT=IOXML,FMT='(A)',IOSTAT=IOS)
1787 : . ''
1788 :
1789 : WRITE(UNIT=IOXML,FMT='(4X,A)',IOSTAT=IOS)
1790 : . ''
1791 : ENDIF
1792 :
1793 :
1794 : WRITE(MYFMT,FMT='("(8X,A,",A8,",A)")') FMDAT
1795 : DO IMAI=1,NBMAIL
1796 :
1797 : * Nom de chaque fichier .vtu créé par cette exécution de la subroutine
1798 : NOM3=NOM2
1799 : IF ((.NOT.ZTEMP.AND.IPVD.LT.3).OR.ZPART) THEN
1800 : NOM3=NOM3(1:LONG(NOM3))//'.'//TMAIL(IMAI)
1801 : ENDIF
1802 : NOM3=NOM3(1:LONG(NOM3))//'.vtu'
1803 :
1804 : * ECRITURE DE LA LIGNE CORRESPONDANTE DANS LA COLLECTION
1805 : * - champ 'timestep' : seulement avec l'option 'TEMP'
1806 : * - champ 'part' : en l'absence de 'TEMP', ou si plusieurs maillages étaient fournis
1807 : * - champ 'file' : toujours !!
1808 : IF (ZTEMP) THEN
1809 : IF (ZPART) THEN
1810 : WRITE(UNIT=IOXML,FMT=MYFMT,IOSTAT=IOS)
1811 : . ' '
1828 : WRITE(UNIT=IOXML,FMT='(A)',IOSTAT=IOS) ' '
1829 :
1830 : CLOSE(UNIT=IOXML)
1831 :
1832 :
1833 :
1834 :
1835 : ************************************************************************
1836 : ************************************************************************
1837 : ************************************************************************
1838 : ************************************************************************
1839 :
1840 :
1841 :
1842 :
1843 : * +---------------------------------------------------------------+
1844 : * | |
1845 : * | F I N D E L A S U B R O U T I N E |
1846 : * | |
1847 : * +---------------------------------------------------------------+
1848 :
1849 :
1850 : 999 CONTINUE
1851 : SEGDES,SMAIL,SCHPO,SCHML
1852 :
1853 :
1854 : RETURN
1855 :
1856 : END
1857 :
1858 :
1859 :
1860 :
1861 :
© Cast3M 2003 - All rights reserved.
Disclaimer