Télécharger change.eso

Retour à la liste

Numérotation des lignes :

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

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