src/tool/Gestion_MTU/gumess.F

   1       subroutine gumess (ulmess, codret)
   2 c ______________________________________________________________________
   3 c
   4 c                             H O M A R D
   5 c
   6 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   7 c
   8 c Version originale enregistree le 18 juin 1996 sous le numero 96036
   9 c aupres des huissiers de justice Simart et Lavoir a Clamart
  10 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  11 c aupres des huissiers de justice
  12 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  13 c
  14 c    HOMARD est une marque deposee d'Electricite de France
  15 c
  16 c Copyright EDF 1996
  17 c Copyright EDF 1998
  18 c Copyright EDF 2002
  19 c Copyright EDF 2020
  20 c ______________________________________________________________________
  21 c
  22 c but : modifie le numero de l'unite logique des messages du
  23 c       gestionnaire d'unite logique
  24 c ______________________________________________________________________
  25 c .        .     .        .                                            .
  26 c .  nom   . e/s . taille .           description                      .
  27 c .____________________________________________________________________.
  28 c . ulmess . e   .   1    . unite logique de la sortie generale        .
  29 c . codret .  s  .    1   . 0 : tout va bien                           .
  30 c .        .     .        . 3 : problemes                              .
  31 c ______________________________________________________________________
  32 c
  33 c====
  34 c 0. declarations et dimensionnement
  35 c====
  36 c
  37 c 0.1. ==> generalites
  38 c
  39       implicit none
  40       save
  41 c
  42       character*6 nompro
  43       parameter ( nompro = 'GUMESS' )
  44 c
  45 #include "genbla.h"
  46 #include "gunbul.h"
  47 c
  48 c 0.2. ==> communs
  49 c
  50 c 0.3. ==> arguments
  51 c
  52       integer ulmess
  53       integer codret
  54 c
  55 c 0.4. ==> variables locales
  56 c
  57 #include "gulggt.h"
  58 c
  59       logical imprim
  60 c
  61       integer guimp, gmimp, raison
  62       integer iaux, ulsort
  63 c
  64       integer langue
  65       integer typarr
  66 c
  67       integer code
  68       integer gunmbr(lgunmb)
  69       integer statut(mbmxul), lnomfi(mbmxul)
  70 c
  71       character*200 nomfic(mbmxul)
  72 c
  73       integer nbmess
  74       parameter ( nbmess = 10 )
  75       character*80 texte(nblang,nbmess)
  76 c
  77 c 0.5. ==> initialisations
  78 c ______________________________________________________________________
  79 c
  80 c====
  81 c 1. initialisation
  82 c====
  83 c
  84       codret = 0
  85 c
  86 c 1.1. ==> initialisation des messages
  87 c
  88 #include "impr01.h"
  89 c
  90       texte(1,10) = '(''Le numero d''''unite logique '',i2,'' voulu'')'
  91       texte(1,4) =
  92      >'(''pour les sorties GU n''''a pas le bon statut GU.'')'
  93 c
  94       texte(2,10) = '(''The logical unit # '',i2,'' wanted for'')'
  95       texte(2,4) = '(''GU messages has not the right status in GU.'')'
  96 c
  97 c 1.2. ==> recuperation de l'information
  98 c
  99       code = 1
 100       call gutabl ( code, gunmbr, statut, nomfic, lnomfi )
 101 c
 102 c     (16): numero de l'unite des messages du gu
 103       ulsort = gunmbr(16)
 104 c
 105 c     (17): langue des messages du gu
 106       langue = gunmbr(17)
 107 c
 108 c     (18): type d'arret du gestionnaire
 109       typarr = gunmbr(18)
 110 c
 111 #ifdef _DEBUG_HOMARD_
 112       write (ulsort,texte(langue,1)) 'Entree', nompro
 113       call dmflsh (iaux)
 114 #endif
 115 c
 116 c====
 117 c 2. verification de la validite du numero. il faut que le statut soit :
 118 c    2 : Sortie standard (sequentiel formate)
 119 c    3 : Ouvert en acces sequentiel formate
 120 c====
 121 c
 122       imprim = .false.
 123       call guinfu ( ulmess, iaux, imprim )
 124 c
 125       if ( iaux.ne.2 .and. iaux.ne.3 ) then
 126 c
 127         write (ulsort,texte(langue,1)) 'Sortie', nompro
 128         write (ulsort,texte(langue,10)) ulmess
 129         write (ulsort,texte(langue,4))
 130 c
 131         if ( typarr.eq.0 ) then
 132           guimp = 1
 133           gmimp = 0
 134           raison = 1
 135           call ugstop(nompro,ulsort,guimp, gmimp, raison)
 136         else
 137           codret = 3
 138           write (ulsort,texte(langue,2)) codret
 139         endif
 140 c
 141       endif
 142 c
 143 c===
 144 c 3. archivage de l'information
 145 c===
 146 c
 147       if ( codret.eq.0 ) then
 148 c
 149 c     (16): numero de l'unite des messages du gu
 150         gunmbr(16) = ulmess
 151 c
 152         code = 0
 153         call gutabl ( code, gunmbr, statut, nomfic, lnomfi )
 154 c
 155       endif
 156 c
 157       end