Télécharger change.eso

Retour à la liste

Numérotation des lignes :

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

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