Télécharger masche.eso

Retour à la liste

Numérotation des lignes :

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

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