src/tool/HOMARD_00/hoinco.F

   1       subroutine hoinco ( 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       HOMARD : INformations COmplementaires
  22 c       --       --           --
  23 c
  24 c remarque : on n'execute ce programme que si le precedent s'est
  25 c            bien passe
  26 c ______________________________________________________________________
  27 c .        .     .        .                                            .
  28 c .  nom   . e/s . taille .           description                      .
  29 c .____________________________________________________________________.
  30 c . codret . es  .    1   . code de retour des modules                 .
  31 c .        .     .        . 0 : pas de probleme                        .
  32 c .        .     .        . 1 : manque de temps cpu                    .
  33 c .        .     .        . 3 : probleme a la lecture                  .
  34 c .        .     .        . 5 : mauvais type de code de calcul associe .
  35 c .        .     .        . 6 : impossible de connaitre le code associe.
  36 c ______________________________________________________________________
  37 c
  38 c====
  39 c 0. declarations et dimensionnement
  40 c====
  41 c
  42 c 0.1. ==> generalites
  43 c
  44       implicit none
  45       save
  46 c
  47       character*6 nompro
  48       parameter ( nompro = 'HOINCO' )
  49 c
  50 #include "motcle.h"
  51 #include "nblang.h"
  52 c
  53 c 0.2. ==> communs
  54 c
  55 #include "envex1.h"
  56 c
  57 #include "gmenti.h"
  58 #include "gmstri.h"
  59 c
  60 #include "cndoad.h"
  61 c
  62 c 0.3. ==> arguments
  63 c
  64       integer codret
  65 c
  66 c 0.4. ==> variables locales
  67 c
  68       integer ulsort, langue, codava
  69       integer adopti, lgopti
  70       integer adopts, lgopts
  71       integer adetco, lgetco
  72       integer nrsect, nrssse
  73       integer nretap, nrsset
  74       integer iaux
  75 c
  76       character*6 saux
  77 c
  78       integer nbmess
  79       parameter ( nbmess = 10 )
  80       character*80 texte(nblang,nbmess)
  81 c
  82 c 0.5. ==> initialisations
  83 c ______________________________________________________________________
  84 c
  85 c====
  86 c 1. les initialisations
  87 c====
  88 c
  89       codava = codret
  90 c
  91 c=======================================================================
  92       if ( codava.eq.0 ) then
  93 c=======================================================================
  94 c
  95 #ifdef _DEBUG_HOMARD_
  96       call gmprsx (nompro, nndoad )
  97       call gmprsx (nompro, nndoad//'.OptEnt' )
  98       call gmprsx (nompro, nndoad//'.OptRee' )
  99       call gmprsx (nompro, nndoad//'.OptCar' )
 100       call gmprsx (nompro, nndoad//'.EtatCour' )
 101 #endif
 102 c
 103 c 1.2. ==> le numero d'unite logique de la liste standard
 104 c
 105       call utulls ( ulsort, codret )
 106 c
 107 c 1.3. ==> la langue des messages
 108 c
 109       call gmadoj ( nndoad//'.OptEnt', adopti, lgopti, codret )
 110       if ( codret.eq.0 ) then
 111         langue = imem(adopti)
 112       else
 113         langue = 1
 114         codret = 2
 115       endif
 116 c
 117 #include "impr01.h"
 118 c
 119 #ifdef _DEBUG_HOMARD_
 120       write (ulsort,texte(langue,1)) 'Entree', nompro
 121       call dmflsh (iaux)
 122 #endif
 123 c
 124 c 1.4. ==> l'etat courant
 125 c
 126       call gmadoj ( nndoad//'.EtatCour', adetco, lgetco, codret )
 127 c
 128       if ( codret.eq.0 ) then
 129         if ( imem(adopti+11).ne.1 ) then
 130           nretap = imem(adetco) + 1
 131           imem(adetco) = nretap
 132           nrsset = -1
 133           imem(adetco+1) = nrsset
 134         endif
 135         nrsect = imem(adetco+2) + 10
 136         imem(adetco+2) = nrsect
 137         nrssse = nrsect
 138         imem(adetco+3) = nrssse
 139       else
 140         nretap = -1
 141         nrsset = -1
 142         nrsect = 200
 143         nrssse = nrsect
 144         codret = 2
 145       endif
 146 c
 147 c=======================================================================
 148       if ( imem(adopti+11).ne.1 ) then
 149 c=======================================================================
 150 c
 151 c 1.5. ==> le debut des mesures de temps
 152 c
 153       call gtdems (nrsect)
 154 c
 155 c 1.6. ==> les messages
 156 c
 157       texte(1,4) = '(/,a6,'' INFORMATIONS COMPLEMENTAIRES'')'
 158       texte(1,5) = '(35(''=''),/)'
 159 c
 160       texte(2,4) = '(/,a6,'' ADDITIONAL INFORMATION'')'
 161       texte(2,5) = '(29(''=''),/)'
 162 c
 163 c 1.7. ==> le titre
 164 c
 165       call utcvne ( nretap, nrsset, saux, iaux, codret )
 166 c
 167       write (ulsort,texte(langue,4)) saux
 168       write (ulsort,texte(langue,5))
 169 c
 170       nrsset = 0
 171       imem(adetco+1) = nrsset
 172 c
 173 c 1.7. ==> les noms d'objets a conserver
 174 c
 175       if ( codret.eq.0 ) then
 176         call gmadoj ( nndoad//'.OptCar', adopts, lgopts, codret )
 177         if ( codret.ne.0 ) then
 178           codret = 2
 179         endif
 180       endif
 181 c
 182 #include "impr03.h"
 183 c
 184 c====
 185 c 2. programme veritable
 186 c====
 187 #ifdef _DEBUG_HOMARD_
 188       write (ulsort,90002) '2. programme veritable ; codret', codret
 189 #endif
 190 c
 191       if ( codret.eq.0 ) then
 192 c
 193 #ifdef _DEBUG_HOMARD_
 194       write (ulsort,texte(langue,3)) 'INFCOM', nompro
 195 #endif
 196       call infcom ( lgopti, imem(adopti), lgopts, smem(adopts),
 197      >              lgetco, imem(adetco),
 198      >              ulsort, langue, codret )
 199 c
 200       endif
 201 c
 202 c====
 203 c 3. la fin
 204 c====
 205 c
 206 c 3.1. ==> message si erreur
 207 c
 208       if ( codret.ne.0 ) then
 209 c
 210 #include "envex2.h"
 211 c
 212       write (ulsort,texte(langue,1)) 'Sortie', nompro
 213       write (ulsort,texte(langue,2)) codret
 214 c
 215       endif
 216 c
 217 c 3.2. ==> fin des mesures de temps de la section
 218 c
 219       call gtfims (nrsect)
 220 c
 221 c=======================================================================
 222       endif
 223 c=======================================================================
 224 c
 225 #ifdef _DEBUG_HOMARD_
 226       write (ulsort,texte(langue,1)) 'Sortie', nompro
 227       call dmflsh (iaux)
 228 #endif
 229 c
 230 c=======================================================================
 231       endif
 232 c=======================================================================
 233 c
 234       end