1 : C MSLIS1 SOURCE CHAT 05/01/13 01:53:15 5004 2 : SUBROUTINE MSLIS1(CTYP,IPOI1,ICLE,IPOI2,IRET,ISOM) 3 : IMPLICIT INTEGER(I-N) 4 : -INC SMLREEL 5 : -INC SMLENTI 6 : CHARACTER*(*) CTYP 7 : IF(CTYP.EQ.'LISTREEL') THEN 8 : MLREE1=IPOI1 9 : MLREE2=IPOI2 10 : SEGACT MLREE1,MLREE2 11 : IF(MLREE1.PROG(/1).NE.MLREE2.PROG(/1)) THEN 11 : CALL ERREUR(263) 12 : SEGDES MLREE1,MLREE2 13 : RETURN 14 : ENDIF 15 : SEGINI,MLREEL=MLREE1 16 : IRET=MLREEL 17 : IF(ICLE.EQ.1) THEN 18 : DO 1 I=1,PROG(/1) 19 : IF(MLREE1.PROG(I).GT.MLREE2.PROG(I)) THEN 20 : PROG(I)=1 21 : ELSE 22 : PROG(I)=0 23 : ENDIF 24 : 1 CONTINUE 25 : ELSEIF (ICLE.EQ.2) THEN 26 : DO 2 I=1,PROG(/1) 27 : IF(MLREE1.PROG(I).GE.MLREE2.PROG(I)) THEN 28 : PROG(I)=1 29 : ELSE 30 : PROG(I)=0 31 : ENDIF 32 : 2 CONTINUE 33 : ELSEIF (ICLE.EQ.3) THEN 34 : DO 3 I=1,PROG(/1) 35 : IF(MLREE1.PROG(I).EQ.MLREE2.PROG(I)) THEN 36 : PROG(I)=1 37 : ELSE 38 : PROG(I)=0 39 : ENDIF 40 : 3 CONTINUE 41 : ELSEIF (ICLE.EQ.4) THEN 42 : DO 4 I=1,PROG(/1) 43 : IF(MLREE1.PROG(I).LE.MLREE2.PROG(I)) THEN 44 : PROG(I)=1 45 : ELSE 46 : PROG(I)=0 47 : ENDIF 48 : 4 CONTINUE 49 : ELSEIF (ICLE.EQ.5) THEN 50 : DO 5 I=1,PROG(/1) 51 : IF(MLREE1.PROG(I).LT.MLREE2.PROG(I)) THEN 52 : PROG(I)=1 53 : ELSE 54 : PROG(I)=0 55 : ENDIF 56 : 5 CONTINUE 57 : ELSEIF (ICLE.EQ.6) THEN 58 : DO 6 I=1,PROG(/1) 59 : IF(MLREE1.PROG(I).NE.MLREE2.PROG(I)) THEN 60 : PROG(I)=1 61 : ELSE 62 : PROG(I)=0 63 : ENDIF 64 : 6 CONTINUE 65 : ENDIF 66 : IF(ISOM.EQ.1) THEN 67 : IRET=0 68 : DO 7 I=1,PROG(/1) 69 : IF(PROG(I).GT.0) IRET = IRET + 1 70 : 7 CONTINUE 71 : ENDIF 72 : SEGDES MLREE1,MLREE2 73 : ELSEIF (CTYP.EQ.'LISTENTI') THEN 74 : MLENT1=IPOI1 75 : MLENT2=IPOI2 76 : SEGACT MLENT1,MLENT2 77 : IF(MLENT1.LECT(/1).NE.MLENT2.LECT(/1)) THEN 77 : CALL ERREUR(263) 78 : SEGDES MLENT1,MLENT2 79 : RETURN 80 : ENDIF 81 : SEGINI,MLENTI=MLENT1 82 : IRET=MLENTI 83 : IF(ICLE.EQ.1) THEN 84 : DO 11 I=1,LECT(/1) 85 : IF(MLENT1.LECT(I).GT.MLENT2.LECT(I)) THEN 86 : LECT(I)=1 87 : ELSE 88 : LECT(I)=0 89 : ENDIF 90 : 11 CONTINUE 91 : ELSEIF (ICLE.EQ.2) THEN 92 : DO 12 I=1,LECT(/1) 93 : IF(MLENT1.LECT(I).GE.MLENT2.LECT(I)) THEN 94 : LECT(I)=1 95 : ELSE 96 : LECT(I)=0 97 : ENDIF 98 : 12 CONTINUE 99 : ELSEIF (ICLE.EQ.3) THEN 100 : DO 13 I=1,LECT(/1) 101 : IF(MLENT1.LECT(I).EQ.MLENT2.LECT(I)) THEN 102 : LECT(I)=1 103 : ELSE 104 : LECT(I)=0 105 : ENDIF 106 : 13 CONTINUE 107 : ELSEIF (ICLE.EQ.4) THEN 108 : DO 14 I=1,LECT(/1) 109 : IF(MLENT1.LECT(I).LE.MLENT2.LECT(I)) THEN 110 : LECT(I)=1 111 : ELSE 112 : LECT(I)=0 113 : ENDIF 114 : 14 CONTINUE 115 : ELSEIF (ICLE.EQ.5) THEN 116 : DO 15 I=1,LECT(/1) 117 : IF(MLENT1.LECT(I).LT.MLENT2.LECT(I)) THEN 118 : LECT(I)=1 119 : ELSE 120 : LECT(I)=0 121 : ENDIF 122 : 15 CONTINUE 123 : ELSEIF (ICLE.EQ.6) THEN 124 : DO 16 I=1,LECT(/1) 125 : IF(MLENT1.LECT(I).NE.MLENT2.LECT(I)) THEN 126 : LECT(I)=1 127 : ELSE 128 : LECT(I)=0 129 : ENDIF 130 : 16 CONTINUE 131 : ENDIF 132 : IF(ISOM.EQ.1) THEN 133 : IRET=0 134 : DO 17 I=1,LECT(/1) 135 : IF(LECT(I).GT.0) IRET = IRET + 1 136 : 17 CONTINUE 137 : ENDIF 138 : SEGDES MLENT1,MLENT2,MLENTI 139 : ENDIF 140 : RETURN 141 : END 142 :
© Cast3M 2003 - All rights reserved.
Disclaimer