Télécharger infopn.eso

Retour à la liste

Numérotation des lignes :

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

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