src/tool/Utilitaire/utinit.F

   1       subroutine utinit ( nfconf, lfconf, messag, nbrmes,
   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 : INITialisation
  24 c       --           ----
  25 c ______________________________________________________________________
  26 c .        .     .        .                                            .
  27 c .  nom   . e/s . taille .           description                      .
  28 c .____________________________________________________________________.
  29 c . nfconf . e   . ch<200 . nom du fichier de configuration            .
  30 c . lfconf . e   .    1   . longueur du nom du fichier                 .
  31 c . messag . e   . char40 . message d'en tete des listes               .
  32 c . nbrmes . e   .   1    . nombres de messages                        .
  33 c . ulsort .  s  .   1    . numero d'unite logique de la liste standard.
  34 c . langue . es  .    1   . langue des messages                        .
  35 c .        .     .        . 1 : francais, 2 : anglais                  .
  36 c . codret .  s  .    1   . code de retour des modules                 .
  37 c .        .     .        .  0 : pas de probleme                       .
  38 c .        .     .        .  2x : probleme dans les memoires           .
  39 c .        .     .        .  3 : probleme dans le decodage du fichier  .
  40 c .        .     .        .      de configuration                      .
  41 c .        .     .        .  3x : probleme dans les fichiers           .
  42 c .        .     .        .  5 : deuxieme appel au programme           .
  43 c .        .     .        .  7 : impossible de decoder le $HOME        .
  44 c .        .     .        . 11 : date d'autorisation depassee          .
  45 c ______________________________________________________________________
  46 c
  47 c====
  48 c 0. declarations et dimensionnement
  49 c====
  50 c
  51 c 0.1. ==> generalites
  52 c
  53       implicit none
  54       save
  55 c
  56       character*6 nompro
  57       parameter ( nompro = 'UTINIT' )
  58 c
  59 #include "nblang.h"
  60 c
  61       integer nbcar
  62       parameter ( nbcar = 6 )
  63 c
  64 c 0.2. ==> communs
  65 c
  66 #include "envex1.h"
  67 c
  68 c 0.3. ==> arguments
  69 c
  70       character*(*) nfconf
  71 c
  72       integer lfconf
  73 c
  74       integer ulsort, langue, codret
  75 c
  76       integer nbrmes
  77       character*40 messag(nblang,nbrmes)
  78 c
  79 c 0.4. ==> variables locales
  80 c
  81 #include "consts.h"
  82 #include "motcle.h"
  83 #include "nuvers.h"
  84 #include "webweb.h"
  85 c
  86       integer lfsort
  87       integer guimp, gmimp, raison
  88       integer iaux, jaux, kaux
  89       integer ulsost, ulmess
  90       integer numann, datheu
  91       integer lgcar(nbcar)
  92 c
  93       character*8 motcle
  94       character*50 nomare, nomais, typmac, noarch, systre, systve
  95       character*48 ladate
  96       character*200 nfsort
  97 c
  98       character*40 blabla
  99 c
 100       integer nbmess
 101       parameter ( nbmess = 20 )
 102       character*80 texte(nblang,nbmess)
 103 c
 104 c 0.5. ==> initialisations
 105 c ______________________________________________________________________
 106 c
 107 c====
 108 c 1. les messages
 109 c====
 110 c
 111 #include "impr01.h"
 112 c
 113       texte(1,4) = '(//,''1. INITIALISATIONS'')'
 114       texte(1,5) = '(18(''=''),/)'
 115       texte(1,7) = '(/,''Ce calcul date du '',a48)'
 116       texte(1,8) = '(''Il a eu lieu sur '',a)'
 117       texte(1,9) = '(''. type de machine : '',a  )'
 118       texte(1,10) = '(''. systeme d''''exploitation : '',a)'
 119       texte(1,11) = '(''                 release : '',a )'
 120       texte(1,12) = '(''                 version : '',a ,//)'
 121 c
 122       texte(2,4) = '(//,''1. INITIALISATIONS'')'
 123       texte(2,5) = '(18(''=''),/)'
 124       texte(2,7) = '(/,''This computation ran '',a48)'
 125       texte(2,8) = '(''It was done on '',a)'
 126       texte(2,9) = '(''. machine type : '',a)'
 127       texte(2,10) = '(''. operating system : '',a)'
 128       texte(2,11) = '(''           release : '',a)'
 129       texte(2,12) = '(''           version : '',a,//)'
 130 c
 131 51001 format (
 132      >   15x,'..........................................')
 133 51101 format (
 134      >   15x,':........................................:')
 135 51002 format (
 136      >   15x,':                                        :')
 137 51003 format (15x,':',a40,':')
 138 51004 format (//)
 139 51011 format (
 140      >   'Copyright 1996 EDF',
 141      > /,'Copyright 2015 EDF',
 142      > /,'Copyright ',i4,' EDF',
 143      > /,'------------------',/)
 144 51012 format (
 145      >   15x,':         H O M A R D     ',a8  ,'       :')
 146 c
 147       spropb = blan08(1:6)
 148 c
 149 c====
 150 c 2. premier appel de uginit pour initialisation du gestionnaire
 151 c    d'unites logiques
 152 c    remarque : au premier appel, ulsort n'a pas besoin d'etre
 153 c               initialise
 154 c====
 155 c
 156       codret = 0
 157 c
 158       if ( langue.le.0 .or. langue.gt.nblang ) then
 159         langue = 1
 160       endif
 161 c
 162 #ifdef _DEBUG_HOMARD_
 163       write (*,*) 'Appel de UGINIT par ', nompro
 164 #endif
 165       call uginit ( ulsort, langue, nfconf, lfconf, codret )
 166 c
 167       if ( codret.eq.0 ) then
 168 c
 169       call gusost ( ulsost )
 170 c
 171       endif
 172 c
 173 c====
 174 c 3. le fichier associe a la sortie standard
 175 c====
 176 #ifdef _DEBUG_HOMARD_
 177       write (*,*) '3. sortie standard ; codret = ', codret
 178 #endif
 179 c
 180       if ( codret.eq.0 ) then
 181 c
 182 c 3.1. ==> le nom de ce fichier
 183 c
 184       motcle = mclist
 185 #ifdef _DEBUG_HOMARD_
 186       write (*,*) 'Appel de UGFINO par ', nompro
 187 #endif
 188       call ugfino ( motcle, nfsort, lfsort,
 189      >              nfconf, lfconf,
 190      >              ulsost, langue, codret )
 191 c
 192       if ( codret.ne.0 .and. codret.ne.1 ) then
 193         guimp = 1
 194         gmimp = 0
 195         raison = 1
 196         call ugstop (nompro, ulsost, guimp, gmimp, raison)
 197       endif
 198 c
 199 c 3.2. ==> l'unite logique associee a cette liste
 200 c          on redirige sur la sortie standard si le fichier
 201 c          n'a pas ete mentionne dans la configuration, sinon
 202 c          on ouvre le fichier correspondant.
 203 c
 204       if ( codret.eq.1 .or. lfsort.le.0 ) then
 205 c
 206         ulsort = ulsost
 207         codret = 0
 208 c
 209       else
 210 c
 211         call guoufs ( nfsort, lfsort, ulsort, codret )
 212         if ( codret.ne.0 ) then
 213           guimp = 1
 214           gmimp = 0
 215           raison = 1
 216           call ugstop (nompro, ulsost, guimp, gmimp, raison)
 217         endif
 218 c
 219         call gurbbu ( ulsort, codret )
 220 c
 221       endif
 222 c
 223       endif
 224 c
 225 #ifdef _DEBUG_HOMARD_
 226       if ( codret.eq.0 ) then
 227       write (ulsort,texte(langue,1)) 'Entree', nompro
 228       call dmflsh (iaux)
 229       endif
 230 #endif
 231 c
 232 c====
 233 c 4. l'environnement
 234 c====
 235 #ifdef _DEBUG_HOMARD_
 236       write (ulsort,*) '4. environnement ; codret = ', codret
 237 #endif
 238 c
 239 c 4.1. ==> la langue
 240 c
 241       if ( codret.eq.0 ) then
 242 #ifdef _DEBUG_HOMARD_
 243       write (*,texte(1,3)) 'UTINLA', nompro
 244 #endif
 245       call utinla ( nfconf, lfconf,
 246      >              ulsort, langue, codret )
 247       endif
 248 c
 249       if ( codret.eq.0 ) then
 250 #ifdef _DEBUG_HOMARD_
 251       write (*,texte(1,3)) 'GULANM', nompro
 252 #endif
 253       call gulanm ( langue, codret )
 254       endif
 255 c
 256 c 4.2. ==> les dates et types de machines
 257 c
 258       if ( codret.eq.0 ) then
 259 c
 260 #ifdef _DEBUG_HOMARD_
 261       write (*,texte(langue,3)) 'UTDHCO', nompro
 262 #endif
 263       call utdhco ( numann, datheu )
 264 c
 265 #ifdef _DEBUG_HOMARD_
 266       write (*,texte(langue,3)) 'UTDHLG', nompro
 267 #endif
 268       call utdhlg ( ladate, langue )
 269 c
 270 #ifdef _DEBUG_HOMARD_
 271       write (*,texte(langue,3)) 'DMMACH', nompro
 272 #endif
 273       call dmmach ( nomare, nomais, typmac,
 274      >              noarch, systre, systve,
 275      >              lgcar )
 276 c
 277       endif
 278 c
 279 c====
 280 c 5. en-tete
 281 c====
 282 #ifdef _DEBUG_HOMARD_
 283       write (*,*) '5. en-tete ; codret = ', codret
 284 #endif
 285 c
 286       if ( codret.eq.0 ) then
 287 c
 288 c 5.1. ==> debut de l'en-tete
 289 c
 290       ulmess = ulsort
 291 c
 292       write (ulmess,51011) numann
 293       write (ulmess,51001)
 294       write (ulmess,51002)
 295       write (ulmess,51012) nuvers
 296       write (ulmess,51002)
 297       write (ulmess,51101)
 298       write (ulmess,51002)
 299 c
 300 c recopie prudente du message (40 caracteres utiles a priori)
 301 c dans blabla :
 302 c
 303       do 511 , jaux = 1 , nbrmes
 304         call dmcpch( messag(langue,jaux), 40, blabla, kaux )
 305         write (ulmess,51003) blabla
 306   511 continue
 307 c
 308       write (ulmess,51002)
 309       write (ulmess,51101)
 310       write (ulmess,51002)
 311 c
 312       call dmcpch( weba, 40, blabla, kaux )
 313       write (ulmess,51003) blabla
 314       if ( langue.eq.2 ) then
 315         call dmcpch( web2, 40, blabla, kaux )
 316         write (ulmess,51003) blabla
 317       endif
 318       write (ulmess,51002)
 319       write (ulmess,51101)
 320 c
 321       write (ulsort,texte(langue,7)) ladate
 322 #ifdef _DEBUG_HOMARD_
 323       write (ulsort,texte(langue,8)) nomare(1:lgcar(1))
 324       write (ulsort,texte(langue,9)) typmac(1:lgcar(3))
 325       write (ulsort,texte(langue,10)) noarch(1:lgcar(4))
 326       write (ulsort,texte(langue,11)) systre(1:lgcar(5))
 327       write (ulsort,texte(langue,12)) systve(1:lgcar(6))
 328 #endif
 329 c
 330 c 5.2. ==> fin de l'en-tete
 331 c
 332       if ( codret.eq.0 ) then
 333       write (ulsort,texte(langue,4))
 334       write (ulsort,texte(langue,5))
 335       endif
 336 c
 337       endif
 338 c
 339 c====
 340 c 6. second appel de uginit pour initialisation du gestionnaire
 341 c    de mesures de temps calcul et de memoire
 342 c====
 343 #ifdef _DEBUG_HOMARD_
 344       write (*,*) '6. second appel de uginit ; codret = ', codret
 345 #endif
 346 c
 347       if ( codret.eq.0 ) then
 348 c
 349 #ifdef _DEBUG_HOMARD_
 350       write (ulsort,texte(langue,3)) 'UGINIT', nompro
 351 #endif
 352       call uginit ( ulsort, langue, nfconf, lfconf, codret )
 353 c
 354       endif
 355 c
 356 c====
 357 c 7. acquisition des noms des fichiers utiles au calcul
 358 c====
 359 #ifdef _DEBUG_HOMARD_
 360       write (*,*) '7. noms des fichiers ; codret = ', codret
 361 #endif
 362 c
 363       if ( codret.eq.0 ) then
 364 c
 365 #ifdef _DEBUG_HOMARD_
 366       write (ulsort,texte(langue,3)) 'UTFIAC', nompro
 367 #endif
 368       call utfiac ( nfconf, lfconf, ulsort, langue, codret )
 369 c
 370       endif
 371 c
 372 c====
 373 c 8. bilan
 374 c====
 375 #ifdef _DEBUG_HOMARD_
 376       write (*,*) '8. bilan ; codret = ', codret
 377 #endif
 378 c
 379       if ( codret.ne.0  ) then
 380 c
 381 #include "envex2.h"
 382 c
 383       endif
 384 c
 385 #ifdef _DEBUG_HOMARD_
 386       write (ulsort,texte(langue,1)) 'Sortie', nompro
 387       call dmflsh (iaux)
 388 #endif
 389 c
 390       end