src/tool/ES_MED/eslnom.F

   1       subroutine eslnom ( idfmed, nomamd, lnomam,
   2      >                      sdim,   mdim,
   3      >                    typrep, nomaxe, uniaxe,
   4      >                    ulsort, langue, codret )
   5 c ______________________________________________________________________
   6 c
   7 c                             H O M A R D
   8 c
   9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  10 c
  11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  12 c aupres des huissiers de justice Simart et Lavoir a Clamart
  13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  14 c aupres des huissiers de justice
  15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  16 c
  17 c    HOMARD est une marque deposee d'Electricite de France
  18 c
  19 c Copyright EDF 1996
  20 c Copyright EDF 1998
  21 c Copyright EDF 2002
  22 c Copyright EDF 2020
  23 c ______________________________________________________________________
  24 c
  25 c  Entree-Sortie - Lecture - NOm du Maillage
  26 c  -      -        -         --     -
  27 c ______________________________________________________________________
  28 c Remarque : eslnom et eslnof sont des clones
  29 c ______________________________________________________________________
  30 c .        .     .        .                                            .
  31 c .  nom   . e/s . taille .           description                      .
  32 c .____________________________________________________________________.
  33 c . idfmed . e   .   1    . identificateur du fichier de               .
  34 c .        .     .        . maillage d'entree                          .
  35 c . nomamd . e   . char64 . nom du maillage MED                        .
  36 c . lnomam . e   .   1    . longueur du nom du maillage voulu          .
  37 c . sdim   .  s  .   1    . dimension de l'espace                      .
  38 c . mdim   .  s  .   1    . dimension du maillage                      .
  39 c . typrep .  s  .   1    . type de repere                             .
  40 c . nomaxe .  s  .   3    . nom des axes de coordonnees                .
  41 c . uniaxe .  s  .   3    . unite des axes de coordonnees              .
  42 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  43 c . langue . e   .    1   . langue des messages                        .
  44 c .        .     .        . 1 : francais, 2 : anglais                  .
  45 c . codret . es  .    1   . code de retour des modules                 .
  46 c .        .     .        . 0 : pas de probleme                        .
  47 c .        .     .        . 3 : le maillage est absent du fichier      .
  48 c ______________________________________________________________________
  49 c
  50 c====
  51 c 0. declarations et dimensionnement
  52 c====
  53 c
  54 c 0.1. ==> generalites
  55 c
  56       implicit none
  57       save
  58 c
  59       character*6 nompro
  60       parameter ( nompro = 'ESLNOM' )
  61 c
  62 #include "nblang.h"
  63 #include "consts.h"
  64 c
  65 c 0.2. ==> communs
  66 c
  67 #include "envex1.h"
  68 c
  69 #include "gmenti.h"
  70 #include "gmstri.h"
  71 c
  72 c 0.3. ==> arguments
  73 c
  74       integer*8 idfmed
  75       integer lnomam
  76       integer sdim, mdim
  77       integer typrep
  78 c
  79       character*16 nomaxe(3), uniaxe(3)
  80       character*64 nomamd
  81 c
  82       integer ulsort, langue, codret
  83 c
  84 c 0.4. ==> variables locales
  85 c
  86 #include "meddc0.h"
  87 c
  88       integer nbmaie
  89       integer typema
  90       integer stype, nstep
  91 c
  92       integer iaux, jaux
  93       integer ptrav1, ptrav2
  94       integer codre1, codre2
  95       integer codre0
  96 c
  97       character*8 ntrav1, ntrav2
  98       character*16 saux16
  99       character*64 saux64
 100       character*200 sau200
 101 c
 102       integer nbmess
 103       parameter ( nbmess = 150 )
 104       character*80 texte(nblang,nbmess)
 105 c ______________________________________________________________________
 106 c
 107 c====
 108 c 1. initialisations
 109 c====
 110 c
 111 #include "impr01.h"
 112 c
 113 #ifdef _DEBUG_HOMARD_
 114       write (ulsort,texte(langue,1)) 'Entree', nompro
 115       call dmflsh (iaux)
 116 #endif
 117 c
 118 #include "esimpr.h"
 119 c
 120       mdim = 0
 121 c
 122       texte(1,4) = '(''Nombre de maillages :'',i3)'
 123       texte(1,5) = '(''Nom du maillage numero'',i3,'' : '',a64)'
 124 c
 125       texte(2,4) = '(''Number of meshes:'',i3)'
 126       texte(2,5) = '(''Name of mesh #'',i3,'': '',a64)'
 127 c
 128 #include "impr03.h"
 129 c
 130 #ifdef _DEBUG_HOMARD_
 131       write (ulsort,texte(langue,22)) nomamd(1:lnomam)
 132 #endif
 133 c
 134 c====
 135 c 2. le maillage est-il present ?
 136 c====
 137 c 2.1. ==> combien de maillages
 138 #ifdef _DEBUG_HOMARD_
 139       write (ulsort,90002) '2.1. combien de maillages ; codret', codret
 140 #endif
 141 c
 142       if ( codret.eq.0 ) then
 143 c
 144 #ifdef _DEBUG_HOMARD_
 145       write (ulsort,texte(langue,3)) 'MMHNMH', nompro
 146 #endif
 147       call mmhnmh ( idfmed, nbmaie, codret )
 148       if ( codret.ne.0 ) then
 149         write (ulsort,texte(langue,20))
 150 #ifdef _DEBUG_HOMARD_
 151       else
 152         write (ulsort,texte(langue,4)) nbmaie
 153 #endif
 154       endif
 155 c
 156       endif
 157 c
 158 c 2.2. ==> structures de stockage des noms des maillages du fichier
 159 #ifdef _DEBUG_HOMARD_
 160       write (ulsort,90002) '2.2. structures ; codret', codret
 161 #endif
 162 c
 163       if ( codret.eq.0 ) then
 164 c
 165       iaux = 8*nbmaie
 166       call gmalot ( ntrav1, 'chaine  ', iaux   , ptrav1, codre1 )
 167       call gmalot ( ntrav2, 'entier  ', nbmaie , ptrav2, codre2 )
 168 c
 169       codre0 = min ( codre1, codre2 )
 170       codret = max ( abs(codre0), codret,
 171      >               codre1, codre2 )
 172 c
 173       endif
 174 c
 175 c 2.3. ==> numero et dimension du maillage voulu
 176 #ifdef _DEBUG_HOMARD_
 177       write (ulsort,90002) '2.3. numero et dimension ; codret', codret
 178 #endif
 179 c
 180       if ( codret.eq.0 ) then
 181 c
 182       do 23 , iaux = 1 , nbmaie
 183 c
 184 c 2.3.1. ==> nom et dimension du maillage numero iaux
 185 c            sdim : Dimension de l'espace de calcul.
 186 c            mdim : Dimension du maillage.
 187 c
 188         if ( codret.eq.0 ) then
 189 c                        12345678901234567890123456789012
 190         saux64( 1:32) = '                                '
 191         saux64(33:64) = '                                '
 192 #ifdef _DEBUG_HOMARD_
 193       write (ulsort,texte(langue,3)) 'MMHMII', nompro
 194 #endif
 195         call mmhmii ( idfmed, iaux,
 196      >                saux64,   sdim,   mdim, typema, sau200,
 197      >                saux16,  stype,  nstep,
 198      >                typrep, nomaxe, uniaxe,
 199      >                codret )
 200         if ( codret.ne.0 ) then
 201           write (ulsort,texte(langue,20))
 202         endif
 203 c
 204         endif
 205 c
 206         if ( codret.eq.0 ) then
 207         call utlgut ( jaux, saux64,
 208      >                ulsort, langue, codret )
 209         endif
 210 c
 211 #ifdef _DEBUG_HOMARD_
 212         write (ulsort,texte(langue,5)) iaux, saux64
 213 #endif
 214 c
 215 c 2.3.2. ==> archivage de ce nom
 216 c
 217         if ( codret.eq.0 ) then
 218 c
 219         call utchs8 ( saux64, jaux, smem(ptrav1+8*(iaux-1)),
 220      >                ulsort, langue, codret )
 221 c
 222         endif
 223 c
 224         if ( codret.eq.0 ) then
 225 c
 226         imem(ptrav2+iaux-1) = jaux
 227 c
 228         endif
 229 c
 230 c 2.3.3. ==> comparaison avec le nom voulu
 231 c            une fois le maillage trouve, on s'assure qu'il est decrit
 232 c            en non structure
 233 c
 234         if ( codret.eq.0 ) then
 235         if ( jaux.eq.lnomam ) then
 236           if ( saux64(1:jaux).eq.nomamd(1:lnomam) ) then
 237             if ( typema.ne.ednost ) then
 238               write (ulsort,texte(langue,22)) nomamd(1:lnomam)
 239               write (ulsort,texte(langue,28)) typema
 240               codret = 11
 241             endif
 242             goto 24
 243           endif
 244         endif
 245         endif
 246 c
 247    23 continue
 248 c
 249 c 2.3.4. ==> le maillage voulu est inconnu dans ce fichier
 250 c
 251       codret = 3
 252       write (ulsort,texte(langue,12)) nomamd(1:lnomam)
 253       write (ulsort,texte(langue,4)) nbmaie
 254 c
 255       do 234 , iaux = 1 , nbmaie
 256 c
 257         jaux = imem(ptrav2+iaux-1)
 258         call uts8ch ( smem(ptrav1+8*(iaux-1)), jaux, saux64,
 259      >                ulsort, langue, codre1 )
 260         write (ulsort,texte(langue,5)) iaux, saux64
 261 c
 262   234 continue
 263 c
 264       endif
 265 c
 266 c 2.4. ==> menage
 267 c
 268    24 continue
 269 c
 270       if ( codret.eq.0 ) then
 271 c
 272 #ifdef _DEBUG_HOMARD_
 273       write (ulsort,90002) 'sdim', sdim
 274       write (ulsort,90002) 'mdim', mdim
 275 #endif
 276 c
 277       call gmlboj ( ntrav1 , codre1 )
 278       call gmlboj ( ntrav2 , codre2 )
 279 c
 280       codre0 = min ( codre1, codre2 )
 281       codret = max ( abs(codre0), codret,
 282      >               codre1, codre2 )
 283 c
 284       endif
 285 c
 286 c====
 287 c 3. la fin
 288 c====
 289 c
 290       if ( codret.ne.0 ) then
 291 c
 292 #include "envex2.h"
 293 c
 294       write (ulsort,texte(langue,1)) 'Sortie', nompro
 295       write (ulsort,texte(langue,2)) codret
 296 c
 297       endif
 298 c
 299 #ifdef _DEBUG_HOMARD_
 300       write (ulsort,texte(langue,1)) 'Sortie', nompro
 301       call dmflsh (iaux)
 302 #endif
 303 c
 304       end