1 subroutine sfcvgf ( nohman, mafrmd, nocdfr, ncafdg,
2 > ulsort, langue, codret)
3 c ______________________________________________________________________
7 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
9 c Version originale enregistree le 18 juin 1996 sous le numero 96036
10 c aupres des huissiers de justice Simart et Lavoir a Clamart
11 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
12 c aupres des huissiers de justice
13 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
15 c HOMARD est une marque deposee d'Electricite de France
21 c ______________________________________________________________________
23 c Suivi de Frontiere - ConVersion de la Geometrie de la Frontiere
25 c ______________________________________________________________________
26 c . nom . e/s . taille . description .
27 c .____________________________________________________________________.
28 c . nohman . e . char*8 . nom de l'objet maillage homard iteration n .
29 c . mafrmd . e . char*8 . maillage de la frontiere au format med .
30 c . nocdfr . s . char*8 . maillage de la frontiere a format C .
31 c . ncafdg . es . char*8 . nom de l'objet groupes frontiere .
32 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
33 c . langue . e . 1 . langue des messages .
34 c . . . . 1 : francais, 2 : anglais .
35 c . codret . es . 1 . code de retour des modules .
36 c . . . . 0 : pas de probleme .
37 c . . . . 2 : probleme avec la memoire .
38 c . . . . 3 : probleme avec le fichier .
39 c . . . . 5 : contenu incorrect .
40 c ______________________________________________________________________
43 c 0. declarations et dimensionnement
46 c 0.1. ==> generalites
52 parameter ( nompro = 'SFCVGF' )
68 character*8 mafrmd, nocdfr, ncafdg
70 integer ulsort, langue, codret
72 c 0.4. ==> variables locales
75 integer degre, maconf, homolo, hierar
76 integer rafdef, nbmane, typcca, typsfr, maextr
78 integer ptypel, pnoeel, nbnoto,nbelem, nvosom, pcoonc
79 integer sdimca, mdimca, dimcst
80 integer pgeoco, psomse, pnumli, ptypli, psegli, adabsc
81 integer pnumfa, pnomfa, pfamee
83 integer ptngrf, pointe, pligfa
84 integer pttgrl, ptngrl, pointl
85 integer ppovos, pvoiso
86 integer laligd, nbfd00, nblign, nbf
88 integer lalign, noelig, arelig
90 integer iaux, jaux, nsomli
91 integer codre1, codre2, codre3, codre4, codre5
92 integer codre6, codre7
95 character*8 ntrav1, ntrav2
96 character*8 ncinfo, ncnoeu, nccono, nccode
97 character*8 nccocl, ncfami
98 character*8 ncequi, ncfron, ncnomb
101 character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
102 character*8 nhtetr, nhhexa, nhpyra, nhpent
104 character*8 nhvois, nhsupe, nhsups
107 parameter ( nbmess = 10 )
108 character*80 texte(nblang,nbmess)
110 c 0.5. ==> initialisations
111 c ______________________________________________________________________
119 #ifdef _DEBUG_HOMARD_
120 write (ulsort,texte(langue,1)) 'Entree', nompro
127 c 2. recuperation des donnees du maillage HOMARD
128 c Le seul but est de recuperer dimcst. Il faut le dimcst du maillage
129 c de calcul et pas celui de la frontiere car ils peuvent etre
130 c differents : le maillage de calcul est 3D alors que la frontiere
134 c 2.1. ==> nom interne des branches
136 if ( codret.eq.0 ) then
138 #ifdef _DEBUG_HOMARD_
139 write (ulsort,texte(langue,3)) 'UTNOMH', nompro
141 call utnomh ( nohman,
143 > degre, maconf, homolo, hierar,
144 > rafdef, nbmane, typcca, typsfr, maextr,
147 > nhnoeu, nhmapo, nharet,
149 > nhtetr, nhhexa, nhpyra, nhpent,
151 > nhvois, nhsupe, nhsups,
152 > ulsort, langue, codret )
156 c 2.2. ==> recuperation de la caracteristique des dimensions
158 if ( codret.eq.0 ) then
160 call gmliat ( nhnoeu, 2, dimcst, codre0 )
163 #ifdef _DEBUG_HOMARD_
164 write (ulsort,90002) 'dimcst', dimcst
170 c 3. recuperation des donnees du maillage de la frontiere
172 #ifdef _DEBUG_HOMARD_
173 write (ulsort,90002) '3. recuperation ; codret', codret
176 c 3.1. ==> nom interne des branches
178 if ( codret.eq.0 ) then
180 #ifdef _DEBUG_HOMARD_
181 write (ulsort,texte(langue,3)) 'UTNOMC - Frontiere', nompro
183 call utnomc ( mafrmd,
185 > degre, mailet, maconf, homolo, hierar,
187 > ncinfo, ncnoeu, nccono, nccode,
189 > ncequi, ncfron, ncnomb,
190 > ulsort, langue, codret)
193 #ifdef _DEBUG_HOMARD_
194 call gmprsx ( nompro, nccono )
197 c 3.2. ==> recuperation des pointeurs
199 if ( codret.eq.0 ) then
201 call gmliat ( ncnoeu, 1, nbnoto, codre1 )
202 call gmliat ( nccono, 1, nbelem, codre2 )
203 call gmliat ( nccono, 2, nbmane, codre3 )
205 codre0 = min ( codre1, codre2, codre3 )
206 codret = max ( abs(codre0), codret,
207 > codre1, codre2, codre3 )
208 #ifdef _DEBUG_HOMARD_
209 write (ulsort,texte(langue,3)) 'UTAD11', nompro
212 call utad11 ( iaux, ncnoeu, nccono,
213 > pcoonc, jaux, jaux, jaux,
214 > ptypel, pfamee, pnoeel, jaux,
215 > ulsort, langue, codret )
219 if ( codret.eq.0 ) then
221 call gmliat ( ncfami, 1, nbf, codret )
223 #ifdef _DEBUG_HOMARD_
224 write (ulsort,texte(langue,3)) 'UTAD13', nompro
227 call utad13 ( iaux, ncfami,
229 > pointe, jaux, ptngrf,
230 > ulsort, langue, codret )
234 if ( codret.eq.0 ) then
236 call gmadoj ( ncfron, pligfa, iaux, codret )
241 c 4. correspondance entre les familles du maillage de calcul et
242 c les lignes dont on demande le suivi
244 #ifdef _DEBUG_HOMARD_
245 write (ulsort,90002) '4. correspondance ; codret', codret
248 c 4.1. ==> Enregistrement des groupes du suivi
250 if ( codret.eq.0 ) then
253 #ifdef _DEBUG_HOMARD_
254 write (ulsort,texte(langue,3)) 'UTADPT', nompro
256 call utadpt ( ncafdg, iaux,
258 > pointl, pttgrl, ptngrl,
259 > ulsort, langue, codret )
263 if ( codret.eq.0 ) then
266 #ifdef _DEBUG_HOMARD_
267 write (ulsort,texte(langue,3)) 'VCSFLG', nompro
269 call vcsflg ( nbfd00, nbf,
270 > imem(pointl), imem(pttgrl), smem(ptngrl),
271 > imem(pointe), smem(ptngrf),
272 > imem(pnumfa), smem(pnomfa),
273 > imem(pligfa), iaux,
274 > ulsort, langue, codret )
279 c 5. Allocation de la tete du maillage au format C
281 #ifdef _DEBUG_HOMARD_
282 write (ulsort,90002) '5. tete du maillage ; codret', codret
285 if ( codret.eq.0 ) then
287 call gmalot ( nocdfr, 'Cal_Fron', 0, iaux, codre1 )
288 call gmaloj ( nocdfr//'.TypeLign', ' ', nbfd00, ptypli, codre2 )
290 codre0 = min ( codre1, codre2 )
291 codret = max ( abs(codre0), codret,
296 if ( codret.eq.0 ) then
298 do 50 , iaux = 1 , nbfd00
299 imem(ptypli+iaux-1) = 0
305 c 6. Examen des lignes jusqu'a ne plus avoir de ligne fermee
312 c 6.1. ==> determination des elements voisins des sommets
313 #ifdef _DEBUG_HOMARD_
314 write (ulsort,90002) '6.1. elements voisins ; codret', codret
317 c 6.1.1. ==> comptage du nombre d'elements pour chaque sommet
318 c et determination des pointeurs par sommets sur "voisom",
319 c ranges dans la structure "povoso"
321 if ( codret.eq.0 ) then
323 call gmalot ( ntrav1, 'PtTabEnt', 0, iaux, codret )
327 if ( codret.eq.0 ) then
330 call gmaloj ( ntrav1//'.Pointeur', ' ', iaux, ppovos, codret )
334 if ( codret.eq.0 ) then
336 #ifdef _DEBUG_HOMARD_
337 write (ulsort,texte(langue,3)) 'VCVOS1', nompro
339 call vcvos1 ( imem(pnoeel), imem(ptypel), imem(ppovos),
340 > nvosom, nbelem, nbmane, nbnoto )
344 c 6.1.2. ==> reperage des voisins : la structure voisom contient la
345 c liste des elements 1d, 2d ou 3d voisins de chaque sommet
346 c (allocation du tableau des voisins a une taille egale
347 c au nombre cumule de voisins des sommets)
349 if ( codret.eq.0 ) then
351 call gmaloj ( ntrav1//'.Table', ' ', nvosom, pvoiso, codret )
355 if ( codret.eq.0 ) then
357 #ifdef _DEBUG_HOMARD_
358 write (ulsort,texte(langue,3)) 'VCVOS2', nompro
360 call vcvos2 ( imem(pnoeel), imem(ptypel), imem(ppovos),
361 > imem(pvoiso), nvosom, nbelem, nbmane, nbnoto )
365 c 6.2. ==> Recherche d'eventuelles lignes fermees
366 #ifdef _DEBUG_HOMARD_
367 write (ulsort,90002) '6.2. lignes fermees ; codret', codret
370 if ( codret.eq.0 ) then
372 #ifdef _DEBUG_HOMARD_
373 write (ulsort,texte(langue,3)) 'VCSFL0', nompro
375 call vcsfl0 ( sdimca, nbelem, nvosom, nbnoto, nbf,
377 > imem(ptypel), imem(pfamee),
378 > imem(ppovos), imem(pvoiso),
379 > imem(pnumfa), smem(pnomfa), imem(pligfa),
381 > lalign, noelig, arelig,
382 > ulsort, langue, codret )
385 #ifdef _DEBUG_HOMARD_
386 write (ulsort,90002) 'lalign', lalign
389 c 6.3. ==> Si on a une ligne fermee, on l'ouvre par duplication du noeud
390 #ifdef _DEBUG_HOMARD_
391 write (ulsort,90002) '6.3. ligne fermee ; codret', codret
394 if ( codret.eq.0 ) then
396 if ( lalign.gt.0 ) then
398 #ifdef _DEBUG_HOMARD_
399 write (ulsort,90002) 'noelig, arelig', noelig, arelig
401 > (rmem(pcoonc+noelig-1+nbnoto*(iaux-1)), iaux=1,sdimca)
404 imem(ptypli+lalign-1) = 1
406 c 6.3.1. ==> Ajout d'un noeud
408 if ( codret.eq.0 ) then
411 call gmmod ( ncnoeu//'.Coor',
412 > pcoonc, nbnoto, iaux, sdimca, sdimca, codre0 )
417 if ( codret.eq.0 ) then
420 do 631 , iaux = 1 , sdimca
421 rmem(pcoonc+nbnoto-1+nbnoto*(iaux-1)) =
422 > rmem(pcoonc+noelig-1+nbnoto*(iaux-1))
427 c 6.3.2. ==> Modification de la description de l'arete terminale
429 if ( codret.eq.0 ) then
431 if ( imem(pnoeel+arelig-1).eq.noelig ) then
432 imem(pnoeel+arelig-1) = nbnoto
433 elseif ( imem(pnoeel+arelig-1+nbelem).eq.noelig ) then
434 imem(pnoeel+arelig-1+nbelem) = nbnoto
443 if ( codret.eq.0 ) then
445 call gmsgoj ( ntrav1, codre0 )
450 c 6.3.4. ==> Maintenant que la ligne est ouverte, on recommence.
460 #ifdef _DEBUG_HOMARD_
461 call gmprsx(nompro, nocdfr//'.TypeLign')
468 #ifdef _DEBUG_HOMARD_
469 write (ulsort,90002) '7. coordonnees ; codret', codret
471 c 7.1. ==> La dimension
474 if ( dimcst.eq.0 ) then
480 #ifdef _DEBUG_HOMARD_
481 write (ulsort,90002) 'dimcst', dimcst
482 write (ulsort,90002) 'sdimca, sfsdim', sdimca, sfsdim
483 write (ulsort,90002) 'sfmdim', sfmdim
488 if ( codret.eq.0 ) then
490 call gmecat ( nocdfr, 1, sfsdim, codre1 )
491 call gmecat ( nocdfr, 2, sfmdim, codre2 )
492 call gmecat ( nocdfr, 3, sfnbso, codre3 )
494 call gmaloj ( nocdfr//'.CoorNoeu', ' ', iaux, pgeoco, codre4 )
496 codre0 = min ( codre1, codre2, codre3, codre4 )
497 codret = max ( abs(codre0), codret,
498 > codre1, codre2, codre3, codre4 )
504 if ( codret.eq.0 ) then
506 #ifdef _DEBUG_HOMARD_
507 write (ulsort,texte(langue,3)) 'SFCVCO', nompro
509 call sfcvco ( dimcst, nbnoto, sfsdim,
510 > rmem(pcoonc), rmem(pgeoco),
511 > ulsort, langue, codret )
516 c 8. conversion du format MED au format C
518 #ifdef _DEBUG_HOMARD_
519 write (ulsort,90002) '8. Conversion MED C ; codret', codret
522 c 8.1. ==> Allocation : on surdimensionne
525 sfnbse = 2*(nbnoto+nbfd00)
527 if ( codret.eq.0 ) then
529 call gmecat ( nocdfr, 4, sfnbli, codre1 )
530 call gmecat ( nocdfr, 5, sfnbse, codre2 )
531 call gmaloj ( nocdfr//'.NumeLign', ' ', sfnbli, pnumli, codre3 )
532 call gmaloj ( nocdfr//'.PtrSomLi', ' ', sfnbli+1, psegli, codre4 )
533 call gmaloj ( nocdfr//'.SommSegm', ' ', sfnbse, psomse, codre5 )
534 call gmaloj ( nocdfr//'.AbsCurvi', ' ', sfnbse, adabsc, codre6 )
535 call gmalot ( ntrav2, 'entier', nbelem, ptrav2, codre7 )
537 codre0 = min ( codre1, codre2, codre3, codre4, codre5,
539 codret = max ( abs(codre0), codret,
540 > codre1, codre2, codre3, codre4, codre5,
545 c 8.2. ==> Conversion
547 if ( codret.eq.0 ) then
550 imem(psegli+1) = nbnoto+1
551 cgn print *,'appel de vcsfli'
552 cgn print *,'nbfd00 = ', nbfd00
553 cgn print *,'nbelem, nbmane, nvosom, nbnoto, nbf = ',
554 cgn > nbelem, nbmane, nvosom, nbnoto, nbf
556 #ifdef _DEBUG_HOMARD_
557 write (ulsort,texte(langue,3)) 'VCSFLI', nompro
559 call vcsfli ( sdimca, nbelem, nbmane, nvosom, nbnoto, nbf,
561 > imem(pnoeel), imem(ptypel), imem(pfamee),
562 > imem(ppovos), imem(pvoiso),
563 > imem(pnumfa), smem(pnomfa), imem(pligfa),
564 > nbfd00, nblign, nsomli,
565 > imem(pnumli), imem(psegli), imem(psomse),
566 > rmem(adabsc), imem(ptrav2),
567 > ulsort, langue, codret )
571 c 8.3. ==> Redimensionnement en tenant compte du vrai nombre de lignes
572 c et de sommets decrivant les lignes
574 if ( codret.eq.0 ) then
578 call gmmod ( nocdfr//'.NumeLign',
579 > pnumli, nbfd00, sfnbli, 1, 1, codre1 )
580 call gmmod ( nocdfr//'.TypeLign',
581 > ptypli, nbfd00, sfnbli, 1, 1, codre2 )
582 call gmmod ( nocdfr//'.PtrSomLi',
583 > pnumli, nbfd00+1, sfnbli+1, 1, 1, codre3 )
584 call gmmod ( nocdfr//'.SommSegm',
585 > psomse, sfnbse, nsomli, 1, 1, codre4 )
586 call gmmod ( nocdfr//'.AbsCurvi',
587 > adabsc, sfnbse, nsomli, 1, 1, codre5 )
589 codre0 = min ( codre1, codre2, codre3, codre4, codre5 )
590 codret = max ( abs(codre0), codret,
591 > codre1, codre2, codre3, codre4, codre5 )
595 call gmecat ( nocdfr, 4, sfnbli, codre1 )
596 call gmecat ( nocdfr, 5, sfnbse, codre2 )
598 codre0 = min ( codre1, codre2 )
599 codret = max ( abs(codre0), codret,
604 if ( codret.eq.0 ) then
606 call gmsgoj ( ntrav1, codre1 )
607 call gmlboj ( ntrav2, codre2 )
609 codre0 = min ( codre1, codre2 )
610 codret = max ( abs(codre0), codret,
615 c 8.4. ==> Enregistrement des groupes du suivi
617 if ( codret.eq.0 ) then
619 call gmatoj ( nocdfr//'.Groupes', ncafdg, codret )
623 #ifdef _DEBUG_HOMARD_
624 if ( codret.eq.0 ) then
625 call gmprsx (nompro, nocdfr )
626 call gmprot (nompro, nocdfr//'.CoorNoeu', 1 , 20 )
627 call gmprot (nompro, nocdfr//'.CoorNoeu', sfnbso-20 , sfnbso )
628 call gmprsx (nompro, nocdfr//'.NumeLign' )
629 call gmprsx (nompro, nocdfr//'.PtrSomLi' )
630 call gmprot (nompro, nocdfr//'.SommSegm', 1 , 20 )
631 call gmprot (nompro, nocdfr//'.SommSegm', sfnbse-20 , sfnbse )
632 call gmprot (nompro, nocdfr//'.AbsCurvi', 1 , 20 )
633 call gmprot (nompro, nocdfr//'.AbsCurvi', sfnbse-20 , sfnbse )
634 call gmprsx (nompro, nocdfr//'.Groupes')
639 c 9. controle des intersections
641 #ifdef _DEBUG_HOMARD_
642 write (ulsort,90002) '9. controle intersections ; codret', codret
645 c 9.1. ==> Allocation : on surdimensionne
647 if ( codret.eq.0 ) then
649 call gmalot ( ntrav2, 'entier', sfnbso, ptrav2, codre0 )
656 if ( codret.eq.0 ) then
658 #ifdef _DEBUG_HOMARD_
659 write (ulsort,texte(langue,3)) 'SFCTRI', nompro
661 call sfctri ( imem(psomse), imem(psegli),
663 > ulsort, langue, codret)
669 if ( codret.eq.0 ) then
671 call gmlboj ( ntrav2, codre0 )
680 if ( codret.ne.0 ) then
684 write (ulsort,texte(langue,1)) 'Sortie', nompro
685 write (ulsort,texte(langue,2)) codret
689 #ifdef _DEBUG_HOMARD_
690 write (ulsort,texte(langue,1)) 'Sortie', nompro