Télécharger masche.eso

Retour à la liste

Numérotation des lignes :

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

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