src/tool/Utilitaire/utdich.F

   1       subroutine utdich ( chain1, chain2,
   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 - teste la DIfference entre 2 CHaines de caracteres
  24 c   --                    --                 --
  25 c ______________________________________________________________________
  26 c .        .     .        .                                            .
  27 c .  nom   . e/s . taille .           description                      .
  28 c .____________________________________________________________________.
  29 c . chain1 . e   .char*(*). chaine de caractere 1 a comparer           .
  30 c . chain2 . e   .char*(*). chaine de caractere 2 a comparer           .
  31 c . ulsort . e   .   1    . unite logique de la sortie generale        .
  32 c . langue . e   .    1   . langue des messages                        .
  33 c .        .     .        . 1 : francais, 2 : anglais                  .
  34 c . codret .  s  .    1   . code de retour des modules                 .
  35 c .        .     .        . 0 : chaines identiques                     .
  36 c .        .     .        . 1 : longueurs identiques, contenu different.
  37 c .        .     .        . 2 : longueurs differentes                  .
  38 c .        .     .        . 10 : probleme de comparaison               .
  39 c ______________________________________________________________________
  40 c
  41 c====
  42 c 0. declarations et dimensionnement
  43 c====
  44 c
  45 c 0.1. ==> generalites
  46 c
  47       implicit none
  48       save
  49 c
  50       character*6 nompro
  51       parameter ( nompro = 'UTDICH' )
  52 c
  53 #include "nblang.h"
  54 c
  55 c 0.2. ==> communs
  56 c
  57 #include "envex1.h"
  58 c
  59 c 0.3. ==> arguments
  60 c
  61       character*(*) chain1, chain2
  62 c
  63       integer ulsort, langue, codret
  64 c
  65       integer nbmess
  66       parameter (nbmess = 10 )
  67       character*80 texte(nblang,nbmess)
  68 c
  69 c 0.4. ==> variables locales
  70 c
  71       integer iaux
  72       integer lg1, lg2
  73 c
  74 c 0.5. ==> initialisations
  75 c ______________________________________________________________________
  76 c
  77 c====
  78 c 1. messages
  79 c====
  80 c
  81 #include "impr01.h"
  82 c
  83 #ifdef _DEBUG_HOMARD_
  84       write (ulsort,texte(langue,1)) 'Entree', nompro
  85       call dmflsh (iaux)
  86 #endif
  87 c
  88       texte(1,10) = '(''Chaine'',i2,'' a comparer :'')'
  89       texte(1,4) = '(''Longueur de la chaine'',i2,'' = '',i8)'
  90       texte(1,5) = '(''La chaine est vide.'')'
  91 c
  92       texte(2,10) = '(''String #'',i2,'' :'')'
  93       texte(2,4) = '(''Length of #'',i2,'' : '',i8)'
  94       texte(2,5) = '(''The string is empty.'')'
  95 c
  96 #ifdef _DEBUG_HOMARD_
  97       write (ulsort,texte(langue,10)) 1
  98       write (ulsort,*) chain1
  99       write (ulsort,texte(langue,10)) 2
 100       write (ulsort,*) chain2
 101 #endif
 102 c
 103       iaux = -1
 104 c
 105 c====
 106 c 2. mesure des longueurs
 107 c====
 108 c
 109       call utlgut ( lg1, chain1, ulsort, langue, codret )
 110       if ( codret.eq.0 ) then
 111         call utlgut ( lg2, chain2, ulsort, langue, codret )
 112       endif
 113 c
 114 c====
 115 c 3. comparaison
 116 c====
 117 c
 118       if ( codret.eq.0 ) then
 119 c
 120 #ifdef _DEBUG_HOMARD_
 121       write (ulsort,texte(langue,4)) 1, lg1
 122       write (ulsort,texte(langue,4)) 2, lg2
 123 #endif
 124 c
 125       if ( lg1.eq.lg2 ) then
 126         if ( chain1(1:lg1).eq.chain2(1:lg2) ) then
 127           iaux = 0
 128         else
 129           iaux = 1
 130         endif
 131       else
 132         iaux = 2
 133       endif
 134 c
 135       endif
 136 c
 137 c====
 138 c 4. la fin
 139 c====
 140 c
 141       if ( codret.ne.0 ) then
 142 c
 143 #include "envex2.h"
 144       write (ulsort,texte(langue,1)) 'Sortie', nompro
 145       write (ulsort,texte(langue,2)) codret
 146       endif
 147 c
 148       if ( iaux.ge.0 ) then
 149         codret = iaux
 150       else
 151         codret = 10
 152 #ifdef _DEBUG_HOMARD_
 153       write (ulsort,texte(langue,1)) 'Sortie', nompro
 154       call dmflsh (iaux)
 155 #endif
 156 c
 157       endif
 158 c
 159       end