src/tool/ES_MED/esech3.F

   1       subroutine esech3 ( nrtafo,
   2      >                    nbtafo, nbpg, nbvalc, nbcomp,
   3      >                    vafonc, trav1,
   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  Entree-Sortie - Ecriture d'un CHamp au format MED - phase 3
  26 c  -      -        -             --                          -
  27 c  Ce programme est le symetrique de ESLCH5
  28 c  remarque : esech2 et esech3 sont des clones
  29 c             2 : double precision
  30 c             3 : entier
  31 c ______________________________________________________________________
  32 c .        .     .        .                                            .
  33 c .  nom   . e/s . taille .           description                      .
  34 c .____________________________________________________________________.
  35 c . nrtafo . es  .   1    . numero courant du tableau de la fonction   .
  36 c . nbcomp . e   .   1    . nombre de composantes du champ             .
  37 c . nbtafo . e   .   1    . nombre de tableaux de la fonction          .
  38 c . renume . e   .   *    . renumerotation des entites                 .
  39 c . nbvalc . e   .   1    . nombre de valeurs par composante           .
  40 c . nbpg   . e   .   1    . nombre de points de Gauss, s'il y en a     .
  41 c .        .     .        . si le champ est sans point de Gauss, nbpg  .
  42 c .        .     .        . vaut 1 pour aider au traitement            .
  43 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  44 c . langue . e   .    1   . langue des messages                        .
  45 c .        .     .        . 1 : francais, 2 : anglais                  .
  46 c . codret . es  .    1   . code de retour des modules                 .
  47 c .        .     .        . 0 : pas de probleme                        .
  48 c .        .     .        . 1 : probleme                               .
  49 c ______________________________________________________________________
  50 c
  51 c====
  52 c 0. declarations et dimensionnement
  53 c====
  54 c
  55 c 0.1. ==> generalites
  56 c
  57       implicit none
  58       save
  59 c
  60       character*6 nompro
  61       parameter ( nompro = 'ESECH3' )
  62 c
  63 #include "nblang.h"
  64 c
  65 c 0.2. ==> communs
  66 c
  67 #include "envex1.h"
  68 c
  69 c 0.3. ==> arguments
  70 c
  71       integer nrtafo
  72       integer nbtafo
  73       integer nbpg, nbvalc, nbcomp
  74 c
  75       integer trav1(nbpg,nbvalc,nbcomp)
  76       integer vafonc(nbtafo,nbpg,*)
  77 c
  78       integer ulsort, langue, codret
  79 c
  80 c 0.4. ==> variables locales
  81 c
  82       integer iaux
  83       integer nrcomp, nugaus
  84 c
  85       integer nbmess
  86       parameter ( nbmess = 150 )
  87       character*80 texte(nblang,nbmess)
  88 c
  89 c 0.5. ==> initialisations
  90 c ______________________________________________________________________
  91 c
  92 c====
  93 c 1. initialisations
  94 c====
  95 c
  96 #include "impr01.h"
  97 c
  98 #ifdef _DEBUG_HOMARD_
  99       write (ulsort,texte(langue,1)) 'Entree', nompro
 100       call dmflsh (iaux)
 101 #endif
 102 c
 103       texte(1,5) = '(''. Premiere valeur : '',i10)'
 104       texte(1,6) = '(''. Derniere valeur : '',i10)'
 105 c
 106       texte(2,5) = '(''. First value: '',i10)'
 107       texte(2,6) = '(''. Last value : '',i10)'
 108 c
 109 #include "impr03.h"
 110 c
 111 #include "esimpr.h"
 112 c
 113 #ifdef _DEBUG_HOMARD_
 114       write (ulsort,*) '============================================='
 115       write (ulsort,texte(langue,58)) nbvalc
 116       write (ulsort,90002) 'nbcomp', nbcomp
 117       write (ulsort,texte(langue,111)) nbtafo
 118       write (ulsort,texte(langue,57)) nbpg
 119       write (ulsort,90002) 'nrtafo', nrtafo
 120       write (ulsort,texte(langue,5)) vafonc(nrtafo,1,1)
 121       write (ulsort,texte(langue,6)) vafonc(nrtafo,nbpg,nbvalc)
 122 #endif
 123 c
 124 c====
 125 c    . Sans points de Gauss :
 126 c    Dans la phase de transfert dans les tableaux HOMARD, le tableau
 127 c    trav1 est declare ainsi : trav1(nbpg,nbensu,nbcomp), ce qui
 128 c    corrrespond a trav1(nbensu,nbcomp) sans points de Gauss.
 129 c
 130 c    En fortran, cela correspond au stockage memoire suivant :
 131 c    trav1(1,1), trav1(2,1), trav1(3,1), ..., trav1(nbensu,1),
 132 c    trav1(1,2), trav1(2,2), trav1(3,2), ..., trav1(nbensu,2),
 133 c    ...
 134 c    trav1(1,nbcomp), trav1(2,nbcomp), ..., trav1(nbensu,nbcomp)
 135 c    on a ainsi toutes les valeurs pour la premiere composante, puis
 136 c    toutes les valeurs pour la seconde composante, etc.
 137 c
 138 c    . Avec nbpg points de Gauss :
 139 c    Dans la phase de transfert dans les tableaux HOMARD, le tableau
 140 c    trav1 sera declare ainsi : trav1(nbpg,nbensu,nbcomp).
 141 c
 142 c    En fortran, cela correspond au stockage memoire suivant :
 143 c    trav1(1,1,1), trav1(2,1,1), ..., trav1(nbpg,1,1), trav1(1,2,1),
 144 c    trav1(2,2,1), ..., trav1(nbpg,2,1), trav1(1,3,1), ...,
 145 c    trav1(1,nbensu,1), trav1(2,nbensu,1), ..., trav1(nbpg,nbensu,1),
 146 c    trav1(1,1,2), trav1(2,1,2), ..., trav1(nbpg,1,2), trav1(1,2,2),
 147 c    trav1(2,2,2), ..., trav1(nbpg,2,2), trav1(1,3,2), ...,
 148 c    trav1(1,nbensu,2), trav1(2,nbensu,2), ..., trav1(nbpg,nbensu,2),
 149 c    ...
 150 c    trav1(1,1,nrcomp), trav1(2,1,nrcomp), ..., trav1(nbpg,1,nrcomp),
 151 c    trav1(1,2,nrcomp), trav1(2,2,nrcomp), ..., trav1(nbpg,2,nrcomp),
 152 c    trav1(1,3,nrcomp), ..., trav1(nbpg,nbensu,nrcomp)
 153 c    on a ainsi tous les points de Gauss de la premiere maille de la
 154 c    premiere composante, puis tous les points de Gauss de la
 155 c    deuxieme maille de la premiere composante, etc. jusqu'a la fin de
 156 c    la premiere composante. Ensuite on recommence avec la deuxieme
 157 c    composante.
 158 c
 159 c    . Remarque : C'est ce que MED appelle le mode non entrelace.
 160 c====
 161 c
 162       codret = 0
 163 c
 164       do 20 , nrcomp = 1 , nbcomp
 165 cgn            print *,'nrcomp,nrtafo,nbvalc = ',nrcomp,nrtafo,nbvalc
 166 c
 167         if ( nbpg.eq.1 ) then
 168           do 21 , iaux = 1 , nbvalc
 169 cgn      print *,'iaux = ',iaux
 170 cgn      print *,'vafonc(',nrtafo,',1,',iaux,') = ',vafonc(nrtafo,1,iaux)
 171             trav1(1,iaux,nrcomp) = vafonc(nrtafo,1,iaux)
 172 cgn            write(12,*) 'trav1 = ',trav1(1,iaux,nrcomp)
 173    21     continue
 174         else
 175           do 22 , iaux = 1 , nbvalc
 176             do 221 , nugaus = 1 , nbpg
 177               trav1(nugaus,iaux,nrcomp) = vafonc(nrtafo,nugaus,iaux)
 178   221       continue
 179    22     continue
 180         endif
 181 c
 182         nrtafo = nrtafo + 1
 183 c
 184    20 continue
 185 c
 186 #ifdef _DEBUG_HOMARD_
 187       write (ulsort,90002) 'nrtafo', nrtafo
 188 #endif
 189 c
 190 c====
 191 c 3. la fin
 192 c====
 193 c
 194       if ( codret.ne.0 ) then
 195 c
 196 #include "envex2.h"
 197 c
 198       write (ulsort,texte(langue,1)) 'Sortie', nompro
 199       write (ulsort,texte(langue,2)) codret
 200 c
 201       endif
 202 c
 203 #ifdef _DEBUG_HOMARD_
 204       write (ulsort,texte(langue,1)) 'Sortie', nompro
 205       call dmflsh (iaux)
 206 #endif
 207 c
 208       end