src/tool/ES_HOMARD/esecno.F

   1       subroutine esecno ( idfmed, nomamd,
   2      >                    nhnoeu,
   3      >                    numdt, numit, instan,
   4      >                    ltbiau, tbiaux,
   5      >                    ulsort, langue, codret)
   6 c
   7 c ______________________________________________________________________
   8 c
   9 c                             H O M A R D
  10 c
  11 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  12 c
  13 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  14 c aupres des huissiers de justice Simart et Lavoir a Clamart
  15 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  16 c aupres des huissiers de justice
  17 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  18 c
  19 c    HOMARD est une marque deposee d'Electricite de France
  20 c
  21 c Copyright EDF 1996
  22 c Copyright EDF 1998
  23 c Copyright EDF 2002
  24 c Copyright EDF 2020
  25 c ______________________________________________________________________
  26 c
  27 c  Entree-Sortie : ECriture des NOeuds
  28 c  -      -        --           --
  29 c ______________________________________________________________________
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . idfmed . e   .   1    . identificateur du fichier MED              .
  33 c . nomamd . e   . char64 . nom du maillage MED voulu                  .
  34 c . ltbiau . e   .    1   . longueur allouee a tbiaux                  .
  35 c . tbiaux .     .    *   . tableau tampon entier                      .
  36 c . numdt  . e   .   1    . numero du pas de temps                     .
  37 c . numit  . e   .   1    . numero d'iteration                         .
  38 c . instan . e   .   1    . pas de temps                               .
  39 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  40 c . langue . e   .    1   . langue des messages                        .
  41 c .        .     .        . 1 : francais, 2 : anglais                  .
  42 c . codret . es  .    1   . code de retour des modules                 .
  43 c .        .     .        . 0 : pas de probleme                        .
  44 c ______________________________________________________________________
  45 c
  46 c====
  47 c 0. declarations et dimensionnement
  48 c====
  49 c
  50 c 0.1. ==> generalites
  51 c
  52       implicit none
  53       save
  54 c
  55       character*6 nompro
  56       parameter ( nompro = 'ESECNO' )
  57 c
  58 #include "nblang.h"
  59 #include "consts.h"
  60 c
  61 c 0.2. ==> communs
  62 c
  63 #include "envex1.h"
  64 #include "gmenti.h"
  65 #include "gmreel.h"
  66 c
  67 #include "envca1.h"
  68 #include "nombno.h"
  69 c
  70 c 0.3. ==> arguments
  71 c
  72       integer*8 idfmed
  73       integer numdt, numit
  74       integer ltbiau, tbiaux(*)
  75 c
  76       character*8 nhnoeu
  77       character*64 nomamd
  78 c
  79       double precision instan
  80 c
  81       integer ulsort, langue, codret
  82 c
  83 c 0.4. ==> variables locales
  84 c
  85 #include "meddc0.h"
  86 c
  87       integer iaux
  88       integer adcoor, adhist, adarno
  89       integer adhono, addera
  90       integer adcoco, adinfg
  91       integer adreco
  92       integer adfami, adcofa
  93 c
  94       integer nbmess
  95       parameter ( nbmess = 150 )
  96       character*80 texte(nblang,nbmess)
  97 c ______________________________________________________________________
  98 c
  99 c====
 100 c 1. messages
 101 c====
 102 c
 103 #include "impr01.h"
 104 c
 105 #ifdef _DEBUG_HOMARD_
 106       write (ulsort,texte(langue,1)) 'Entree', nompro
 107       call dmflsh (iaux)
 108 #endif
 109 c
 110       texte(1,4) = '(''. Ecriture des noeuds.'')'
 111 c
 112       texte(2,4) = '(''. Writings of nodes.'')'
 113 c
 114 #include "impr03.h"
 115 c
 116 #include "esimpr.h"
 117 c
 118 #ifdef _DEBUG_HOMARD_
 119       write (ulsort,texte(langue,4))
 120 #endif
 121 ccc      call gmprsx ( nompro, nhnoeu )
 122 ccc      call gmprsx ( nompro, nhnoeu//'.HistEtat' )
 123 c
 124 c====
 125 c 2. Adresses
 126 c====
 127 #ifdef _DEBUG_HOMARD_
 128       write (ulsort,texte(langue,3)) 'UTAD21', nompro
 129 #endif
 130       call utad21 ( nhnoeu,
 131      >              adcoor, adhist, adarno,
 132      >              adhono, addera,
 133      >              adcoco, adinfg,
 134      >              adreco,
 135      >              adfami, adcofa,
 136      >              ulsort, langue, codret )
 137 c
 138 c====
 139 c 3. Ecritures
 140 c====
 141 c 3.1. ==> Ecriture de la connectivite et des familles
 142 #ifdef _DEBUG_HOMARD_
 143       write (ulsort,90002) '3.1. connectivite ; codret', codret
 144 #endif
 145 c
 146       if ( codret.eq.0 ) then
 147 c
 148 #ifdef _DEBUG_HOMARD_
 149       write (ulsort,texte(langue,3)) 'ESEMNO', nompro
 150 #endif
 151       call esemno ( idfmed, nomamd,
 152      >              nbnoto, sdim, rmem(adcoor), imem(adfami),
 153      >              numdt, numit, instan,
 154      >              ulsort, langue, codret )
 155 c
 156       endif
 157 c
 158 c 3.2. ==> Ecriture des complements
 159 #ifdef _DEBUG_HOMARD_
 160       write (ulsort,90002) '3.2. complements ; codret', codret
 161 #endif
 162 c
 163       if ( codret.eq.0 ) then
 164 c
 165 #ifdef _DEBUG_HOMARD_
 166       write (ulsort,texte(langue,3)) 'ESECN1', nompro
 167 #endif
 168       call esecn1 ( idfmed, nomamd,
 169      >              adhist, adarno,
 170      >              adhono, addera,
 171      >              numdt, numit, instan,
 172      >              ltbiau, tbiaux,
 173      >              ulsort, langue, codret )
 174 c
 175       endif
 176 c
 177 c====
 178 c 4. la fin
 179 c====
 180 c
 181       if ( codret.ne.0 ) then
 182 c
 183 #include "envex2.h"
 184 c
 185       write (ulsort,texte(langue,1)) 'Sortie', nompro
 186       write (ulsort,texte(langue,2)) codret
 187 c
 188       endif
 189 c
 190 #ifdef _DEBUG_HOMARD_
 191       write (ulsort,texte(langue,1)) 'Sortie', nompro
 192       call dmflsh (iaux)
 193 #endif
 194 c
 195       end