Download si.eso

Back to the list

   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'/
  18 :       CALL LIRLOG(LOG,1,IRETOU)
  19 :       IF (IERR.NE.0) RETURN
  20 :       IPSI=0
  21 :       IREPET=0
  22 :       ilupoy=0
  23 :       IF (LOG) RETURN      
  24 :    1  CONTINUE
  24 :       CALL NOUTRU
  25 :       if(ilupoy.eq.0) then
  26 :         lectab=1
  26 :         call quetyp (ijch, 1,iretou)
  27 :         sredle=iredle
  28 :         chauer = text(1:40) 
  29 :       endif 
  30 : C   POUR NE PAS ETRE PAR LA RECHERCHE DE L'INDICE DES TABLES
  31 :       LECTAB=1
  31 :       CALL LIRMO3(MCLE,7,IRET,0,IMOTCO)
  32 :       ilupoy=ilupoy+1
  33 :       IF (IERR.NE.0) RETURN
  34 :       GOTO (10,20,30,40,50,60,60),IRET
  35 :   10  CONTINUE
  36 :       IPSI=IPSI+1
  37 :       GOTO 1
  38 :   20  CONTINUE
  39 :       LECTAB=0
  40 :       IF (IPSI.EQ.0) THEN
  41 :          IF(IREPET.NE.0) THEN
  42 :            moterr(1:40)=chauer
  42 :            CALL ERREUR(520)
  43 :          ENDIF
  44 :          RETURN
  45 :       ENDIF
  46 :       GOTO 1
  47 :   30  CONTINUE
  48 :       LECTAB=0
  49 :       IF (IPSI.EQ.0) THEN
  50 :          IF(IREPET.NE.0) THEN
  51 :            moterr(1:40)=chauer
  51 :            CALL ERREUR(520)
  52 :          ENDIF
  53 :          RETURN
  54 :       ENDIF
  55 :       IF (IPSI.EQ.0) RETURN
  56 :       IPSI=IPSI-1
  57 :       GOTO 1
  58 :   40  CONTINUE
  58 :       CALL REPETE
  59 : C  NE LIRE QU'UNE FOIS LA BOUCLE
  60 :       MBCONT=1
  61 :       IREPET=IREPET+1
  62 :       GOTO 1
  63 :   50  CONTINUE
  63 :       CALL QUETYP( IJCH, 0, IRETOU)
  64 :       IF( IRETOU.EQ.0) GO TO 1
  65 :       IF(IREPET.EQ.0) THEN
  66 :        MBCOUR = MBCOUR -1
  67 :        moterr(1:40)=chauer
  67 :        CALL ERREUR(520)
  68 :        RETURN
  69 :       ENDIF
  69 :       CALL FIN
  70 :       IREPET=IREPET-1
  71 :       GOTO 1
  72 :   60  CONTINUE
  73 :       MBCOUR = MBCOUR - 1
  74 :       moterr(1:40)=chauer
  74 :       CALL ERREUR(521)
  75 :       RETURN
  76 :       END
  77 : 
  78 :  
  79 :  
  80 :  
  81 :  
  82 :  
  83 :  
  84 :  
  85 :  
  86 :  

© Cast3M 2003 - All rights reserved.
Disclaimer