src/tool/Utilitaire/utmcc0.F

   1       subroutine utmcc0 ( nbcham,
   2      >                    caetal, cactal, cartal,
   3      >                    nbfich,
   4      >                    nomref, lgnofi, poinno,
   5      >                    nomufi, nomstr,
   6      >                    ulsort, langue, codret )
   7 c ______________________________________________________________________
   8 c
   9 c                             H O M A R D
  10 c
  11 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  12 c
  13 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  14 c aupres des huissiers de justice Simart et Lavoir a Clamart
  15 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  16 c aupres des huissiers de justice
  17 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  18 c
  19 c    HOMARD est une marque deposee d'Electricite de France
  20 c
  21 c Copyright EDF 1996
  22 c Copyright EDF 1998
  23 c Copyright EDF 2002
  24 c Copyright EDF 2020
  25 c ______________________________________________________________________
  26 c
  27 c     UTilitaire : Mot-Cle - liste des Champs a mettre a jour - 0
  28 c     --           -   -               -                        -
  29 c ______________________________________________________________________
  30 c .        .     .        .                                            .
  31 c .  nom   . e/s . taille .           description                      .
  32 c .____________________________________________________________________.
  33 c . nbcham . e   .    1   . nombre de champs a mettre a jour           .
  34 c . cactal .  s  .8*nbseal. caracteristiques caracteres de chaque      .
  35 c .        .     .        . tableau a lire                             .
  36 c .        .     .        . 1,2,3,4. nom du champ associe              .
  37 c . caetal .  s  .  12 *  . caracteristiques entieres de chaque        .
  38 c .        .     . nbseal . tableau a lire                             .
  39 c .        .     .        . 1. type de support au sens MED             .
  40 c .        .     .        .  -1, si on prend tous les supports         .
  41 c .        .     .        . 2. 1, si numero du pas de temps, 0 sinon   .
  42 c .        .     .        . 3. numero du pas de temps                  .
  43 c .        .     .        . 4. 1, si numero d'ordre, 0 sinon           .
  44 c .        .     .        . 5. numero d'ordre                          .
  45 c .        .     .        . 6. 1, si instant, 0 sinon                  .
  46 c .        .     .        . 7. 1, si aux noeuds par elements, 0 sinon, .
  47 c .        .     .        .   -1, si non precise                       .
  48 c .        .     .        . 8. numero du champ noeuds/element associe  .
  49 c .        .     .        . 9. numero du champ associe dans HOMARD     .
  50 c .        .     .        . 10. type d'interpolation                   .
  51 c .        .     .        .  0, si automatique                         .
  52 c .        .     .        .  1 si degre 1, 2 si degre 2, 3 si iso-P2   .
  53 c .        .     .        . 11. sans objet a ce stade du traitement    .
  54 c .        .     .        . 12. type de champ edfl64/edin64            .
  55 c . cartal .  s  . nbseal . caracteristiques reelles de chaque         .
  56 c .        .     .        . tableau a lire                             .
  57 c .        .     .        . 1. instant                                 .
  58 c . nomref . e   . nbfich . nom de reference des fichiers              .
  59 c . lgnofi . e   . nbfich . longueurs des noms des fichiers            .
  60 c . poinno . e   .0:nbfich. pointeur dans le tableau des noms          .
  61 c . nomufi . e   . lgtanf . noms des fichiers                          .
  62 c . nomstr . e   . nbfich . nom des structures                         .
  63 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  64 c . langue . e   .    1   . langue des messages                        .
  65 c .        .     .        . 1 : francais, 2 : anglais                  .
  66 c . codret . es  .    1   . code de retour des modules                 .
  67 c .        .     .        . 0 : pas de probleme                        .
  68 c .        .     .        . 1 : la configuration est perdue            .
  69 c .        .     .        . 2 : probleme de lecture                    .
  70 c .        .     .        . 8 : Allocation impossible                  .
  71 c ______________________________________________________________________
  72 c
  73 c====
  74 c 0. declarations et dimensionnement
  75 c====
  76 c
  77 c 0.1. ==> generalites
  78 c
  79       implicit none
  80       save
  81 c
  82       character*6 nompro
  83       parameter ( nompro = 'UTMCC0' )
  84 c
  85 #include "nblang.h"
  86 #include "motcle.h"
  87 #include "consts.h"
  88 c
  89 c 0.2. ==> communs
  90 c
  91 #include "envex1.h"
  92 c
  93 c 0.3. ==> arguments
  94 c
  95       integer nbcham
  96       integer caetal(12,nbcham)
  97       integer nbfich
  98       integer lgnofi(nbfich), poinno(0:nbfich)
  99 c
 100       double precision cartal(*)
 101 c
 102       character*8 cactal(*)
 103       character*8 nomref(nbfich), nomufi(*), nomstr(nbfich)
 104 c
 105       integer ulsort, langue, codret
 106 c
 107 c 0.4. ==> variables locales
 108 c
 109       integer iaux, jaux, kaux
 110       integer nrcham, nrfich
 111       integer numero
 112 c
 113       double precision daux
 114 c
 115       character*8 motcle
 116       character*200 sau200
 117 c
 118       logical chnom, chnum, chpdt, chins, chcas, chncn
 119 c
 120       integer nbmess
 121       parameter ( nbmess = 20 )
 122       character*80 texte(nblang,nbmess)
 123 c
 124 c 0.5. ==> initialisations
 125 c ______________________________________________________________________
 126 c
 127 c====
 128 c 1. messages
 129 c====
 130 c
 131 #include "impr01.h"
 132 c
 133 #ifdef _DEBUG_HOMARD_
 134       write (ulsort,texte(langue,1)) 'Entree', nompro
 135       call dmflsh (iaux)
 136 #endif
 137 c
 138       texte(1,4) = '(''Nombre de champs a mettre a jour :'',i8)'
 139       texte(1,5) = '(/,''Numero du champ en cours de recherche :'',i8)'
 140       texte(1,6) = '('' .. ==> Nom du champ : '',a)'
 141       texte(1,7) = '(''Le nom est introuvable.'')'
 142       texte(1,8) = '('' .. ==> Numero d''''ordre :'',i8)'
 143       texte(1,9) = '(''Le numero d''''ordre est introuvable.'')'
 144       texte(1,10) = '('' .. ==> Numero du pas de temps :'',i8)'
 145       texte(1,11) = '(''Le numero de pas de temps est introuvable.'')'
 146       texte(1,12) = '('' .. ==> Instant                :'',g12.5)'
 147       texte(1,13) = '(''L''''instant est introuvable.'')'
 148       texte(1,14) = '('' .. ==> Caracteristique du support : '',a)'
 149       texte(1,15) =
 150      > '(''La caracteristique du support est inconnue : '',a)'
 151       texte(1,16) = '('' .. ==> Numero du champ associe :'',i8)'
 152 c
 153       texte(2,4) = '(''Number of files to update :'',i8)'
 154       texte(2,5) = '(/,''Search for field #'',i8)'
 155       texte(2,6) = '('' .. ==> Name of the field : '',a)'
 156       texte(2,7) = '(''Name of the field cannot be found.'')'
 157       texte(2,8) = '('' .. ==> Rank number :'',i8)'
 158       texte(2,9) = '(''Rank number cannot be found.'')'
 159       texte(2,10) = '('' .. ==> Time step # :'',i8)'
 160       texte(2,11) = '(''Time step # cannot be found.'')'
 161       texte(2,12) = '('' .. ==> Instant     :'',g12.5)'
 162       texte(2,13) = '(''Instant cannot be found.'')'
 163       texte(2,14) = '('' .. ==> Characteristic of support : '',a)'
 164       texte(2,15) =
 165      > '(''The characteristic of support is unknown : '',a)'
 166       texte(2,16) = '(''. Number for the associated field :'',i8)'
 167 c
 168 #include "impr03.h"
 169 c
 170 #ifdef _DEBUG_HOMARD_
 171       write (ulsort,texte(langue,4)) nbcham
 172 #endif
 173 c
 174       codret = 0
 175 c
 176 c====
 177 c 2. on parcourt toutes les posssibilites de champs
 178 c====
 179 c
 180       do 20 , nrcham = 1 , nbcham
 181 c
 182 #ifdef _DEBUG_HOMARD_
 183         write (ulsort,texte(langue,5)) nrcham
 184 #endif
 185         chnom = .false.
 186         chnum = .false.
 187         chpdt = .false.
 188         chins = .false.
 189         chcas = .false.
 190         chncn = .false.
 191 c
 192         caetal(2,nrcham) = 0
 193         caetal(4,nrcham) = 0
 194         caetal(6,nrcham) = 0
 195         caetal(9,nrcham) = 0
 196         caetal(10,nrcham) = 0
 197 c
 198         do 200 , nrfich = 1 , nbfich
 199 c
 200 c 2.1. ==> si c'est un des mots-cles possibles, on verifie que c'est
 201 c          pour le bon champ
 202 c
 203           if ( codret.eq.0 ) then
 204 c
 205           motcle = nomref(nrfich)
 206 cgn      write (ulsort,*) '.. motcle = ',motcle
 207 c
 208           if ( motcle.eq.mcchno .or.
 209      >         motcle.eq.mcchcs .or.
 210      >         motcle.eq.mcchpt .or.
 211      >         motcle.eq.mcchnu .or.
 212      >         motcle.eq.mcchin .or.
 213      >         motcle.eq.mcchti .or.
 214      >         motcle.eq.mcchnc ) then
 215 c
 216 cgn      write (ulsort,*) '.. nomstr(nrfich) = ',nomstr(nrfich)
 217 #ifdef _DEBUG_HOMARD_
 218       write (ulsort,texte(langue,3)) 'UTCHEN', nompro
 219 #endif
 220             call utchen ( nomstr(nrfich), numero,
 221      >                    ulsort, langue, codret )
 222 c
 223 cgn      write (ulsort,*) '.. motcle = ',motcle,' ',nrcham,' ',numero
 224             if ( nrcham.eq.numero ) then
 225 c
 226               if ( motcle.eq.mcchno ) then
 227                 goto 22
 228               elseif ( motcle.eq.mcchcs ) then
 229                 goto 23
 230               elseif ( motcle.eq.mcchpt .or. motcle.eq.mcchnu ) then
 231                 goto 24
 232               elseif ( motcle.eq.mcchin ) then
 233                 goto 25
 234               elseif ( motcle.eq.mcchti ) then
 235                 goto 26
 236               else
 237                 goto 27
 238               endif
 239             else
 240               goto 200
 241             endif
 242 c
 243           else
 244 c
 245             goto 200
 246 c
 247           endif
 248 c
 249 c
 250           endif
 251 c
 252 c 2.2. ==> recherche du nom du champ
 253 c
 254    22     continue
 255 c
 256           if ( codret.eq.0 ) then
 257 c
 258 cgn      write (ulsort,90002) 'debut de 22 continue ; nrcham', nrcham
 259 c
 260           jaux = 8*(nrcham-1)
 261           do 221 , iaux = jaux+1 , jaux+8
 262             cactal(iaux) = blan08
 263   221     continue
 264           kaux = poinno(nrfich-1) + 1
 265           do 222 , iaux = kaux, poinno(nrfich)
 266             jaux = jaux + 1
 267             cactal(jaux) = nomufi(iaux)
 268   222     continue
 269           chnom = .true.
 270 #ifdef _DEBUG_HOMARD_
 271           jaux = poinno(nrfich-1) + 1
 272           kaux = lgnofi(nrfich)
 273           call uts8ch ( nomufi(jaux), kaux, sau200,
 274      >                  ulsort, langue, codret )
 275           write (ulsort,texte(langue,6)) sau200(1:kaux)
 276 #endif
 277 c
 278           goto 28
 279 c
 280           endif
 281 c
 282 c 2.3. ==> recherche de la caracteristique du support du champ
 283 c          par defaut, il est standard
 284 c
 285    23     continue
 286 c
 287           if ( codret.eq.0 ) then
 288 c
 289 cgn      write (ulsort,90002) 'debut de 23 continue ; nrcham', nrcham
 290 c
 291           caetal(7,nrcham) = 0
 292 c
 293           jaux = 1
 294           kaux = poinno(nrfich-1) + 1
 295           do 231 , iaux = kaux, poinno(nrfich)
 296             sau200(jaux:jaux+7) = nomufi(iaux)
 297             jaux = jaux + 8
 298   231     continue
 299 c
 300           do 232 , iaux = jaux , 200
 301             sau200(iaux:iaux) = ' '
 302   232     continue
 303 c
 304           call utlgut ( iaux, sau200,
 305      >                  ulsort, langue, codret )
 306 c
 307           jaux = 1
 308 c
 309           if ( iaux.eq.8 ) then
 310 c                                   12345678
 311             if ( sau200(1:iaux).eq.'standard' ) then
 312               caetal(7,nrcham) = 1
 313               jaux = 0
 314             endif
 315 c
 316           elseif ( iaux.eq.22 ) then
 317 c                                   1234567890123456789012
 318             if ( sau200(1:iaux).eq.'aux_noeuds_par_element' ) then
 319               caetal(7,nrcham) = 1
 320               jaux = 0
 321             endif
 322 c
 323           endif
 324           if ( jaux.ne.0 ) then
 325             write (ulsort,texte(langue,15)) sau200(1:iaux)
 326             codret = 1
 327 #ifdef _DEBUG_HOMARD_
 328           else
 329             write (ulsort,texte(langue,14)) sau200(1:iaux)
 330 #endif
 331           endif
 332 c
 333           chcas = .true.
 334 c
 335           goto 28
 336 c
 337           endif
 338 c
 339 c 2.4. ==> recherche de numero d'ordre du champ
 340 c
 341    24     continue
 342 c
 343           if ( codret.eq.0 ) then
 344 c
 345 cgn      write (ulsort,90002) 'debut de 24 continue ; nrcham', nrcham
 346 c
 347           jaux = poinno(nrfich-1) + 1
 348           kaux = lgnofi(nrfich)
 349           call uts8ch ( nomufi(jaux), kaux, sau200,
 350      >                  ulsort, langue, codret )
 351 c
 352           endif
 353 c
 354           if ( codret.eq.0 ) then
 355 c
 356 #ifdef _DEBUG_HOMARD_
 357       write (ulsort,texte(langue,3)) 'UTCHEN', nompro
 358 #endif
 359           call utchen ( sau200, iaux,
 360      >                  ulsort, langue, codret )
 361 c
 362           endif
 363 c
 364           if ( codret.eq.0 ) then
 365 c
 366           if ( motcle.eq.mcchpt ) then
 367             caetal(2,nrcham) = 1
 368             caetal(3,nrcham) = iaux
 369             chpdt = .true.
 370 #ifdef _DEBUG_HOMARD_
 371             write (ulsort,texte(langue,10)) iaux
 372 #endif
 373           else
 374             caetal(4,nrcham) = 1
 375             caetal(5,nrcham) = iaux
 376             chnum = .true.
 377 #ifdef _DEBUG_HOMARD_
 378             write (ulsort,texte(langue,8)) iaux
 379 #endif
 380           endif
 381 c
 382           goto 28
 383 c
 384           endif
 385 c
 386 c 2.5. ==> recherche de l'instant du champ
 387 c
 388    25     continue
 389 c
 390           if ( codret.eq.0 ) then
 391 c
 392 cgn      write (ulsort,90002) 'debut de 25 continue ; nrcham', nrcham
 393 c
 394           jaux = poinno(nrfich-1) + 1
 395           kaux = lgnofi(nrfich)
 396           call uts8ch ( nomufi(jaux), kaux, sau200,
 397      >                  ulsort, langue, codret )
 398 c
 399           endif
 400 c
 401           if ( codret.eq.0 ) then
 402 c
 403 #ifdef _DEBUG_HOMARD_
 404       write (ulsort,texte(langue,3)) 'UTCHRE', nompro
 405 #endif
 406           call utchre ( sau200, daux,
 407      >                  ulsort, langue, codret )
 408 c
 409           endif
 410 c
 411           if ( codret.eq.0 ) then
 412 c
 413           caetal(6,nrcham) = 1
 414           cartal(nrcham) = daux
 415           chins = .true.
 416 #ifdef _DEBUG_HOMARD_
 417           write (ulsort,texte(langue,12)) daux
 418 #endif
 419 c
 420           goto 28
 421 c
 422           endif
 423 c
 424 c 2.6. ==> recherche du type d'interpolation
 425 c
 426    26     continue
 427 c
 428           if ( codret.eq.0 ) then
 429 c
 430 cgn      write (ulsort,90002) 'debut de 26 continue ; nrcham', nrcham
 431 c
 432           jaux = poinno(nrfich-1) + 1
 433           kaux = lgnofi(nrfich)
 434           call uts8ch ( nomufi(jaux), kaux, sau200,
 435      >                  ulsort, langue, codret )
 436 c
 437           endif
 438 c
 439           if ( codret.eq.0 ) then
 440 c
 441 #ifdef _DEBUG_HOMARD_
 442       write (ulsort,texte(langue,3)) 'UTCHEN', nompro
 443 #endif
 444           call utchen ( sau200, iaux,
 445      >                  ulsort, langue, codret )
 446 c
 447           endif
 448 c
 449           if ( codret.eq.0 ) then
 450 c
 451           caetal(10,nrcham) = iaux
 452 c
 453           goto 28
 454 c
 455           endif
 456 c
 457 c 2.7. ==> recherche du numero du champ aux noeuds par elements associe
 458 c          au champ courant.
 459 c          remarque : on ne peut pas controler ici que c'est un vrai
 460 c                     champ aux points de Gauss
 461 c
 462    27     continue
 463 c
 464           if ( codret.eq.0 ) then
 465 c
 466 cgn      write (ulsort,90002) 'debut de 27 continue ; nrcham', nrcham
 467 c
 468           jaux = poinno(nrfich-1) + 1
 469           kaux = lgnofi(nrfich)
 470           call uts8ch ( nomufi(jaux), kaux, sau200,
 471      >                  ulsort, langue, codret )
 472 c
 473           endif
 474 c
 475           if ( codret.eq.0 ) then
 476 c
 477 #ifdef _DEBUG_HOMARD_
 478       write (ulsort,texte(langue,3)) 'UTCHEN', nompro
 479 #endif
 480           call utchen ( sau200, iaux,
 481      >                  ulsort, langue, codret )
 482 c
 483           caetal(8,nrcham) = iaux
 484           chncn = .true.
 485 #ifdef _DEBUG_HOMARD_
 486           write (ulsort,texte(langue,16)) iaux
 487 #endif
 488 c
 489           goto 28
 490 c
 491           endif
 492 c
 493 c 2.8. ==> si on a tout trouve, on passe au champ suivant
 494 c
 495    28     continue
 496 c
 497           if ( codret.eq.0 ) then
 498 c
 499 #ifdef _DEBUG_HOMARD_
 500       write (ulsort,*) '... arrivee dans 28 continue'
 501       write (ulsort,90003) 'chnom', chnom
 502       write (ulsort,90003) 'chnum', chnum
 503       write (ulsort,90003) 'chpdt', chpdt
 504       write (ulsort,90003) 'chins', chins
 505       write (ulsort,90003) 'chcas', chcas
 506       write (ulsort,90003) 'chncn', chncn
 507 #endif
 508 c
 509           if ( chnom .and.
 510      >         ( ( chnum .and. chpdt ) .or. chins ) .and.
 511      >         chcas .and. chncn ) then
 512             caetal(1,nrcham) = -1
 513 c
 514 #ifdef _DEBUG_HOMARD_
 515             write (ulsort,*) '... ==> OK 28 ; passage au champ suivant'
 516 #endif
 517             goto 20
 518           endif
 519 c
 520           endif
 521 c
 522   200   continue
 523 c
 524 c 2.9. ==> si on arrive ici, il faut verifier qu'il ne manque rien
 525 c
 526         if ( codret.eq.0 ) then
 527 c
 528 #ifdef _DEBUG_HOMARD_
 529       write (ulsort,*) 'debut de 29 continue'
 530       write (ulsort,90003) 'chnom', chnom
 531       write (ulsort,90003) 'chnum', chnum
 532       write (ulsort,90003) 'chpdt', chpdt
 533       write (ulsort,90003) 'chins', chins
 534       write (ulsort,90003) 'chcas', chcas
 535       write (ulsort,90003) 'chncn', chncn
 536 #endif
 537 c
 538 c 2.9.1. ==> s'il ne manque que la caracteristique du support ou les
 539 c            indications temporelles, on suppose que ce champ est
 540 c            standard
 541 c
 542         if ( chnom ) then
 543 c
 544           caetal(1,nrcham) = -1
 545           if ( .not.chcas ) then
 546             caetal(7,nrcham) = 0
 547           endif
 548           if ( .not.chncn ) then
 549             caetal(8,nrcham) = 0
 550           endif
 551 c
 552 #ifdef _DEBUG_HOMARD_
 553           write (ulsort,*) '... ==> OK 29 ; passage au champ suivant'
 554 #endif
 555 c
 556 c 2.9.2. ==> s'il manque le nom, probleme ...
 557 c
 558         else
 559 c
 560           write (ulsort,texte(langue,5)) nrcham
 561           write (ulsort,texte(langue,7))
 562 #ifdef _DEBUG_HOMARD_
 563           if ( .not.chnum ) then
 564             write (ulsort,texte(langue,9))
 565           endif
 566           if ( .not.chpdt ) then
 567             write (ulsort,texte(langue,11))
 568           endif
 569           if ( .not.chins ) then
 570             write (ulsort,texte(langue,13))
 571           endif
 572 #endif
 573           codret = 1
 574 c
 575         endif
 576 c
 577         endif
 578 c
 579 cgn      print texte(langue,6), sau200(1:kaux)
 580 cgn      print *, '... support MED    caetal(1,',nrcham,') = ',
 581 cgn     >     caetal(1,nrcham)
 582 cgn      print *, '... pas de temps ? caetal(2,',nrcham,') = ',
 583 cgn     >     caetal(2,nrcham)
 584 cgn      print *, '... pas de temps = caetal(3,',nrcham,') = ',
 585 cgn     >     caetal(3,nrcham)
 586 cgn      print *, '... nro ordre ?    caetal(4,',nrcham,') = ',
 587 cgn     >     caetal(4,nrcham)
 588 cgn      print *, '... nro ordre =    caetal(5,',nrcham,') = ',
 589 cgn     >     caetal(5,nrcham)
 590 cgn      print *, '... instant ?      caetal(6,',nrcham,') = ',
 591 cgn     >     caetal(6,nrcham)
 592 cgn      print *, '... no/el ?        caetal(7,',nrcham,') = ',
 593 cgn     >     caetal(7,nrcham)
 594 cgn      print *, '... nr chp no/el   caetal(8,',nrcham,') = ',
 595 cgn     >     caetal(8,nrcham)
 596 cgn      print *, '... typint         caetal(10,',nrcham,') = ',
 597 cgn     >     caetal(10,nrcham)
 598 cgn      print *, '... instant =      cartal(',nrcham,') = ',
 599 cgn     >     cartal(nrcham)
 600    20 continue
 601 c
 602 c====
 603 c 3. la fin
 604 c====
 605 c
 606       if ( codret.ne.0 ) then
 607 c
 608 #include "envex2.h"
 609 c
 610       write (ulsort,texte(langue,1)) 'Sortie', nompro
 611       write (ulsort,texte(langue,2)) codret
 612 c
 613       endif
 614 c
 615 #ifdef _DEBUG_HOMARD_
 616       write (ulsort,texte(langue,1)) 'Sortie', nompro
 617       call dmflsh (iaux)
 618 #endif
 619 c
 620       end