src/tool/Utilitaire/utmclc.F

   1       subroutine utmclc ( nbseal, majsol, nochso,
   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 - Liste des Champs a mettre a jour
  24 c     --           -   -     -         -
  25 c ______________________________________________________________________
  26 c
  27 c but : creer une structure de type ChampMAJ qui memorise les
  28 c       caracteristiques des champs a mettre a jour
  29 c ______________________________________________________________________
  30 c .        .     .        .                                            .
  31 c .  nom   . e/s . taille .           description                      .
  32 c .____________________________________________________________________.
  33 c . nbseal . es  .    1   . En entree :                                .
  34 c .        .     .        . 0 : aucune demande particuliere            .
  35 c .        .     .        . 1 : on a demande la mise a jour de tous    .
  36 c .        .     .        .     les champs                             .
  37 c .        .     .        . En sortie :                                .
  38 c .        .     .        . -1 : tous les champs sont a lire           .
  39 c .        .     .        .  0 : aucun champ n'est a lire              .
  40 c .        .     .        . >0 : nombre de champs a mettre a jour      .
  41 c . majsol .  s  .   1    . conversion de la solution 0 : non, 1 : oui .
  42 c . nochso . es  . char*8 . nom de l'objet qui memorise les champs     .
  43 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  44 c . langue . e   .    1   . langue des messages                        .
  45 c .        .     .        . 1 : francais, 2 : anglais                  .
  46 c . codret . es  .    1   . code de retour des modules                 .
  47 c .        .     .        . 0 : pas de probleme                        .
  48 c .        .     .        . 1 : la configuration est perdue            .
  49 c .        .     .        . 2 : probleme de lecture                    .
  50 c .        .     .        . 8 : Allocation impossible                  .
  51 c .        .     .        . 9 : incoherence de donnees                 .
  52 c ______________________________________________________________________
  53 c
  54 c====
  55 c 0. declarations et dimensionnement
  56 c====
  57 c
  58 c 0.1. ==> generalites
  59 c
  60       implicit none
  61       save
  62 c
  63       character*6 nompro
  64       parameter ( nompro = 'UTMCLC' )
  65 c
  66 #include "nblang.h"
  67 #include "motcle.h"
  68 c
  69 c 0.2. ==> communs
  70 c
  71 #include "envex1.h"
  72 c
  73 #include "gmenti.h"
  74 #include "gmreel.h"
  75 #include "gmstri.h"
  76 c
  77 c 0.3. ==> arguments
  78 c
  79       integer nbseal, majsol
  80 c
  81       character*8 nochso
  82 c
  83       integer ulsort, langue, codret
  84 c
  85 c 0.4. ==> variables locales
  86 c
  87 #include "utliob.h"
  88 c
  89       integer codre1, codre2, codre3, codre4
  90       integer codre0
  91       integer iaux
  92       integer loptio
  93       integer numero
  94       integer nbfich
  95       integer adcaet, adcact, adcart
  96       integer adnore, adlono, adpono, adnofi, adnoos
  97 c
  98       character*8 motcle
  99       character*200 option
 100 c
 101       integer nbmess
 102       parameter ( nbmess = 20 )
 103       character*80 texte(nblang,nbmess)
 104 c
 105 c 0.5. ==> initialisations
 106 c ______________________________________________________________________
 107 c
 108 c====
 109 c 1. messages
 110 c====
 111 c
 112 c 1.1. ==> tout va bien
 113 c
 114       codret = 0
 115 c
 116 c 1.2. ==> les messages
 117 c
 118 #include "impr01.h"
 119 c
 120 #ifdef _DEBUG_HOMARD_
 121       write (ulsort,texte(langue,1)) 'Entree', nompro
 122       call dmflsh (iaux)
 123 #endif
 124 c
 125       texte(1,10) = '(''Nombre de champs a mettre a jour :'',i8)'
 126       texte(1,11) = '(''La configuration est perdue ?'')'
 127       texte(1,12) = '(''Probleme de lecture.'')'
 128       texte(1,18) =
 129      >'(''Impossible d''''allouer la structure memorisant les choix.'')'
 130       texte(1,19) =
 131      > '(''Mise a jour de tous les champs ou de certains ?'')'
 132 c
 133       texte(2,10) = '(''Number of fields to update :'',i8)'
 134       texte(2,11) = '(''Configuration is lost ?'')'
 135       texte(2,12) = '(''Problem while reading.'')'
 136       texte(2,18) = '(''Structure of choices cannot be allocated.'')'
 137       texte(2,19) = '(''Updating of all fields or someone ?'')'
 138 c
 139 c====
 140 c 2. recherche du nombre d'occurences du mot-cle
 141 c====
 142 c
 143       if ( codret.eq.0 ) then
 144 c
 145 c 2.1. ==> on recherche la premiere occurence associe au mot-cle
 146 c
 147       numero = 1
 148 c
 149       motcle = mcchno
 150       call utfin1 ( motcle, numero,
 151      >              iaux, option, loptio,
 152      >              ulsort, langue, codre0 )
 153 c
 154 c 2.2. ==> aucune option n'a ete precisee
 155 c
 156       if ( codre0.eq.2 ) then
 157 c
 158         codret = 0
 159 c
 160 c 2.3. ==> probleme de lecture
 161 c
 162       elseif ( codre0.ne.0 ) then
 163 c
 164         codret = 1
 165 c
 166 c 2.4. ==> on peut y aller
 167 c
 168       else
 169 c
 170         codret = 0
 171 c
 172       endif
 173 c
 174       if ( codret.ne.0 ) then
 175         codret = 2
 176       endif
 177 c
 178       endif
 179 c
 180 c 2.5. ==> coherence avec la demande globale de mise a jour des champs
 181 c
 182       if ( codret.eq.0 ) then
 183 c
 184       if ( nbseal.eq.0 ) then
 185         nbseal = iaux
 186       else
 187         if ( iaux.eq.0 ) then
 188           nbseal = -1
 189         else
 190           codret = 9
 191         endif
 192       endif
 193 c
 194       endif
 195 c
 196 #ifdef _DEBUG_HOMARD_
 197       write (ulsort,texte(langue,10)) nbseal
 198 #endif
 199 c
 200 c====
 201 c 3. Les caracteristiques des champs quand on en lit quelques uns
 202 c====
 203 c
 204       if ( nbseal.gt.0 ) then
 205 c
 206 c 3.1. ==> on alloue le receptacle des caracteristiques des champs
 207 c
 208         if ( codret.eq.0 ) then
 209         call gmalot ( nochso, 'ChampMAJ', 0, iaux, codret )
 210         endif
 211 c
 212         if ( codret.eq.0 ) then
 213 c
 214         iaux = 8*nbseal
 215         call gmecat ( nochso, 1, nbseal, codre1 )
 216         call gmaloj ( nochso//'.CarCaChp', ' ', iaux, adcact, codre2 )
 217         iaux = 12*nbseal
 218         call gmaloj ( nochso//'.CarEnChp', ' ', iaux, adcaet, codre3 )
 219         iaux = 1*nbseal
 220         call gmaloj ( nochso//'.CarReChp', ' ', iaux, adcart, codre4 )
 221 c
 222         codre0 = min ( codre1, codre2, codre3, codre4 )
 223         codret = max ( abs(codre0), codret,
 224      >                 codre1, codre2, codre3, codre4 )
 225 c
 226         if ( codret.ne.0 ) then
 227           codret = 8
 228         endif
 229 c
 230         endif
 231 c
 232 c 3.2. ==> adresses des objets GM lies aux noms des fichiers
 233 c
 234         if ( codret.eq.0 ) then
 235 c
 236 #ifdef _DEBUG_HOMARD_
 237       write (ulsort,texte(langue,3)) 'UTAD80', nompro
 238 #endif
 239         call utad80 ( nbfich,
 240      >                adnore, adlono, adpono, adnofi, adnoos,
 241      >                ulsort, langue, codret )
 242 c
 243         endif
 244 c
 245 c 3.3. ==> remplissage des tableaux
 246 c
 247         if ( codret.eq.0 ) then
 248 c
 249 #ifdef _DEBUG_HOMARD_
 250       write (ulsort,texte(langue,3)) 'UTMCC0', nompro
 251 #endif
 252         call utmcc0 ( nbseal,
 253      >                imem(adcaet), smem(adcact), rmem(adcart),
 254      >                nbfich,
 255      >                smem(adnore), imem(adlono), imem(adpono),
 256      >                smem(adnofi), smem(adnoos),
 257      >                ulsort, langue, codret )
 258 c
 259         endif
 260 c
 261       endif
 262 c
 263 #ifdef _DEBUG_HOMARD_
 264       if ( nbseal.gt.0 ) then
 265 cgn      call gmprsx (nompro, nochso )
 266       call gmprsx (nompro, nochso//'.CarCaChp' )
 267       call gmprsx (nompro, nochso//'.CarEnChp' )
 268       call gmprsx (nompro, nochso//'.CarReChp' )
 269       endif
 270 #endif
 271 c
 272 c====
 273 c 4. consequence sur la conversion de solution
 274 c====
 275 c
 276       if ( codret.eq.0 ) then
 277 c
 278 c 4.1. ==> pointeur sur la conversion de solution
 279 c
 280       if ( nbseal.eq.0 ) then
 281         majsol = 0
 282       else
 283         majsol = 1
 284       endif
 285 c
 286 c 4.2. ==> si tous les champs sont concernes, on met un nom blanc pour
 287 c          la structure de stockage car c'est ainsi que l'on se repere
 288 c          ensuite
 289 c
 290       if ( nbseal.eq.-1 ) then
 291 c                 12345678
 292         nochso = '        '
 293       endif
 294 c
 295       endif
 296 c
 297 c====
 298 c 5. la fin
 299 c====
 300 c
 301       if ( codret.ne.0 ) then
 302 c
 303 #include "envex2.h"
 304 c
 305       write (ulsort,texte(langue,1)) 'Sortie', nompro
 306       write (ulsort,texte(langue,2)) codret
 307       write (ulsort,texte(langue,10+codret))
 308 c
 309       endif
 310 c
 311 #ifdef _DEBUG_HOMARD_
 312       write (ulsort,texte(langue,1)) 'Sortie', nompro
 313       call dmflsh (iaux)
 314 #endif
 315 c
 316       end