src/tool/Utilitaire/utsex3.F

   1       subroutine utsex3 ( nbcham, nocham,
   2      >                    edsuav, edsuap, edsaav, edsaap, nbenti,
   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 - Solution - EXtrusion - phase 3
  25 c    --           -          --                -
  26 c    Changement du support dans un champ
  27 c ______________________________________________________________________
  28 c .        .     .        .                                            .
  29 c .  nom   . e/s . taille .           description                      .
  30 c .____________________________________________________________________.
  31 c . nbcham . e   .   1    . nombre de champs a traiter                 .
  32 c . nocham . e   . nbcham . nom des objets qui contiennent la          .
  33 c .        .     .        . description de chaque champ                .
  34 c . edsuav . e   .   1    . type med avant                             .
  35 c . edsuap . e   .   1    . type med apres                             .
  36 c . edsaav . e   .   1    . type med associe avant                     .
  37 c . edsaap . e   .   1    . type med associe apres                     .
  38 c . nbenti . e   .   1    . nombre d'entites apres                     .
  39 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  40 c . langue . e   .    1   . langue des messages                        .
  41 c .        .     .        . 1 : francais, 2 : anglais                  .
  42 c . codret . es  .    1   . code de retour des modules                 .
  43 c .        .     .        . 0 : pas de probleme                        .
  44 c .        .     .        . 1 : probleme                               .
  45 c ______________________________________________________________________
  46 c
  47 c====
  48 c 0. declarations et dimensionnement
  49 c====
  50 c
  51 c 0.1. ==> generalites
  52 c
  53       implicit none
  54       save
  55 c
  56       character*6 nompro
  57       parameter ( nompro = 'UTSEX3' )
  58 c
  59 #include "nblang.h"
  60 #include "esutil.h"
  61 c
  62 c 0.2. ==> communs
  63 c
  64 #include "envex1.h"
  65 c
  66 #include "gmenti.h"
  67 c
  68 c 0.3. ==> arguments
  69 c
  70       integer nbcham
  71       integer edsuav, edsuap, edsaav, edsaap, nbenti
  72 c
  73       character*8 nocham(nbcham)
  74 c
  75       integer ulsort, langue, codret
  76 c
  77 c 0.4. ==> variables locales
  78 c
  79       integer iaux, jaux
  80       integer codre1, codre2
  81       integer codre0
  82 c
  83       integer nrcham, nbtv
  84 c
  85       integer adcaen
  86 c
  87       character*8 obcham
  88 c
  89       integer nbmess
  90       parameter ( nbmess = 10 )
  91       character*80 texte(nblang,nbmess)
  92 c
  93 c 0.5. ==> initialisations
  94 c ______________________________________________________________________
  95 c
  96 c====
  97 c 1. initialisations
  98 c====
  99 c
 100 #include "impr01.h"
 101 c
 102 #ifdef _DEBUG_HOMARD_
 103       write (ulsort,texte(langue,1)) 'Entree', nompro
 104       call dmflsh (iaux)
 105 #endif
 106 c
 107       texte(1,4) = '(''Champ numero'',i3)'
 108 c
 109       texte(2,4) = '(''Field #'',i3)'
 110 c
 111 #include "impr03.h"
 112 c
 113 #ifdef _DEBUG_HOMARD_
 114       write (ulsort,90015) 'Support. Passage de', edsuav,' a', edsuap
 115       write (ulsort,90015) 'S. associe. Passage de', edsaav,' a', edsaap
 116       write (ulsort,90002) 'nbenti', nbenti
 117 #endif
 118 c
 119       codret = 0
 120 c
 121 c====
 122 c 2. exploration des champs
 123 c====
 124 c
 125       do 20 , nrcham = 1 , nbcham
 126 c
 127         if ( codret.eq.0 ) then
 128 c
 129         obcham = nocham(nrcham)
 130 c
 131 #ifdef _DEBUG_HOMARD_
 132         write (ulsort,texte(langue,4)) nrcham
 133 #endif
 134 #ifdef _DEBUG_HOMARD_
 135 cgn        call gmprsx (nompro, obcham )
 136         call gmprsx (nompro//' - entree', obcham//'.Cham_Ent' )
 137 #endif
 138 c
 139 c 2.1. ==> caracteristiques du champ
 140 c
 141         if ( codret.eq.0 ) then
 142 c
 143         call gmliat ( obcham, 2, nbtv, codre1 )
 144         call gmadoj ( obcham//'.Cham_Ent', adcaen, iaux, codre2 )
 145 c
 146         codre0 = min ( codre1, codre2 )
 147         codret = max ( abs(codre0), codret,
 148      >                 codre1, codre2 )
 149 c
 150         endif
 151 c
 152 #ifdef _DEBUG_HOMARD_
 153         if ( codret.eq.0 ) then
 154         write (ulsort,90002) 'nbtv', nbtv
 155         endif
 156 #endif
 157 c
 158 c 2.2. ==> modification des caracteristiques entieres des champs
 159 c
 160         if ( codret.eq.0 ) then
 161 c
 162         do 22 , iaux = 1 , nbtv
 163 c
 164           jaux = adcaen
 165 c
 166           if ( imem(jaux).eq.edsuav ) then
 167 c
 168 c 2.2.1. ==> Support
 169 #ifdef _DEBUG_HOMARD_
 170         write (ulsort,90002) '==> conversion support', edsuav, edsuap
 171 #endif
 172             imem(jaux) = edsuap
 173 c
 174 c 2.2.2. ==> Nombre d'entites
 175 c
 176             jaux = adcaen + 4
 177 #ifdef _DEBUG_HOMARD_
 178        write (ulsort,90002) '==> conversion nbenti', imem(jaux), nbenti
 179 #endif
 180             imem(jaux) = nbenti
 181 c
 182 c 2.2.3. ==> Support associe eventuel
 183 c
 184             jaux = adcaen + 20
 185             if ( mod(imem(jaux),edsaav).eq.0 ) then
 186 #ifdef _DEBUG_HOMARD_
 187        write (ulsort,90002) '==> conversion support associe',
 188      > imem(jaux), imem(jaux)*edsaap/edsaav
 189 #endif
 190               imem(jaux) = imem(jaux)*edsaap/edsaav
 191             endif
 192 c
 193           endif
 194 c
 195           adcaen = adcaen + nbinec
 196 c
 197    22   continue
 198 c
 199         endif
 200 c
 201 #ifdef _DEBUG_HOMARD_
 202 cgn        write (ulsort,texte(langue,4)) nrcham
 203         call gmprsx (nompro//' - sortie', obcham//'.Cham_Ent' )
 204 #endif
 205 c
 206         endif
 207 c
 208    20 continue
 209 c
 210 c====
 211 c 3. la fin
 212 c====
 213 c
 214       if ( codret.ne.0 ) then
 215 c
 216 #include "envex2.h"
 217 c
 218       write (ulsort,texte(langue,1)) 'Sortie', nompro
 219       write (ulsort,texte(langue,2)) codret
 220 c
 221       endif
 222 c
 223 #ifdef _DEBUG_HOMARD_
 224       write (ulsort,texte(langue,1)) 'Sortie', nompro
 225       call dmflsh (iaux)
 226 #endif
 227 c
 228       end