Télécharger infopn.eso

Retour à la liste

Numérotation des lignes :

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

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