src/tool/Gestion_MTU/ugfia3.F

   1       subroutine ugfia3 ( ligne,
   2      >                    ideb1, ifin1, ideb2, ifin2,
   3      >                    ideb3, ifin3, ideb4, ifin4,
   4      >                    ulsort, langue, codret )
   5 c ______________________________________________________________________
   6 c
   7 c                             H O M A R D
   8 c
   9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  10 c
  11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  12 c aupres des huissiers de justice Simart et Lavoir a Clamart
  13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  14 c aupres des huissiers de justice
  15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  16 c
  17 c    HOMARD est une marque deposee d'Electricite de France
  18 c
  19 c Copyright EDF 1996
  20 c Copyright EDF 1998
  21 c Copyright EDF 2002
  22 c Copyright EDF 2020
  23 c ______________________________________________________________________
  24 c
  25 c retourne les indices de debut et de fin de chacun des 4 mots possibles
  26 c ______________________________________________________________________
  27 c .        .     .        .                                            .
  28 c .  nom   . e/s . taille .           description                      .
  29 c .____________________________________________________________________.
  30 c . ligne  . e   .    1   . ligne a decoder                            .
  31 c . ulsort . e   .    1   . unite logique d'impression                 .
  32 c . idebi  .  s  .    1   . debut du mot numero i                      .
  33 c . ifini  .  s  .    1   . fin du mot numero i                        .
  34 c . langue . e   .    1   . langue des messages                        .
  35 c .        .     .        . 1 : francais, 2 : anglais                  .
  36 c . codret .  s  .    1   . code de retour                             .
  37 c .        .     .        . 0 : pas de probleme                        .
  38 c .        .     .        . 3 : probleme de decodage des noms          .
  39 c .        .     .        . 7 : impossible de decoder le $HOME         .
  40 c .        .     .        .   : (ou une autre variable d'environnement).
  41 c .        .     .        . 9 : probleme avec le 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 = 'UGFIA3' )
  55 c
  56 #include "nblang.h"
  57 c
  58 c 0.2. ==> communs
  59 c
  60 c 0.3. ==> arguments
  61 c
  62       character*(*) ligne
  63 c
  64       integer ideb1, ideb2, ideb3, ideb4
  65       integer ifin1, ifin2, ifin3, ifin4
  66 c
  67       integer ulsort, langue, codret
  68 c
  69 c 0.4. ==> variables locales
  70 c
  71       integer iaux, jaux, kaux
  72       integer lemot2, lemot3
  73 c
  74       integer lgmax
  75 c
  76       logical ouverd, quotd2, quotd3
  77       logical ouvers, quots2, quots3
  78 c
  79       integer nbmess
  80       parameter ( nbmess = 10 )
  81       character*80 texte(nblang,nbmess)
  82 c
  83 c 0.5. ==> initialisations
  84 c
  85       parameter ( lgmax = 400 )
  86 c ______________________________________________________________________
  87 c
  88 c====
  89 c 1. initialisations
  90 c====
  91 c
  92 #include "impr03.h"
  93 c
  94 c 1.1. ==> les messages
  95 c
  96 #include "impr01.h"
  97 c
  98 #ifdef _DEBUG_HOMARD_
  99       write (ulsort,texte(langue,1)) 'Entree', nompro
 100       call dmflsh (iaux)
 101 #endif
 102 c
 103       texte(1,4) = '(''Nombre de quotes dans la ligne :'',i4)'
 104       texte(1,5) = '(''Il en faut 0, 2 ou 4.'')'
 105 c
 106       texte(2,4) = '(''Number of quotes in line :'',i4)'
 107       texte(2,5) = '(''0, 2 or 4 is required.'')'
 108 c
 109       codret = 0
 110 c
 111 c====
 112 c 2. recherche de la position du premier mot
 113 c====
 114 c
 115 c 2.1. ==> recherche de la position du debut du premier mot : ideb1
 116 c
 117       ideb1 = lgmax+1
 118       do 21 , jaux = 1 , lgmax
 119         if ( ligne(jaux:jaux).ne.' ' ) then
 120           ideb1 = jaux
 121           goto 22
 122         endif
 123    21 continue
 124 c
 125    22 continue
 126 cgn      write (ulsort,90002) 'ideb1',ideb1
 127 c
 128 c 2.2. ==> recherche de la position de la fin du premier mot : ifin1
 129 c
 130       ifin1 = lgmax
 131       iaux = ideb1 + 1
 132       do 23 , jaux = iaux , lgmax
 133         if ( ligne(jaux:jaux).eq.' ' ) then
 134           ifin1 = jaux - 1
 135           goto 24
 136         endif
 137    23 continue
 138 c
 139    24 continue
 140 cgn      write (ulsort,90002) 'ifin1',ifin1
 141 c
 142 c====
 143 c 3. reperage des debuts et fin des mots 2 et 3
 144 c    on en profite pour reperer s'ils sont encadres par des quotes,
 145 c    en distinguant les simples et les doubles
 146 c====
 147 c
 148       lemot2 = 0
 149       ideb2 = -1
 150       ideb3 = -1
 151       lemot3 = 0
 152       ouvers = .false.
 153       quots2 = .false.
 154       quots3 = .false.
 155       ouverd = .false.
 156       quotd2 = .false.
 157       quotd3 = .false.
 158       kaux = 0
 159       iaux = ifin1 + 1
 160       do 31 , jaux = iaux , lgmax
 161 c
 162 c 3.1. ==> c'est une quote double
 163 c
 164         if ( ligne(jaux:jaux).eq.'"' ) then
 165           if ( ouverd ) then
 166             ouverd = .false.
 167             if ( lemot2.eq.1 ) then
 168               quotd2 = .true.
 169               lemot2 = 2
 170               ifin2 = jaux-1
 171             elseif ( lemot3.eq.1 ) then
 172               quotd3 = .true.
 173               lemot3 = 2
 174               ifin3 = jaux-1
 175             endif
 176           else
 177             ouverd = .true.
 178           endif
 179           kaux = kaux + 1
 180 c
 181 c 3.2. ==> c'est une quote simple
 182 c          . si une quote double est ouverte, c'est un caractere comme
 183 c          un autre, donc on ne fait rien de special
 184 c          . sinon, c'est une ouverture
 185 c
 186         elseif ( ligne(jaux:jaux).eq.'''' ) then
 187 c
 188           if ( ouverd ) then
 189             goto 31
 190           elseif ( ouvers ) then
 191             ouvers = .false.
 192             if ( lemot2.eq.1 ) then
 193               quots2 = .true.
 194               lemot2 = 2
 195               ifin2 = jaux-1
 196             elseif ( lemot3.eq.1 ) then
 197               quots3 = .true.
 198               lemot3 = 2
 199               ifin3 = jaux-1
 200             endif
 201           else
 202             ouvers = .true.
 203           endif
 204           kaux = kaux + 1
 205 c
 206 c 3.3. ==> c'est un caractere non blanc : debut de mot
 207 c
 208         elseif ( ligne(jaux:jaux).ne.' ' ) then
 209           if ( lemot2.le.1 ) then
 210             lemot2 = 1
 211             if ( ideb2.eq.-1 ) then
 212               ideb2 = jaux
 213             endif
 214           else
 215             lemot3 = 1
 216             if ( ideb3.eq.-1 ) then
 217               ideb3 = jaux
 218             endif
 219           endif
 220 c
 221 c 3.4. ==> c'est un caractere blanc : fin de mot si pas entre quotes
 222 c
 223         elseif ( ligne(jaux:jaux).eq.' ' .and. .not.ouverd ) then
 224           if ( lemot2.eq.1 ) then
 225             lemot2 = 2
 226             ifin2 = jaux-1
 227           elseif ( lemot3.eq.1 ) then
 228             lemot3 = 2
 229             ifin3 = jaux-1
 230           endif
 231 c
 232         endif
 233 c
 234 cgn        if ( ideb1.eq.1 .and. jaux.le.80) then
 235 cgn 3499     format(      i8,              a2,    l2,    l2,    i2,    i2)
 236 cgn          write (ulsort,3499)jaux,ligne(jaux:jaux),ouverd,ouvers,lemot2,lemot3
 237 cgn        endif
 238    31 continue
 239 c
 240 c 3.n. ==> controle des quotes
 241 c
 242 cgn      write (ulsort,*) kaux, quotd2, quotd3
 243 cgn      write (ulsort,*) kaux, quots2, quots3
 244 cgn      write (ulsort,*) ideb2, ifin2, ideb3,ifin3
 245       if ( kaux.eq.0 .or.
 246      >     ( kaux.eq.2 .and. quotd2 .and. .not.quotd3 ) .or.
 247      >     ( kaux.eq.2 .and. quotd3 .and. .not.quotd2 ) .or.
 248      >     ( kaux.eq.4 .and. quotd2 .and. quotd3 ) .or.
 249      >     ( kaux.eq.2 .and. quots2 .and. .not.quots3 ) .or.
 250      >     ( kaux.eq.2 .and. quots3 .and. .not.quots2 ) .or.
 251      >     ( kaux.eq.4 .and. quots2 .and. quots3 ) ) then
 252         goto 40
 253       else
 254 c
 255         write (ulsort,*) ligne
 256         write (ulsort,texte(langue,4)) kaux
 257         write (ulsort,texte(langue,5))
 258         codret = 3
 259 c
 260       endif
 261 c
 262 c====
 263 c 4. recherche de la position du quatrieme nom
 264 c    s'il n'y en n'a pas, on passe directement au decodage.
 265 c====
 266 c
 267    40 continue
 268 c
 269       ideb4 = -1
 270 c
 271       if ( codret.eq.0 ) then
 272 c
 273       if ( ideb3.gt.0 ) then
 274 c
 275 c 3.4.1. ==> recherche du debut du quatrieme nom : ideb4
 276 c
 277         if ( quotd3 ) then
 278           iaux = ifin3 + 2
 279         else
 280           iaux = ifin3 + 1
 281         endif
 282         do 41 , jaux = iaux , lgmax
 283           if ( ligne(jaux:jaux).ne.' ' ) then
 284             ideb4 = jaux
 285             goto 42
 286           endif
 287   41   continue
 288 c
 289         goto 50
 290 c
 291   42   continue
 292 c
 293 c 3.4.2. ==> recherche de la fin du quatrieme nom : ifin4
 294 c
 295         ifin4 = lgmax
 296         iaux = ideb4 + 1
 297         do 43 , jaux = iaux , lgmax
 298           if ( ligne(jaux:jaux).eq.' ' ) then
 299             ifin4 = jaux - 1
 300             goto 44
 301           endif
 302   43    continue
 303 c
 304   44    continue
 305 c
 306       endif
 307 c
 308       endif
 309 c
 310 c====
 311 c 5. fin
 312 c====
 313 c
 314    50   continue
 315 cgn      write (ulsort,90002) 'ideb4, ifin4',ideb4, ifin4
 316 c
 317       end