Télécharger infor1.eso

Retour à la liste

Numérotation des lignes :

  1. C INFOR1 SOURCE GF238795 16/07/12 21:15:01 9029
  2. C CE SOUS PROGRAMME SERT A LISTER SUR L'UNITE DE SORTIE LE CONTENU
  3. C DU CHAPITRE DESIRE DU FICHIER D'INFORMATION
  4. C
  5. SUBROUTINE INFOR1(NOM,IRET)
  6. IMPLICIT INTEGER(I-N)
  7. -INC CCOPTIO
  8. -INC SMLENTI
  9. CHARACTER*4 CODE
  10. CHARACTER*8 MOT,NOM
  11. CHARACTER*80 BUFFER,SOULIG,SOULI2,TITRE,TITR2
  12. CHARACTER*1 rep,AI
  13. LOGICAL ISTRU,IPART,ICHAP
  14. IRET=0
  15. C
  16. C SEGMENT DE COPIE DE LA NOTICE
  17. SEGMENT,MCOPIE
  18. CHARACTER*80 LIGN(NL1)
  19. ENDSEGMENT
  20. POINTEUR MCOPI1.MCOPIE
  21. C
  22. SOULIG='========================================'
  23. SOULIG=SOULIG(1:40)//SOULIG(1:40)
  24. SOULI2='----------------------------------------'
  25. SOULI2=SOULI2(1:40)//SOULI2(1:40)
  26. c
  27. call gistty(ligne)
  28. if (ligne.le.0) ligne=6000000
  29. ligne=max(ligne,50)
  30. C RECHERCHE DU BON CHAPITRE DANS CETTE METHODE LE NOM EST CADRE A
  31. C GAUCHE
  32. IEC=1
  33. CODE='0'
  34. CALL INFOPO(NOM,CODE)
  35. IF (CODE.NE.'0 '.OR.IERR.NE.0) THEN
  36. IRET=7
  37. RETURN
  38. ENDIF
  39. C IF (IERR.NE.0.AND.IIMPI.NE.0) WRITE (IIMPI,100) CODE
  40. C IF (IERR.NE.0) RETURN
  41. C LECTURE DU CHAPITRE ECRITURE SUR LE TERMINAL
  42. NSTRU=0
  43. NPART=0
  44. NCHAP=0
  45. ISTRU=.FALSE.
  46. IPART=.FALSE.
  47. ICHAP=.FALSE.
  48. NL1=5000
  49. SEGINI,MCOPI1
  50. JG=NL1
  51. SEGINI,MLENT1
  52. lalig=0
  53. lnoti=1
  54. 1 CALL INFOLI(BUFFER,CODE)
  55. IF (CODE.NE.'0 ') GOTO 2
  56. lnoti=lnoti+1
  57. C
  58. C GESTION DE LA LANGUE D'AFFICHAGE
  59. IF(BUFFER(5:8).EQ.'====') THEN
  60. IF(BUFFER(1:4).EQ.LANGUE.OR.BUFFER(1:4).EQ.'====')THEN
  61. IEC=1
  62. GO TO 1
  63. ELSE
  64. IEC=0
  65. GO TO 1
  66. ENDIF
  67. ENDIF
  68. C
  69. C SAUT DU MOT-CLE "Section :" DE LA CLASSIFICATION THEMATIQUE
  70. IF (BUFFER(1:9).EQ.'Section :') THEN
  71. GO TO 1
  72. ENDIF
  73. C
  74. C DETECTION D UNE SOUS-STRUCTURATION DE LA NOTICE (PARTIES...)
  75. IF ((BUFFER(1:4).EQ.'PART'.OR.BUFFER(1:4).EQ.'CHAP').AND.IEC.EQ.1)
  76. & THEN
  77. IF (.NOT.ISTRU) THEN
  78. ISTRU=.TRUE.
  79. JG=100
  80. SEGINI,MLENT2,MLENT3
  81. ENDIF
  82. NSTRU=NSTRU+1
  83. C Ajustement taille liste : structure --> ligne buffer (MLENT2)
  84. C : structure --> niv. titre (MLENT3)
  85. JG=MLENT2.LECT(/1)
  86. IF (NSTRU.EQ.JG) THEN
  87. JG=JG+100
  88. SEGADJ,MLENT2,MLENT3
  89. ENDIF
  90. C
  91. C Ajustement des tableaux copie Buffer et ligne --> no titre
  92. lalig=lalig+1
  93. NL1=MCOPI1.LIGN(/2)
  94. IF (lalig.EQ.NL1) THEN
  95. NL1=NL1+5000
  96. SEGADJ,MCOPI1
  97. JG=JG+5000
  98. SEGADJ,MLENT1
  99. ENDIF
  100. C Numerotation des chapitres et parties
  101. IF (BUFFER(1:4).EQ.'PART') THEN
  102. IPART=.TRUE.
  103. NPART=NPART+1
  104. MLENT1.LECT(lalig)=NPART
  105. MLENT3.LECT(NSTRU)=2
  106. ENDIF
  107. IF (BUFFER(1:4).EQ.'CHAP') THEN
  108. ICHAP=.TRUE.
  109. NPART=0
  110. NCHAP=NCHAP+1
  111. MLENT1.LECT(lalig)=NCHAP
  112. MLENT3.LECT(NSTRU)=1
  113. ENDIF
  114. C TRAITEMENT DU TITRE
  115. C DETECTION DU SIGNE { = debut de la chaine
  116. INDD1=INDEX(BUFFER(1:80),'{')
  117. IF (INDD1.EQ.0) THEN
  118. MOTERR(1:1)='{'
  119. INTERR(1)=lnoti
  120. IRET=1047
  121. GOTO 999
  122. ENDIF
  123. INDD1=INDD1+1
  124. C DETECTION DU SIGNE } = Fin de la chaine
  125. INDF1=INDEX(BUFFER(1:80),'}')
  126. IF (INDF1.EQ.0) THEN
  127. MOTERR(1:1)='}'
  128. INTERR(1)=lnoti
  129. IRET=1047
  130. GOTO 999
  131. ENDIF
  132. INDF1=INDF1-1
  133. C Formatage du titre
  134. IF (NCHAP.EQ.0) THEN
  135. NX=NPART
  136. NFM=INT(LOG10(REAL(NX)))+1
  137. WRITE (AI,'(i1)') nfm
  138. MOT='(i'//AI//')'
  139. WRITE (TITRE,MOT) NX
  140. TITRE=TITRE(1:nfm)//'. '//BUFFER(INDD1:INDF1)
  141. MCOPI1.LIGN(lalig)=TITRE
  142. MLENT2.LECT(NSTRU)=lalig
  143. lalig=lalig+1
  144. MCOPI1.LIGN(lalig)=SOULI2(INDD1:INDF1+NFM+2)
  145. ELSEIF (NPART.EQ.0) THEN
  146. MCOPI1.LIGN(lalig)=' '
  147. lalig=lalig+1
  148. NX=NCHAP
  149. NFM=INT(LOG10(REAL(NX)))+1
  150. WRITE (AI,'(i1)') nfm
  151. MOT='(i'//AI//')'
  152. WRITE (TITRE,MOT) NX
  153. TITRE=TITRE(1:nfm)//'. '//BUFFER(INDD1:INDF1)
  154. MCOPI1.LIGN(lalig)=TITRE
  155. MLENT2.LECT(NSTRU)=lalig
  156. lalig=lalig+1
  157. MCOPI1.LIGN(lalig)=SOULIG(INDD1:INDF1+NFM+2)
  158. ELSE
  159. MCOPI1.LIGN(lalig)=' '
  160. lalig=lalig+1
  161. NX=NPART
  162. NFM=INT(LOG10(REAL(NX)))+1
  163. WRITE (AI,'(i1)') nfm
  164. MOT='(i'//AI//')'
  165. WRITE (TITRE,MOT) NX
  166. NX=NCHAP
  167. NFM2=INT(LOG10(REAL(NX)))+1
  168. WRITE (AI,'(i1)') nfm2
  169. MOT='(i'//AI//')'
  170. WRITE (TITR2,MOT) NX
  171. TITRE=TITR2(1:NFM2)//'.'//TITRE(1:nfm)//'. '//
  172. & BUFFER(INDD1:INDF1)
  173. MCOPI1.LIGN(lalig)=TITRE
  174. MLENT2.LECT(NSTRU)=lalig
  175. lalig=lalig+1
  176. MCOPI1.LIGN(lalig)=SOULI2(INDD1:INDF1+NFM+2+NFM2+1)
  177. ENDIF
  178. GO TO 1
  179. ENDIF
  180. C
  181. C COPIE DE LA NOTICE
  182. IF (IEC.EQ.1) then
  183. NL1=MCOPI1.LIGN(/2)
  184. IF (lalig.EQ.NL1) THEN
  185. NL1=NL1+5000
  186. SEGADJ,MCOPI1
  187. JG=JG+5000
  188. SEGADJ,MLENT1
  189. ENDIF
  190. lalig=lalig+1
  191. MCOPI1.LIGN(lalig)=BUFFER
  192. endif
  193. GOTO 1
  194. C
  195. 2 CONTINUE
  196. C
  197. IF (ISTRU) GOTO 20
  198. C
  199. C==== CAS DES NOTICES SIMPLES (NON STRUCTUREES) ====
  200.  
  201. C IMPRESSION DE LA NOTICE PAGE/PAGE
  202. I=0
  203. NLA=0
  204. ipag=1
  205. 3 CONTINUE
  206. I=I+1
  207. NLA=NLA+1
  208. C Gestion des pages
  209. if (NLA.gt.ligne-3) then
  210. ipag=ipag+1
  211. read (ioter,fmt='(a1)',end=999,err=998) rep
  212. if (rep.eq.'q') goto 999
  213. call gistty(ligne)
  214. MOTERR(1:4)=NOM
  215. INTERR(1)=ipag
  216. CALL ERREUR(-357)
  217. NLA=0
  218. endif
  219. IF (I.GT.lalig) goto 999
  220. WRITE (IOIMP,100) MCOPI1.LIGN(I)
  221. GOTO 3
  222.  
  223. C==== CAS DES NOTICES STRUCTUREES ====
  224.  
  225. 20 CONTINUE
  226. I=1
  227. JS=1
  228. NLA=1
  229. ISOMM=MLENT2.LECT(1)
  230. IMENU=lalig+1
  231. 23 CONTINUE
  232. C AFFICHAGE PAGE/PAGE
  233. C 1 & 1 seule ligne imprimee (write) ou lue (read) par iteration (NLA)
  234. C NLA = Nb. Lignes Affichees
  235. C Affichage no page
  236. IF (NLA.EQ.ligne) THEN
  237. call gistty(ligne)
  238. MOTERR(1:4)=NOM
  239. INTERR(1)=(I+NSTRU+5)/(ligne-2)+2
  240. CALL ERREUR(-357)
  241. NLA=0
  242. C Lecture choi
  243. ELSEIF (NLA.EQ.ligne-1.OR.I.GT.IMENU) THEN
  244. C ELSEIF (I.GT.IMENU) THEN
  245. read (ioter,fmt='(a8)',end=999,err=998) mot
  246. IF (MOT.EQ.'q') GOTO 999
  247. IF (.TRUE.) THEN
  248. IF (MOT.EQ.'s') THEN
  249. I=1
  250. JS=1
  251. NLA=0
  252. ISOMM=MLENT2.LECT(1)
  253. IMENU=lalig+1
  254. ELSE
  255. C Analyse No Partie, Chapitre
  256. ICHOIP=0
  257. ICHOIC=0
  258. IP=INDEX(MOT,'.')
  259. c write(6,*) 'MOT, IP =', MOT, IP
  260. IF (IP.GT.0) THEN
  261. IF (ICHAP.AND.IPART) THEN
  262. LMOT=LEN(MOT)
  263. 666 CONTINUE
  264. IF (MOT(LMOT:LMOT).EQ.' ') THEN
  265. LMOT=LMOT-1
  266. GOTO 666
  267. ENDIF
  268. IP2=INDEX(MOT(IP+1:LMOT),'.')
  269. c write(6,*) 'IP2 =', IP2
  270. IF (IP2.GT.1) THEN
  271. IF (IP2.EQ.2)
  272. & READ (MOT(IP+1:IP+IP2-1),FMT='(i1)',end=999,err=998) ICHOIP
  273. IF (IP2.EQ.3)
  274. & READ (MOT(IP+1:IP+IP2-1),FMT='(i2)',end=999,err=998) ICHOIP
  275. IF (IP2.EQ.4)
  276. & READ (MOT(IP+1:IP+IP2-1),FMT='(i3)',end=999,err=998) ICHOIP
  277. ELSE
  278. c write(6,*) 'MOT(IP+1:LMOT), LMOT =', MOT(IP+1:LMOT), LMOT
  279. IF ((LMOT-IP-1).EQ.0)
  280. & READ (MOT(IP+1:LMOT),FMT='(i1)',end=999,err=998) ICHOIP
  281. IF ((LMOT-IP-1).EQ.1)
  282. & READ (MOT(IP+1:LMOT),FMT='(i2)',end=999,err=998) ICHOIP
  283. IF ((LMOT-IP-1).EQ.2)
  284. & READ (MOT(IP+1:LMOT),FMT='(i3)',end=999,err=998) ICHOIP
  285. ENDIF
  286. ENDIF
  287. c write(6,*) 'ICHOIP = ', ICHOIP
  288. IF (IP.EQ.2)
  289. & READ (MOT(1:IP-1),FMT='(i1)',end=999,err=998) ICHOIC
  290. IF (IP.EQ.3)
  291. & READ (MOT(1:IP-1),FMT='(i2)',end=999,err=998) ICHOIC
  292. IF (IP.EQ.4)
  293. & READ (MOT(1:IP-1),FMT='(i3)',end=999,err=998) ICHOIC
  294. ELSE
  295. READ (MOT,FMT='(i3)',end=999,err=998) ICHOIC
  296. ENDIF
  297. c write(6,*) 'ICHOIP, ICHOIC', ICHOIP, ICHOIC
  298. C Traitement du CHOIx
  299. ICHOI =0
  300. IF (ICHOIC.NE.0.AND.ICHAP) THEN
  301. IC=0
  302. IP=0
  303. DO IS=1,NSTRU
  304. ICHOI=ICHOI+1
  305. IF (MLENT3.LECT(IS).EQ.1) THEN
  306. IP=0
  307. IC=IC+1
  308. ENDIF
  309. IF (MLENT3.LECT(IS).EQ.2) IP=IP+1
  310. IF (IC.EQ.ICHOIC.AND.IP.EQ.ICHOIP) GOTO 25
  311. ENDDO
  312. GOTO 999
  313. 25 CONTINUE
  314. ELSE
  315. ICHOI=ICHOIC
  316. ENDIF
  317. C Positionnement dans la notice
  318. IF (ICHOI.GE.1.AND.ICHOI.LE.NSTRU) THEN
  319. I=MLENT2.LECT(ICHOI)
  320. NLA=0
  321. IF (ICHOI.EQ.NSTRU) THEN
  322. IMENU=lalig+1
  323. ELSE
  324. IMENU=MLENT2.LECT(ICHOI+1)
  325. IF(IMENU.LT.I+5) IMENU=MLENT2.LECT(ICHOI+2)
  326. ENDIF
  327. ELSEIF (ICHOI.GT.NSTRU) THEN
  328. GOTO 999
  329. ELSE
  330. NLA=0
  331. IMENU=lalig+1
  332. IF (I.EQ.lalig+1) I=I+1
  333. ENDIF
  334. ENDIF
  335. ENDIF
  336. C Menu notice
  337. C ELSEIF (NLA.EQ.ligne-2.AND.I.GE.IMENU) THEN
  338. ELSEIF (I.GE.IMENU) THEN
  339. IMENU=I-1
  340. CALL ERREUR(-356)
  341. C Sauts de ligne si CHAP
  342. C ELSEIF (NLA.LT.ligne-2.AND.I.GE.IMENU) THEN
  343. C WRITE (IOIMP,FMT='(x)')
  344. C Affichage sommaire
  345. ELSEIF (I.GE.ISOMM) THEN
  346. IF (JS.EQ.1.OR.JS.EQ.4.OR.JS.EQ.NSTRU+5) THEN
  347. WRITE (IOIMP,FMT='(x)')
  348. ELSEIF (JS.EQ.2) THEN
  349. CALL ERREUR(-355)
  350. ELSEIF (JS.GE.5.AND.JS.LE.NSTRU+4) THEN
  351. J=JS-4
  352. C Si on veut changer format sommaire en fonct du niv. des titres
  353. IF (MLENT3.LECT(J).EQ.1) THEN
  354. WRITE (IOIMP,101) MCOPI1.LIGN(MLENT2.LECT(J))
  355. ELSE
  356. WRITE (IOIMP,102) MCOPI1.LIGN(MLENT2.LECT(J))
  357. ENDIF
  358. ENDIF
  359. IF (JS.EQ.NSTRU+5) THEN
  360. IMENU=I
  361. ISOMM=lalig+2
  362. ENDIF
  363. JS=JS+1
  364. C Impression notice
  365. ELSE
  366. WRITE (IOIMP,100) MCOPI1.LIGN(I)
  367. I=I+1
  368. ENDIF
  369. IF (I.GT.lalig+1) goto 999
  370. NLA=NLA+1
  371. GOTO 23
  372. C
  373. 100 FORMAT (1X,A80)
  374. 101 FORMAT (3X,A80)
  375. 102 FORMAT (5X,A80)
  376. C
  377. 998 IRET=21
  378. 999 SEGSUP,MCOPI1,MLENT1
  379. IF (ISTRU) SEGSUP,MLENT2
  380. RETURN
  381. END
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.  
  389.  
  390.  

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