src/tool/Utilitaire/utmczr.F

   1       subroutine utmczr ( ncazor, nbzord,
   2      >                    ulsort, langue, codret )
   3 c ______________________________________________________________________
   4 c
   5 c                             H O M A R D
   6 c
   7 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   8 c
   9 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  10 c aupres des huissiers de justice Simart et Lavoir a Clamart
  11 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  12 c aupres des huissiers de justice
  13 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  14 c
  15 c    HOMARD est une marque deposee d'Electricite de France
  16 c
  17 c Copyright EDF 1996
  18 c Copyright EDF 1998
  19 c Copyright EDF 2002
  20 c Copyright EDF 2020
  21 c ______________________________________________________________________
  22 c
  23 c     UTilitaire : Mot-Cle - caracterisation des Zones a Raffiner
  24 c     --           -   -                         -       -
  25 c ______________________________________________________________________
  26 c .        .     .        .                                            .
  27 c .  nom   . e/s . taille .           description                      .
  28 c .____________________________________________________________________.
  29 c . ncazor . es  . char*8 . nom de l'objet des zones a raffiner        .
  30 c . nbzord .  s  .    1   . nombre de zones a raffiner/deraffiner      .
  31 c .        .     .        . si negatif, les zones sont 2D (en x et y)  .
  32 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  33 c . langue . e   .    1   . langue des messages                        .
  34 c .        .     .        . 1 : francais, 2 : anglais                  .
  35 c . codret . es  .    1   . code de retour des modules                 .
  36 c .        .     .        . 0 : pas de probleme                        .
  37 c .        .     .        . 1 : la configuration est perdue            .
  38 c .        .     .        . 2 : probleme de lecture                    .
  39 c .        .     .        . 8 : Allocation impossible                  .
  40 c ______________________________________________________________________
  41 c
  42 c====
  43 c 0. declarations et dimensionnement
  44 c====
  45 c
  46 c 0.1. ==> generalites
  47 c
  48       implicit none
  49       save
  50 c
  51       character*6 nompro
  52       parameter ( nompro = 'UTMCZR' )
  53 c
  54 #include "nblang.h"
  55 #include "motcle.h"
  56 c
  57       integer nbmcle
  58       parameter ( nbmcle = 20 )
  59 c
  60 c 0.2. ==> communs
  61 c
  62 #include "envex1.h"
  63 c
  64 #include "gmenti.h"
  65 #include "gmreel.h"
  66 #include "gmstri.h"
  67 c
  68 c 0.3. ==> arguments
  69 c
  70       integer nbzord
  71 c
  72       character*8 ncazor
  73 c
  74       integer ulsort, langue, codret
  75 c
  76 c 0.4. ==> variables locales
  77 c
  78 #include "utliob.h"
  79 c
  80       integer codre0
  81       integer iaux, jaux
  82       integer loptio
  83       integer numero
  84       integer nbfich
  85 c
  86       integer adnore, adlono, adpono, adnofi, adnoos
  87       integer adzord
  88 c
  89       character*8 motcle
  90       character*200 option
  91 c
  92       integer nbmess
  93       parameter ( nbmess = 20 )
  94       character*80 texte(nblang,nbmess)
  95 c
  96 c 0.5. ==> initialisations
  97 c ______________________________________________________________________
  98 c
  99 c====
 100 c 1. messages
 101 c====
 102 c
 103 c 1.1. ==> tout va bien
 104 c
 105       codret = 0
 106 c
 107 c 1.2. ==> les messages
 108 c
 109 #include "impr01.h"
 110 c
 111 #ifdef _DEBUG_HOMARD_
 112       write (ulsort,texte(langue,1)) 'Entree', nompro
 113       call dmflsh (iaux)
 114 #endif
 115 c
 116       texte(1,4) = '(''Nombre de zones a raffiner :'',i8)'
 117       texte(1,9) = '(''Le mot-cle '',a,'' apparait :'',i8,'' fois.'')'
 118       texte(1,11) = '(''La configuration est perdue ?'')'
 119       texte(1,12) = '(''Probleme de lecture.'')'
 120       texte(1,13) = '(''Donnees incoherentes.'')'
 121       texte(1,18) =
 122      >'(''Impossible d''''allouer la structure memorisant les choix.'')'
 123 c
 124       texte(2,4) = '(''Number of zones to refine :'',i8)'
 125       texte(2,9) = '(''Keyword '',a,'' appears :'',i8,'' times.'')'
 126       texte(2,11) = '(''Configuration is lost ?'')'
 127       texte(2,12) = '(''Problem while reading.'')'
 128       texte(2,13) = '(''Data without coherence.'')'
 129       texte(2,18) = '(''Structure of choices cannot be allocated.'')'
 130 c
 131 c====
 132 c 2. recherche du nombre d'occurences du mot-cle de type
 133 c    Le nombre de zones de raffinement est egal au nombre de
 134 c    fois ou un type a ete declare
 135 c====
 136 c
 137       if ( codret.eq.0 ) then
 138 c
 139       motcle = mczrty
 140       numero = 1
 141 c
 142       call utfin1 ( motcle, numero,
 143      >              jaux, option, loptio,
 144      >              ulsort, langue, codre0 )
 145 #ifdef _DEBUG_HOMARD_
 146       write (ulsort,texte(langue,9)) motcle, jaux
 147 #endif
 148 c
 149 c 2.2. ==> aucune option n'a ete precisee
 150 c
 151       if ( codre0.eq.2 ) then
 152 c
 153         jaux = 0
 154         codret = 0
 155 c
 156 c 2.3. ==> probleme de lecture
 157 c
 158       elseif ( codre0.ne.0 ) then
 159 c
 160         codret = 1
 161 c
 162 c 2.4. ==> on peut y aller
 163 c
 164       else
 165 c
 166         codret = 0
 167 c
 168       endif
 169 c
 170 c 2.5. ==> bilan
 171 c
 172       if ( codret.eq.0 ) then
 173 c
 174         nbzord = jaux
 175 c
 176 #ifdef _DEBUG_HOMARD_
 177         write (ulsort,texte(langue,4)) nbzord
 178 #endif
 179       else
 180         codret = 2
 181       endif
 182 c
 183       endif
 184 c
 185 c====
 186 c 3. on alloue le receptacle des caracteristiques des zones
 187 c====
 188 #ifdef _DEBUG_HOMARD_
 189       write (ulsort,*) '3. Allocation ; codret = ', codret
 190 #endif
 191 c
 192       if ( nbzord.ne.0 ) then
 193 c
 194         if ( codret.eq.0 ) then
 195 c
 196         iaux = nbzord*nbmcle
 197         call gmalot ( ncazor, 'reel    ', iaux, adzord, codret )
 198 c
 199         endif
 200 c
 201       endif
 202 c
 203 c====
 204 c 4. recherche des adresses des objets GM lies aux noms des fichiers
 205 c====
 206 c
 207 #ifdef _DEBUG_HOMARD_
 208       write (ulsort,*) '4. Recherche ; codret = ', codret
 209 #endif
 210 c
 211       if ( nbzord.ne.0 ) then
 212 c
 213         if ( codret.eq.0 ) then
 214 c
 215 #ifdef _DEBUG_HOMARD_
 216       write (ulsort,texte(langue,3)) 'UTAD80', nompro
 217 #endif
 218         call utad80 ( nbfich,
 219      >                adnore, adlono, adpono, adnofi, adnoos,
 220      >                ulsort, langue, codret )
 221 c
 222         endif
 223 c
 224       endif
 225 c
 226 c====
 227 c 5. remplissage des tableaux
 228 c====
 229 c
 230       if ( nbzord.ne.0 ) then
 231 c
 232         if ( codret.eq.0 ) then
 233 c
 234 #ifdef _DEBUG_HOMARD_
 235       write (ulsort,texte(langue,3)) 'UTMCZ0', nompro
 236 #endif
 237         call utmcz0 ( nbzord, rmem(adzord),
 238      >                nbfich,
 239      >                smem(adnore), imem(adlono), imem(adpono),
 240      >                smem(adnofi), smem(adnoos),
 241      >                ulsort, langue, codret )
 242 c
 243         endif
 244 c
 245 #ifdef _DEBUG_HOMARD_
 246         if ( codret.eq.0 ) then
 247         call gmprsx (nompro, ncazor )
 248         endif
 249 #endif
 250 c
 251       endif
 252 c
 253 c====
 254 c 6. la fin
 255 c====
 256 c
 257       if ( codret.ne.0 ) then
 258 c
 259 #include "envex2.h"
 260 c
 261       write (ulsort,texte(langue,1)) 'Sortie', nompro
 262       write (ulsort,texte(langue,2)) codret
 263       write (ulsort,texte(langue,10+codret))
 264 c
 265       endif
 266 c
 267 #ifdef _DEBUG_HOMARD_
 268       write (ulsort,texte(langue,1)) 'Sortie', nompro
 269       call dmflsh (iaux)
 270 #endif
 271 c
 272       end