src/tool/Utilitaire/utcapf.F

   1       subroutine utcapf ( obpafo,
   2      >                    nbfopa, typgpf, ngauss, carsup, typint,
   3      >                    adobfo, adtyge,
   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    UTilitaire - CAracteristiques d'un Paquet de Fonctions
  26 c    --           --                    -         -
  27 c ______________________________________________________________________
  28 c .        .     .        .                                            .
  29 c .  nom   . e/s . taille .           description                      .
  30 c .____________________________________________________________________.
  31 c . obpafo . e   . char8  . nom de l'objet du paquet de fonctions      .
  32 c . nbfopa .   s .   1    . nombre de fonctions dans le paquet         .
  33 c . typgpf .  s  .   1    . si >0 : type geometrique s'il est unique   .
  34 c .        .     .        . si <0 : nombre de type geometriques associe.
  35 c . ngauss .   s .   1    . nombre de points de gauss                  .
  36 c . carsup .   s .   1    . caracteristiques du support                .
  37 c .        .     .        . 1, si aux noeuds par elements              .
  38 c .        .     .        . 2, si aux points de Gauss, associe avec    .
  39 c .        .     .        .    n champ aux noeuds par elements         .
  40 c .        .     .        . 3 si aux points de Gauss autonome          .
  41 c .        .     .        . 0, sinon                                   .
  42 c . typint .   s .   s    . type d'interpolation                       .
  43 c .        .     .        .  0, si automatique                         .
  44 c .        .     .        .  elements : 0 si intensif, sans orientation.
  45 c .        .     .        .             1 si extensif, sans orientation.
  46 c .        .     .        .             2 si intensif, avec orientation.
  47 c .        .     .        .             3 si extensif, avec orientation.
  48 c .        .     .        .  noeuds : 1 si degre 1                     .
  49 c .        .     .        .           2 si degre 2                     .
  50 c .        .     .        .           3 si iso-P2                      .
  51 c . adobfo .   s .   1    . adresse des noms des objets 'Fonction' et  .
  52 c .        .     .        . de l'eventuel paquet associe               .
  53 c . adtyge .   s .   1    . adresse des types geometriques             .
  54 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  55 c . langue . e   .    1   . langue des messages                        .
  56 c .        .     .        . 1 : francais, 2 : anglais                  .
  57 c . codret . es  .    1   . code de retour des modules                 .
  58 c .        .     .        . 0 : pas de probleme                        .
  59 c .        .     .        . 1 : probleme                               .
  60 c ______________________________________________________________________
  61 c
  62 c====
  63 c 0. declarations et dimensionnement
  64 c====
  65 c
  66 c 0.1. ==> generalites
  67 c
  68       implicit none
  69       save
  70 c
  71       character*6 nompro
  72       parameter ( nompro = 'UTCAPF' )
  73 c
  74 #include "nblang.h"
  75 c
  76 c 0.2. ==> communs
  77 c
  78 #include "envex1.h"
  79 c
  80 c 0.3. ==> arguments
  81 c
  82       character*8 obpafo
  83 c
  84       integer nbfopa, typgpf, ngauss, carsup, typint
  85       integer adobfo, adtyge
  86 c
  87       integer ulsort, langue, codret
  88 c
  89 c 0.4. ==> variables locales
  90 c
  91       integer iaux
  92       integer codre1, codre2, codre3, codre4, codre5
  93       integer codre0
  94 c
  95       integer nbmess
  96       parameter ( nbmess = 10 )
  97       character*80 texte(nblang,nbmess)
  98 c
  99 c 0.5. ==> initialisations
 100 c ______________________________________________________________________
 101 c
 102 c====
 103 c 1. initialisations
 104 c====
 105 c
 106 c 1.1. ==> messages
 107 c
 108 #include "impr01.h"
 109 c
 110 #ifdef _DEBUG_HOMARD_
 111       write (ulsort,texte(langue,1)) 'Entree', nompro
 112       call dmflsh (iaux)
 113 #endif
 114 c
 115       texte(1,4) =
 116      > '(''Impossible de lire les attributs de l''''objet '',a)'
 117       texte(1,5) =
 118      > '(''Impossible de lire les valeurs de l''''objet '',a)'
 119 c
 120       texte(2,4) = '(''Attributes of object '',a,'' cannot be read.'')'
 121       texte(2,5) = '(''Values of object '',a,'' cannot be read.'')'
 122 c
 123 #ifdef _DEBUG_HOMARD_
 124       call gmprsx (nompro, obpafo )
 125       call gmprsx (nompro, obpafo//'.Fonction' )
 126 #endif
 127 c
 128       codret = 0
 129 c
 130 c====
 131 c 2. caracteristiques du paquet de fonctions
 132 c====
 133 c
 134       call gmliat ( obpafo, 1, nbfopa, codre1 )
 135       call gmliat ( obpafo, 2, typgpf, codre2 )
 136       call gmliat ( obpafo, 3, ngauss, codre3 )
 137       call gmliat ( obpafo, 4, carsup, codre4 )
 138       call gmliat ( obpafo, 5, typint, codre5 )
 139 c
 140       codre0 = min ( codre1, codre2, codre3, codre4, codre5 )
 141       codret = max ( abs(codre0), codret,
 142      >               codre1, codre2, codre3, codre4, codre5 )
 143 c
 144       if ( codret.ne.0 ) then
 145       write (ulsort,texte(langue,4)) obpafo
 146       endif
 147 c
 148 c====
 149 c 3. les branches
 150 c====
 151 #ifdef _DEBUG_HOMARD_
 152       write (ulsort,*) '3. branches ; codret = ', codret
 153 #endif
 154 c
 155       if ( codret.eq.0 ) then
 156 c
 157       call gmadoj ( obpafo//'.Fonction', adobfo, iaux, codret )
 158 c
 159       if ( codret.ne.0 ) then
 160       write (ulsort,texte(langue,5)) obpafo
 161       endif
 162 c
 163       endif
 164 c
 165       if ( typgpf.lt.0 ) then
 166 c
 167         if ( codret.eq.0 ) then
 168 c
 169         call gmadoj ( obpafo//'.TypeSuAs', adtyge, iaux, codret )
 170 c
 171         if ( codret.ne.0 ) then
 172         write (ulsort,texte(langue,5)) obpafo
 173         endif
 174 c
 175         endif
 176 c
 177       endif
 178 c
 179 c====
 180 c 4. la fin
 181 c====
 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 c
 190       endif
 191 c
 192 #ifdef _DEBUG_HOMARD_
 193       write (ulsort,texte(langue,1)) 'Sortie', nompro
 194       call dmflsh (iaux)
 195 #endif
 196 c
 197       end