Télécharger change.eso

Retour à la liste

Numérotation des lignes :

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

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