src/tool/Utilitaire/utsvm0.F

   1       subroutine utsvm0 ( typenh, option, nhenti, nosvmn,
   2      >                    ulsort, langue, codret )
   3 c ______________________________________________________________________
   4 c
   5 c                             H O M A R D
   6 c
   7 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   8 c
   9 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  10 c aupres des huissiers de justice Simart et Lavoir a Clamart
  11 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  12 c aupres des huissiers de justice
  13 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  14 c
  15 c    HOMARD est une marque deposee d'Electricite de France
  16 c
  17 c Copyright EDF 1996
  18 c Copyright EDF 1998
  19 c Copyright EDF 2002
  20 c Copyright EDF 2020
  21 c ______________________________________________________________________
  22 c
  23 c    UTilitaire - creation de SauVegardes du Maillage iteration N - 0
  24 c    --                       -  -           -                      -
  25 c ______________________________________________________________________
  26 c .        .     .        .                                            .
  27 c .  nom   . e/s . taille .           description                      .
  28 c .____________________________________________________________________.
  29 c . typenh . e   .   1    . code des entites au sens homard            .
  30 c .        .     .        .  -1 : noeuds                               .
  31 c .        .     .        .   0 : mailles-points                       .
  32 c .        .     .        .   1 : segments                             .
  33 c .        .     .        .   2 : triangles                            .
  34 c .        .     .        .   3 : tetraedres                           .
  35 c .        .     .        .   4 : quadrangles                          .
  36 c .        .     .        .   5 : pyramides                            .
  37 c .        .     .        .   6 : hexaedres                            .
  38 c .        .     .        .   7 : pentaedres                           .
  39 c . option . e   .   1    . option de pilotage des sauvegardes         .
  40 c .        .     .        . c'est un multiple des entiers suivants :   .
  41 c .        .     .        .  2 : Fille et HistEtat                     .
  42 c .        .     .        .  3 : EntiFamm                              .
  43 c .        .     .        .  5 : InfoSup2                              .
  44 c . nhenti . e   .  ch8   . nom de l'objet contenant l'entite          .
  45 c . nosvmn .   s .  ch8   . nom de l'objet contenant les sauvegardes du.
  46 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  47 c . langue . e   .    1   . langue des messages                        .
  48 c .        .     .        . 1 : francais, 2 : anglais                  .
  49 c . codret . es  .    1   . code de retour des modules                 .
  50 c .        .     .        . 0 : pas de probleme                        .
  51 c ______________________________________________________________________
  52 c
  53 c====
  54 c 0. declarations et dimensionnement
  55 c====
  56 c
  57 c 0.1. ==> generalites
  58 c
  59       implicit none
  60       save
  61 c
  62       character*6 nompro
  63       parameter ( nompro = 'UTSVM0' )
  64 c
  65 #include "nblang.h"
  66 c
  67 c 0.2. ==> communs
  68 c
  69 #include "envex1.h"
  70 #include "enti01.h"
  71 #include "impr02.h"
  72 c
  73 c 0.3. ==> arguments
  74 c
  75       integer typenh, option
  76       character*8 nhenti, nosvmn
  77 c
  78       integer ulsort, langue, codret
  79 c
  80 c 0.4. ==> variables locales
  81 c
  82       integer iaux
  83       integer codre1, codre2
  84       integer codre0
  85 c
  86       character*2 saux02
  87 c
  88       integer nbmess
  89       parameter ( nbmess = 10 )
  90       character*80 texte(nblang,nbmess)
  91 c
  92 c 0.5. ==> initialisations
  93 c ______________________________________________________________________
  94 c
  95 c====
  96 c 1. initialisations
  97 c====
  98 c
  99 c 1.1. ==> les messages
 100 c
 101 #include "impr01.h"
 102 c
 103 #ifdef _DEBUG_HOMARD_
 104       write (ulsort,texte(langue,1)) 'Entree', nompro
 105       call dmflsh (iaux)
 106 #endif
 107 c
 108       texte(1,4) =
 109      > '(''Sauvegardes des branches relatives aux '',a)'
 110       texte(1,5) = '(''Option :'',i10)'
 111 c
 112       texte(2,4) = '(''Saving of arrays for '',a)'
 113       texte(2,5) = '(''Option :'',i10)'
 114 c
 115 #ifdef _DEBUG_HOMARD_
 116       write (ulsort,texte(langue,4)) mess14(langue,3,typenh)
 117       write (ulsort,texte(langue,5)) option
 118 #endif
 119 c
 120 c 1.2. ==> types d'entites
 121 c
 122       saux02 = suffix(3,typenh)(1:2)
 123 c
 124       codret = 0
 125 c
 126 c====
 127 c 2. Sauvegarde
 128 c====
 129 c
 130       if ( option.ne.0 ) then
 131 c
 132 c 2.1. ==> Fille et Etat
 133 c
 134       if ( mod(option,2).eq.0 ) then
 135 c
 136       call gmcpoj ( nhenti//'.Fille',
 137      >              nosvmn//'.Fille_'//saux02, codre1 )
 138       call gmcpoj ( nhenti//'.HistEtat',
 139      >              nosvmn//'.HEtat_'//saux02, codre2 )
 140 c
 141       codre0 = min ( codre1, codre2 )
 142       codret = max ( abs(codre0), codret,
 143      >               codre1, codre2 )
 144 c
 145       endif
 146 c
 147 c 2.2. ==> Branche Famille
 148 c
 149       if ( mod(option,3).eq.0 ) then
 150 c
 151       call gmcpoj ( nhenti//'.Famille.EntiFamm',
 152      >              nosvmn//'.Famil_'//saux02, codre0 )
 153 c
 154       codret = max ( abs(codre0), codret )
 155 c
 156       endif
 157 c
 158 c 2.5. ==> Branche InfoSup2 (eventuellement)
 159 c
 160       if ( mod(option,5).eq.0 ) then
 161 c
 162       call gmobal ( nhenti//'.InfoSup2', codre1 )
 163 c
 164       if ( codre1.eq.0 ) then
 165         codre0 = 0
 166       elseif ( codre1.eq.2 ) then
 167         call gmcpoj ( nhenti//'.InfoSup2',
 168      >                nosvmn//'.Insu2_'//saux02, codre0 )
 169       else
 170         codre0 = 1
 171       endif
 172 c
 173       codret = max ( abs(codre0), codret )
 174 c
 175       endif
 176 c
 177       endif
 178 c
 179 c====
 180 c 4. la fin
 181 c====
 182 c
 183       if ( codret.ne.0 ) then
 184 c
 185 #include "envex2.h"
 186 c
 187       write (ulsort,texte(langue,1)) 'Sortie', nompro
 188       write (ulsort,texte(langue,2)) codret
 189       write(ulsort,texte(langue,4)) mess14(langue,3,typenh)
 190       call gmprsx (nompro,nhenti)
 191       call gmprsx (nompro,nosvmn)
 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       end