Télécharger la plaquette Cast3M


fr en

Télécharger mslis1.eso

Retour à la liste

Numérotation des lignes : 

mslis1

  1. C MSLIS1    SOURCE    PV        20/04/28    21:15:18     10593          
  2.       SUBROUTINE MSLIS1(CTYP,IPOI1,ICLE,IPOI2,IPOI3,X1,I1,IKO,IRET,ISOM)
  3. *     IKO =  0  =>  1 ou 2 LISTxxxx
  4. *     IKO =  1  =>  1 nombre puis 1 LISTxxxx
  5. *     IKO = -1  =>  1 LISTxxxx puis 1 nombre
  6.       IMPLICIT INTEGER(I-N)
  7. -INC SMLREEL
  8. -INC SMLENTI
  9.       CHARACTER*(*) CTYP
  10.       REAL*8 X1
  11. *
  12.       IKOK=IKO
  13.       IF (IKOK.EQ.0.AND.IPOI3.LE.0) IKOK=-1
  14. *
  15. *     TRAITEMENT D'UN LISTREEL
  16. *     ========================
  17. *
  18.       IF (CTYP.EQ.'LISTREEL') THEN
  19.          MLREE1=IPOI1
  20.          MLREE2=IPOI2
  21.          IF (MLREE1.PROG(/1).NE.MLREE2.PROG(/1)) THEN
  22.             CALL ERREUR(263)
  23.             RETURN
  24.          ENDIF
  25.          IF (IKOK.EQ.0) THEN
  26.             MLREE3=IPOI3
  27.             IF (MLREE1.PROG(/1).NE.MLREE3.PROG(/1)) THEN
  28.                CALL ERREUR(263)
  29.                RETURN
  30.             ENDIF
  31.          ENDIF
  32.          SEGINI,MLREEL=MLREE1
  33.          IRET=MLREEL
  34. *
  35. *        MOT-CLE "SUPE"
  36.          IF (ICLE.EQ.1) THEN
  37.            DO 1 I=1,PROG(/1)
  38.              IF (MLREE1.PROG(I).GT.MLREE2.PROG(I)) THEN
  39.                 PROG(I)=1
  40.              ELSE
  41.                 PROG(I)=0
  42.              ENDIF
  43.     1      CONTINUE
  44. *
  45. *        MOT-CLE "EGSU"
  46.          ELSEIF (ICLE.EQ.2) THEN
  47.            DO 2 I=1,PROG(/1)
  48.              IF (MLREE1.PROG(I).GE.MLREE2.PROG(I)) THEN
  49.                 PROG(I)=1
  50.              ELSE
  51.                 PROG(I)=0
  52.              ENDIF
  53.     2      CONTINUE
  54. *
  55. *        MOT-CLE "EGAL"
  56.          ELSEIF (ICLE.EQ.3) THEN
  57.            DO 3 I=1,PROG(/1)
  58.              IF (MLREE1.PROG(I).EQ.MLREE2.PROG(I)) THEN
  59.                 PROG(I)=1
  60.              ELSE
  61.                 PROG(I)=0
  62.              ENDIF
  63.     3      CONTINUE
  64. *
  65. *        MOT-CLE "EGIN"
  66.          ELSEIF (ICLE.EQ.4) THEN
  67.            DO 4 I=1,PROG(/1)
  68.              IF (MLREE1.PROG(I).LE.MLREE2.PROG(I)) THEN
  69.                 PROG(I)=1
  70.              ELSE
  71.                 PROG(I)=0
  72.              ENDIF
  73.     4      CONTINUE
  74. *
  75. *        MOT-CLE "INFE"
  76.          ELSEIF (ICLE.EQ.5) THEN
  77.            DO 5 I=1,PROG(/1)
  78.              IF (MLREE1.PROG(I).LT.MLREE2.PROG(I)) THEN
  79.                 PROG(I)=1
  80.              ELSE
  81.                 PROG(I)=0
  82.              ENDIF
  83.     5      CONTINUE
  84. *
  85. *        MOT-CLE "DIFF"
  86.          ELSEIF (ICLE.EQ.6) THEN
  87.            DO 6 I=1,PROG(/1)
  88.              IF (MLREE1.PROG(I).NE.MLREE2.PROG(I)) THEN
  89.                 PROG(I)=1
  90.              ELSE
  91.                 PROG(I)=0
  92.              ENDIF
  93.     6      CONTINUE
  94. *
  95. *        MOT-CLE "COMP"
  96.          ELSEIF (ICLE.EQ.7) THEN
  97.            IF (IKOK.EQ.0) THEN
  98.              DO 71 I=1,PROG(/1)
  99.                IF (MLREE1.PROG(I).GE.MLREE2.PROG(I).AND.
  100.      &             MLREE1.PROG(I).LE.MLREE3.PROG(I)) THEN
  101.                   PROG(I)=1
  102.                ELSE
  103.                   PROG(I)=0
  104.                ENDIF
  105.    71        CONTINUE
  106.            ELSEIF (IKOK.GT.0) THEN
  107.              DO 72 I=1,PROG(/1)
  108.                IF (MLREE1.PROG(I).GE.X1.AND.
  109.      &             MLREE1.PROG(I).LE.MLREE2.PROG(I)) THEN
  110.                   PROG(I)=1
  111.                ELSE
  112.                   PROG(I)=0
  113.                ENDIF
  114.    72        CONTINUE
  115.            ELSE
  116.              DO 73 I=1,PROG(/1)
  117.                IF (MLREE1.PROG(I).GE.MLREE2.PROG(I).AND.
  118.      &             MLREE1.PROG(I).LE.X1) THEN
  119.                   PROG(I)=1
  120.                ELSE
  121.                   PROG(I)=0
  122.                ENDIF
  123.    73        CONTINUE
  124.            ENDIF
  125.          ENDIF
  126. *
  127. *        ******************************
  128. *
  129. *        DEUXIEME MOT-CLE "SOMM"
  130.          IF (ISOM.EQ.1) THEN
  131.            IRET=0
  132.            DO 7 I=1,PROG(/1)
  133.              IF (PROG(I).GT.0) IRET=IRET+1
  134.     7      CONTINUE
  135.          ENDIF
  136. *
  137. *
  138. *     TRAITEMENT D'UN LISTENTI
  139. *     ========================
  140. *
  141.       ELSEIF (CTYP.EQ.'LISTENTI') THEN
  142.          MLENT1=IPOI1
  143.          MLENT2=IPOI2
  144.          IF (MLENT1.LECT(/1).NE.MLENT2.LECT(/1)) THEN
  145.             CALL ERREUR(263)
  146.             RETURN
  147.          ENDIF
  148.          IF (IKOK.EQ.0) THEN
  149.             MLENT3=IPOI3
  150.             IF (MLENT1.LECT(/1).NE.MLENT3.LECT(/1)) THEN
  151.                CALL ERREUR(263)
  152.                RETURN
  153.             ENDIF
  154.          ENDIF
  155.          SEGINI,MLENTI=MLENT1
  156.          IRET=MLENTI
  157. *
  158. *        MOT-CLE "SUPE"
  159.          IF (ICLE.EQ.1) THEN
  160.            DO 11 I=1,LECT(/1)
  161.              IF (MLENT1.LECT(I).GT.MLENT2.LECT(I)) THEN
  162.                 LECT(I)=1
  163.              ELSE
  164.                 LECT(I)=0
  165.              ENDIF
  166.    11      CONTINUE
  167. *
  168. *        MOT-CLE "EGSU"
  169.          ELSEIF (ICLE.EQ.2) THEN
  170.            DO 12 I=1,LECT(/1)
  171.              IF (MLENT1.LECT(I).GE.MLENT2.LECT(I)) THEN
  172.                 LECT(I)=1
  173.              ELSE
  174.                 LECT(I)=0
  175.              ENDIF
  176.    12      CONTINUE
  177. *
  178. *        MOT-CLE "EGAL"
  179.          ELSEIF (ICLE.EQ.3) THEN
  180.            DO 13 I=1,LECT(/1)
  181.              IF (MLENT1.LECT(I).EQ.MLENT2.LECT(I)) THEN
  182.                 LECT(I)=1
  183.              ELSE
  184.                 LECT(I)=0
  185.              ENDIF
  186.    13      CONTINUE
  187. *
  188. *        MOT-CLE "EGIN"
  189.          ELSEIF (ICLE.EQ.4) THEN
  190.            DO 14 I=1,LECT(/1)
  191.              IF (MLENT1.LECT(I).LE.MLENT2.LECT(I)) THEN
  192.                 LECT(I)=1
  193.              ELSE
  194.                 LECT(I)=0
  195.              ENDIF
  196.    14      CONTINUE
  197. *
  198. *        MOT-CLE "INFE"
  199.          ELSEIF (ICLE.EQ.5) THEN
  200.            DO 15 I=1,LECT(/1)
  201.              IF (MLENT1.LECT(I).LT.MLENT2.LECT(I)) THEN
  202.                 LECT(I)=1
  203.              ELSE
  204.                 LECT(I)=0
  205.              ENDIF
  206.    15      CONTINUE
  207. *
  208. *        MOT-CLE "DIFF"
  209.          ELSEIF (ICLE.EQ.6) THEN
  210.            DO 16 I=1,LECT(/1)
  211.              IF (MLENT1.LECT(I).NE.MLENT2.LECT(I)) THEN
  212.                 LECT(I)=1
  213.              ELSE
  214.                 LECT(I)=0
  215.              ENDIF
  216.    16      CONTINUE
  217. *
  218. *        MOT-CLE "COMP"
  219.          ELSEIF (ICLE.EQ.7) THEN
  220.            IF (IKOK.EQ.0) THEN
  221.              DO 171 I=1,LECT(/1)
  222.                IF (MLENT1.LECT(I).GE.MLENT2.LECT(I).AND.
  223.      &             MLENT1.LECT(I).LE.MLENT3.LECT(I)) THEN
  224.                   LECT(I)=1
  225.                ELSE
  226.                   LECT(I)=0
  227.                ENDIF
  228.   171        CONTINUE
  229.            ELSEIF (IKOK.GT.0) THEN
  230.              DO 172 I=1,LECT(/1)
  231.                IF (MLENT1.LECT(I).GE.I1.AND.
  232.      &             MLENT1.LECT(I).LT.MLENT2.LECT(I)) THEN
  233.                   LECT(I)=1
  234.                ELSE
  235.                   LECT(I)=0
  236.                ENDIF
  237.   172        CONTINUE
  238.            ELSE
  239.              DO 173 I=1,LECT(/1)
  240.                IF (MLENT1.LECT(I).GE.MLENT2.LECT(I).AND.
  241.      &             MLENT1.LECT(I).LT.I1) THEN
  242.                   LECT(I)=1
  243.                ELSE
  244.                   LECT(I)=0
  245.                ENDIF
  246.   173        CONTINUE
  247.            ENDIF
  248.          ENDIF
  249. *
  250. *        ******************************
  251. *
  252. *        DEUXIEME MOT-CLE "SOMM"
  253.          IF (ISOM.EQ.1) THEN
  254.            IRET=0
  255.            DO 17 I=1,LECT(/1)
  256.              IF (LECT(I).GT.0) IRET=IRET+1
  257.    17      CONTINUE
  258.          ENDIF
  259.       ENDIF
  260.       END
  261.  
  262.  
  263.  
  264.  

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