src/tool/ES_HOMARD/esecn1.F

   1       subroutine esecn1 ( idfmed, nomamd,
   2      >                    adhist, adarno,
   3      >                    adhono, addera,
   4      >                    numdt, numit, instan,
   5      >                    ltbiau, tbiaux,
   6      >                    ulsort, langue, codret)
   7 c
   8 c ______________________________________________________________________
   9 c
  10 c                             H O M A R D
  11 c
  12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  13 c
  14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  15 c aupres des huissiers de justice Simart et Lavoir a Clamart
  16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  17 c aupres des huissiers de justice
  18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  19 c
  20 c    HOMARD est une marque deposee d'Electricite de France
  21 c
  22 c Copyright EDF 1996
  23 c Copyright EDF 1998
  24 c Copyright EDF 2002
  25 c Copyright EDF 2020
  26 c ______________________________________________________________________
  27 c
  28 c  Entree-Sortie : ECriture des Noeuds - 1
  29 c  -      -        --           -        -
  30 c ______________________________________________________________________
  31 c .  nom   . e/s . taille .           description                      .
  32 c .____________________________________________________________________.
  33 c . idfmed . e   .   1    . identificateur du fichier MED              .
  34 c . nomamd . e   .   1    . nom du maillage MED voulu                  .
  35 c . ltbiau . e   .    1   . longueur allouee a tbiaux                  .
  36 c . tbiaux .     .    *   . tableau tampon entier                      .
  37 c . numdt  . e   .   1    . numero du pas de temps                     .
  38 c . numit  . e   .   1    . numero d'iteration                         .
  39 c . instan . e   .   1    . pas de temps                               .
  40 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  41 c . langue . e   .    1   . langue des messages                        .
  42 c .        .     .        . 1 : francais, 2 : anglais                  .
  43 c . codret . es  .    1   . code de retour des modules                 .
  44 c .        .     .        . 0 : pas de probleme                        .
  45 c ______________________________________________________________________
  46 c
  47 c====
  48 c 0. declarations et dimensionnement
  49 c====
  50 c
  51 c 0.1. ==> generalites
  52 c
  53       implicit none
  54       save
  55 c
  56       character*6 nompro
  57       parameter ( nompro = 'ESECN1' )
  58 c
  59 #include "nblang.h"
  60 #include "consts.h"
  61 c
  62 c 0.2. ==> communs
  63 c
  64 #include "envex1.h"
  65 #include "gmenti.h"
  66 c
  67 #include "enti01.h"
  68 #include "nombno.h"
  69 c
  70 c 0.3. ==> arguments
  71 c
  72       integer*8 idfmed
  73       integer adhist, adarno
  74       integer adhono, addera
  75       integer numdt, numit
  76       integer ltbiau, tbiaux(*)
  77 c
  78       character*64 nomamd
  79 c
  80       double precision instan
  81 c
  82       integer ulsort, langue, codret
  83 c
  84 c 0.4. ==> variables locales
  85 c
  86 #include "meddc0.h"
  87 c
  88       integer nbcmax
  89       parameter ( nbcmax = 20 )
  90 c
  91       integer iaux, jaux, kaux, laux
  92       integer adress(nbcmax)
  93       integer nbcomp
  94 c
  95       character*16 dtunit
  96       character*16 nomcmp(nbcmax), unicmp(nbcmax)
  97       character*64 nomcha
  98 c
  99       logical prem
 100 c
 101       integer nbmess
 102       parameter ( nbmess = 150 )
 103       character*80 texte(nblang,nbmess)
 104 c
 105 c 0.5. ==> initialisation
 106 c
 107       data prem / .true. /
 108 c ______________________________________________________________________
 109 c
 110 c====
 111 c 1. initialisation
 112 c====
 113 c 1.1. ==> messages
 114 c
 115 #include "impr01.h"
 116 c
 117 #ifdef _DEBUG_HOMARD_
 118       write (ulsort,texte(langue,1)) 'Entree', nompro
 119       call dmflsh (iaux)
 120 #endif
 121 c
 122       texte(1,4) = '(''... Ecriture des complements pour les noeuds'')'
 123 c
 124       texte(2,4) = '(''... Writings of additional terms for nodes'')'
 125 c
 126 #ifdef _DEBUG_HOMARD_
 127       write (ulsort,texte(langue,4))
 128 #endif
 129 c
 130 #include "esimpr.h"
 131 c
 132       texte(1,4) = '(/,''Creation du champ : '',a64)'
 133       texte(1,5) = '(''Type du champ : '',i2)'
 134       texte(1,6) =
 135      > '(''Numero !     Composante     !       Unite'',/,49(''-''))'
 136       texte(1,7) = '(i6,'' !  '',a16,''  !  '',a16)'
 137       texte(1,81) = '(''Longueur allouee pour tbiaux    : '',i10)'
 138       texte(1,82) = '(''Longueur necessaire pour tbiaux : '',i10)'
 139 c
 140       texte(2,4) = '(/,''Creation of field : '',a64)'
 141       texte(2,5) = '(''Type of field : '',i2)'
 142       texte(2,6) =
 143      > '(''  #    !     Component      !       Unit'',/,49(''-''))'
 144       texte(2,7) = '(i6,'' !  '',a16,''  !  '',a16)'
 145       texte(2,81) = '(''Allocated length for tbiaux    : '',i10)'
 146       texte(2,82) = '(''Used length for tbiaux : '',i10)'
 147 c
 148 c 1.2. ==> unites : non definies
 149 c
 150       if ( prem ) then
 151 c
 152         do 12 , iaux = 1 , nbcmax
 153           unicmp(iaux) = blan16
 154    12   continue
 155         prem = .false.
 156 c
 157       endif
 158 c
 159 c====
 160 c 2. Reperage des composantes en fonction de la presence des tableaux
 161 c====
 162 c
 163       if ( codret.eq.0 ) then
 164 c
 165       nbcomp = 0
 166 c
 167 c                         1234567890123456
 168       if ( adhist.ne.0 ) then
 169         nbcomp = nbcomp + 1
 170         adress(nbcomp) = adhist
 171         nomcmp(nbcomp) = 'HistEtat        '
 172       endif
 173 c
 174       if ( adarno.ne.0 ) then
 175         nbcomp = nbcomp + 1
 176         adress(nbcomp) = adarno
 177         nomcmp(nbcomp) = 'AretSupp        '
 178       endif
 179 c
 180       if ( adhono.ne.0 ) then
 181         nbcomp = nbcomp + 1
 182         adress(nbcomp) = adhono
 183         nomcmp(nbcomp) = 'Homologu        '
 184       endif
 185 c
 186       if ( addera.ne.0 ) then
 187         nbcomp = nbcomp + 1
 188         adress(nbcomp) = addera
 189         nomcmp(nbcomp) = 'Deraffin        '
 190       endif
 191 c
 192 #ifdef _DEBUG_HOMARD_
 193       write (ulsort,texte(langue,85)) nbcomp
 194 #endif
 195 c
 196       endif
 197 c
 198       if ( codret.eq.0 ) then
 199 c
 200       if ( nbnoto*nbcomp.gt.ltbiau ) then
 201         write (ulsort,texte(langue,85)) nbcomp
 202         write (ulsort,texte(langue,81)) ltbiau
 203         write (ulsort,texte(langue,82)) nbnoto*nbcomp
 204         codret = 7
 205       endif
 206 c
 207       endif
 208 c
 209 c====
 210 c 3. Ecritures
 211 c====
 212 c
 213       if ( nbcomp.gt.0 ) then
 214 c
 215 c 3.1. ==> Creation du champ
 216 c
 217       if ( codret.eq.0 ) then
 218 c
 219       nomcha = blan64
 220       nomcha(1:8) = suffix(3,-1)
 221 c
 222 #ifdef _DEBUG_HOMARD_
 223       write (ulsort,texte(langue,4)) nomcha
 224       write (ulsort,texte(langue,5)) edint
 225       write (ulsort,texte(langue,6))
 226       do 31 , iaux = 1 , nbcomp
 227         write (ulsort,texte(langue,7)) iaux, nomcmp(iaux), unicmp(iaux)
 228    31 continue
 229 #endif
 230 c
 231       iaux = edint
 232       dtunit = blan16
 233 c
 234 #ifdef _DEBUG_HOMARD_
 235       write (ulsort,texte(langue,3)) 'MFDCRE', nompro
 236 #endif
 237       call mfdcre ( idfmed, nomcha, iaux,
 238      >              nbcomp, nomcmp, unicmp, dtunit, nomamd, codret )
 239 c
 240       endif
 241 c
 242       endif
 243 c
 244 c 3.2. ==> Le tableau des valeurs du champ, en mode non entrelace.
 245 c    En fortran, cela correspond au stockage memoire suivant :
 246 c    tbiaux(1,1), tbiaux(2,1), tbiaux(3,1), ..., tbiaux(nbnoto,1),
 247 c    tbiaux(1,2), tbiaux(2,2), tbiaux(3,2), ..., tbiaux(nbnoto,2),
 248 c    ...
 249 c    tbiaux(1,nbcomp), tbiaux(2,nbcomp), ..., tbiaux(nbnoto,nbcomp)
 250 c    on a ainsi toutes les valeurs pour la premiere composante, puis
 251 c    toutes les valeurs pour la seconde composante, etc.
 252 c
 253       if ( codret.eq.0 ) then
 254 c
 255       do 32 , iaux = 1 , nbcomp
 256 c
 257         kaux = nbnoto*(iaux-1)
 258         laux = adress(iaux)-1
 259         do 321 , jaux = 1 , nbnoto
 260           tbiaux(kaux+jaux) = imem(laux+jaux)
 261   321   continue
 262 c
 263    32 continue
 264 c
 265       endif
 266 c
 267 c 3.3. ==> Ecriture des valeurs du champ
 268 c
 269       if ( codret.eq.0 ) then
 270 c
 271       iaux = 0
 272 #ifdef _DEBUG_HOMARD_
 273       write (ulsort,texte(langue,3)) 'MFDIVW', nompro
 274 #endif
 275       call mfdivw ( idfmed, nomcha,
 276      >              numdt, numit, instan,
 277      >              ednoeu, iaux, ednoin, edall,
 278      >              nbnoto, tbiaux, codret )
 279 c
 280       if ( codret.ne.0 ) then
 281         write (ulsort,texte(langue,19)) nomcha
 282       endif
 283 c
 284       endif
 285 c
 286 c====
 287 c 4. la fin
 288 c====
 289 c
 290       if ( codret.ne.0 ) then
 291 c
 292 #include "envex2.h"
 293 c
 294       write (ulsort,texte(langue,1)) 'Sortie', nompro
 295       write (ulsort,texte(langue,2)) codret
 296 c
 297       endif
 298 c
 299 #ifdef _DEBUG_HOMARD_
 300       write (ulsort,texte(langue,1)) 'Sortie', nompro
 301       call dmflsh (iaux)
 302 #endif
 303 c
 304       end