Télécharger infopn.eso

Retour à la liste

Numérotation des lignes :

  1. C INFOPN SOURCE CB215821 18/01/23 21:15:16 9704
  2. SUBROUTINE INFOPN(IRET)
  3. IMPLICIT INTEGER(I-N)
  4.  
  5. -INC CCOPTIO
  6.  
  7. integer curEnr,curCha,curFic
  8. integer curLig,totCha
  9. integer IRET
  10. integer nNoti,iFic,preEnr,derEnr,iostat
  11. integer nEnt
  12. integer curCh2
  13. integer iEnre,jEnre,kEnre
  14. integer nindex
  15. integer i,j,ind1,ind2
  16. CHARACTER*(500) IAREA
  17. DATA iLonEn /100000/
  18. CHARACTER*100000 cCHAR
  19. CHARACTER*8 c8
  20.  
  21. SEGMENT indFic
  22. CHARACTER*8 nomEnt(nEnt)
  23. INTEGER carDeb(nEnt)
  24. INTEGER numFic(nEnt)
  25. ENDSEGMENT
  26.  
  27. SEGMENT UTIFIC
  28. integer debCha(nlig+1)
  29. ENDSEGMENT
  30.  
  31. 103 FORMAT(A100000)
  32. C901 FORMAT('Impossible de lire le fichier ',I3,'. Fichier suivant')
  33.  
  34. pointeur pLiNot.indFic
  35. pointeur utif3.utific
  36. utif3=0
  37. nEnt=0
  38. SEGINI pLiNot
  39. nNoti=0
  40. jEnre=0
  41. do 13 iFic=33,37,4
  42. c write(IOIMP,*) '**** UNITE DE LECTURE',iFic,'***********'
  43. utif3=0
  44. IF(UTIFI3(iFic-30).EQ.0) then
  45. c write(IOIMP,901) iFic
  46. GOTO 12
  47. endif
  48. READ(iFic,REC=1,FMT=103,IOSTAT=IOSTAT)cCHAR
  49. if (iostat.gt.0) then
  50. c write(IOIMP,901) iFic
  51. goto 12
  52. endif
  53. READ(cCHAR(1:30),FMT=301,IOSTAT=IOSTAT)curEnr,nLig,nNoti
  54. if (iostat.gt.0) then
  55. c write(IOIMP,901) iFic
  56. goto 12
  57. endif
  58. nEnt=nNoti+nEnt
  59. c write(6,*) 'nb not',nNoti
  60. SEGADJ pLiNot
  61. curCha=31
  62.  
  63. do iNoti=1,nNoti
  64. if(curcha.le.iLonEn-17) then
  65. read(cCHAR(curCha:curcha+17),FMT=202,IOSTAT=IOSTAT)
  66. & c8,curCh2
  67. c write(6,*) curcha,c8,curCh2
  68. if (iostat.gt.0) then
  69. write(IOIMP,902) iNoti
  70. 902 FORMAT('Arret premature a la notice ',I3,'. Fichier suivant')
  71. nEnt=jEnre-1
  72. SEGADJ pLiNot
  73. goto 12
  74. endif
  75. jEnre=jEnre+1
  76. pLiNot.nomEnt(jEnre)=c8
  77. pLiNot.carDeb(jEnre)=curCh2
  78. c on enleve 1 pour etre sur que jchar-1 n'est pas sup ou egal a iLonEn
  79. c write(IOIMP,*) c8,curch2
  80. c write(IOIMP,94)c8,curch2,iFic
  81. pLiNot.numFic(jEnre)=iFic
  82. curCha=curCha+18
  83. else
  84. write(IOIMP,*) 'Trop de notices'
  85. endif
  86. enddo
  87. c lecture de la correspondance des lignes
  88. c write(IOIMP,*) 'nb lig',nLig
  89. c write(IOIMP,*) 'nb Enr',curEnr
  90. READ(iFic,REC=curEnr,FMT=103,IOSTAT=IOSTAT)cCHAR
  91. if (iostat.gt.0) then
  92. goto 12
  93. endif
  94. segini utif3
  95. curCha=1
  96. do curLig=1,nLig+1
  97. c attention, ici, on fait l'hypothese que iLonEn est un multiple de 10
  98. READ(cCHAR(curCha:curCha+9),FMT=204,IOSTAT=IOSTAT)
  99. & utif3.debCha(curLig)
  100. if (iostat.gt.0) then
  101. write(IOIMP,903) curLig
  102. 903 FORMAT('Arret premature a la ligne ',I3,'. Fichier suivant')
  103. nLig=curLig-2
  104. segadj utif3
  105. goto 12
  106. endif
  107. c WRITE(6,*) 'ligne',curLig,utif3.debCha(curLig)
  108. curCha=curCha+10
  109. if(curCha.GE.iLonEn) then
  110. curEnr=curEnr+1
  111. READ(iFic,REC=curEnr,FMT=103,IOSTAT=IOSTAT)cCHAR
  112. if (iostat.gt.0) then
  113. write(IOIMP,903) curLig
  114. nLig=curLig-1
  115. segadj utif3
  116. goto 12
  117. endif
  118. curCha=1
  119. endif
  120. enddo
  121. 12 CONTINUE
  122. utifi3(iFic-30)=utif3
  123. if(utif3 .GT. 0) then
  124. segdes utif3
  125. endif
  126. IRET=9999
  127. 13 CONTINUE
  128. c dump de la lecture du fichier
  129. c write(IOIMP,*) 'dump de la lecture du fichier', nEnt
  130. c do 93 I=1,nEnt
  131. c write(IOIMP,94)pLiNot.nomEnt(i),pLiNot.carDeb(i),
  132. c & pLiNot.numFic(i)
  133. c94 FORMAT('Noti : ',A8,' ligne ',I10,'fichier',I3)
  134. c93 continue
  135. lisNoti=pLiNot
  136.  
  137. C NINDEX=jEnre
  138.  
  139. segdes pLiNot
  140. C 100 FORMAT (2I6)
  141. C 101 FORMAT(5(A8,I6))
  142. 301 FORMAT(3I10)
  143. 202 FORMAT(A8,I10)
  144. C 203 FORMAT(A)
  145. 204 FORMAT(I10)
  146. C 102 FORMAT(A500)
  147. END
  148.  
  149.  
  150.  

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