src/tool/Information/infve6.F

   1       subroutine infve6 ( action, numblo, numniv,
   2      >                    infsup, typcof,
   3      >                    nomcha, nomcmp, nrocha,
   4      >                    titre0,
   5      >                    titre1, lgtit1, titre2, lgtit2,
   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   INformation : Fichier VEctoriel - 6eme partie
  28 c   --            -       --          -
  29 c ______________________________________________________________________
  30 c .        .     .        .                                            .
  31 c .  nom   . e/s . taille .           description                      .
  32 c .____________________________________________________________________.
  33 c . action . e   . char8  . action en cours                            .
  34 c . numblo . e   .   1    . numero du bloc a tracer                    .
  35 c .        .     .        . 0 : trace du domaine global                .
  36 c . numniv . e   .   1    . numero du niveau a tracer                  .
  37 c .        .     .        . -1 : tous les niveaux                      .
  38 c . infsup . e   .   1    . information supplementaire a afficher      .
  39 c .        .     .        . 0 : aucune                                 .
  40 c .        .     .        . 1 : numero homard des noeuds               .
  41 c .        .     .        . 2 : numero du calcul des noeuds            .
  42 c .        .     .        . 3 : numero homard des faces                .
  43 c .        .     .        . 4 : numero du calcul des faces             .
  44 c .        .     .        . 5 : numero homard des aretes               .
  45 c .        .     .        . 6 : numero du calcul des aretes            .
  46 c .        .     .        . np : choix n et choix p simultanement      .
  47 c . typcof . e   .   1    . type de coloriage des faces                .
  48 c .        .     .        .   0 : incolore transparent                 .
  49 c .        .     .        .   1 : incolore opaque                      .
  50 c .        .     .        .   2 : famille HOMARD                       .
  51 c .        .     .        .   4 : idem 2, en niveau de gris            .
  52 c .        .     .        . +-6 : couleur selon un champ, echelle auto..
  53 c .        .     .        . +-7 : idem avec echelle fixe               .
  54 c .        .     .        . +-8/+-9 : idem +-6/+-7, en niveau de gris  .
  55 c .        .     .        .  10 : niveau                               .
  56 c . nomcha . e   . char64 . nom du champ retenu pour le coloriage      .
  57 c . nomcmp . e   .   1    . nom de la composante retenue               .
  58 c . nrocha . e   .   1    . nunero du champ retenu pour le coloriage   .
  59 c .        .     .        . -1 si coloriage selon la qualite           .
  60 c . titre0 . e   .   20   . titre initial                              .
  61 c . titre1 .  s  .  100   . titre 1                                    .
  62 c . lgtit1 .  s  .   1    . longueur du titre 1                        .
  63 c . titre2 .  s  .  100   . titre 2                                    .
  64 c . lgtit2 .  s  .   1    . longueur du titre 2                        .
  65 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  66 c . langue . e   .    1   . langue des messages                        .
  67 c .        .     .        . 1 : francais, 2 : anglais                  .
  68 c . codret . es  .    1   . code de retour des modules                 .
  69 c .        .     .        . 0 : pas de probleme                        .
  70 c .        .     .        . 2 : probleme dans les memoires             .
  71 c .        .     .        . 3 : probleme dans les fichiers             .
  72 c .        .     .        . 5 : probleme autre                         .
  73 c ______________________________________________________________________
  74 c
  75 c====
  76 c 0. declarations et dimensionnement
  77 c====
  78 c
  79 c 0.1. ==> generalites
  80 c
  81       implicit none
  82       save
  83 c
  84       character*6 nompro
  85       parameter ( nompro = 'INFVE6' )
  86 c
  87 #include "nblang.h"
  88 c
  89 c 0.2. ==> communs
  90 c
  91 #include "envex1.h"
  92 c
  93 #include "envca2.h"
  94 #include "envada.h"
  95 c
  96 c 0.3. ==> arguments
  97 c
  98       integer numblo, numniv
  99       integer infsup, typcof
 100       integer nrocha
 101       integer lgtit1, lgtit2
 102 c
 103       character*8 action
 104       character*16 nomcmp
 105       character*64 nomcha
 106       character*100 titre1, titre2
 107 c
 108       integer ulsort, langue, codret
 109 c
 110 c 0.4. ==> variables locales
 111 c
 112       integer iaux, jaux
 113 c
 114       character*8 saux08
 115       character*20 titre0
 116 c
 117       integer nbmess
 118       parameter ( nbmess = 10 )
 119       character*80 texte(nblang,nbmess)
 120 c
 121 c 0.5. ==> initialisations
 122 c ______________________________________________________________________
 123 c
 124 c====
 125 c 1. messages
 126 c====
 127 c
 128 #include "impr01.h"
 129 c
 130 #ifdef _DEBUG_HOMARD_
 131       write (ulsort,texte(langue,1)) 'Entree', nompro
 132       call dmflsh (iaux)
 133 #endif
 134 c
 135       texte(1,4) = '(''Action en cours : '',a)'
 136       texte(1,10) = '(''titre'',i1,'' : '',a)'
 137 c
 138       texte(2,4) = '(''Current action : '',a)'
 139       texte(2,10) = '(''titre'',i1,'' : '',a)'
 140 c
 141 #ifdef _DEBUG_HOMARD_
 142       write (ulsort,texte(langue,4)) action
 143 #endif
 144 c
 145 c====
 146 c 2. Titres
 147 c====
 148 c 2.1. ==> Titres vides au depart
 149 c
 150       do 21 , iaux = 1 , 100
 151         titre1(iaux:iaux) = ' '
 152         titre2(iaux:iaux) = ' '
 153    21 continue
 154 c
 155 c 2.2 ==> Action et numero d'iteration
 156 c               12345678
 157       saux08 = '        '
 158       if ( action(1:7).eq.'info_av' ) then
 159         saux08(1:4) = 'avad'
 160       elseif ( action(1:7).eq.'info_ap' ) then
 161         saux08(1:4) = 'apad'
 162       endif
 163 c
 164       call utench ( nbiter, '0', iaux, saux08(6:7),
 165      >              ulsort, langue, codret )
 166 c
 167 c 2.3 ==> Ajout du titre du calcul
 168 c
 169       if ( codret.eq.0 ) then
 170 c
 171       call utlgut ( iaux, titre, ulsort, langue, codret )
 172 c
 173       endif
 174 c
 175       if ( codret.eq.0 ) then
 176 c
 177       titre1(1:iaux+11) = saux08//'- '//titre
 178 c
 179       lgtit1 = iaux + 11
 180 c
 181       endif
 182 c
 183 c 2.4 ==> Bloc eventuel
 184 c
 185       if ( codret.eq.0 ) then
 186 c
 187       if ( numblo.gt.0 ) then
 188 c
 189         call utench ( numblo, 'g', jaux, saux08,
 190      >                ulsort, langue, codret )
 191 c
 192         if ( codret.eq.0 ) then
 193 c
 194         if ( langue.eq.1 ) then
 195           if ( lgtit1+14+jaux.le.100 ) then
 196             titre1(lgtit1+1:lgtit1+14+jaux) =
 197      >                                 '- Bloc numero '//saux08(1:jaux)
 198 c                                       12345678901234
 199             lgtit1 = lgtit1+14+jaux
 200           endif
 201         else
 202           if ( lgtit1+10+jaux.le.100 ) then
 203             titre1(lgtit1+1:lgtit1+10+jaux) =
 204      >                                 '- Block # '//saux08(1:jaux)
 205 c                                       1234567890
 206             lgtit1 = lgtit1+10+jaux
 207           endif
 208         endif
 209 c
 210         endif
 211 c
 212       endif
 213 c
 214       endif
 215 c
 216 c 2.5 ==> Niveau eventuel
 217 c
 218       if ( codret.eq.0 ) then
 219 c
 220       if ( numniv.gt.-1 ) then
 221 c
 222         call utench ( numniv, 'g', jaux, saux08,
 223      >                ulsort, langue, codret )
 224 c
 225         if ( codret.eq.0 ) then
 226 c
 227         if ( langue.eq.1 ) then
 228           if ( iaux+10+jaux.le.100 ) then
 229             titre1(iaux+1:iaux+10+jaux) =
 230      >                              ' - Niveau '//saux08(1:jaux)
 231 c                                    1234567890
 232             iaux = iaux+10+jaux
 233           endif
 234         else
 235           if ( iaux+11+jaux.le.100 ) then
 236             titre1(iaux+1:iaux+11+jaux) =
 237      >                                 ' - Level # '//saux08(1:jaux)
 238 c                                       12345678901
 239             iaux = iaux+11+jaux
 240           endif
 241         endif
 242 c
 243         lgtit1 = iaux
 244 c
 245         endif
 246 c
 247       endif
 248 c
 249       endif
 250 c
 251 c 2.6 ==> Complements en fonction des choix retenus pour les couleurs
 252 c
 253       if ( codret.eq.0 ) then
 254 cgn      print *,titre1
 255 cgn      print *,'lgtit1 =', lgtit1
 256 c
 257       if (      ( typcof.ge.2 .and. typcof.le.5 ) .or.
 258      >     ( abs(typcof).ge.6 .and. abs(typcof).le.9 ) .or.
 259      >     typcof.eq.10 ) then
 260 c
 261         if ( typcof.eq.10 ) then
 262           if ( langue.eq.1 ) then
 263             if ( lgtit1+24.le.100 ) then
 264 c                                           123456789012345678901234
 265               titre1(lgtit1+1:lgtit1+24) = ' - Niveau de raffinement'
 266               lgtit1 = lgtit1 + 24
 267             endif
 268           else
 269             if ( iaux+19.le.100 ) then
 270               titre1(lgtit1+1:lgtit1+19) = ' - Refinement level'
 271               lgtit1 = lgtit1 + 19
 272             endif
 273           endif
 274         elseif ( typcof.eq.2 .or. typcof.eq.4 ) then
 275           if ( langue.eq.1 ) then
 276             if ( lgtit1+17.le.100 ) then
 277 c                                           12345678901234567
 278               titre1(lgtit1+1:lgtit1+17) = ' - Famille HOMARD'
 279               lgtit1 = lgtit1 + 17
 280             endif
 281           else
 282             if ( lgtit1+16.le.100 ) then
 283               titre1(lgtit1+1:lgtit1+16)  = ' - HOMARD family'
 284               lgtit1 = lgtit1 + 16
 285             endif
 286           endif
 287         else
 288           if ( nrocha.le.0 ) then
 289             if ( langue.eq.1 ) then
 290               if ( lgtit1+10.le.100 ) then
 291 c                                             1234567890
 292                 titre1(lgtit1+1:lgtit1+10) = ' - Qualite'
 293                 lgtit1 = lgtit1 + 10
 294               endif
 295             else
 296               if ( lgtit1+10.le.100 ) then
 297                 titre1(lgtit1+1:lgtit1+10) = ' - Quality'
 298                 lgtit1 = lgtit1 + 10
 299               endif
 300             endif
 301           else
 302             call utlgut ( iaux, nomcha, ulsort, langue, codret )
 303             jaux = lgtit1 + 3 + iaux
 304             if ( iaux.gt.0 .and. jaux.le.100 ) then
 305               titre1(lgtit1+1:jaux) = ' - '//nomcha(1:iaux)
 306               lgtit1 = jaux
 307             endif
 308             call utlgut ( iaux, nomcmp, ulsort, langue, codret )
 309             jaux = lgtit1 + 2 + iaux
 310             if ( iaux.gt.0 .and. jaux.le.100 ) then
 311               titre1(lgtit1+1:jaux) = ', '//nomcmp(1:iaux)
 312               lgtit1 = jaux
 313             endif
 314             call utlgut ( iaux, titre0, ulsort, langue, codret )
 315             jaux = lgtit1 + 1 + iaux
 316             if ( iaux.gt.0 .and. jaux.le.100 ) then
 317               titre1(lgtit1+1:jaux) = ' ' // titre0(1:iaux)
 318               lgtit1 = jaux
 319             endif
 320           endif
 321         endif
 322       endif
 323 c
 324       endif
 325 c
 326 c 2.6 ==> Complements en fonction des choix retenus pour les ecritures
 327 c
 328       if ( codret.eq.0 ) then
 329 c
 330 c                    123456789012345678901234567
 331       if ( infsup.eq.1 ) then
 332         if ( langue.eq.1 ) then
 333           titre2 = 'Numero HOMARD des noeuds'
 334           lgtit2 = 24
 335         else
 336           titre2 = 'HOMARD # of nodes'
 337           lgtit2 = 17
 338         endif
 339       elseif ( infsup.eq.2 ) then
 340         if ( langue.eq.1 ) then
 341           titre2 = 'Numero du calcul des noeuds'
 342           lgtit2 = 27
 343         else
 344           titre2 = 'Extern # of nodes'
 345           lgtit2 = 17
 346         endif
 347       elseif ( infsup.eq.3 ) then
 348         if ( langue.eq.1 ) then
 349           titre2 = 'Numero HOMARD des faces'
 350           lgtit2 = 23
 351         else
 352           titre2 = 'HOMARD # of faces'
 353           lgtit2 = 17
 354         endif
 355       elseif ( infsup.eq.4 ) then
 356         if ( langue.eq.1 ) then
 357           titre2 = 'Numero du calcul des faces'
 358           lgtit2 = 26
 359         else
 360           titre2 = 'Extern # of faces'
 361           lgtit2 = 17
 362         endif
 363       elseif ( infsup.eq.5 ) then
 364         if ( langue.eq.1 ) then
 365           titre2 = 'Numero HOMARD des aretes'
 366           lgtit2 = 24
 367         else
 368           titre2 = 'HOMARD # of edges'
 369           lgtit2 = 17
 370         endif
 371       elseif ( infsup.eq.6 ) then
 372         if ( langue.eq.1 ) then
 373           titre2 = 'Numero du calcul des aretes'
 374           lgtit2 = 27
 375         else
 376           titre2 = 'Extern # of edges'
 377           lgtit2 = 17
 378         endif
 379       else
 380         lgtit2 = 0
 381       endif
 382 c
 383       if ( lgtit2.ne.0 ) then
 384         titre2(lgtit2+1:lgtit2+3) = ' - '
 385         lgtit2 = lgtit2 + 3
 386       endif
 387       call utlgut ( iaux, ladate, ulsort, langue, codret )
 388       titre2(lgtit2+1:lgtit2+iaux) = ladate
 389       lgtit2 = lgtit2 + iaux
 390 c
 391       endif
 392 c
 393 #ifdef _DEBUG_HOMARD_
 394       write (ulsort,texte(langue,10)) 1, titre1
 395       write (ulsort,texte(langue,10)) 2, titre2
 396 #endif
 397 c
 398 c====
 399 c 3. la fin
 400 c====
 401 c
 402       if ( codret.ne.0 ) then
 403 c
 404 #include "envex2.h"
 405 c
 406       write (ulsort,texte(langue,1)) 'Sortie', nompro
 407       write (ulsort,texte(langue,2)) codret
 408 c
 409       endif
 410 c
 411 #ifdef _DEBUG_HOMARD_
 412       write (ulsort,texte(langue,1)) 'Sortie', nompro
 413       call dmflsh (iaux)
 414 #endif
 415 c
 416       end