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