Télécharger lircsv.eso

Retour à la liste

Numérotation des lignes :

  1. C LIRCSV SOURCE CB215821 19/12/10 21:15:01 10425
  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 Possibilite de lire en ligne ou en colonne
  17. C
  18. C
  19. C Liste des Corrections :
  20. C CB215821 09/03/2016 : Fortran runtime error en cas de fichier VIDE...
  21. C CB215821 09/06/2016 : Possibilite d''utiliser le séparateur ' '
  22. C CB215821 10/06/2016 : Tentative de lire la case 0 d'une chaine
  23. C Meilleure gestion des SEGMENTS
  24. C CB215821 14/04/2017 : Declaration de la ligne dans un SEGMENT pour
  25. C lire toutes les tailles de lignes
  26. C Ajout d''un DATA contenant les caracteres qu''il
  27. C est possible de lire (sinon ' ')
  28. C CB215821 07/11/2019 : Traduction du separateur decimal ',' par '.'
  29. C CB215821 05/12/2019 : Lecture en colonne 'COLO' ou en ligne 'LIGN'
  30. C CB215821 10/12/2019 : Si le separateur est ' ' les separateurs successifs
  31. C ne sont consideres que comme 1 seul !
  32. C
  33. C Appelee par : LIREFI
  34. C
  35. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  36.  
  37.  
  38.  
  39. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  40. CC DEBUT DES DECLARATIONS CC
  41. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  42.  
  43. IMPLICIT INTEGER(I-N)
  44. IMPLICIT REAL*8 (A-H,O-Z)
  45.  
  46. -INC CCOPTIO
  47. -INC SMLREEL
  48. -INC SMTABLE
  49.  
  50. C Declaration des chaines de caracteres
  51. CHARACTER*1 Separa,CHA1,VID1
  52. CHARACTER*500 Fichier
  53. CHARACTER*4 CHA4
  54.  
  55. C Declaration des ENTIERS
  56. INTEGER IUCSV
  57. INTEGER ICOEF
  58. INTEGER NVALIG
  59. INTEGER NBLIGN
  60. INTEGER NBSEPA
  61. INTEGER NBSEPI
  62. INTEGER NBOPT
  63. INTEGER IDEB
  64. INTEGER IFIN
  65. INTEGER IOSTA1
  66.  
  67. C Declaration des FLOTTANTS
  68. REAL*8 FlotLu
  69.  
  70.  
  71. C Liste des CARACTERES RECONNUS pour détecter les CR et LF
  72. CHARACTER*93 CARAOK
  73. DATA CARAOK /' 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNO
  74. &PQRSTUVWXYZ+-/*.,:;_#$%&()[]{}<=>?@`|~!"'''/
  75.  
  76.  
  77.  
  78. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  79. C Declaration des SEGMENTS C
  80. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  81. C Segment pour s'adapter a la taille de la ligne a lire
  82. SEGMENT SLIGNE
  83. C LONGLI : Longueur de la ligne la plus longue a lire dans le fichier
  84. CHARACTER*(LONGLI) LignFi
  85. ENDSEGMENT
  86.  
  87. C Segment XVALU : Tableau contenant les Valeurs lues
  88. SEGMENT XVALU(NVALIG,NLIGLU)
  89. C NVALIG : Nombre de valeurs sur une ligne
  90. C NLIGLU : Nombre de lignes utiles lues
  91. C ENDSEGMENT
  92.  
  93. C Liste des mots clé OPTIONNELS
  94. PARAMETER (NBOPT=4)
  95. CHARACTER*4 MCLOPT(NBOPT)
  96. DATA MCLOPT / 'DEBU','SEPA','COLO','LIGN' /
  97. INTEGER MCLLUS(NBOPT)
  98. C MCLLUS : Tableau indiquant qu'un mot cle a ete lu
  99. LOGICAL BCOLO
  100. C BCOLO : Logique vrai si on lit en colonne et faux en ligne
  101.  
  102. C Declaration des PARAMETER
  103. C Unite logique du fichier d'impression au format CSV
  104. PARAMETER (IUCSV=67)
  105.  
  106.  
  107. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  108. CC Initialisations CC
  109. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  110. 1000 FORMAT(A)
  111.  
  112. NVALIG= 0
  113. NLIGLU= 1024
  114. LONGLI= 2048
  115. ICOEF = 2
  116. IDEB = 0
  117. IFIN = 0
  118. BCOLO =.TRUE.
  119. VID1 =' '
  120.  
  121. DO IOPT=1,NBOPT
  122. MCLLUS(IOPT)=0
  123. ENDDO
  124.  
  125. FlotLu=REAL(0.D0)
  126.  
  127. C Le separateur de nombre par defaut est le ';'
  128. Separa=';'
  129.  
  130. C Lecture des arguments : Nom du fichier a lire
  131. CALL LIRCHA(Fichier,1,IRETO1)
  132. IF (IERR .NE. 0) RETURN
  133.  
  134. C Par defaut, Erreur Cast3M numero 424
  135. C Erreur 424 : Probleme %i1 en ouvrant le fichier : %m1:40
  136. L =LEN(Fichier)
  137. L1=MIN(L,40)
  138. MOTERR(1:L1)=Fichier(1:L1)
  139. INTERR(1)=0
  140.  
  141. C Ouverture du fichier
  142. CLOSE(UNIT=IUCSV,ERR=990)
  143. OPEN (UNIT=IUCSV,STATUS='OLD',FILE=Fichier(1:L),
  144. & IOSTAT=IOSTA1,FORM='FORMATTED')
  145.  
  146. C Traitement des erreurs d'ouverture des fichiers
  147. IF (IOSTA1 .NE. 0) THEN
  148. INTERR(1)=IOSTA1
  149. CALL ERREUR(424)
  150. RETURN
  151. ENDIF
  152.  
  153. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  154. CC DECODAGE DES OPTIONS CC
  155. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  156. 1 CONTINUE
  157. C Lecture OPTIONNELLE des Options
  158. CALL LIRMOT(MCLOPT,NBOPT,IRETO1,0)
  159. IF (IERR .NE. 0) RETURN
  160.  
  161. IF(IRETO1 .EQ. 0) GOTO 2
  162. IF(MCLLUS(IRETO1) .EQ. 1) THEN
  163. C Le MOT CLE a deja ete lu
  164. MOTERR=MCLOPT(IRETO1)
  165. CALL ERREUR(1105)
  166. RETURN
  167. ELSE
  168. MCLLUS(IRETO1)=1
  169. ENDIF
  170.  
  171. IF (IRETO1 .EQ. 1) THEN
  172. C Cas de l'option 'DEBU'
  173. C Lecture OBLIGATOIRE d'un ENTIER (Ligne/Colonne du début)
  174. CALL LIRENT(IVALU,1,IRETO2)
  175. IF (IERR .NE. 0) RETURN
  176. IF(IVALU .LT. 1)THEN
  177. CALL ERREUR(1107)
  178. RETURN
  179. ENDIF
  180. GOTO 1
  181.  
  182. ELSEIF (IRETO1 .EQ. 2) THEN
  183. C Cas de l'option 'SEPA'
  184. C Lecture OBLIGATOIRE d'un MOT (Separa)
  185. CALL LIRCHA(Separa,1,IRETO1)
  186. IF (IERR .NE. 0) RETURN
  187.  
  188. C Le separateur doit etre dans la liste des caracteres autorises
  189. INDXE=INDEX(CARAOK,Separa)
  190. IF (INDXE .EQ. 0) THEN
  191. MOTERR=Separa
  192. CALL ERREUR(1106)
  193. RETURN
  194. ENDIF
  195. GOTO 1
  196.  
  197. ELSEIF (IRETO1 .EQ. 3) THEN
  198. C Lecture en COLONNE (c'est le defaut)
  199. BCOLO =.TRUE.
  200.  
  201. ELSEIF (IRETO1 .EQ. 4) THEN
  202. C Lecture en LIGNE
  203. BCOLO =.FALSE.
  204.  
  205. ELSE
  206. GOTO 1
  207. ENDIF
  208.  
  209.  
  210. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  211. CC LECTURE DU FICHIER CC
  212. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  213. 2 CONTINUE
  214. NUMLIG = 0
  215. NBLIGN = 0
  216. NBSEPI = 0
  217. NBSEPA = 0
  218.  
  219. SEGINI,SLIGNE
  220.  
  221. C On saute les (IVALU-1) premieres lignes
  222. IF (IVALU .GT. 1) THEN
  223. DO I=1,(IVALU-1)
  224. NUMLIG = NUMLIG + 1
  225. READ(IUCSV,1000,IOSTAT=IOSTA1,ERR=989,END=8) LignFi
  226. IF (IOSTA1 .NE. 0) GOTO 989
  227. ENDDO
  228. GOTO 10
  229. 8 CONTINUE
  230. C La fin du fichier est atteinte avant même d'avoir commencé la lecture...
  231. INTERR(1)=IVALU
  232. CALL ERREUR(36)
  233. RETURN
  234. ENDIF
  235.  
  236. C Boucle de lecture des lignes
  237. 10 CONTINUE
  238. IF (IERR .NE. 0) RETURN
  239. NUMLIG = NUMLIG + 1
  240.  
  241. C Lecture de la ligne complete
  242. READ(IUCSV,1000,IOSTAT=IOSTA1,ERR=989,END=100) LignFi
  243. IF (IOSTA1 .NE. 0) GOTO 989
  244. LCOURA = LONGLI
  245.  
  246. DO J=1,LCOURA
  247. C Remplacement des caracteres non present dans le DATA par ' '
  248. CHA1 =LignFi(J:J)
  249. INDXE=INDEX(CARAOK,CHA1)
  250. IF (INDXE .EQ. 0) THEN
  251. CHA1=VID1
  252. LignFi(J:J)=CHA1
  253. ENDIF
  254.  
  255. C Remplacement du separateur decimal ',' par '.'
  256. IF(Separa .NE. ',' .AND. CHA1.EQ.',') LignFi(J:J) = '.'
  257. ENDDO
  258.  
  259. C Detection de la longueur des lignes
  260. DO J=LCOURA,1,-1
  261. C Detection du premier caractere en partant de la fin qui n'est pas ' ' ni Separa
  262. CHA1 = LignFi(J:J)
  263. IF (CHA1 .NE. VID1 .AND. CHA1 .NE. Separa) THEN
  264. LLIGN=J
  265. IF (J .GT. (LONGLI - 64)) THEN
  266. LONGLI = J * ICOEF
  267. SEGSUP,SLIGNE
  268.  
  269. C On recommence le fichier depuis le depart
  270. REWIND(UNIT=IUCSV,IOSTAT=IOSTA1,ERR=989)
  271. IF (IOSTA1 .NE. 0) GOTO 989
  272. GOTO 2
  273.  
  274. CC On recommence depuis le dernier retour chariot (ATTENTION depend de Windows/Linux/MAC...)
  275. C BACKSPACE(UNIT=IUCSV,IOSTAT=IOSTA1,ERR=989)
  276. C IF (IOSTA1 .NE. 0) GOTO 989
  277. C NUMLIG = NUMLIG - 1
  278. C GOTO 10
  279. ENDIF
  280. GOTO 111
  281. ENDIF
  282. ENDDO
  283. GOTO 10
  284.  
  285. 111 CONTINUE
  286. IF (Separa .EQ. VID1) THEN
  287. DO J=1,LLIGN
  288. C Detection en partant du debut du premier caractere qui n'est pas ' '
  289. CHA1=LignFi(J:J)
  290. IF (CHA1 .NE. VID1) THEN
  291. IDEBLI=J
  292. GOTO 112
  293. ENDIF
  294. ENDDO
  295. GOTO 10
  296.  
  297. ELSE
  298. IDEBLI= 1
  299. ENDIF
  300.  
  301. 112 CONTINUE
  302. C Cas ou la ligne n'est pas vide
  303. NBLIGN = NBLIGN + 1
  304.  
  305. C Compte le nombre de separateurs
  306. NBSEPA=0
  307. DO J=IDEBLI,LLIGN
  308. CHA1=LignFi(J:J)
  309. IF (NBLIGN.EQ.1 .AND. CHA1.EQ.Separa) THEN
  310. C Cas de la premiere ligne
  311. NBSEPI = NBSEPI + 1
  312. IF(J .GT. 1)THEN
  313. CHA1=LignFi(J-1:J-1)
  314. IF(CHA1.EQ.Separa .AND. Separa.EQ.' ') THEN
  315. NBSEPI = NBSEPI - 1
  316. ENDIF
  317. ENDIF
  318. NBSEPA = NBSEPI
  319.  
  320. ELSEIF(NBLIGN.GT.1 .AND. CHA1.EQ.Separa) THEN
  321. C Cas des autres lignes
  322. NBSEPA = NBSEPA + 1
  323. IF(J .GT. 1)THEN
  324. CHA1=LignFi(J-1:J-1)
  325. IF(CHA1.EQ.Separa .AND. Separa.EQ.' ') THEN
  326. NBSEPA = NBSEPA - 1
  327. ENDIF
  328. ENDIF
  329. ENDIF
  330. ENDDO
  331.  
  332. IF(NBSEPA.NE.NBSEPI)THEN
  333. INTERR(1)= NBSEPI
  334. INTERR(2)= NBSEPA
  335. INTERR(3)= NUMLIG
  336. MOTERR = Separa
  337. CALL ERREUR(1109)
  338. RETURN
  339. ENDIF
  340.  
  341. IF (NBLIGN .EQ. 1) THEN
  342. C Creation de XVALU
  343. NVALIG=NBSEPI+1
  344. SEGINI,XVALU
  345.  
  346. ELSEIF (NBLIGN.GT.NLIGLU) THEN
  347. C Ajustement de XVALU a la volee
  348. NLIGLU=NBLIGN * ICOEF
  349. SEGADJ,XVALU
  350. ENDIF
  351.  
  352. C Remplissage des LISTREELS avec les valeurs lues
  353. C Remplissage de XVALU avec les valeurs lues
  354. IDEB = IDEBLI
  355. IFIN = IDEB
  356. NUVALU = 0
  357. DO 113 J=IDEBLI,LLIGN
  358. IF (LignFi(J-1:J-1).EQ.Separa .AND. (Separa.EQ.VID1)) THEN
  359. GOTO 113
  360. ELSEIF(LignFi(J:J) .EQ. Separa) THEN
  361. IFIN=J-1
  362. ELSEIF(J .EQ. LLIGN) THEN
  363. IFIN=LLIGN
  364. ELSE
  365. GOTO 113
  366. ENDIF
  367.  
  368. NUVALU = NUVALU + 1
  369. READ(LignFi(IDEB:IFIN),*,ERR=989,IOSTAT=IOSTA1) FlotLu
  370. IF (IOSTA1 .NE. 0) GOTO 989
  371.  
  372. IF (NUVALU .GT. NVALIG) THEN
  373. CALL ERREUR(217)
  374. RETURN
  375. ENDIF
  376. XVALU(NUVALU,NBLIGN)=FlotLu
  377. IDEB=J+1
  378. 113 CONTINUE
  379.  
  380. C Lecture d'une nouvelle ligne
  381. GOTO 10
  382.  
  383.  
  384. 100 CONTINUE
  385. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  386. CC FIN LECTURE FICHIER CC
  387. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  388. CLOSE(UNIT=IUCSV,ERR=990)
  389.  
  390. C Creation du resultat TABLE et des LISTREELS solution
  391. IF(BCOLO)THEN
  392. C Cas lecture en COLONNES
  393. M=NVALIG
  394. SEGINI,MTABLE
  395. MTABLE.MLOTAB=M
  396. JG=NBLIGN
  397. DO IVA=1,NVALIG
  398. SEGINI,MLREEL
  399. DO ILI=1,NBLIGN
  400. MLREEL.PROG(ILI)=XVALU(IVA,ILI)
  401. ENDDO
  402. MTABLE.MTABTI(IVA)='ENTIER'
  403. MTABLE.MTABII(IVA)= IVA
  404. MTABLE.MTABTV(IVA)='LISTREEL'
  405. MTABLE.MTABIV(IVA)= MLREEL
  406. SEGACT,MLREEL
  407. ENDDO
  408.  
  409. ELSE
  410. C Cas lecture en LIGNES
  411. M=NBLIGN
  412. SEGINI,MTABLE
  413. MTABLE.MLOTAB=M
  414. JG=NVALIG
  415. DO ILI=1,NBLIGN
  416. SEGINI,MLREEL
  417. DO IVA=1,NVALIG
  418. MLREEL.PROG(IVA)=XVALU(IVA,ILI)
  419. ENDDO
  420. MTABLE.MTABTI(ILI)='ENTIER'
  421. MTABLE.MTABII(ILI)= ILI
  422. MTABLE.MTABTV(ILI)='LISTREEL'
  423. MTABLE.MTABIV(ILI)= MLREEL
  424. SEGACT,MLREEL
  425. ENDDO
  426. ENDIF
  427.  
  428. SEGDES,MTABLE
  429. SEGSUP,SLIGNE,XVALU
  430.  
  431. C Ecriture du resultat en sortie
  432. CALL ECROBJ('TABLE ',MTABLE)
  433. RETURN
  434.  
  435. 990 CONTINUE
  436. C Label ERR de CLOSE
  437. MOTERR=Fichier(1:40)
  438. CALL ERREUR(1108)
  439. RETURN
  440.  
  441. 989 CONTINUE
  442. INTERR(1)=NUMLIG
  443. CALL ERREUR(1069)
  444. END
  445.  
  446.  
  447.  

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