Télécharger mslis1.eso

Retour à la liste

Numérotation des lignes :

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

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