Sources Esope | Cast3M

cforma
C CFORMA    SOURCE    CHAT      05/01/12    21:53:15     5004
c subroutine utilisee dans tableau
***************************************************
*
*  FORMAT UNE CHAINE EN NBMCX MORCEAUX DE
*  LONGUEUR MAXI MCXLNG
*  LI EST UN POINTEUR SUR UNE LISTE D'ENTIERS
*   - QUI N'EST PAS ALLOUER AVANT L'APPEL
*   - QU'IL NE FAUT PAS OUBLIER DE DESALLOUER APRES
*   - LES CHIFFRES VONT 2 PAR 2, LE PREMIER INDIQUE
*  LE PREMIER CARACTERE DE LA SOUS CHAINE ET LE SECOND
*  INDIQUE LE DERNIER CARACTERE.
***************************************************
        SUBROUTINE CFORMA (CHAINE,MCXLNG,NBMCX,LI)
 
*
*  DEFINITION DES VARIABLES
*
      IMPLICIT INTEGER(I-N)
-INC TMNTAB
-INC SMLENTI
        CHARACTER*(*)   CHAINE
        INTEGER         MCXLNG,NBMCX
        POINTEUR        LI.MLENTI
        INTEGER         JG,IX,LONG,IPC,ICC,IDB
*
        IF (LI.NE.0) SEGSUP LI
        NBMCX = 0
        IF (MCXLNG.LT.2) RETURN
*
* RECHERCHER LA VRAIE LONGUEUR (SANS LES ESPACES A LA FIN)
        DO 3002 IX=LEN(CHAINE) , 1 , -1
        IF(CHAINE(IX:IX).NE.' ') GOTO 3003
3002    CONTINUE
3003    LONG = IX
        IF(LONG.LE.2) RETURN
* INITIALISER LA LISTE D'ENTIERS
        JG = LONG/MCXLNG*4 + 4
        SEGINI LI
 
* INI
        ICC = 1
 
* DEBUT DE CYCLE
3004    CONTINUE
        IPC    = 1
        NBMCX = NBMCX + 1
        IDB   = -1
        LI.LECT(2*NBMCX-1) = ICC
 
* TESTS
3006    CONTINUE
        IF (ICC.EQ.LONG) THEN
          LI.LECT(2*NBMCX) = ICC
          GOTO 3010
        ENDIF
        IF (IPC.EQ.MCXLNG) THEN
          IF (IDB.EQ.(-1)) THEN
            LI.LECT(2*NBMCX) = ICC
            ICC = ICC + 1
            GOTO 3004
          ENDIF
          LI.LECT(2*NBMCX) = IDB-1
          ICC = IDB+1
          GOTO 3004
        ENDIF
 
* INCREMENTATION
3008    IF (CHAINE(ICC:ICC).EQ.' ')  IDB=ICC
        ICC = ICC+1
        IPC = IPC+1
        GOTO 3006
 
* FINIR
3010    CONTINUE
        SEGDES LI
*
        END