src/tool/Utilitaire/utmcfa.F

   1       subroutine utmcfa ( ncafan, ncafar, ncfgnf, ncfgng,
   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 Frontieres Analytiques
  24 c     --           -   -                         -          -
  25 c ______________________________________________________________________
  26 c .        .     .        .                                            .
  27 c .  nom   . e/s . taille .           description                      .
  28 c .____________________________________________________________________.
  29 c . ncafan . es  . char*8 . nom de l'objet des frontieres analytiques :.
  30 c .        .     .        . nom des frontieres                         .
  31 c . ncafar . es  . char*8 . nom de l'objet des frontieres analytiques :.
  32 c .        .     .        . valeurs reelles                            .
  33 c . ncfgnf . es  . char*8 . lien frontiere/groupe : nom des frontieres .
  34 c . ncfgng . es  . char*8 . lien frontiere/groupe : nom des groupes    .
  35 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  36 c . langue . e   .    1   . langue des messages                        .
  37 c .        .     .        . 1 : francais, 2 : anglais                  .
  38 c . codret . es  .    1   . code de retour des modules                 .
  39 c .        .     .        . 0 : pas de probleme                        .
  40 c .        .     .        . 1 : la configuration est perdue            .
  41 c .        .     .        . 2 : probleme de lecture                    .
  42 c .        .     .        . 8 : Allocation impossible                  .
  43 c ______________________________________________________________________
  44 c
  45 c====
  46 c 0. declarations et dimensionnement
  47 c====
  48 c
  49 c 0.1. ==> generalites
  50 c
  51       implicit none
  52       save
  53 c
  54       character*6 nompro
  55       parameter ( nompro = 'UTMCFA' )
  56 c
  57 #include "nblang.h"
  58 #include "motcle.h"
  59 c
  60       integer nbmcle
  61       parameter ( nbmcle = 13 )
  62 c
  63 c 0.2. ==> communs
  64 c
  65 #include "envex1.h"
  66 c
  67 #include "gmenti.h"
  68 #include "gmreel.h"
  69 #include "gmstri.h"
  70 c
  71 c 0.3. ==> arguments
  72 c
  73       character*8 ncafan, ncafar, ncfgnf, ncfgng
  74 c
  75       integer ulsort, langue, codret
  76 c
  77 c 0.4. ==> variables locales
  78 c
  79 #include "utliob.h"
  80 c
  81       integer codre0
  82       integer iaux, jaux
  83       integer loptio
  84       integer numero
  85       integer nbfich
  86 c
  87       integer nbfran
  88       integer adnore, adlono, adpono, adnofi, adnoos
  89       integer adcafr
  90       integer nbfrgr
  91       integer adcpoi, adctai, adctab
  92       integer adfpoi, adftai, adftab
  93       integer adgpoi, adgtai, adgtab
  94 c
  95       character*8 motcle
  96       character*200 option
  97 c
  98       integer nbmess
  99       parameter ( nbmess = 20 )
 100       character*80 texte(nblang,nbmess)
 101 c
 102 c 0.5. ==> initialisations
 103 c ______________________________________________________________________
 104 c
 105 c====
 106 c 1. messages
 107 c====
 108 c
 109 c 1.1. ==> tout va bien
 110 c
 111       codret = 0
 112 c
 113 c 1.2. ==> les messages
 114 c
 115 #include "impr01.h"
 116 c
 117 #ifdef _DEBUG_HOMARD_
 118       write (ulsort,texte(langue,1)) 'Entree', nompro
 119       call dmflsh (iaux)
 120 #endif
 121 c
 122       texte(1,4) = '(''Nombre de frontieres analytiques :'',i8)'
 123       texte(1,5) = '(''Nombre de liens frontiere/groupe :'',i8)'
 124       texte(1,9) = '(''Le mot-cle '',a,'' apparait :'',i8,'' fois.'')'
 125       texte(1,11) = '(''La configuration est perdue ?'')'
 126       texte(1,12) = '(''Probleme de lecture.'')'
 127       texte(1,13) = '(''Donnees incoherentes.'')'
 128       texte(1,18) =
 129      >'(''Impossible d''''allouer la structure memorisant les choix.'')'
 130 c
 131       texte(2,4) = '(''Number of analytical boundaries :'',i8)'
 132       texte(2,5) = '(''Number of links boundary/group  :'',i8)'
 133       texte(2,9) = '(''Keyword '',a,'' appears :'',i8,'' times.'')'
 134       texte(2,11) = '(''Configuration is lost ?'')'
 135       texte(2,12) = '(''Problem while reading.'')'
 136       texte(2,13) = '(''Data without coherence.'')'
 137       texte(2,18) = '(''Structure of choices cannot be allocated.'')'
 138 c
 139 c====
 140 c 2. recherche du nombre d'occurences du mot-cle :
 141 c    A. Le nom d'une frontiere analytique dans sa description
 142 c    B. Le nom d'une frontiere analytique dans son lien avec un groupe
 143 c====
 144 c
 145       do 20 , iaux = 1 , 2
 146 c
 147 c 2.1. ==> presence du mot-cle ?
 148 c
 149         if ( codret.eq.0 ) then
 150 c
 151         if ( iaux.eq.1 ) then
 152           motcle = mcfanm
 153         else
 154           motcle = mcfgfr
 155         endif
 156         numero = 1
 157 c
 158         call utfin1 ( motcle, numero,
 159      >                jaux, option, loptio,
 160      >                ulsort, langue, codre0 )
 161 #ifdef _DEBUG_HOMARD_
 162       write (ulsort,texte(langue,9)) motcle, jaux
 163 #endif
 164 c
 165 c 2.2. ==> aucune option n'a ete precisee
 166 c
 167         if ( codre0.eq.2 ) then
 168 c
 169           jaux = 0
 170           codret = 0
 171 c
 172 c 2.3. ==> probleme de lecture
 173 c
 174         elseif ( codre0.ne.0 ) then
 175 c
 176           codret = 1
 177 c
 178 c 2.4. ==> on peut y aller
 179 c
 180         else
 181 c
 182           codret = 0
 183 c
 184         endif
 185 c
 186 c 2.5. ==> bilan
 187 c
 188         if ( codret.eq.0 ) then
 189 c
 190         if ( iaux.eq.1 ) then
 191           nbfran = jaux
 192         else
 193           nbfrgr = jaux
 194         endif
 195 #ifdef _DEBUG_HOMARD_
 196         write (ulsort,texte(langue,3+iaux)) jaux
 197 #endif
 198 c
 199       else
 200         codret = 2
 201       endif
 202 c
 203       endif
 204 c
 205    20 continue
 206 c
 207 c 2.6. ==> Si aucun lien frontiere/groupe n'est present, on annule
 208 c          toute description eventuelle de frontiere pour ne pas
 209 c          surcharger les donnees
 210 c
 211       if ( codret.eq.0 ) then
 212 c
 213       if ( nbfrgr.eq.0 ) then
 214 c
 215         nbfran = 0
 216 c
 217       endif
 218 c
 219       endif
 220 c
 221 c====
 222 c 3. on alloue le receptacle des caracteristiques des frontieres
 223 c====
 224 #ifdef _DEBUG_HOMARD_
 225       write (ulsort,*) '3. Allocation ; codret = ', codret
 226 #endif
 227 c
 228       if ( codret.eq.0 ) then
 229 c
 230 #ifdef _DEBUG_HOMARD_
 231       write (ulsort,texte(langue,3)) 'UTMCF0 - frontiere', nompro
 232 #endif
 233       call utmcf0 ( nbfran, ncafan,
 234      >              adcpoi, adctai, adctab,
 235      >              ulsort, langue, codret )
 236 c
 237 #ifdef _DEBUG_HOMARD_
 238       call gmprsx(nompro,ncafan)
 239 #endif
 240 c
 241       endif
 242 c
 243       if ( codret.eq.0 ) then
 244 c
 245       if ( nbfran.ne.0 ) then
 246 c
 247         iaux = nbfran*nbmcle
 248         call gmalot ( ncafar, 'reel    ', iaux, adcafr, codret )
 249 c
 250       endif
 251 c
 252       endif
 253 c
 254 c====
 255 c 4. recherche des adresses des objets GM lies aux noms des fichiers
 256 c====
 257 c
 258 #ifdef _DEBUG_HOMARD_
 259       write (ulsort,*) '4. Recherche ; codret = ', codret
 260 #endif
 261 c
 262       if ( nbfran.ne.0 ) then
 263 c
 264         if ( codret.eq.0 ) then
 265 c
 266 #ifdef _DEBUG_HOMARD_
 267       write (ulsort,texte(langue,3)) 'UTAD80', nompro
 268 #endif
 269         call utad80 ( nbfich,
 270      >                adnore, adlono, adpono, adnofi, adnoos,
 271      >                ulsort, langue, codret )
 272 c
 273         endif
 274 c
 275       endif
 276 c
 277 c====
 278 c 5. remplissage des tableaux caracterisant les frontieres
 279 c====
 280 c
 281       if ( nbfran.ne.0 ) then
 282 c
 283         if ( codret.eq.0 ) then
 284 c
 285 #ifdef _DEBUG_HOMARD_
 286       write (ulsort,texte(langue,3)) 'UTMCF1', nompro
 287 #endif
 288         call utmcf1 ( nbfran, rmem(adcafr),
 289      >                imem(adcpoi), imem(adctai), smem(adctab),
 290      >                nbfich,
 291      >                smem(adnore), imem(adlono), imem(adpono),
 292      >                smem(adnofi), smem(adnoos),
 293      >                ulsort, langue, codret )
 294 c
 295         if ( codret.ne.0 ) then
 296           codret = 3
 297         endif
 298 c
 299         endif
 300 c
 301 #ifdef _DEBUG_HOMARD_
 302         if ( codret.eq.0 ) then
 303         call gmprsx (nompro, ncafar )
 304         call gmprsx (nompro, ncafan )
 305         call gmprsx (nompro, ncafan//'.Pointeur' )
 306         call gmprsx (nompro, ncafan//'.Taille' )
 307         call gmprsx (nompro, ncafan//'.Table' )
 308         endif
 309 #endif
 310 c
 311       endif
 312 c
 313 c====
 314 c 6. Les tableaux des liens frontieres/groupes
 315 c====
 316 #ifdef _DEBUG_HOMARD_
 317       write (ulsort,*) '6. liens frontieres/groupes ; codret = ', codret
 318 #endif
 319 c
 320       if ( nbfrgr.ne.0 ) then
 321 c
 322 c 6.1. ==> Nom des frontieres
 323 c
 324       if ( codret.eq.0 ) then
 325 c
 326 #ifdef _DEBUG_HOMARD_
 327       write (ulsort,texte(langue,3)) 'UTMCF0 - lien - frontiere', nompro
 328 #endif
 329       call utmcf0 ( nbfrgr, ncfgnf,
 330      >              adfpoi, adftai, adftab,
 331      >              ulsort, langue, codret )
 332 c
 333       endif
 334 c
 335 c 6.2. ==> Nom des groupes
 336 c
 337       if ( codret.eq.0 ) then
 338 c
 339 #ifdef _DEBUG_HOMARD_
 340       write (ulsort,texte(langue,3)) 'UTMCF0 - lien - groupe', nompro
 341 #endif
 342       call utmcf0 ( nbfrgr, ncfgng,
 343      >              adgpoi, adgtai, adgtab,
 344      >              ulsort, langue, codret )
 345 c
 346       endif
 347 c
 348 c 6.3. remplissage des tableaux des liens frontieres/groupes
 349 c
 350         if ( codret.eq.0 ) then
 351 c
 352 #ifdef _DEBUG_HOMARD_
 353       write (ulsort,texte(langue,3)) 'UTMCF2', nompro
 354 #endif
 355         call utmcf2 ( nbfrgr,
 356      >                imem(adfpoi), imem(adftai), smem(adftab),
 357      >                imem(adgpoi), imem(adgtai), smem(adgtab),
 358      >                nbfich,
 359      >                smem(adnore), imem(adlono), imem(adpono),
 360      >                smem(adnofi), smem(adnoos),
 361      >                ulsort, langue, codret )
 362 c
 363         if ( codret.ne.0 ) then
 364           codret = 3
 365         endif
 366 c
 367         endif
 368 c
 369 #ifdef _DEBUG_HOMARD_
 370         if ( codret.eq.0 ) then
 371         call gmprsx (nompro, ncfgnf )
 372         call gmprsx (nompro, ncfgnf//'.Pointeur' )
 373         call gmprsx (nompro, ncfgnf//'.Taille' )
 374         call gmprsx (nompro, ncfgnf//'.Table' )
 375         call gmprsx (nompro, ncfgng )
 376         call gmprsx (nompro, ncfgng//'.Pointeur' )
 377         call gmprsx (nompro, ncfgng//'.Taille' )
 378         call gmprsx (nompro, ncfgng//'.Table' )
 379         endif
 380 #endif
 381 c
 382       endif
 383 c
 384 c====
 385 c 7. la fin
 386 c====
 387 c
 388       if ( codret.ne.0 ) then
 389 c
 390 #include "envex2.h"
 391 c
 392       write (ulsort,texte(langue,1)) 'Sortie', nompro
 393       write (ulsort,texte(langue,2)) codret
 394       write (ulsort,texte(langue,10+codret))
 395 c
 396       endif
 397 c
 398 #ifdef _DEBUG_HOMARD_
 399       write (ulsort,texte(langue,1)) 'Sortie', nompro
 400       call dmflsh (iaux)
 401 #endif
 402 c
 403       end