Télécharger la plaquette Cast3M


fr en

Télécharger lircsv.eso

Retour à la liste

Numérotation des lignes : 

lircsv

  1. C LIRCSV    SOURCE    CB215821  23/08/09    21:15:03     11721          
  2.       SUBROUTINE LIRCSV
  3.  
  4. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  5. C
  6. C BUT: Lecture des donnes dans un fichier ASCII sous forme 'CSV'
  7. C      Possibilite de changer le separateur
  8. C      Pas besoin de specifier la longueur des objets LISTREEL a lire,
  9. C      un premier decompte est fait jusqu'à atteindre la fin du fichier
  10. C
  11. C Auteur : Clement BERTHINIER
  12. C Date   : ORIGINAL  Avril 2014
  13. C
  14. C Améliorations à prévoir :
  15. C      Possibilite de changer la virgule (Options Regionales)
  16. C
  17. C
  18. C Liste des Corrections :
  19. C CB215821 09/03/2016 : Fortran runtime error en cas de fichier VIDE...
  20. C CB215821 09/06/2016 : Possibilite d''utiliser le séparateur ' '
  21. C CB215821 10/06/2016 : Tentative de lire la case 0 d'une chaine
  22. C                       Meilleure gestion des SEGMENTS
  23. C CB215821 14/04/2017 : Declaration  de la  ligne dans  un  SEGMENT pour
  24. C                       lire toutes les tailles de lignes
  25. C                       Ajout d''un DATA contenant les caracteres qu''il
  26. C                       est possible de lire (sinon ' ')
  27. C CB215821 07/11/2019 : Traduction du separateur decimal ',' par '.'
  28. C CB215821 05/12/2019 : Lecture en colonne 'COLO' ou en ligne 'LIGN'
  29. C CB215821 10/12/2019 : Si le separateur est ' ' les separateurs successifs
  30. C                       ne sont consideres que comme 1 seul !
  31. C CB215821 18/10/2020 : Ajout de clarte dans les messages d'erreur pour
  32. C                       l'existence, l'ouverture et la fermeture des fichiers lus
  33. C JB251061 04/07/2022 : Ajout de la possibilite de mettre des en-tetes sur la
  34. C                       premiere ligne du fichier. Ces en-tetes sont utilises
  35. C                       comme indices de la table resultats si la lecture est
  36. C                       faite en colonnes, et sont retournes sous forme de LISTMOTS
  37. C                       si elle est faite en lignes.
  38. C CB215821 15/11/2022 : Initialisation necessaire de la premiere ligne lue (IFIRST)
  39. C                       a cause d'un UNDERFLOW sur un INTEGER sous WIN32
  40. C Augustin 06/06/2023 : Ajout du mot clé 'FIN' suivi d'un entier afin de pouvoir
  41. C                       donner la derniere ligne a lire.
  42. C
  43. C Appelee par : LIREFI
  44. C
  45. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  46.  
  47.  
  48.  
  49. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  50. CC                       DEBUT DES DECLARATIONS                       CC
  51. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  52.  
  53.       IMPLICIT INTEGER(I-N)
  54.       IMPLICIT REAL*8 (A-H,O-Z)
  55.  
  56.  
  57. -INC PPARAM
  58. -INC CCOPTIO
  59. -INC CCREDLE
  60. -INC SMLREEL
  61. -INC SMLMOTS
  62. -INC SMTABLE
  63.  
  64. C Declaration des chaines de caracteres
  65.       CHARACTER*1 SEP,CHA1
  66.       CHARACTER*(LOCHAI) Fichier,INDICE,MOVAR
  67.       CHARACTER*4 CHA4
  68.       CHARACTER*10 CHA10
  69.  
  70. C     Liste des CARACTERES RECONNUS pour détecter les CR et LF
  71.       CHARACTER*93 CARAOK
  72.       DATA CARAOK /' 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNO
  73.      &PQRSTUVWXYZ+-/*.,:;_#$%&()[]{}<=>?@`|~!"'''/
  74.  
  75. C Liste des mots clé OPTIONNELS
  76.       PARAMETER (NBOPT=5)
  77.       CHARACTER*4 MCLOPT(NBOPT)
  78.       DATA MCLOPT / 'DEBU','SEPA','COLO','LIGN','FIN' /
  79.  
  80. C     MACRO reprenant les options fournies pour ne pas tester de chaines
  81.       MACRO, (DEBU, SEPA, COLO, LIGN, FIN)
  82.  
  83.       INTEGER        MCLLUS(NBOPT)
  84. C                    MCLLUS : Tableau indiquant qu'un mot cle a ete lu
  85.       LOGICAL EN_COLONNES,EXISTE_FICHIER,EST_OUVERT,SEP_PAS_VIRGULE
  86.      &       ,EXISTE_ENTETE
  87.  
  88. C Declaration des PARAMETER
  89. C     Unite logique du fichier d'impression au format CSV
  90.       PARAMETER (IUCSV=67)
  91.  
  92.  
  93. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  94. C Declaration des SEGMENTS                                             C
  95. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  96.  
  97. C     Segment pour s'adapter a la taille de la ligne a lire
  98.       SEGMENT SLIGNE
  99. C       LONGLI  : Longueur de la ligne la plus longue a lire dans le fichier
  100.         CHARACTER*(LONGLI) LignFi
  101.       ENDSEGMENT
  102.  
  103. C     Segment contenant les Valeurs lues
  104.       SEGMENT XVALU(NVALIG, NLIGLU)
  105. C       NVALIG  : Nombre de valeurs sur une ligne
  106. C       NLIGLU  : Nombre de lignes utiles lues
  107.  
  108. C     SEGMENT CONTENANT LES ENTETES
  109.       SEGMENT SENTETE
  110.         CHARACTER*(LOCHAI) ENTETE(NVALIG)
  111.       ENDSEGMENT
  112.  
  113. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  114. CC                          Initialisations                           CC
  115. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  116.  
  117.       NVALIG = 0
  118.       NLIGLU = 1024
  119.       LONGLI = 2048
  120.       ICOEF = 2
  121.       IDEB = 0
  122.       IFIN = 0
  123.       EN_COLONNES = .TRUE.
  124.  
  125.       DO IOPT=1,NBOPT
  126.         MCLLUS(IOPT) = 0
  127.       ENDDO
  128.  
  129. C     Le separateur de nombre par defaut est le ';'
  130.       SEP = ';'
  131.  
  132. C     Par defaut la premiere ligne lue est la ligne n°1
  133.       IFIRST = 1
  134.  
  135. C     Par defaut la dernière ligne lue est initialisee negative (car optionnel)
  136.       ILAST = -1
  137.  
  138. C Lecture des arguments : Nom du fichier a lire
  139.       CALL LIRCHA(Fichier, 1, IRETO1)
  140.       IF (IERR.NE.0) RETURN
  141.  
  142. C Ouverture du fichier
  143. C     Test d'existence
  144.       INQUIRE(FILE=Fichier(1:LEN(Fichier)), EXIST=EXISTE_FICHIER)
  145.       IF (EXISTE_FICHIER) THEN
  146. C       Teste si le fichier est deja ouvert
  147.         INQUIRE(FILE=Fichier(1:LEN(Fichier)), OPENED=EST_OUVERT)
  148.  
  149.         IF (EST_OUVERT) THEN
  150.           CLOSE(UNIT=IUCSV, IOSTAT=IOSTA1)
  151. C         Traitement des erreurs de fermeture
  152.           IF (IOSTA1.NE.0) THEN
  153.             MOTERR = Fichier
  154.             CALL ERREUR(1131)
  155.             RETURN
  156.           ENDIF
  157.  
  158.           OPEN (UNIT=IUCSV, STATUS='OLD', FILE=Fichier(1:LEN(Fichier)),
  159.      &          IOSTAT=IOSTA1, FORM='FORMATTED')
  160. C         Traitement des erreurs d'ouverture des fichiers
  161.           IF (IOSTA1.NE.0) THEN
  162. C           Erreur 424 : Probleme %i1 en ouvrant le fichier : %M1:128
  163.             MOTERR = Fichier
  164.             INTERR(1) = IOSTA1
  165.             CALL ERREUR(424)
  166.             RETURN
  167.           ENDIF
  168.  
  169.         ELSE
  170.           OPEN (UNIT=IUCSV, STATUS='OLD', FILE=Fichier(1:LEN(Fichier)),
  171.      &          IOSTAT=IOSTA1, FORM='FORMATTED')
  172.  
  173. C         Traitement des erreurs d'ouverture des fichiers
  174.           IF (IOSTA1.NE.0) THEN
  175. C           Erreur 424 : Probleme %i1 en ouvrant le fichier : %M1:128
  176.             MOTERR = Fichier
  177.             INTERR(1) = IOSTA1
  178.             CALL ERREUR(424)
  179.             RETURN
  180.           ENDIF
  181.         ENDIF
  182.  
  183.       ELSE
  184.         MOTERR = Fichier
  185.         CALL ERREUR(1130)
  186.         RETURN
  187.       ENDIF
  188.  
  189. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  190. CC                        DECODAGE DES OPTIONS                        CC
  191. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  192.  
  193.  150  CONTINUE
  194. C     Lecture OPTIONNELLE des Options
  195.       CALL LIRMOT(MCLOPT, NBOPT, IRETO1, 0)
  196.       IF (IERR .NE. 0) RETURN
  197.       IF (IRETO1 .EQ. 0) GOTO 2
  198.  
  199.       IF (MCLLUS(IRETO1).EQ.1) THEN
  200. C     Le MOT CLE a deja ete lu
  201.         MOTERR = MCLOPT(IRETO1)
  202.         CALL ERREUR(1105)
  203.         RETURN
  204.  
  205.       ELSE
  206.         MCLLUS(IRETO1) = 1
  207.       ENDIF
  208.  
  209.       CASE,IRETO1
  210.  
  211.         WHEN, DEBU
  212. C         Lecture OBLIGATOIRE d'un ENTIER (Ligne/Colonne du debut)
  213.           CALL LIRENT(IFIRST, 1, IRETO2)
  214.           IF (IERR.NE.0) RETURN
  215.           IF (IFIRST.LT.1) THEN
  216.             CALL ERREUR(1107)
  217.             RETURN
  218.           ENDIF
  219.  
  220.         WHEN, FIN
  221. C         Lecture OBLIGATOIRE d'un ENTIER (Ligne/Colonne de fin)
  222.           CALL LIRENT(ILAST, 1, IRETO3)
  223.           IF (IERR .NE. 0) RETURN
  224.           IF (ILAST.LT. 1) THEN
  225.             INTERR(1) = 1
  226.             INTERR(2) = ILAST
  227.             CALL ERREUR(190)
  228.             RETURN
  229.           ENDIF
  230.  
  231.         WHEN, SEPA
  232. C         Lecture OBLIGATOIRE d'un MOT (SEP)
  233.           CALL LIRCHA(SEP, 1, IRETO1)
  234.           IF (IERR.NE.0) RETURN
  235. C         Le separateur doit etre dans la liste des caracteres autorises
  236.           INDXE = INDEX(CARAOK, SEP)
  237.           IF (INDXE.EQ.0) THEN
  238.             MOTERR = SEP
  239.             CALL ERREUR(1106)
  240.             RETURN
  241.           ENDIF
  242.  
  243.         WHEN, COLO
  244. C         Lecture en COLONNE (c'est le defaut)
  245.           EN_COLONNES = .TRUE.
  246.  
  247.         WHEN, LIGN
  248. C         Lecture en LIGNE
  249.           EN_COLONNES = .FALSE.
  250.       ENDCASE
  251.       GOTO 150
  252.  
  253. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  254. CC                         LECTURE DU FICHIER                         CC
  255. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  256.  2    CONTINUE
  257.       NUMLIG = 0
  258.       NBLIGN = 0
  259.       NBSEP  = 0
  260.  
  261.       SEP_PAS_VIRGULE = SEP.NE.','
  262.       EXISTE_ENTETE = .FALSE.
  263.  
  264.       SEGINI,SLIGNE
  265.       CALL INIRED(SREDLE)
  266.  
  267. C     On saute les (IFIRST-1) premieres lignes
  268.       DO I=1,(IFIRST-1)
  269.         NUMLIG = NUMLIG + 1
  270.         READ(IUCSV, 1000, IOSTAT=IOSTA1, ERR=902, END=901) LignFi
  271.         IF (IOSTA1.NE.0) GOTO 902
  272.       ENDDO
  273.  
  274.  
  275. C     Boucle de lecture des lignes
  276. 10    CONTINUE
  277.       IF (IERR.NE.0) RETURN
  278.       NUMLIG = NUMLIG + 1
  279.       IF (NUMLIG .EQ. ILAST+1) GOTO 100
  280.  
  281.  
  282. C     Lecture de la ligne complete
  283.       READ(IUCSV, 1000, IOSTAT=IOSTA1, ERR=902, END=100) LignFi
  284.       IF (IOSTA1.NE.0) GOTO 902
  285.       LCOURA = LONGLI
  286.  
  287.       DO J=1,LCOURA
  288. C       Remplacement des caracteres non present dans le DATA par ' '
  289.         INDXE = INDEX(CARAOK, LignFi(J:J))
  290.         IF (INDXE.EQ.0) THEN
  291.           LignFi(J:J) = ' '
  292.         ENDIF
  293.       ENDDO
  294.  
  295. C     Detection du dernier caractere qui n'est pas ' ' ou le separateur
  296.       J = LCOURA
  297.       DO WHILE (J.GT.0.AND.
  298.      &          (LignFi(J:J).EQ.' '.OR.LignFi(J:J).EQ.SEP))
  299.         J = J - 1
  300.       ENDDO
  301.  
  302.       IF (J.EQ.0) THEN
  303. C       Que des espaces et des separateurs sur la ligne => on saute la ligne
  304.         GOTO 10
  305.  
  306.       ELSEIF (J.GT.(LONGLI - 64)) THEN
  307. C       Un caractere non espace et non separateur dans les 64 derniers caracteres
  308. C       => On augmente la taille de la ligne pour ne pas manquer des caracteres
  309.         LONGLI = J * ICOEF
  310.         SEGADJ,SLIGNE
  311. C       On recommence le fichier depuis le depart
  312.         REWIND(UNIT=IUCSV, IOSTAT=IOSTA1, ERR=902)
  313.         IF (IOSTA1.NE.0) GOTO 902
  314.         GOTO 2
  315.  
  316.       ELSE
  317. C       Sinon on peut utiliser la longueur trouvee
  318.         LLIGN = J
  319.       ENDIF
  320.  
  321. C     Detection du premier caractere qui n'est pas ' '
  322.       IF (SEP.EQ.' ') THEN
  323.         J = 1
  324.         DO WHILE (J.LT.LLIGN.AND.LIGNFI(J:J).EQ.' ')
  325.           J = J + 1
  326.         ENDDO
  327.         IF (J.EQ.LLIGN.AND.LIGNFI(J:J).EQ.' ') GOTO 10
  328.         IDEBLI = J
  329.  
  330.       ELSE
  331.         IDEBLI = 1
  332.       ENDIF
  333.  
  334. C     Cas ou la ligne n'est pas vide
  335.       NBLIGN = NBLIGN + 1
  336.  
  337. C     Compte le nombre de separateurs
  338.       NBSEP = 0
  339.       DO J=IDEBLI,LLIGN
  340.         CHA1 = LignFi(J:J)
  341.         IF (CHA1.EQ.SEP) THEN
  342.           NBSEP = NBSEP + 1
  343.           IF (J.GT.1) THEN
  344.             CHA1 = LignFi(J-1:J-1)
  345.             IF(CHA1.EQ.SEP.AND.SEP.EQ.' ') THEN
  346.               NBSEP = NBSEP - 1
  347.             ENDIF
  348.           ENDIF
  349.         ENDIF
  350.       ENDDO
  351.       IF (NBLIGN.EQ.1) THEN
  352.         NBSEP1 = NBSEP
  353.       ENDIF
  354.  
  355.       IF (NBSEP.NE.NBSEP1) THEN
  356.         INTERR(1) = NBSEP1
  357.         INTERR(2) = IFIRST
  358.         INTERR(3) = NBSEP
  359.         INTERR(4) = NUMLIG
  360.         MOTERR = SEP
  361.         CALL ERREUR(1109)
  362.         RETURN
  363.       ENDIF
  364.  
  365.       IF (NBLIGN.EQ.1) THEN
  366. C       Creation de XVALU
  367.         NVALIG = NBSEP+1
  368.         SEGINI,XVALU,SENTETE
  369.       ELSEIF (NBLIGN.GT.NLIGLU) THEN
  370. C       Ajustement de XVALU a la volee
  371.         NLIGLU = NBLIGN * ICOEF
  372.         SEGADJ,XVALU
  373.       ENDIF
  374.  
  375. C     Remplissage de XVALU ET SENTETE avec les valeurs lues
  376.       IDEB = IDEBLI
  377.       IFIN = IDEB
  378.       NUVALU = 0
  379.       DO WHILE (IFIN .LT. LLIGN)
  380.         NUVALU = NUVALU + 1
  381.         IF (NUVALU.GT.NVALIG) THEN
  382.           CALL ERREUR(217)
  383.           RETURN
  384.         ENDIF
  385.  
  386.         IFIN = INDEX(LIGNFI(IDEB:LLIGN), SEP)
  387.         IF (IFIN.EQ.0) THEN
  388.           IFIN = LLIGN
  389.  
  390.         ELSE
  391.           IFIN = IDEB + IFIN - 2
  392.         ENDIF
  393.  
  394.         IF (NBLIGN.EQ.1) THEN
  395. C         Au cas on la sauvegarde la premiere ligne comme entete
  396.           IENTE=IDEB
  397.           DO WHILE (LIGNFI(IENTE:IENTE) .EQ. ' ')
  398.             IENTE = IENTE + 1
  399.           ENDDO
  400.           ENTETE(NUVALU)=LIGNFI(IENTE:IFIN)
  401.         ENDIF
  402.  
  403. C       Decodage de la chaine (Tel quel)
  404.         NRAN  = 0
  405.         ICOUR = IFIN - IDEB + 1
  406.         TEXT  = LIGNFI(IDEB:IFIN)
  407.  
  408. C       On converti le separateur decimal ',' en '.' a la volee si le separateur de valeur n'est pas ',' lui meme
  409.         IF(SEP_PAS_VIRGULE)THEN
  410.           IVIRG = INDEX(TEXT, ',')
  411.           IF (IVIRG .GT. 0) THEN
  412.             TEXT(IVIRG:IVIRG) = '.'
  413.           ENDIF
  414.         ENDIF
  415.  
  416.         CALL REDLEC(SREDLE)
  417.         IRE_1 = SREDLE.IRE
  418.  
  419.         I_Compt=0
  420.         DO WHILE (IRE .NE. 0)
  421.           I_Compt = I_Compt + 1
  422.           CALL REDLEC(SREDLE)
  423.         ENDDO
  424.  
  425. C       Si on a lu quelque chose en 1 seul coup ==> On remet le 1er type lu
  426.         IF (I_Compt .EQ. 1)THEN
  427.           IRE = IRE_1
  428.  
  429.         ELSE
  430.           IRE = 3
  431.         ENDIF
  432.  
  433. C       On n'a lu ni un ENTIER ni un FLOTTANT, est-ce la premiere ligne ? ==> Entetes
  434.         IF (IRE .NE. 1 .AND. IRE.NE.2)THEN
  435.           IF (NBLIGN.EQ.1)THEN
  436.             EXISTE_ENTETE = .TRUE.
  437.           ELSE
  438.             GOTO 902
  439.           ENDIF
  440.         ENDIF
  441.  
  442. C       Enregistrement des valeurs dans les LISTREELS
  443.         IF (EXISTE_ENTETE .AND. NBLIGN.GT.1) THEN
  444.           XVALU(NUVALU, NBLIGN - 1) = SREDLE.FLOT
  445.  
  446.         ELSE
  447.           XVALU(NUVALU, NBLIGN) = SREDLE.FLOT
  448.         ENDIF
  449.  
  450.         IF (SEP.EQ.' ') THEN
  451. C         SI LE SEAPARATEUR EST ' ' ON AVANCE JUSQU'AU DERNIER ' ' CONSECUTIF
  452.           IFIN = IFIN + 1
  453.           DO WHILE (LIGNFI(IFIN:IFIN).EQ.' ')
  454.             IFIN = IFIN + 1
  455.           ENDDO
  456.           IFIN = IFIN - 1
  457.           IDEB = IFIN + 1
  458.  
  459.         ELSE
  460. C         SINON IL NE PEUT Y AVOIR QU'UN SEUL SEPARATEUR AVANT LA PROCHAINE VALEUR
  461.           IDEB = IFIN + 2
  462.         ENDIF
  463.       ENDDO
  464.  
  465. C     Lecture d'une nouvelle ligne
  466.       GOTO 10
  467.  
  468.  
  469. 100   CONTINUE
  470. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  471. CC                        FIN LECTURE FICHIER                         CC
  472. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  473.       CLOSE(UNIT=IUCSV, IOSTAT=IOSTA1)
  474. C     Traitement des erreurs de fermeture
  475.       IF (IOSTA1.NE.0) THEN
  476.         MOTERR = Fichier
  477.         CALL ERREUR(1131)
  478.         RETURN
  479.       ENDIF
  480.  
  481. C     Creation du resultat TABLE et des LISTREELS solution
  482.       IF (EXISTE_ENTETE) THEN
  483.         NBLIGN = NBLIGN - 1
  484.       ENDIF
  485.  
  486.       IF (EN_COLONNES) THEN
  487. C       Cas lecture en COLONNES
  488.         M = NVALIG
  489.         SEGINI,MTABLE
  490.         MTABLE.MLOTAB = M
  491.         JG=NBLIGN
  492.         DO IVA=1,NVALIG
  493.           SEGINI,MLREEL
  494.           DO ILI=1,NBLIGN
  495.             MLREEL.PROG(ILI) = XVALU(IVA, ILI)
  496.           ENDDO
  497.           IF (EXISTE_ENTETE) THEN
  498.             INDICE = ENTETE(IVA)
  499. C           ON ENLEVE LES ESPACES A LA FIN
  500.             J = LOCHAI
  501.             DO WHILE (INDICE(J:J).EQ.' ')
  502.               J = J - 1
  503.             ENDDO
  504. C           ON APPELLE POSCHA POUR DONNER LA POSITION EN MEMOIRE DE LA CHAINE A LA TABLE
  505.             CALL POSCHA(INDICE(1:J), IRET)
  506.             MTABLE.MTABTI(IVA) = 'MOT'
  507.             MTABLE.MTABII(IVA) = IRET
  508.  
  509.           ELSE
  510.             MTABLE.MTABTI(IVA) = 'ENTIER'
  511.             MTABLE.MTABII(IVA) = IVA
  512.           ENDIF
  513.           MTABLE.MTABTV(IVA) = 'LISTREEL'
  514.           MTABLE.MTABIV(IVA) = MLREEL
  515.           SEGACT,MLREEL
  516.         ENDDO
  517.  
  518.       ELSE
  519. C       Cas lecture en LIGNES
  520.         M = NBLIGN
  521.         IF (EXISTE_ENTETE) M = M + 1
  522.         SEGINI,MTABLE
  523.         MTABLE.MLOTAB = M
  524.         JG = NVALIG
  525.         IF (EXISTE_ENTETE) THEN
  526.           JGN = 0
  527.           JGM = NVALIG
  528.           SEGINI,MLMOTS
  529.           DO IVA=1,NVALIG
  530.             INDICE = ENTETE(IVA)
  531. C           ON DETERMINE LA LONGUEUR DE L'EN-TETE
  532.             J = LOCHAI
  533.             DO WHILE (INDICE(J:J).EQ.' ')
  534.               J = J - 1
  535.             ENDDO
  536.             IF (JGN.LT.J) THEN
  537. C             SI L'EN-TETE EST PLUS LONG, ON AJUSTE MLMOTS
  538.               JGN = J
  539.               SEGADJ,MLMOTS
  540.             ENDIF
  541.             MLMOTS.MOTS(IVA) = INDICE(1:J)
  542.           ENDDO
  543.           MTABLE.MTABTI(1) = 'ENTIER'
  544.           MTABLE.MTABII(1) = 1
  545.           MTABLE.MTABTV(1) = 'LISTMOTS'
  546.           MTABLE.MTABIV(1) = MLMOTS
  547.           SEGACT,MLMOTS
  548.         ENDIF
  549.         DO ILI=1,NBLIGN
  550.           SEGINI,MLREEL
  551.           DO IVA=1,NVALIG
  552.             MLREEL.PROG(IVA) = XVALU(IVA, ILI)
  553.           ENDDO
  554.           IIND = ILI
  555.           IF (EXISTE_ENTETE) IIND = IIND + 1
  556.           MTABLE.MTABTI(IIND) = 'ENTIER'
  557.           MTABLE.MTABII(IIND) = IIND
  558.           MTABLE.MTABTV(IIND) = 'LISTREEL'
  559.           MTABLE.MTABIV(IIND) = MLREEL
  560.           SEGACT,MLREEL
  561.         ENDDO
  562.       ENDIF
  563.  
  564.       SEGDES,MTABLE
  565.       SEGSUP,SLIGNE,SREDLE
  566.       IF (NBLIGN.GT.0) SEGSUP,XVALU,SENTETE
  567.  
  568. C     Ecriture du resultat en sortie
  569.       CALL ECROBJ('TABLE   ',MTABLE)
  570.       RETURN
  571.  
  572.  901  CONTINUE
  573. C     La fin du fichier est atteinte avant même d'avoir commencé la lecture...
  574.       INTERR(1) = IFIRST
  575.       CALL ERREUR(36)
  576.       RETURN
  577.  
  578.  902  CONTINUE
  579.       INTERR(1) = NUMLIG
  580.       CALL ERREUR(1069)
  581.       RETURN
  582.  
  583.  1000 FORMAT(A)
  584.  
  585.       END
  586.  
  587.  
  588.  
  589.  
  590.  
  591.  

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