Télécharger la plaquette Cast3M


fr en

Télécharger sinon.eso

Retour à la liste

Numérotation des lignes : 

sinon

  1. C SINON     SOURCE    PV090527  24/01/10    21:15:06     11818          
  2. C  INSTRUCTION SINON
  3. C
  4.       SUBROUTINE SINON
  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.       CHARACTER*8 IJCH
  15.       CHARACTER*4 MCLE(7),ICHG
  16.       DIMENSION IMOTCO(7)
  17.       SAVE IMOTCO
  18.       DATA MCLE/'SI  ','SINO','FINS','REPE','FIN ','FINP','FINM'/
  19.       DATA IMOTCO(1)/-1/
  20.  
  21. * TC on met en commentaire la suite car pas possible
  22. * de tester l'imbrication des bloc et des si ( les cartes des
  23. * procedures sont deja lues mais pas execute
  24. C      IF(MBFONC.EQ.0) THEN
  25. C         NOMLU=0
  26. C         MTXBLC=MTXBL
  27. C         NN=NINSTV
  28. C         IIPS=1
  29. C         IREPET=0
  30. C  106    CONTINUE
  31. C         MBCOUR=MBCOUR+1
  32. C         IF(MBCOUR.GT.NN) THEN
  33. C            CALL ERREUR(520)
  34. C            MBCOUR=MBCOUR-1
  35. C            RETURN
  36. C         ENDIF
  37. C         IDEF= MTXBA(MBCOUR)
  38. C         IPLAC=MTXBLA(IDEF+1)
  39. C         IF(INOOB2(IPLAC).NE.'MOT     ') GO TO 106
  40. C         IP=IOUEP2(IPLAC)
  41. C         IDEBCH=IPCHAR(IP)
  42. C         IFINCH=IPCHAR(IP+1)-1
  43. C         ICHG=ICHARA(IDEBCH:IFINCH)
  44. C         IF(ICHG.EQ.'FINS') THEN
  45. C           IIPS=IIPS-1
  46. C         ELSEIF(ICHG.EQ.'SI  ')  THEN
  47. C           IIPS=IIPS+1
  48. C         ELSEIF(ICHG.EQ.'FINP'.OR.ICHG.EQ.'FINM') THEN
  49. CC           MBCOUR=MBCOUR-1
  50. C           CALL ERREUR (521)
  51. C           RETURN
  52. C         ENDIF
  53. C         IF(IIPS.EQ.0)   RETURN
  54. C         GO TO 106
  55. C      ENDIF
  56.       IPSI=0
  57.       IREPET=0
  58.       ilupoy=0
  59.    1  CONTINUE
  60.       CALL NOUTRU
  61.       if(ilupoy.eq.0) then
  62.         lectab=1
  63.         call quetyp (ijch, 1,iretou)
  64.         IF(IERR.NE.0) RETURN
  65.         sredle=iredle
  66.         chauer = text
  67.       endif
  68. *  POUR NE PAS ETRE GENE PAR LA RECHERCHE DE L'INDICE DE LA TABLE
  69.       LECTAB=1
  70.       CALL LIRMO3(MCLE,7,IR,0,IMOTCO)
  71.       IF (IERR.NE.0) RETURN
  72.       ilupoy=ilupoy+1
  73.       GOTO (10,20,30,40,50,60,60),IR
  74.   10  CONTINUE
  75.       IPSI=IPSI+1
  76.       GOTO 1
  77.   20  CONTINUE
  78.       GOTO 1
  79.   30  CONTINUE
  80.       IF (IPSI.EQ.0) THEN
  81.          IF(IREPET.NE.0) THEN
  82.            moterr =chauer
  83.            CALL ERREUR(520)
  84.          ENDIF
  85.          RETURN
  86.       ENDIF
  87.       IPSI=IPSI-1
  88.       GOTO 1
  89.   40  CONTINUE
  90.  
  91.       CALL REPETE(1)
  92.       IF (IERR.NE.0) RETURN
  93. C  NE FAIRE QU'UNE SEULE FOIS LA BOUCLE
  94.       IREPET=IREPET + 1
  95.       MBCONT=1
  96.       GOTO 1
  97.  
  98.   50  CONTINUE
  99.       CALL QUETYP( IJCH, 0, IRETOU)
  100.       IF(IERR.NE.0) RETURN
  101.  
  102.       IF( IRETOU.EQ.0) GO TO 1
  103.       IF(IREPET.EQ.0) THEN
  104.        MBCOUR = MBCOUR - 1
  105.        moterr =chauer
  106.        CALL ERREUR (520)
  107.        RETURN
  108.       ENDIF
  109.       CALL FIN
  110.       IF(IERR.NE.0) RETURN
  111.       IREPET=IREPET -1
  112.       GOTO 1
  113.  
  114.    60 CONTINUE
  115.       MBCOUR = MBCOUR - 1
  116.       moterr =chauer
  117.       CALL ERREUR (521)
  118.       RETURN
  119.       END
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  

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