src/tool/HOMARD_00/hoprin.F

   1        subroutine hoprin
   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 : programme PRINcipal
  23 c       --                 ----
  24 c ______________________________________________________________________
  25 c
  26 c====
  27 c 0. declarations et dimensionnement
  28 c====
  29 c
  30 c 0.1. ==> generalites
  31 c
  32       implicit none
  33       save
  34 c
  35       character*6 nompro
  36       parameter ( nompro = 'HOPRIN' )
  37 c
  38 #include "nblang.h"
  39 #include "referx.h"
  40 c
  41 c 0.2. ==> communs
  42 c          On les met tous pour assurer la coherence en descendance.
  43 c          En principe, le save devrait remedier a cela mais on fait
  44 c          ceinture et bretelles
  45 c
  46 #include "chisig.h"
  47 #include "cndoad.h"
  48 #include "cofhex.h"
  49 #include "cofpen.h"
  50 #include "comp07.h"
  51 #include "defiqu.h"
  52 #include "demitr.h"
  53 #include "dicfen.h"
  54 #include "enti01.h"
  55 #include "envada.h"
  56 #include "envca1.h"
  57 #include "envca2.h"
  58 #include "envex1.h"
  59 #include "fahmed.h"
  60 #include "front0.h"
  61 #include "front1.h"
  62 #include "front2.h"
  63 #include "gmenti.h"
  64 #include "gmreel.h"
  65 #include "gmstri.h"
  66 #include "hexcf0.h"
  67 #include "hexcf1.h"
  68 #include "i1i2i3.h"
  69 #include "impr02.h"
  70 #include "indefi.h"
  71 #include "indefr.h"
  72 #include "indefs.h"
  73 #include "infini.h"
  74 #include "j1234j.h"
  75 #include "nancnb.h"
  76 #include "nbfami.h"
  77 #include "nbfamm.h"
  78 #include "nbutil.h"
  79 #include "nombar.h"
  80 #include "nomber.h"
  81 #include "nombhe.h"
  82 #include "nombmp.h"
  83 #include "nombno.h"
  84 #include "nombpe.h"
  85 #include "nombpy.h"
  86 #include "nombqu.h"
  87 #include "nombsr.h"
  88 #include "nombte.h"
  89 #include "nombtr.h"
  90 #include "nomest.h"
  91 #include "nouvnb.h"
  92 #include "op0123.h"
  93 #include "op1234.h"
  94 #include "op1aa6.h"
  95 #include "ope1a3.h"
  96 #include "ope1a4.h"
  97 #include "ope4a6.h"
  98 #include "oriefp.h"
  99 #include "oriefy.h"
 100 #include "orieqh.h"
 101 #include "oriett.h"
 102 #include "permut.h"
 103 #include "precis.h"
 104 #include "refere.h"
 105 #include "refert.h"
 106 #include "rfamed.h"
 107 #include "rftmed.h"
 108 c
 109 c 0.3. ==> arguments
 110 c
 111 c 0.4. ==> variables locales
 112 c
 113       integer modhom
 114       integer lnomfi, lang, ulsort, codret, codre0
 115       integer guimp, gmimp, raison
 116 c
 117       character*200 nomfic
 118 c
 119       integer nbmess
 120       parameter ( nbmess = 10 )
 121       character*80 texte(nblang,nbmess)
 122 c
 123 #include "hoconf.h"
 124 #include "langue.h"
 125 c
 126 c 0.5. ==> initialisations
 127 c ______________________________________________________________________
 128 c
 129 c====
 130 c 1. initialisation
 131 c====
 132 c
 133 #include "impr01.h"
 134 #include "impr03.h"
 135 c
 136       lang = langue
 137       nomfic = nfconf
 138       lnomfi = lfconf
 139 #ifdef _DEBUG_HOMARD_
 140       write (*,*) 'Appel de HOINIT par ', nompro
 141 #endif
 142       call hoinit ( nomfic, lnomfi, lang, codret )
 143 c
 144       call utulls ( ulsort, codre0 )
 145 c
 146 c====
 147 c 2. lectures
 148 c    modhom est, en sortie, le mode d'utilisation de HOMARD :
 149 c    1 : adaptation standard
 150 c    2 : information sur un maillage
 151 c    3 : modification d'un maillage, sans adaptation
 152 c    4 : conversion de solution
 153 c    5 : mise a jour des coordonnees apres un suivi de frontiere externe
 154 c====
 155 c
 156 #ifdef _DEBUG_HOMARD_
 157       write (ulsort,texte(langue,3)) 'HOLECT', nompro
 158 #endif
 159       call holect ( modhom, codret )
 160 c
 161 c====
 162 c 3. Mode : HOMARD pur
 163 c====
 164 c
 165       if ( modhom.eq.1 ) then
 166 c
 167 c 3.1. ==> conversions avant adaptation et ecritures
 168 c
 169 #ifdef _DEBUG_HOMARD_
 170       write (ulsort,texte(langue,3)) 'HOAVCV', nompro
 171 #endif
 172       call hoavcv ( codret )
 173 c
 174 #ifdef _DEBUG_HOMARD_
 175       write (ulsort,texte(langue,3)) 'HOAVEC', nompro
 176 #endif
 177       call hoavec ( codret )
 178 c
 179 c 3.2. ==> attribution des decisions aux faces et aux aretes
 180 c
 181 #ifdef _DEBUG_HOMARD_
 182       write (ulsort,texte(langue,3)) 'HODECI', nompro
 183 #endif
 184       call hodeci ( codret )
 185 c
 186 c 3.3. ==> creation du nouveau maillage
 187 c
 188 #ifdef _DEBUG_HOMARD_
 189       write (ulsort,texte(langue,3)) 'HOCRMA', nompro
 190 #endif
 191       call hocrma ( codret )
 192 c
 193 c 3.4. ==> suivi de frontiere (eventuellement)
 194 c
 195 #ifdef _DEBUG_HOMARD_
 196       write (ulsort,texte(langue,3)) 'HOSUFR', nompro
 197 #endif
 198       call hosufr ( codret )
 199 c
 200 c 3.5. ==> conversions apres adaptation
 201 c
 202 #ifdef _DEBUG_HOMARD_
 203       write (ulsort,texte(langue,3)) 'HOAPCV', nompro
 204 #endif
 205       call hoapcv ( codret )
 206 c
 207 c 3.6. ==> informations complementaires
 208 c
 209 #ifdef _DEBUG_HOMARD_
 210       write (ulsort,texte(langue,3)) 'HOINCO', nompro
 211 #endif
 212       call hoinco ( codret )
 213 c
 214 c 3.7. ==> ecritures
 215 c
 216 #ifdef _DEBUG_HOMARD_
 217       write (ulsort,texte(langue,3)) 'HOAPEC', nompro
 218 #endif
 219       call hoapec ( codret )
 220 c
 221 c 3.8. ==> creation de maillage et solution annexes (eventuellement)
 222 c
 223 #ifdef _DEBUG_HOMARD_
 224       write (ulsort,texte(langue,3)) 'HOCMSA', nompro
 225 #endif
 226       call hocmsa ( codret )
 227 c
 228 c====
 229 c 4. Mode : information
 230 c====
 231 c
 232       elseif ( modhom.eq.2 ) then
 233 c
 234 c 4.1. ==> conversions
 235 c
 236 #ifdef _DEBUG_HOMARD_
 237       write (ulsort,texte(langue,3)) 'INCONV', nompro
 238 #endif
 239       call inconv ( codret )
 240 c
 241 c 4.2. ==> informations
 242 c
 243 #ifdef _DEBUG_HOMARD_
 244       write (ulsort,texte(langue,3)) 'ININFM', nompro
 245 #endif
 246       call ininfm ( codret )
 247 c
 248 c 4.3. ==> questions/reponses
 249 c
 250 #ifdef _DEBUG_HOMARD_
 251       write (ulsort,texte(langue,3)) 'INQURE', nompro
 252 #endif
 253       call inqure ( codret )
 254 c
 255 c====
 256 c 5. Mode : modification de maillage
 257 c====
 258 c
 259       elseif ( modhom.eq.3 ) then
 260 c
 261 c 5.1. ==> conversions initiales et ecritures
 262 c
 263 #ifdef _DEBUG_HOMARD_
 264       write (ulsort,texte(langue,3)) 'HOAVCV', nompro
 265 #endif
 266       call hoavcv ( codret )
 267 c
 268 #ifdef _DEBUG_HOMARD_
 269       write (ulsort,texte(langue,3)) 'HOAVEC', nompro
 270 #endif
 271       call hoavec ( codret )
 272 c
 273 c 5.2. ==> modification
 274 c
 275 #ifdef _DEBUG_HOMARD_
 276       write (ulsort,texte(langue,3)) 'MMODI', nompro
 277 #endif
 278       call mmmodi ( codret )
 279 c
 280 c 5.3. ==> conversions apres modification
 281 c
 282 #ifdef _DEBUG_HOMARD_
 283       write (ulsort,texte(langue,3)) 'HOAPCV', nompro
 284 #endif
 285       call hoapcv ( codret )
 286 c
 287 c 5.4. ==> informations complementaires
 288 c
 289 #ifdef _DEBUG_HOMARD_
 290       write (ulsort,texte(langue,3)) 'HOINCO', nompro
 291 #endif
 292       call hoinco ( codret )
 293 c
 294 c 5.5. ==> ecritures
 295 c
 296 #ifdef _DEBUG_HOMARD_
 297       write (ulsort,texte(langue,3)) 'HOAPEC', nompro
 298 #endif
 299       call hoapec ( codret )
 300 c
 301 c====
 302 c 6. Mode : conversion de la solution
 303 c====
 304 c
 305       elseif ( modhom.eq.4 ) then
 306 c
 307 #ifdef _DEBUG_HOMARD_
 308       write (ulsort,texte(langue,3)) 'HOAPCV', nompro
 309 #endif
 310       call hoapcv ( codret )
 311 c
 312 #ifdef _DEBUG_HOMARD_
 313       write (ulsort,texte(langue,3)) 'HOAPEC', nompro
 314 #endif
 315       call hoapec ( codret )
 316 c
 317 c====
 318 c 7. Mode : mise a jour des coordonnees
 319 c====
 320 c
 321       elseif ( modhom.eq.5 ) then
 322 c
 323 #ifdef _DEBUG_HOMARD_
 324       write (ulsort,texte(langue,3)) 'HOMAJC', nompro
 325 #endif
 326       call homajc ( codret )
 327 c
 328 #ifdef _DEBUG_HOMARD_
 329       write (ulsort,texte(langue,3)) 'HOAVEC', nompro
 330 #endif
 331       call hoavec ( codret )
 332 c
 333 c====
 334 c 8. Mode : erreur
 335 c====
 336 c
 337       else
 338
 339       codret = 7
 340 c
 341       endif
 342 c
 343 c====
 344 c 9. la fin
 345 c     Si le code de retour est :
 346 c     . 0 : tout va bien
 347 c     . un multiple de 2 : probleme dans les objets GM
 348 c     . un multiple de 3 : probleme dans les fichiers
 349 c     . 5 : deux appels a des programmes d'initialisations
 350 c     . 7 : mode inconnu
 351 c===
 352 c
 353       call utulls ( ulsort, codre0 )
 354 c
 355       guimp = 0
 356       gmimp = 0
 357 c
 358       if ( codret.eq.0 ) then
 359 c
 360         raison = 0
 361 c
 362       else
 363 c
 364         raison = 1
 365         if ( mod(codret,2).eq.0 ) then
 366           gmimp = 1
 367         endif
 368         if ( mod(codret,3).eq.0 ) then
 369           guimp = 1
 370         endif
 371 c
 372       endif
 373 c
 374 #ifdef _DEBUG_HOMARD_
 375       write (ulsort,texte(langue,3)) 'HOSTOP', nompro
 376 #endif
 377       call hostop ( ulsort, guimp, gmimp, raison)
 378 c
 379       end