Télécharger chang2.eso

Retour à la liste

Numérotation des lignes :

  1. C CHANG2 SOURCE BP208322 16/11/18 21:15:29 9177
  2. SUBROUTINE CHANG2(IPT1,ITY)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : CHANG2
  7. C DESCRIPTION : Change un maillage (éventuellement composite)
  8. C de QUAF en 'TRI3','TET4','QUA4','CUB8','PYR5'
  9. C
  10. C
  11. C LANGAGE : ESOPE
  12. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  13. C mél : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELES :
  16. C APPELES (E/S) :
  17. C APPELES (BLAS) :
  18. C APPELES (CALCUL) :
  19. C APPELE PAR :
  20. C***********************************************************************
  21. C SYNTAXE GIBIANE :
  22. C ENTREES :
  23. C ENTREES/SORTIES :
  24. C SORTIES :
  25. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  26. C***********************************************************************
  27. C VERSION : v1, 04/01/2007, version initiale
  28. C HISTORIQUE : v1, 04/01/2007, création
  29. C HISTORIQUE :
  30. C HISTORIQUE :
  31. C***********************************************************************
  32. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  33. C en cas de modification de ce sous-programme afin de faciliter
  34. C la maintenance !
  35. C***********************************************************************
  36. -INC CCOPTIO
  37. -INC CCGEOME
  38. -INC SMELEME
  39. *
  40. LOGICAL LCOMP,ltelq
  41. PARAMETER(NTYP2=5)
  42. CHARACTER*4 LTYP2(NTYP2),LTYPD2(NTYP2),LTYPD3(NTYP2),MTYP,MTYP2
  43. INTEGER S3S2(2,2),T7T3(3,4),T7Q4(4,3),Q9T3(3,8),Q9Q4(4,4)
  44. INTEGER T15T4(4,4),T15O6(6),O6T4(4,4),T15C8(8,4),T15T7(7,4)
  45. INTEGER P19H6(6,4),P19O6(6),H6T4(4,3),P19T7(7,4),P19Q9(9)
  46. INTEGER P21P6A(6,4),P21P6B(6,4),P6AT4(4,3),P6BT4(4,3)
  47. INTEGER P21C8(8,6),P21T7(7,2),P21Q9(9,3)
  48. INTEGER C27C8(8,8),C8T4(4,5),C27Q9(9,6)
  49. *
  50. DATA LTYP2 /'TRI3','TET4','QUA4','CUB8','PYR5'/
  51. DATA LTYPD2/'TRI3','TRI3','QUA4','QUA4','QUA4'/
  52. DATA LTYPD3/'TET4','TET4','CUB8','CUB8','PYR5'/
  53. * SEG3 -> 2 SEG2
  54. DATA S3S2/1,2 , 2,3/
  55. * TRI7 -> 4 TRI3
  56. DATA T7T3/1,2,6 , 2,3,4 , 6,4,5 , 2,4,6/
  57. * TRI7 -> 3 QUA4
  58. DATA T7Q4/1,2,7,6 , 2,3,4,7 , 7,4,5,6/
  59. * QUA9 -> 8 TRI3
  60. DATA Q9T3/1,2,9 , 2,3,9 , 3,4,9 , 4,5,9 ,
  61. $ 5,6,9 , 6,7,9 , 7,8,9 , 8,1,9/
  62. * QUA9 -> 4 QUA4
  63. DATA Q9Q4/1,2,9,8 , 2,3,4,9 , 9,4,5,6 , 8,9,6,7/
  64. * TE15 -> 4 TET4 + 1 OCT6
  65. DATA T15T4/1,2,6,7 , 2,3,4,8 , 4,5,6,9 , 7,8,9,10/
  66. DATA T15O6/7,2,4,9,8,6/
  67. * OCT6 -> 4 TET4
  68. DATA O6T4/1,2,6,5 , 2,3,6,5 , 3,4,6,5 , 4,1,6,5/
  69. * TE15 -> 4 CUB8
  70. DATA T15C8/1,2,11,6,7,12,15,14 , 2,3,4,11,12,8,13,15 ,
  71. $ 4,5,6,11,13,9,14,15 , 8,13,15,12,10,9,14,7/
  72. * TE15 -> 4 TRI7 (Les faces)
  73. DATA T15T7/1,7,10,8,3,2,12 , 3,8,10,9,5,4,13 ,
  74. $ 5,9,10,7,1,6,14 , 1,2,3,4,5,6,11/
  75. * PY19 -> 4 HEX6 + 1 OCT6
  76. DATA P19H6/1,2,3,14,9,10 , 3,4,5,14,10,11 ,
  77. $ 5,6,7,14,11,12 , 7,8,1,14,12,9/
  78. DATA P19O6/9,10,11,12,13,14/
  79. * HEX6 -> 3 TET4
  80. DATA H6T4/1,2,4,5 , 5,2,4,6 , 2,3,4,6/
  81. * PY19 -> 4 TRI7 (Les faces triangulaires)
  82. DATA P19T7/1,9,13,10,3,2,15 , 3,10,13,11,5,4,16 ,
  83. $ 5,11,13,12,7,6,17 , 7,12,13,9,1,8,18/
  84. * PY19 -> QUA9 (La face carrée)
  85. DATA P19Q9/1,2,3,4,5,6,7,8,14/
  86. * PR21 -> 4 PRI6 de type A
  87. DATA P21P6A/7,16,18,10,11,15 , 9,18,17,14,15,13 ,
  88. $ 7,18,16,1,6,2 , 9,17,18,5,4,6/
  89. * PR21 -> 4 PRI6 de type B
  90. DATA P21P6B/ 8,17,16,12,13,11 , 16,17,18,11,13,15 ,
  91. $ 8,16,17,3,2,4 , 2,4,6,16,17,18/
  92. Cbuggé $ 8,16,17,3,2,4 , 16,18,17,2,6,4/
  93. * PRI6 de type A -> 3 TET4
  94. DATA P6AT4/1,2,3,4 , 5,3,4,6 , 5,2,4,3/
  95. * PRI6 de type B -> 3 TET4
  96. DATA P6BT4/1,2,3,4 , 3,6,4,2 , 5,2,4,6/
  97. * PR21 -> 6 CUB8
  98. DATA P21C8/7,16,21,18,10,11,20,15 , 16,8,17,21,11,12,13,20 ,
  99. $ 21,17,9,18,20,13,14,15 , 1,2,19,6,7,16,21,18 ,
  100. $ 2,3,4,19,16,8,17,21 , 19,4,5,6,21,17,9,18/
  101. * PR21 -> 2 TRI7 (Les faces triangulaires)
  102. DATA P21T7/1,2,3,4,5,6,19 , 10,15,14,13,12,11,20/
  103. * PR21 -> 3 QUA9 (Les faces carrées)
  104. DATA P21Q9/10,11,12,8,3,2,1,7,16 , 12,13,14,9,5,4,3,8,17 ,
  105. $ 14,15,10,7,1,6,5,9,18/
  106. * CU27 -> 8 CUB8
  107. DATA C27C8/1,2,25,8,9,21,27,24 , 3,4,25,2,10,22,27,21 ,
  108. $ 5,6,25,4,11,23,27,22 , 7,8,25,6,12,24,27,23 ,
  109. $ 13,20,26,14,9,24,27,21 , 15,14,26,16,10,21,27,22 ,
  110. $ 17,16,26,18,11,22,27,23 , 19,18,26,20,12,23,27,24/
  111. * CUB8 -> 5 TET4
  112. DATA C8T4/1,2,3,6 , 3,4,1,8 , 1,6,8,5 , 6,3,8,7 , 8,6,1,3/
  113. * CU27 -> 6 QUA9 (Les faces carrées)
  114. DATA C27Q9/1,9,13,14,15,10,3,2,21 , 3,10,15,16,17,11,5,4,22 ,
  115. $ 5,11,17,18,19,12,7,6,23 , 7,12,19,20,13,9,1,8,24 ,
  116. $ 1,2,3,4,5,6,7,8,25 , 13,20,19,18,17,16,15,14,26/
  117. *
  118. * Executable statements
  119. *
  120. IMPR=0
  121. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans chang2.eso'
  122. * Numéro de l'élément à créer dans la numérotation de LTYP2
  123. CALL FIMOT2(NOMS(ITY),LTYP2,NTYP2,JTY,IMPR,IRET)
  124. IF (IRET.NE.0) GOTO 9999
  125. SEGACT IPT1
  126. NBSOUS=IPT1.LISOUS(/1)
  127. LCOMP=(NBSOUS.GE.1)
  128. IPT3=0
  129. *
  130. IF (NBSOUS.EQ.0) NBSOUS=1
  131. DO ISOUS=1,NBSOUS
  132. IF (LCOMP) THEN
  133. IPT2=IPT1.LISOUS(ISOUS)
  134. SEGACT IPT2
  135. ELSE
  136. IPT2=IPT1
  137. ENDIF
  138. ITYP=IPT2.ITYPEL
  139. MTYP=NOMS(ITYP)
  140. NBL=IPT2.NUM(/2)
  141. * NBN=IPT2.NUM(/1)
  142. IF (MTYP.EQ.'SEG3') THEN
  143. * Passage SEG3 -> 2 SEG2
  144. NBNN=2
  145. NBELEM=NBL*2
  146. NBSOUS=0
  147. NBREF=0
  148. SEGINI IPT4
  149. IPT4.ITYPEL=2
  150. IEL4=0
  151. DO IBL=1,NBL
  152. DO IL=1,2
  153. IEL4=IEL4+1
  154. DO IN=1,2
  155. IPT4.NUM(IN,IEL4)=IPT2.NUM(S3S2(IN,IL),IBL)
  156. ENDDO
  157. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  158. ENDDO
  159. ENDDO
  160. SEGDES IPT4
  161. ELSEIF (MTYP.EQ.'TRI7') THEN
  162. MTYP2=LTYPD2(JTY)
  163. IF (MTYP2.EQ.'TRI3') THEN
  164. * Passage TRI7 -> 4 TRI3
  165. NBNN=3
  166. NBELEM=NBL*4
  167. NBSOUS=0
  168. NBREF=0
  169. SEGINI IPT4
  170. IPT4.ITYPEL=4
  171. IEL4=0
  172. DO IBL=1,NBL
  173. DO IL=1,4
  174. IEL4=IEL4+1
  175. DO IN=1,3
  176. IPT4.NUM(IN,IEL4)=IPT2.NUM(T7T3(IN,IL),IBL)
  177. ENDDO
  178. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  179. ENDDO
  180. ENDDO
  181. SEGDES IPT4
  182. ELSEIF (MTYP2.EQ.'QUA4') THEN
  183. * Passage TRI7 -> 3 QUA4
  184. NBNN=4
  185. NBELEM=NBL*3
  186. NBSOUS=0
  187. NBREF=0
  188. SEGINI IPT4
  189. IPT4.ITYPEL=8
  190. IEL4=0
  191. DO IBL=1,NBL
  192. DO IL=1,3
  193. IEL4=IEL4+1
  194. DO IN=1,4
  195. IPT4.NUM(IN,IEL4)=IPT2.NUM(T7Q4(IN,IL),IBL)
  196. ENDDO
  197. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  198. ENDDO
  199. ENDDO
  200. SEGDES IPT4
  201. ELSE
  202. GOTO 9998
  203. ENDIF
  204. ELSEIF (MTYP.EQ.'QUA9') THEN
  205. MTYP2=LTYPD2(JTY)
  206. IF (MTYP2.EQ.'TRI3') THEN
  207. * Passage QUA9 -> 8 TRI3
  208. NBNN=3
  209. NBELEM=NBL*8
  210. NBSOUS=0
  211. NBREF=0
  212. SEGINI IPT4
  213. IPT4.ITYPEL=4
  214. IEL4=0
  215. DO IBL=1,NBL
  216. DO IL=1,8
  217. IEL4=IEL4+1
  218. DO IN=1,3
  219. IPT4.NUM(IN,IEL4)=IPT2.NUM(Q9T3(IN,IL),IBL)
  220. ENDDO
  221. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  222. ENDDO
  223. ENDDO
  224. SEGDES IPT4
  225. ELSEIF (MTYP2.EQ.'QUA4') THEN
  226. * Passage QUA9 -> 4 QUA4
  227. NBNN=4
  228. NBELEM=NBL*4
  229. NBSOUS=0
  230. NBREF=0
  231. SEGINI IPT4
  232. IPT4.ITYPEL=8
  233. IEL4=0
  234. DO IBL=1,NBL
  235. DO IL=1,4
  236. IEL4=IEL4+1
  237. DO IN=1,4
  238. IPT4.NUM(IN,IEL4)=IPT2.NUM(Q9Q4(IN,IL),IBL)
  239. ENDDO
  240. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  241. ENDDO
  242. ENDDO
  243. SEGDES IPT4
  244. ELSE
  245. GOTO 9998
  246. ENDIF
  247. ELSEIF (MTYP.EQ.'TE15') THEN
  248. MTYP2=LTYPD3(JTY)
  249. IF (MTYP2.EQ.'TET4') THEN
  250. * Passage TE15 -> 8 TET4
  251. NBNN=4
  252. NBELEM=NBL*8
  253. NBSOUS=0
  254. NBREF=0
  255. SEGINI IPT4
  256. CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  257. IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  258. CALL ERREUR(5)
  259. RETURN
  260. ENDIF
  261. IPT4.ITYPEL=ITYP2
  262. IEL4=0
  263. DO IBL=1,NBL
  264. * D'abord les 4TET4 des coins
  265. DO IL=1,4
  266. IEL4=IEL4+1
  267. DO IN=1,4
  268. IPT4.NUM(IN,IEL4)=IPT2.NUM(T15T4(IN,IL),IBL)
  269. ENDDO
  270. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  271. ENDDO
  272. * Puis l'octaèdre du milieu
  273. DO IL=1,4
  274. IEL4=IEL4+1
  275. DO IN=1,4
  276. IPT4.NUM(IN,IEL4)=
  277. $ IPT2.NUM(T15O6(O6T4(IN,IL)),IBL)
  278. ENDDO
  279. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  280. ENDDO
  281. ENDDO
  282. SEGDES IPT4
  283. ELSEIF (MTYP2.EQ.'CUB8') THEN
  284. * Passage TE15 -> 4 CUB8
  285. NBNN=8
  286. NBELEM=NBL*4
  287. NBSOUS=0
  288. NBREF=0
  289. SEGINI IPT4
  290. CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  291. IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  292. CALL ERREUR(5)
  293. RETURN
  294. ENDIF
  295. IPT4.ITYPEL=ITYP2
  296. IEL4=0
  297. DO IBL=1,NBL
  298. DO IL=1,4
  299. IEL4=IEL4+1
  300. DO IN=1,8
  301. IPT4.NUM(IN,IEL4)=IPT2.NUM(T15C8(IN,IL),IBL)
  302. ENDDO
  303. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  304. ENDDO
  305. ENDDO
  306. SEGDES IPT4
  307. ELSEIF (MTYP2.EQ.'PYR5') THEN
  308. * Passage TE15 -> 12 PYR5
  309. NBNN=5
  310. NBELEM=NBL*12
  311. NBSOUS=0
  312. NBREF=0
  313. SEGINI IPT4
  314. CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  315. IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  316. CALL ERREUR(5)
  317. RETURN
  318. ENDIF
  319. IPT4.ITYPEL=ITYP2
  320. IEL4=0
  321. DO IBL=1,NBL
  322. DO IL=1,4
  323. DO IL2=1,3
  324. IEL4=IEL4+1
  325. DO IN=1,4
  326. IPT4.NUM(IN,IEL4)=
  327. $ IPT2.NUM(T15T7(T7Q4(IN,IL2),IL),IBL)
  328. ENDDO
  329. IPT4.NUM(5,IEL4)=IPT2.NUM(15,IBL)
  330. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  331. ENDDO
  332. ENDDO
  333. ENDDO
  334. SEGDES IPT4
  335. ELSE
  336. GOTO 9998
  337. ENDIF
  338. ELSEIF (MTYP.EQ.'PY19') THEN
  339. MTYP2=LTYPD3(JTY)
  340. IF (MTYP2.EQ.'TET4') THEN
  341. * Passage PY19 -> 16 TET4
  342. NBNN=4
  343. NBELEM=NBL*16
  344. NBSOUS=0
  345. NBREF=0
  346. SEGINI IPT4
  347. CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  348. IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  349. CALL ERREUR(5)
  350. RETURN
  351. ENDIF
  352. IPT4.ITYPEL=ITYP2
  353. IEL4=0
  354. DO IBL=1,NBL
  355. * D'abord les 4 HEX6 des coins
  356. DO IL=1,4
  357. DO IL2=1,3
  358. IEL4=IEL4+1
  359. DO IN=1,4
  360. IPT4.NUM(IN,IEL4)=
  361. $ IPT2.NUM(P19H6(H6T4(IN,IL2),IL),IBL)
  362. ENDDO
  363. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  364. ENDDO
  365. ENDDO
  366. * Puis l'octaèdre du milieu
  367. DO IL=1,4
  368. IEL4=IEL4+1
  369. DO IN=1,4
  370. IPT4.NUM(IN,IEL4)=
  371. $ IPT2.NUM(P19O6(O6T4(IN,IL)),IBL)
  372. ENDDO
  373. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  374. ENDDO
  375. ENDDO
  376. SEGDES IPT4
  377. ELSEIF (MTYP2.EQ.'PYR5') THEN
  378. * Passage PY19 -> 16 PYR5
  379. NBNN=5
  380. NBELEM=NBL*16
  381. NBSOUS=0
  382. NBREF=0
  383. SEGINI IPT4
  384. CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  385. IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  386. CALL ERREUR(5)
  387. RETURN
  388. ENDIF
  389. IPT4.ITYPEL=ITYP2
  390. IEL4=0
  391. DO IBL=1,NBL
  392. * Les faces triangulaires
  393. DO IL=1,4
  394. DO IL2=1,3
  395. IEL4=IEL4+1
  396. DO IN=1,4
  397. IPT4.NUM(IN,IEL4)=
  398. $ IPT2.NUM(P19T7(T7Q4(IN,IL2),IL),IBL)
  399. ENDDO
  400. IPT4.NUM(5,IEL4)=IPT2.NUM(19,IBL)
  401. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  402. ENDDO
  403. ENDDO
  404. * La face carrée
  405. DO IL=1,4
  406. IEL4=IEL4+1
  407. DO IN=1,4
  408. IPT4.NUM(IN,IEL4)=
  409. $ IPT2.NUM(P19Q9(Q9Q4(IN,IL)),IBL)
  410. ENDDO
  411. IPT4.NUM(5,IEL4)=IPT2.NUM(19,IBL)
  412. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  413. ENDDO
  414. ENDDO
  415. SEGDES IPT4
  416. ELSE
  417. GOTO 9998
  418. ENDIF
  419. ELSEIF (MTYP.EQ.'PR21') THEN
  420. MTYP2=LTYPD3(JTY)
  421. IF (MTYP2.EQ.'TET4') THEN
  422. * Passage PR21 -> 24 TET4
  423. NBNN=4
  424. NBELEM=NBL*24
  425. NBSOUS=0
  426. NBREF=0
  427. SEGINI IPT4
  428. CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  429. IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  430. CALL ERREUR(5)
  431. RETURN
  432. ENDIF
  433. IPT4.ITYPEL=ITYP2
  434. IEL4=0
  435. DO IBL=1,NBL
  436. * D'abord les 4 PRI6 de type A
  437. DO IL=1,4
  438. DO IL2=1,3
  439. IEL4=IEL4+1
  440. DO IN=1,4
  441. IPT4.NUM(IN,IEL4)=
  442. $ IPT2.NUM(P21P6A(P6AT4(IN,IL2),IL),IBL)
  443. ENDDO
  444. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  445. ENDDO
  446. ENDDO
  447. * Puis les 4 PRI6 de type B
  448. DO IL=1,4
  449. DO IL2=1,3
  450. IEL4=IEL4+1
  451. DO IN=1,4
  452. IPT4.NUM(IN,IEL4)=
  453. $ IPT2.NUM(P21P6B(P6BT4(IN,IL2),IL),IBL)
  454. ENDDO
  455. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  456. ENDDO
  457. ENDDO
  458. ENDDO
  459. SEGDES IPT4
  460. ELSEIF (MTYP2.EQ.'CUB8') THEN
  461. * Passage PR21 -> 6 CUB8
  462. NBNN=8
  463. NBELEM=NBL*6
  464. NBSOUS=0
  465. NBREF=0
  466. SEGINI IPT4
  467. CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  468. IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  469. CALL ERREUR(5)
  470. RETURN
  471. ENDIF
  472. IPT4.ITYPEL=ITYP2
  473. IEL4=0
  474. DO IBL=1,NBL
  475. DO IL=1,6
  476. IEL4=IEL4+1
  477. DO IN=1,8
  478. IPT4.NUM(IN,IEL4)=IPT2.NUM(P21C8(IN,IL),IBL)
  479. ENDDO
  480. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  481. ENDDO
  482. ENDDO
  483. SEGDES IPT4
  484. ELSEIF (MTYP2.EQ.'PYR5') THEN
  485. * Passage PR21 -> 18 PYR5
  486. NBNN=5
  487. NBELEM=NBL*18
  488. NBSOUS=0
  489. NBREF=0
  490. SEGINI IPT4
  491. CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  492. IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  493. CALL ERREUR(5)
  494. RETURN
  495. ENDIF
  496. IPT4.ITYPEL=ITYP2
  497. IEL4=0
  498. DO IBL=1,NBL
  499. * Les faces triangulaires
  500. DO IL=1,2
  501. DO IL2=1,3
  502. IEL4=IEL4+1
  503. DO IN=1,4
  504. IPT4.NUM(IN,IEL4)=
  505. $ IPT2.NUM(P21T7(T7Q4(IN,IL2),IL),IBL)
  506. ENDDO
  507. IPT4.NUM(5,IEL4)=IPT2.NUM(21,IBL)
  508. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  509. ENDDO
  510. ENDDO
  511. * Les faces carrées
  512. DO IL=1,3
  513. DO IL2=1,4
  514. IEL4=IEL4+1
  515. DO IN=1,4
  516. IPT4.NUM(IN,IEL4)=
  517. $ IPT2.NUM(P21Q9(Q9Q4(IN,IL2),IL),IBL)
  518. ENDDO
  519. IPT4.NUM(5,IEL4)=IPT2.NUM(21,IBL)
  520. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  521. ENDDO
  522. ENDDO
  523. ENDDO
  524. SEGDES IPT4
  525. ELSE
  526. GOTO 9998
  527. ENDIF
  528. ELSEIF (MTYP.EQ.'CU27') THEN
  529. MTYP2=LTYPD3(JTY)
  530. IF (MTYP2.EQ.'TET4') THEN
  531. * Passage CU27 -> 40 TET4
  532. NBNN=4
  533. NBELEM=NBL*40
  534. NBSOUS=0
  535. NBREF=0
  536. SEGINI IPT4
  537. CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  538. IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  539. CALL ERREUR(5)
  540. RETURN
  541. ENDIF
  542. IPT4.ITYPEL=ITYP2
  543. IEL4=0
  544. DO IBL=1,NBL
  545. DO IL=1,8
  546. DO IL2=1,5
  547. IEL4=IEL4+1
  548. DO IN=1,4
  549. IPT4.NUM(IN,IEL4)=
  550. $ IPT2.NUM(C27C8(C8T4(IN,IL2),IL),IBL)
  551. ENDDO
  552. ENDDO
  553. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  554. ENDDO
  555. ENDDO
  556. SEGDES IPT4
  557. ELSEIF (MTYP2.EQ.'CUB8') THEN
  558. * Passage CU27 -> 8 CUB8
  559. NBNN=8
  560. NBELEM=NBL*8
  561. NBSOUS=0
  562. NBREF=0
  563. SEGINI IPT4
  564. CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  565. IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  566. CALL ERREUR(5)
  567. RETURN
  568. ENDIF
  569. IPT4.ITYPEL=ITYP2
  570. IEL4=0
  571. DO IBL=1,NBL
  572. DO IL=1,8
  573. IEL4=IEL4+1
  574. DO IN=1,8
  575. IPT4.NUM(IN,IEL4)=IPT2.NUM(C27C8(IN,IL),IBL)
  576. ENDDO
  577. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  578. ENDDO
  579. ENDDO
  580. SEGDES IPT4
  581. ELSEIF (MTYP2.EQ.'PYR5') THEN
  582. * Passage CU27 -> 24 PYR5
  583. NBNN=5
  584. NBELEM=NBL*24
  585. NBSOUS=0
  586. NBREF=0
  587. SEGINI IPT4
  588. CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  589. IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  590. CALL ERREUR(5)
  591. RETURN
  592. ENDIF
  593. IPT4.ITYPEL=ITYP2
  594. IEL4=0
  595. DO IBL=1,NBL
  596. DO IL=1,6
  597. DO IL2=1,4
  598. IEL4=IEL4+1
  599. DO IN=1,4
  600. IPT4.NUM(IN,IEL4)=
  601. $ IPT2.NUM(C27Q9(Q9Q4(IN,IL2),IL),IBL)
  602. ENDDO
  603. IPT4.NUM(5,IEL4)=IPT2.NUM(27,IBL)
  604. IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  605. ENDDO
  606. ENDDO
  607. ENDDO
  608. SEGDES IPT4
  609. ELSE
  610. GOTO 9998
  611. ENDIF
  612. ELSE
  613. GOTO 9998
  614. ENDIF
  615. *
  616. IF (LCOMP) SEGDES IPT2
  617. IF (IPT3.EQ.0) THEN
  618. IPT3=IPT4
  619. ELSE
  620. ltelq=.false.
  621. CALL FUSE(IPT3,IPT4,IPT5,ltelq)
  622. IPT3=IPT5
  623. ENDIF
  624. *
  625. ENDDO
  626. SEGDES IPT1
  627. *
  628.  
  629. IPT1=IPT3
  630. *
  631. * Normal termination
  632. *
  633. IRET=0
  634. RETURN
  635. *
  636. * Format handling
  637. *
  638. *
  639. * Error handling
  640. *
  641. * 995 2
  642. *On ne sait pas changer des éléments %m1:4 en élément %m5:8
  643. 9998 CONTINUE
  644. MOTERR(1:4)=MTYP
  645. MOTERR(5:8)=NOMS(ITY)
  646. CALL ERREUR(995)
  647. RETURN
  648. 9999 CONTINUE
  649. IRET=1
  650. WRITE(IOIMP,*) 'An error was detected in subroutine chang2'
  651. RETURN
  652. *
  653. * End of subroutine CHANG2
  654. *
  655. END
  656.  
  657.  
  658.  
  659.  
  660.  
  661.  

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