Télécharger lircsv.eso

Retour à la liste

Numérotation des lignes :

  1. C LIRCSV SOURCE CB215821 17/04/14 21:15:01 9394
  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
  29. C Appelee par : LIREFI
  30. C
  31. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  32.  
  33.  
  34.  
  35. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  36. CC DEBUT DES DECLARATIONS CC
  37. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  38.  
  39. IMPLICIT INTEGER(I-N)
  40. IMPLICIT REAL*8 (A-H,O-Z)
  41.  
  42. -INC CCOPTIO
  43. -INC SMLREEL
  44. -INC SMTABLE
  45.  
  46. C Declaration des chaines de caracteres
  47. CHARACTER*1 Separa
  48. CHARACTER*256 Fichier
  49. CHARACTER*4 CHA4
  50.  
  51. C Declaration des ENTIERS
  52. INTEGER IUCSV
  53. INTEGER JG
  54. INTEGER INCJG
  55. INTEGER ICOEF
  56. INTEGER NBLR
  57. INTEGER NBLIGN
  58. INTEGER NBSEPA
  59. INTEGER NBSEPI
  60. INTEGER NBOPT
  61. INTEGER IDEB
  62. INTEGER IFIN
  63. INTEGER IDLRRE
  64. INTEGER IOSTA1
  65.  
  66. C Declaration des FLOTTANTS
  67. REAL*8 FlotLu
  68.  
  69.  
  70. C Liste des CARACTERES RECONNUS pour détecter les CR et LF
  71. CHARACTER*94 CARAOK
  72. DATA CARAOK /' 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNO
  73. &PQRSTUVWXYZ+-/\*.,:;_#$%&()[]{}<=>?@`|~!"'''/
  74.  
  75.  
  76.  
  77. C Declaration des SEGMENTS
  78. C Segment pour s'adapter a la taille de la ligne a lire
  79. SEGMENT SLIGNE
  80. C LONGLI : Longueur de la ligne la plus longue a lire dans le fichier
  81. CHARACTER*(LONGLI) LignFi
  82. ENDSEGMENT
  83.  
  84. C Segement contenant la liste des MLREEL
  85. SEGMENT SLISLR
  86. C LISTLR : Tableau contenant la liste des POINTEUR LISTREEL
  87. C NBLR : Nombre de LISTREEL dans le tableau LISTLR
  88. INTEGER LISTLR(NBLR)
  89. ENDSEGMENT
  90.  
  91. C Liste des mots clé OPTIONNELS
  92. PARAMETER (NBOPT=2)
  93. CHARACTER*4 MCLOPT(NBOPT)
  94. DATA MCLOPT / 'DEBU','SEPA' /
  95.  
  96. C Declaration des PARAMETER
  97. C Unite logique du fichier d'impression au format CSV
  98. PARAMETER (IUCSV=67)
  99.  
  100.  
  101. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  102. CC Initialisations CC
  103. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  104. 1000 FORMAT(A)
  105. NBLR =0
  106. JG =0
  107. INCJG =1000
  108. ICOEF =2
  109. LONGLI=2048
  110. IDEBLI=1
  111. NBLIGN=0
  112. NBSEPI=0
  113. NBSEPA=0
  114. IDEB =0
  115. IFIN =0
  116. IDLRRE=0
  117. IVALU =0
  118.  
  119. FlotLu=REAL(0.D0)
  120.  
  121. C Le separateur par defaut est le ';'
  122. Separa=';'
  123.  
  124. C Lecture des arguments : Nom du fichier a lire
  125. CALL LIRCHA(Fichier,1,IRETO1)
  126. IF (IERR .NE. 0) RETURN
  127.  
  128.  
  129. C Par defaut, Erreur Cast3M numero 424
  130. C Erreur 424 : Probleme %i1 en ouvrant le fichier : %m1:40
  131. L=LEN(Fichier)
  132. L1=MIN(L,40)
  133. MOTERR(1:L1)=Fichier(1:L1)
  134. INTERR(1)=0
  135.  
  136. C Ouverture du fichier
  137. CLOSE(UNIT=IUCSV,ERR=990)
  138. OPEN (UNIT=IUCSV,STATUS='OLD',FILE=Fichier(1:L),
  139. & IOSTAT=IOSTA1,FORM='FORMATTED')
  140.  
  141.  
  142. C Traitement des erreurs d'ouverture des fichiers
  143. IF (IOSTA1 .NE. 0) THEN
  144. INTERR(1)=IOSTA1
  145. CALL ERREUR(424)
  146. GOTO 990
  147. ENDIF
  148.  
  149. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  150. CC DECODAGE DES OPTIONS CC
  151. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  152. 1 CONTINUE
  153. C Lecture OPTIONNELLE des Options
  154. CALL LIRCHA(CHA4,0,IRETO1)
  155. IF (IERR .NE. 0) RETURN
  156.  
  157. IF (IRETO1 .NE. 0) THEN
  158. C Recherche de l'option lue dans le DATA des mots-clés
  159. CALL PLACE(MCLOPT,NBOPT,IRETO1,CHA4)
  160. IF (IERR .NE. 0 ) RETURN
  161. IF (IRETO1 .EQ. 0) THEN
  162. C Cas d'une option inexistante
  163. MOTERR(1:8) ='MOT '
  164. MOTERR(9:16)= CHA4
  165. CALL ERREUR(11)
  166. RETURN
  167. ELSEIF (IRETO1 .EQ. 1) THEN
  168. C Cas de l'option 'DEBU'
  169. C Lecture OBLIGATOIRE d'un ENTIER (Ligne du début)
  170. CALL LIRENT(IVALU,1,IRETO2)
  171. IF (IERR .NE. 0) RETURN
  172.  
  173. ELSEIF (IRETO1 .EQ. 2) THEN
  174. C Cas de l'option 'SEPA'
  175.  
  176. C Lecture OBLIGATOIRE d'un MOT (Separa)
  177. CALL LIRCHA(Separa,1,IRETO1)
  178. IF (IERR .NE. 0) RETURN
  179. C IF (Separa .EQ. ' ') THEN
  180. C CALL ERREUR(26)
  181. C RETURN
  182. C ENDIF
  183. ENDIF
  184.  
  185. GOTO 1
  186. ENDIF
  187.  
  188.  
  189. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  190. CC LECTURE DU FICHIER CC
  191. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  192. SEGINI,SLISLR,SLIGNE
  193. NUMLIG = 0
  194. C Boucle de lecture des lignes
  195. LMAXI =LignFi(/1)
  196.  
  197. C On saute les (IVALU-1) premieres lignes le cas echeant
  198. IF ((IVALU .EQ. 0) .OR. (IVALU .EQ. 1)) THEN
  199. GOTO 10
  200. ELSEIF (IVALU .GE. 2) THEN
  201. DO I=1,(IVALU-1)
  202. NUMLIG = NUMLIG + 1
  203. READ(IUCSV,1000,IOSTAT=IOSTA1,ERR=989,END=8) LignFi
  204. IF (IOSTA1 .NE. 0) GOTO 989
  205. ENDDO
  206. GOTO 10
  207. 8 CONTINUE
  208. C La fin du fichier est atteinte avant même d'avoir commencé la lecture...
  209. INTERR(1)=IVALU
  210. CALL ERREUR(36)
  211. RETURN
  212. ELSE
  213. INTERR(1)=IVALU
  214. CALL ERREUR(36)
  215. RETURN
  216. ENDIF
  217.  
  218. C Lecture des lignes utiles
  219. 10 CONTINUE
  220. IF (IERR .NE. 0) RETURN
  221. NUMLIG = NUMLIG + 1
  222. C Lecture de la ligne complete
  223. READ(IUCSV,1000,IOSTAT=IOSTA1,ERR=989,END=100) LignFi
  224. IF (IOSTA1 .NE. 0) GOTO 989
  225. LCOURA = LONGLI
  226.  
  227. C Remplacement des caracteres non present dans le DATA par ' '
  228. DO J=1,LCOURA
  229. INDXE=INDEX(CARAOK,LignFi(J:J))
  230. IF (INDXE .EQ. 0) LignFi(J:J)=' '
  231. ENDDO
  232.  
  233. C Detection de la longueur des lignes
  234. DO J=LCOURA,1,-1
  235. C Detection en partant de la fin du premier caractere qui n'est ni ' ' ni Separa
  236. IF ((LignFi(J:J) .NE. ' ') .AND.
  237. & (LignFi(J:J) .NE. Separa)) THEN
  238. LMAXI=MAX(LMAXI,J)
  239. LLIGN=J
  240. IF (J .GT. (LONGLI - 64)) THEN
  241. LONGLI = LONGLI * 2
  242. SEGADJ,SLIGNE
  243. C On recommence la lecture de la ligne
  244. BACKSPACE(UNIT=IUCSV,IOSTAT=IOSTA1,ERR=989)
  245. IF (IOSTA1 .NE. 0) GOTO 989
  246. NUMLIG = NUMLIG - 1
  247. GOTO 10
  248. ENDIF
  249. GOTO 111
  250. ENDIF
  251. ENDDO
  252. GOTO 10
  253.  
  254. 111 CONTINUE
  255. IF (Separa .EQ. ' ') THEN
  256. DO J=1,LLIGN
  257. C Detection en partant du debut du premier caractere qui n'est pas ' '
  258. IF (LignFi(J:J) .NE. ' ') THEN
  259. IDEBLI=J
  260. GOTO 112
  261. ENDIF
  262. ENDDO
  263. GOTO 10
  264. ENDIF
  265.  
  266. 112 CONTINUE
  267. C Cas ou la ligne n'est pas vide
  268. NBLIGN = NBLIGN + 1
  269.  
  270. C Compte le nombre de separateurs, Les separateurs ' ' consecutifs sont ignorés
  271. NBSEPA=0
  272. IDEB=IDEBLI
  273. IFIN=IDEB
  274. DO J=IDEBLI,LLIGN
  275. IF (NBLIGN .EQ. 1) THEN
  276. C Cas de la premiere ligne
  277. IF (LignFi(J:J) .EQ. Separa) THEN
  278. NBSEPI = NBSEPI + 1
  279. IF (LignFi(J-1:J-1) .EQ. Separa .AND. Separa .EQ. ' ') THEN
  280. NBSEPI = NBSEPI - 1
  281. ENDIF
  282. ENDIF
  283. ELSE
  284. C Cas des autres lignes
  285. IF (LignFi(J:J) .EQ. Separa) THEN
  286. NBSEPA = NBSEPA + 1
  287. IF (LignFi(J-1:J-1) .EQ. Separa .AND. Separa .EQ. ' ') THEN
  288. NBSEPA = NBSEPA - 1
  289. ENDIF
  290. ENDIF
  291. ENDIF
  292. ENDDO
  293.  
  294. C PRINT *,'IDEBLI,LLIGN,NBSEPI,NBSEPA,NBLIGN',
  295. C & IDEBLI,LLIGN,NBSEPI,NBSEPA,NBLIGN
  296.  
  297. C Test sur le nombre de colonnes lues
  298. IF (NBLIGN .EQ. 1) THEN
  299. NBLR=NBSEPI+1
  300. SEGADJ,SLISLR
  301. C Creation des SEGMENTS DES LISTREELS
  302. JG=INCJG
  303. DO J=1,NBLR
  304. SEGINI,MLREEL
  305. LISTLR(J)=MLREEL
  306. ENDDO
  307. ENDIF
  308.  
  309. C Ajustement des LISTREELS a la volee
  310. IF ( NBLIGN .GT. JG) THEN
  311. INCJG = INCJG * ICOEF
  312. JG=NBLIGN + INCJG
  313. DO J=1,NBLR
  314. MLREEL=LISTLR(J)
  315. SEGADJ,MLREEL
  316. ENDDO
  317. ENDIF
  318.  
  319. C Remplissage des LISTREELS avec les valeurs lues
  320. IDEB=IDEBLI
  321. IFIN=IDEB
  322. IDLRRE=0
  323. DO 113 J=IDEBLI,LLIGN
  324. IF (LignFi(J-1:J-1).EQ.Separa .AND. (Separa.EQ.' ')) THEN
  325. GOTO 113
  326. ELSEIF (LignFi(J:J) .EQ. Separa) THEN
  327. IFIN=J-1
  328. ELSEIF (J .EQ. LLIGN) THEN
  329. IFIN=LLIGN
  330. ELSE
  331. GOTO 113
  332. ENDIF
  333.  
  334. IDLRRE = IDLRRE + 1
  335. READ(LignFi(IDEB:IFIN),*,ERR=989,IOSTAT=IOSTA1) FlotLu
  336. IF (IOSTA1 .NE. 0) THEN
  337. C PRINT*,NUMLIG,':',LignFi,':',LignFi(IDEB:IFIN)
  338. GOTO 989
  339. ENDIF
  340. C PRINT *,FlotLu,LignFi(IDEB:IFIN),IDLRRE,NBLIGN
  341.  
  342. IF (IDLRRE .GT. NBLR) THEN
  343. CALL ERREUR(217)
  344. RETURN
  345. ENDIF
  346. MLREEL=LISTLR(IDLRRE)
  347. PROG(NBLIGN)=FlotLu
  348. IDEB=J+1
  349. 113 CONTINUE
  350.  
  351. C Lecture d'une nouvelle ligne
  352. GOTO 10
  353.  
  354.  
  355. 100 CONTINUE
  356. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  357. CC FIN LECTURE FICHIER CC
  358. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  359. C Creation de la table VIDE de sortie
  360. M=0
  361. SEGINI,MTABLE
  362.  
  363. C Ajustement des LISTREELS et ecriture dans la TABLE
  364. IF ( NBLIGN .LT. JG) THEN
  365. JG=NBLIGN
  366. DO J=1,NBLR
  367. MLREEL=LISTLR(J)
  368. SEGADJ,MLREEL
  369. CALL ECCTAB(MTABLE,'ENTIER ',J,REAL(0.D0),'RIEN',.FALSE.,0,
  370. & 'LISTREEL',0,REAL(0.D0),'RIEN',.FALSE.,MLREEL)
  371. IF (IERR .NE. 0 ) RETURN
  372. SEGDES,MLREEL
  373. ENDDO
  374. ENDIF
  375.  
  376. SEGDES,MTABLE
  377. SEGSUP,SLISLR,SLIGNE
  378.  
  379. C Ecriture du resultat en sortie
  380. CALL ECROBJ('TABLE ',MTABLE)
  381. IF (IERR .NE. 0 ) RETURN
  382.  
  383. 990 CONTINUE
  384. RETURN
  385.  
  386.  
  387. 989 CONTINUE
  388. CALL ERREUR(21)
  389. RETURN
  390. END
  391.  
  392.  

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