src/tool/Dependance_Machine/dmcpch.F

   1       subroutine dmcpch ( chain1, long1, chain2, long2 )
   2 c ______________________________________________________________________
   3 c
   4 c                             H O M A R D
   5 c
   6 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   7 c
   8 c Version originale enregistree le 18 juin 1996 sous le numero 96036
   9 c aupres des huissiers de justice Simart et Lavoir a Clamart
  10 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  11 c aupres des huissiers de justice
  12 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  13 c
  14 c    HOMARD est une marque deposee d'Electricite de France
  15 c
  16 c Copyright EDF 1996
  17 c Copyright EDF 1998
  18 c Copyright EDF 2002
  19 c Copyright EDF 2020
  20 c ______________________________________________________________________
  21 c   Dependance Machine : CoPie de CHaine de caracteres
  22 c   -          -         - -      --
  23 c ______________________________________________________________________
  24 c
  25 c
  26 c but : copie "prudente" de la chaine 1 dans la chaine 2
  27 c
  28 c       . les eventuels caracteres non imprimables sont remplaces      .
  29 c       par des blancs ... sauf ceux en debut et fin de chaine,        .
  30 c       qui sont elimines.                                             .
  31 c
  32 c dependance machine : code ASCII
  33 c                      ( blanc = 32, et
  34 c                        non imprimable <==> code < 32 ...
  35 c                        ... sauf que les TAB (code 9) sont remplaces
  36 c                        par un blanc chacun )
  37 c ______________________________________________________________________
  38 c .        .     .        .                                            .
  39 c .  nom   . e/s . taille .           description                      .
  40 c .____________________________________________________________________.
  41 c . chain1 . e   . char * . chaine "source"                            .
  42 c . long1  . e   .    1   . longueur utile de la chaine "source"       .
  43 c . chain2 .  s  . char * . chaine "cible"                             .
  44 c . long2  .  s  .    1   . longueur utile de la chaine "cible"        .
  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 c 0.2. ==> communs
  57 c
  58 c 0.3. ==> arguments
  59 c
  60       integer       long1, long2
  61       character*(*) chain1, chain2
  62 c
  63 c 0.4. ==> variables locales
  64 c
  65       integer long, iaux, deb, fin, dern0, deb1, p0
  66 c
  67 c 0.5. ==> initialisations
  68 c ______________________________________________________________________
  69 c
  70 c====
  71 c 1.
  72 c====
  73 c
  74       long = 0
  75       deb = 0
  76       deb1 = 0
  77       dern0 = 0
  78       p0 = -1
  79 c
  80       do 1 iaux = 1, min( len(chain1), long1 )
  81         if ( ichar(chain1(iaux:iaux)).gt.32 ) then
  82           if ( deb.eq.0 ) then
  83             deb = iaux
  84           endif
  85           fin = iaux
  86           p0 = 0
  87           if ( long.lt.len(chain2) ) then
  88             if ( deb1.eq.0 ) then
  89               deb1 = iaux
  90             endif
  91             long = long + 1
  92             chain2(long:long) = chain1(iaux:iaux)
  93           endif
  94         else if ( ichar(chain1(iaux:iaux)).eq.32 .or.
  95      >            ichar(chain1(iaux:iaux)).eq.9       ) then
  96           if ( deb.eq.0 ) then
  97             deb = iaux
  98           endif
  99           if ( long.lt.len(chain2) ) then
 100             long = long + 1
 101             chain2(long:long) = ' '
 102           endif
 103         else
 104 c
 105 c non imprimables:
 106 c
 107           if ( deb.gt.0 .and. long.lt.len(chain2) ) then
 108             long = long + 1
 109             chain2(long:long) = ' '
 110           endif
 111           dern0 = iaux
 112           if ( p0.eq.0 ) then
 113             p0 = iaux
 114           endif
 115         endif
 116     1 continue
 117 c
 118 c On complete eventuellement avec des blancs :
 119 c (mais qui ne seront pas comptes dans long2)
 120 c
 121       do 10 iaux = long+1, len(chain2)
 122         chain2(iaux:iaux) = ' '
 123    10 continue
 124 c
 125 c Bilan :
 126 c
 127       if ( deb1.gt.0 ) then
 128 c
 129 c Il y a au moins un caractere imprimable et non blanc, qui a pu
 130 c etre copie de la chaine source chain1 vers la cible chain2 :
 131 c (deb1 est le premier de ceux-ci dans chain1)
 132 c
 133         if ( dern0.lt.fin ) then
 134           long2 = long
 135         else
 136 c
 137 c Apres le dernier caractere imprimable et non blanc de chain1 (fin),
 138 c on a trouve : des blancs eventuels, puis un premier caractere non
 139 c imprimable (p0), puis eventuellement des blancs ou non impr.
 140 c puis enfin un dernier caractere non impr. (dern0, >= p0),
 141 c puis des blancs eventuels.
 142 c
 143 c deb pointe sur le premier caractere "utile" (blanc ou imprimable)
 144 c de chaine1 (deb<=deb1<=fin)
 145 c p0-1 serait le dernier caractere "utile" de chaine1 (fin<=p0-1)
 146 c
 147           long2 = min( max(0,len(chain2)) , p0-deb )
 148 c
 149         endif
 150 c
 151       else
 152 c
 153 c chaine "source" vide, ou entierement blanche(+caracteres non impr.) :
 154 c
 155         long2 = 0
 156 c
 157       endif
 158 c
 159       end