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

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