src/tool/Utilitaire/utmcz0.F

   1       subroutine utmcz0 ( nbzord, cazord,
   2      >                    nbfich,
   3      >                    nomref, lgnofi, poinno,
   4      >                    nomufi, nomstr,
   5      >                    ulsort, langue, codret )
   6 c ______________________________________________________________________
   7 c
   8 c                             H O M A R D
   9 c
  10 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  11 c
  12 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  13 c aupres des huissiers de justice Simart et Lavoir a Clamart
  14 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  15 c aupres des huissiers de justice
  16 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  17 c
  18 c    HOMARD est une marque deposee d'Electricite de France
  19 c
  20 c Copyright EDF 1996
  21 c Copyright EDF 1998
  22 c Copyright EDF 2002
  23 c Copyright EDF 2020
  24 c ______________________________________________________________________
  25 c
  26 c     UTilitaire : Mot-Cle - caracterisation des Zones a Raffiner - 0
  27 c     --           -   -               -                            -
  28 c ______________________________________________________________________
  29 c .        .     .        .                                            .
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . nbzord . es  .    1   . nombre de zones a raffiner/deraffiner      .
  33 c .        .     .        . si negatif, les zones sont 2D (en x et y)  .
  34 c . cazord .  s  .  20 *  . caracteristiques zone a raffiner/deraffiner.
  35 c .        .     . nbzord . 1 : >0 si a raffiner, <0 si a deraffiner   .
  36 c .        .     .        . . si rectangle :                           .
  37 c .        .     .        . 1 : +-1                                    .
  38 c .        .     .        . de 2 a 5 : xmin, xmax, ymin, ymax          .
  39 c .        .     .        . . si parallelepipede :                     .
  40 c .        .     .        . 1 : +-2                                    .
  41 c .        .     .        . de 2 a 7 : xmin, xmax, ymin, ymax          .
  42 c .        .     .        .            zmin, zmax                      .
  43 c .        .     .        . . si disque :                              .
  44 c .        .     .        . 1 : +-3                                    .
  45 c .        .     .        . de  8 a 10 : rayon, xcentr, ycentr         .
  46 c .        .     .        . . si sphere :                              .
  47 c .        .     .        . 1 : +-4                                    .
  48 c .        .     .        . de  8 a 11 : rayon, xcentr, ycentr, zcentr .
  49 c .        .     .        . . si cylindre :                            .
  50 c .        .     .        . 1 : +-5                                    .
  51 c .        .     .        . 8          : rayon                         .
  52 c .        .     .        . de 12 a 14 : xaxe, yaxe, zaxe              .
  53 c .        .     .        . de 15 a 17 : xbase, ybase, zbase           .
  54 c .        .     .        . 18         : hauteur                       .
  55 c .        .     .        . . si disque perce :                        .
  56 c .        .     .        . 1 : +-6                                    .
  57 c .        .     .        . de  9 a 10 : xcentr, ycentr                .
  58 c .        .     .        . 19         : rayon interieur               .
  59 c .        .     .        . 20         : rayon exterieur               .
  60 c .        .     .        . . si tuyau :                               .
  61 c .        .     .        . 1 : +-7                                    .
  62 c .        .     .        . de 12 a 14 : xaxe, yaxe, zaxe              .
  63 c .        .     .        . de 15 a 17 : xbase, ybase, zbase           .
  64 c .        .     .        . 18         : hauteur                       .
  65 c .        .     .        . 19         : rayon interieur               .
  66 c .        .     .        . 20         : rayon exterieur               .
  67 c . nomref . e   . nbfich . nom de reference des fichiers              .
  68 c . lgnofi . e   . nbfich . longueurs des noms des fichiers            .
  69 c . poinno . e   .0:nbfich. pointeur dans le tableau des noms          .
  70 c . nomufi . e   . lgtanf . noms des fichiers                          .
  71 c . nomstr . e   . nbfich . nom des structures                         .
  72 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  73 c . langue . e   .    1   . langue des messages                        .
  74 c .        .     .        . 1 : francais, 2 : anglais                  .
  75 c . codret . es  .    1   . code de retour des modules                 .
  76 c .        .     .        . 0 : pas de probleme                        .
  77 c .        .     .        . 2 : probleme de lecture                    .
  78 c .        .     .        . 3 : type inconnu                           .
  79 c ______________________________________________________________________
  80 c
  81 c====
  82 c 0. declarations et dimensionnement
  83 c====
  84 c
  85 c 0.1. ==> generalites
  86 c
  87       implicit none
  88       save
  89 c
  90       character*6 nompro
  91       parameter ( nompro = 'UTMCZ0' )
  92 c
  93 #include "nblang.h"
  94 #include "motcle.h"
  95 c
  96       integer nbmcle
  97       parameter ( nbmcle = 20 )
  98 c
  99 c 0.2. ==> communs
 100 c
 101 #include "envex1.h"
 102 c
 103 c 0.3. ==> arguments
 104 c
 105       integer nbzord
 106       integer nbfich
 107       integer lgnofi(nbfich), poinno(0:nbfich)
 108 c
 109       character*8 nomref(nbfich), nomufi(*), nomstr(nbfich)
 110 c
 111       double precision cazord(nbmcle,nbzord)
 112 c
 113       integer ulsort, langue, codret
 114 c
 115 c 0.4. ==> variables locales
 116 c
 117       integer iaux, jaux
 118       integer nrfich
 119       integer nrzord, tyzord, tyzosi
 120       integer numero, nrmcle
 121 c
 122       character*8 mclref(nbmcle)
 123       character*200 sau200
 124 c
 125       logical mccode(nbmcle)
 126       logical mccod2(nbmcle)
 127 c
 128       double precision daux
 129 c
 130       integer nbmess
 131       parameter ( nbmess = 10 )
 132       character*80 texte(nblang,nbmess)
 133 c
 134       character*13 messag(nblang,7)
 135 c
 136 c 0.5. ==> initialisations
 137 c ______________________________________________________________________
 138 c
 139 c====
 140 c 1. messages
 141 c====
 142 c
 143 c 1.1. ==> tout va bien
 144 c
 145       codret = 0
 146 c
 147 c 1.2. ==> les messages
 148 c
 149 #include "impr01.h"
 150 c
 151 #ifdef _DEBUG_HOMARD_
 152       write (ulsort,texte(langue,1)) 'Entree', nompro
 153       call dmflsh (iaux)
 154 #endif
 155 c
 156       texte(1,4) = '(''Nombre de zones a raffiner :'',i8)'
 157       texte(1,5) = '(''Numero de la zone en cours de recherche :'',i8)'
 158       texte(1,6) = '(''Type de la zone : '',a)'
 159       texte(1,7) = '(''Le type '',i8,'' est inconnu.'')'
 160       texte(1,8) = '(''La valeur de '',a,'' est indecodable.'')'
 161 c
 162       texte(2,4) = '(''Number of zones to refine :'',i8)'
 163       texte(2,5) = '(''Search for zone #'',i8)'
 164       texte(2,6) = '(''Type of zone : '',a)'
 165       texte(2,7) = '(''The type #'',i8,'' is unknown.'')'
 166       texte(2,8) = '(''The value for '',a,'' cannot be uncoded.'')'
 167 c
 168 c                    1234567890123
 169       messag(1,1) = 'Rectangle    '
 170       messag(1,2) = 'Parallepipede'
 171       messag(1,3) = 'Disque       '
 172       messag(1,4) = 'Sphere       '
 173       messag(1,5) = 'Cylindre     '
 174       messag(1,6) = 'Disque perce '
 175       messag(1,7) = 'Tuyau        '
 176 c
 177       messag(2,1) = 'Rectangle    '
 178       messag(2,2) = 'Parallepiped '
 179       messag(2,3) = 'Disk         '
 180       messag(2,4) = 'Sphere       '
 181       messag(2,5) = 'Cylindre     '
 182       messag(2,6) = 'Disk         '
 183       messag(2,7) = 'Pipe         '
 184 c
 185 c 1.3. ==> preliminaires
 186 c
 187 #ifdef _DEBUG_HOMARD_
 188       write (ulsort,texte(langue,4)) nbzord
 189 #endif
 190       mclref( 1) = mczrty
 191       mclref( 2) = mcrxmi
 192       mclref( 3) = mcrxma
 193       mclref( 4) = mcrymi
 194       mclref( 5) = mcryma
 195       mclref( 6) = mcrzmi
 196       mclref( 7) = mcrzma
 197       mclref( 8) = mcrray
 198       mclref( 9) = mcrxce
 199       mclref(10) = mcryce
 200       mclref(11) = mcrzce
 201       mclref(12) = mcrxax
 202       mclref(13) = mcryax
 203       mclref(14) = mcrzax
 204       mclref(15) = mcrxba
 205       mclref(16) = mcryba
 206       mclref(17) = mcrzba
 207       mclref(18) = mcrhau
 208       mclref(19) = mcrrai
 209       mclref(20) = mcrrae
 210 c
 211 #ifdef _DEBUG_HOMARD_
 212       write(ulsort,*) mclref
 213 #endif
 214 c
 215 c====
 216 c 2. on parcourt toutes les posssibilites de zones de raffinement
 217 c====
 218 c
 219       do 20 , nrzord = 1 , nbzord
 220 c
 221 c 2.0. ==> On n'a rien au debut
 222 c
 223         do 201 , iaux = 1 , nbmcle
 224           mccode(iaux) = .false.
 225   201   continue
 226 c
 227         do 200 , nrfich = 1 , nbfich
 228 c
 229 c 2.1. ==> si c'est un des mots-cles possibles, on verifie si c'est
 230 c          pour la bonne zone
 231 c
 232           if ( codret.eq.0 ) then
 233 c
 234 cgn      write(ulsort,*) nomref(nrfich)
 235           nrmcle = -1
 236           do 21 , iaux = 1 , nbmcle
 237 cgn      write(ulsort,*) 'mclref(',iaux,') =', mclref(iaux)
 238             if ( nomref(nrfich).eq.mclref(iaux) ) then
 239               nrmcle = iaux
 240 cgn      write(ulsort,*) '==> nrmcle =',iaux
 241               goto 211
 242             endif
 243    21     continue
 244 c
 245   211     continue
 246 c
 247           if ( nrmcle.ge.1 ) then
 248 c
 249             call utchen ( nomstr(nrfich), numero,
 250      >                    ulsort, langue, codret )
 251 c
 252             if ( nrzord.ne.numero ) then
 253               goto 200
 254             endif
 255 c
 256           else
 257 c
 258             goto 200
 259 c
 260           endif
 261 c
 262           endif
 263 c
 264 c 2.2. ==> Recherche de la valeur
 265 c 2.2.1. ==> Mise sous forme de chaine de la 3eme donnee sur la ligne
 266 c
 267           if ( codret.eq.0 ) then
 268 c
 269           iaux = poinno(nrfich-1) + 1
 270           jaux = lgnofi(nrfich)
 271           call uts8ch ( nomufi(iaux), jaux, sau200,
 272      >                  ulsort, langue, codret )
 273 c
 274           endif
 275 cgn      write(ulsort,*) 'nrmcle =',nrmcle,nomufi(iaux),
 276 cgn     >'sau200 = ',sau200
 277 c
 278 c 2.2.2. ==> Conversions
 279 c
 280           if ( codret.eq.0 ) then
 281 c
 282 c 2.2.2.1. ==> Conversion du type : entier a decoder, puis reel
 283 c
 284           if ( nrmcle.eq.1 ) then
 285 c
 286             call utchen ( sau200, tyzord,
 287      >                    ulsort, langue, codret )
 288 c
 289             cazord(nrmcle,nrzord) = dble(tyzord)
 290             if ( tyzord.gt.0 ) then
 291               tyzosi = 1
 292             else
 293               tyzosi = -1
 294             endif
 295             tyzord = abs(tyzord)
 296 c
 297 c 2.2.2.2. ==> Conversion des coordonnees : reel
 298 c
 299           elseif ( nrmcle.ge.2 ) then
 300 c
 301             call utchre ( sau200, daux,
 302      >                    ulsort, langue, codret )
 303             cazord(nrmcle,nrzord) = daux
 304 c
 305             if ( codret.ne.0 ) then
 306               write (ulsort,texte(langue,5)) nrzord
 307               write (ulsort,texte(langue,8)) mclref(nrmcle)
 308             endif
 309 c
 310           endif
 311 c
 312           endif
 313 c
 314 c 2.2.3. ==> Memorisation du passage par le mot-cle
 315 c
 316           if ( codret.eq.0 ) then
 317 c
 318           mccode(nrmcle) = .true.
 319 c
 320           endif
 321 c
 322 c 2.3. ==> Controle ; si on a tout trouve, on passe a la zone suivante
 323 c
 324           if ( codret.eq.0 ) then
 325 c
 326           if ( mccode(1) ) then
 327 c
 328 c 2.3.1. ==> Cas du rectangle
 329 c
 330             if ( tyzord.eq.1 ) then
 331 c
 332               if ( mccode(2) .and. mccode(3) .and.
 333      >             mccode(4) .and. mccode(5) ) then
 334 c
 335                 goto 20
 336 c
 337               endif
 338 c
 339 c 2.3.2. ==> Cas du parallelepipede
 340 c
 341             elseif ( tyzord.eq.2 ) then
 342 c
 343               if ( mccode(2) .and. mccode(3) .and.
 344      >             mccode(4) .and. mccode(5) .and.
 345      >             mccode(6) .and. mccode(7) ) then
 346 c
 347                 goto 20
 348 c
 349               endif
 350 c
 351 c 2.3.3. ==> Cas du disque
 352 c
 353             elseif ( tyzord.eq.3 ) then
 354 c
 355               if ( mccode( 8) .and. mccode( 9) .and.
 356      >             mccode(10) ) then
 357 c
 358                 goto 20
 359 c
 360               endif
 361 c
 362 c 2.3.4. ==> Cas de la sphere
 363 c
 364             elseif ( tyzord.eq.4 ) then
 365 c
 366               if ( mccode( 8) .and. mccode( 9) .and.
 367      >             mccode(10) .and. mccode(11) ) then
 368 c
 369                 goto 20
 370 c
 371               endif
 372 c
 373 c 2.3.5. ==> Cas du cylindre
 374 c
 375             elseif ( tyzord.eq.5 ) then
 376 c
 377               if ( mccode( 8) .and.
 378      >             mccode(12) .and. mccode(13) .and.
 379      >             mccode(14) .and. mccode(15) .and.
 380      >             mccode(16) .and. mccode(17) .and.
 381      >             mccode(18) ) then
 382 c
 383                 goto 20
 384 c
 385               endif
 386 c
 387 c 2.3.6. ==> Cas du disque perce
 388 c
 389             elseif ( tyzord.eq.6 ) then
 390 c
 391               if ( mccode( 9) .and. mccode(10) .and.
 392      >             mccode(19) .and. mccode(20) ) then
 393 c
 394                 goto 20
 395 c
 396               endif
 397 c
 398 c 2.3.7. ==> Cas du tuyau
 399 c
 400             elseif ( tyzord.eq.7 ) then
 401 c
 402               if ( mccode(12) .and. mccode(13) .and.
 403      >             mccode(14) .and. mccode(15) .and.
 404      >             mccode(16) .and. mccode(17) .and.
 405      >             mccode(18) .and. mccode(19) .and.
 406      >             mccode(20) ) then
 407 c
 408                 goto 20
 409 c
 410               endif
 411 c
 412 c 2.3.n. ==> Type inconnu
 413 c
 414             else
 415               write (ulsort,texte(langue,7)) tyzord*tyzosi
 416               codret = 3
 417             endif
 418 c
 419           endif
 420 c
 421           endif
 422 c
 423   200   continue
 424 c
 425 c 2.4. ==> si on arrive ici, c'est qu'il en manque pour la zone courante
 426 c
 427         if ( codret.eq.0 ) then
 428 c
 429         do 240 , iaux = 1 , nbmcle
 430           mccod2(iaux) = .false.
 431   240   continue
 432 c
 433         write (ulsort,texte(langue,5)) nrzord
 434         write (ulsort,texte(langue,6)) messag(langue,tyzord)
 435         if ( tyzord.eq.1 ) then
 436           do 241 , iaux = 2 , 5
 437             mccod2(iaux) = .true.
 438   241     continue
 439         elseif ( tyzord.eq.2 ) then
 440           do 242 , iaux = 2 , 7
 441             mccod2(iaux) = .true.
 442   242     continue
 443         elseif ( tyzord.eq.3 ) then
 444           do 243 , iaux = 8 , 10
 445             mccod2(iaux) = .true.
 446   243     continue
 447         elseif ( tyzord.eq.4 ) then
 448           do 244 , iaux = 8 , 11
 449             mccod2(iaux) = .true.
 450   244     continue
 451         elseif ( tyzord.ge.5 ) then
 452           mccod2(8) = .true.
 453           do 245 , iaux = 12 , 18
 454             mccod2(iaux) = .true.
 455   245     continue
 456         elseif ( tyzord.eq.6 ) then
 457           do 246 , iaux = 8 , 10
 458             mccod2(iaux) = .true.
 459   246     continue
 460           mccod2(19) = .true.
 461         elseif ( tyzord.eq.7 ) then
 462           mccod2(8) = .true.
 463           do 248 , iaux = 12 , 19
 464             mccod2(iaux) = .true.
 465   248     continue
 466         endif
 467         do 24 , iaux = 2 , nbmcle
 468           if ( .not.mccode(iaux) .and. mccod2(iaux) ) then
 469             write (ulsort,texte(langue,8)) mclref(iaux)
 470           endif
 471    24   continue
 472 c
 473         codret = 2
 474 c
 475         endif
 476 c
 477    20 continue
 478 c
 479 c====
 480 c 3. la fin
 481 c====
 482 c
 483       if ( codret.ne.0 ) then
 484 c
 485       call dmflsh(iaux)
 486 c
 487 #include "envex2.h"
 488 c
 489       write (ulsort,texte(langue,1)) 'Sortie', nompro
 490       write (ulsort,texte(langue,2)) codret
 491 c
 492       endif
 493 c
 494 #ifdef _DEBUG_HOMARD_
 495       write (ulsort,texte(langue,1)) 'Sortie', nompro
 496       call dmflsh (iaux)
 497 #endif
 498 c
 499       end