src/tool/ES_MED/esveri.F

   1       subroutine esveri ( nomfic, messin,
   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  Entree-Sortie - VERIfication du fichier
  24 c  -      -        ----
  25 c ______________________________________________________________________
  26 c .        .     .        .                                            .
  27 c .  nom   . e/s . taille .           description                      .
  28 c .____________________________________________________________________.
  29 c . nomfic . e   .   1    . nom du fichier a examiner                  .
  30 c . messin . e   .   1    . message d'informations                     .
  31 c .        .     .        . impressions MED si multiple de 3           .
  32 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  33 c . langue . e   .    1   . langue des messages                        .
  34 c .        .     .        . 1 : francais, 2 : anglais                  .
  35 c . codret . es  .    1   . code de retour des modules                 .
  36 c .        .     .        . 0 : pas de probleme                        .
  37 c .        .     .        . 1 : fichier inexistant                     .
  38 c .        .     .        . 2 : probleme de version HDF du fichier     .
  39 c .        .     .        . 3 : probleme de version MED du fichier     .
  40 c .        .     .        . 4 : impossible trouver version MED HOMARD  .
  41 c .        .     .        . 5 : impossible trouver version MED fichier .
  42 c ______________________________________________________________________
  43 c
  44 c====
  45 c 0. declarations et dimensionnement
  46 c====
  47 c
  48 c 0.1. ==> generalites
  49 c
  50       implicit none
  51       save
  52 c
  53       character*6 nompro
  54       parameter ( nompro = 'ESVERI' )
  55 c
  56 #include "nblang.h"
  57 #include "consts.h"
  58 c
  59 c 0.2. ==> communs
  60 c
  61 #include "envex1.h"
  62 c
  63 c 0.3. ==> arguments
  64 c
  65       integer messin
  66 c
  67       character*(*) nomfic
  68 c
  69       integer ulsort, langue, codret
  70 c
  71 c 0.4. ==> variables locales
  72 c
  73 #include "meddc0.h"
  74 c
  75       integer iaux
  76       integer*8 idfmed
  77       integer hdfok, medok
  78       integer lgvhom, lgvfic
  79 c
  80       logical old
  81 c
  82       character*200 verhom, verfic
  83 c
  84       integer nbmess
  85       parameter ( nbmess = 150 )
  86       character*80 texte(nblang,nbmess)
  87 c ______________________________________________________________________
  88 c
  89 c====
  90 c 1. initialisations
  91 c====
  92 c
  93 #include "impr01.h"
  94 c
  95 #ifdef _DEBUG_HOMARD_
  96       write (ulsort,texte(langue,1)) 'Entree', nompro
  97       call dmflsh (iaux)
  98 #endif
  99 c
 100 #include "esimpr.h"
 101 c
 102       texte(1,4) = '(''Fichier : '',a)'
 103       texte(1,11) = '(''Ce fichier n''''existe pas.'')'
 104       texte(1,12) = '(''La version HDF est incompatible.'')'
 105       texte(1,13) = '(''La version MED est incompatible.'')'
 106       texte(1,14) =
 107      > '(''Impossible de trouver la bibliotheque MED de HOMARD.'')'
 108       texte(1,15) =
 109      > '(''Impossible de trouver la bibliotheque MED du fichier.'')'
 110       texte(1,16) = '(''Impossible de fermer le fichier.'')'
 111 c
 112       texte(2,4) = '(''File: '',a)'
 113       texte(2,11) = '(''This file does not exist.'')'
 114       texte(2,12) = '(''HDF release is uncorrect.'')'
 115       texte(2,13) = '(''MED release is uncorrect.'')'
 116       texte(2,14) = '(''MED library for HOMARD cannot be found.'')'
 117       texte(2,15) = '(''MED library for file cannot be found.'')'
 118       texte(2,16) = '(''The file cannot be closed.'')'
 119 c
 120 #ifdef _DEBUG_HOMARD_
 121       write (ulsort,texte(langue,4)) nomfic
 122 #endif
 123 c
 124 c====
 125 c 2. verifications
 126 c====
 127 c
 128       codret = 0
 129 c
 130 c 2.1. ==> Existence
 131 c
 132       if ( codret.eq.0 ) then
 133 c
 134       inquire ( file = nomfic, exist = old )
 135       if ( .not.old ) then
 136         codret = 1
 137       endif
 138 c
 139       endif
 140 c
 141 c 2.2. ==> Compatibilite du fichier en version HDF et MED
 142 c
 143       if ( codret.eq.0 ) then
 144 c
 145 #ifdef _DEBUG_HOMARD_
 146       write (ulsort,texte(langue,3)) 'MFICOM', nompro
 147 #endif
 148       call mficom ( nomfic, hdfok, medok, codret )
 149       if ( codret.ne.0 ) then
 150         codret = 1
 151       endif
 152       if ( hdfok.ne.1 ) then
 153         codret = 2
 154       endif
 155       if ( medok.ne.1 ) then
 156         codret = 3
 157       endif
 158 c
 159       endif
 160 cgn            print *,codret,hdfok, medok,messin
 161 c
 162 c 2.3. ==> Details
 163 c
 164       if ( ( codret.eq.0 .and. mod(messin,3).eq.0 ) .or.
 165      >       codret.eq.2 .or.
 166      >       codret.eq.3 ) then
 167 c
 168 c 2.4.1. ==> versions de la bibliotheque MED utilisee par HOMARD
 169 c
 170 #ifdef _DEBUG_HOMARD_
 171       write (ulsort,texte(langue,3)) 'MLBSTV', nompro
 172 #endif
 173       call mlbstv ( verhom, iaux )
 174 c
 175       if ( iaux.eq.0 ) then
 176 #ifdef _DEBUG_HOMARD_
 177       write (ulsort,texte(langue,3)) 'UTLGUT', nompro
 178 #endif
 179         call utlgut ( lgvhom, verhom,
 180      >                ulsort, langue, iaux )
 181         if ( iaux.eq.0 ) then
 182           write (ulsort,texte(langue,46)) 'HOMARD', verhom(1:lgvhom)
 183         else
 184           codret = 4
 185         endif
 186       else
 187         codret = 4
 188       endif
 189 c
 190 c 2.4.2. ==> versions de la bibliotheque MED du fichier
 191 c
 192       if ( iaux.eq.0 ) then
 193 #ifdef _DEBUG_HOMARD_
 194       write (ulsort,texte(langue,3)) 'MFIOPE', nompro
 195 #endif
 196       call mfiope ( idfmed, nomfic, edlect, iaux )
 197       if ( iaux.ne.0 ) then
 198         codret = 5
 199       endif
 200       endif
 201 c
 202       if ( iaux.eq.0 ) then
 203 #ifdef _DEBUG_HOMARD_
 204       write (ulsort,texte(langue,3)) 'MFISVR', nompro
 205 #endif
 206       call mfisvr ( idfmed, verfic, iaux )
 207       if ( iaux.eq.0 ) then
 208 #ifdef _DEBUG_HOMARD_
 209       write (ulsort,texte(langue,3)) 'UTLGUT', nompro
 210 #endif
 211         call utlgut ( lgvfic, verfic,
 212      >                ulsort, langue, iaux )
 213         if ( iaux.eq.0 ) then
 214           write (ulsort,texte(langue,46)) nomfic, verfic(1:lgvfic)
 215         else
 216           codret = 5
 217         endif
 218       else
 219         codret = 5
 220       endif
 221       endif
 222 c
 223       if ( iaux.eq.0 ) then
 224 #ifdef _DEBUG_HOMARD_
 225       write (ulsort,texte(langue,3)) 'MFICLO', nompro
 226 #endif
 227       call mficlo ( idfmed, iaux )
 228       if ( iaux.ne.0 ) then
 229         codret = 6
 230       endif
 231       endif
 232 c
 233       endif
 234 c
 235 c====
 236 c 3. la fin
 237 c====
 238 c
 239       if ( codret.ne.0 ) then
 240 c
 241 #include "envex2.h"
 242 c
 243       write (ulsort,texte(langue,1)) 'Sortie', nompro
 244       write (ulsort,texte(langue,2)) codret
 245       write (ulsort,texte(langue,8)) nomfic
 246       write (ulsort,texte(langue,codret+10))
 247 c
 248       endif
 249 c
 250 #ifdef _DEBUG_HOMARD_
 251       write (ulsort,texte(langue,1)) 'Sortie', nompro
 252       call dmflsh (iaux)
 253 #endif
 254 c
 255       end