Télécharger change.eso

Retour à la liste

Numérotation des lignes :

  1. C CHANGE SOURCE PV 20/04/02 21:15:11 10567
  2. C SERT A CHANGER LE TYPE DE L'ELEMENT DE L'OBJET
  3. C
  4. C CONVERSION QUA8->QUA9
  5. C CONVERSION QUA9->QUA4 PP 9/9/92
  6. C
  7. SUBROUTINE CHANGE(IPT1,ITY)
  8. IMPLICIT REAL*8 (A-H,O-Z)
  9. IMPLICIT INTEGER (I-N)
  10. -INC CCOPTIO
  11. -INC SMCOORD
  12. -INC CCGEOME
  13. -INC SMELEME
  14. SEGMENT NKON(IKOUR)
  15. SEGMENT KON(IKOUR,NKMAX,3)
  16. SEGMENT ICPR(nbpts)
  17. PARAMETER(NTYP2=5)
  18. CHARACTER*4 LTYP2(NTYP2),MTYP2
  19. REAL*8 Q89(4)
  20. *
  21. DATA LTYP2/'TRI3','TET4','QUA4','CUB8','PYR5'/
  22. *
  23. * regarder l'etat de mcoord pour remettre le meme en sortie
  24. call oooeta(mcoord,ieta,imod)
  25. *
  26.  
  27. * Si ce sont des QUAF et qu'on demande à changer
  28. * en TRI3, TET4, QUA4, CUB8, PYR5, on branche vers chang2
  29. CALL KQCEST(IPT1,IKR)
  30. IF (IKR.EQ.1341.OR.IKR.EQ.1.OR.IKR.EQ.13.OR.IKR.EQ.134) THEN
  31. MTYP2=NOMS(ITY)
  32. CALL FIMOT2(MTYP2,LTYP2,NTYP2,ITYP2,0,IRET)
  33. IF (IRET.NE.0) THEN
  34. CALL ERREUR(5)
  35. RETURN
  36. ENDIF
  37. IF (ITYP2.NE.0) THEN
  38. CALL CHANG2(IPT1,ITY)
  39. RETURN
  40. ENDIF
  41. ENDIF
  42. *
  43. SEGACT IPT1
  44. IPT5=IPT1
  45. IF (ITY.EQ.1) GOTO 10
  46. c IF (IPT1.LISOUS(/1).NE.0) CALL ERREUR(25)
  47. c IF (IERR.NE.0) RETURN
  48. ISOU=1
  49. 5 CONTINUE
  50. IF (IPT5.LISOUS(/1).NE.0) THEN
  51. IPT1=IPT5.LISOUS(ISOU)
  52. SEGACT,IPT1
  53. IF (IPT1.ITYPEL.EQ.ITY.OR.IPT1.ITYPEL.EQ.KSURF(ITY)) THEN
  54. IPT2=IPT1
  55. GOTO 100
  56. ENDIF
  57. ELSE
  58. IF (IPT1.ITYPEL.EQ.ITY) RETURN
  59. IF (IPT1.ITYPEL.EQ.KSURF(ITY)) RETURN
  60. ENDIF
  61.  
  62. * SG 2016/11/29 Gestion maillage vide
  63. IF (IPT1.NUM(/2).EQ.0) THEN
  64. CALL MELVID(ITY,IPT2)
  65. * ON LAISSE IPT2 ACTIF CAR BEAUCOUP DE GENS L'UTILISE AINSI
  66. SEGACT IPT2*MOD
  67. GOTO 100
  68. ENDIF
  69. IF (KSURF(ITY).NE.4.OR.IPT1.ITYPEL.NE.8) GOTO 10
  70. C
  71. C ON CHANGE DES Q4 EN COUPLES DE T3
  72. C
  73. NBELEM=2*IPT1.NUM(/2)
  74. NBNN=3
  75. NBSOUS=0
  76. NBREF=IPT1.LISREF(/1)
  77. SEGINI IPT2
  78. IPT2.ITYPEL=4
  79. IF (NBREF.EQ.0) GOTO 1
  80. DO 2 I=1,NBREF
  81. IPT2.LISREF(I)=IPT1.LISREF(I)
  82. 2 CONTINUE
  83. 1 DO 3 I=1,IPT1.NUM(/2),2
  84. J=2*I-1
  85. IPT2.NUM(1,J)=IPT1.NUM(1,I)
  86. IPT2.NUM(2,J)=IPT1.NUM(2,I)
  87. IPT2.NUM(3,J)=IPT1.NUM(3,I)
  88. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  89. J=J+1
  90. IPT2.NUM(1,J)=IPT1.NUM(1,I)
  91. IPT2.NUM(2,J)=IPT1.NUM(3,I)
  92. IPT2.NUM(3,J)=IPT1.NUM(4,I)
  93. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  94. J=J+1
  95. IF (J.GT.IPT2.NUM(/2)) GOTO 3
  96. IPT2.NUM(1,J)=IPT1.NUM(1,I+1)
  97. IPT2.NUM(2,J)=IPT1.NUM(2,I+1)
  98. IPT2.NUM(3,J)=IPT1.NUM(4,I+1)
  99. IPT2.ICOLOR(J)=IPT1.ICOLOR(I+1)
  100. J=J+1
  101. IPT2.NUM(1,J)=IPT1.NUM(2,I+1)
  102. IPT2.NUM(2,J)=IPT1.NUM(3,I+1)
  103. IPT2.NUM(3,J)=IPT1.NUM(4,I+1)
  104. IPT2.ICOLOR(J)=IPT1.ICOLOR(I+1)
  105. 3 CONTINUE
  106. GOTO 100
  107. 10 CONTINUE
  108. * IF (IPT1.ITYPEL.EQ.ITY) RETURN
  109. IF (ITY.NE.1) GOTO 20
  110. C
  111. C ON CHANGE EN P1
  112. C
  113. SEGINI ICPR
  114. DO 11 I=1,nbpts
  115. ICPR(I)=0
  116. 11 CONTINUE
  117. ICON=0
  118. IPT2=IPT1
  119. DO 14 IOB=1,MAX(1,IPT1.LISOUS(/1))
  120. IF (IPT1.LISOUS(/1).NE.0) THEN
  121. IPT2=IPT1.LISOUS(IOB)
  122. SEGACT IPT2
  123. ENDIF
  124. DO 12 I=1,IPT2.NUM(/1)
  125. DO 12 J=1,IPT2.NUM(/2)
  126. IKI=IPT2.NUM(I,J)
  127. IF (ICPR(IKI).NE.0) GOTO 12
  128. ICON=ICON+1
  129. ICPR(IKI)=ICON
  130. 12 CONTINUE
  131. C IF (IPT1.LISOUS(/1).NE.0) SEGDES IPT2
  132. 14 CONTINUE
  133. NBSOUS=0
  134. NBREF=0
  135. NBELEM=ICON
  136. NBNN=1
  137. SEGINI IPT2
  138. IPT2.ITYPEL=1
  139. DO 13 I=1,nbpts
  140. IF (ICPR(I).EQ.0) GOTO 13
  141. IPT2.NUM(1,ICPR(I))=I
  142. 13 CONTINUE
  143. call crech1(ipt2,1)
  144. SEGSUP ICPR
  145. GOTO 100
  146. *
  147. 20 IF ((IPT1.ITYPEL.NE.4.OR.KSURF(ITY).NE.6).AND.
  148. # (IPT1.ITYPEL.NE.8.OR.KSURF(ITY).NE.10).AND.
  149. # (IPT1.ITYPEL.NE.8.OR.KSURF(ITY).NE.6).AND.
  150. # (IPT1.ITYPEL.NE.14.OR.ITY.NE.15)) GOTO 50
  151. C
  152. C ON CHANGE EVENTUELLEMENT EN DEUX TEMPS DES Q4 EN T6
  153. C ON CHANGE DES T3 EN T6 OU DES Q4 EN Q8 OU DES CUB8 EN CUB20.
  154. C
  155. SEGINI ICPR
  156. DO 21 I=1,nbpts
  157. ICPR(I)=0
  158. 21 CONTINUE
  159. IKOUR=0
  160. DO 22 I=1,IPT1.NUM(/1)
  161. DO 22 J=1,IPT1.NUM(/2)
  162. ITH=IPT1.NUM(I,J)
  163. IF (ICPR(ITH).NE.0) GOTO 22
  164. IKOUR=IKOUR+1
  165. ICPR(ITH)=IKOUR
  166. 22 CONTINUE
  167. SEGINI NKON
  168. DO 23 I=1,IKOUR
  169. NKON(I)=0
  170. 23 CONTINUE
  171. DO 24 I=1,IPT1.NUM(/1)
  172. DO 24 J=1,IPT1.NUM(/2)
  173. NKON(ICPR(IPT1.NUM(I,J)))=NKON(ICPR(IPT1.NUM(I,J)))+1
  174. 24 CONTINUE
  175. NKMAX=0
  176. DO 25 I=1,IKOUR
  177. NKMAX=MAX(NKMAX,NKON(I))
  178. 25 CONTINUE
  179. 26 SEGINI KON
  180. DO 27 I=1,IKOUR
  181. DO 27 J=1,NKMAX
  182. KON(I,J,1)=0
  183. KON(I,J,2)=0
  184. KON(I,J,3)=0
  185. 27 CONTINUE
  186. IF (IPT1.LISREF(/1).EQ.0) GOTO 33
  187. C
  188. C REMPLISSAGE DE KON DANS LE CAS OU LES COTES DE L'OBJET
  189. C SONT A 3 NOEUDS OU 8 NOEUDS.
  190. DO 32 IN=1,IPT1.LISREF(/1)
  191. IPT3=IPT1.LISREF(IN)
  192. SEGACT IPT3
  193. IF ((IPT3.ITYPEL.NE.3).AND.(IPT3.ITYPEL.NE.10)) GOTO 32
  194. DO 31 J=1,IPT3.NUM(/2)
  195. DO 31 I=1,IPT3.NUM(/1),2
  196. IFI=I+2
  197. IF ((I.EQ.IPT3.NUM(/1)).AND.(IPT3.ITYPEL.EQ.3)) GOTO 31
  198. IF (IFI.GT.IPT3.NUM(/1)) IFI=1
  199. I1=IPT3.NUM(I,J)
  200. I2=IPT3.NUM(IFI,J)
  201. J1=ICPR(MIN(I1,I2))
  202. J2=MAX(I1,I2)
  203. KSCOL=IPT3.ICOLOR(J)
  204. ITF=0
  205. 29 ITF=ITF+1
  206. IF (ITF.GT.NKMAX) GOTO 61
  207. IF ((KON(J1,ITF,1).EQ.J2).OR.(KON(J1,ITF,1).EQ.0)) GOTO 30
  208. GOTO 29
  209. 30 KON(J1,ITF,1)=J2
  210. KON(J1,ITF,2)=IPT3.NUM(I+1,J)
  211. KON(J1,ITF,3)=KSCOL
  212. 31 CONTINUE
  213. C SEGDES IPT3
  214. 32 CONTINUE
  215. C
  216. C CREATION DES NOUVEAUX NOEUDS.
  217. 33 NBELEM=IPT1.NUM(/2)
  218. NBNN1=IPT1.NUM(/1)
  219. NBNN=NBNN1*2
  220. IF (IPT1.ITYPEL.EQ.14) NBNN=20
  221. NBSOUS=0
  222. NBREF=IPT1.LISREF(/1)
  223. SEGINI IPT2
  224. IPT2.ITYPEL=IPT1.ITYPEL+2
  225. IF (IPT1.ITYPEL.EQ.14) IPT2.ITYPEL=15
  226. SEGACT MCOORD*mod
  227. DO 38 J=1,NBELEM
  228. DO 38 I=1,NBNN1
  229. IND=0
  230. IF (I.GT.4) IND=4
  231. IPT2.NUM(2*I-1+IND,J)=IPT1.NUM(I,J)
  232. IFI=I+1
  233. IF ((IPT1.ITYPEL.EQ.14).AND.(I.EQ.4)) IFI=1
  234. IF ((IPT1.ITYPEL.EQ.14).AND.(I.EQ.NBNN1)) IFI=5
  235. IF ((IPT1.ITYPEL.NE.14).AND.(I.EQ.NBNN1)) IFI=1
  236. I1=IPT1.NUM(I,J)
  237. I2=IPT1.NUM(IFI,J)
  238. J1=ICPR(MIN(I1,I2))
  239. J2=MAX(I1,I2)
  240. KSCOL=IPT1.ICOLOR(J)
  241. ITF=0
  242. 34 ITF=ITF+1
  243. IF (ITF.GT.NKMAX) GOTO 61
  244. IF (KON(J1,ITF,1).EQ.J2) GOTO 35
  245. IF (KON(J1,ITF,1).NE.0) GOTO 34
  246. KON(J1,ITF,1)=J2
  247. KON(J1,ITF,3)=KSCOL
  248. IREFI=(IDIM+1)*(I1-1)
  249. IREFJ=(IDIM+1)*(I2-1)
  250. NBPTS=nbpts+1
  251. SEGADJ MCOORD
  252. DO 71 K=1,IDIM+1
  253. XCOOR((NBPTS-1)*(IDIM+1)+K)=0.5D0*(XCOOR(IREFI+K)+XCOOR(IREFJ+K))
  254. 71 CONTINUE
  255. KON(J1,ITF,2)=nbpts
  256. 35 IPT2.NUM(2*I+IND,J)=KON(J1,ITF,2)
  257. IPT2.ICOLOR(J)=KON(J1,ITF,3)
  258. IF ((IPT1.ITYPEL.NE.14).OR.(I.GT.4)) GOTO 38
  259. I2=IPT1.NUM(I+4,J)
  260. J1=ICPR(MIN(I1,I2))
  261. J2=MAX(I1,I2)
  262. ITF=0
  263. 36 ITF=ITF+1
  264. IF (ITF.GT.NKMAX) GOTO 61
  265. IF (KON(J1,ITF,1).EQ.J2) GOTO 37
  266. IF (KON(J1,ITF,1).NE.0) GOTO 36
  267. KON(J1,ITF,1)=J2
  268. IREFI=(IDIM+1)*(I1-1)
  269. IREFJ=(IDIM+1)*(I2-1)
  270. NBPTS=nbpts+1
  271. SEGADJ MCOORD
  272. DO 72 K=1,IDIM+1
  273. XCOOR((NBPTS-1)*(IDIM+1)+K)=0.5D0*(XCOOR(IREFI+K)+XCOOR(IREFJ+K))
  274. 72 CONTINUE
  275. KON(J1,ITF,2)=nbpts
  276. 37 IPT2.NUM(I+8,J)=KON(J1,ITF,2)
  277. IPT2.ICOLOR(J)=KON(J1,ITF,3)
  278. 38 CONTINUE
  279. IF (IPT1.LISREF(/1).EQ.0) GOTO 48
  280. C
  281. C MISE A JOUR DES COTES DE L'OBJET.
  282. DO 46 IN=1,IPT1.LISREF(/1)
  283. IPT3=IPT1.LISREF(IN)
  284. SEGACT IPT3
  285. IF (IPT3.ITYPEL.EQ.2) GOTO 40
  286. IF (IPT3.ITYPEL.EQ.8) GOTO 41
  287. IPT2.LISREF(IN)=IPT3
  288. GOTO 46
  289. 40 NBELEM=IPT3.NUM(/2)
  290. NBNN=3
  291. NBSOUS=0
  292. NBREF=IPT3.LISREF(/1)
  293. SEGINI IPT4
  294. IPT4.ITYPEL=3
  295. GOTO 42
  296. 41 NBELEM=IPT3.NUM(/2)
  297. NBNN=8
  298. NBSOUS=0
  299. * pv on ne cree pas les cotes NBREF=IPT3.LISREF(/1)
  300. nbref=0
  301. SEGINI IPT4
  302. IPT4.ITYPEL=10
  303. 42 NBNN3=IPT3.NUM(/1)
  304. DO 44 J=1,NBELEM
  305. DO 44 I=1,NBNN3
  306. IFI=I+1
  307. IF (I.EQ.NBNN3) IFI=1
  308. I1=IPT3.NUM(I,J)
  309. I2=IPT3.NUM(IFI,J)
  310. IPT4.NUM(2*I-1,J)=I1
  311. IPT4.ICOLOR(J)=IPT3.ICOLOR(J)
  312. IF ((NBNN3.EQ.2).AND.(IFI.EQ.1)) GOTO 44
  313. J1=ICPR(MIN(I1,I2))
  314. J2=MAX(I1,I2)
  315. ITF=0
  316. 43 ITF=ITF+1
  317. IF (KON(J1,ITF,1).NE.J2) GOTO 43
  318. IPT4.NUM(2*I,J)=KON(J1,ITF,2)
  319. IPT4.ICOLOR(J)=KON(J1,ITF,3)
  320. 44 CONTINUE
  321. IPT2.LISREF(IN)=IPT4
  322. C SEGDES IPT4,IPT3
  323. 46 CONTINUE
  324. 48 SEGSUP ICPR,NKON,KON
  325. IF ((IPT2.ITYPEL.EQ.KSURF(ITY)).OR.(IPT2.ITYPEL.EQ.15)) GOTO 100
  326. C SEGDES IPT1
  327. IPT1=IPT2
  328. 50 IF (KSURF(ITY).NE.6.OR.IPT1.ITYPEL.NE.10) GOTO 60
  329. C
  330. C ON CHANGE DES Q8 EN COUPLES DE TRI6
  331. C
  332. SEGACT MCOORD*mod
  333. NBELEM=2*IPT1.NUM(/2)
  334. NBNN=6
  335. NBSOUS=0
  336. NBREF=IPT1.LISREF(/1)
  337. SEGINI IPT2
  338. IPT2.ITYPEL=6
  339. IF (NBREF.EQ.0) GOTO 51
  340. DO 52 I=1,NBREF
  341. IPT2.LISREF(I)=IPT1.LISREF(I)
  342. 52 CONTINUE
  343. 51 CONTINUE
  344. NBPTT=nbpts
  345. NBPTS=NBPTT+IPT1.NUM(/2)
  346. SEGADJ MCOORD
  347. DO 53 I=1,IPT1.NUM(/2),2
  348. J=2*I-1
  349. I1=IPT1.NUM(1,I)
  350. I2=IPT1.NUM(3,I)
  351. I3=IPT1.NUM(5,I)
  352. I4=IPT1.NUM(7,I)
  353. IREF1=(I1-1)*(IDIM+1)
  354. IREF2=(I2-1)*(IDIM+1)
  355. IREF3=(I3-1)*(IDIM+1)
  356. IREF4=(I4-1)*(IDIM+1)
  357. DO 73 K=1,IDIM+1
  358. XCOOR(NBPTT*(IDIM+1)+K)=
  359. $0.25D0*(XCOOR(IREF1+K)+XCOOR(IREF2+K)+
  360. $ XCOOR(IREF3+K)+XCOOR(IREF4+K))
  361. 73 CONTINUE
  362. NBPTT=NBPTT+1
  363. ISUP=NBPTT
  364. IPT2.NUM(1,J)=I1
  365. IPT2.NUM(2,J)=IPT1.NUM(2,I)
  366. IPT2.NUM(3,J)=I2
  367. IPT2.NUM(4,J)=IPT1.NUM(4,I)
  368. IPT2.NUM(5,J)=I3
  369. IPT2.NUM(6,J)=ISUP
  370. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  371. J=J+1
  372. IPT2.NUM(1,J)=I1
  373. IPT2.NUM(2,J)=ISUP
  374. IPT2.NUM(3,J)=I3
  375. IPT2.NUM(4,J)=IPT1.NUM(6,I)
  376. IPT2.NUM(5,J)=I4
  377. IPT2.NUM(6,J)=IPT1.NUM(8,I)
  378. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  379. J=J+1
  380. IF (J.GT.IPT2.NUM(/2)) GOTO 53
  381. I1=IPT1.NUM(1,I+1)
  382. I2=IPT1.NUM(3,I+1)
  383. I3=IPT1.NUM(5,I+1)
  384. I4=IPT1.NUM(7,I+1)
  385. IREF1=(I1-1)*(IDIM+1)
  386. IREF2=(I2-1)*(IDIM+1)
  387. IREF3=(I3-1)*(IDIM+1)
  388. IREF4=(I4-1)*(IDIM+1)
  389. DO 74 K=1,IDIM+1
  390. XCOOR(NBPTT*(IDIM+1)+K)=
  391. #0.25D0*(XCOOR(IREF1+K)+XCOOR(IREF2+K)+
  392. $ XCOOR(IREF3+K)+XCOOR(IREF4+K))
  393. 74 CONTINUE
  394. NBPTT=NBPTT+1
  395. ISUP=NBPTT
  396. IPT2.NUM(1,J)=I1
  397. IPT2.NUM(2,J)=IPT1.NUM(2,I+1)
  398. IPT2.NUM(3,J)=I2
  399. IPT2.NUM(4,J)=ISUP
  400. IPT2.NUM(5,J)=I4
  401. IPT2.NUM(6,J)=IPT1.NUM(8,I+1)
  402. IPT2.ICOLOR(J)=IPT1.ICOLOR(I+1)
  403. J=J+1
  404. IPT2.NUM(1,J)=I2
  405. IPT2.NUM(2,J)=IPT1.NUM(4,I+1)
  406. IPT2.NUM(3,J)=I3
  407. IPT2.NUM(4,J)=IPT1.NUM(6,I+1)
  408. IPT2.NUM(5,J)=I4
  409. IPT2.NUM(6,J)=ISUP
  410. IPT2.ICOLOR(J)=IPT1.ICOLOR(I+1)
  411. 53 CONTINUE
  412. GOTO 100
  413. 60 CONTINUE
  414. IF(IPT1.ITYPEL.NE.3.OR.KDEGRE(ITY).NE.2) GO TO 70
  415. N1=IPT1.NUM(/2)
  416. NBELEM=N1*2
  417. NBNN=2
  418. NBSOUS=0
  419. NBREF=0
  420. SEGINI IPT2
  421. IPT2.ITYPEL=2
  422. DO 63 I=1,N1
  423. I2=(I-1)*2+1
  424. IPT2.NUM(1,I2 )=IPT1.NUM(1,I)
  425. IPT2.NUM(2,I2 )=IPT1.NUM(2,I)
  426. IPT2.ICOLOR(I2)=IPT1.ICOLOR(I)
  427. IPT2.NUM(1,I2+1)=IPT1.NUM(2,I)
  428. IPT2.NUM(2,I2+1)=IPT1.NUM(3,I)
  429. IPT2.ICOLOR(I2+1)=IPT1.ICOLOR(I)
  430. 63 CONTINUE
  431. GO TO 100
  432. 70 CONTINUE
  433. C ON CHANGE DES T6 EN QUATRE T3
  434. IF(IPT1.ITYPEL.NE.6.OR.KSURF(ITY).NE.4) GO TO 80
  435. C
  436. NBELEM=4*IPT1.NUM(/2)
  437. NBNN=3
  438. NBSOUS=0
  439. * on oublie les cotes ou contours
  440. NBREF=0
  441. SEGINI IPT2
  442. IPT2.ITYPEL=4
  443. DO 77 I=1,IPT1.NUM(/2)
  444. J=4*I-3
  445. IPT2.NUM(1,J)=IPT1.NUM(1,I)
  446. IPT2.NUM(2,J)=IPT1.NUM(2,I)
  447. IPT2.NUM(3,J)=IPT1.NUM(6,I)
  448. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  449. J=J+1
  450. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  451. IPT2.NUM(2,J)=IPT1.NUM(3,I)
  452. IPT2.NUM(3,J)=IPT1.NUM(4,I)
  453. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  454. J=J+1
  455. IPT2.NUM(1,J)=IPT1.NUM(4,I)
  456. IPT2.NUM(2,J)=IPT1.NUM(5,I)
  457. IPT2.NUM(3,J)=IPT1.NUM(6,I)
  458. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  459. J=J+1
  460. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  461. IPT2.NUM(2,J)=IPT1.NUM(4,I)
  462. IPT2.NUM(3,J)=IPT1.NUM(6,I)
  463. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  464. 77 CONTINUE
  465. GOTO 100
  466. 80 CONTINUE
  467. C ON CHANGE DES Q8 EN SIX T3
  468. IF(IPT1.ITYPEL.NE.10.OR.KSURF(ITY).NE.4) GO TO 90
  469. C
  470. NBELEM=6*IPT1.NUM(/2)
  471. NBNN=3
  472. NBSOUS=0
  473. * on oublie les cotes ou contours
  474. NBREF=0
  475. SEGINI IPT2
  476. IPT2.ITYPEL=4
  477. DO 83 I=1,IPT1.NUM(/2)
  478. J=6*I-5
  479. IPT2.NUM(1,J)=IPT1.NUM(1,I)
  480. IPT2.NUM(2,J)=IPT1.NUM(2,I)
  481. IPT2.NUM(3,J)=IPT1.NUM(8,I)
  482. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  483. J=J+1
  484. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  485. IPT2.NUM(2,J)=IPT1.NUM(3,I)
  486. IPT2.NUM(3,J)=IPT1.NUM(4,I)
  487. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  488. J=J+1
  489. IPT2.NUM(1,J)=IPT1.NUM(4,I)
  490. IPT2.NUM(2,J)=IPT1.NUM(5,I)
  491. IPT2.NUM(3,J)=IPT1.NUM(6,I)
  492. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  493. J=J+1
  494. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  495. IPT2.NUM(2,J)=IPT1.NUM(4,I)
  496. IPT2.NUM(3,J)=IPT1.NUM(6,I)
  497. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  498. J=J+1
  499. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  500. IPT2.NUM(2,J)=IPT1.NUM(6,I)
  501. IPT2.NUM(3,J)=IPT1.NUM(8,I)
  502. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  503. J=J+1
  504. IPT2.NUM(1,J)=IPT1.NUM(6,I)
  505. IPT2.NUM(2,J)=IPT1.NUM(7,I)
  506. IPT2.NUM(3,J)=IPT1.NUM(8,I)
  507. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  508. 83 CONTINUE
  509. GOTO 100
  510. 90 CONTINUE
  511. C ON CHANGE DES CUB8 EN CINQ TET4
  512. IF(IPT1.ITYPEL.NE.14.OR.ITY.NE.23) GO TO 130
  513. C
  514. NBELEM=5*IPT1.NUM(/2)
  515. NBNN=4
  516. NBSOUS=0
  517. * on oublie les cotes ou contours ou faces
  518. NBREF=0
  519. SEGINI IPT2
  520. IPT2.ITYPEL=23
  521. DO 93 I=1,IPT1.NUM(/2)
  522. J=5*I-4
  523. IPT2.NUM(1,J)=IPT1.NUM(1,I)
  524. IPT2.NUM(2,J)=IPT1.NUM(2,I)
  525. IPT2.NUM(3,J)=IPT1.NUM(4,I)
  526. IPT2.NUM(4,J)=IPT1.NUM(5,I)
  527. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  528. J=J+1
  529. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  530. IPT2.NUM(2,J)=IPT1.NUM(3,I)
  531. IPT2.NUM(3,J)=IPT1.NUM(4,I)
  532. IPT2.NUM(4,J)=IPT1.NUM(7,I)
  533. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  534. J=J+1
  535. IPT2.NUM(1,J)=IPT1.NUM(4,I)
  536. IPT2.NUM(2,J)=IPT1.NUM(5,I)
  537. IPT2.NUM(3,J)=IPT1.NUM(7,I)
  538. IPT2.NUM(4,J)=IPT1.NUM(8,I)
  539. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  540. J=J+1
  541. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  542. IPT2.NUM(2,J)=IPT1.NUM(5,I)
  543. IPT2.NUM(3,J)=IPT1.NUM(6,I)
  544. IPT2.NUM(4,J)=IPT1.NUM(7,I)
  545. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  546. J=J+1
  547. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  548. IPT2.NUM(2,J)=IPT1.NUM(4,I)
  549. IPT2.NUM(3,J)=IPT1.NUM(5,I)
  550. IPT2.NUM(4,J)=IPT1.NUM(7,I)
  551. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  552. 93 CONTINUE
  553. GOTO 100
  554. 130 CONTINUE
  555. C ON CHANGE DES PRI6 EN TROIS TET4
  556. IF(IPT1.ITYPEL.NE.16.OR.ITY.NE.23) GO TO 140
  557. C
  558. NBELEM=3*IPT1.NUM(/2)
  559. NBNN=4
  560. NBSOUS=0
  561. * on oublie les cotes ou contours ou faces
  562. NBREF=0
  563. SEGINI IPT2
  564. IPT2.ITYPEL=23
  565. DO 133 I=1,IPT1.NUM(/2)
  566. J=3*I-2
  567. IPT2.NUM(1,J)=IPT1.NUM(1,I)
  568. IPT2.NUM(2,J)=IPT1.NUM(2,I)
  569. IPT2.NUM(3,J)=IPT1.NUM(3,I)
  570. IPT2.NUM(4,J)=IPT1.NUM(4,I)
  571. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  572. J=J+1
  573. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  574. IPT2.NUM(2,J)=IPT1.NUM(3,I)
  575. IPT2.NUM(3,J)=IPT1.NUM(4,I)
  576. IPT2.NUM(4,J)=IPT1.NUM(5,I)
  577. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  578. J=J+1
  579. IPT2.NUM(1,J)=IPT1.NUM(3,I)
  580. IPT2.NUM(2,J)=IPT1.NUM(4,I)
  581. IPT2.NUM(3,J)=IPT1.NUM(5,I)
  582. IPT2.NUM(4,J)=IPT1.NUM(6,I)
  583. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  584. 133 CONTINUE
  585. GOTO 100
  586. 140 CONTINUE
  587. C ON CHANGE DES PYR5 EN DEUX TET4
  588. IF(IPT1.ITYPEL.NE.25.OR.ITY.NE.23) GO TO 150
  589. C
  590. NBELEM=2*IPT1.NUM(/2)
  591. NBNN=4
  592. NBSOUS=0
  593. * on oublie les cotes ou contours ou faces
  594. NBREF=0
  595. SEGINI IPT2
  596. IPT2.ITYPEL=23
  597. DO 143 I=1,IPT1.NUM(/2)
  598. J=2*I-1
  599. IPT2.NUM(1,J)=IPT1.NUM(1,I)
  600. IPT2.NUM(2,J)=IPT1.NUM(2,I)
  601. IPT2.NUM(3,J)=IPT1.NUM(4,I)
  602. IPT2.NUM(4,J)=IPT1.NUM(5,I)
  603. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  604. J=J+1
  605. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  606. IPT2.NUM(2,J)=IPT1.NUM(3,I)
  607. IPT2.NUM(3,J)=IPT1.NUM(4,I)
  608. IPT2.NUM(4,J)=IPT1.NUM(5,I)
  609. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  610. 143 CONTINUE
  611. GOTO 100
  612. 150 CONTINUE
  613. C ON CHANGE DES TE10 EN HUIT TET4
  614. IF(IPT1.ITYPEL.NE.24.OR.ITY.NE.23) GO TO 160
  615. C
  616. NBELEM=8*IPT1.NUM(/2)
  617. NBNN=4
  618. NBSOUS=0
  619. * on oublie les cotes ou contours ou faces
  620. NBREF=0
  621. SEGINI IPT2
  622. IPT2.ITYPEL=23
  623. DO 153 I=1,IPT1.NUM(/2)
  624. J=8*I-7
  625. IPT2.NUM(1,J)=IPT1.NUM(1,I)
  626. IPT2.NUM(2,J)=IPT1.NUM(2,I)
  627. IPT2.NUM(3,J)=IPT1.NUM(6,I)
  628. IPT2.NUM(4,J)=IPT1.NUM(7,I)
  629. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  630. J=J+1
  631. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  632. IPT2.NUM(2,J)=IPT1.NUM(3,I)
  633. IPT2.NUM(3,J)=IPT1.NUM(4,I)
  634. IPT2.NUM(4,J)=IPT1.NUM(8,I)
  635. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  636. J=J+1
  637. IPT2.NUM(1,J)=IPT1.NUM(4,I)
  638. IPT2.NUM(2,J)=IPT1.NUM(5,I)
  639. IPT2.NUM(3,J)=IPT1.NUM(6,I)
  640. IPT2.NUM(4,J)=IPT1.NUM(9,I)
  641. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  642. J=J+1
  643. IPT2.NUM(1,J)=IPT1.NUM(7,I)
  644. IPT2.NUM(2,J)=IPT1.NUM(8,I)
  645. IPT2.NUM(3,J)=IPT1.NUM(9,I)
  646. IPT2.NUM(4,J)=IPT1.NUM(10,I)
  647. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  648. J=J+1
  649. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  650. IPT2.NUM(2,J)=IPT1.NUM(4,I)
  651. IPT2.NUM(3,J)=IPT1.NUM(7,I)
  652. IPT2.NUM(4,J)=IPT1.NUM(8,I)
  653. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  654. J=J+1
  655. IPT2.NUM(1,J)=IPT1.NUM(4,I)
  656. IPT2.NUM(2,J)=IPT1.NUM(7,I)
  657. IPT2.NUM(3,J)=IPT1.NUM(8,I)
  658. IPT2.NUM(4,J)=IPT1.NUM(9,I)
  659. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  660. J=J+1
  661. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  662. IPT2.NUM(2,J)=IPT1.NUM(4,I)
  663. IPT2.NUM(3,J)=IPT1.NUM(6,I)
  664. IPT2.NUM(4,J)=IPT1.NUM(7,I)
  665. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  666. J=J+1
  667. IPT2.NUM(1,J)=IPT1.NUM(4,I)
  668. IPT2.NUM(2,J)=IPT1.NUM(6,I)
  669. IPT2.NUM(3,J)=IPT1.NUM(7,I)
  670. IPT2.NUM(4,J)=IPT1.NUM(9,I)
  671. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  672. 153 CONTINUE
  673. GOTO 100
  674. 160 CONTINUE
  675. C ON CHANGE DES CU20 EN 22 TET4
  676. IF(IPT1.ITYPEL.NE.15.OR.ITY.NE.23) GO TO 170
  677. C
  678. NBELEM=22*IPT1.NUM(/2)
  679. NBNN=4
  680. NBSOUS=0
  681. * on oublie les cotes ou contours ou faces
  682. NBREF=0
  683. SEGINI IPT2
  684. IPT2.ITYPEL=23
  685. DO 163 I=1,IPT1.NUM(/2)
  686. J=22*I-21
  687. IPT2.NUM(1,J)=IPT1.NUM(1,I)
  688. IPT2.NUM(2,J)=IPT1.NUM(2,I)
  689. IPT2.NUM(3,J)=IPT1.NUM(8,I)
  690. IPT2.NUM(4,J)=IPT1.NUM(9,I)
  691. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  692. J=J+1
  693. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  694. IPT2.NUM(2,J)=IPT1.NUM(3,I)
  695. IPT2.NUM(3,J)=IPT1.NUM(4,I)
  696. IPT2.NUM(4,J)=IPT1.NUM(10,I)
  697. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  698. J=J+1
  699. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  700. IPT2.NUM(2,J)=IPT1.NUM(4,I)
  701. IPT2.NUM(3,J)=IPT1.NUM(8,I)
  702. IPT2.NUM(4,J)=IPT1.NUM(10,I)
  703. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  704. J=J+1
  705. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  706. IPT2.NUM(2,J)=IPT1.NUM(8,I)
  707. IPT2.NUM(3,J)=IPT1.NUM(9,I)
  708. IPT2.NUM(4,J)=IPT1.NUM(10,I)
  709. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  710. J=J+1
  711. IPT2.NUM(1,J)=IPT1.NUM(6,I)
  712. IPT2.NUM(2,J)=IPT1.NUM(7,I)
  713. IPT2.NUM(3,J)=IPT1.NUM(8,I)
  714. IPT2.NUM(4,J)=IPT1.NUM(12,I)
  715. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  716. J=J+1
  717. IPT2.NUM(1,J)=IPT1.NUM(4,I)
  718. IPT2.NUM(2,J)=IPT1.NUM(5,I)
  719. IPT2.NUM(3,J)=IPT1.NUM(6,I)
  720. IPT2.NUM(4,J)=IPT1.NUM(11,I)
  721. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  722. J=J+1
  723. IPT2.NUM(1,J)=IPT1.NUM(4,I)
  724. IPT2.NUM(2,J)=IPT1.NUM(6,I)
  725. IPT2.NUM(3,J)=IPT1.NUM(8,I)
  726. IPT2.NUM(4,J)=IPT1.NUM(12,I)
  727. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  728. J=J+1
  729. IPT2.NUM(1,J)=IPT1.NUM(4,I)
  730. IPT2.NUM(2,J)=IPT1.NUM(6,I)
  731. IPT2.NUM(3,J)=IPT1.NUM(11,I)
  732. IPT2.NUM(4,J)=IPT1.NUM(12,I)
  733. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  734. J=J+1
  735. IPT2.NUM(1,J)=IPT1.NUM(4,I)
  736. IPT2.NUM(2,J)=IPT1.NUM(10,I)
  737. IPT2.NUM(3,J)=IPT1.NUM(11,I)
  738. IPT2.NUM(4,J)=IPT1.NUM(12,I)
  739. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  740. J=J+1
  741. IPT2.NUM(1,J)=IPT1.NUM(4,I)
  742. IPT2.NUM(2,J)=IPT1.NUM(8,I)
  743. IPT2.NUM(3,J)=IPT1.NUM(10,I)
  744. IPT2.NUM(4,J)=IPT1.NUM(12,I)
  745. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  746. J=J+1
  747. IPT2.NUM(1,J)=IPT1.NUM(8,I)
  748. IPT2.NUM(2,J)=IPT1.NUM(9,I)
  749. IPT2.NUM(3,J)=IPT1.NUM(10,I)
  750. IPT2.NUM(4,J)=IPT1.NUM(12,I)
  751. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  752. J=J+1
  753. IPT2.NUM(1,J)=IPT1.NUM(9,I)
  754. IPT2.NUM(2,J)=IPT1.NUM(10,I)
  755. IPT2.NUM(3,J)=IPT1.NUM(12,I)
  756. IPT2.NUM(4,J)=IPT1.NUM(20,I)
  757. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  758. J=J+1
  759. IPT2.NUM(1,J)=IPT1.NUM(10,I)
  760. IPT2.NUM(2,J)=IPT1.NUM(12,I)
  761. IPT2.NUM(3,J)=IPT1.NUM(16,I)
  762. IPT2.NUM(4,J)=IPT1.NUM(20,I)
  763. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  764. J=J+1
  765. IPT2.NUM(1,J)=IPT1.NUM(10,I)
  766. IPT2.NUM(2,J)=IPT1.NUM(11,I)
  767. IPT2.NUM(3,J)=IPT1.NUM(12,I)
  768. IPT2.NUM(4,J)=IPT1.NUM(16,I)
  769. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  770. J=J+1
  771. IPT2.NUM(1,J)=IPT1.NUM(10,I)
  772. IPT2.NUM(2,J)=IPT1.NUM(15,I)
  773. IPT2.NUM(3,J)=IPT1.NUM(16,I)
  774. IPT2.NUM(4,J)=IPT1.NUM(14,I)
  775. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  776. J=J+1
  777. IPT2.NUM(1,J)=IPT1.NUM(11,I)
  778. IPT2.NUM(2,J)=IPT1.NUM(16,I)
  779. IPT2.NUM(3,J)=IPT1.NUM(17,I)
  780. IPT2.NUM(4,J)=IPT1.NUM(18,I)
  781. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  782. J=J+1
  783. IPT2.NUM(1,J)=IPT1.NUM(12,I)
  784. IPT2.NUM(2,J)=IPT1.NUM(18,I)
  785. IPT2.NUM(3,J)=IPT1.NUM(19,I)
  786. IPT2.NUM(4,J)=IPT1.NUM(20,I)
  787. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  788. J=J+1
  789. IPT2.NUM(1,J)=IPT1.NUM(11,I)
  790. IPT2.NUM(2,J)=IPT1.NUM(12,I)
  791. IPT2.NUM(3,J)=IPT1.NUM(16,I)
  792. IPT2.NUM(4,J)=IPT1.NUM(18,I)
  793. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  794. J=J+1
  795. IPT2.NUM(1,J)=IPT1.NUM(12,I)
  796. IPT2.NUM(2,J)=IPT1.NUM(16,I)
  797. IPT2.NUM(3,J)=IPT1.NUM(18,I)
  798. IPT2.NUM(4,J)=IPT1.NUM(20,I)
  799. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  800. J=J+1
  801. IPT2.NUM(1,J)=IPT1.NUM(9,I)
  802. IPT2.NUM(2,J)=IPT1.NUM(13,I)
  803. IPT2.NUM(3,J)=IPT1.NUM(14,I)
  804. IPT2.NUM(4,J)=IPT1.NUM(20,I)
  805. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  806. J=J+1
  807. IPT2.NUM(1,J)=IPT1.NUM(9,I)
  808. IPT2.NUM(2,J)=IPT1.NUM(10,I)
  809. IPT2.NUM(3,J)=IPT1.NUM(14,I)
  810. IPT2.NUM(4,J)=IPT1.NUM(16,I)
  811. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  812. J=J+1
  813. IPT2.NUM(1,J)=IPT1.NUM(9,I)
  814. IPT2.NUM(2,J)=IPT1.NUM(14,I)
  815. IPT2.NUM(3,J)=IPT1.NUM(16,I)
  816. IPT2.NUM(4,J)=IPT1.NUM(20,I)
  817. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  818. 163 CONTINUE
  819. GOTO 100
  820. 170 CONTINUE
  821. C ON CHANGE DES PY13 EN 13 TET4
  822. IF(IPT1.ITYPEL.NE.26.OR.ITY.NE.23) GO TO 180
  823. C
  824. NBELEM=13*IPT1.NUM(/2)
  825. NBNN=4
  826. NBSOUS=0
  827. NBREF=IPT1.LISREF(/1)
  828. SEGINI IPT2
  829. IPT2.ITYPEL=23
  830. * on oublie les cotes ou contours ou faces
  831. NBREF=0
  832. DO 173 I=1,IPT1.NUM(/2)
  833. J=13*I-12
  834. IPT2.NUM(1,J)=IPT1.NUM(1,I)
  835. IPT2.NUM(2,J)=IPT1.NUM(2,I)
  836. IPT2.NUM(3,J)=IPT1.NUM(8,I)
  837. IPT2.NUM(4,J)=IPT1.NUM(9,I)
  838. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  839. J=J+1
  840. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  841. IPT2.NUM(2,J)=IPT1.NUM(3,I)
  842. IPT2.NUM(3,J)=IPT1.NUM(4,I)
  843. IPT2.NUM(4,J)=IPT1.NUM(10,I)
  844. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  845. J=J+1
  846. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  847. IPT2.NUM(2,J)=IPT1.NUM(4,I)
  848. IPT2.NUM(3,J)=IPT1.NUM(8,I)
  849. IPT2.NUM(4,J)=IPT1.NUM(10,I)
  850. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  851. J=J+1
  852. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  853. IPT2.NUM(2,J)=IPT1.NUM(8,I)
  854. IPT2.NUM(3,J)=IPT1.NUM(9,I)
  855. IPT2.NUM(4,J)=IPT1.NUM(10,I)
  856. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  857. J=J+1
  858. IPT2.NUM(1,J)=IPT1.NUM(6,I)
  859. IPT2.NUM(2,J)=IPT1.NUM(7,I)
  860. IPT2.NUM(3,J)=IPT1.NUM(8,I)
  861. IPT2.NUM(4,J)=IPT1.NUM(12,I)
  862. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  863. J=J+1
  864. IPT2.NUM(1,J)=IPT1.NUM(4,I)
  865. IPT2.NUM(2,J)=IPT1.NUM(5,I)
  866. IPT2.NUM(3,J)=IPT1.NUM(6,I)
  867. IPT2.NUM(4,J)=IPT1.NUM(11,I)
  868. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  869. J=J+1
  870. IPT2.NUM(1,J)=IPT1.NUM(4,I)
  871. IPT2.NUM(2,J)=IPT1.NUM(6,I)
  872. IPT2.NUM(3,J)=IPT1.NUM(8,I)
  873. IPT2.NUM(4,J)=IPT1.NUM(12,I)
  874. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  875. J=J+1
  876. IPT2.NUM(1,J)=IPT1.NUM(4,I)
  877. IPT2.NUM(2,J)=IPT1.NUM(6,I)
  878. IPT2.NUM(3,J)=IPT1.NUM(11,I)
  879. IPT2.NUM(4,J)=IPT1.NUM(12,I)
  880. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  881. J=J+1
  882. IPT2.NUM(1,J)=IPT1.NUM(4,I)
  883. IPT2.NUM(2,J)=IPT1.NUM(10,I)
  884. IPT2.NUM(3,J)=IPT1.NUM(11,I)
  885. IPT2.NUM(4,J)=IPT1.NUM(12,I)
  886. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  887. J=J+1
  888. IPT2.NUM(1,J)=IPT1.NUM(4,I)
  889. IPT2.NUM(2,J)=IPT1.NUM(8,I)
  890. IPT2.NUM(3,J)=IPT1.NUM(10,I)
  891. IPT2.NUM(4,J)=IPT1.NUM(12,I)
  892. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  893. J=J+1
  894. IPT2.NUM(1,J)=IPT1.NUM(8,I)
  895. IPT2.NUM(2,J)=IPT1.NUM(9,I)
  896. IPT2.NUM(3,J)=IPT1.NUM(10,I)
  897. IPT2.NUM(4,J)=IPT1.NUM(12,I)
  898. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  899. J=J+1
  900. IPT2.NUM(1,J)=IPT1.NUM(9,I)
  901. IPT2.NUM(2,J)=IPT1.NUM(10,I)
  902. IPT2.NUM(3,J)=IPT1.NUM(12,I)
  903. IPT2.NUM(4,J)=IPT1.NUM(13,I)
  904. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  905. J=J+1
  906. IPT2.NUM(1,J)=IPT1.NUM(10,I)
  907. IPT2.NUM(2,J)=IPT1.NUM(11,I)
  908. IPT2.NUM(3,J)=IPT1.NUM(12,I)
  909. IPT2.NUM(4,J)=IPT1.NUM(13,I)
  910. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  911. 173 CONTINUE
  912. GOTO 100
  913. 180 CONTINUE
  914. C ON CHANGE DES PR15 EN 14 TET4
  915. C PP IF(IPT1.ITYPEL.NE.17.OR.ITY.NE.23) GO TO 770
  916. IF(IPT1.ITYPEL.NE.17.OR.ITY.NE.23) GO TO 200
  917. C
  918. NBELEM=14*IPT1.NUM(/2)
  919. NBNN=4
  920. NBSOUS=0
  921. * on oublie les cotes ou contours ou faces
  922. NBREF=0
  923. SEGINI IPT2
  924. IPT2.ITYPEL=23
  925. DO 183 I=1,IPT1.NUM(/2)
  926. J=14*I-13
  927. IPT2.NUM(1,J)=IPT1.NUM(1,I)
  928. IPT2.NUM(2,J)=IPT1.NUM(2,I)
  929. IPT2.NUM(3,J)=IPT1.NUM(6,I)
  930. IPT2.NUM(4,J)=IPT1.NUM(7,I)
  931. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  932. J=J+1
  933. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  934. IPT2.NUM(2,J)=IPT1.NUM(3,I)
  935. IPT2.NUM(3,J)=IPT1.NUM(4,I)
  936. IPT2.NUM(4,J)=IPT1.NUM(8,I)
  937. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  938. J=J+1
  939. IPT2.NUM(1,J)=IPT1.NUM(4,I)
  940. IPT2.NUM(2,J)=IPT1.NUM(5,I)
  941. IPT2.NUM(3,J)=IPT1.NUM(6,I)
  942. IPT2.NUM(4,J)=IPT1.NUM(9,I)
  943. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  944. J=J+1
  945. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  946. IPT2.NUM(2,J)=IPT1.NUM(4,I)
  947. IPT2.NUM(3,J)=IPT1.NUM(6,I)
  948. IPT2.NUM(4,J)=IPT1.NUM(9,I)
  949. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  950. J=J+1
  951. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  952. IPT2.NUM(2,J)=IPT1.NUM(4,I)
  953. IPT2.NUM(3,J)=IPT1.NUM(8,I)
  954. IPT2.NUM(4,J)=IPT1.NUM(9,I)
  955. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  956. J=J+1
  957. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  958. IPT2.NUM(2,J)=IPT1.NUM(6,I)
  959. IPT2.NUM(3,J)=IPT1.NUM(7,I)
  960. IPT2.NUM(4,J)=IPT1.NUM(9,I)
  961. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  962. J=J+1
  963. IPT2.NUM(1,J)=IPT1.NUM(2,I)
  964. IPT2.NUM(2,J)=IPT1.NUM(7,I)
  965. IPT2.NUM(3,J)=IPT1.NUM(8,I)
  966. IPT2.NUM(4,J)=IPT1.NUM(9,I)
  967. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  968. J=J+1
  969. IPT2.NUM(1,J)=IPT1.NUM(7,I)
  970. IPT2.NUM(2,J)=IPT1.NUM(8,I)
  971. IPT2.NUM(3,J)=IPT1.NUM(9,I)
  972. IPT2.NUM(4,J)=IPT1.NUM(11,I)
  973. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  974. J=J+1
  975. IPT2.NUM(1,J)=IPT1.NUM(7,I)
  976. IPT2.NUM(2,J)=IPT1.NUM(10,I)
  977. IPT2.NUM(3,J)=IPT1.NUM(11,I)
  978. IPT2.NUM(4,J)=IPT1.NUM(15,I)
  979. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  980. J=J+1
  981. IPT2.NUM(1,J)=IPT1.NUM(9,I)
  982. IPT2.NUM(2,J)=IPT1.NUM(13,I)
  983. IPT2.NUM(3,J)=IPT1.NUM(14,I)
  984. IPT2.NUM(4,J)=IPT1.NUM(15,I)
  985. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  986. J=J+1
  987. IPT2.NUM(1,J)=IPT1.NUM(9,I)
  988. IPT2.NUM(2,J)=IPT1.NUM(11,I)
  989. IPT2.NUM(3,J)=IPT1.NUM(13,I)
  990. IPT2.NUM(4,J)=IPT1.NUM(15,I)
  991. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  992. J=J+1
  993. IPT2.NUM(1,J)=IPT1.NUM(7,I)
  994. IPT2.NUM(2,J)=IPT1.NUM(9,I)
  995. IPT2.NUM(3,J)=IPT1.NUM(11,I)
  996. IPT2.NUM(4,J)=IPT1.NUM(15,I)
  997. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  998. J=J+1
  999. IPT2.NUM(1,J)=IPT1.NUM(8,I)
  1000. IPT2.NUM(2,J)=IPT1.NUM(9,I)
  1001. IPT2.NUM(3,J)=IPT1.NUM(11,I)
  1002. IPT2.NUM(4,J)=IPT1.NUM(13,I)
  1003. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  1004. J=J+1
  1005. IPT2.NUM(1,J)=IPT1.NUM(8,I)
  1006. IPT2.NUM(2,J)=IPT1.NUM(11,I)
  1007. IPT2.NUM(3,J)=IPT1.NUM(12,I)
  1008. IPT2.NUM(4,J)=IPT1.NUM(13,I)
  1009. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  1010. 183 CONTINUE
  1011. GOTO 100
  1012. C+PP
  1013. 200 CONTINUE
  1014. IF(IPT1.ITYPEL.NE.10.OR.KSURF(ITY).NE.11) GO TO 210
  1015. C
  1016. C ON CHANGE DES Q8 EN Q9
  1017. C
  1018. C ON CHERCHE LES DIMENSIONS DU MAILLAGE
  1019. NBELEM=IPT1.NUM(/2)
  1020. NBNN=9
  1021. NBSOUS=0
  1022. NBREF=IPT1.LISREF(/1)
  1023. C ON CREE LE MAILLAGE
  1024. SEGINI IPT2
  1025. C ON REMPLIT LE TYPE ET LES REFERENCES
  1026. IPT2.ITYPEL=11
  1027. IF (NBREF.NE.0) THEN
  1028. DO 201 I=1,NBREF
  1029. IPT2.LISREF(I)=IPT1.LISREF(I)
  1030. 201 CONTINUE
  1031. ENDIF
  1032. C ON ALLONGE LE TABLEAU DES COORDONNEES
  1033. SEGACT MCOORD*mod
  1034. NBPTT=nbpts
  1035. NBPTS=NBPTT+NBELEM
  1036. SEGADJ MCOORD
  1037. C ON BOUCLE SUR LES ELEMENTS
  1038. DO 209 I=1,IPT1.NUM(/2)
  1039. C ON CHERCHE LES COORDONNEES DU NOUVEAU POINT
  1040. CALL ZERO(Q89,4,1)
  1041. DO 203 J=1,8
  1042. IREFJ=(IPT1.NUM(J,I)-1)*(IDIM+1)
  1043. DO 202 K=1,IDIM+1
  1044. Q89(K)=Q89(K)+XCOOR(IREFJ+K)
  1045. 202 CONTINUE
  1046. 203 CONTINUE
  1047. C ON STOCKE LE NOUVEAU POINT
  1048. DO 204 K=1,IDIM+1
  1049. XCOOR(NBPTT*(IDIM+1)+K)=Q89(K)*0.125D0
  1050. 204 CONTINUE
  1051. NBPTT=NBPTT+1
  1052. C ON REMPLIE LE NOUVEL ELEMENT
  1053. DO 205 J=1,8
  1054. IPT2.NUM(J,I)=IPT1.NUM(J,I)
  1055. 205 CONTINUE
  1056. IPT2.NUM(9,I)=NBPTT
  1057. C ON DUPLIQUE LA COULEUR
  1058. IPT2.ICOLOR(I)=IPT1.ICOLOR(I)
  1059. 209 CONTINUE
  1060. C ON A FINI
  1061. GOTO 100
  1062. C
  1063. 210 CONTINUE
  1064. IF(IPT1.ITYPEL.NE.11.OR.KSURF(ITY).NE.8) GO TO 220
  1065. C
  1066. C ON CHANGE DES Q9 EN QUATRE Q4
  1067. C
  1068. C ON CHERCHE LES DIMENSIONS DU MAILLAGE
  1069. NBELEM=4*IPT1.NUM(/2)
  1070. NBNN=4
  1071. NBSOUS=0
  1072. * on oublie les cotes ou contours ou faces
  1073. NBREF=0
  1074. C ON CREE LE MAILLAGE
  1075. SEGINI IPT2
  1076. C ON REMPLIT LE TYPE ET LES REFERENCES
  1077. IPT2.ITYPEL=8
  1078. C ON BOUCLE SUR LES GROS ELEMENTS
  1079. DO 215 I=1,IPT1.NUM(/2)
  1080. C ON LES TRANSFORME EN QUATRE PETITS
  1081. J=4*(I-1)
  1082. C 1ER ELEMENT
  1083. J=J+1
  1084. IPT2.NUM(1,J)=IPT1.NUM(9,I)
  1085. IPT2.NUM(2,J)=IPT1.NUM(8,I)
  1086. IPT2.NUM(3,J)=IPT1.NUM(1,I)
  1087. IPT2.NUM(4,J)=IPT1.NUM(2,I)
  1088. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  1089. C 2EME ELEMENT
  1090. J=J+1
  1091. IPT2.NUM(1,J)=IPT1.NUM(9,I)
  1092. IPT2.NUM(2,J)=IPT1.NUM(2,I)
  1093. IPT2.NUM(3,J)=IPT1.NUM(3,I)
  1094. IPT2.NUM(4,J)=IPT1.NUM(4,I)
  1095. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  1096. C 3EME ELEMENT
  1097. J=J+1
  1098. IPT2.NUM(1,J)=IPT1.NUM(9,I)
  1099. IPT2.NUM(2,J)=IPT1.NUM(4,I)
  1100. IPT2.NUM(3,J)=IPT1.NUM(5,I)
  1101. IPT2.NUM(4,J)=IPT1.NUM(6,I)
  1102. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  1103. C 4EME ELEMENT
  1104. J=J+1
  1105. IPT2.NUM(1,J)=IPT1.NUM(9,I)
  1106. IPT2.NUM(2,J)=IPT1.NUM(6,I)
  1107. IPT2.NUM(3,J)=IPT1.NUM(7,I)
  1108. IPT2.NUM(4,J)=IPT1.NUM(8,I)
  1109. IPT2.ICOLOR(J)=IPT1.ICOLOR(I)
  1110. C
  1111. 215 CONTINUE
  1112. C ON A FINI
  1113. GOTO 100
  1114. C+PP
  1115. 220 CONTINUE
  1116. IF(IPT1.ITYPEL.NE.6.OR.KSURF(ITY).NE.7) GO TO 770
  1117. C
  1118. C ON CHANGE DES T6 EN T7
  1119. C
  1120. C ON CHERCHE LES DIMENSIONS DU MAILLAGE
  1121. NBELEM=IPT1.NUM(/2)
  1122. NBNN=7
  1123. NBSOUS=0
  1124. NBREF=IPT1.LISREF(/1)
  1125. C ON CREE LE MAILLAGE
  1126. SEGINI IPT2
  1127. C ON REMPLIT LE TYPE ET LES REFERENCES
  1128. IPT2.ITYPEL=7
  1129. IF (NBREF.NE.0) THEN
  1130. DO 221 I=1,NBREF
  1131. IPT2.LISREF(I)=IPT1.LISREF(I)
  1132. 221 CONTINUE
  1133. ENDIF
  1134. C ON ALLONGE LE TABLEAU DES COORDONNEES
  1135. SEGACT MCOORD*mod
  1136. NBPTT=nbpts
  1137. NBPTS=NBPTT+NBELEM
  1138. SEGADJ MCOORD
  1139. C ON BOUCLE SUR LES ELEMENTS
  1140. DO 229 I=1,IPT1.NUM(/2)
  1141. C ON CHERCHE LES COORDONNEES DU NOUVEAU POINT
  1142. CALL ZERO(Q89,3,1)
  1143. DO 223 J=1,6
  1144. IREFJ=(IPT1.NUM(J,I)-1)*(IDIM+1)
  1145. DO 222 K=1,IDIM+1
  1146. Q89(K)=Q89(K)+XCOOR(IREFJ+K)
  1147. 222 CONTINUE
  1148. 223 CONTINUE
  1149. C ON STOCKE LE NOUVEAU POINT
  1150. DO 224 K=1,IDIM+1
  1151. XCOOR(NBPTT*(IDIM+1)+K)=Q89(K)/6.D0
  1152. 224 CONTINUE
  1153. NBPTT=NBPTT+1
  1154. C ON REMPLIE LE NOUVEL ELEMENT
  1155. DO 225 J=1,6
  1156. IPT2.NUM(J,I)=IPT1.NUM(J,I)
  1157. 225 CONTINUE
  1158. IPT2.NUM(7,I)=NBPTT
  1159. C ON DUPLIQUE LA COULEUR
  1160. IPT2.ICOLOR(I)=IPT1.ICOLOR(I)
  1161. 229 CONTINUE
  1162. C ON A FINI
  1163. GOTO 100
  1164. *
  1165. 770 CALL ERREUR(29)
  1166. RETURN
  1167. 61 SEGSUP KON
  1168. NKMAX=NKMAX+1
  1169. IF (IIMPI.NE.0) WRITE (IOIMP,1000) NKMAX
  1170. 1000 FORMAT(/,' NOUVELLE VALEUR DE NKMAX TENTEE DANS CHANGE ',I4)
  1171. GOTO 26
  1172. 100 CONTINUE
  1173. IF (ITY.NE.1.AND.ISOU.LE.IPT5.LISOUS(/1)) THEN
  1174. IF (ISOU.EQ.1) THEN
  1175. SEGINI,IPT6=IPT2
  1176. ELSE
  1177. NBSOUS=0
  1178. NBREF=0
  1179. NBNN=IPT6.NUM(/1)
  1180. NEL6=IPT6.NUM(/2)
  1181. NEL2=IPT2.NUM(/2)
  1182. NBELEM=NEL6+NEL2
  1183. SEGADJ,IPT6
  1184. DO K=1,NEL2
  1185. DO L=1,NBNN
  1186. IPT6.NUM(L,NEL6+K)=IPT2.NUM(L,K)
  1187. ENDDO
  1188. ENDDO
  1189. C SEGDES,IPT2
  1190. ENDIF
  1191. ISOU=ISOU+1
  1192. IF (ISOU.LE.IPT5.LISOUS(/1)) GOTO 5
  1193. IPT2=IPT6
  1194. ENDIF
  1195. * ON LAISSE IPT2 ACTIF CAR BEAUCOUP DE GENS L'UTILISE AINSI
  1196. IPT1=IPT2
  1197. if (ieta.eq.1) then
  1198. segact mcoord
  1199. else
  1200. segdes mcoord
  1201. endif
  1202. END
  1203.  
  1204.  
  1205.  
  1206.  
  1207.  
  1208.  

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