src/tool/ES_MED/eses11.F

   1       subroutine eses11 ( idfmed, nomcha,
   2      >                    nbcomp, typcha,
   3      >                    nomcmp, unicmp,
   4      >                    dtunit, nomamd,
   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  Entree-Sortie - Ecriture d'une Solution au format MED - phase 1.1
  27 c  -      -        -              -                              - -
  28 c ______________________________________________________________________
  29 c .        .     .        .                                            .
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . idfmed . e   .   1    . identifiant du fichier med en sortie       .
  33 c . nomcha . e   . char64 . nom du champ                               .
  34 c . nbcomp . e   .    1   . nombre de composantes                      .
  35 c . typcha . e   .   1    . edin64/edfl64 selon entier/reel            .
  36 c . nomcmp . e   . nbcomp . noms des composantes                       .
  37 c . unicmp . e   . nbcomp . unites des composantes                     .
  38 c . dtunit . e   .   1    . unite des pas de temps                     .
  39 c . nomamd . e   . char64 . nom du maillage MED                        .
  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 .        .     .        . 1 : probleme                               .
  46 c ______________________________________________________________________
  47 c
  48 c====
  49 c 0. declarations et dimensionnement
  50 c====
  51 c
  52 c 0.1. ==> generalites
  53 c
  54       implicit none
  55       save
  56 c
  57       character*6 nompro
  58       parameter ( nompro = 'ESES11' )
  59 c
  60 #include "nblang.h"
  61 #include "consts.h"
  62 c
  63 #include "meddc0.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*8 idfmed
  72       integer nbcomp, typcha
  73 c
  74       character*64 nomcha
  75       character*16 nomcmp(nbcomp), unicmp(nbcomp)
  76       character*16 dtunit
  77       character*64 nomamd
  78 c
  79       integer ulsort, langue, codret
  80 c
  81 c 0.4. ==> variables locales
  82 c
  83       integer iaux
  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 #include "esimpr.h"
 104 c
 105       texte(1,4) = '(/,''Creation du champ : '',a)'
 106       texte(1,5) = '(''Type du champ : '',i2)'
 107       texte(1,6) =
 108      > '(''Numero !     Composante     !       Unite'',/,49(''-''))'
 109       texte(1,7) = '(i6,'' !  '',a16,''  !  '',a16)'
 110       texte(1,8) = '(''Unite du pas de temps : '',a)'
 111 c
 112       texte(2,4) = '(/,''Creation of field: '',a)'
 113       texte(2,5) = '(''Type of field: '',i2)'
 114       texte(2,6) =
 115      > '(''  #    !     Component      !       Unit'',/,49(''-''))'
 116       texte(2,7) = '(i6,'' !  '',a16,''  !  '',a16)'
 117       texte(2,8) = '(''Time step unity: '',a)'
 118 c
 119 #include "impr03.h"
 120 c
 121 c====
 122 c 2. creation du champ
 123 c====
 124 c
 125       call utlgut ( iaux, nomcha, ulsort, langue, codret )
 126 c
 127       if ( codret.eq.0 ) then
 128 c
 129       write (ulsort,texte(langue,4)) nomcha(1:iaux)
 130       write (ulsort,texte(langue,5)) typcha
 131       write (ulsort,texte(langue,6))
 132       do 20 , iaux = 1 , nbcomp
 133         write (ulsort,texte(langue,7)) iaux, nomcmp(iaux), unicmp(iaux)
 134    20 continue
 135       call utlgut ( iaux, dtunit, ulsort, langue, codret )
 136 c
 137       endif
 138 c
 139       if ( codret.eq.0 ) then
 140 c
 141       if ( iaux.gt.0 ) then
 142       write (ulsort,texte(langue,8)) dtunit
 143       endif
 144 c
 145       endif
 146 c
 147 c====
 148 c 3. creation du champ
 149 c====
 150 #ifdef _DEBUG_HOMARD_
 151       write (ulsort,90002) '3. creation du champ ; codret', codret
 152 #endif
 153 c
 154       if ( codret.eq.0 ) then
 155 c
 156 #ifdef _DEBUG_HOMARD_
 157       write (ulsort,texte(langue,3)) 'MFDCRE', nompro
 158 #endif
 159       call mfdcre ( idfmed, nomcha, typcha,
 160      >              nbcomp, nomcmp, unicmp,
 161      >              dtunit, nomamd, codret )
 162 c
 163       if ( codret.ne.0 ) then
 164         write (ulsort,texte(langue,13)) nomcha
 165       endif
 166 c
 167       endif
 168 c
 169 c====
 170 c 4. la fin
 171 c====
 172 c
 173       if ( codret.ne.0 ) then
 174 c
 175 #include "envex2.h"
 176 c
 177       write (ulsort,texte(langue,1)) 'Sortie', nompro
 178       write (ulsort,texte(langue,2)) codret
 179 c
 180       endif
 181 c
 182 #ifdef _DEBUG_HOMARD_
 183       write (ulsort,texte(langue,1)) 'Sortie', nompro
 184       call dmflsh (iaux)
 185 #endif
 186 c
 187       end