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

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