Télécharger masche.eso

Retour à la liste

Numérotation des lignes :

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

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