Télécharger procpn.eso

Retour à la liste

Numérotation des lignes :

  1. C PROCPN SOURCE JC220346 18/12/14 21:15:11 10039
  2. SUBROUTINE PROCPN(IAREA,IRET)
  3. IMPLICIT INTEGER(I-N)
  4. -INC CCOPTIO
  5. -INC CCNOYAU
  6. SAVE LINDEX,ISTAT,IULEPR,ISTAT2
  7. integer curEnr,curCha,curFic,curLig
  8. integer totCha
  9. SAVE curEnr,curCha,curFic,curLig
  10. CHARACTER*(*) IAREA
  11. INTEGER IRET
  12. DATA iLonEn /100000/
  13. CHARACTER*100000 cCHAR
  14. CHARACTER*(LONOM) cnom
  15. integer nDol
  16. integer iProc
  17. integer iEnre
  18. integer nProc,nProc34
  19. integer nEnt
  20. integer curCh2
  21. integer tmpLong
  22. CHARACTER*500 cline
  23. DIMENSION INDEX (6)
  24. DIMENSION NAME(2)
  25. c CHARACTER*8 INDIX (6)
  26. SEGMENT indFic
  27. CHARACTER*(LONOM) nomEnt(nEnt)
  28. INTEGER carDeb(nEnt)
  29. INTEGER numFic(nEnt)
  30. ENDSEGMENT
  31. SEGMENT UTIFIC
  32. integer debCha(nlig+1)
  33. ENDSEGMENT
  34. 103 FORMAT(A100000)
  35. pointeur pLiPro.indFic
  36. pointeur utif3.utific
  37. nl=LONOM+10
  38. utif3=0
  39. C IJKL=0
  40. IDEJA=0
  41. ISTAT=1
  42. nEnt=0
  43. SEGINI pLiPro
  44.  
  45.  
  46. C Fichier /u/castem/CAST3M.PROC (unite=34)
  47. C ========================================
  48. c write(6,*) 'Lecture du premier fichier de procedure'
  49. nProc=0
  50. IF(utifi3(4).EQ.0) THEN
  51. goto 95
  52. ENDIF
  53. READ(34,REC=1,FMT=103,IOSTAT=IOSTAT)cCHAR
  54. if (iostat.gt.0) then
  55. goto 95
  56. endif
  57.  
  58. READ(cCHAR(1:30),FMT=301,IOSTAT=IOSTAT)curEnr,nLig,nProc
  59. if (iostat.gt.0) then
  60. goto 95
  61. endif
  62. ISTAT=0
  63. c recuperation du nombre de ligne, d enregistrement, et de procedure
  64. c write(6,*) 'nb proc',nProc
  65. c lecture de la liste des procedures
  66. nEnt=nProc
  67. SEGADJ pLiPro
  68. curCha=31
  69. DO iproc=1,nProc
  70. if(curcha.le.iLonEn-nl+1) then
  71. read(cCHAR(curCha:curcha+nl-1),FMT=202,IOSTAT=IOSTAT) cnom,
  72. & curCh2
  73. if (iostat.gt.0) then
  74. nEnt=iProc-1
  75. segadj pLiPro
  76. goto 95
  77. endif
  78. pLiPro.nomEnt(iProc)=cnom
  79. pLiPro.carDeb(iProc)=curCh2
  80. c on enleve 1 pour etre sur que jchar-1 n'est pas sup ou egal a iLonEn
  81. pLiPro.numFic(iProc)=34
  82. CALL NOMOBJ('PROCEDUR',cnom,-curCh2)
  83. curCha=curCha+nl
  84. else
  85. write(IOIMP,*) 'Trop de procedures'
  86. endif
  87. enddo
  88. c lecture de la correspondance des lignes
  89. c write(IOIMP,*) 'nb lig',nLig
  90. c write(IOIMP,*) 'nb Enr',curEnr
  91. READ(34,REC=curEnr,FMT=103,IOSTAT=IOSTAT)cCHAR
  92. if (iostat.gt.0) then
  93. goto 95
  94. endif
  95. segini utif3
  96. curCha=1
  97. do curLig=1,nLig+1
  98. c attention, ici, on fait l'hypothese que iLonEn est un multiple de 10
  99. READ(cCHAR(curCha:curCha+9),FMT=204,IOSTAT=IOSTAT)
  100. & utif3.debCha(curLig)
  101. if (iostat.gt.0) then
  102. nLig=curLig-2
  103. segadj utif3
  104. goto 95
  105. endif
  106. c WRITE(6,*) 'ligne',curLig,utif3.debCha(curLig)
  107. curCha=curCha+10
  108. if(curCha.GE.iLonEn) then
  109. curEnr=curEnr+1
  110. READ(34,REC=curEnr,FMT=103,IOSTAT=IOSTAT)cCHAR
  111. if (iostat.gt.0) then
  112. nLig=curLig-1
  113. segadj utif3
  114. goto 95
  115. endif
  116. curCha=1
  117. endif
  118. enddo
  119. 95 CONTINUE
  120. utifi3(4)=utif3
  121. IF(utif3 .GT. 0) then
  122. segdes utif3
  123. endif
  124.  
  125. utif3=0
  126. nProc34=nProc
  127. c write(6,*) cline
  128. c write(6,*) 'fin de Lecture du fichier de procedure'
  129.  
  130.  
  131.  
  132. C Fichier UTILPROC du repertoire local (unite=36)
  133. C ===============================================
  134. ISTAT2=1
  135. c write(6,*) 'Lecture du deuxieme fichier de procedure'
  136. nProc=0
  137. IF(utifi3(6).EQ.0) THEN
  138. goto 96
  139. ENDIF
  140. READ(36,REC=1,FMT=103,IOSTAT=IOSTAT)cCHAR
  141. if (iostat.gt.0) then
  142. goto 96
  143. endif
  144.  
  145. READ(cCHAR(1:30),FMT=301,IOSTAT=IOSTAT)curEnr,nLig,nProc
  146. if (iostat.gt.0) then
  147. goto 96
  148. endif
  149. ISTAT2=0
  150. c recuperation du nombre de ligne, d enregistrement, et de procedure
  151. c write(IOIMP,*) 'nb Enr',curEnr
  152. c write(IOIMP,*) 'nb lig',nLig
  153. c write(IOIMP,*) 'nb proc',nProc
  154. c lecture de la liste des procedures
  155. nEnt=nProc+nProc34
  156. SEGADJ pLiPro
  157. curCha=31
  158. DO iproc=nProc34+1,nEnt
  159. if(curcha.le.iLonEn-nl+1) then
  160. read(cCHAR(curCha:curcha+nl-1),FMT=202,IOSTAT=IOSTAT) cnom,
  161. & curCh2
  162. if (iostat.gt.0) then
  163. nEnt=iProc-1
  164. SEGADJ pLiPro
  165. goto 96
  166. endif
  167. pLiPro.nomEnt(iProc)=cnom
  168. pLiPro.carDeb(iProc)=curCh2
  169. cc on enleve 1 pour etre sur que jchar-1 n'est pas sup ou egal a iLonEn
  170. pLiPro.numFic(iProc)=36
  171. DO 40 nProc=1,nProc34
  172. IF(cnom.EQ.pLiPro.nomEnt(nProc)) THEN
  173. IF(IDEJA.EQ.0) THEN
  174. CALL ERREUR (-302)
  175. ENDIF
  176. WRITE(IOIMP,*) cnom
  177. IDEJA=IDEJA+1
  178. GO TO 41
  179. ENDIF
  180. 40 CONTINUE
  181. 41 CONTINUE
  182. CALL NOMOBJ('PROCEDUR',cnom,-(curCh2+500000000))
  183. curCha=curCha+nl
  184. else
  185. write(IOIMP,*) 'Trop de procedures'
  186. endif
  187. enddo
  188. c lecture de la correspondance des lignes
  189. READ(36,REC=curEnr,FMT=103,IOSTAT=IOSTAT)cCHAR
  190. if (iostat.gt.0) then
  191. goto 96
  192. endif
  193. segini utif3
  194. curCha=1
  195. do curLig=1,nLig+1
  196. c attention, ici, on fait l'hypothese que iLonEn est un multiple de 10
  197. READ(cCHAR(curCha:curCha+9),FMT=204,IOSTAT=IOSTAT)
  198. & utif3.debCha(curLig)
  199. if (iostat.gt.0) then
  200. nLig=curLig-2
  201. segadj utif3
  202. goto 96
  203. endif
  204. c WRITE(6,*) 'ligne',curLig,utif3.debCha(curLig)
  205. curCha=curCha+10
  206. if(curCha.GE.iLonEn) then
  207. curEnr=curEnr+1
  208. READ(36,REC=curEnr,FMT=103,IOSTAT=IOSTAT)cCHAR
  209. if (iostat.gt.0) then
  210. nLig=curLig-1
  211. segadj utif3
  212. goto 96
  213. endif
  214. curCha=1
  215. endif
  216. enddo
  217. 96 continue
  218. utifi3(6)=utif3
  219. IF(utifi3(6) .GT. 0) then
  220. segdes utif3
  221. endif
  222.  
  223. c dump de la lecture du fichier
  224. c write(IOIMP,*) 'dump de la lecture du fichier'
  225. c do 93 I=1,nEnt
  226. c write(IOIMP,94)pLiPro.nomEnt(i),(pLiPro.carDeb(i)/iLonEn),
  227. c & mod(pLiPro.carDeb(i),iLonEn)
  228. c write(IOIMP,94)pLiPro.nomEnt(i),pLiPro.carDeb(i)
  229. c write(IOIMP,94)pLiPro.nomEnt(i),pLiPro.carDeb(i),
  230. c & pLiPro.numFic(i)
  231. c94 FORMAT('Proc : ',A8,' ligne ',I10,'fichier',I3)
  232. c93 continue
  233. c write(IOIMP,*) 'statut',ISTAT,ISTAT2
  234. lisProc=pLiPro
  235. segdes pLiPro
  236. IRET=9999
  237. C 9998 CONTINUE
  238. c lecture du deuxieme fichier
  239.  
  240. RETURN
  241. ENTRY PROCPO(JINDEX,IRET)
  242. c Le principe de cette routine est de placer le pointeur LINDEX au bon endroit
  243. c elle renvoit IRET = 0 en cas d erreur, 9999 sinon
  244. c Le pointeur LINDEX est place en fonction de la position demandee modulo le fichier
  245. c Le pointeur demandee est enregistree lors du nomobj de procpn
  246. c write(IOIMP,*)'Entree dans PROCPO'
  247. IRET=0
  248. IF (ISTAT*ISTAT2.EQ.1) RETURN
  249. IF(JINDEX.GT.500000000) THEN
  250. c write(6,94)pLiPro.nomEnt(i),(pLiPro.carDeb(i)/iLonEn),
  251. c & mod(pLiPro.carDeb(i),iLonEn)
  252. curFic=36
  253. curLig = (JINDEX-500000000)
  254. ELSE
  255. curFic=34
  256. curLig = JINDEX
  257. ENDIF
  258. IRET=9999
  259. c write(IOIMP,*)'sortie de PROCPO',IRET
  260. RETURN
  261. ENTRY PROCLI(IAREA,IRET)
  262. c Le principe de cette routine est de lire la ligne sous le pointeur LINDEX et d avancer le pointeur
  263. c La ligne est enregistree dans IAREA et le pointeur LINDEX est avance de 1
  264. c Notre but ici va etre de lire 500 caractere a partir de curCha
  265. c (eventuellement avancer curEnr et s'arreter si on rencontre 4
  266. c dollars. Puis renvoyer ca dans IAREA
  267. c write(IOIMP,*)'Entree dans PROCLI',ISTAT,ISTAT2
  268. IRET=9999
  269. IF (ISTAT*ISTAT2.EQ.1) RETURN
  270. utif3=utifi3(curfic-30)
  271. if(utif3.LE.0) RETURN
  272. segact utif3
  273. nlig=utif3.debCha(/1)
  274. c write(IOIMP,*)'Nombre de lignes',nlig,curLig
  275. IF(curLig.GE.nlig)return
  276. curEnr = utif3.debCha(curLig)/iLonEn+1
  277. c curCha = utif3.debCha(curLig) - ilonEn * (curEnr-1)
  278. curCha = mod(utif3.debCha(curLig),iLonEn)+1
  279. curCh2 = mod(utif3.debCha(curLig+1),iLonEn)
  280. c write(6,*) 'Ligne ',curLig,curCha,curCh2
  281. IRET=0
  282. WRITE(cline,FMT=203)' '
  283. READ(curFic,REC=curEnr,FMT=103,IOSTAT=IOSTAT)cChar
  284. if (iostat.gt.0) then
  285. write(IOIMP,*)'Impossible de lire l''enregistrement',curEnr,
  286. & curFic
  287. IAREA(1:500)=cline(1:500)
  288. segdes utif3
  289. return
  290. endif
  291. c Est-ce que curCh2 peut valoir 0 ??
  292. if(curCha.LE.curCh2) then
  293. tmplong=curCh2-curCha+1
  294. cline(1:tmplong) = cChar(curCha:curCh2)
  295. else
  296. tmplong=(iLonEn-curCha) + 1
  297. cline(1:tmpLong)=cCHAR(curCha:iLonEn)
  298. c write(6,*) 'Premiere partie',curEnr,1,tmpLong,curCha,iLonEn,
  299. c & cline(1:tmpLong)
  300. curEnr=curEnr+1
  301. READ(curFic,REC=curEnr,FMT=103,IOSTAT=IOSTAT)cCHAR
  302. if (iostat.eq.0) then
  303. cline(1+tmpLong:curCh2-curCha+1+iLonEn) = cChar(1:curCh2)
  304. tmplong=curCh2-curCha+1+iLonEn
  305. endif
  306. c write(6,*) 'Deuxieme partie',curEnr,1+tmpLong,1,curCh2,
  307. c & curCh2-curCha+1+iLonEn,
  308. c & cline(1+tmpLong:curCh2-curCha+1+iLonEn)
  309. endif
  310. c write(6,'(A,I10,A,I10,A,A,A)') 'Li',curLig,'/',nLig,', |',
  311. c & cline(1:tmplong),'|'
  312. c Nettoyage de cline : on s'arrete si on trouve des $$$$ puis on
  313. c enleve les blanc
  314. IF(cline(1:4).EQ.'$$$$')IRET=9999
  315. IAREA(1:500)=cline(1:500)
  316. curLig=curLig+1
  317. segdes utif3
  318. c write(IOIMP,*)'sortie de PROCLI ',IRET
  319. RETURN
  320. ENTRY PROCL2(IAREA,IRET)
  321. c write(IOIMP,*)'Entree dans PROCL2'
  322. c Procli2 place le pointeur LINDEX sur le debut de la routine IAREA et dans le bon fichier
  323. pLiPro=lisProc
  324. segact pLiPro
  325. IRET=0
  326. IF (ISTAT*ISTAT2.EQ.1) RETURN
  327. do 73 I=pLiPro.numFic(/1),1,-1
  328. if(IAREA(1:LONOM).EQ.pLiPro.nomEnt(i)) THEN
  329. curFic=pLiPro.numFic(i)
  330. IF(curFic.EQ.34) THEN
  331. IRET=9999
  332. ELSE
  333. IRET=9998
  334. ENDIF
  335. curLig = pLiPro.carDeb(i)
  336. segdes pLiPro
  337. c write(IOIMP,*)'sortie de PROCL2 ',IRET
  338. return
  339. ENDIF
  340. 73 continue
  341. segdes pLiPro
  342. c write(IOIMP,*)'sortie de PROCL2 ',IRET
  343. RETURN
  344. 301 FORMAT(3I10)
  345. 202 FORMAT(A24,I10)
  346. 203 FORMAT(A)
  347. 204 FORMAT(I10)
  348. END
  349.  
  350.  
  351.  
  352.  

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