src/tool/Utilitaire/utchnu.F

   1       subroutine utchnu ( option, nbenti, nounum,
   2      >                    dim1, dim2, table,
   3      >                    tabaux,
   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    UTilitaire - CHangement de NUmerotation d'une table
  26 c    --           --            --
  27 c ______________________________________________________________________
  28 c .        .     .        .                                            .
  29 c .  nom   . e/s . taille .           description                      .
  30 c .____________________________________________________________________.
  31 c . option . e   .    1   . type de renumerotation                     .
  32 c .        .     .        . 1 : changement de l'indice de la table     .
  33 c .        .     .        . 2 : changement du contenu de la table      .
  34 c .        .     .        . 3 : changement de l'indice et du contenu   .
  35 c . nbenti . e   .    1   . nombre d'entites                           .
  36 c . nounum . e   . nbenti . nouveau numero des entites                 .
  37 c . dim1   . e   .    1   . 1ere dimension de la table a renumeroter   .
  38 c . dim2   . e   .    1   . 2nde dimension de la table a renumeroter   .
  39 c . table  . es  .dim1dim2. table a renumeroter                        .
  40 c . tabaux . a   .dim1dim2. tableau auxiliaire pour les options 1 et 3 .
  41 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  42 c . langue . e   .    1   . langue des messages                        .
  43 c .        .     .        . 1 : francais, 2 : anglais                  .
  44 c . codret . es  .    1   . code de retour des modules                 .
  45 c .        .     .        . 0 : pas de probleme                        .
  46 c .        .     .        . 1 : mauvais choix d'option                 .
  47 c .        .     .        . 2 : mauvaises dimensions                   .
  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 = 'UTCHNU' )
  61 c
  62 #include "nblang.h"
  63 c
  64 c 0.2. ==> communs
  65 c
  66 #include "envex1.h"
  67 c
  68 c 0.3. ==> arguments
  69 c
  70       integer option
  71       integer nbenti
  72       integer dim1, dim2
  73       integer table(dim1,dim2)
  74       integer nounum(0:nbenti)
  75       integer tabaux(dim1,dim2)
  76 c
  77       integer ulsort, langue, codret
  78 c
  79 c 0.4. ==> variables locales
  80 c
  81       integer iaux, jaux
  82       integer diment
  83 c
  84       integer nbmess
  85       parameter ( nbmess = 10 )
  86       character*80 texte(nblang,nbmess)
  87 c
  88 c 0.5. ==> initialisations
  89 c ______________________________________________________________________
  90 c
  91 c====
  92 c 1. preliminaires
  93 c====
  94 c
  95 c 1.1. ==> messages
  96 c
  97 #include "impr01.h"
  98 c
  99 #ifdef _DEBUG_HOMARD_
 100       write (ulsort,texte(langue,1)) 'Entree', nompro
 101       call dmflsh (iaux)
 102 #endif
 103 c
 104       texte(1,4) = '(''Nombre d''''entites :'',i10)'
 105       texte(1,5) = '(''Option'',i10,'' impossible.'')'
 106       texte(1,6) = '(''Dimension'',i2,'' :'',i10)'
 107       texte(1,7) =
 108      > '(''Une dimension doit etre egale au nombre d''''entites.'')'
 109       texte(1,8) = '(''Changement de l''''indice de la table'')'
 110       texte(1,9) = '(''Changement du contenu de la table'')'
 111       texte(1,10) = '(''Changement de l''''indice et du contenu'')'
 112 c
 113       texte(2,4) = '(''Number of entities :'',i10)'
 114       texte(2,5) = '(''Option'',i10,'' impossible.'')'
 115       texte(2,6) = '(''Dimension #'',i2,'' :'',i10)'
 116       texte(2,7) =
 117      > '(''One should be equal to the number of entities.'')'
 118 c
 119       codret = 0
 120 c
 121 #ifdef _DEBUG_HOMARD_
 122         write (ulsort,texte(langue,4)) nbenti
 123         write (ulsort,texte(langue,6)) 1, dim1
 124         write (ulsort,texte(langue,6)) 2, dim2
 125 #endif
 126 c
 127 c====
 128 c 2. Controles
 129 c====
 130 c 2.1. ==> Option
 131 c
 132       if ( option.le.0 .or. option.ge.4 ) then
 133 c
 134         write (ulsort,texte(langue,5)) option
 135         codret = 1
 136 c
 137       endif
 138 c
 139 #ifdef _DEBUG_HOMARD_
 140       if ( codret.eq.0 ) then
 141         write (ulsort,texte(langue,7+option))
 142       endif
 143 #endif
 144 c
 145 c 2.2. ==> Les dimensions
 146 c
 147       if ( codret.eq.0 ) then
 148 c
 149       if ( option.eq.1 .or. option.eq.3 ) then
 150 c
 151         if ( dim1.eq.nbenti ) then
 152           diment = 1
 153         elseif ( dim2.eq.nbenti ) then
 154           diment = 2
 155         else
 156           write (ulsort,texte(langue,4)) nbenti
 157           write (ulsort,texte(langue,6)) 1, dim1
 158           write (ulsort,texte(langue,6)) 2, dim2
 159           write (ulsort,texte(langue,7))
 160           codret = 2
 161         endif
 162 c
 163       endif
 164 c
 165       endif
 166 c
 167 c====
 168 c 3. Renumerotation
 169 c====
 170 c
 171       if ( codret.eq.0 ) then
 172 c
 173 cgn      write (ulsort,*) '==> diment = ', diment
 174 c
 175 c 3.1. ==> Stockage de la table au depart
 176 c
 177       if ( option.eq.1 .or. option.eq.3 ) then
 178 c
 179         if ( diment.eq.1 ) then
 180 c
 181           do 311 , jaux = 1 , dim2
 182             do 312 , iaux = 1 , nbenti
 183               tabaux(iaux,jaux) = table(iaux,jaux)
 184   312       continue
 185   311     continue
 186 c
 187         else
 188 c
 189           do 313 , iaux = 1 , dim1
 190             do 314 , jaux = 1 , nbenti
 191               tabaux(iaux,jaux) = table(iaux,jaux)
 192   314       continue
 193   313     continue
 194 cgn      if ( dim1.eq.2 ) then
 195 cgn      write (ulsort,*) table(1,108482), table(2,108482)
 196 cgn      write (ulsort,*) table(1,109114), table(2,109114)
 197 cgn      write (ulsort,*) table(1,109215), table(2,109215)
 198 cgn      endif
 199 c
 200         endif
 201 c
 202       endif
 203 c
 204 c 3.2. ==> Bascule
 205 c
 206 c 3.2.1. ==> Changement de l'indice
 207 c
 208       if ( option.eq.1 ) then
 209 c
 210         if ( diment.eq.1 ) then
 211 cgn        write (ulsort,*) '3211'
 212 c
 213           do 3211 , jaux = 1 , dim2
 214 cgn        write (ulsort,*) '. jaux =', jaux
 215             do 3212 , iaux = 1 , nbenti
 216 cgn      write (ulsort,*) '.. taux(',iaux,',',jaux,')',tabaux(iaux,jaux)
 217               table(nounum(iaux),jaux) = tabaux(iaux,jaux)
 218  3212       continue
 219  3211     continue
 220 c
 221         else
 222 c
 223 cgn        write (ulsort,*) '3211'
 224           do 3213 , iaux = 1 , dim1
 225 cgn        write (ulsort,*) '. iaux =', iaux
 226             do 3214 , jaux = 1 , nbenti
 227 cgn      write (ulsort,*) '.. taux(',iaux,',',jaux,')',tabaux(iaux,jaux)
 228             table(iaux,nounum(jaux)) = tabaux(iaux,jaux)
 229  3214       continue
 230  3213     continue
 231 c
 232         endif
 233 c
 234 c 3.2.2. ==> Changement du contenu
 235 c
 236       elseif ( option.eq.2 ) then
 237 c
 238         do 3221 , iaux = 1 , dim1
 239 cgn        write (ulsort,*) '. iaux =', iaux
 240           do 3222 , jaux = 1 , dim2
 241 cgn      write (ulsort,*) '.. table(',iaux,',',jaux,')',table(iaux,jaux)
 242             table(iaux,jaux) = nounum(table(iaux,jaux))
 243  3222     continue
 244  3221   continue
 245 c
 246 c 3.2.3. ==> Changement de l'indice et du contenu
 247 c
 248       elseif ( option.eq.3 ) then
 249 c
 250         if ( diment.eq.1 ) then
 251 c
 252           do 3231 , jaux = 1 , dim2
 253             do 3232 , iaux = 1 , nbenti
 254               table(nounum(iaux),jaux) = nounum(tabaux(iaux,jaux))
 255  3232       continue
 256  3231     continue
 257 c
 258         else
 259 c
 260           do 3233 , iaux = 1 , dim1
 261             do 3234 , jaux = 1 , nbenti
 262               table(iaux,nounum(jaux)) = nounum(tabaux(iaux,jaux))
 263  3234       continue
 264  3233     continue
 265 c
 266         endif
 267 c
 268       endif
 269 c
 270       endif
 271 c
 272 c====
 273 c 3. la fin
 274 c====
 275 c
 276       if ( codret.ne.0 ) then
 277 c
 278 #include "envex2.h"
 279 c
 280       write (ulsort,texte(langue,1)) 'Sortie', nompro
 281       write (ulsort,texte(langue,2)) codret
 282 c
 283       endif
 284 c
 285 #ifdef _DEBUG_HOMARD_
 286       write (ulsort,texte(langue,1)) 'Sortie', nompro
 287       call dmflsh (iaux)
 288 #endif
 289 c
 290       end