Télécharger si.eso

Retour à la liste

Numérotation des lignes :

  1. C SI SOURCE CHAT 11/04/13 21:15:01 6941
  2. C INSTRUCTION SI
  3. C
  4. SUBROUTINE SI
  5. IMPLICIT INTEGER(I-N)
  6. -INC CCOPTIO
  7. -INC CCNOYAU
  8. -INC SMBLOC
  9. -INC CCREDLE
  10. *
  11. character*40 chauer
  12. LOGICAL LOG
  13. CHARACTER*8 IJCH
  14. CHARACTER*4 MCLE(7)
  15. DIMENSION IMOTCO(7)
  16. SAVE IMOTCO
  17. DATA IMOTCO(1)/-1/
  18. DATA MCLE /'SI ','SINO','FINS','REPE','FIN ','FINP','FINM'/
  19. CALL LIRLOG(LOG,1,IRETOU)
  20. IF (IERR.NE.0) RETURN
  21. IPSI=0
  22. IREPET=0
  23. ilupoy=0
  24. IF (LOG) RETURN
  25. 1 CONTINUE
  26. CALL NOUTRU
  27. if(ilupoy.eq.0) then
  28. lectab=1
  29. call quetyp (ijch, 1,iretou)
  30. sredle=iredle
  31. chauer = text(1:40)
  32. endif
  33. C POUR NE PAS ETRE PAR LA RECHERCHE DE L'INDICE DES TABLES
  34. LECTAB=1
  35. CALL LIRMO3(MCLE,7,IRET,0,IMOTCO)
  36. ilupoy=ilupoy+1
  37. IF (IERR.NE.0) RETURN
  38. GOTO (10,20,30,40,50,60,60),IRET
  39. 10 CONTINUE
  40. IPSI=IPSI+1
  41. GOTO 1
  42. 20 CONTINUE
  43. LECTAB=0
  44. IF (IPSI.EQ.0) THEN
  45. IF(IREPET.NE.0) THEN
  46. moterr(1:40)=chauer
  47. CALL ERREUR(520)
  48. ENDIF
  49. RETURN
  50. ENDIF
  51. GOTO 1
  52. 30 CONTINUE
  53. LECTAB=0
  54. IF (IPSI.EQ.0) THEN
  55. IF(IREPET.NE.0) THEN
  56. moterr(1:40)=chauer
  57. CALL ERREUR(520)
  58. ENDIF
  59. RETURN
  60. ENDIF
  61. IF (IPSI.EQ.0) RETURN
  62. IPSI=IPSI-1
  63. GOTO 1
  64. 40 CONTINUE
  65. CALL REPETE
  66. C NE LIRE QU'UNE FOIS LA BOUCLE
  67. MBCONT=1
  68. IREPET=IREPET+1
  69. GOTO 1
  70. 50 CONTINUE
  71. CALL QUETYP( IJCH, 0, IRETOU)
  72. IF( IRETOU.EQ.0) GO TO 1
  73. IF(IREPET.EQ.0) THEN
  74. MBCOUR = MBCOUR -1
  75. moterr(1:40)=chauer
  76. CALL ERREUR(520)
  77. RETURN
  78. ENDIF
  79. CALL FIN
  80. IREPET=IREPET-1
  81. GOTO 1
  82. 60 CONTINUE
  83. MBCOUR = MBCOUR - 1
  84. moterr(1:40)=chauer
  85. CALL ERREUR(521)
  86. RETURN
  87. END
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  
  98.  

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