Télécharger genera.eso

Retour à la liste

Numérotation des lignes :

  1. C GENERA SOURCE BP208322 16/11/18 21:17:19 9177
  2. C OPTION GENERATRICE
  3. C
  4. SUBROUTINE GENERA
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. DIMENSION XCO(4)
  8. -INC CCOPTIO
  9. -INC CCGEOME
  10. -INC SMCOORD
  11. -INC SMELEME
  12. logical ltelq
  13. SEGMENT ICPR(2,NBELEC)
  14. SEGMENT ICPP(XCOOR(/1)/(IDIM+1))
  15. COMMON/CTOURN/XPT1,YPT1,ZPT1,XV1,YV1,ZV1,XV2,YV2,ZV2,XVEC,YVEC,
  16. # ZVEC,ANGLE,ICLE
  17.  
  18. IF (KSURF(ILCOUR).EQ.0) CALL ERREUR(16)
  19. IF (IERR.NE.0) RETURN
  20. CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  21. IF (IERR.NE.0) RETURN
  22. CALL EXTRLI(IPT1,3,IRET,-1)
  23. IF (IERR.NE.0) RETURN
  24.  
  25. IFUSE=0
  26. IF (IPT1.NE.IRET) IFUSE=IPT1
  27. IPT1=IRET
  28. CALL LIROBJ('MAILLAGE',IPT8,1,IRETOU)
  29. IF (IERR.NE.0) RETURN
  30.  
  31. SEGACT IPT8
  32. IF (IPT8.ITYPEL.NE.KDEGRE(ILCOUR)) CALL ERREUR(16)
  33. IF (IERR.NE.0) RETURN
  34.  
  35. NCOUCH=IPT8.NUM(/2)
  36. SEGACT IPT1
  37. SEGACT MCOORD
  38. NBNN =IPT1.NUM(/1)
  39. NBELEM=IPT1.NUM(/2)
  40. IBOUCL=0
  41. IF (IPT1.NUM(1,1).EQ.IPT1.NUM(NBNN,NBELEM)) IBOUCL=1
  42.  
  43. 20 CONTINUE
  44. NX=NCOUCH-1
  45. IF (IIMPI.EQ.1) WRITE (IOIMP,1000) NCOUCH
  46. 1000 FORMAT(/,' COUCHES ',I6)
  47. NBNN =4
  48. NBELEM=IPT1.NUM(/2)*NCOUCH
  49. NBSOUS=0
  50. NBREF =4
  51. SEGINI,MELEME
  52. ITYPEL=8
  53. INCR =IPT1.ITYPEL-1
  54. IL =1
  55. NBELEC=IPT1.NUM(/2)
  56. SEGINI,ICPR
  57.  
  58. C ON FAIT D'ABORD L' EXTREMITEE
  59. SEGINI,ICPP
  60. DO 52 I=1,ICPP(/1)
  61. 52 ICPP(I)=0
  62.  
  63. ICLE =1
  64. IPBAS =IPT8.NUM(1,1)
  65. IPHAU =IPT8.NUM(IPT8.NUM(/1),NCOUCH)
  66. IREFB =(IDIM+1)*(IPBAS-1)
  67. IREFH =(IDIM+1)*(IPHAU-1)
  68.  
  69. DO 200 I=1,IDIM+1
  70. XCO(I)=XCOOR(IREFH+I)-XCOOR(IREFB+I)
  71. 200 CONTINUE
  72.  
  73. CALL ADDITE(XCO,IPT1,IPT3,ICPP,0)
  74. IF (IERR.NE.0) RETURN
  75. SEGSUP ICPP
  76. SEGACT MCOORD
  77. SEGACT IPT3
  78. CALL INVERS(IPT3,IPT4)
  79. SEGDES IPT4
  80. LISREF(3)=IPT4
  81. C ON REMPLIT LE TABLEAU ICPR DES PTS EFFECTIFS
  82. IDEB=XCOOR(/1)/(IDIM+1)+1
  83. DO 70 I=1,2
  84. DO 70 J=1,NBELEC
  85. 70 ICPR(I,J)=0
  86. LCPR=0
  87. DO 71 J=1,NBELEC
  88. DO 71 I=1,2
  89. I1=IPT1.NUM((I-1)*INCR+1,J)
  90. LCPR=LCPR+1
  91. DO 72 JJ=1,J
  92. DO 72 II=1,2
  93. IF (IPT1.NUM((II-1)*INCR+1,JJ).NE.I1) GOTO 72
  94. IF (II.NE.I) GOTO 73
  95. IF (JJ.EQ.J) GOTO 71
  96. 73 ICPR(I,J)=II+(JJ-1)*2
  97. LCPR=LCPR-1
  98. IF (J.EQ.NBELEC.AND.I.EQ.2) GOTO 75
  99. GOTO 71
  100. 75 IF (IBOUCL.EQ.1) GOTO 71
  101. ICPR(I,J)=0
  102. ICPR(II,JJ)=I+(J-1)*2
  103. GOTO 71
  104. 72 CONTINUE
  105. 71 CONTINUE
  106. * IL SEMBLERAIT QUE L'ON AIT NCOUCH A FAIRE AVEC LCPR POINTS EFFECTIFS
  107. C ON NE S'OCCUPE QUE DE FABRIQUER DES RECTANGLES A 4 NOEUDS POUR
  108. C LE MOMENT D'ABORD LES POINTS DU BAS QUI NE SONT PAS A FABRIQUER
  109. DO 40 I=1,IPT1.NUM(/2)
  110. NUM(1,I)=IPT1.NUM(1,I)
  111. NUM(2,I)=IPT1.NUM(1+INCR,I)
  112. 40 CONTINUE
  113. ILASI=IDEB-1
  114. ILASJ=ILASI+(INCR*NX)+INCR-1
  115. IF (IBOUCL.EQ.1) ILASJ=ILASI
  116. ILAS=ILASJ+INCR*NX+INCR
  117. DO 42 ICOUCH=1,NCOUCH
  118. IF (NCOUCH.EQ.ICOUCH) GOTO 41
  119. ILASI=ILASI+INCR
  120. ILASJ=ILASJ+INCR
  121. INI=(ICOUCH-1)*IPT1.NUM(/2)
  122. NUM(1,1+INI+NBELEC)=ILASI
  123. NUM(4,1+INI)=ILASI
  124. NUM(2,INI+2*NBELEC)=ILASJ
  125. NUM(3,INI+NBELEC)=ILASJ
  126. DO 42 J=1,IPT1.NUM(/2)
  127. DO 42 I=1,2
  128. ILL=ILAS
  129. IF (I.EQ.1.AND.J.EQ.1) GOTO 42
  130. IF (I.EQ.2.AND.J.EQ.NBELEC) GOTO 42
  131. IF (ICPR(I,J).NE.0) ILL=NUM(MOD(ICPR(I,J)-1,2)+1,
  132. # (ICPR(I,J)-1)/2+1+INI+NBELEC)
  133. NUM(I,J+INI+NBELEC)=ILL
  134. NUM(5-I,J+INI)=ILL
  135. IF (ICPR(I,J).NE.0) GOTO 42
  136. ILAS=ILL+1
  137. 42 CONTINUE
  138. 41 CONTINUE
  139. INI=(NCOUCH-1)*IPT1.NUM(/2)
  140. DO 43 I=1,NBELEC
  141. NUM(4,INI+I)=IPT3.NUM(1,I)
  142. NUM(3,INI+I)=IPT3.NUM(1+INCR,I)
  143. 43 CONTINUE
  144. DO 44 I=1,NCOUCH
  145. DO 44 J=1,IPT1.NUM(/2)
  146. II=(I-1)*IPT1.NUM(/2)+J
  147. 44 ICOLOR(II)=IPT1.ICOLOR(J)
  148. LISREF(1)=IPT1
  149. C CREATION DES BORDS LATERAUX PAR LIGNE PETIT SOUCI
  150. C CECI EST A REVOIR (NOUVEAU S-P POUR CE CAS QUI RESPECTE LA
  151. C NUMEROTATION
  152. ILS=IPT1.ITYPEL
  153. IDS=IPT1.ICOLOR(1)
  154. LP1=IPT1.NUM(1,1)
  155. LP2=IPT3.NUM(1,1)
  156. CALL GENERL(LP1,LP2,IPT8,IPT2,IDS)
  157. IF (IERR.NE.0) RETURN
  158. CALL INVERS(IPT2,IPT4)
  159. LISREF(4)=IPT4
  160. SEGDES IPT4,IPT2
  161. IF (IBOUCL.EQ.0) GOTO 46
  162. LISREF(2)=IPT2
  163. GOTO 45
  164. 46 CONTINUE
  165. IDS=IPT1.ICOLOR(IPT1.ICOLOR(/1))
  166. LP2=IPT3.NUM(IPT3.NUM(/1),IPT3.NUM(/2))
  167. LP1=IPT1.NUM(IPT1.NUM(/1),IPT1.NUM(/2))
  168. CALL GENERL(LP1,LP2,IPT8,IPT2,IDS)
  169. IF (IERR.NE.0) RETURN
  170. SEGDES IPT2
  171. LISREF(2)=IPT2
  172. 45 CONTINUE
  173. SEGSUP IPT3
  174. C CREATION DES POINTS (PAS LES POINTS MILIEUX QUI SERONT FABRIQUES
  175. C EVENTUELLEMENT LORS DE LA CONVERSION DES ELEMENTS)
  176. IADR=XCOOR(/1)/(IDIM+1)
  177. IF (NCOUCH.EQ.1) GOTO 60
  178. NBPTS=IADR+IPT1.NUM(/2)*(NCOUCH-1)*2
  179. SEGADJ MCOORD
  180. DO 61 I=2,NCOUCH
  181. IF (IPT1.NUM(/2).EQ.1) GOTO 60
  182. IREFI=(IDIM+1)*(IPT8.NUM(1,I)-1)
  183. XVI=XCOOR(IREFI+1)-XCOOR(IREFB+1)
  184. YVI=XCOOR(IREFI+2)-XCOOR(IREFB+2)
  185. ZVI=XCOOR(IREFI+3)-XCOOR(IREFB+3)
  186. DO 62 J=1,IPT1.NUM(/2)
  187. DO 62 K=1,2
  188. IF (K.EQ.1.AND.J.EQ.1) GOTO 62
  189. IF (K.EQ.2.AND.J.EQ.NBELEC) GOTO 62
  190. IF (ICPR(K,J).NE.0) GOTO 62
  191. IREF=(IDIM+1)*IPT1.NUM((K-1)*INCR+1,J)-IDIM
  192. XCOOR(IADR*(IDIM+1)+1)=XCOOR(IREF)+XVI
  193. XCOOR(IADR*(IDIM+1)+2)=XCOOR(IREF+1)+YVI
  194. IF (IDIM.NE.2) XCOOR(IADR*(IDIM+1)+3)=XCOOR(IREF+2)+ZVI
  195. XCOOR(IADR*(IDIM+1)+(IDIM+1))=XCOOR(IREF+IDIM)
  196. IADR=IADR+1
  197. 62 CONTINUE
  198. 61 CONTINUE
  199. 60 CONTINUE
  200. NBPTS=IADR
  201. SEGADJ MCOORD
  202. IF (KSURF(ILCOUR).EQ.8) GOTO 101
  203. IF (KSURF(ILCOUR).NE.4) GOTO 102
  204. NBNN=3
  205. NBELEM=2*NUM(/2)
  206. NBREF=4
  207. NBSOUS=0
  208. SEGINI IPT1
  209. IPT1.ITYPEL=4
  210. IPT1.LISREF(1)=LISREF(1)
  211. IPT1.LISREF(2)=LISREF(2)
  212. IPT1.LISREF(3)=LISREF(3)
  213. IPT1.LISREF(4)=LISREF(4)
  214. DO 103 I=1,NUM(/2),2
  215. J=2*I-1
  216. IPT1.NUM(1,J)=NUM(1,I)
  217. IPT1.NUM(2,J)=NUM(2,I)
  218. IPT1.NUM(3,J)=NUM(3,I)
  219. IPT1.ICOLOR(J)=ICOLOR(I)
  220. J=J+1
  221. IPT1.NUM(1,J)=NUM(1,I)
  222. IPT1.NUM(2,J)=NUM(3,I)
  223. IPT1.NUM(3,J)=NUM(4,I)
  224. IPT1.ICOLOR(J)=ICOLOR(I)
  225. J=J+1
  226. IF (J.GT.IPT1.NUM(/2)) GOTO 103
  227. IPT1.NUM(1,J)=NUM(1,I+1)
  228. IPT1.NUM(2,J)=NUM(2,I+1)
  229. IPT1.NUM(3,J)=NUM(4,I+1)
  230. IPT1.ICOLOR(J)=ICOLOR(I+1)
  231. J=J+1
  232. IPT1.NUM(1,J)=NUM(2,I+1)
  233. IPT1.NUM(2,J)=NUM(3,I+1)
  234. IPT1.NUM(3,J)=NUM(4,I+1)
  235. IPT1.ICOLOR(J)=ICOLOR(I+1)
  236. 103 CONTINUE
  237. SEGSUP MELEME
  238. MELEME=IPT1
  239. GOTO 101
  240. 102 CONTINUE
  241. IF (KSURF(ILCOUR).NE.10.AND.KSURF(ILCOUR).NE.6) GOTO 104
  242. C ON FAIT DES QUA8 OU DES TRI6
  243. NBNN=8
  244. NBELEM=NUM(/2)
  245. NBREF=4
  246. NBSOUS=0
  247. SEGINI IPT5
  248. IPT5.ITYPEL=10
  249. IPT1=LISREF(1)
  250. IPT2=LISREF(2)
  251. IPT3=LISREF(3)
  252. IPT4=LISREF(4)
  253. IPT5.LISREF(1)=IPT1
  254. IPT5.LISREF(2)=IPT2
  255. IPT5.LISREF(3)=IPT3
  256. IPT5.LISREF(4)=IPT4
  257. SEGACT IPT1,IPT2,IPT3,IPT4
  258. DO 105 J=1,NUM(/1)
  259. JJ=2*J-1
  260. DO 105 I=1,NBELEM
  261. IPT5.NUM(JJ,I)=NUM(J,I)
  262. 105 CONTINUE
  263. DO 135 I=1,NBELEM
  264. 135 IPT5.ICOLOR(I)=ICOLOR(I)
  265. NLIG=IPT1.NUM(/2)
  266. DO 106 I=1,NLIG
  267. IPT5.NUM(2,I)=IPT1.NUM(2,I)
  268. IPT5.NUM(6,NBELEM+1-I)=IPT3.NUM(2,I)
  269. 106 CONTINUE
  270. NBPTA=XCOOR(/1)/(IDIM+1)
  271. NBPTS=NBPTA+NCOUCH*(NLIG+NLIG*2)
  272. SEGADJ MCOORD
  273. DO 107 I=1,NCOUCH
  274. IPT5.NUM(8,NLIG*(I-1)+1)=IPT4.NUM(2,NCOUCH+1-I)
  275. IPT5.NUM(4,NLIG*I)=IPT2.NUM(2,I)
  276. C ON FAIT D'ABORD LES NOEUDS 2 DU HAUT (6 DU BAS)
  277. C CREATION DES NOEUDS
  278. IF (I.EQ.NCOUCH) GOTO 108
  279. IREFI=(IDIM+1)*(IPT8.NUM(IPT8.NUM(/1),I)-1)
  280. XVI=XCOOR(IREFI+1)-XCOOR(IREFB+1)
  281. YVI=XCOOR(IREFI+2)-XCOOR(IREFB+2)
  282. ZVI=XCOOR(IREFI+3)-XCOOR(IREFB+3)
  283. DO 109 J=1,NLIG
  284. IREF=(IDIM+1)*(IPT1.NUM(2,J)-1)
  285. XCOOR(IADR*(IDIM+1)+1)=XCOOR(IREF+1)+XVI
  286. XCOOR(IADR*(IDIM+1)+2)=XCOOR(IREF+2)+YVI
  287. IF (IDIM.GE.3) XCOOR(IADR*(IDIM+1)+3)=XCOOR(IREF+3)+ZVI
  288. XCOOR(IADR*(IDIM+1)+(IDIM+1))=XCOOR(IREF+IDIM+1)
  289. IADR=IADR+1
  290. C ON MET LE NOEUD DANS LES ELEMENTS
  291. IPT5.NUM(6,(I-1)*NLIG+J)=IADR
  292. IPT5.NUM(2,I*NLIG+J)=IADR
  293. 109 CONTINUE
  294. 108 CONTINUE
  295. IF (NLIG.EQ.1) GOTO 113
  296. C ON MET LES NOEUDS 4 DE GAUCHE ET 8 DE DROITE
  297. C CREATION DES NOEUDS
  298. IREFI=(IDIM+1)*(IPT8.NUM(2,I)-1)
  299. XVI=XCOOR(IREFI+1)-XCOOR(IREFB+1)
  300. YVI=XCOOR(IREFI+2)-XCOOR(IREFB+2)
  301. ZVI=XCOOR(IREFI+3)-XCOOR(IREFB+3)
  302. DO 115 J=1,NLIG
  303. DO 115 K=1,2
  304. IF (K.EQ.1.AND.J.EQ.1) GOTO 115
  305. IF (K.EQ.2.AND.J.EQ.NLIG) GOTO 115
  306. IF (ICPR(K,J).NE.0) GOTO 116
  307. IREF=(IPT1.NUM(2*K-1,J)-1)*(IDIM+1)
  308. XCOOR(IADR*(IDIM+1)+1)=XCOOR(IREF+1)+XVI
  309. XCOOR(IADR*(IDIM+1)+2)=XCOOR(IREF+2)+YVI
  310. IF (IDIM.GE.3) XCOOR(IADR*(IDIM+1)+3)=XCOOR(IREF+3)+ZVI
  311. XCOOR(IADR*(IDIM+1)+(IDIM+1))=XCOOR(IREF+IDIM+1)
  312. IADR=IADR+1
  313. 116 CONTINUE
  314. C NOEUDS DES ELEM
  315. IF (ICPR(K,J).NE.0) GOTO 119
  316. IPT5.NUM(4*(3-K),(I-1)*NLIG+J)=IADR
  317. GOTO 115
  318. 119 CONTINUE
  319. IPT5.NUM(4*(3-K),(I-1)*NLIG+J)=IPT5.NUM(4*(2-MOD(ICPR(K,J)-1,2)),
  320. # (ICPR(K,J)+1)/2+(I-1)*NLIG)
  321. 115 CONTINUE
  322. 113 CONTINUE
  323. 107 CONTINUE
  324. NBPTS=IADR
  325. SEGADJ MCOORD
  326. SEGSUP MELEME
  327. MELEME=IPT5
  328. SEGDES IPT1,IPT2,IPT3,IPT4
  329. IF (KSURF(ILCOUR).NE.6) GOTO 101
  330. C ON FAIT DES TRI6
  331. NBNN=6
  332. NBELEM=2*NUM(/2)
  333. NBREF=4
  334. NBSOUS=0
  335. SEGINI IPT1
  336. IPT1.ITYPEL=6
  337. IPT1.LISREF(1)=LISREF(1)
  338. IPT1.LISREF(2)=LISREF(2)
  339. IPT1.LISREF(3)=LISREF(3)
  340. IPT1.LISREF(4)=LISREF(4)
  341. IALT=1
  342. NBPTS=XCOOR(/1)/(IDIM+1)+NCOUCH*NLIG
  343. SEGADJ MCOORD
  344. DO 120 I=1,NCOUCH
  345. IREFI=(IDIM+1)*(IPT8.NUM(2,I)-1)
  346. XVI=XCOOR(IREFI+1)-XCOOR(IREFB+1)
  347. YVI=XCOOR(IREFI+2)-XCOOR(IREFB+2)
  348. ZVI=XCOOR(IREFI+3)-XCOOR(IREFB+3)
  349. DO 120 J=1,NLIG
  350. INU=(I-1)*NLIG+J
  351. IALT=3-IALT
  352. C CREATION DU POINT SUPPLEMENTAIRE
  353. IREF=(NUM(2,J)-1)*(IDIM+1)
  354. XCOOR(IADR*(IDIM+1)+1)=XCOOR(IREF+1)+XVI
  355. XCOOR(IADR*(IDIM+1)+2)=XCOOR(IREF+2)+YVI
  356. IF (IDIM.EQ.3) XCOOR(IADR*(IDIM+1)+3)=XCOOR(IREF+3)+ZVI
  357. XCOOR(IADR*(IDIM+1)+(IDIM+1))=XCOOR(IREF+IDIM+1)
  358. IADR=IADR+1
  359. ITR1=2*INU-1
  360. ITR2=2*INU
  361. GOTO (124,125),IALT
  362. C CREATION DES TRIANGLES
  363. 124 IPT1.NUM(1,ITR1)=NUM(1,INU)
  364. IPT1.NUM(2,ITR1)=NUM(2,INU)
  365. IPT1.NUM(3,ITR1)=NUM(3,INU)
  366. IPT1.NUM(5,ITR1)=NUM(7,INU)
  367. IPT1.NUM(6,ITR1)=NUM(8,INU)
  368. IPT1.NUM(4,ITR1)=IADR
  369. IPT1.NUM(1,ITR2)=NUM(3,INU)
  370. IPT1.NUM(2,ITR2)=NUM(4,INU)
  371. IPT1.NUM(3,ITR2)=NUM(5,INU)
  372. IPT1.NUM(4,ITR2)=NUM(6,INU)
  373. IPT1.NUM(5,ITR2)=NUM(7,INU)
  374. IPT1.NUM(6,ITR2)=IADR
  375. IPT1.ICOLOR(ITR1)=ICOLOR(INU)
  376. IPT1.ICOLOR(ITR2)=ICOLOR(INU)
  377. GOTO 126
  378. 125 IPT1.NUM(1,ITR1)=NUM(1,INU)
  379. IPT1.NUM(2,ITR1)=NUM(2,INU)
  380. IPT1.NUM(3,ITR1)=NUM(3,INU)
  381. IPT1.NUM(4,ITR1)=NUM(4,INU)
  382. IPT1.NUM(5,ITR1)=NUM(5,INU)
  383. IPT1.NUM(6,ITR1)=IADR
  384. IPT1.NUM(1,ITR2)=NUM(5,INU)
  385. IPT1.NUM(2,ITR2)=NUM(6,INU)
  386. IPT1.NUM(3,ITR2)=NUM(7,INU)
  387. IPT1.NUM(4,ITR2)=NUM(8,INU)
  388. IPT1.NUM(5,ITR2)=NUM(1,INU)
  389. IPT1.NUM(6,ITR2)=IADR
  390. IPT1.ICOLOR(ITR1)=ICOLOR(INU)
  391. IPT1.ICOLOR(ITR2)=ICOLOR(INU)
  392. GOTO 126
  393. 126 CONTINUE
  394. 120 CONTINUE
  395. SEGSUP MELEME
  396. MELEME=IPT1
  397. GOTO 101
  398. 104 CONTINUE
  399. 101 CONTINUE
  400. SEGSUP ICPR
  401. C S'IL Y A LIEU EXAMINER LA DEGENERESCENCE (ROTATION)
  402. SEGDES IPT1
  403. IF (IFUSE.EQ.0) GOTO 63
  404. IPT5=IFUSE
  405. SEGACT IPT5,MELEME
  406. ltelq=.false.
  407. CALL FUSE(IPT5,MELEME,IRET,ltelq)
  408. SEGDES IPT5
  409. SEGSUP MELEME
  410. MELEME=IRET
  411. 63 CONTINUE
  412. CALL ECROBJ('MAILLAGE',MELEME)
  413. SEGDES MELEME,IPT8
  414. RETURN
  415. END
  416.  
  417.  
  418.  
  419.  
  420.  
  421.  
  422.  
  423.  
  424.  
  425.  
  426.  

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