src/tool/Information/ininfm.F

   1       subroutine ininfm ( codret )
   2 c ______________________________________________________________________
   3 c
   4 c                             H O M A R D
   5 c
   6 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   7 c
   8 c Version originale enregistree le 18 juin 1996 sous le numero 96036
   9 c aupres des huissiers de justice Simart et Lavoir a Clamart
  10 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  11 c aupres des huissiers de justice
  12 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  13 c
  14 c    HOMARD est une marque deposee d'Electricite de France
  15 c
  16 c Copyright EDF 1996
  17 c Copyright EDF 1998
  18 c Copyright EDF 2002
  19 c Copyright EDF 2020
  20 c ______________________________________________________________________
  21 c
  22 c  INformation - INFormation sur le Maillage
  23 c  --            ---                -
  24 c
  25 c remarque : on n'execute ce programme que si le precedent s'est
  26 c            bien passe
  27 c
  28 c ______________________________________________________________________
  29 c .        .     .        .                                            .
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . codret . es  .    1   . code de retour des modules                 .
  33 c .        .     .        . en entree = celui du module d'avant        .
  34 c .        .     .        . en sortie = celui du module en cours       .
  35 c .        .     .        . 0 : pas de probleme                        .
  36 c .        .     .        . 1 : manque de temps cpu                    .
  37 c .        .     .        . 2x : probleme dans les memoires            .
  38 c .        .     .        . 3x : probleme dans les fichiers            .
  39 c .        .     .        . 5 : mauvaises options                      .
  40 c .        .     .        . 6 : problemes dans les noms d'objet        .
  41 c ______________________________________________________________________
  42 c
  43 c====
  44 c 0. declarations et dimensionnement
  45 c====
  46 c
  47 c 0.1. ==> generalites
  48 c
  49       implicit none
  50       save
  51 c
  52       character*6 nompro
  53       parameter ( nompro = 'ININFM' )
  54 c
  55 #include "motcle.h"
  56 #include "nblang.h"
  57 c
  58 c 0.2. ==> communs
  59 c
  60 #include "envex1.h"
  61 #include "envca1.h"
  62 #include "envada.h"
  63 c
  64 #include "gmenti.h"
  65 #include "gmstri.h"
  66 c
  67 #include "cndoad.h"
  68 #include "nomber.h"
  69 c
  70 c 0.3. ==> arguments
  71 c
  72       integer codret
  73 c
  74 c 0.4. ==> variables locales
  75 c
  76       integer ulsort, langue, codava
  77       integer adopti, lgopti
  78       integer adopts, lgopts
  79       integer adetco, lgetco
  80       integer nrsect, nrssse
  81       integer nretap, nrsset
  82       integer iaux, jaux
  83       integer codre0
  84       integer codre1, codre2, codre3, codre4, codre5
  85       integer codre6, codre7, codre8
  86       integer adnbrn
  87       integer adinch, adinpf, adinpr, adinlg
  88       integer lnomfi
  89 c
  90       integer ulfido, ulenst, ulsost
  91 c
  92       logical exisol
  93 c
  94       character*6 saux
  95       character*8 action
  96       character*8 nohman, norenu, nocsol, nochso
  97       character*8 typobs
  98       character*50 commen(nblang)
  99       character*200 nomfic
 100 c
 101       integer nbmess
 102       parameter ( nbmess = 10 )
 103       character*80 texte(nblang,nbmess)
 104 c
 105 c 0.5. ==> initialisations
 106 c ______________________________________________________________________
 107 c
 108 c====
 109 c 1. les initialisations
 110 c====
 111 c
 112       codava = codret
 113 c
 114 c=======================================================================
 115       if ( codava.eq.0 ) then
 116 c=======================================================================
 117 c
 118 #ifdef _DEBUG_HOMARD_
 119       call gmprsx (nompro, nndoad )
 120       call gmprsx (nompro, nndoad//'.OptEnt' )
 121       call gmprsx (nompro, nndoad//'.OptRee' )
 122       call gmprsx (nompro, nndoad//'.OptCar' )
 123       call gmprsx (nompro, nndoad//'.EtatCour' )
 124 #endif
 125 c
 126 c 1.1. ==> le numero d'unite logique de la liste standard
 127 c
 128       call utulls ( ulsort, codret )
 129 c
 130 c 1.2. ==> la langue des messages
 131 c
 132       call gmadoj ( nndoad//'.OptEnt', adopti, lgopti, codret )
 133       if ( codret.eq.0 ) then
 134         langue = imem(adopti)
 135       else
 136         langue = 1
 137         codret = 2
 138       endif
 139 c
 140 c 1.3. ==> l'etat courant
 141 c
 142       call gmadoj ( nndoad//'.EtatCour', adetco, lgetco, codret )
 143       if ( codret.eq.0 ) then
 144         nretap = imem(adetco) + 1
 145         imem(adetco) = nretap
 146         nrsset = -1
 147         imem(adetco+1) = nrsset
 148         nrsect = imem(adetco+2) + 10
 149         imem(adetco+2) = nrsect
 150         nrssse = nrsect
 151         imem(adetco+3) = nrssse
 152       else
 153         nretap = -1
 154         nrsset = -1
 155         nrsect = 200
 156         nrssse = nrsect
 157         codret = 2
 158       endif
 159 c
 160 c 1.4. ==> le debut des mesures de temps
 161 c
 162       call gtdems (nrsect)
 163 c
 164 c 1.5. ==> les messages
 165 c
 166 #include "impr03.h"
 167 c
 168 #include "impr01.h"
 169 c
 170 #ifdef _DEBUG_HOMARD_
 171       write (ulsort,texte(langue,1)) 'Entree', nompro
 172       call dmflsh (iaux)
 173 #endif
 174 c
 175       texte(1,4) =
 176      > '(//,a6,'//
 177      >''' I N F O R M A T I O N    S U R    L E    M A I L L A G E'')'
 178       texte(1,5) = '(63(''=''),/)'
 179       texte(1,7) = '(''Le maillage est a corriger.'')'
 180 c
 181       texte(2,4) = '(//,a6,'' M E S H    I N F O R M A T I O N'')'
 182       texte(2,5) = '(39(''=''),/)'
 183       texte(2,7) = '(''This mesh is not correct.'')'
 184 c
 185 c 1.6. ==> le titre
 186 c
 187       call utcvne ( nretap, nrsset, saux, iaux, codret )
 188 c
 189       write (ulsort,texte(langue,4)) saux
 190       write (ulsort,texte(langue,5))
 191 c
 192       nrsset = 0
 193       imem(adetco+1) = nrsset
 194 c
 195 c 1.7. ==> les noms d'objets a conserver
 196 c
 197       if ( codret.eq.0 ) then
 198         call gmadoj ( nndoad//'.OptCar', adopts, lgopts, codret )
 199         if ( codret.ne.0 ) then
 200           codret = 2
 201         endif
 202       endif
 203 c
 204 c 1.8. ==> les numeros d'unite logique au terminal
 205 c
 206       call dmunit ( ulenst, ulsost )
 207 c
 208 c 1.9. ==> le maillage d'entree
 209 c
 210       nohman = smem(adopts+2)
 211       action = smem(adopts+29)
 212 c
 213 c 1.10. ==> le numero d'unite logique du fichier de donnees correct
 214 c
 215       call utulfd ( action, nbiter, ulfido, codret )
 216 c
 217 c====
 218 c 2. reactualisation des communs de la renumerotation
 219 c====
 220 c
 221 #ifdef _DEBUG_HOMARD_
 222       write(ulsort,90002) '2. reactualisation communs ; codret', codret
 223 #endif
 224 c
 225 c 2.1. ==> Noms des structures
 226 c
 227       if ( codret.eq.0 ) then
 228 c
 229       call gmnomc ( nohman//'.RenuMail', norenu, codret )
 230 c
 231       endif
 232 c
 233       if ( codret.eq.0 ) then
 234 c
 235       call gmadoj ( norenu//'.Nombres', adnbrn, iaux, codret )
 236 c
 237       endif
 238 c
 239 c 2.2. ==> Adresses
 240 #ifdef _DEBUG_HOMARD_
 241       write(ulsort,90002) '2.2. Adresses ; codret', codret
 242 #endif
 243 c
 244       if ( codret.eq.0 ) then
 245 c
 246 #ifdef _DEBUG_HOMARD_
 247       write (ulsort,texte(langue,3)) 'UTNBMH', nompro
 248 #endif
 249       call utnbmh ( imem(adnbrn),
 250      >              renois, renoei, renomp,
 251      >              renop1, renop2, renoim,
 252      >                iaux,   iaux,   iaux,
 253      >                iaux,   iaux,   iaux,   iaux,
 254      >                iaux,   iaux,   iaux,   iaux,
 255      >                iaux,   iaux,   iaux,   iaux,
 256      >                iaux,   iaux,
 257      >                iaux,   iaux,
 258      >              ulsort, langue, codret )
 259 c
 260       endif
 261 c
 262 c 2.3. ==> Recuperations des valeurs
 263 #ifdef _DEBUG_HOMARD_
 264       write(ulsort,90002) '2.3. Recuperations ; codret', codret
 265 #endif
 266 c
 267       if ( codret.eq.0 ) then
 268 c
 269       reno1i = renois + renoei + renomp + renop1
 270 c
 271       call gmliat ( norenu, 1, renoac, codre1 )
 272       call gmliat ( norenu, 2, renoto, codre2 )
 273       call gmliat ( norenu, 3, rempac, codre3 )
 274       call gmliat ( norenu, 4, rempto, codre4 )
 275       call gmliat ( norenu, 5, rearac, codre5 )
 276       call gmliat ( norenu, 6, rearto, codre6 )
 277       call gmliat ( norenu, 7, retrac, codre7 )
 278       call gmliat ( norenu, 8, retrto, codre8 )
 279 c
 280       codre0 = min ( codre1, codre2, codre3, codre4, codre5,
 281      >               codre6, codre7, codre8 )
 282       codret = max ( abs(codre0), codret,
 283      >               codre1, codre2, codre3, codre4, codre5,
 284      >               codre6, codre7, codre8 )
 285 c
 286       call gmliat ( norenu,  9, requac, codre1 )
 287       call gmliat ( norenu, 10, requto, codre2 )
 288       call gmliat ( norenu, 11, reteac, codre3 )
 289       call gmliat ( norenu, 12, reteto, codre4 )
 290 c
 291       codre0 = min ( codre1, codre2, codre3, codre4 )
 292       codret = max ( abs(codre0), codret,
 293      >               codre1, codre2, codre3, codre4 )
 294 c
 295       endif
 296 c
 297 c====
 298 c 3. Lecture de tous les champs presents dans le fichier
 299 c====
 300 c
 301 #ifdef _DEBUG_HOMARD_
 302       write(ulsort,90002) '3. Lecture des champs ; codret', codret
 303 #endif
 304 c
 305 c 3.1. ==> Recherche du type de code de calcul associe
 306 c
 307       if ( codret.eq.0 ) then
 308 c
 309       call gmliat ( nohman, 9, typcca, codret )
 310 c
 311       endif
 312 c
 313 c 3.2. ==> Lecture de l'eventuelle solution
 314 c
 315 c 3.2.1. ==> La solution existe-t-elle ?
 316 c
 317       if ( codret.eq.0 ) then
 318 c
 319       if ( mod(typcca-6,10).eq.0 ) then
 320 c
 321         typobs = mccson
 322         iaux = 0
 323         jaux = 0
 324         call utfino ( typobs, iaux, nomfic, lnomfi,
 325      >                jaux,
 326      >                ulsort, langue, codret )
 327 c
 328         if ( codret.eq.0 ) then
 329           exisol = .true.
 330         else
 331           exisol = .false.
 332           codret = 0
 333         endif
 334 c
 335       else
 336         exisol = .false.
 337       endif
 338 c
 339       endif
 340 c
 341 c 3.2.2. ==> Une solution existe
 342 c
 343       if ( exisol ) then
 344 c
 345 c 3.2.2.1. ==> Lecture du format MED
 346 c
 347         if ( codret.eq.0 ) then
 348 c
 349 #ifdef _DEBUG_HOMARD_
 350       write (ulsort,texte(langue,3)) 'ESLSMD', nompro
 351 #endif
 352         nochso = '        '
 353         iaux = 0
 354         call eslsmd ( nocsol, nochso,
 355      >                imem(adopti+8), iaux,
 356      >                ulsort, langue, codret )
 357 c
 358         endif
 359 c
 360 c 3.2.2.2. ==> pour le cas extrude, passage du 3D au 2D
 361 c
 362         if ( imem(adopti+38).ne.0 ) then
 363 c
 364           if ( codret.eq.0 ) then
 365 c
 366 #ifdef _DEBUG_HOMARD_
 367       write (ulsort,texte(langue,3)) 'UTSEXT', nompro
 368 #endif
 369           iaux = 1
 370           call utsext ( nocsol, iaux, typcca,
 371      >                  lgetco, imem(adetco),
 372      >                  ulsort, langue, codret )
 373 c
 374           endif
 375 c
 376         endif
 377 c
 378       else
 379 c
 380 c 3.2.3. ==> S'il n'y a pas de solution, on en alloue une vide pour ne
 381 c            pas perturber la suite
 382 c
 383         if ( codret.eq.0 ) then
 384 c
 385 #ifdef _DEBUG_HOMARD_
 386       write (ulsort,texte(langue,3)) 'UTALSO', nompro
 387 #endif
 388         iaux = 0
 389         call utalso ( nocsol,
 390      >                iaux, iaux, iaux, iaux,
 391      >                adinch, adinpf, adinpr, adinlg,
 392      >                ulsort, langue, codret )
 393 c
 394         endif
 395 c
 396       endif
 397 c
 398 cgn      call gmprsx (nompro,nocsol)
 399 c
 400 #ifdef _DEBUG_HOMARD_
 401       write(ulsort,90002) 'Fin etape 3 avec codret', codret
 402 #endif
 403 c
 404 c====
 405 c 4. Analyse du maillage d'entree
 406 c====
 407 #ifdef _DEBUG_HOMARD_
 408       write(ulsort,90002) '4. Analyse ; codret', codret
 409       call dmflsh(iaux)
 410 #endif
 411 c
 412       if ( codret.eq.0 ) then
 413 c
 414       imem(adetco+3) = imem(adetco+3) + 1
 415       nrssse = imem(adetco+3)
 416 c
 417       call gtdems (nrssse)
 418 c
 419       endif
 420 c
 421 c 4.1. ==> numero d'iteration
 422 c
 423       if ( codret.eq.0 ) then
 424 c
 425 #ifdef _DEBUG_HOMARD_
 426       write (ulsort,texte(langue,3)) 'INITER', nompro
 427 #endif
 428       call initer ( ulsort, langue, codret )
 429 c
 430       endif
 431 c
 432 c 4.2. ==> analyse du maillage d'entree
 433 c
 434       if ( codret.eq.0 ) then
 435 c
 436       commen(1) = 'Maillage a analyser                               '
 437       commen(2) = 'Mesh to analyze                                   '
 438 c
 439 #ifdef _DEBUG_HOMARD_
 440       write (ulsort,texte(langue,3)) 'UTBILM', nompro
 441 #endif
 442       call utbilm ( nohman, commen(langue), imem(adopti+2), action,
 443      >              lgetco, imem(adetco),
 444      >              ulsort, langue, codret )
 445 c
 446       endif
 447 c
 448       if ( codret.eq.0 ) then
 449 c
 450       call gtfims (nrssse)
 451 c
 452       endif
 453 c
 454 c====
 455 c 5. Familles
 456 c====
 457 #ifdef _DEBUG_HOMARD_
 458       write(ulsort,90002) '5. Familles ; codret', codret
 459 #endif
 460 c
 461       if ( codret.eq.0 ) then
 462 c
 463       iaux = maextr
 464       if ( imem(adopti+10).eq.26 .or. imem(adopti+10).eq.46 ) then
 465         iaux = 0
 466       endif
 467 #ifdef _DEBUG_HOMARD_
 468       write (ulsort,texte(langue,3)) 'INFAMI', nompro
 469 #endif
 470       call infami ( nohman,   iaux,
 471      >              ulsort, langue, codret )
 472 c
 473       endif
 474 c
 475 c====
 476 c 6. Fichiers
 477 c====
 478 #ifdef _DEBUG_HOMARD_
 479       write(ulsort,90002) '6. Fichiers ; codret', codret
 480       call dmflsh(iaux)
 481 #endif
 482 c
 483       if ( codret.eq.0 ) then
 484 c
 485       imem(adetco+3) = imem(adetco+3) + 1
 486       nrssse = imem(adetco+3)
 487 c
 488       call gtdems (nrssse)
 489 c
 490       endif
 491 c
 492 c 6.1. ==> sorties vectorielles
 493 c
 494       if ( codret.eq.0 ) then
 495 c
 496 #ifdef _DEBUG_HOMARD_
 497       write (ulsort,texte(langue,3)) 'INFVEC', nompro
 498 #endif
 499       call infvec ( nohman, nocsol, action,
 500      >              ulfido, ulenst, ulsost,
 501      >              lgetco, imem(adetco),
 502      >              ulsort, langue, codret )
 503 c
 504       endif
 505 c
 506 c 6.2. ==> fichiers ascii pour les champs
 507 c
 508       if ( codret.eq.0 ) then
 509 c
 510 #ifdef _DEBUG_HOMARD_
 511       write (ulsort,texte(langue,3)) 'INFCAS', nompro
 512       write(ulsort,*) imem(adetco+3)
 513 #endif
 514       call infcas ( nohman, nocsol,
 515      >              ulfido, ulenst, ulsost,
 516      >              lgetco, imem(adetco),
 517      >              ulsort, langue, codret )
 518 c
 519       endif
 520 c
 521       if ( codret.eq.0 ) then
 522 c
 523       call gtfims (nrssse)
 524 c
 525       endif
 526 c
 527 c====
 528 c 7. la fin
 529 c====
 530 c
 531 c 7.1. ==> message si erreur
 532 c
 533       if ( codret.ne.0 ) then
 534 c
 535 #include "envex2.h"
 536 c
 537       write (ulsort,texte(langue,1)) 'Sortie', nompro
 538       write (ulsort,texte(langue,2)) codret
 539 c
 540       endif
 541 c
 542 c 7.2. ==> fin des mesures de temps de la section
 543 c
 544       call gtfims (nrsect)
 545 c
 546 #ifdef _DEBUG_HOMARD_
 547       write (ulsort,texte(langue,1)) 'Sortie', nompro
 548       call dmflsh (iaux)
 549 #endif
 550 c
 551 c=======================================================================
 552       endif
 553 c=======================================================================
 554 c
 555       end