Télécharger lectur.eso

Retour à la liste

Numérotation des lignes :

  1. C LECTUR SOURCE CHAT 05/01/13 01:14:30 5004
  2. C FABRIQUE UN OBJET DE TYPE LISTENTI (LISTE D'ENTIERS)
  3. C
  4. SUBROUTINE LECTUR
  5. C
  6. IMPLICIT INTEGER(I-N)
  7. -INC CCOPTIO
  8. -INC SMLENTI
  9. CHARACTER*4 MOTC(2),MOTF(2)
  10. DATA MOTC/'PAS ','* '/
  11. DATA MOTF/'NPAS',' '/
  12. C
  13. JG=0
  14. IP=0
  15. IBEGIN=0
  16. SEGINI MLENTI
  17. 999 CONTINUE
  18. CALL LIRENT(IPP,IBEGIN,IRETOU)
  19. IF(IRETOU.EQ.0) GO TO 30
  20. C
  21. C LECTURE D'UN ENTIER
  22. C
  23. 1 CONTINUE
  24. IP=IPP
  25. JG=LECT(/1)+1
  26. SEGADJ MLENTI
  27. LECT(JG)=IP
  28. GO TO 999
  29. C
  30. 30 CONTINUE
  31. CALL LIRMOT(MOTC,2,IRET,0)
  32. IF(IRET.EQ.0) GO TO 20
  33. IF (IRET.EQ.2) GOTO 50
  34. C
  35. C LECTURE DU MOT "PAS "
  36. C
  37. CALL LIRENT(IPAS,1,IRETOU)
  38. IF(IERR.NE.0) RETURN
  39. CALL LIRENT(IQ,0,IRETOU)
  40. IF(IRETOU.EQ.1)GOTO 10
  41. CALL LIRMOT(MOTF(1),1,INPA,1)
  42. C
  43. C LECTURE DE NPAS
  44. C
  45. CALL LIRENT(NP,1,IRETOU)
  46. IF(IERR.NE.0)RETURN
  47. NP=MAX(0,NP)
  48. KIP=IP
  49. KIPAS=IPAS
  50. JG0=JG
  51. JG=JG+NP
  52. SEGADJ MLENTI
  53. DO 11 IJ=1,NP
  54. LECT(JG0+IJ)=IJ*KIPAS+KIP
  55. 11 CONTINUE
  56. C
  57. C ON DOIT LIRE UN ENTIER OU RIEN
  58. C
  59. CALL LIRENT(IPP,0,IRETOU)
  60. IF(IRETOU.EQ.1) GOTO 1
  61. GOTO 20
  62. C
  63. C VOIR SI IQ EST SUIVI PAR "* "
  64. C
  65. 10 CONTINUE
  66. CALL LIRENT(IQ2,0,IRETX)
  67. IF (IRETX.EQ.1) GOTO 60
  68. CALL LIRMOT(MOTC(2),1,IRF,0)
  69. IF (IRF.EQ.0) GOTO 60
  70. NFOIS=IQ
  71. CALL LIRENT(IQ,1,IRETOU)
  72. IF (IERR.NE.0) RETURN
  73. 60 CONTINUE
  74. IA=IQ-IP
  75. IF(IA*IPAS) 6,7,8
  76. 6 CONTINUE
  77. CALL ERREUR(36)
  78. C IQ ET IP SONT DE SIGNE CONTRAIRE
  79. RETURN
  80. 7 CONTINUE
  81. IF(IPAS.NE.0) THEN
  82. if( ipas.eq.1) go to 99
  83. CALL ERREUR(21)
  84. C IQ ET IP SONT IDENTIQUES
  85. RETURN
  86. ENDIF
  87. 8 CONTINUE
  88. IF(IPAS.NE.0)IA=MOD(IA,IPAS)
  89. IF(IA.NE.0) THEN
  90. CALL ERREUR(21)
  91. C IQ-IP N EST PAS DIVISIBLE PAR IPAS
  92. RETURN
  93. ENDIF
  94. IF(IPAS.EQ.0)JQ=2
  95. IF(IPAS.NE.0)JQ=ABS((IQ-IP)/IPAS)+1
  96. JA=IP+IPAS
  97. JG1=LECT(/1)-1
  98. JG=JG1+JQ
  99. SEGADJ MLENTI
  100. DO 9 IA=2,JQ
  101. LECT(JG1+IA)=JA
  102. JA=JA+IPAS
  103. 9 CONTINUE
  104. 99 continue
  105. IPP=IQ2
  106. IP=IQ
  107. IF (IRF.EQ.1) GOTO 65
  108. IF (IRETX.EQ.1) GOTO 1
  109. GO TO 999
  110. 50 CONTINUE
  111. C
  112. C ON A LU "* "
  113. C
  114. IMAX=LECT(/1)
  115. NFOIS=LECT(IMAX)
  116. CALL LIRENT(IP,1,IRETOU)
  117. IF (IERR.NE.0) RETURN
  118. LECT(IMAX)=IP
  119. 65 CONTINUE
  120. IF (NFOIS.LE.0) GOTO 6
  121. NF=NFOIS-1
  122. IF (NF.EQ.0) GOTO 51
  123. JG1=LECT(/1)
  124. JG=JG1+NF
  125. SEGADJ MLENTI
  126. DO 52 I=1,NF
  127. LECT(JG1+I)=IP
  128. 52 CONTINUE
  129. 51 CONTINUE
  130. GOTO 999
  131. C
  132. 20 CONTINUE
  133. CALL ECROBJ('LISTENTI',MLENTI)
  134. SEGDES MLENTI
  135. RETURN
  136. END
  137.  
  138.  
  139.  
  140.  

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