src/tool/AV_Conversion/vcind2.F

   1       subroutine vcind2 ( nrfonc,
   2      >                    caraca,
   3      >                    advalr, nbtafo, nbenmx, nbpg, tyelho,
   4      >                    adlipr, nbvapr,
   5      >                    ulsort, langue, codret)
   6 c ______________________________________________________________________
   7 c
   8 c                             H O M A R D
   9 c
  10 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  11 c
  12 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  13 c aupres des huissiers de justice Simart et Lavoir a Clamart
  14 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  15 c aupres des huissiers de justice
  16 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  17 c
  18 c    HOMARD est une marque deposee d'Electricite de France
  19 c
  20 c Copyright EDF 1996
  21 c Copyright EDF 1998
  22 c Copyright EDF 2002
  23 c Copyright EDF 2020
  24 c ______________________________________________________________________
  25 c
  26 c    aVant adaptation - Conversion d'INDicateur - phase 2
  27 c     -                 -            ---                -
  28 c recuperation des caracteristiques du n-eme tableau de valeurs
  29 c ______________________________________________________________________
  30 c .        .     .        .                                            .
  31 c .  nom   . e/s . taille .           description                      .
  32 c .____________________________________________________________________.
  33 c . nrfonc . e   .   1    . numero de la fonction en cours             .
  34 c . caraca . e   . nbincc*. caracteristiques caracteres des tableaux   .
  35 c .        .     . nbsqch . du champ en cours d'examen                 .
  36 c .        .     .        . 1. nom de l'objet fonction                 .
  37 c .        .     .        . 2. nom de l'objet profil, blanc sinon      .
  38 c .        .     .        . 3. nom de l'objet localisation des points  .
  39 c .        .     .        . de Gauss, blanc sinon                      .
  40 c . advalr .   s .   1    . adresse des valeurs reelles                .
  41 c . nbtafo .   s .   1    . nombre de tableaux dans la fonction        .
  42 c . nbenmx .   s .   1    . nombre d'entites maximum                   .
  43 c . nbpg   .   s .   1    . nombre de points de Gauss                  .
  44 c . tyelho .   s .   1    . type d'element au sens HOMARD              .
  45 c . nbvapr .   s .   1    . nombre de valeurs du profil                .
  46 c .        .     .        . -1, si pas de profil                       .
  47 c . adlipr .   s .   1    . adresse de la liste du profil              .
  48 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  49 c . langue . e   .    1   . langue des messages                        .
  50 c .        .     .        . 1 : francais, 2 : anglais                  .
  51 c . codret . es  .    1   . code de retour des modules                 .
  52 c .        .     .        . 0 : pas de probleme                        .
  53 c .        .     .        . 5 : mauvais type de code de calcul associe .
  54 c ______________________________________________________________________
  55 c
  56 c====
  57 c 0. declarations et dimensionnement
  58 c====
  59 c
  60 c 0.1. ==> generalites
  61 c
  62       implicit none
  63       save
  64 c
  65       character*6 nompro
  66       parameter ( nompro = 'VCIND2' )
  67 c
  68 #include "nblang.h"
  69 #include "consts.h"
  70 #include "meddc0.h"
  71 #include "esutil.h"
  72 c
  73 c 0.2. ==> communs
  74 c
  75 #include "envex1.h"
  76 c
  77 #include "rftmed.h"
  78 c
  79 c 0.3. ==> arguments
  80 c
  81       integer nrfonc
  82       integer advalr, nbtafo, nbenmx, nbpg
  83       integer adlipr, nbvapr
  84       integer tyelho
  85 c
  86       character*8 caraca(nbincc,*)
  87 c
  88       integer ulsort, langue, codret
  89 c
  90 c 0.4. ==> variables locales
  91 c
  92       integer typgeo, ngauss, nbtyas, carsup, typint
  93       integer iaux, jaux
  94       integer advale, adobch, adprpg, adtyas
  95 c
  96       character*8 nofonc, noprof
  97       character*200 profil
  98 c
  99       integer nbmess
 100       parameter ( nbmess = 10 )
 101       character*80 texte(nblang,nbmess)
 102 c
 103 c 0.5. ==> initialisations
 104 c ______________________________________________________________________
 105 c
 106 c====
 107 c 1. messages
 108 c====
 109 c
 110 #include "impr01.h"
 111 c
 112 #ifdef _DEBUG_HOMARD_
 113       write (ulsort,texte(langue,1)) 'Entree', nompro
 114       call dmflsh (iaux)
 115 #endif
 116 c
 117       texte(1,4) = '(''Nombre de points de Gauss : '',i5)'
 118       texte(1,5) = '(''On ne sait pas faire.'')'
 119       texte(1,6) = '(/,''Type d''''element HOMARD associe :'',i3)'
 120       texte(1,7) = '(''Pas de profil associe.'')'
 121       texte(1,8) = '(''Nombre de valeurs du profil :'',i10)'
 122 c
 123       texte(2,4) = '(''Number of Gauss points : '',i5)'
 124       texte(2,5) = '(''We cannot do it.'')'
 125       texte(2,6) = '(/,''HOMARD element :'',i3)'
 126       texte(2,7) = '(''No profile connected to the field.'')'
 127       texte(2,8) = '(''Number of values in profile :'',i10)'
 128 c
 129 c====
 130 c 2. caracteristiques de la fonction associee
 131 c====
 132 c
 133       if ( codret.eq.0 ) then
 134 c
 135       nofonc = caraca(1,nrfonc)
 136 c
 137 #ifdef _DEBUG_HOMARD_
 138       call gmprsx (nompro, nofonc )
 139 cgn      call gmprsx (nompro, nofonc//'.ValeursR' )
 140       call gmprot (nompro, nofonc//'.ValeursR', 1, 30 )
 141 #endif
 142 c
 143 #ifdef _DEBUG_HOMARD_
 144       write (ulsort,texte(langue,3)) 'UTCAFO', nompro
 145 #endif
 146       call utcafo ( nofonc,
 147      >              iaux,
 148      >              typgeo, ngauss, nbenmx, jaux, nbtyas,
 149      >              carsup, nbtafo, typint,
 150      >              advale, advalr, adobch, adprpg, adtyas,
 151      >              ulsort, langue, codret )
 152 c
 153       endif
 154 c
 155       if ( codret.eq.0 ) then
 156 c
 157       if ( ngauss.eq.ednopg ) then
 158         nbpg = 1
 159       elseif ( ngauss.gt.0 ) then
 160         nbpg = ngauss
 161       else
 162         write (ulsort,texte(langue,4)) ngauss
 163         write (ulsort,texte(langue,5))
 164         codret = 2
 165       endif
 166 c
 167       tyelho = medtrf(typgeo)
 168 #ifdef _DEBUG_HOMARD_
 169       write (ulsort,texte(langue,6)) tyelho
 170 #endif
 171 c
 172       endif
 173 cgn      print *,medtrf(102),medtrf(103)
 174 cgn      print *,medtrf(203),medtrf(206)
 175 cgn      print *,medtrf(304),medtrf(310)
 176 cgn      print *,'nrfonc, typgeo, tyelho = ',nrfonc, typgeo, tyelho
 177 c
 178 c====
 179 c 3. caracteristiques du profil associe
 180 c====
 181 c
 182       if ( codret.eq.0 ) then
 183 c
 184       noprof = caraca(2,nrfonc)
 185 cgn      print *,'noprof = ',noprof
 186 c
 187       if ( noprof.eq.'        ' ) then
 188 c
 189         nbvapr = -1
 190 c
 191 #ifdef _DEBUG_HOMARD_
 192         write (ulsort,texte(langue,7))
 193 #endif
 194 c
 195       else
 196 c
 197 #ifdef _DEBUG_HOMARD_
 198         call gmprsx (nompro, noprof )
 199         call gmprsx (nompro, noprof//'.NomProfi' )
 200         call gmprot (nompro, noprof//'.ListEnti', 1, 10 )
 201 #endif
 202 c
 203 #ifdef _DEBUG_HOMARD_
 204       write (ulsort,texte(langue,3)) 'UTCAPR', nompro
 205 #endif
 206         call utcapr ( noprof,
 207      >                nbvapr, profil, adlipr,
 208      >                ulsort, langue, codret )
 209 c
 210 #ifdef _DEBUG_HOMARD_
 211         write (ulsort,texte(langue,8)) nbvapr
 212 #endif
 213 c
 214       endif
 215 c
 216       endif
 217 cgn      print *,'nbvapr = ',nbvapr
 218 c
 219 c====
 220 c 4. la fin
 221 c====
 222 c
 223       if ( codret.ne.0 ) then
 224 c
 225 #include "envex2.h"
 226 c
 227       write (ulsort,texte(langue,1)) 'Sortie', nompro
 228       write (ulsort,texte(langue,2)) codret
 229 c
 230       endif
 231 c
 232 #ifdef _DEBUG_HOMARD_
 233       write (ulsort,texte(langue,1)) 'Sortie', nompro
 234       call dmflsh (iaux)
 235 #endif
 236 c
 237       end