Esope source files

   1 : C CFORMA    SOURCE    CHAT      05/01/12    21:53:15     5004           
   2 : c subroutine utilisee dans tableau
   3 : ***************************************************
   4 : *
   5 : *  FORMAT UNE CHAINE EN NBMCX MORCEAUX DE 
   6 : *  LONGUEUR MAXI MCXLNG
   7 : *  LI EST UN POINTEUR SUR UNE LISTE D'ENTIERS
   8 : *   - QUI N'EST PAS ALLOUER AVANT L'APPEL
   9 : *   - QU'IL NE FAUT PAS OUBLIER DE DESALLOUER APRES
  10 : *   - LES CHIFFRES VONT 2 PAR 2, LE PREMIER INDIQUE
  11 : *  LE PREMIER CARACTERE DE LA SOUS CHAINE ET LE SECOND
  12 : *  INDIQUE LE DERNIER CARACTERE.
  13 : ***************************************************
  14 :         SUBROUTINE CFORMA (CHAINE,MCXLNG,NBMCX,LI)
  15 : 
  16 : *
  17 : *  DEFINITION DES VARIABLES
  18 : *
  19 :       IMPLICIT INTEGER(I-N)
  20 : -INC TMNTAB
  21 : -INC SMLENTI
  22 :         CHARACTER*(*)   CHAINE
  23 :         INTEGER         MCXLNG,NBMCX
  24 :         POINTEUR        LI.MLENTI
  25 :         INTEGER         JG,IX,LONG,IPC,ICC,IDB
  26 : *
  27 :         IF (LI.NE.0) SEGSUP LI
  28 :         NBMCX = 0
  29 :         IF (MCXLNG.LT.2) RETURN
  30 : *
  31 : * RECHERCHER LA VRAIE LONGUEUR (SANS LES ESPACES A LA FIN)
  32 :         DO 3002 IX=LEN(CHAINE) , 1 , -1
  33 :         IF(CHAINE(IX:IX).NE.' ') GOTO 3003
  34 : 3002    CONTINUE
  35 : 3003    LONG = IX
  36 :         IF(LONG.LE.2) RETURN
  37 : * INITIALISER LA LISTE D'ENTIERS
  38 :         JG = LONG/MCXLNG*4 + 4
  39 :         SEGINI LI
  40 : 
  41 : * INI
  42 :         ICC = 1
  43 : 
  44 : * DEBUT DE CYCLE
  45 : 3004    CONTINUE
  46 :         IPC    = 1
  47 :         NBMCX = NBMCX + 1
  48 :         IDB   = -1
  49 :         LI.LECT(2*NBMCX-1) = ICC
  50 : 
  51 : * TESTS
  52 : 3006    CONTINUE
  53 :         IF (ICC.EQ.LONG) THEN
  54 :           LI.LECT(2*NBMCX) = ICC
  55 :           GOTO 3010
  56 :         ENDIF
  57 :         IF (IPC.EQ.MCXLNG) THEN
  58 :           IF (IDB.EQ.(-1)) THEN
  59 :             LI.LECT(2*NBMCX) = ICC
  60 :             ICC = ICC + 1
  61 :             GOTO 3004
  62 :           ENDIF
  63 :           LI.LECT(2*NBMCX) = IDB-1
  64 :           ICC = IDB+1
  65 :           GOTO 3004
  66 :         ENDIF
  67 : 
  68 : * INCREMENTATION
  69 : 3008    IF (CHAINE(ICC:ICC).EQ.' ')  IDB=ICC
  70 :         ICC = ICC+1
  71 :         IPC = IPC+1
  72 :         GOTO 3006
  73 : 
  74 : * FINIR
  75 : 3010    CONTINUE
  76 :         SEGDES LI
  77 : *
  78 :         END
  79 : 
  80 :  
  81 :