src/tool/Information/inqure.F

   1       subroutine inqure ( codret )
   2 c ______________________________________________________________________
   3 c
   4 c                             H O M A R D
   5 c
   6 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   7 c
   8 c Version originale enregistree le 18 juin 1996 sous le numero 96036
   9 c aupres des huissiers de justice Simart et Lavoir a Clamart
  10 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  11 c aupres des huissiers de justice
  12 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  13 c
  14 c    HOMARD est une marque deposee d'Electricite de France
  15 c
  16 c Copyright EDF 1996
  17 c Copyright EDF 1998
  18 c Copyright EDF 2002
  19 c Copyright EDF 2020
  20 c ______________________________________________________________________
  21 c
  22 c   INformation : QUestions / REponses
  23 c   --            --          --
  24 c
  25 c remarque : on n'execute ce programme que si le precedent s'est
  26 c            bien passe
  27 c
  28 c ______________________________________________________________________
  29 c .        .     .        .                                            .
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . codret . es  .    1   . code de retour des modules                 .
  33 c .        .     .        . en entree = celui du module d'avant        .
  34 c .        .     .        . en sortie = celui du module en cours       .
  35 c .        .     .        . 0 : pas de probleme                        .
  36 c .        .     .        . 1 : manque de temps cpu                    .
  37 c .        .     .        . 2x : probleme dans les memoires            .
  38 c .        .     .        . 3x : probleme dans les fichiers            .
  39 c .        .     .        . 5 : mauvaises options                      .
  40 c .        .     .        . 6 : problemes dans les noms d'objet        .
  41 c ______________________________________________________________________
  42 c
  43 c====
  44 c 0. declarations et dimensionnement
  45 c====
  46 c
  47 c 0.1. ==> generalites
  48 c
  49       implicit none
  50       save
  51 c
  52       character*6 nompro
  53       parameter ( nompro = 'INQURE' )
  54 c
  55 #include "motcle.h"
  56 #include "nblang.h"
  57 c
  58 c 0.2. ==> communs
  59 c
  60 #include "envex1.h"
  61 #include "envada.h"
  62 c
  63 #include "gmenti.h"
  64 #include "gmstri.h"
  65 c
  66 #include "cndoad.h"
  67 c
  68 c 0.3. ==> arguments
  69 c
  70       integer codret
  71 c
  72 c 0.4. ==> variables locales
  73 c
  74       integer ulsort, langue, codava
  75       integer adopti, lgopti
  76       integer adopts, lgopts
  77       integer adetco, lgetco
  78       integer nrsect, nrssse
  79       integer nretap, nrsset
  80       integer iaux, jaux
  81       integer adinch, adinpf, adinpr, adinlg
  82       integer typcca
  83       integer lnomfi
  84 c
  85       integer ulfido, ulenst, ulsost
  86 c
  87       logical exisol
  88 c
  89       character*6 saux
  90       character*8 action
  91       character*8 nohman, nocsol, nochso
  92       character*8 typobs
  93       character*200 nomfic
  94 c
  95       integer nbmess
  96       parameter ( nbmess = 10 )
  97       character*80 texte(nblang,nbmess)
  98 c
  99 c 0.5. ==> initialisations
 100 c ______________________________________________________________________
 101 c
 102 c====
 103 c 1. les initialisations
 104 c====
 105 c
 106 #include "impr03.h"
 107 c
 108       codava = codret
 109 c
 110 c=======================================================================
 111       if ( codava.eq.0 ) then
 112 c=======================================================================
 113 c
 114 #ifdef _DEBUG_HOMARD_
 115       call gmprsx (nompro, nndoad )
 116       call gmprsx (nompro, nndoad//'.OptEnt' )
 117       call gmprsx (nompro, nndoad//'.OptRee' )
 118       call gmprsx (nompro, nndoad//'.OptCar' )
 119       call gmprsx (nompro, nndoad//'.EtatCour' )
 120 #endif
 121 c
 122 c 1.1. ==> le numero d'unite logique de la liste standard
 123 c
 124       call utulls ( ulsort, codret )
 125 c
 126 c 1.2. ==> la langue des messages
 127 c
 128       call gmadoj ( nndoad//'.OptEnt', adopti, lgopti, codret )
 129       if ( codret.eq.0 ) then
 130         langue = imem(adopti)
 131       else
 132         langue = 1
 133         codret = 2
 134       endif
 135 c
 136 c 1.3. ==> l'etat courant
 137 c
 138       call gmadoj ( nndoad//'.EtatCour', adetco, lgetco, codret )
 139       if ( codret.eq.0 ) then
 140         nretap = imem(adetco) + 1
 141         imem(adetco) = nretap
 142         nrsset = -1
 143         imem(adetco+1) = nrsset
 144         nrsect = imem(adetco+2) + 10
 145         imem(adetco+2) = nrsect
 146         nrssse = nrsect
 147         imem(adetco+3) = nrssse
 148       else
 149         nretap = -1
 150         nrsset = -1
 151         nrsect = 200
 152         nrssse = nrsect
 153         codret = 2
 154       endif
 155 c
 156 c 1.4. ==> le debut des mesures de temps
 157 c
 158       call gtdems (nrsect)
 159 c
 160 c 1.5. ==> les messages
 161 c
 162 #include "impr01.h"
 163 c
 164 #ifdef _DEBUG_HOMARD_
 165       write (ulsort,texte(langue,1)) 'Entree', nompro
 166       call dmflsh (iaux)
 167 #endif
 168 c
 169       texte(1,4) = '(/,a6,'' QUESTIONS / REPONSES'')'
 170       texte(1,5) = '(27(''=''),/)'
 171 c
 172       texte(2,4) = '(/,a6,'' QUESTIONS / ANSWERS'')'
 173       texte(2,5) = '(26(''=''),/)'
 174 c
 175 c 1.6. ==> le titre
 176 c
 177       call utcvne ( nretap, nrsset, saux, iaux, codret )
 178 c
 179       write (ulsort,texte(langue,4)) saux
 180       write (ulsort,texte(langue,5))
 181 c
 182       nrsset = 0
 183       imem(adetco+1) = nrsset
 184 c
 185 c 1.7. ==> les noms d'objets a conserver
 186 c
 187       if ( codret.eq.0 ) then
 188         call gmadoj ( nndoad//'.OptCar', adopts, lgopts, codret )
 189         if ( codret.ne.0 ) then
 190           codret = 2
 191         endif
 192       endif
 193 c
 194 c 1.8. ==> les numeros d'unite logique au terminal
 195 c
 196       call dmunit ( ulenst, ulsost )
 197 c
 198 c 1.9. ==> l'action en cours
 199 c
 200       action = smem(adopts+29)
 201 c
 202 c 1.10. ==> le numero d'unite logique du fichier de donnees correct
 203 c
 204       call utulfd ( action, nbiter, ulfido, codret )
 205 c
 206 c====
 207 c 2. le maillage d'entree
 208 c====
 209 c
 210       if ( codret.eq.0 ) then
 211 c
 212       nohman = smem(adopts+2)
 213 c
 214       endif
 215 c
 216 c====
 217 c 3. Lecture de tous les champs presents dans le fichier
 218 c====
 219 c
 220 #ifdef _DEBUG_HOMARD_
 221       write (ulsort,90002) '3. Lecture des champs ; codret', codret
 222 #endif
 223 c
 224 c 3.1. ==> Recherche du type de code de calcul associe
 225 c
 226       if ( codret.eq.0 ) then
 227 c
 228       call gmliat ( nohman, 9, typcca, codret )
 229 c
 230       endif
 231 c
 232 c 3.2. ==> Lecture de l'eventuelle solution
 233 c          Attention, c'est obligatoirement du format MED
 234 c
 235 c 3.2.1. ==> La solution existe-t-elle ?
 236 c
 237       if ( codret.eq.0 ) then
 238 c
 239       if ( mod(typcca-6,10).eq.0 ) then
 240 c
 241         typobs = mccson
 242         iaux = 0
 243         jaux = 0
 244         call utfino ( typobs, iaux, nomfic, lnomfi,
 245      >                jaux,
 246      >                ulsort, langue, codret )
 247 c
 248         if ( codret.eq.0 ) then
 249           exisol = .true.
 250         else
 251           exisol = .false.
 252           codret = 0
 253         endif
 254 c
 255       else
 256         exisol = .false.
 257       endif
 258 c
 259       endif
 260 c
 261 c 3.2.2. ==> Une solution existe
 262 c
 263       if ( exisol ) then
 264 c
 265 c 3.2.2.1. ==> Lecture du format MED
 266 c
 267         if ( codret.eq.0 ) then
 268 c
 269 #ifdef _DEBUG_HOMARD_
 270       write (ulsort,texte(langue,3)) 'ESLSMD', nompro
 271 #endif
 272         nochso = '        '
 273         iaux = 0
 274         call eslsmd ( nocsol, nochso,
 275      >                imem(adopti+8), iaux,
 276      >                ulsort, langue, codret )
 277 c
 278         endif
 279 c
 280 c 3.2.2.2. ==> pour le cas extrude, passage du 3D au 2D
 281 c
 282         if ( imem(adopti+38).ne.0 ) then
 283 c
 284           if ( codret.eq.0 ) then
 285 c
 286 #ifdef _DEBUG_HOMARD_
 287       write (ulsort,texte(langue,3)) 'UTSEXT', nompro
 288 #endif
 289           iaux = 1
 290           call utsext ( nocsol, iaux, typcca,
 291      >                  lgetco, imem(adetco),
 292      >                  ulsort, langue, codret )
 293 c
 294           endif
 295 c
 296         endif
 297 c
 298       else
 299 c
 300 c 3.2.3. ==> S'il n'y a pas de solution, on en alloue une vide.
 301 c
 302         if ( codret.eq.0 ) then
 303 c
 304 #ifdef _DEBUG_HOMARD_
 305       write (ulsort,texte(langue,3)) 'UTALSO', nompro
 306 #endif
 307         iaux = 0
 308         call utalso ( nocsol,
 309      >                iaux, iaux, iaux, iaux,
 310      >                adinch, adinpf, adinpr, adinlg,
 311      >                ulsort, langue, codret )
 312 c
 313         endif
 314 c
 315       endif
 316 cgn      call gmprsx (nompro,nocsol)
 317 c
 318 #ifdef _DEBUG_HOMARD_
 319       write(ulsort,*) 'Fin etape 4 avec codret = ', codret
 320 #endif
 321 c
 322 c====
 323 c 4. questions / reponses
 324 c====
 325 c
 326       if ( codret.eq.0 ) then
 327 c
 328       imem(adetco+3) = imem(adetco+3) + 1
 329 c
 330 #ifdef _DEBUG_HOMARD_
 331       write (ulsort,texte(langue,3)) 'INQUR1', nompro
 332 #endif
 333       call inqur1 ( nohman, nocsol,
 334      >              ulfido, ulenst, ulsost,
 335      >              ulsort, langue, codret )
 336 c
 337       endif
 338 c
 339 c====
 340 c 5. la fin
 341 c====
 342 c
 343 c 5.1. ==> message si erreur
 344 c
 345       if ( codret.ne.0 ) then
 346 c
 347 #include "envex2.h"
 348 c
 349       write (ulsort,texte(langue,1)) 'Sortie', nompro
 350       write (ulsort,texte(langue,2)) codret
 351 c
 352       endif
 353 c
 354 c 5.2. ==> fin des mesures de temps de la section
 355 c
 356       call gtfims (nrsect)
 357 c
 358 #ifdef _DEBUG_HOMARD_
 359       write (ulsort,texte(langue,1)) 'Sortie', nompro
 360       call dmflsh (iaux)
 361 #endif
 362 c
 363 c=======================================================================
 364       endif
 365 c=======================================================================
 366 c
 367       jaux = 0
 368       end