Télécharger masche.eso

Retour à la liste

Numérotation des lignes :

  1. C MASCHE SOURCE JC220346 16/12/14 21:15:25 9262
  2. SUBROUTINE MASCHE(X1,X2,MCH,ICLE,IPCHMA,ISOM,IRET)
  3. ***********************************************************************
  4. * OPERATEUR MASQ (APPELE PAR MASQ)
  5. *
  6. * ENTREES :
  7. * ---------
  8. * X1 :NB AVEC LEQUEL SONT COMPAREES LES VALEURS DU MCHAML
  9. * MCH :POINTEUR SUR UN MCHAML
  10. * ICLE :ENTIER CARACTERISANT LE TYPE DE COMPARAISON
  11. * ISOM =1 SI L ON VEUT LA SOMME
  12. * 0 SINON
  13. *
  14. *
  15. * SORTIES :
  16. * ---------
  17. * IPCHMA :- POINTEUR SUR UN MCHALM RESULTAT SI ISOM=0
  18. * - SOMME DES 1 ET DES 0 SI OPTION ISOM=1
  19. * IRET =1 OU 0 SUIVANT SUCCES OU PAS
  20. *
  21. *
  22. * PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 01/91
  23. *
  24. ***********************************************************************
  25. IMPLICIT INTEGER(I-N)
  26. REAL*8 X1,X2,X3
  27. *
  28. -INC CCOPTIO
  29. -INC SMCHAML
  30. -INC SMLREEL
  31. -INC SMCOORD
  32. *
  33. IRET=1
  34. IPCHAM=1
  35. IF (ISOM.EQ.0) THEN
  36. MCHEL1 = MCH
  37. SEGINI,MCHELM=MCHEL1
  38. ELSE
  39. MCHELM = MCH
  40. SEGACT MCHELM
  41. IPCHMA=0
  42. ENDIF
  43. *
  44. DO 1 ISOUS=1,ICHAML(/1)
  45. IF (ISOM.EQ.0) THEN
  46. MCHAM1=ICHAML(ISOUS)
  47. SEGINI,MCHAML=MCHAM1
  48. ICHAML(ISOUS)=MCHAML
  49. ELSE
  50. MCHAML=ICHAML(ISOUS)
  51. SEGACT MCHAML
  52. ENDIF
  53. *
  54. NCOMP=IELVAL(/1)
  55. *
  56. DO 30 ICOMP=1,NCOMP
  57. MELVAL=IELVAL(ICOMP)
  58. IF (TYPCHE(ICOMP).EQ.'REAL*8') THEN
  59. ICOD=1
  60. ELSEIF (TYPCHE(ICOMP).EQ.'POINTEURLISTREEL') THEN
  61. ICOD=2
  62. ELSEIF (TYPCHE(ICOMP).EQ.'POINTEURPOINT ') THEN
  63. ICOD=3
  64. ELSE
  65. MOTERR(1:4)=NOMCHE(ICOMP)
  66. CALL ERREUR(197)
  67. IRET=0
  68. IF (ISOM.EQ.0) THEN
  69. SEGSUP MCHAML,MCHELM
  70. ELSE
  71. SEGDES MCHAML,MCHELM
  72. ENDIF
  73. RETURN
  74. ENDIF
  75. *
  76. SEGACT MELVAL
  77. N1PTEL=VELCHE(/1)
  78. N1EL =VELCHE(/2)
  79. N2PTEL=IELCHE(/1)
  80. N2EL =IELCHE(/2)
  81. *
  82. IF (ISOM.EQ.1) GOTO 10
  83. *
  84. * SOIT ON VEUT UN MASQUE ELEMENT PAR ELEMENT...
  85. * =============================================
  86. SEGINI MELVA1
  87. IELVAL(ICOMP)=MELVA1
  88. *
  89. * MOT-CLE "SUPE"
  90. IF (ICLE.EQ.1) THEN
  91. IF (ICOD.EQ.1) THEN
  92. DO 21 J=1,N1EL
  93. DO 21 L=1,N1PTEL
  94. IF (VELCHE(L,J).GT.X1) MELVA1.VELCHE(L,J)=1.D0
  95. 21 CONTINUE
  96. ELSEIF (ICOD.EQ.2) THEN
  97. DO 22 J=1,N2EL
  98. DO 22 L=1,N2PTEL
  99. MLREEL=IELCHE(L,J)
  100. SEGACT MLREEL
  101. JG=PROG(/1)
  102. SEGINI MLREE1
  103. DO 211 IPROG=1,JG
  104. IF (PROG(IPROG).GT.X1) MLREE1.PROG(IPROG)=1.D0
  105. 211 CONTINUE
  106. MELVA1.IELCHE(L,J)=MLREE1
  107. SEGDES MLREEL,MLREE1
  108. 22 CONTINUE
  109. ELSEIF (ICOD.EQ.3) THEN
  110. DO 23 J=1,N2EL
  111. DO 23 L=1,N2PTEL
  112. IP=IELCHE(L,J)
  113. IREF=(IP-1)*(IDIM+1)
  114. *
  115. * ON CREE UN NVX POINTS :NOEUD NBNO+1
  116. *
  117. SEGACT MCOORD
  118. NBNO=XCOOR(/1)/(IDIM+1)
  119. NBNOI=NBNO
  120. NBPTS=NBNO+1
  121. SEGADJ MCOORD
  122. *
  123. DO 231 IC=1,IDIM
  124. IF (XCOOR(IREF+IC).GT.X1) THEN
  125. XCOOR(NBNOI*(IDIM+1)+IC)=1.D0
  126. ELSE
  127. XCOOR(NBNOI*(IDIM+1)+IC)=0.D0
  128. ENDIF
  129. 231 CONTINUE
  130. XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=XCOOR(IREF+(IDIM+1))
  131. IELCHE(L,J)=NBPTS
  132. 23 CONTINUE
  133. ENDIF
  134. *
  135. * MOT-CLE "EGSU"
  136. ELSEIF (ICLE.EQ.2) THEN
  137. IF (ICOD.EQ.1) THEN
  138. DO 31 J=1,N1EL
  139. DO 31 L=1,N1PTEL
  140. IF (VELCHE(L,J).GE.X1) MELVA1.VELCHE(L,J)=1.D0
  141. 31 CONTINUE
  142. ELSEIF (ICOD.EQ.2) THEN
  143. DO 32 J=1,N2EL
  144. DO 32 L=1,N2PTEL
  145. MLREEL=IELCHE(L,J)
  146. SEGACT MLREEL
  147. JG=PROG(/1)
  148. SEGINI MLREE1
  149. DO 311 IPROG=1,JG
  150. IF (PROG(IPROG).GE.X1) MLREE1.PROG(IPROG)=1.D0
  151. 311 CONTINUE
  152. MELVA1.IELCHE(L,J)=MLREE1
  153. SEGDES MLREEL,MLREE1
  154. 32 CONTINUE
  155. ELSEIF (ICOD.EQ.3) THEN
  156. DO 33 J=1,N2EL
  157. DO 33 L=1,N2PTEL
  158. IP=IELCHE(L,J)
  159. IREF=(IP-1)*(IDIM+1)
  160. *
  161. * ON CREE UN NVX POINTS :NOEUD NBNO+1
  162. *
  163. SEGACT MCOORD
  164. NBNO=XCOOR(/1)/(IDIM+1)
  165. NBNOI=NBNO
  166. NBPTS=NBNO+1
  167. SEGADJ MCOORD
  168. *
  169. DO 331 IC=1,IDIM
  170. IF (XCOOR(IREF+IC).GE.X1) THEN
  171. XCOOR(NBNOI*(IDIM+1)+IC)=1.D0
  172. ELSE
  173. XCOOR(NBNOI*(IDIM+1)+IC)=0.D0
  174. ENDIF
  175. 331 CONTINUE
  176. XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=XCOOR(IREF+(IDIM+1))
  177. IELCHE(L,J)=NBPTS
  178. 33 CONTINUE
  179. ENDIF
  180. *
  181. * MOT-CLE "EGAL"
  182. ELSEIF (ICLE.EQ.3) THEN
  183. IF (ICOD.EQ.1) THEN
  184. DO 41 J=1,N1EL
  185. DO 41 L=1,N1PTEL
  186. IF (VELCHE(L,J).EQ.X1) MELVA1.VELCHE(L,J)=1.D0
  187. 41 CONTINUE
  188. ELSEIF (ICOD.EQ.2) THEN
  189. DO 42 J=1,N2EL
  190. DO 42 L=1,N2PTEL
  191. MLREEL=IELCHE(L,J)
  192. SEGACT MLREEL
  193. JG=PROG(/1)
  194. SEGINI MLREE1
  195. DO 411 IPROG=1,JG
  196. IF (PROG(IPROG).EQ.X1) MLREE1.PROG(IPROG)=1.D0
  197. 411 CONTINUE
  198. MELVA1.IELCHE(L,J)=MLREE1
  199. SEGDES MLREEL,MLREE1
  200. 42 CONTINUE
  201. ELSEIF (ICOD.EQ.3) THEN
  202. DO 43 J=1,N2EL
  203. DO 43 L=1,N2PTEL
  204. IP=IELCHE(L,J)
  205. IREF=(IP-1)*(IDIM+1)
  206. *
  207. * ON CREE UN NVX POINTS :NOEUD NBNO+1
  208. *
  209. SEGACT MCOORD
  210. NBNO=XCOOR(/1)/(IDIM+1)
  211. NBNOI=NBNO
  212. NBPTS=NBNO+1
  213. SEGADJ MCOORD
  214. *
  215. DO 431 IC=1,IDIM
  216. IF (XCOOR(IREF+IC).EQ.X1) THEN
  217. XCOOR(NBNOI*(IDIM+1)+IC)=1.D0
  218. ELSE
  219. XCOOR(NBNOI*(IDIM+1)+IC)=0.D0
  220. ENDIF
  221. 431 CONTINUE
  222. XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=XCOOR(IREF+(IDIM+1))
  223. IELCHE(L,J)=NBPTS
  224. 43 CONTINUE
  225. ENDIF
  226. *
  227. * MOT-CLE "EGIN"
  228. ELSEIF (ICLE.EQ.4) THEN
  229. IF (ICOD.EQ.1) THEN
  230. DO 51 J=1,N1EL
  231. DO 51 L=1,N1PTEL
  232. IF (VELCHE(L,J).LE.X1) MELVA1.VELCHE(L,J)=1.D0
  233. 51 CONTINUE
  234. ELSEIF (ICOD.EQ.2) THEN
  235. DO 52 J=1,N2EL
  236. DO 52 L=1,N2PTEL
  237. MLREEL=IELCHE(L,J)
  238. SEGACT MLREEL
  239. JG=PROG(/1)
  240. SEGINI MLREE1
  241. DO 511 IPROG=1,JG
  242. IF (PROG(IPROG).LE.X1) MLREE1.PROG(IPROG)=1.D0
  243. 511 CONTINUE
  244. MELVA1.IELCHE(L,J)=MLREE1
  245. SEGDES MLREEL,MLREE1
  246. 52 CONTINUE
  247. ELSEIF (ICOD.EQ.3) THEN
  248. DO 53 J=1,N2EL
  249. DO 53 L=1,N2PTEL
  250. IP=IELCHE(L,J)
  251. IREF=(IP-1)*(IDIM+1)
  252. *
  253. * ON CREE UN NVX POINTS :NOEUD NBNO+1
  254. *
  255. SEGACT MCOORD
  256. NBNO=XCOOR(/1)/(IDIM+1)
  257. NBNOI=NBNO
  258. NBPTS=NBNO+1
  259. SEGADJ MCOORD
  260. *
  261. DO 531 IC=1,IDIM
  262. IF (XCOOR(IREF+IC).LE.X1) THEN
  263. XCOOR(NBNOI*(IDIM+1)+IC)=1.D0
  264. ELSE
  265. XCOOR(NBNOI*(IDIM+1)+IC)=0.D0
  266. ENDIF
  267. 531 CONTINUE
  268. XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=XCOOR(IREF+(IDIM+1))
  269. IELCHE(L,J)=NBPTS
  270. 53 CONTINUE
  271. ENDIF
  272. *
  273. * MOT-CLE "INFE"
  274. ELSEIF (ICLE.EQ.5) THEN
  275. IF (ICOD.EQ.1) THEN
  276. DO 61 J=1,N1EL
  277. DO 61 L=1,N1PTEL
  278. IF (VELCHE(L,J).LT.X1) MELVA1.VELCHE(L,J)=1.D0
  279. 61 CONTINUE
  280. ELSEIF (ICOD.EQ.2) THEN
  281. DO 62 J=1,N2EL
  282. DO 62 L=1,N2PTEL
  283. MLREEL=IELCHE(L,J)
  284. SEGACT MLREEL
  285. JG=PROG(/1)
  286. SEGINI MLREE1
  287. DO 611 IPROG=1,JG
  288. IF (PROG(IPROG).LT.X1) MLREE1.PROG(IPROG)=1.D0
  289. 611 CONTINUE
  290. MELVA1.IELCHE(L,J)=MLREE1
  291. SEGDES MLREEL,MLREE1
  292. 62 CONTINUE
  293. ELSEIF (ICOD.EQ.3) THEN
  294. DO 63 J=1,N2EL
  295. DO 63 L=1,N2PTEL
  296. IP=IELCHE(L,J)
  297. IREF=(IP-1)*(IDIM+1)
  298. *
  299. * ON CREE UN NVX POINTS :NOEUD NBNO+1
  300. *
  301. SEGACT MCOORD
  302. NBNO=XCOOR(/1)/(IDIM+1)
  303. NBNOI=NBNO
  304. NBPTS=NBNO+1
  305. SEGADJ MCOORD
  306. *
  307. DO 631 IC=1,IDIM
  308. IF (XCOOR(IREF+IC).LT.X1) THEN
  309. XCOOR(NBNOI*(IDIM+1)+IC)=1.D0
  310. ELSE
  311. XCOOR(NBNOI*(IDIM+1)+IC)=0.D0
  312. ENDIF
  313. 631 CONTINUE
  314. XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=XCOOR(IREF+(IDIM+1))
  315. IELCHE(L,J)=NBPTS
  316. 63 CONTINUE
  317. ENDIF
  318. *
  319. * MOT-CLE "DIFF"
  320. ELSEIF (ICLE.EQ.6) THEN
  321. IF (ICOD.EQ.1) THEN
  322. DO 71 J=1,N1EL
  323. DO 71 L=1,N1PTEL
  324. IF (VELCHE(L,J).NE.X1) MELVA1.VELCHE(L,J)=1.D0
  325. 71 CONTINUE
  326. ELSEIF (ICOD.EQ.2) THEN
  327. DO 72 J=1,N2EL
  328. DO 72 L=1,N2PTEL
  329. MLREEL=IELCHE(L,J)
  330. SEGACT MLREEL
  331. JG=PROG(/1)
  332. SEGINI MLREE1
  333. DO 711 IPROG=1,JG
  334. IF (PROG(IPROG).NE.X1) MLREE1.PROG(IPROG)=1.D0
  335. 711 CONTINUE
  336. MELVA1.IELCHE(L,J)=MLREE1
  337. SEGDES MLREEL,MLREE1
  338. 72 CONTINUE
  339. ELSEIF (ICOD.EQ.3) THEN
  340. DO 73 J=1,N2EL
  341. DO 73 L=1,N2PTEL
  342. IP=IELCHE(L,J)
  343. IREF=(IP-1)*(IDIM+1)
  344. *
  345. * ON CREE UN NVX POINTS :NOEUD NBNO+1
  346. *
  347. SEGACT MCOORD
  348. NBNO=XCOOR(/1)/(IDIM+1)
  349. NBNOI=NBNO
  350. NBPTS=NBNO+1
  351. SEGADJ MCOORD
  352. *
  353. DO 731 IC=1,IDIM
  354. IF (XCOOR(IREF+IC).NE.X1) THEN
  355. XCOOR(NBNOI*(IDIM+1)+IC)=1.D0
  356. ELSE
  357. XCOOR(NBNOI*(IDIM+1)+IC)=0.D0
  358. ENDIF
  359. 731 CONTINUE
  360. XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=XCOOR(IREF+(IDIM+1))
  361. IELCHE(L,J)=NBPTS
  362. 73 CONTINUE
  363. ENDIF
  364. *
  365. * MOT-CLE "COMP"
  366. ELSEIF (ICLE.EQ.7) THEN
  367. IF (ICOD.EQ.1) THEN
  368. DO 81 J=1,N1EL
  369. DO 81 L=1,N1PTEL
  370. IF (VELCHE(L,J).GE.X1.AND.VELCHE(L,J).LE.X2)
  371. & MELVA1.VELCHE(L,J)=1.D0
  372. 81 CONTINUE
  373. ELSEIF (ICOD.EQ.2) THEN
  374. DO 82 J=1,N2EL
  375. DO 82 L=1,N2PTEL
  376. MLREEL=IELCHE(L,J)
  377. SEGACT MLREEL
  378. JG=PROG(/1)
  379. SEGINI MLREE1
  380. DO 811 IPROG=1,JG
  381. IF (PROG(IPROG).GE.X1.AND.PROG(IPROG).LE.X2)
  382. & MLREE1.PROG(IPROG)=1.D0
  383. 811 CONTINUE
  384. MELVA1.IELCHE(L,J)=MLREE1
  385. SEGDES MLREEL,MLREE1
  386. 82 CONTINUE
  387. ELSEIF (ICOD.EQ.3) THEN
  388. DO 83 J=1,N2EL
  389. DO 83 L=1,N2PTEL
  390. IP=IELCHE(L,J)
  391. IREF=(IP-1)*(IDIM+1)
  392. *
  393. * ON CREE UN NVX POINTS :NOEUD NBNO+1
  394. *
  395. SEGACT MCOORD
  396. NBNO=XCOOR(/1)/(IDIM+1)
  397. NBNOI=NBNO
  398. NBPTS=NBNO+1
  399. SEGADJ MCOORD
  400. *
  401. DO 831 IC=1,IDIM
  402. X3=XCOOR(IREF+IC)
  403. IF (X3.GE.X1.AND.X3.LE.X2) THEN
  404. XCOOR(NBNOI*(IDIM+1)+IC)=1.D0
  405. ELSE
  406. XCOOR(NBNOI*(IDIM+1)+IC)=0.D0
  407. ENDIF
  408. 831 CONTINUE
  409. XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=XCOOR(IREF+(IDIM+1))
  410. IELCHE(L,J)=NBPTS
  411. 83 CONTINUE
  412. ENDIF
  413. ENDIF
  414. SEGDES MELVA1
  415. GO TO 20
  416. *
  417. * SOIT ON CHERCHE SEULEMENT LA SOMME...
  418. * =====================================
  419. 10 CONTINUE
  420. *
  421. * MOT-CLE "SUPE"
  422. IF (ICLE.EQ.1) THEN
  423. IF (ICOD.EQ.1) THEN
  424. DO 121 J=1,N1EL
  425. DO 121 L=1,N1PTEL
  426. IF (VELCHE(L,J).GT.X1) IPCHMA=IPCHMA+1
  427. 121 CONTINUE
  428. ELSEIF (ICOD.EQ.2) THEN
  429. DO 122 J=1,N2EL
  430. DO 122 L=1,N2PTEL
  431. MLREEL=IELCHE(L,J)
  432. SEGACT MLREEL
  433. JG=PROG(/1)
  434. DO 1122 IPROG=1,JG
  435. IF (PROG(IPROG).GT.X1) IPCHMA=IPCHAM+1
  436. 1122 CONTINUE
  437. SEGDES MLREEL
  438. 122 CONTINUE
  439. ELSEIF (ICOD.EQ.3) THEN
  440. DO 123 J=1,N2EL
  441. DO 123 L=1,N2PTEL
  442. IP=IELCHE(L,J)
  443. IREF=(IP-1)*(IDIM+1)
  444. *
  445. DO 1123 IC=1,IDIM
  446. IF (XCOOR(IREF+IC).GT.X1) IPCHMA=IPCHAM+1
  447. 1123 CONTINUE
  448. 123 CONTINUE
  449. ENDIF
  450. *
  451. * MOT-CLE "EGSU"
  452. ELSEIF (ICLE.EQ.2) THEN
  453. IF (ICOD.EQ.1) THEN
  454. DO 131 J=1,N1EL
  455. DO 131 L=1,N1PTEL
  456. IF (VELCHE(L,J).GE.X1) IPCHMA=IPCHMA+1
  457. 131 CONTINUE
  458. ELSEIF (ICOD.EQ.2) THEN
  459. DO 132 J=1,N2EL
  460. DO 132 L=1,N2PTEL
  461. MLREEL=IELCHE(L,J)
  462. SEGACT MLREEL
  463. JG=PROG(/1)
  464. DO 1132 IPROG=1,JG
  465. IF (PROG(IPROG).GE.X1) IPCHMA=IPCHMA+1
  466. 1132 CONTINUE
  467. SEGDES MLREEL
  468. 132 CONTINUE
  469. ELSEIF (ICOD.EQ.3) THEN
  470. DO 133 J=1,N2EL
  471. DO 133 L=1,N2PTEL
  472. IP=IELCHE(L,J)
  473. IREF=(IP-1)*(IDIM+1)
  474. *
  475. DO 1133 IC=1,IDIM
  476. IF (XCOOR(IREF+IC).GE.X1) IPCHMA=IPCHMA+1
  477. 1133 CONTINUE
  478. 133 CONTINUE
  479. ENDIF
  480. *
  481. * MOT-CLE "EGAL"
  482. ELSEIF (ICLE.EQ.3) THEN
  483. IF (ICOD.EQ.1) THEN
  484. DO 141 J=1,N1EL
  485. DO 141 L=1,N1PTEL
  486. IF (VELCHE(L,J).EQ.X1) IPCHMA=IPCHMA+1
  487. 141 CONTINUE
  488. ELSEIF (ICOD.EQ.2) THEN
  489. DO 142 J=1,N2EL
  490. DO 142 L=1,N2PTEL
  491. MLREEL=IELCHE(L,J)
  492. SEGACT MLREEL
  493. JG=PROG(/1)
  494. DO 1142 IPROG=1,JG
  495. IF (PROG(IPROG).EQ.X1) IPCHMA=IPCHMA+1
  496. 1142 CONTINUE
  497. SEGDES MLREEL
  498. 142 CONTINUE
  499. ELSEIF (ICOD.EQ.3) THEN
  500. DO 143 J=1,N2EL
  501. DO 143 L=1,N2PTEL
  502. IP=IELCHE(L,J)
  503. IREF=(IP-1)*(IDIM+1)
  504. *
  505. DO 1143 IC=1,IDIM
  506. IF (XCOOR(IREF+IC).EQ.X1) IPCHMA=IPCHMA+1
  507. 1143 CONTINUE
  508. 143 CONTINUE
  509. ENDIF
  510. *
  511. * MOT-CLE "EGIN"
  512. ELSEIF (ICLE.EQ.4) THEN
  513. IF (ICOD.EQ.1) THEN
  514. DO 151 J=1,N1EL
  515. DO 151 L=1,N1PTEL
  516. IF (VELCHE(L,J).LE.X1) IPCHMA=IPCHMA+1
  517. 151 CONTINUE
  518. ELSEIF (ICOD.EQ.2) THEN
  519. DO 152 J=1,N2EL
  520. DO 152 L=1,N2PTEL
  521. MLREEL=IELCHE(L,J)
  522. SEGACT MLREEL
  523. JG=PROG(/1)
  524. DO 1152 IPROG=1,JG
  525. IF (PROG(IPROG).LE.X1) IPCHMA=IPCHMA+1
  526. 1152 CONTINUE
  527. SEGDES MLREEL
  528. 152 CONTINUE
  529. ELSEIF (ICOD.EQ.3) THEN
  530. DO 153 J=1,N2EL
  531. DO 153 L=1,N2PTEL
  532. IP=IELCHE(L,J)
  533. IREF=(IP-1)*(IDIM+1)
  534. *
  535. DO 1153 IC=1,IDIM
  536. IF (XCOOR(IREF+IC).LE.X1) IPCHMA=IPCHMA+1
  537. 1153 CONTINUE
  538. 153 CONTINUE
  539. ENDIF
  540. *
  541. * MOT-CLE "INFE"
  542. ELSEIF (ICLE.EQ.5) THEN
  543. IF (ICOD.EQ.1) THEN
  544. DO 161 J=1,N1EL
  545. DO 161 L=1,N1PTEL
  546. IF (VELCHE(L,J).LT.X1) IPCHMA=IPCHMA+1
  547. 161 CONTINUE
  548. ELSEIF (ICOD.EQ.2) THEN
  549. DO 162 J=1,N2EL
  550. DO 162 L=1,N2PTEL
  551. MLREEL=IELCHE(L,J)
  552. SEGACT MLREEL
  553. JG=PROG(/1)
  554. DO 1162 IPROG=1,JG
  555. IF (PROG(IPROG).LT.X1) IPCHMA=IPCHMA+1
  556. 1162 CONTINUE
  557. SEGDES MLREEL
  558. 162 CONTINUE
  559. ELSEIF (ICOD.EQ.3) THEN
  560. DO 163 J=1,N2EL
  561. DO 163 L=1,N2PTEL
  562. IP=IELCHE(L,J)
  563. IREF=(IP-1)*(IDIM+1)
  564. *
  565. DO 1163 IC=1,IDIM
  566. IF (XCOOR(IREF+IC).LT.X1) IPCHMA=IPCHMA+1
  567. 1163 CONTINUE
  568. 163 CONTINUE
  569. ENDIF
  570. *
  571. * MOT-CLE "DIFF"
  572. ELSEIF (ICLE.EQ.6) THEN
  573. IF (ICOD.EQ.1) THEN
  574. DO 171 J=1,N1EL
  575. DO 171 L=1,N1PTEL
  576. IF (VELCHE(L,J).NE.X1) IPCHMA=IPCHMA+1
  577. 171 CONTINUE
  578. ELSEIF (ICOD.EQ.2) THEN
  579. DO 172 J=1,N2EL
  580. DO 172 L=1,N2PTEL
  581. MLREEL=IELCHE(L,J)
  582. SEGACT MLREEL
  583. JG=PROG(/1)
  584. DO 1172 IPROG=1,JG
  585. IF (PROG(IPROG).NE.X1) IPCHMA=IPCHMA+1
  586. 1172 CONTINUE
  587. SEGDES MLREEL
  588. 172 CONTINUE
  589. ELSEIF (ICOD.EQ.3) THEN
  590. DO 173 J=1,N2EL
  591. DO 173 L=1,N2PTEL
  592. IP=IELCHE(L,J)
  593. IREF=(IP-1)*(IDIM+1)
  594. *
  595. DO 1173 IC=1,IDIM
  596. IF (XCOOR(IREF+IC).NE.X1) IPCHMA=IPCHMA+1
  597. 1173 CONTINUE
  598. 173 CONTINUE
  599. ENDIF
  600. *
  601. * MOT-CLE "COMP"
  602. ELSEIF (ICLE.EQ.7) THEN
  603. IF (ICOD.EQ.1) THEN
  604. DO 181 J=1,N1EL
  605. DO 181 L=1,N1PTEL
  606. IF (VELCHE(L,J).GE.X1.AND.VELCHE(L,J).LE.X2)
  607. & IPCHMA=IPCHMA+1
  608. 181 CONTINUE
  609. ELSEIF (ICOD.EQ.2) THEN
  610. DO 182 J=1,N2EL
  611. DO 182 L=1,N2PTEL
  612. MLREEL=IELCHE(L,J)
  613. SEGACT MLREEL
  614. JG=PROG(/1)
  615. DO 1182 IPROG=1,JG
  616. IF (PROG(IPROG).GE.X1.AND.PROG(IPROG).LE.X2)
  617. & IPCHMA=IPCHMA+1
  618. 1182 CONTINUE
  619. SEGDES MLREEL
  620. 182 CONTINUE
  621. ELSEIF (ICOD.EQ.3) THEN
  622. DO 183 J=1,N2EL
  623. DO 183 L=1,N2PTEL
  624. IP=IELCHE(L,J)
  625. IREF=(IP-1)*(IDIM+1)
  626. *
  627. DO 1183 IC=1,IDIM
  628. X3=XCOOR(IREF+IC)
  629. IF (X3.GE.X1.OR.X3.LE.X2) IPCHMA=IPCHMA+1
  630. 1183 CONTINUE
  631. 183 CONTINUE
  632. ENDIF
  633. ENDIF
  634.  
  635. 20 CONTINUE
  636. SEGDES MELVAL
  637. 30 CONTINUE
  638. SEGDES MCHAML
  639. 1 CONTINUE
  640. *
  641. IF (ISOM.EQ.0) THEN
  642. SEGDES MCHELM
  643. IPCHMA=MCHELM
  644. ENDIF
  645. SEGDES MCHELM
  646. *
  647. RETURN
  648. END
  649.  
  650.  
  651.  
  652.  
  653.  

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