src/tool/Utilitaire/utboqu.F

   1       subroutine utboqu ( nbquto, nbheto, numead,
   2      >                    nivqua, filqua, perqua,
   3      >                    hethex, hetpyr,
   4      >                    volqua, pypequ,
   5      >                    borqua,
   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 - BOrd - quadrangles
  28 c    --           --     --
  29 c ______________________________________________________________________
  30 c .        .     .        .                                            .
  31 c .  nom   . e/s . taille .           description                      .
  32 c .____________________________________________________________________.
  33 c . nbquto . e   .   1    . nombre de quadrangles total                .
  34 c . nbheto . e   .   1    . nombre d'hexaedres total                   .
  35 c . numead . e   .   1    . numero de la mere adoptive                 .
  36 c . nivqua . e   . nbquto . niveau des quadrangles                     .
  37 c . filqua . e   . nbquto . fils des quadrangles                       .
  38 c . perqua . e   . nbquto . pere des quadrangles                       .
  39 c . hethex . e   . nbheto . historique de l'etat des hexaedres         .
  40 c . hetpyr . e   . nbpyto . historique de l'etat des pyramides         .
  41 c . volqua . e   .nbquto*2. numeros des 2 volumes par quadrangle       .
  42 c .        .     .        . volqua(i,k) definit le i-eme voisin de k   .
  43 c .        .     .        .   0 : pas de voisin                        .
  44 c .        .     .        . j>0 : hexaedre j                           .
  45 c .        .     .        . j<0 : pyramide/pentaedre dans pypequ(1/2,j).
  46 c . pypequ . e   .2*lgpype. pypequ(1,j) = numero de la pyramide voisine.
  47 c .        .     .        . du quadrangle k tel que volqua(k,1/2) = -j .
  48 c .        .     .        . pypequ(2,j) = numero du pentaedre voisin   .
  49 c .        .     .        . du quadrangle k tel que volqua(k,1/2) = -j .
  50 c . borqua .  s  . nbquto . reperage des quadrangles de bord           .
  51 c .        .     .        . -1 : quadrangle non classe                 .
  52 c .        .     .        .  0 : quadrangle bidimensionnel             .
  53 c .        .     .        .  1 : quadrangle au bord d'un seul hexaedre .
  54 c .        .     .        .  2 : quadrangle entre 2 hexaedres          .
  55 c .        .     .        .  3 : quadrangle de non conformite          .
  56 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  57 c . langue . e   .    1   . langue des messages                        .
  58 c .        .     .        . 1 : francais, 2 : anglais                  .
  59 c . codret . es  .    1   . code de retour des modules                 .
  60 c .        .     .        . 0 : pas de probleme                        .
  61 c .        .     .        . sinon : probleme                           .
  62 c ______________________________________________________________________
  63 c
  64 c====
  65 c 0. declarations et dimensionnement
  66 c====
  67 c
  68 c 0.1. ==> generalites
  69 c
  70       implicit none
  71       save
  72 c
  73       character*6 nompro
  74       parameter ( nompro = 'UTBOQU' )
  75 c
  76 #include "nblang.h"
  77 c
  78 c 0.2. ==> communs
  79 c
  80 #include "envex1.h"
  81 #include "impr02.h"
  82 c
  83 c 0.3. ==> arguments
  84 c
  85       integer nbquto, nbheto, numead
  86       integer nivqua(nbquto)
  87       integer filqua(nbquto), perqua(nbquto)
  88       integer hethex(*), hetpyr(*)
  89       integer volqua(2,nbquto), pypequ(2,*)
  90       integer borqua(nbquto)
  91 c
  92       integer ulsort, langue, codret
  93 c
  94 c 0.4. ==> variables locales
  95 c
  96       integer iaux
  97       integer nbqu2d, nbqubo, nbquv2, nbquv3, nbquv4, nbqunc
  98 c
  99       integer nbmess
 100       parameter ( nbmess = 10 )
 101       character*80 texte(nblang,nbmess)
 102 c ______________________________________________________________________
 103 c
 104 c====
 105 c 1. messages
 106 c====
 107 c
 108 #include "impr01.h"
 109 c
 110 #ifdef _DEBUG_HOMARD_
 111       write (ulsort,texte(langue,1)) 'Entree', nompro
 112       call dmflsh (iaux)
 113 #endif
 114 c
 115       texte(1,4) =
 116      > '(''Nombre de '',a,'' de regions bidimensionnelles :'',i10)'
 117       texte(1,5) =
 118      > '(''Nombre de '',a,'' de bord                      :'',i10)'
 119       texte(1,6) =
 120      > '(''Nombre de '',a,'' internes aux volumes         :'',i10)'
 121       texte(1,7) =
 122      > '(''Nombre de '',a,'' de non conformite            :'',i10)'
 123       texte(1,8) =
 124      > '(''Nombre de '',a,'' non classes                  :'',i10)'
 125 c
 126       texte(2,4) =
 127      > '(''Number of '',a,'' in 2D regions     :'',i10)'
 128       texte(2,5) =
 129      > '(''Number of boundary '',a,''          :'',i10)'
 130       texte(2,6) =
 131      > '(''Number of '',a,'' inside of volume  :'',i10)'
 132       texte(2,7) =
 133      > '(''Number of non conformal '',a,''     :'',i10)'
 134       texte(2,8) =
 135      > '(''Number of '',a,'' without any place :'',i10)'
 136 c
 137       codret = 0
 138 c
 139 c====
 140 c 2. appel du programme generique
 141 c====
 142 c
 143 #ifdef _DEBUG_HOMARD_
 144       write (ulsort,texte(langue,3)) 'UTBOFA', nompro
 145 #endif
 146       iaux = 4
 147       call utbofa ( iaux, numead,
 148      >              nbquto, nbheto,
 149      >              nivqua, filqua, perqua,
 150      >              hethex, hetpyr,
 151      >              volqua, pypequ,
 152      >              borqua, nbqu2d, nbqubo,
 153      >              nbquv2, nbquv3, nbquv4, nbqunc,
 154      >              ulsort, langue, codret )
 155 c
 156 #ifdef _DEBUG_HOMARD_
 157       if ( codret.eq.0 ) then
 158       iaux = 4
 159       write(ulsort,texte(langue,4)) mess14(langue,3,iaux), nbqu2d
 160       write(ulsort,texte(langue,5)) mess14(langue,3,iaux), nbqubo
 161       write(ulsort,texte(langue,6)) mess14(langue,3,iaux), nbquv2
 162       write(ulsort,texte(langue,7)) mess14(langue,3,iaux), nbqunc
 163       write(ulsort,texte(langue,8)) mess14(langue,3,iaux),
 164      >                        nbquto - nbqu2d - nbqubo - nbquv2 - nbqunc
 165       endif
 166 #endif
 167 c
 168 c====
 169 c 3. la fin
 170 c====
 171 c
 172       if ( codret.ne.0 ) then
 173 c
 174 #include "envex2.h"
 175 c
 176       write (ulsort,texte(langue,1)) 'Sortie', nompro
 177       write (ulsort,texte(langue,2)) codret
 178 c
 179       endif
 180 c
 181 #ifdef _DEBUG_HOMARD_
 182       write (ulsort,texte(langue,1)) 'Sortie', nompro
 183       call dmflsh (iaux)
 184 #endif
 185 c
 186       end