Télécharger cforma.eso

Retour à la liste

Numérotation des lignes :

cforma
  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.  
  82.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales