src/tool/HOMARD_00/hoavec.F

   1       subroutine hoavec ( 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       HOMARD : interface AVant adaptation : ECritures
  23 c       --                 --                 --
  24 c ______________________________________________________________________
  25 c .        .     .        .                                            .
  26 c .  nom   . e/s . taille .           description                      .
  27 c .____________________________________________________________________.
  28 c . codret . es  .    1   . code de retour des modules                 .
  29 c .        .     .        . en entree = celui du module d'avant        .
  30 c .        .     .        . en sortie = celui du module en cours       .
  31 c .        .     .        . 0 : pas de probleme                        .
  32 c .        .     .        . 1 : manque de temps cpu                    .
  33 c .        .     .        . 2x : probleme dans les memoires            .
  34 c .        .     .        . 3x : probleme dans les fichiers            .
  35 c .        .     .        . 5 : mauvaises options                      .
  36 c .        .     .        . 6 : problemes dans les noms d'objet        .
  37 c ______________________________________________________________________
  38 c
  39 c====
  40 c 0. declarations et dimensionnement
  41 c====
  42 c
  43 c 0.1. ==> generalites
  44 c
  45       implicit none
  46       save
  47 c
  48       character*6 nompro
  49       parameter ( nompro = 'HOAVEC' )
  50 c
  51 #include "motcle.h"
  52 #include "nblang.h"
  53 c
  54 c 0.2. ==> communs
  55 c
  56 #include "gmenti.h"
  57 #include "gmstri.h"
  58 #include "cndoad.h"
  59 c
  60 c 0.3. ==> arguments
  61 c
  62       integer codret
  63 c
  64 c 0.4. ==> variables locales
  65 c
  66       integer ulsort, langue, codava
  67       integer adopti, lgopti
  68       integer adopts, lgopts
  69       integer adetco, lgetco
  70       integer nrsect, nrssse
  71       integer nretap, nrsset
  72       integer iaux
  73 c
  74       character*8 typobs
  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 c 1.4. ==> Va-t-on ecrire ?
 118 c
 119       iaux = 0
 120       if ( codret.eq.0 ) then
 121 cgn      print *,imem(adopti+20),imem(adopti+4)
 122       if ( imem(adopti+20).eq.1 ) then
 123         if ( mod(imem(adopti+4),2).eq.0 ) then
 124           iaux = 1
 125         endif
 126       endif
 127 cgn      print *,imem(adopti+3),imem(adopti+4)
 128       if ( imem(adopti+3) .eq.-3 .and.
 129      >     mod(imem(adopti+4),2).eq.0 .and.
 130      >     imem(adopti+26).eq.1 ) then
 131         iaux = 1
 132       endif
 133       if ( imem(adopti+3) .eq.5 ) then
 134         iaux = 1
 135       endif
 136       endif
 137 c
 138 c-----------------------------------------------------------------------
 139       if ( iaux.eq.1 ) then
 140 c-----------------------------------------------------------------------
 141 c
 142 c 1.5. ==> l'etat courant
 143 c
 144       call gmadoj ( nndoad//'.EtatCour', adetco, lgetco, codret )
 145       if ( codret.eq.0 ) then
 146         nretap = imem(adetco) + 1
 147         imem(adetco) = nretap
 148         nrsset = -1
 149         imem(adetco+1) = nrsset
 150         nrsect = imem(adetco+2) + 10
 151         imem(adetco+2) = nrsect
 152         nrssse = nrsect
 153         imem(adetco+3) = nrssse
 154       else
 155         nretap = -1
 156         nrsset = -1
 157         nrsect = 200
 158         nrssse = nrsect
 159         codret = 2
 160       endif
 161 c
 162 c 1.6. ==> le debut des mesures de temps
 163 c
 164       call gtdems (nrsect)
 165 c
 166 c 1.7. ==> les messages
 167 c
 168 #include "impr01.h"
 169 c
 170 #ifdef _DEBUG_HOMARD_
 171       write (ulsort,texte(langue,1)) 'Entree', nompro
 172       call dmflsh (iaux)
 173 #endif
 174 c
 175       texte(1,4) =
 176      > '(//,a6,'' E C R I T U R E   D E S   F I C H I E R S'')'
 177       texte(1,5) = '(48(''=''),/)'
 178 c
 179       texte(2,4) = '(//,a6,'' W R I T I N G   O F   F I L E S'')'
 180       texte(2,5) = '(38(''=''),/)'
 181 c
 182 c 1.8. ==> le titre
 183 c
 184       call utcvne ( nretap, nrsset, saux, iaux, codret )
 185 c
 186       write (ulsort,texte(langue,4)) saux
 187       write (ulsort,texte(langue,5))
 188 c
 189       nrsset = 0
 190       imem(adetco+1) = nrsset
 191 c
 192 c 1.9. ==> les noms d'objets a conserver
 193 c
 194       if ( codret.eq.0 ) then
 195         call gmadoj ( nndoad//'.OptCar', adopts, lgopts, codret )
 196         if ( codret.ne.0 ) then
 197           codret = 2
 198         endif
 199       endif
 200 c
 201 c====
 202 c 2. ecriture eventuelle du maillage
 203 c====
 204 c
 205       imem(adetco+3) = imem(adetco+3) + 1
 206 c
 207       if ( codret.eq.0 ) then
 208 c
 209       if ( imem(adopti+20).eq.1 .or. imem(adopti+3).eq.5 ) then
 210 c
 211         if ( mod(imem(adopti+4),2).eq.0 ) then
 212 c
 213           typobs = mchman
 214           nrssse = imem(adetco+3)
 215           nrsset = imem(adetco+1) + 1
 216           imem(adetco+1) = nrsset
 217 c
 218 #ifdef _DEBUG_HOMARD_
 219       write (ulsort,texte(langue,3)) 'ESEMHO', nompro
 220 #endif
 221           call esemho ( typobs, nrssse, nretap, nrsset,
 222      >                  imem(adopti+4),
 223      >                  imem(adopti+28), smem(adopts+15),
 224      >                  ulsort, langue, codret)
 225 c
 226         endif
 227 c
 228       endif
 229 c
 230       endif
 231
 232 c
 233 c====
 234 c 3. la fin
 235 c====
 236 c
 237 c 3.1. ==> message si erreur
 238 c
 239       if ( codret.ne.0 ) then
 240 c
 241          write (ulsort,texte(langue,1)) 'Sortie', nompro
 242          write (ulsort,texte(langue,2)) codret
 243 c
 244       endif
 245 c
 246 c 3.2. ==> fin des mesures de temps de la section
 247 c
 248       call gtfims (nrsect)
 249 c
 250 #ifdef _DEBUG_HOMARD_
 251       write (ulsort,texte(langue,1)) 'Sortie', nompro
 252       call dmflsh (iaux)
 253 #endif
 254 c
 255 c-----------------------------------------------------------------------
 256       else
 257 c-----------------------------------------------------------------------
 258 c
 259 c====
 260 c 4. Mise a jour du compteur des sections temporelles
 261 c    si rien n'a ete fait
 262 c====
 263 c
 264       call gmadoj ( nndoad//'.EtatCour', adetco, lgetco, codret )
 265       if ( codret.eq.0 ) then
 266         nrsect = imem(adetco+2) + 10
 267         imem(adetco+2) = nrsect
 268       endif
 269 c-----------------------------------------------------------------------
 270       endif
 271 c-----------------------------------------------------------------------
 272 c=======================================================================
 273       endif
 274 c=======================================================================
 275 c
 276       end