src/tool/ES_MED/eslnof.F

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