Télécharger sorexc.eso

Retour à la liste

Numérotation des lignes :

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

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