Télécharger mslis1.eso

Retour à la liste

Numérotation des lignes :

  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