Télécharger sorexc.eso

Retour à la liste

Numérotation des lignes :

  1. C SOREXC SOURCE JC220346 20/07/29 21:16:17 10667
  2. C***********************************************************************
  3. C NOM : sorexc.eso
  4. C DESCRIPTION : Sortie de données tabulaires au format CSV (Comma-
  5. C Separated Values, pour Excel ou Matlab par exemple)
  6. C***********************************************************************
  7. C HISTORIQUE : 26/11/2003 : CHAT : version initiale
  8. C HISTORIQUE : 12/01/2010 : FANDEUR : deplacement du code de prsort.eso
  9. C vers sorexc.eso
  10. C HISTORIQUE : 19/07/2011 : FANDEUR : correction anomalie 7035
  11. C HISTORIQUE : 07/06/2012 : JCARDO : ajout des options NCOL et SEPA
  12. C + sortie de LISTENTI/LISTMOTS
  13. C + ajout de l'extension CSV
  14. C + fermeture du fichier
  15. C HISTORIQUE :
  16. C***********************************************************************
  17. C Prière de PRENDRE LE TEMPS DE COMPLÉTER LES COMMENTAIRES
  18. C en cas de modification de ce sous-programme afin de faciliter
  19. C la maintenance !
  20. C***********************************************************************
  21. C APPELÉ PAR : opérateur SORTir (prsort.eso)
  22. C***********************************************************************
  23. C ENTRÉES :: aucune
  24. C SORTIES :: aucune (sur fichier uniquement)
  25. C***********************************************************************
  26. C SYNTAXE (GIBIANE) :
  27. C
  28. C SORT 'EXCE' OBJ1 (... OBJn) ('NCOL' ENTI1) ('SEPA' |'PVIR'|)
  29. C |'VIRG'|
  30. C |'ESPA'|
  31. C |'TABU'|
  32. C |'OBLI'|
  33. C
  34. C avec OBJi = [ LENTIi | LREELi | LMOTSi | EVOLi | TABi ]
  35. C
  36. C***********************************************************************
  37.  
  38. SUBROUTINE SOREXC
  39.  
  40. IMPLICIT INTEGER(I-N)
  41. IMPLICIT REAL*8(A-H,O-Z)
  42.  
  43.  
  44. -INC CCNOYAU
  45. -INC PPARAM
  46. -INC CCOPTIO
  47. -INC SMTABLE
  48. -INC SMLREEL
  49. -INC SMLENTI
  50. -INC SMLMOTS
  51. -INC SMEVOLL
  52.  
  53. CHARACTER*1 CHA1
  54. CHARACTER*4 CHA4
  55. CHARACTER*8 CHA8
  56. CHARACTER*12 CH12
  57. CHARACTER*(LONOM) MOTI
  58. CHARACTER*20 MYFMT,MYFMT2,FMTFLO
  59.  
  60. CHARACTER*256 FICEXC
  61. LOGICAL ZOPEN
  62.  
  63. C Segment de travail contenant toutes les listes a ecrire dans le fichier CSV
  64. C M1 : nombre total de LISTREEL
  65. C M2 : nombre total de LISTENTI
  66. C M3 : nombre total de LISTMOTS
  67. C M : nombre total de listes (M = M1 + M2 + M3)
  68. SEGMENT TRAV
  69. CHARACTER*12 TITCOL(M)
  70. CHARACTER*8 TYPCOL(M)
  71. INTEGER NUMCOL(M),LONCOL(M)
  72. REAL*8 XX(N,M1)
  73. INTEGER II(N,M2)
  74. CHARACTER*(LONOM) CC(N,M3)
  75. ENDSEGMENT
  76.  
  77. PARAMETER (NCHMAX=30)
  78. SEGMENT TRAV2
  79. * CHARACTER*12 CHARAC(NBCOL)
  80. CHARACTER*(NCH) CHARAC(NBCOL)
  81. ENDSEGMENT
  82.  
  83. LOGICAL B_Z
  84.  
  85. PARAMETER(NCLE=3)
  86. CHARACTER*4 LCLE(NCLE)
  87.  
  88. PARAMETER(NSEP=5)
  89. INTEGER LISEP(NSEP)
  90. CHARACTER*4 LMSEP(NSEP)
  91. CHARACTER*1 CHSEP
  92.  
  93. PARAMETER(NTYP=3)
  94. CHARACTER*8 LTYP(NTYP)
  95. INTEGER ITYP(2)
  96.  
  97.  
  98.  
  99.  
  100. EXTERNAL LONG
  101.  
  102. DATA LCLE /'NCOL','SEPA','DIGI'/
  103. DATA LMSEP /'TABU','VIRG','PVIR','ESPA','OBLI'/
  104. DATA LISEP / 9 , 44 , 59 , 32 , 47 /
  105. DATA LTYP /'LISTREEL','LISTENTI','LISTMOTS'/
  106.  
  107.  
  108. M1=0
  109. M2=0
  110. M3=0
  111. M=0
  112. N=0
  113. SEGINI,TRAV
  114.  
  115.  
  116.  
  117. C Ajout de l'extension au nom du fichier
  118. INQUIRE(UNIT=IOPER,OPENED=ZOPEN)
  119. IF (.NOT.ZOPEN) THEN
  120. CALL ERREUR(-212)
  121. WRITE(IOIMP,*) '(via OPTI "SORT")'
  122. MOTERR(1:8)='CSV '
  123. CALL ERREUR(705)
  124. RETURN
  125. ENDIF
  126.  
  127. INQUIRE(UNIT=IOPER,NAME=NOMFIC)
  128. CLOSE(UNIT=IOPER,STATUS='DELETE')
  129.  
  130. CALL LENCHA(NOMFIC,LC)
  131. FICEXC=NOMFIC(1:LC)
  132. IF (NOMFIC(LC-3:LC).NE.'.csv') FICEXC(LC+1:LC+4)='.csv'
  133. IOS=0
  134. OPEN(UNIT=IOPER,STATUS='UNKNOWN',FILE=FICEXC(1:LONG(FICEXC)),
  135. & IOSTAT=IOS,FORM='FORMATTED')
  136.  
  137.  
  138.  
  139.  
  140. C +---------------------------------------------------------------+
  141. C | |
  142. C | L E C T U R E D E S M O T S C L E F S |
  143. C | |
  144. C +---------------------------------------------------------------+
  145.  
  146. C Valeurs par défaut (nombre de colonnes et séparateur)
  147. NBCOL=0
  148. ICSEP=LISEP(3)
  149. NDIGIT=4
  150. 1 CONTINUE
  151. CALL LIRMOT(LCLE,NCLE,ICLE,0)
  152. C Mot clef "NCOL"
  153. IF (ICLE.EQ.1) THEN
  154. CALL LIRENT(NBCOL,0,IRETOU)
  155. IF (IRETOU.EQ.0) THEN
  156. C ERREUR : Le mot-clé %m1:4 n'est pas suivi de la donnée correspondante
  157. MOTERR(1:4)=LCLE(ICLE)
  158. CALL ERREUR(166)
  159. RETURN
  160. ENDIF
  161. IF (NBCOL.LT.1) THEN
  162. C ERREUR : On veut lire un entier supérieur ou égal à %i1 (on a lu : %i2)
  163. INTERR(1)=1
  164. INTERR(2)=NBCOL
  165. CALL ERREUR(190)
  166. RETURN
  167. ENDIF
  168. GOTO 1
  169. C Mot clef "SEPA"
  170. ELSEIF (ICLE.EQ.2) THEN
  171. CALL LIRMOT(LMSEP,NSEP,ISEP,0)
  172. IF (ISEP.EQ.0) THEN
  173. C ERREUR : Le mot-clé %m1:4 n'est pas suivi de la donnée correspondante
  174. MOTERR(1:4)=LCLE(ICLE)
  175. CALL ERREUR(166)
  176. RETURN
  177. ENDIF
  178. ICSEP=LISEP(ISEP)
  179. GOTO 1
  180. C Mot clef "DIGIT"
  181. ELSEIF (ICLE.EQ.3) THEN
  182. CALL LIRENT(NDIGIT,0,IRETOU)
  183. IF (IRETOU.EQ.0) THEN
  184. C ERREUR : Le mot-clé %m1:4 n'est pas suivi de la donnée correspondante
  185. MOTERR(1:4)=LCLE(ICLE)
  186. CALL ERREUR(166)
  187. RETURN
  188. ENDIF
  189. IF (NDIGIT.LT.1) THEN
  190. C ERREUR : On veut lire un entier supérieur ou égal à %i1 (on a lu : %i2)
  191. INTERR(1)=1
  192. INTERR(2)=NDIGIT
  193. CALL ERREUR(190)
  194. RETURN
  195. ENDIF
  196. GOTO 1
  197. ENDIF
  198. * il faut que NCH soit < ou = NCHMAX (cf. taille de CHARAC)
  199. NCH=NDIGIT+8
  200. NCH=MIN(NCH,NCHMAX)
  201. NDIGIT=NCH-8
  202.  
  203.  
  204.  
  205.  
  206.  
  207. C +---------------------------------------------------------------+
  208. C | |
  209. C | L E C T U R E D E S A R G U M E N T S |
  210. C | P R I N C I P A U X |
  211. C | E T R E M P L I S S A G E D U S E G M E N T T R A V |
  212. C | |
  213. C +---------------------------------------------------------------+
  214.  
  215. 2 CONTINUE
  216. CALL QUETYP(CHA8,0,IRETOU)
  217. IF (IRETOU.EQ.0) GOTO 900
  218.  
  219. C ============================
  220. C LECTURE D'UN OBJET TABLE
  221. C ============================
  222. IF (CHA8.EQ.'TABLE') THEN
  223. CALL LIROBJ('TABLE ',MTABLE,1,IRETOU)
  224. C Acquisition des LISTREEL, LISTENTI et LISTMOTS de la table
  225. CALL ECROBJ('TABLE ',MTABLE)
  226. CALL INDETA
  227. IF (IERR.NE.0) RETURN
  228. CALL LIROBJ('TABLE ',MTAB2,1,IRETOU)
  229. IF (IERR.NE.0) RETURN
  230. M10=M1
  231. M20=M2
  232. M30=M3
  233. SEGACT,MTABLE
  234. DO I=1,MLOTAB
  235. IF (MTABTV(I).EQ.'LISTREEL') THEN
  236. M1=M1+1
  237. MLREEL=MTABIV(I)
  238. SEGACT,MLREEL
  239. N=MAX(N,PROG(/1))
  240. ELSEIF (MTABTV(I).EQ.'LISTENTI') THEN
  241. M2=M2+1
  242. MLENTI=MTABIV(I)
  243. SEGACT,MLENTI
  244. N=MAX(N,LECT(/1))
  245. ELSEIF (MTABTV(I).EQ.'LISTMOTS') THEN
  246. M3=M3+1
  247. MLMOTS=MTABIV(I)
  248. SEGACT,MLMOTS
  249. N=MAX(N,MOTS(/2))
  250. ELSE
  251. C ERREUR : On ne veut pas d'objet de type %m1:8
  252. MOTERR(1:8)=MTABTV(I)
  253. CALL ERREUR(39)
  254. RETURN
  255. ENDIF
  256. ENDDO
  257. M=M1+M2+M3
  258. SEGADJ,TRAV
  259. DO I=1,MLOTAB
  260. IF (MTABTV(I).EQ.'LISTREEL') THEN
  261. M10=M10+1
  262. NUMCOL(M10+M20+M30)=M10
  263. MLREEL=MTABIV(I)
  264. JMAX=PROG(/1)
  265. DO J=1,JMAX
  266. XX(J,M10)=PROG(J)
  267. ENDDO
  268. SEGDES,MLREEL
  269. ELSEIF (MTABTV(I).EQ.'LISTENTI') THEN
  270. M20=M20+1
  271. NUMCOL(M10+M20+M30)=M20
  272. MLENTI=MTABIV(I)
  273. JMAX=LECT(/1)
  274. DO J=1,JMAX
  275. II(J,M20)=LECT(J)
  276. ENDDO
  277. SEGDES,MLENTI
  278. ELSEIF (MTABTV(I).EQ.'LISTMOTS') THEN
  279. M30=M30+1
  280. NUMCOL(M10+M20+M30)=M30
  281. MLMOTS=MTABIV(I)
  282. JMAX=MOTS(/2)
  283. DO J=1,JMAX
  284. MOTI=MOTS(J)
  285. CALL LENCHA(MOTI,NCAR)
  286. CC(J,M30)=MOTI
  287. NCH=MAX(NCH,NCAR)
  288. ENDDO
  289. SEGDES,MLMOTS
  290. ENDIF
  291. M0=M10+M20+M30
  292. TYPCOL(M0)=MTABTV(I)
  293. LONCOL(M0)=JMAX
  294. TITCOL(M0)=' '
  295. IF (MTABTI(I).EQ.'MOT ') THEN
  296. CALL ACCTAB(MTAB2,'ENTIER ', I ,R_Z,CHA1,B_Z,I_Z,
  297. & 'MOT ',I_Z,R_Z,CH12,B_Z,I_Z)
  298. TITCOL(M0)=CH12
  299. ENDIF
  300. ENDDO
  301. SEGDES,MTABLE
  302. SEGSUP,MTAB2
  303.  
  304. C ============================
  305. C LECTURE D'UN OBJET EVOLUTION
  306. C ============================
  307. ELSEIF (CHA8.EQ.'EVOLUTIO') THEN
  308. CALL LIROBJ('EVOLUTIO',MEVOLL,1,IRETOU)
  309. IF (IERR.NE.0) RETURN
  310. M10=M1
  311. M20=M2
  312. M30=M3
  313.  
  314. C Activation et decompte
  315. SEGACT,MEVOLL
  316. DO I=1,IEVOLL(/1)
  317. KEVOLL=IEVOLL(I)
  318. SEGACT,KEVOLL
  319. CALL PLACE(LTYP,NTYP,ITYP(1),TYPX)
  320. CALL PLACE(LTYP,NTYP,ITYP(2),TYPY)
  321. IF (ITYP(1).GT.0.AND.ITYP(2).GT.0) THEN
  322. DO J=1,2
  323. IF (ITYP(J).EQ.1) THEN
  324. M1=M1+1
  325. IF (J.EQ.1) THEN
  326. MLREEL=IPROGX
  327. ELSE
  328. MLREEL=IPROGY
  329. ENDIF
  330. SEGACT MLREEL
  331. NN=PROG(/1)
  332. ELSEIF (ITYP(J).EQ.2) THEN
  333. M2=M2+1
  334. IF (J.EQ.1) THEN
  335. MLENTI=IPROGX
  336. ELSE
  337. MLENTI=IPROGY
  338. ENDIF
  339. SEGACT MLENTI
  340. NN=LECT(/1)
  341. ELSEIF (ITYP(J).EQ.3) THEN
  342. M3=M3+1
  343. IF (J.EQ.1) THEN
  344. MLMOTS=IPROGX
  345. ELSE
  346. MLMOTS=IPROGY
  347. ENDIF
  348. SEGACT MLMOTS
  349. NN=MOTS(/2)
  350. ELSE
  351. CALL ERREUR(5)
  352. RETURN
  353. ENDIF
  354. ENDDO
  355. N=MAX(N,NN)
  356. ENDIF
  357. ENDDO
  358.  
  359. M=M1+M2+M3
  360. SEGADJ,TRAV
  361. DO I=1,IEVOLL(/1)
  362. KEVOLL=IEVOLL(I)
  363. CALL PLACE(LTYP,NTYP,ITYP(1),TYPX)
  364. CALL PLACE(LTYP,NTYP,ITYP(2),TYPY)
  365. IF (ITYP(1).GT.0.AND.ITYP(2).GT.0) THEN
  366. DO J=1,2
  367. IF (ITYP(J).EQ.1) THEN
  368. M10=M10+1
  369. NUMCOL(M10+M20+M30)=M10
  370. IF (J.EQ.1) THEN
  371. MLREEL=IPROGX
  372. ELSE
  373. MLREEL=IPROGY
  374. ENDIF
  375. KMAX=PROG(/1)
  376. DO K=1,KMAX
  377. XX(K,M10)=PROG(K)
  378. ENDDO
  379. ELSEIF (ITYP(J).EQ.2) THEN
  380. M20=M20+1
  381. NUMCOL(M10+M20+M30)=M20
  382. IF (J.EQ.1) THEN
  383. MLENTI=IPROGX
  384. ELSE
  385. MLENTI=IPROGY
  386. ENDIF
  387. KMAX=LECT(/1)
  388. DO K=1,KMAX
  389. II(K,M20)=LECT(K)
  390. ENDDO
  391. ELSEIF (ITYP(J).EQ.3) THEN
  392. M30=M30+1
  393. NUMCOL(M10+M20+M30)=M30
  394. IF (J.EQ.1) THEN
  395. MLMOTS=IPROGX
  396. ELSE
  397. MLMOTS=IPROGY
  398. ENDIF
  399. KMAX=MOTS(/2)
  400. DO K=1,KMAX
  401. MOTI=MOTS(K)
  402. CALL LENCHA(MOTI,NCAR)
  403. CC(K,M30)=MOTI
  404. NCH=MAX(NCH,NCAR)
  405. ENDDO
  406. ELSE
  407. CALL ERREUR(5)
  408. RETURN
  409. ENDIF
  410. M0=M10+M20+M30
  411. TYPCOL(M0)=LTYP(ITYP(J))
  412. LONCOL(M0)=KMAX
  413. IF (J.EQ.1) THEN
  414. TITCOL(M0) =NOMEVX
  415. ELSE
  416. TITCOL(M0) =NOMEVY
  417. ENDIF
  418. ENDDO
  419. ENDIF
  420. ENDDO
  421.  
  422. C Descctivation
  423. DO I=1,IEVOLL(/1)
  424. KEVOLL=IEVOLL(I)
  425. CALL PLACE(LTYP,NTYP,ITYP(1),TYPX)
  426. CALL PLACE(LTYP,NTYP,ITYP(2),TYPY)
  427. IF (ITYP(1).GT.0.AND.ITYP(2).GT.0) THEN
  428. DO J=1,2
  429. IF (ITYP(J).EQ.1) THEN
  430. IF (J.EQ.1) THEN
  431. MLREEL=IPROGX
  432. ELSE
  433. MLREEL=IPROGY
  434. ENDIF
  435. SEGDES,MLREEL
  436. ELSEIF (ITYP(J).EQ.2) THEN
  437. IF (J.EQ.1) THEN
  438. MLENTI=IPROGX
  439. ELSE
  440. MLENTI=IPROGY
  441. ENDIF
  442. SEGDES,MLENTI
  443. ELSEIF (ITYP(J).EQ.3) THEN
  444. IF (J.EQ.1) THEN
  445. MLMOTS=IPROGX
  446. ELSE
  447. MLMOTS=IPROGY
  448. ENDIF
  449. SEGDES,MLMOTS
  450. ELSE
  451. CALL ERREUR(5)
  452. RETURN
  453. ENDIF
  454. ENDDO
  455. ENDIF
  456. SEGDES,KEVOLL
  457. ENDDO
  458. SEGDES,MEVOLL
  459.  
  460. C ===========================
  461. C LECTURE D'UN OBJET LISTREEL
  462. C ===========================
  463. ELSEIF (CHA8.EQ.'LISTREEL') THEN
  464. CALL LIROBJ('LISTREEL',MLREEL,1,IRETOU)
  465. IF (IERR.NE.0) RETURN
  466. M1=M1+1
  467. SEGACT,MLREEL
  468. N=MAX(N,PROG(/1))
  469. M=M1+M2+M3
  470. SEGADJ,TRAV
  471. NUMCOL(M)=M1
  472. TYPCOL(M)='LISTREEL'
  473. LONCOL(M)=PROG(/1)
  474. TITCOL(M)=' '
  475. DO I=1,PROG(/1)
  476. XX(I,M1)=PROG(I)
  477. ENDDO
  478. SEGDES,MLREEL
  479.  
  480. C ===========================
  481. C LECTURE D'UN OBJET LISTENTI
  482. C ===========================
  483. ELSEIF (CHA8.EQ.'LISTENTI') THEN
  484. CALL LIROBJ('LISTENTI',MLENTI,1,IRETOU)
  485. IF (IERR.NE.0) RETURN
  486. M2=M2+1
  487. SEGACT,MLENTI
  488. N=MAX(N,LECT(/1))
  489. M=M1+M2+M3
  490. SEGADJ,TRAV
  491. NUMCOL(M)=M2
  492. TYPCOL(M)='LISTENTI'
  493. LONCOL(M)=LECT(/1)
  494. TITCOL(M)=' '
  495. DO I=1,LECT(/1)
  496. II(I,M2)=LECT(I)
  497. ENDDO
  498. SEGDES,MLENTI
  499.  
  500. C ===========================
  501. C LECTURE D'UN OBJET LISTMOTS
  502. C ===========================
  503. ELSEIF (CHA8.EQ.'LISTMOTS') THEN
  504. CALL LIROBJ('LISTMOTS',MLMOTS,1,IRETOU)
  505. IF (IERR.NE.0) RETURN
  506. M3=M3+1
  507. SEGACT,MLMOTS
  508. N=MAX(N,MOTS(/2))
  509. M=M1+M2+M3
  510. SEGADJ,TRAV
  511. NUMCOL(M)=M3
  512. TYPCOL(M)='LISTMOTS'
  513. LONCOL(M)=MOTS(/2)
  514. TITCOL(M)=' '
  515. DO I=1,MOTS(/2)
  516. MOTI=MOTS(I)
  517. CALL LENCHA(MOTI,NCAR)
  518. CC(I,M3)=MOTI
  519. NCH=MAX(NCH,NCAR)
  520. ENDDO
  521. SEGDES,MLMOTS
  522.  
  523. C ====================================================
  524. C LECTURE D'UN OBJET D'UN AUTRE TYPE QUE CEUX ATTENDUS
  525. C ====================================================
  526. ELSE
  527. C ERREUR : On ne veut pas d'objet de type %m1:8
  528. MOTERR(1:8)=CHA8
  529. CALL ERREUR(39)
  530. RETURN
  531. ENDIF
  532. GOTO 2
  533.  
  534.  
  535.  
  536.  
  537.  
  538. C +---------------------------------------------------------------+
  539. C | |
  540. C | É C R I T U R E D A N S L E F I C H I E R |
  541. C | |
  542. C +---------------------------------------------------------------+
  543.  
  544. 900 CONTINUE
  545. IF (M.EQ.0) THEN
  546. C Aucun objet compatible n'a été trouvé
  547. MOTERR( 1: 8)='TABLE '
  548. MOTERR( 9:16)='EVOLUTIO'
  549. MOTERR(17:24)='LISTREEL'
  550. MOTERR(25:32)='LISTENTI'
  551. MOTERR(33:40)='LISTMOTS'
  552. CALL ERREUR(471)
  553. RETURN
  554.  
  555. ELSE IF (N.EQ.0) THEN
  556. WRITE(IOIMP,*) 'ATTENTION : il n''y a rien à sortir'
  557. CALL ERREUR(21)
  558. RETURN
  559.  
  560. ELSE
  561. NCH=MIN(NCH,NCHMAX)
  562.  
  563. ICOL=0
  564. IF (NBCOL.EQ.0) NBCOL=M
  565. SEGINI,TRAV2
  566.  
  567. CHSEP=ACHAR(ICSEP)
  568. WRITE(MYFMT,'("(",I8,"(A",I2,",''",A1,"''))")')NBCOL,NCH,CHSEP
  569. WRITE(MYFMT2,'("(A",I2,")")') NCH
  570. c write(*,*) 'MYFMT=',MYFMT
  571. * format pour les sorties de flottants (reels)
  572. WRITE(FMTFLO,'("(1PE",I2,".",I2,"E3)")') NCH,NDIGIT
  573. c write(*,*) 'FMTFLO=',FMTFLO
  574.  
  575. 901 CONTINUE
  576. KK=MIN(ICOL+NBCOL,M)
  577.  
  578. * Decalage a gauche du titre des colonnes, si leur largeur
  579. * depasse 12 caracteres
  580. DO K=ICOL+1,KK
  581. K1=K-ICOL
  582. CHARAC(K1)=TITCOL(K)
  583. ENDDO
  584.  
  585. WRITE(UNIT=IOPER,FMT=MYFMT,IOSTAT=IOS,ERR=9999)
  586. & (CHARAC(I),I=1,KK-ICOL)
  587. IF (IOS .NE. 0) GOTO 9998
  588. DO J=1,N
  589. DO I=1,KK-ICOL
  590. K=ICOL+I
  591. C on teste si le LISTREEL/LISTENTI/LISTMOTS associe a
  592. C cette colonne est bien de dim > ou= a J
  593. IF (LONCOL(K).GE.J) THEN
  594. IF (TYPCOL(K).EQ.'LISTREEL') THEN
  595. c WRITE(CHARAC(I),FMT='(1PE12.4E3)',
  596. WRITE(CHARAC(I),FMTFLO,
  597. & IOSTAT=IOS,ERR=9999) XX(J,NUMCOL(K))
  598. ELSEIF (TYPCOL(K).EQ.'LISTENTI') THEN
  599. WRITE(CHARAC(I),FMT='(I12)',
  600. & IOSTAT=IOS,ERR=9999) II(J,NUMCOL(K))
  601. ELSEIF (TYPCOL(K).EQ.'LISTMOTS') THEN
  602. WRITE(CHARAC(I),FMT=MYFMT2,
  603. & IOSTAT=IOS,ERR=9999) CC(J,NUMCOL(K))
  604. ENDIF
  605. IF (IOS .NE. 0) GOTO 9998
  606.  
  607. ELSE
  608. CHARAC(I)=' '
  609. ENDIF
  610. ENDDO
  611. WRITE(UNIT=IOPER,FMT=MYFMT) (CHARAC(I),I=1,KK-ICOL)
  612. ENDDO
  613.  
  614. ICOL=ICOL+NBCOL
  615. IF (ICOL.LT.M) THEN
  616. WRITE(IOPER,996,IOSTAT=IOS,ERR=9999)
  617. IF (IOS .NE. 0) GOTO 9998
  618. WRITE(IOPER,996,IOSTAT=IOS,ERR=9999)
  619. IF (IOS .NE. 0) GOTO 9998
  620. WRITE(IOPER,996,IOSTAT=IOS,ERR=9999)
  621. IF (IOS .NE. 0) GOTO 9998
  622. GOTO 901
  623. ENDIF
  624. ENDIF
  625.  
  626. 996 FORMAT(A20)
  627. C 997 FORMAT(12(A12,';'))
  628. C 998 FORMAT(12(1PE12.5,';'))
  629.  
  630.  
  631. C Fermeture du fichier
  632. CLOSE(UNIT=IOPER)
  633.  
  634. C Un peu de menage
  635. SEGSUP,TRAV
  636. RETURN
  637.  
  638. C Sortie en ERREUR : IOS different de 0
  639. 9998 CONTINUE
  640. INTERR(1)=IOS
  641. INTERR(2)=IOPER
  642. LC1=LONG(FICEXC)
  643. IMAX=MAX(LC1,16)
  644. MOTERR(1:IMAX)=FICEXC(1:IMAX)
  645. CALL ERREUR(1067)
  646. RETURN
  647.  
  648. C Sortie en ERREUR : Ecriture impossible dans l'unite
  649. 9999 CONTINUE
  650. INTERR(1)=IOPER
  651. LC1=LONG(FICEXC)
  652. IMAX=MAX(LC1,16)
  653. MOTERR(1:IMAX)=FICEXC(1:IMAX)
  654. CALL ERREUR(1066)
  655. RETURN
  656.  
  657. END
  658.  
  659.  
  660.  
  661.  

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