src/tool/Utilitaire/utmmc1.F

   1       subroutine utmmc1 ( sdim, nbnoto,
   2      >                    coonca, coocst, sdimre, ncnoeu,
   3      >                    ulsort, langue, codret )
   4 c ______________________________________________________________________
   5 c
   6 c                             H O M A R D
   7 c
   8 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   9 c
  10 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  11 c aupres des huissiers de justice Simart et Lavoir a Clamart
  12 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  13 c aupres des huissiers de justice
  14 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  15 c
  16 c    HOMARD est une marque deposee d'Electricite de France
  17 c
  18 c Copyright EDF 1996
  19 c Copyright EDF 1998
  20 c Copyright EDF 2002
  21 c Copyright EDF 2020
  22 c ______________________________________________________________________
  23 c
  24 c    UTilitaire - Minimum/Maximum des Coordonnees - phase 1
  25 c    --           -       -           -                   -
  26 c ______________________________________________________________________
  27 c .        .     .        .                                            .
  28 c .  nom   . e/s . taille .           description                      .
  29 c .____________________________________________________________________.
  30 c . sdim   . e   .   1    . dimension                                  .
  31 c . nbnoto . e   .   1    . nombre total de noeuds                     .
  32 c . coonca . e   . nbnoto . coordonnees des noeuds                     .
  33 c . coocst .  s  .   11   . 1 : coordonnee constante eventuelle        .
  34 c .        .     .        . 2, 3, 4 : xmin, ymin, zmin                 .
  35 c .        .     .        . 5, 6, 7 : xmax, ymax, zmax                 .
  36 c .        .     .        . 8, 9, 10 : -1 si constant, max-min sinon   .
  37 c .        .     .        . 11 : max des (max-min)                     .
  38 c . sdimre .  s  .   1    . dimension reelle                           .
  39 c . ncnoeu . es  .   1    . structure des noeuds                       .
  40 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  41 c . langue . e   .    1   . langue des messages                        .
  42 c .        .     .        . 1 : francais, 2 : anglais                  .
  43 c . codret . es  .    1   . code de retour des modules                 .
  44 c .        .     .        . 0 : pas de probleme                        .
  45 c .        .     .        . 1 : probleme                               .
  46 c ______________________________________________________________________
  47 c
  48 c====
  49 c 0. declarations et dimensionnement
  50 c====
  51 c
  52 c 0.1. ==> generalites
  53 c
  54       implicit none
  55       save
  56 c
  57       character*6 nompro
  58       parameter ( nompro = 'UTMMC1' )
  59 c
  60 #include "nblang.h"
  61 c
  62 c 0.2. ==> communs
  63 c
  64 #include "envex1.h"
  65 #include "indefr.h"
  66 c
  67 c 0.3. ==> arguments
  68 c
  69       integer sdim, nbnoto, dimcst
  70       integer sdimre
  71 c
  72       double precision coonca(nbnoto,sdim), coocst(11)
  73 c
  74       character*8 ncnoeu
  75 c
  76       integer ulsort, langue, codret
  77 c
  78 c 0.4. ==> variables locales
  79 c
  80       integer iaux
  81 c
  82       integer nbmess
  83       parameter ( nbmess = 10 )
  84       character*80 texte(nblang,nbmess)
  85 c ______________________________________________________________________
  86 c
  87 c====
  88 c 1. initialisations
  89 c====
  90 c
  91 c 1.1. ==> les messages
  92 c
  93 #include "impr01.h"
  94 c
  95 #ifdef _DEBUG_HOMARD_
  96       write (ulsort,texte(langue,1)) 'Entree', nompro
  97       call dmflsh (iaux)
  98 #endif
  99 c
 100       texte(1,4) =
 101      > '(''Direction '',a1,'' : mini = '',g12.5,'' maxi = '',g12.5)'
 102       texte(1,5) = '(/,8x,''La coordonnee'',i2,'' est constante.'')'
 103       texte(1,6) = '(8x,''Elle vaut : '',g12.4)'
 104       texte(1,7) =
 105      > '(50(''*''),/,''Taille maximale :'',g12.5,/,50(''*''))'
 106 c
 107       texte(2,4) =
 108      > '(a1,''direction '','' : mini = '',g12.5,'' maxi = '',g12.5)'
 109       texte(2,5) = '(/,8x,''The coordinate #'',i2,'' is constant.'')'
 110       texte(2,6) = '(8x,''Its value is : '',g12.4)'
 111       texte(2,7) =
 112      > '(50(''*''),/,''Maximum size :'',g12.5,/,50(''*''))'
 113 c
 114 c 1.2. ==> constantes
 115 c
 116       codret = 0
 117 c
 118 c====
 119 c 2. coordonnees extremes
 120 c====
 121 c
 122 #ifdef _DEBUG_HOMARD_
 123       write (ulsort,texte(langue,3)) 'UTMMCO', nompro
 124 #endif
 125       call utmmco ( coocst(2), coocst(5), coocst(8),
 126      >              nbnoto, sdim, coonca,
 127      >              ulsort, langue, codret )
 128 c
 129 #ifdef _DEBUG_HOMARD_
 130       if ( codret.eq.0 ) then
 131       write (ulsort,texte(langue,4)) 'x', coocst(2), coocst(5)
 132       write (ulsort,texte(langue,4)) 'y', coocst(3), coocst(6)
 133       if ( sdim.eq.3 ) then
 134         write (ulsort,texte(langue,4)) 'z', coocst(4), coocst(7)
 135       endif
 136       endif
 137 #endif
 138 c
 139 c====
 140 c 3. tests et memorisation
 141 c====
 142 c
 143       if ( codret.eq.0 ) then
 144 c
 145       dimcst = 0
 146       coocst(1) = rindef
 147       sdimre = 0
 148 c
 149       do 30 , iaux = 1 , sdim
 150 c
 151         if ( coocst(iaux+7).lt.0.d0 ) then
 152           dimcst = iaux
 153           call gmecat ( ncnoeu, 3, dimcst, codret )
 154           coocst(1) = coocst(iaux+1)
 155           write (ulsort,texte(langue,5)) dimcst
 156           write (ulsort,texte(langue,6)) coocst(1)
 157         else
 158           sdimre = sdimre + 1
 159         endif
 160 c
 161    30 continue
 162 c
 163       endif
 164 c
 165 c====
 166 c 4. la fin
 167 c====
 168 c
 169       if ( codret.ne.0 ) then
 170 c
 171 #include "envex2.h"
 172 c
 173       write (ulsort,texte(langue,1)) 'Sortie', nompro
 174       write (ulsort,texte(langue,2)) codret
 175 c
 176       endif
 177 c
 178 #ifdef _DEBUG_HOMARD_
 179       write (ulsort,texte(langue,1)) 'Sortie', nompro
 180       call dmflsh (iaux)
 181 #endif
 182 c
 183       end