src/tool/Utilitaire/utindh.F

   1       subroutine utindh ( typpro, ulsort, langue, 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   UTilitaire : INitialisation des Donnees de HOMARD
  23 c   --           --                 -          -
  24 c ______________________________________________________________________
  25 c .        .     .        .                                            .
  26 c .  nom   . e/s . taille .           description                      .
  27 c .____________________________________________________________________.
  28 c . typpro . e   .    1   . type de programme                          .
  29 c .        .     .        . 1 : homard complet                         .
  30 c .        .     .        . 2 : interface avant adaptation             .
  31 c .        .     .        . 3 : adaptation                             .
  32 c .        .     .        . 4 : suivi de frontiere                     .
  33 c .        .     .        . 5 : interface apres adaptation             .
  34 c .        .     .        . 6 : information                            .
  35 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  36 c . langue . e   .    1   . langue des messages                        .
  37 c .        .     .        . 1 : francais, 2 : anglais                  .
  38 c . codret . es  .    1   . code de retour des modules                 .
  39 c .        .     .        . 0 : pas de probleme                        .
  40 c .        .     .        . 2 : impossible d'allouer la tete           .
  41 c .        .     .        . 4 : impossible d'allouer les objets simples.
  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 = 'UTINDH' )
  55 c
  56 #include "nblang.h"
  57 c
  58 c 0.2. ==> communs
  59 c
  60 #include "envex1.h"
  61 c
  62 #include "cndoad.h"
  63 c
  64 #include "gmenti.h"
  65 c
  66 c 0.3. ==> arguments
  67 c
  68       integer typpro
  69       integer ulsort, langue, codret
  70 c
  71 c 0.4. ==> variables locales
  72 c
  73       integer iaux
  74       integer codre1, codre2
  75       integer codre0
  76       integer adress
  77 c
  78       character*200 nomobj
  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. messages
  89 c====
  90 c
  91 c 1.1. ==> tout va bien
  92 c
  93       codret = 0
  94 c
  95 c 1.2. ==> les messages,
  96 c
  97 #include "impr01.h"
  98 c
  99 #ifdef _DEBUG_HOMARD_
 100       write (ulsort,texte(langue,1)) 'Entree', nompro
 101       call dmflsh (iaux)
 102 #endif
 103 c
 104       texte(1,10) =
 105      > '(''Impossible d''''allouer la tete de type DonnHOMA.'')'
 106       texte(1,4) = '(''Impossible d''''allouer l''''objet :'')'
 107 c
 108       texte(2,10) =
 109      > '(''Head object of type DonnHOMA cannot be allocated.'')'
 110       texte(2,4) = '(''This object cannot be allocated :'')'
 111 c
 112 c====
 113 c 2. Les options
 114 c====
 115 c
 116 c 2.1. ==> allocation de l'objet de tete
 117 c
 118       call gmalot ( nndoad, 'DonnHOMA', 0, iaux, codre0 )
 119 c
 120       if ( codre0.ne.0 ) then
 121         codret = 2
 122       endif
 123 c
 124 c 2.2. ==> allocation des options entieres
 125 c
 126       if ( codret.eq.0 ) then
 127 c
 128         nomobj = nndoad//'.OptEnt'
 129         iaux = 50
 130         call gmecat ( nndoad, 1, iaux, codre1 )
 131         call gmaloj ( nomobj, ' ', iaux, adress, codre2 )
 132 c
 133         codre0 = min ( codre1, codre2 )
 134         codret = max ( abs(codre0), codret,
 135      >                 codre1, codre2 )
 136 c
 137         if ( codret.ne.0 ) then
 138           codret = 4
 139         else
 140           imem(adress) = langue
 141         endif
 142 c
 143       endif
 144 c
 145 c 2.3. ==> allocation des options reelles
 146 c
 147       if ( codret.eq.0 ) then
 148 c
 149         nomobj = nndoad//'.OptRee'
 150         iaux = 20
 151         call gmecat ( nndoad, 2, iaux, codre1 )
 152         call gmaloj ( nomobj, ' ', iaux, adress, codre2 )
 153 c
 154         codre0 = min ( codre1, codre2 )
 155         codret = max ( abs(codre0), codret,
 156      >                 codre1, codre2 )
 157 c
 158         if ( codret.ne.0 ) then
 159           codret = 4
 160         endif
 161 c
 162       endif
 163 c
 164 c 2.4. ==> allocation des options caracteres
 165 c
 166       if ( codret.eq.0 ) then
 167 c
 168         nomobj = nndoad//'.OptCar'
 169         iaux = 40
 170         call gmecat ( nndoad, 3, iaux, codre1 )
 171         call gmaloj ( nomobj, ' ', iaux, adress, codre2 )
 172 c
 173         codre0 = min ( codre1, codre2 )
 174         codret = max ( abs(codre0), codret,
 175      >                 codre1, codre2 )
 176 c
 177         if ( codret.ne.0 ) then
 178           codret = 4
 179         endif
 180 c
 181       endif
 182 c
 183 c 2.5. ==> allocation de l'etat courant
 184 c
 185       if ( codret.eq.0 ) then
 186 c
 187         nomobj = nndoad//'.EtatCour'
 188         iaux = 10
 189         call gmecat ( nndoad, 4, iaux, codre1 )
 190         call gmaloj ( nomobj, ' ', iaux, adress, codre2 )
 191 c
 192         codre0 = min ( codre1, codre2 )
 193         codret = max ( abs(codre0), codret,
 194      >                 codre1, codre2 )
 195 c
 196         if ( codret.ne.0 ) then
 197           codret = 4
 198         else
 199           imem(adress) = 1
 200           imem(adress+1) = 1
 201           imem(adress+2) = 10
 202           imem(adress+3) = 10
 203         endif
 204 c
 205       endif
 206 c
 207 c 2.6. ==> le type de programme
 208 c
 209       if ( codret.eq.0 ) then
 210 c
 211         call gmecat ( nndoad, 5, typpro, codret )
 212 c
 213         if ( codret.ne.0 ) then
 214           codret = 4
 215         endif
 216 c
 217       endif
 218 c
 219 #ifdef _DEBUG_HOMARD_
 220       call gmprsx (nompro, nndoad )
 221       call gmprsx (nompro, nndoad//'.OptEnt' )
 222       call gmprsx (nompro, nndoad//'.OptRee' )
 223       call gmprsx (nompro, nndoad//'.OptCar' )
 224       call gmprsx (nompro, nndoad//'.EtatCour' )
 225 #endif
 226 c
 227 c====
 228 c 3. la fin
 229 c====
 230 c
 231       if ( codret.ne.0 ) then
 232 c
 233 #include "envex2.h"
 234 c
 235       write (ulsort,texte(langue,1)) 'Sortie', nompro
 236         write (ulsort,texte(langue,2)) codret
 237         if ( codret.eq.2 ) then
 238           write (ulsort,texte(langue,10))
 239         else
 240           write (ulsort,texte(langue,4))
 241           write (ulsort,*) nomobj
 242         endif
 243 c
 244       endif
 245 c
 246 #ifdef _DEBUG_HOMARD_
 247       write (ulsort,texte(langue,1)) 'Sortie', nompro
 248       call dmflsh (iaux)
 249 #endif
 250 c
 251       end