Télécharger la plaquette Cast3M


fr en

Télécharger si.eso

Retour à la liste

Numérotation des lignes : 

si

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

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