src/tool/ES_MED/eslimd.F

   1       subroutine eslimd ( nocind,
   2      >                    numdt, numit, instan,
   3      >                    yandt, yanrd, yains,
   4      >                    messin,
   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 - Lecture de l'Indicateur au format MED
  27 c  -      -        -            -                    - -
  28 c ______________________________________________________________________
  29 c .        .     .        .                                            .
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . nocind .  s  . char*8 . nom de l'objet indicateur d'erreur calcul  .
  33 c . numdt  . e   .   1    . numero du pas de temps eventuel            .
  34 c . numit  . e   .   1    . numero d'ordre eventuel                    .
  35 c . instan . e   .   1    . instant eventuel                           .
  36 c . yandt  . e   .   1    . 2, on prend le dernier pas de temps        .
  37 c .        .     .        . 1, le numero du pas de temps est fourni    .
  38 c .        .     .        . 0, sinon                                   .
  39 c . yanrd  . e   .   1    . 2, on prend le dernier numero d'ordre      .
  40 c .        .     .        . 1, le numero d'ordre est fourni            .
  41 c .        .     .        . 0, sinon                                   .
  42 c . yains  . e   .   1    . 2, on prend le dernier instant             .
  43 c .        .     .        . 1, l'instant est fourni                    .
  44 c .        .     .        . 0, sinon                                   .
  45 c . messin . e   .   1    . message d'informations                     .
  46 c .        .     .        . impressions MED si multiple de 3           .
  47 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  48 c . langue . e   .    1   . langue des messages                        .
  49 c .        .     .        . 1 : francais, 2 : anglais                  .
  50 c . codret . es  .    1   . code de retour des modules                 .
  51 c .        .     .        . en entree = celui du module d'avant        .
  52 c .        .     .        . en sortie = celui du module en cours       .
  53 c .        .     .        . 0 : pas de probleme                        .
  54 c .        .     .        . 1 : manque de temps cpu                    .
  55 c .        .     .        . 2x : probleme dans les memoires            .
  56 c .        .     .        . 3x : probleme dans les fichiers            .
  57 c .        .     .        . -1 : probleme avec le nom du champ         .
  58 c .        .     .        . -2 : probleme avec le nom de la composante .
  59 c .        .     .        . -3 : probleme avec le nom du maillage      .
  60 c ______________________________________________________________________
  61 c
  62 c  HOAVLI --> ESLIMD --> ESLSM0
  63 c        -> ESLSM0 -> ESOUVL -> ESVERI -> MFICOM
  64 c                                       -> MLBSTV
  65 c                                       -> MFIOPE
  66 c                                       -> MFISVR
  67 c                                       -> MFICLO
  68 c                             -> MFIOPE
  69 c                             -> ESLENT -> MFICOR
  70 c                   -> ESLNOM -> MMHNMH
  71 c                             -> MMHMII
  72 c                   -> MFDNFD
  73 c                   -> MLCNLC
  74 c                   -> ESLSM1 -> MFDNFC
  75 c                             -> MFDFDI
  76 c                             -> ESLCH1 -> ESLCH2 -> MFDCSI
  77 c                                       -> MFDNPF
  78 c                                       -> ESLPR1 -> MPFPSN
  79 c                                                 -> MPFPRR
  80 c                                       -> ESLPG1 -> ESLPG2 -> MLCNLC
  81 c                                                           -> MLCLCI
  82 c                                                 -> MLCLOR
  83 c                                       -> MFDNPN
  84 c                             -> ESLCH6
  85 c                   -> ESLSM2 -> ESLCH3
  86 c                             -> ESLCH7
  87 c                   -> ESLSM3
  88 c                   -> ESLSM4 -> ESLCH4 -> MFDRPR
  89 c                                       -> ESLCH5
  90 c                   -> ESLSM5
  91 c         -> MFICLO
  92 c====
  93 c 0. declarations et dimensionnement
  94 c====
  95 c
  96 c 0.1. ==> generalites
  97 c
  98       implicit none
  99       save
 100 c
 101       character*6 nompro
 102       parameter ( nompro = 'ESLIMD' )
 103 c
 104 #include "nblang.h"
 105 #include "consts.h"
 106 c
 107 #include "motcle.h"
 108 #include "meddc0.h"
 109 c
 110 c 0.2. ==> communs
 111 c
 112 #include "envex1.h"
 113 c
 114 #include "gmenti.h"
 115 #include "gmreel.h"
 116 #include "gmstri.h"
 117
 118 c 0.3. ==> arguments
 119 c
 120       integer numdt, numit, yandt, yanrd,yains
 121       double precision instan
 122 c
 123       character*8 nocind
 124 c
 125       integer messin
 126 c
 127       integer ulsort, langue, codret
 128 c
 129 c 0.4. ==> variables locales
 130 c
 131       integer iaux, jaux
 132       integer codre0
 133       integer codre1, codre2, codre3
 134       integer adcact, adcaet, adcart
 135       integer nbseal, nbtosv
 136 c
 137       integer lnomfi
 138       integer lnocin, lnomam
 139 c
 140       character*8 typobs
 141       character*8 ntrav1, ntrav2, ntrav3
 142       character*64 nomamd
 143       character*64 nochin
 144       character*64 saux64
 145       character*200 nomfic
 146 c
 147       integer nbmess
 148       parameter ( nbmess = 150 )
 149       character*80 texte(nblang,nbmess)
 150 c
 151 c 0.5. ==> initialisations
 152 c ______________________________________________________________________
 153 c
 154 c====
 155 c 1. initialisations
 156 c====
 157 c
 158 #include "impr01.h"
 159 c
 160 #ifdef _DEBUG_HOMARD_
 161       write (ulsort,texte(langue,1)) 'Entree', nompro
 162       call dmflsh (iaux)
 163 #endif
 164 c
 165       texte(1,4) =
 166      >'(''Probleme pour allouer l''''objet indicateur.'')'
 167       texte(1,5) = '(''Mot-cle : '',a8)'
 168       texte(1,6) = '(''Le nom du champ indicateur est inconnu.'')'
 169       texte(1,7) =
 170      > '(''La composante du champ indicateur est inconnue.'')'
 171 c
 172       texte(2,4) ='(''Problem while allocating the indicator object.'')'
 173       texte(2,5) = '(''Keyword : '',a8)'
 174       texte(2,6) = '(''The name of the indicator field is unknown.'')'
 175       texte(2,7) =
 176      >'(''The name of the indicator field component is unknown.'')'
 177 c
 178 #include "impr03.h"
 179 c
 180 #include "esimpr.h"
 181 c
 182 c====
 183 c 2. premiers decodages
 184 c====
 185 c
 186 c 2.1. ==> nom du fichier contenant l'indicateur
 187 c
 188       typobs = mccind
 189       iaux = 0
 190       jaux = 1
 191       call utfino ( typobs, iaux, nomfic, lnomfi,
 192      >              jaux,
 193      >              ulsort, langue, codret )
 194 c
 195 c 2.2. ==> nom du maillage dans ce fichier
 196 c
 197       if ( codret.eq.0 ) then
 198 c
 199       typobs = mccnmn
 200       iaux = 0
 201       jaux = 0
 202       call utfino ( typobs, iaux, nomamd, lnomam,
 203      >              jaux,
 204      >              ulsort, langue, codret )
 205       if ( codret.ne.0 ) then
 206         call utosme ( typobs, ulsort, langue )
 207         if ( codret.eq.4 ) then
 208           write (ulsort,texte(langue,52)) lnomam
 209           write (ulsort,texte(langue,53)) len(nomamd)
 210           codret = -3
 211         endif
 212       endif
 213 c
 214       endif
 215 c
 216 c 2.3. ==> recherche des caracteristiques de l'indicateur
 217 c          si le nom de l'indicateur est absent, ... probleme
 218 c
 219 c 2.3.1. ==> nom du champ
 220 c
 221 #ifdef _DEBUG_HOMARD_
 222       write (ulsort,90002) '2.3.2. nom du champ ; codret', codret
 223 #endif
 224 c
 225       if ( codret.eq.0 ) then
 226 c
 227       typobs = mccnin
 228       iaux = 0
 229       jaux = 0
 230       call utfino ( typobs, iaux, nochin, lnocin,
 231      >              jaux,
 232      >              ulsort, langue, codret )
 233 c
 234       if ( codret.eq.2 ) then
 235         codret = -1
 236         write (ulsort,texte(langue,5)) typobs
 237         write (ulsort,texte(langue,6))
 238       endif
 239 c
 240       endif
 241 c
 242       if ( codret.eq.0 ) then
 243       write (ulsort,texte(langue,32)) nochin(1:lnocin)
 244       endif
 245 c
 246 c====
 247 c 3. mise en forme du tableau a lire
 248 c====
 249 c
 250 #ifdef _DEBUG_HOMARD_
 251       write (ulsort,90002) '3. mise en forme ; codret', codret
 252 #endif
 253 c
 254       if ( codret.eq.0 ) then
 255 c
 256       nbseal = 1
 257 c
 258       iaux = 8*nbseal
 259       call gmalot ( ntrav1, 'chaine  ', iaux, adcact, codre1 )
 260       iaux = 12*nbseal
 261       call gmalot ( ntrav2, 'entier  ', iaux, adcaet, codre2 )
 262       iaux = 1*nbseal
 263       call gmalot ( ntrav3, 'reel    ', iaux, adcart, codre3 )
 264 c
 265       codre0 = min ( codre1, codre2, codre3 )
 266       codret = max ( abs(codre0), codret,
 267      >               codre1, codre2, codre3 )
 268 c
 269       endif
 270 c
 271       if ( codret.eq.0 ) then
 272 c
 273       saux64 = blan64
 274       iaux = 64
 275 c
 276       call utchs8 ( saux64, iaux, smem(adcact),
 277      >              ulsort, langue, codret )
 278 c
 279       endif
 280 c
 281       if ( codret.eq.0 ) then
 282 c
 283       call utchs8 ( nochin, lnocin, smem(adcact),
 284      >              ulsort, langue, codret )
 285 c
 286       endif
 287 c
 288       if ( codret.eq.0 ) then
 289 c
 290 #ifdef _DEBUG_HOMARD_
 291       write (ulsort,90002) 'yandt', yandt
 292       write (ulsort,90002) 'yanrd', yanrd
 293       write (ulsort,90002) 'yains', yains
 294 #endif
 295       imem(adcaet+0) = -1
 296       imem(adcaet+1) = yandt
 297       if ( yandt.eq.1 ) then
 298         imem(adcaet+2) = numdt
 299         write (ulsort,texte(langue,113)) numdt
 300       elseif ( yandt.eq.2 ) then
 301         write (ulsort,texte(langue,93))
 302       endif
 303       imem(adcaet+3) = yanrd
 304       if ( yanrd.eq.1 ) then
 305         imem(adcaet+4) = numit
 306         write (ulsort,texte(langue,114)) numit
 307 cgn      elseif ( yanrd.eq.2 ) then
 308 cgn        write (ulsort,texte(langue,94))
 309       endif
 310       imem(adcaet+5) = yains
 311       if ( yains.eq.1 ) then
 312         rmem(adcart) = instan
 313         write (ulsort,texte(langue,115)) instan
 314       elseif ( yains.eq.2 ) then
 315         write (ulsort,texte(langue,95))
 316       endif
 317       imem(adcaet+6) = -1
 318       imem(adcaet+9) = 0
 319 c
 320       endif
 321 c
 322 c====
 323 c 4. lecture
 324 c====
 325 c
 326 #ifdef _DEBUG_HOMARD_
 327       write (ulsort,90002) '4. lecture ; codret', codret
 328 #endif
 329 c
 330 c 4.1. ==> lecture MED
 331 c
 332       if ( codret.eq.0 ) then
 333 #ifdef _DEBUG_HOMARD_
 334       write (ulsort,texte(langue,3)) 'ESLSM0', nompro
 335 #endif
 336 c
 337       iaux = 0
 338       call eslsm0 ( nocind, nomfic, lnomfi,
 339      >              nomamd, lnomam,
 340      >              nbseal, nbtosv,
 341      >              smem(adcact), imem(adcaet), rmem(adcart),
 342      >              messin, iaux,
 343      >              ulsort, langue, codret )
 344 c
 345       endif
 346 c
 347 c 4.2. ==> on controle qu'il y a bien au moins un tableau
 348 c
 349       if ( codret.eq.0 ) then
 350 #ifdef _DEBUG_HOMARD_
 351       call gmprsx (nompro, nocind )
 352       call gmprsx (nompro, nocind//'.InfoPaFo' )
 353       call gmprsx (nompro, '%%%%%%13' )
 354       call gmprsx (nompro, nocind//'.InfoCham' )
 355       call gmprsx (nompro, '%%%%%%11' )
 356       call gmprsx (nompro, '%%%%%%11.Nom_Comp' )
 357       call gmprsx (nompro, '%%%%%%11.Cham_Ent' )
 358       call gmprsx (nompro, '%%%%%%11.Cham_Ree' )
 359       call gmprsx (nompro, '%%%%%%11.Cham_Car' )
 360       call gmprsx (nompro, '%%%%%%12' )
 361       call gmprsx (nompro, '%%%%%%12.ValeursR' )
 362 #endif
 363 #ifdef _DEBUG_HOMARD_
 364       write (ulsort,texte(langue,111)) nbtosv
 365 #endif
 366 c
 367       if ( nbtosv.eq.0 ) then
 368 c
 369       write (ulsort,texte(langue,96)) nomamd
 370       if ( yandt.eq.1 ) then
 371         write (ulsort,texte(langue,113)) numdt
 372       endif
 373       if ( yanrd.eq.1 ) then
 374         write (ulsort,texte(langue,114)) numit
 375       endif
 376       if ( yains.eq.1 ) then
 377         write (ulsort,texte(langue,115)) instan
 378       endif
 379       write (ulsort,texte(langue,70))
 380       write (ulsort,texte(langue,71))
 381       write (ulsort,texte(langue,72))
 382       write (ulsort,texte(langue,73))
 383 c
 384 #ifdef _DEBUG_HOMARD_
 385       write (ulsort,texte(langue,3)) 'ESLSC1', nompro
 386 #endif
 387       call eslsc1 ( nomfic, lnomfi,
 388      >              messin,
 389      >              ulsort, langue, codret )
 390 c
 391       codret = 2
 392 c
 393       endif
 394 c
 395       endif
 396 c
 397 c 4.3. ==> Menage
 398 c
 399       if ( codret.eq.0 ) then
 400 c
 401       call gmlboj ( ntrav1, codre1 )
 402       call gmlboj ( ntrav2, codre2 )
 403       call gmlboj ( ntrav3, codre3 )
 404 c
 405       codre0 = min ( codre1, codre2, codre3 )
 406       codret = max ( abs(codre0), codret,
 407      >               codre1, codre2, codre3 )
 408 c
 409       endif
 410 c
 411 c====
 412 c 5. la fin
 413 c====
 414 c
 415       if ( codret.ne.0 ) then
 416 c
 417 #include "envex2.h"
 418 c
 419       write (ulsort,texte(langue,1)) 'Sortie', nompro
 420       write (ulsort,texte(langue,2)) codret
 421       write (ulsort,texte(langue,8)) nomfic
 422       if ( codret.gt.0 .or. codret.eq.-2 ) then
 423         write (ulsort,texte(langue,32)) nochin
 424       endif
 425       if ( codret.gt.0 ) then
 426         if ( yandt.eq.1 ) then
 427           write (ulsort,texte(langue,113)) numdt
 428         elseif ( yandt.eq.2 ) then
 429         write (ulsort,texte(langue,93))
 430         endif
 431         if ( yanrd.eq.1 ) then
 432           write (ulsort,texte(langue,114)) numit
 433         endif
 434       endif
 435 c
 436       endif
 437 c
 438 #ifdef _DEBUG_HOMARD_
 439       write (ulsort,texte(langue,1)) 'Sortie', nompro
 440       call dmflsh (iaux)
 441 #endif
 442 c
 443       end