src/tool/HOMARD_00/holver.F

   1       subroutine holver ( lgopti, taopti, lgoptr, taoptr,
   2      >                    lgetco, taetco,
   3      >                    ulsort, langue, codret)
   4 c ______________________________________________________________________
   5 c
   6 c                             H O M A R D
   7 c
   8 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   9 c
  10 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  11 c aupres des huissiers de justice Simart et Lavoir a Clamart
  12 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  13 c aupres des huissiers de justice
  14 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  15 c
  16 c    HOMARD est une marque deposee d'Electricite de France
  17 c
  18 c Copyright EDF 1996
  19 c Copyright EDF 1998
  20 c Copyright EDF 2002
  21 c Copyright EDF 2020
  22 c ______________________________________________________________________
  23 c
  24 c   HOMARD : Lectures VERifications
  25 c   --       -        ---
  26 c ______________________________________________________________________
  27 c .        .     .        .                                            .
  28 c .  nom   . e/s . taille .           description                      .
  29 c .____________________________________________________________________.
  30 c . lgopti . e   .   1    . longueur du tableau des options            .
  31 c . taopti . e   . lgopti . tableau des options                        .
  32 c . lgoptr . e   .   1    . longueur du tableau des options reelles    .
  33 c . taoptr . e   . lgoptr . tableau des options reelles                .
  34 c . lgetco . e   .   1    . longueur du tableau de l'etat courant      .
  35 c . taetco . e   . lgetco . tableau de l'etat courant                  .
  36 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  37 c . langue . e   .    1   . langue des messages                        .
  38 c .        .     .        . 1 : francais, 2 : anglais                  .
  39 c . codret . es  .    1   . code de retour des modules                 .
  40 c .        .     .        . 0 : pas de probleme                        .
  41 c .        .     .        . 2 : incoherence dans les options           .
  42 c ______________________________________________________________________
  43 c
  44 c====
  45 c 0. declarations et dimensionnement
  46 c====
  47 c
  48 c 0.1. ==> generalites
  49 c
  50       implicit none
  51       save
  52 c
  53       character*6 nompro
  54       parameter ( nompro = 'HOLVER' )
  55 c
  56 #include "nblang.h"
  57 c
  58 c 0.2. ==> communs
  59 c
  60 #include "envex1.h"
  61 #include "ope1a3.h"
  62 c
  63 c 0.3. ==> arguments
  64 c
  65       integer lgopti
  66       integer taopti(lgopti)
  67 c
  68       integer lgoptr
  69       double precision taoptr(lgoptr)
  70 c
  71       integer lgetco
  72       integer taetco(lgetco)
  73 c
  74       integer ulsort, langue, codret
  75 c
  76 c 0.4. ==> variables locales
  77 c
  78       integer codava
  79       integer nbrepb
  80       integer nretap, nrsset
  81       integer iaux, jaux
  82       integer modhom
  83 c
  84       character*6 saux
  85 c
  86       integer nbmess
  87       parameter ( nbmess = 200 )
  88       character*80 texte(nblang,nbmess)
  89 c
  90 c 0.5. ==> initialisations
  91 c ______________________________________________________________________
  92 c
  93 c====
  94 c 1. initialisations
  95 c====
  96 c
  97       codava = codret
  98 c
  99 c=======================================================================
 100       if ( codava.eq.0 ) then
 101 c=======================================================================
 102 c
 103 c 1.1. ==> tout va bien
 104 c
 105       codret = 0
 106 c
 107       nbrepb = 0
 108 c
 109 c 1.2. ==> les messages
 110 c
 111 #include "impr01.h"
 112 c
 113 #ifdef _DEBUG_HOMARD_
 114       write (ulsort,texte(langue,1)) 'Entree', nompro
 115       call dmflsh (iaux)
 116 #endif
 117 c
 118       texte(1,4) = '(/,a6,'' VERIFICATION DES OPTIONS'')'
 119       texte(1,5) = '(31(''=''),/)'
 120       texte(1,8) = '(/,''Mode de fonctionnement de HOMARD :'')'
 121 c
 122       texte(1,95) = '(7x,''Maillage avant adaptation :'')'
 123       texte(1,96) = '(7x,''Maillage apres adaptation :'')'
 124       texte(1,97) = '(7x,''Maillage apres modification :'')'
 125       texte(1,98) = '(7x,''Indicateurs d''''erreurs :'')'
 126       texte(1,99) = '(7x,''Solution :'')'
 127 c
 128       texte(2,4) = '(/,a6,'' CONTROL OF OPTIONS'')'
 129       texte(2,5) = '(25(''=''),/)'
 130       texte(2,8) = '(/,''HOMARD running mode:'')'
 131 c
 132       texte(2,95) = '(7x,''Mesh before adaptation:'')'
 133       texte(2,96) = '(7x,''Mesh after adaptation:'')'
 134       texte(2,97) = '(7x,''Mesh after modification:'')'
 135       texte(2,98) = '(7x,''Error indicator:'')'
 136       texte(2,99) = '(7x,''Solution:'')'
 137 c
 138 #include "impr03.h"
 139 c
 140 #include "mslver.h"
 141 c
 142 c 1.3. ==> le numero de sous-etape
 143 c
 144       nretap = taetco(1)
 145       nrsset = taetco(2) + 1
 146       taetco(2) = nrsset
 147 c
 148       call utcvne ( nretap, nrsset, saux, iaux, codret )
 149 c
 150 c 1.4. ==> le titre
 151 c
 152       write (ulsort,texte(langue,4)) saux
 153       write (ulsort,texte(langue,5))
 154 c
 155 c====
 156 c 2. verification du mode d'utilisation de homard
 157 c====
 158 c
 159       if ( taopti(4).ge.1 .and. taopti(4).le.5 ) then
 160         modhom = taopti(4)
 161 #ifdef _DEBUG_HOMARD_
 162       write (ulsort,90002) 'modhom', modhom
 163 #endif
 164       else
 165         write(ulsort,texte(langue,8))
 166         write(ulsort,texte(langue,11)) taopti(4)
 167         nbrepb = nbrepb + 1
 168       endif
 169 c
 170 c====
 171 c 3. verification de la validite des mots_cles de pilotage
 172 c====
 173 c
 174 c 3.1. ==> type de code de calcul associe
 175 c
 176 #include "mslve0.h"
 177 #include "mslve1.h"
 178 c
 179 c 3.2. ==> pour le mode homard pur
 180 #ifdef _DEBUG_HOMARD_
 181       write (ulsort,90002) '3.2. homard pur ; nbrepb', nbrepb
 182 #endif
 183 c
 184       if ( modhom.eq.1 ) then
 185 c
 186 c 3.2.1. ==> numero d'iteration initiale
 187 c
 188       write(ulsort,texte(langue,23))
 189       if ( taopti(10).eq.0 ) then
 190         write(ulsort,texte(langue,20))
 191       elseif ( taopti(10).eq.1 ) then
 192         write(ulsort,texte(langue,21))
 193       elseif ( taopti(10).gt.1 ) then
 194         write(ulsort,texte(langue,22)) taopti(10)
 195       else
 196         write(ulsort,texte(langue,11)) taopti(10)
 197         nbrepb = nbrepb + 1
 198       endif
 199 c
 200 c 3.2.2. ==> type de conformite
 201 #ifdef _DEBUG_HOMARD_
 202       write (ulsort,90002) '3.2.2. conformite ; nbrepb', nbrepb
 203 #endif
 204 c
 205 #include "mslve2.h"
 206 c
 207 c 3.2.3. ==> maillage extrude
 208 #ifdef _DEBUG_HOMARD_
 209       write (ulsort,90002) '3.2.3. maillage extrude ; nbrepb', nbrepb
 210 #endif
 211 c
 212 #include "mslve3.h"
 213 c
 214 c 3.2.4. ==> raffinement
 215 #ifdef _DEBUG_HOMARD_
 216       write (ulsort,90002) '3.2.4. raffinement ; nbrepb', nbrepb
 217 #endif
 218 c
 219 #include "mslve5.h"
 220 #include "mslv13.h"
 221 #include "mslve6.h"
 222 c
 223 c 3.2.5. ==> deraffinement
 224 #ifdef _DEBUG_HOMARD_
 225       write (ulsort,90002) '3.2.5. deraffinement ; nbrepb', nbrepb
 226 #endif
 227 c
 228 #include "mslve7.h"
 229 #include "mslve8.h"
 230 c
 231 c 3.2.6. ==> coherence entre raffinement et deraffinement
 232 #ifdef _DEBUG_HOMARD_
 233       write (ulsort,90002) '3.2.6. raff/dera ; nbrepb', nbrepb
 234 #endif
 235 c
 236 #include "mslve9.h"
 237 c
 238 c 3.2.7. ==> coherence des seuils
 239 #ifdef _DEBUG_HOMARD_
 240       write (ulsort,90002) '3.2.7. seuils ; nbrepb', nbrepb
 241 #endif
 242 c
 243 #include "mslv10.h"
 244 c
 245 c 3.2.8. ==> indicateur de suivi de frontiere
 246 #ifdef _DEBUG_HOMARD_
 247       write (ulsort,90002) '3.2.8. suivi de frontiere ; nbrepb', nbrepb
 248 #endif
 249 c
 250 #include "mslv11.h"
 251 c
 252 c 3.3. ==> pour les autres modes
 253 c
 254       else
 255 c
 256       taopti(31) = 0
 257       taopti(32) = 0
 258 c
 259       endif
 260 c
 261 c 3.4. ==> pour le mode homard pur ou interpolation de solution
 262 c
 263       if ( modhom.eq.1 .or. modhom.eq.4 ) then
 264 c
 265 c 3.4.1. ==> indicateur de conversion de la solution
 266 c
 267       write(ulsort,texte(langue,61))
 268 c
 269       write(ulsort,texte(langue,99))
 270       if ( taopti(28).eq.0 ) then
 271         write(ulsort,texte(langue,12))
 272       elseif ( taopti(28).eq.1 ) then
 273         write(ulsort,texte(langue,13))
 274       else
 275         write(ulsort,texte(langue,11)) taopti(28)
 276         nbrepb = nbrepb + 1
 277       endif
 278 c
 279       endif
 280 c
 281 c 3.5. ==> reperage temporel de l'indicateur d'erreur
 282 c
 283       if ( modhom.eq.1 ) then
 284 c
 285 #include "mslv12.h"
 286 c
 287       endif
 288 c
 289 c====
 290 c 4. message si erreur
 291 c====
 292 c
 293       if ( nbrepb.ne.0 ) then
 294 c
 295         write (ulsort,texte(langue,1)) 'Sortie', nompro
 296         if ( nbrepb.eq.1 ) then
 297           write (ulsort,texte(langue,6))
 298         else
 299           write (ulsort,texte(langue,7))
 300         endif
 301         codret = 2
 302 c
 303       endif
 304 c
 305 c====
 306 c 5. si tout va bien, on en deduit les conversions a faire
 307 c====
 308 c
 309       if ( codret.eq.0 ) then
 310 c
 311 c 5.1. ==> indicateur de conversion du maillage
 312 c
 313 c 5.1.1. ==> pour le mode homard pur
 314 c
 315       if ( modhom.eq.1 ) then
 316 c
 317       write(ulsort,texte(langue,95))
 318       if ( taopti(10).eq.0 ) then
 319         taopti(21) = 1
 320         write(ulsort,texte(langue,13))
 321       else
 322         taopti(21) = 0
 323         write(ulsort,texte(langue,12))
 324       endif
 325 c
 326       write(ulsort,texte(langue,96))
 327       taopti(22) = 1
 328       write(ulsort,texte(langue,13))
 329 c
 330 c 5.1.2. ==> pour le mode information
 331 c
 332       elseif ( modhom.eq.2 ) then
 333 c
 334       write(ulsort,texte(langue,24))
 335       if ( taopti(11).ne.1 ) then
 336         taopti(21) = 1
 337         write(ulsort,texte(langue,13))
 338       else
 339         taopti(21) = 0
 340         write(ulsort,texte(langue,12))
 341       endif
 342 c
 343 c 5.1.3. ==> pour le mode modification
 344 c
 345       elseif ( modhom.eq.3 ) then
 346 c
 347       write(ulsort,texte(langue,25))
 348       if ( taopti(11).ne.1 ) then
 349         taopti(21) = 1
 350         write(ulsort,texte(langue,13))
 351       else
 352         taopti(21) = 0
 353         write(ulsort,texte(langue,12))
 354       endif
 355 c
 356       write(ulsort,texte(langue,97))
 357       taopti(22) = 1
 358       write(ulsort,texte(langue,13))
 359 c
 360 c 5.1.4. ==> pour le mode interpolation
 361 c
 362       else
 363 c
 364       taopti(21) = 0
 365       taopti(22) = 0
 366 c
 367       endif
 368 c
 369 c 5.2. ==> indicateur de conversion de l'indicateur d'erreur
 370 c
 371 c 5.2.1. ==> pour le mode homard pur
 372 c
 373       if ( modhom.eq.1 ) then
 374 c
 375         if ( taopti(37).eq.0 ) then
 376           write(ulsort,texte(langue,98))
 377             taopti(27) = 0
 378           if ( taopti(10).eq.0 ) then
 379             if ( taopti(31).gt.0 ) then
 380               taopti(27) = 1
 381             endif
 382           else
 383             if ( taopti(31).gt.0 .or. taopti(32).gt.0 ) then
 384               taopti(27) = 1
 385             endif
 386           endif
 387           if ( taopti(27).eq.0 ) then
 388             write(ulsort,texte(langue,12))
 389           else
 390             write(ulsort,texte(langue,13))
 391           endif
 392         else
 393           taopti(27) = 0
 394         endif
 395 c
 396 c 5.2.2. ==> pour les autres modes
 397 c
 398       else
 399 c
 400       taopti(27) = 0
 401 c
 402       endif
 403 c
 404       endif
 405
 406 c====
 407 c 6. ecriture des fichiers HOMARD : rien pour le mode d'information
 408 c====
 409 c
 410       if ( codret.eq.0 ) then
 411 c
 412       if ( modhom.eq.2 ) then
 413         taopti(5) = 1
 414       endif
 415 c
 416       endif
 417 c
 418 c====
 419 c 7. Option du delta de coordonnees pour les maillages extrudes
 420 c====
 421 c
 422       if ( taopti(39).ne.0 ) then
 423 c
 424 c 7.1 ==> Si le delta est impose, on doit avoir une valeur > 0
 425 c
 426       if ( codret.eq.0 ) then
 427 c
 428       if ( taopti(40).eq.2 ) then
 429 c
 430       if ( abs(taoptr(3)+1789.d0).lt.1.0d-6 ) then
 431         write(ulsort,texte(langue,70))
 432         write(ulsort,texte(langue,72))
 433         codret = 2
 434 c
 435       elseif ( taoptr(3).le.0.0d0 ) then
 436         write(ulsort,texte(langue,70))
 437         write(ulsort,texte(langue,73))
 438         codret = 2
 439 c
 440       endif
 441 c
 442       endif
 443 c
 444       endif
 445 c
 446       endif
 447 c
 448 c====
 449 c 8. la fin
 450 c====
 451 c
 452       if ( codret.ne.0 ) then
 453 c
 454 #include "envex2.h"
 455 c
 456       write (ulsort,texte(langue,1)) 'Sortie', nompro
 457       write (ulsort,texte(langue,2)) codret
 458 c
 459       endif
 460 c
 461 #ifdef _DEBUG_HOMARD_
 462       write (ulsort,texte(langue,1)) 'Sortie', nompro
 463       call dmflsh (iaux)
 464 #endif
 465 c
 466 c=======================================================================
 467       endif
 468 c=======================================================================
 469 c
 470       end