src/tool/Utilitaire/utsext.F

   1       subroutine utsext ( nocsol, option, typcca,
   2      >                    lgetco, taetco,
   3      >                    ulsort, langue, codret)
   4 c ______________________________________________________________________
   5 c
   6 c                             H O M A R D
   7 c
   8 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   9 c
  10 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  11 c aupres des huissiers de justice Simart et Lavoir a Clamart
  12 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  13 c aupres des huissiers de justice
  14 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  15 c
  16 c    HOMARD est une marque deposee d'Electricite de France
  17 c
  18 c Copyright EDF 1996
  19 c Copyright EDF 1998
  20 c Copyright EDF 2002
  21 c Copyright EDF 2020
  22 c ______________________________________________________________________
  23 c
  24 c    UTilitaire - Solution - EXTrusion
  25 c    --           -          ---
  26 c ______________________________________________________________________
  27 c .        .     .        .                                            .
  28 c .  nom   . e/s . taille .           description                      .
  29 c .____________________________________________________________________.
  30 c . nocsol . e   . char8  . nom de l'objet solution a modifier         .
  31 c . option . e   .    1   . option de la modification                  .
  32 c .        .     .        . 1 : passage du 3D au 2D                    .
  33 c .        .     .        . 2 : passage du 2D au 3D                    .
  34 c . typcca . e   .   1    . type du code de calcul                     .
  35 c .        .     .        .    26 : SATURNE_2D (format MED)            .
  36 c .        .     .        .    36 : SATURNE (format MED)               .
  37 c .        .     .        .    46 : NEPTUNE_2D (format MED)            .
  38 c .        .     .        .    56 : NEPTUNE (format MED)               .
  39 c .        .     .        .    66 : CARMEL_2D (format MED)             .
  40 c .        .     .        .    76 : CARMEL (format MED)                .
  41 c . lgetco . e   .   1    . longueur du tableau de l'etat courant      .
  42 c . taetco . e   . lgetco . tableau de l'etat courant                  .
  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 .        .     .        . 5 : mauvais type de code de calcul associe .
  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 = 'UTSEXT' )
  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 option, typcca
  72 c
  73       character*8 nocsol
  74 c
  75       integer lgetco
  76       integer taetco(lgetco)
  77 c
  78       integer ulsort, langue, codret
  79 c
  80 c 0.4. ==> variables locales
  81 c
  82       integer codava
  83       integer nretap, nrsset
  84       integer iaux
  85 c
  86       integer sdimav, sdimap
  87 c
  88       character*6 saux
  89       character*9 saux09
  90 c
  91       integer nbmess
  92       parameter ( nbmess = 10 )
  93       character*80 texte(nblang,nbmess)
  94 c
  95 c 0.5. ==> initialisations
  96 c ______________________________________________________________________
  97 c
  98       codava = codret
  99 c
 100 c=======================================================================
 101       if ( codava.eq.0 ) then
 102 c=======================================================================
 103 c
 104 c====
 105 c 1. messages
 106 c====
 107 c
 108 #include "impr01.h"
 109 c
 110 #ifdef _DEBUG_HOMARD_
 111       write (ulsort,texte(langue,1)) 'Entree', nompro
 112       call dmflsh (iaux)
 113 #endif
 114 c
 115       if ( typcca.eq.26 ) then
 116         saux09 = 'SATURNE  '
 117       elseif ( typcca.eq.46 ) then
 118         saux09 = 'NEPTUNE  '
 119       else
 120         saux09 = 'EXTRUSION'
 121       endif
 122 c
 123       texte(1,4) =
 124      > '(/,a6,1x,'''//saux09//' - PASSAGE DU CHAMP '',i1,
 125      > ''D EN '',i1,''D'')'
 126       texte(1,5) = '(44(''=''),/)'
 127       texte(1,6) = '(''Option de conversion '',i8,'' invalide.'')'
 128       texte(1,7) = '(''Il faut 1 ou 2.'')'
 129 c
 130       texte(2,4) = '(/,a6,1x,'''//saux09//' - FROM '',i1,
 131      > ''D FIELD TO '',i1,''D'')'
 132       texte(2,5) = '(38(''=''),/)'
 133       texte(2,6) = '(''Option for conversion '',i8,'' is uncorrect.'')'
 134       texte(2,7) = '(''1 or 2 is needed.'')'
 135 c
 136 c 1.4. ==> le numero de sous-etape
 137 c
 138       nretap = taetco(1)
 139       nrsset = taetco(2) + 1
 140       taetco(2) = nrsset
 141 c
 142       call utcvne ( nretap, nrsset, saux, iaux, codret )
 143 c
 144 c 1.5 ==> le titre
 145 c
 146       if ( option.eq.1 ) then
 147         sdimav = 3
 148         sdimap = 2
 149       elseif ( option.eq.2 ) then
 150         sdimav = 2
 151         sdimap = 3
 152       else
 153         sdimav = 0
 154         sdimap = 0
 155         codret = 1
 156       endif
 157 c
 158       write (ulsort,texte(langue,4)) saux, sdimav, sdimap
 159       write (ulsort,texte(langue,5))
 160 c
 161       if ( codret.eq.1 ) then
 162         write (ulsort,texte(langue,6)) option
 163         write (ulsort,texte(langue,7))
 164       endif
 165 c
 166 #include "impr03.h"
 167 c
 168 c====
 169 c 2. conversion de la solution
 170 c====
 171 c
 172       if ( codret.eq.0 ) then
 173 c
 174 #ifdef _DEBUG_HOMARD_
 175       write (ulsort,texte(langue,3)) 'UTSEX0', nompro
 176 #endif
 177       call utsex0 ( nocsol, option,
 178      >              ulsort, langue, codret )
 179 c
 180       endif
 181 c
 182 c====
 183 c 3. la fin
 184 c====
 185 c
 186       if ( codret.ne.0 ) then
 187 c
 188 #include "envex2.h"
 189 c
 190       write (ulsort,texte(langue,1)) 'Sortie', nompro
 191       write (ulsort,texte(langue,2)) codret
 192 c
 193       endif
 194 c
 195 #ifdef _DEBUG_HOMARD_
 196       write (ulsort,texte(langue,1)) 'Sortie', nompro
 197       call dmflsh (iaux)
 198 #endif
 199 c
 200 c=======================================================================
 201       endif
 202 c=======================================================================
 203 c
 204       end