src/tool/HOMARD_00/hoapec.F

   1       subroutine hoapec ( 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 APres 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 = 'HOAPEC' )
  50 c
  51 #include "motcle.h"
  52 #include "nblang.h"
  53 c
  54 c 0.2. ==> communs
  55 c
  56 #include "envex1.h"
  57 c
  58 #include "gmenti.h"
  59 #include "gmstri.h"
  60 c
  61 #include "cndoad.h"
  62 c
  63 c 0.3. ==> arguments
  64 c
  65       integer codret
  66 c
  67 c 0.4. ==> variables locales
  68 c
  69       integer ulsort, langue, codava
  70       integer adopti, lgopti
  71       integer adetco, lgetco
  72       integer adopts, lgopts
  73       integer nrsect, nrssse
  74       integer nretap, nrsset
  75       integer iaux
  76 c
  77       character*6 saux
  78       character*8 typobs
  79 c
  80       integer nbmess
  81       parameter ( nbmess = 10 )
  82       character*80 texte(nblang,nbmess)
  83 c
  84 c 0.5. ==> initialisations
  85 c ______________________________________________________________________
  86 c
  87 c====
  88 c 1. les initialisations
  89 c====
  90 c
  91 #include "impr03.h"
  92 c
  93       codava = codret
  94 c
  95 c=======================================================================
  96       if ( codava.eq.0 ) then
  97 c=======================================================================
  98 c
  99 #ifdef _DEBUG_HOMARD_
 100       call gmprsx (nompro, nndoad )
 101       call gmprsx (nompro, nndoad//'.OptEnt' )
 102       call gmprsx (nompro, nndoad//'.OptRee' )
 103       call gmprsx (nompro, nndoad//'.OptCar' )
 104       call gmprsx (nompro, nndoad//'.EtatCour' )
 105 #endif
 106 c
 107 c 1.2. ==> le numero d'unite logique de la liste standard
 108 c
 109       call utulls ( ulsort, codret )
 110 c
 111 c 1.3. ==> la langue des messages
 112 c
 113       call gmadoj ( nndoad//'.OptEnt', adopti, lgopti, codret )
 114       if ( codret.eq.0 ) then
 115         langue = imem(adopti)
 116       else
 117         langue = 1
 118         codret = 2
 119       endif
 120 c
 121 c 1.4. ==> l'etat courant
 122 c
 123       call gmadoj ( nndoad//'.EtatCour', adetco, lgetco, codret )
 124       if ( codret.eq.0 ) then
 125         nretap = imem(adetco) + 1
 126         imem(adetco) = nretap
 127         nrsset = -1
 128         imem(adetco+1) = nrsset
 129         nrsect = imem(adetco+2) + 10
 130         imem(adetco+2) = nrsect
 131         nrssse = nrsect
 132         imem(adetco+3) = nrssse
 133       else
 134         nretap = -1
 135         nrsset = -1
 136         nrsect = 200
 137         nrssse = nrsect
 138         codret = 2
 139       endif
 140 c
 141 c 1.4. ==> le debut des mesures de temps
 142 c
 143       call gtdems (nrsect)
 144 c
 145 c 1.5. ==> les messages
 146 c
 147 #include "impr01.h"
 148 c
 149 #ifdef _DEBUG_HOMARD_
 150       write (ulsort,texte(langue,1)) 'Entree', nompro
 151       call dmflsh (iaux)
 152 #endif
 153 c
 154       texte(1,4) =
 155      > '(//,a6,'' E C R I T U R E   D E S   F I C H I E R S'')'
 156       texte(1,5) = '(48(''=''),/)'
 157 c
 158       texte(2,4) = '(//,a6,'' W R I T I N G   O F   F I L E S'')'
 159       texte(2,5) = '(38(''=''),/)'
 160 c
 161 c 1.6. ==> le titre
 162 c
 163       call utcvne ( nretap, nrsset, saux, iaux, codret )
 164 c
 165       write (ulsort,texte(langue,4)) saux
 166       write (ulsort,texte(langue,5))
 167 c
 168       nrsset = 0
 169       imem(adetco+1) = nrsset
 170 c
 171 c 1.7. ==> les noms d'objets a conserver
 172 c
 173       if ( codret.eq.0 ) then
 174         call gmadoj ( nndoad//'.OptCar', adopts, lgopts, codret )
 175         if ( codret.ne.0 ) then
 176           codret = 2
 177         endif
 178       endif
 179 c
 180 c====
 181 c 2. Ecriture eventuelle du maillage HOMARD
 182 c====
 183 #ifdef _DEBUG_HOMARD_
 184       write (ulsort,90002) '2. Maillage HOMARD ; codret', codret
 185 #endif
 186 c
 187       if ( codret.eq.0 ) then
 188 c
 189       imem(adetco+3) = imem(adetco+3) + 1
 190 c
 191       if ( mod(imem(adopti+4),3).eq.0 ) then
 192 c
 193         typobs = mchmap
 194         nrssse = imem(adetco+3)
 195         nrsset = imem(adetco+1) + 1
 196         imem(adetco+1) = nrsset
 197 c
 198 #ifdef _DEBUG_HOMARD_
 199         write (ulsort,texte(langue,3)) 'ESEMHO', nompro
 200 #endif
 201         call esemho ( typobs, nrssse, nretap, nrsset,
 202      >                imem(adopti+4),
 203      >                imem(adopti+28), smem(adopts+15),
 204      >                ulsort, langue, codret )
 205 c
 206       endif
 207 c
 208       endif
 209 c
 210 c====
 211 c 3. Ecriture eventuelle du maillage de calcul
 212 c====
 213 #ifdef _DEBUG_HOMARD_
 214       write (ulsort,90002) '3. Maillage de calcul ; codret', codret
 215 #endif
 216 c
 217       if ( codret.eq.0 ) then
 218 c
 219       imem(adetco+3) = imem(adetco+3) + 1
 220 c
 221       if ( imem(adopti+21).eq.1 ) then
 222 c
 223         imem(adopti+49) = 1
 224 c
 225 #ifdef _DEBUG_HOMARD_
 226         write (ulsort,texte(langue,3)) 'HOAPEM', nompro
 227 #endif
 228         call hoapem ( lgopti, imem(adopti), lgopts, smem(adopts),
 229      >                lgetco, imem(adetco),
 230      >                ulsort, langue, codret )
 231 c
 232       endif
 233 c
 234       endif
 235 c
 236 c====
 237 c 4. ecriture eventuelle de solutions
 238 c====
 239 #ifdef _DEBUG_HOMARD_
 240       write (ulsort,90002) '4. Solutions ; codret', codret
 241 #endif
 242 c
 243       if ( codret.eq.0 ) then
 244 c
 245       imem(adetco+3) = imem(adetco+3) + 1
 246 c
 247       if ( imem(adopti+27).eq.1 .or. imem(adopti+11).gt.1 ) then
 248 c
 249 #ifdef _DEBUG_HOMARD_
 250         write (ulsort,texte(langue,3)) 'HOAPES', nompro
 251 #endif
 252         call hoapes ( lgopti, imem(adopti), lgopts, smem(adopts),
 253      >                lgetco, imem(adetco),
 254      >                ulsort, langue, codret )
 255 c
 256       endif
 257 c
 258       endif
 259 c
 260 c====
 261 c 5. la fin
 262 c====
 263 c
 264 c 5.1. ==> message si erreur
 265 c
 266       if ( codret.ne.0 ) then
 267 c
 268 #include "envex2.h"
 269 c
 270       write (ulsort,texte(langue,1)) 'Sortie', nompro
 271       write (ulsort,texte(langue,2)) codret
 272 c
 273       endif
 274 c
 275 c 5.2. ==> fin des mesures de temps de la section
 276 c
 277       call gtfims (nrsect)
 278 c
 279 #ifdef _DEBUG_HOMARD_
 280       write (ulsort,texte(langue,1)) 'Sortie', nompro
 281       call dmflsh (iaux)
 282 #endif
 283 c
 284 c=======================================================================
 285       endif
 286 c=======================================================================
 287 c
 288       end