Télécharger infopn.eso

Retour à la liste

Numérotation des lignes :

  1. C INFOPN SOURCE PV 14/04/14 21:15:01 8035
  2. SUBROUTINE INFOPN(IAREA,IRET)
  3. IMPLICIT INTEGER(I-N)
  4. SAVE LINDEX,SINDEX,NINDEX,ISTAT,IULENO,IUTINO
  5. CHARACTER*4 IRET
  6. CHARACTER*(*) IAREA
  7. SEGMENT SINDEX
  8. CHARACTER*8 CINDEX((IND2-IND1+1)*5)
  9. INTEGER INDEX((IND2-IND1+1)*5)
  10. ENDSEGMENT
  11. ISTAT=1
  12. READ(33,REC=1,FMT=100,IOSTAT=IOSTAT)IND1,IND2
  13. if (iostat.ne.0) goto 1000
  14. ISTAT=0
  15. SEGINI SINDEX
  16. J=1
  17. DO 1 I=IND1,IND2
  18. READ(33,REC=I,FMT=101,IOSTAT=IOSTAT)
  19. * (CINDEX(J+K-1),INDEX(J+K-1),K=1,5)
  20. if (iostat.ne.0) goto 1000
  21. J=J+5
  22. 1 CONTINUE
  23. NINDEX=J-1
  24. IUTINO=NINDEX
  25. IRET='9999'
  26. READ(37,REC=1,FMT=100,IOSTAT=IOSTAT)IND11,IND21
  27. if (iostat.ne.0) goto 1000
  28. IND2=IND2 + IND21+1
  29. IND1 = IND1 + IND11
  30. SEGADJ SINDEX
  31. DO 18 I=IND11,IND21
  32. READ(37,REC=I,FMT=101,IOSTAT=IOSTAT)
  33. * (CINDEX(J+K-1),INDEX(J+K-1),K=1,5)
  34. if (iostat.ne.0) goto 1000
  35. J=J+5
  36. 18 CONTINUE
  37. NINDEX=J-1
  38. 1000 RETURN
  39. ENTRY INFOPO(IAREA,IRET)
  40. IRET='0'
  41. IF (ISTAT.NE.0)RETURN
  42. IF (IAREA(1:8).EQ.' ') GOTO 11
  43. DO 10 I=NINDEX,1,-1
  44. IF(CINDEX(I).EQ.IAREA(1:8))GO TO 15
  45. 10 CONTINUE
  46. 11 CONTINUE
  47. IRET='9999'
  48. RETURN
  49. 15 CONTINUE
  50. IF(I.LE.IUTINO) THEN
  51. IULENO=33
  52. ELSE
  53. IULENO=37
  54. ENDIF
  55. LINDEX=INDEX(I)+1
  56. RETURN
  57. ENTRY INFOLI(IAREA,IRET)
  58. IRET='9999'
  59. IF (ISTAT.NE.0) RETURN
  60. IRET='0'
  61. READ(IULENO,REC=LINDEX,FMT=102,IOSTAT=IOSTAT) IAREA
  62. if (iostat.ne.0) goto 1000
  63. IF(IAREA(1:4).EQ.'$$$$') IRET='9999'
  64. LINDEX=LINDEX+1
  65. RETURN
  66. 100 FORMAT (2I6)
  67. 101 FORMAT(5(A8,I6))
  68. 102 FORMAT(A80)
  69. END
  70.  
  71.  
  72.  
  73.  

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