src/tool/HOMARD_00/hoavli.F

   1       subroutine hoavli ( lgopti, taopti,  lgoptr, taoptr,
   2      >                    lgopts, taopts,
   3      >                    lgetco, taetco,
   4      >                    ulsort, langue, codret)
   5 c ______________________________________________________________________
   6 c
   7 c                             H O M A R D
   8 c
   9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  10 c
  11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  12 c aupres des huissiers de justice Simart et Lavoir a Clamart
  13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  14 c aupres des huissiers de justice
  15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  16 c
  17 c    HOMARD est une marque deposee d'Electricite de France
  18 c
  19 c Copyright EDF 1996
  20 c Copyright EDF 1998
  21 c Copyright EDF 2002
  22 c Copyright EDF 2020
  23 c ______________________________________________________________________
  24 c
  25 c       HOMARD : interface AVant adaptation : Lectures de l'Indicateur
  26 c       --                 --                 -             -
  27 c ______________________________________________________________________
  28 c .        .     .        .                                            .
  29 c .  nom   . e/s . taille .           description                      .
  30 c .____________________________________________________________________.
  31 c . lgopti . e   .   1    . longueur du tableau des options entieres   .
  32 c . taopti . e   . lgopti . tableau des options entieres               .
  33 c . lgoptr . e   .   1    . longueur du tableau des options reelles    .
  34 c . taoptr . es  . lgoptr . tableau des options                        .
  35 c . lgopts . e   .   1    . longueur du tableau des options caracteres .
  36 c . taopts . e   . lgopts . tableau des options caracteres             .
  37 c . lgetco . e   .   1    . longueur du tableau de l'etat courant      .
  38 c . taetco . e   . lgetco . tableau de l'etat courant                  .
  39 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  40 c . langue . e   .    1   . langue des messages                        .
  41 c .        .     .        . 1 : francais, 2 : anglais                  .
  42 c . codret . es  .    1   . code de retour des modules                 .
  43 c .        .     .        . 0 : pas de probleme                        .
  44 c .        .     .        . 1 : manque de temps cpu                    .
  45 c .        .     .        . 3 : probleme a la lecture                  .
  46 c .        .     .        . 4 : impossible de connaitre le code associe.
  47 c .        .     .        . 5 : mauvais type de code de calcul associe .
  48 c ______________________________________________________________________
  49 c
  50 c====
  51 c 0. declarations et dimensionnement
  52 c====
  53 c
  54 c 0.1. ==> generalites
  55 c
  56       implicit none
  57       save
  58 c
  59       character*6 nompro
  60       parameter ( nompro = 'HOAVLI' )
  61 c
  62 #include "nblang.h"
  63 c
  64 c 0.2. ==> communs
  65 c
  66 #include "envex1.h"
  67 c
  68 c 0.3. ==> arguments
  69 c
  70       integer lgopti
  71       integer taopti(lgopti)
  72 c
  73       integer lgoptr
  74       double precision taoptr(lgoptr)
  75 c
  76       integer lgopts
  77       character*8 taopts(lgopts)
  78 c
  79       integer lgetco
  80       integer taetco(lgetco)
  81 c
  82       integer ulsort, langue, codret
  83 c
  84 c 0.4. ==> variables locales
  85 c
  86       integer codava
  87       integer nrosec
  88       integer nretap, nrsset
  89       integer iaux
  90 c
  91       character*6 saux
  92 c
  93       integer nbmess
  94       parameter ( nbmess = 10 )
  95       character*80 texte(nblang,nbmess)
  96 c
  97 c====
  98 c 1. messages
  99 c====
 100 c
 101       codava = codret
 102 c
 103 c=======================================================================
 104       if ( codava.eq.0 ) then
 105 c=======================================================================
 106 c
 107 c 1.1. ==> le debut des mesures de temps
 108 c
 109       nrosec = taetco(4)
 110       call gtdems (nrosec)
 111 c
 112 c 1.3. ==> les messages
 113 c
 114 #include "impr01.h"
 115 c
 116 #ifdef _DEBUG_HOMARD_
 117       write (ulsort,texte(langue,1)) 'Entree', nompro
 118       call dmflsh (iaux)
 119 #endif
 120 c
 121       texte(1,4) =
 122      > '(/,a6,'' LECTURE DE L''''INDICATEUR D''''ERREUR'')'
 123       texte(1,5) = '(39(''=''),/)'
 124       texte(1,6) = '(''Mauvais code de calcul :'',i5)'
 125 c
 126       texte(2,4) = '(/,a6,'' READINGS OF ERROR INDICATOR'')'
 127       texte(2,5) = '(34(''=''),/)'
 128       texte(2,6) = '(''Bad related code:'',i5)'
 129 c
 130 c 1.4. ==> le numero de sous-etape
 131 c
 132       nretap = taetco(1)
 133       nrsset = taetco(2) + 1
 134       taetco(2) = nrsset
 135 c
 136       call utcvne ( nretap, nrsset, saux, iaux, codret )
 137 c
 138 c 1.5. ==> le titre
 139 c
 140       write (ulsort,texte(langue,4)) saux
 141       write (ulsort,texte(langue,5))
 142 c
 143 c====
 144 c 2. lecture de l'indicateur
 145 c====
 146 c
 147 c 2.1. ==> format med
 148 c
 149       if ( mod(taopti(11)-6,10).eq.0 ) then
 150 c
 151 #ifdef _DEBUG_HOMARD_
 152       write (ulsort,texte(langue,3)) 'ESLIMD', nompro
 153 #endif
 154         call eslimd ( taopts(7),
 155      >                taopti(13), taopti(14), taoptr(10),
 156      >                taopti(15), taopti(16), taopti(17),
 157      >                taopti(9),
 158      >                ulsort, langue, codret)
 159 #ifdef _DEBUG_HOMARD_
 160       call gmprsx ( nompro, taopts(7))
 161       call gmprsx ( nompro, taopts(7)//'.InfoPaFo')
 162       call gmprsx ( nompro, '%%%%%%14')
 163       call gmprsx ( nompro, '%%%%%%15')
 164       call gmprsx ( nompro, '%%%%%%15.TypeSuAs')
 165 #endif
 166 c
 167 c 2.2. ==> mauvais type
 168 c
 169       else
 170 c
 171         codret = 5
 172 c
 173       endif
 174 c
 175    20 continue
 176 c
 177 c====
 178 c 3. la fin
 179 c====
 180 c
 181 c 3.1. ==> message si erreur
 182 c
 183       if ( codret.ne.0 ) then
 184 c
 185 #include "envex2.h"
 186 c
 187       write (ulsort,texte(langue,1)) 'Sortie', nompro
 188       write (ulsort,texte(langue,2)) codret
 189       if ( codret.eq.5 ) then
 190         write (ulsort,texte(langue,6)) taopti(11)
 191       endif
 192 c
 193       endif
 194 c
 195 c 3.2. ==> fin des mesures de temps de la section
 196 c
 197       call gtfims (nrosec)
 198 c
 199 #ifdef _DEBUG_HOMARD_
 200       write (ulsort,texte(langue,1)) 'Sortie', nompro
 201       call dmflsh (iaux)
 202 #endif
 203 c
 204 c=======================================================================
 205       endif
 206 c=======================================================================
 207 c
 208       end