Télécharger hexos.eso

Retour à la liste

Numérotation des lignes :

  1. C HEXOS SOURCE CHAT 06/06/01 21:16:49 5450
  2. SUBROUTINE HEXOS(ITR1,NBE1,NBN1,ITR2,NBE2,NBN2,COORD,NBCOOR,
  3. > N1,N2,DEN1,DEN2,NBCOUC,
  4. > ITVL,NITMAX,NOSUPR,
  5. > ITR3,NBE3,NBEMAX,NBPMAX,NBNL,ICOIN,ITRACE,
  6. > IERCOD,iarr,RAISON)
  7. C **********************************************************************
  8. C OBJET HEXOS : MAILLAGE H8 RACCORDANT 2 MAILLAGE GRILLES COMPATIBLES
  9. C
  10. C EN ENTREE :
  11. C
  12. C --------- MAILLAGES A RACCORDER --------------------------
  13. C ITR1 : DEFINITION DE LA CONNECTIQUE DU MAILLAGE
  14. C ITR1((I-1)*4+J = JIEME NOEUD DU IIEME ELEMENT
  15. C LES ELEMENTS SONT DES QUADRANGLES A 4 NOEUDS
  16. C NBE1 : NOMBRE DE QUADRANGLES DANS LE MAILLAGE ITR1
  17. C NBN1 : NOMBRE DE NOEUDS DU MAILLAGE ITR1
  18. C
  19. C ITR2,NBE2,NBN2 : DEFINITION DU DEUXIEME MAILLAGE
  20. C
  21. C COORD : TABLEAU DES COORDONNEES DES POINTS
  22. C COORD((I-1)*3+J) = LA JIEME COORDONNE DU IEME NOEUD
  23. C NBCOOR : NOMBRE DE POINTS DANS LE TABLEAU COORD
  24. C
  25. C --------- PARAMETRES POUR LE RACCORD -----------------------
  26. C N1 : NUMERO DU NOEUD DE ITR1 A CONNECTER A N2 DE ITR2
  27. C N2 : " " " " " ITR2 " " " A N1 DE ITR1
  28. C DEN1 : TAILLE SOUHAITEE POUR LES ELEMENTS S'APPUYANT SUR ITR1
  29. C DEN2 : " " " " " " " " " " " SUR ITR2
  30. C NBCOUC : NOMBRE DE COUCHES SUPPLEMENTAIRES(PAR DEFAUT 1 SEULE COUCHE)
  31. C
  32. C --------- LES TABLEAUX VIDES ------------------------------
  33. C ITVL : TABLEAU D'ENTIERS POUR LES CALCULS
  34. C NITMAX : TAILLE DE ITVL, LA PLACE DEMANDEE EST DE :
  35. C T1 =(NBE2+NBE1)*4 +NBCOOR POUR LA STRUCTURE MAILLAGE (T2=3*NBCOOR)
  36. C T3 = NBN1 + NBN2 POUR LES GRILLES (T4 = MAX(NBN1,NBN2))
  37. C T5 = 2*NBLIG1*NBCOL2 POUR LA GRILLE INTERMEDIAIRE (2 COUCHES)
  38. C T5 = 0 SI UNE COUCHE
  39. C T6 = 2*NBLIG1*NBCOL2*(NBRAN-1) + NBCOOR
  40. C NITMAX >= T1+T3+ MAX(T2,T4,T5+T6)
  41. C AVEC NBRAN = (3+NBCOUC+NBCOL2+NBLIG2-NBCOL1-NBLIG1)
  42. C AVEC NBN1 = NBNL(1)*NBNL(2) ; NBN1 <= 3 + 2*NBE1
  43. C NBN2 = NBNL(3)*NBNL(4) ; NBN2 <= 3 + 2*NBE2
  44. C AVEC NBLIG1 = MAX(NBNL(2),NBNL(4))
  45. C NBCOL2 = MAX(NBNL(1),NBNL(3))
  46. C
  47. C ITR3 : TABLEAU DES HEXAEDRES (A REMPLIR)
  48. C NBEMAX : NOMBRE MAXIMUM D'ELEMENTS (LIE A LA TAILLE DE ITR3)
  49. C = 0 SI L'ON SOUHAITE SEULEMENT UNE IDENTIFICATION DES
  50. C GRILLE : NBNL, ICOIN
  51. C NBPMAX : NOMBRE MAXIMUM DE NOEUDS (LIE A LA TAILLE DE COORD)
  52. C
  53. C NOSUPR : NOSUPR = 1 SUPPRESSION DES NOEUDS ISOLES
  54. C NOSUPR = 0 PAS DE SUPPRESSION DE NOEUD
  55. C (LA SUPPRESSION DES NOEUDS POSE UN PROBLEME
  56. C QUAND IL Y A DES NOEUDS MILIEU)
  57. C
  58. C EN SORTIE :
  59. C
  60. C ITR3 : DEFINITION DE LA CONNECTIQUE DU MAILLAGE
  61. C ITR3((I-1)*8+J = JIEME NOEUD DU IIEME ELEMENT
  62. C LES ELEMENTS SONT DES HEXAEDRES A 8 NOEUDS
  63. C NBE3 : NOMBRE D'HEXAEDRES DANS LE MAILLAGE ITR3
  64. C COORD : TABLEAU DES POINTS CONTENANT LES POINTS AJOUTES
  65. C NBCOOR : NOMBRE DE POINTS APRES AJOUT
  66. C
  67. C NBNL : NOMBRE DE LIGNES ET DE COLONNES DES MAILLAGES ITR1 ET ITR2
  68. C NBNL(1) = NOMBRE DE COLONNES DE ITR1
  69. C NBNL(2) = NOMBRE DE LIGNES DE ITR1
  70. C NBNL(3) = NOMBRE DE COLONNES DE ITR2
  71. C NBNL(4) = NOMBRE DE LIGNES DE ITR2
  72. C ICOIN : LES NUMEROS DES NOEUDS DES COINS DE ITR1 ET ITR2
  73. C ICOIN(1) = PREMIER COIN DE ITR1....
  74. C ICOIN(4) = PREMIER COIN DE ITR2 ....
  75. C iarr : TYPE D'ERREUR -1 SI DONNEES INCORRECTES
  76. C -2 SI TABLEAUX INSUFFISANTS
  77. C IERCOD : CODE DETAILLE DE L'ERREUR
  78. C -100 : ERREUR NON REPERTORIEE
  79. C -101 : LES NUMEROS DES DEUX NOEUDS SONT INCORRECTS
  80. C -102 : LES DEUX NOEUDS SONT CONFONDUS
  81. C -103 : LES DENSITES SONT INCORRECTES
  82. C -104 : LE NOMBRE DE COUCHES DOIT ETRE POSITIF OU NUL
  83. C -105 : CONNECTIQUE NON VALIDE POUR LE PREMIER MAILLAGE
  84. C -106 : CONNECTIQUE NON VALIDE POUR LE DEUXIEME MAILLAGE
  85. C -107 : LES DEUX MAILLAGES PARTAGENT UN NOEUD
  86. C -108 : LE NOMBRE TOTAL DE LIGNES OU DE COLONNES EST IMPAIR
  87. C -109 : LA TAILLE SOUHAITEE EST SUPERIEURE A LA TAILLE DISPONIBLE
  88. C -110 : LE PREMIER MAILLAGE N'EST PAS UNE GRILLE
  89. C -111 : ORIENTATION DU PREMIER MAILLAGE IMPOSSIBLE
  90. C LES NOEUDS ET LE MAILLAGE SONT COPLANAIRES
  91. C -112 : LE DEUXIEME MAILLAGE N'EST PAS UNE GRILLE
  92. C -113 : ORIENTATION DU DEUXIEME MAILLAGE IMPOSSIBLE
  93. C LES NOEUDS ET LE MAILLAGE SONT COPLANAIRES
  94. C **********************************************************************
  95. IMPLICIT INTEGER(I-N)
  96. -INC CCREEL
  97. INTEGER ITR1(*),NBE1,NBN1,ITR2(*),NBE2,NBN2
  98. REAL*8 COORD(*),DEN1,DEN2
  99. INTEGER NBCOOR,N1,N2,NBCOUC,ITVL(*),NITMAX,NOSUPR
  100. INTEGER ITR3(*),NBE3
  101. INTEGER NBNL(*),ICOIN(*)
  102. INTEGER NBEMAX,NBPMAX,ITRACE,IERCOD,iarr
  103. C
  104. INTEGER NCC1,NCC2,NBNMX1,NBNMX2,NBCMX1,NBCMX2
  105. INTEGER ITRTR1,ITRTR2,INOET1,INOET2,ITRAV,ITRVMX
  106. INTEGER IDE,IDIMC
  107. C
  108. INTEGER IGR1,NGRMX1,IGR2,NGRMX2,NBCOL3,NBLIG3,NBRAN3
  109. INTEGER ICOMPR,NBENUL,NBISOL,NBN3,I,IOP
  110. INTEGER NBEGEN,NBPGEN,NBCMAX,NBNMAX,ITRTRI,NOEMAX,NOETRI
  111. C
  112. REAL*8 DLONG,RAISON,VK(3)
  113. * SAVE RAISON
  114. C
  115. C COMMON /CGEPSI/ XYZHUG,XYZMIN,XYZEPS
  116. C REAL*8 XYZHUG,XYZMIN,XYZEPS
  117. C
  118. IERCOD = -100
  119. ICOMPR = 0
  120. NBE3 = 0
  121. IF((N1.LE.0).OR.(N2.LE.0).OR.(N1.GT.NBCOOR).OR.
  122. > (N2.GT.NBCOOR))THEN
  123. iarr = -1
  124. IERCOD = -101
  125. CALL DSERRE(1,iarr,'HEXOS','IL FAUT DONNER LES COINS')
  126. GOTO 9999
  127. ENDIF
  128. C ---------------------------
  129. C --- CALCUL DE LA PROGRESSION ---
  130. C ---------------------------
  131. C
  132. IDIMC = 3
  133. DLONG = 0.0
  134. DO 5 I=1,IDIMC
  135. DLONG=(COORD((N1-1)*IDIMC+I)-COORD((N2-1)*IDIMC+I))**2 +DLONG
  136. 5 CONTINUE
  137. IF( DLONG.GT.XPETIT )DLONG = SQRT(DLONG)
  138. IF( DLONG.LE.XPETIT )THEN
  139. iarr = -1
  140. IERCOD = -102
  141. CALL DSERRE(1,iarr,'HEXOS',' COINS CONFONDUS')
  142. GOTO 9999
  143. ENDIF
  144. IF((DEN1.LT.0.0 ).OR.(DEN2.LT.0.0))THEN
  145. iarr = -1
  146. IERCOD = -103
  147. CALL DSERRE(1,iarr,'ESHEXO',
  148. > ' LA DENSITE DOIT ETRE POSITIVE OU NULLE')
  149. GOTO 9999
  150. ENDIF
  151. C IF((DEN1.GT.(DLONG+XPETIT) ).OR.(DEN2.GT.(DLONG+XPETIT)))THEN
  152. C iarr = -1
  153. C IERCOD = -109
  154. C CALL DSERRE(1,iarr,'ESHEXO',
  155. C > ' LA TAILLE SOUHAITEE EST SUPERIEURE A LA TAILLE DISPONIBLE')
  156. C GOTO 9999
  157. C ENDIF
  158. C IF(NBCOUC.LT.0)THEN
  159. C iarr = -1
  160. C IERCOD = -104
  161. C CALL DSERRE(1,iarr,'ESHEXO',
  162. C > ' LE NOMBRE DE COUCHES DOIT ETRE POSITIF OU NUL')
  163. C GOTO 9999
  164. C ENDIF
  165. C
  166. IF(NBEMAX.EQ.0)CALL SUGEGE(DEN1,DEN2,DLONG,RAISON,NBCOUC,iarr)
  167. C
  168. IF( iarr.NE.0 )THEN
  169. iarr = -1
  170. IERCOD = -103
  171. CALL DSERRE(1,iarr,'HEXOS',' APPEL SUGEGE')
  172. GOTO 9999
  173. ENDIF
  174. C
  175. C -------------------------
  176. C --- CALCUL DE LA STRUCTURE ---
  177. C -------------------------
  178. C
  179. IDE = 2
  180. NCC1 = 1
  181. NCC2 = 1
  182. NBNMX1 = 4
  183. NBNMX2 = 4
  184. NBCMX1 = 4
  185. NBCMX2 = 4
  186. C
  187. IF(NITMAX.LT.(((NBE1+NBE2)+ NBCOOR)*4))THEN
  188. iarr = -2
  189. CALL DSERRE(1,iarr,'HEXOS',' CREATION DES MAILLAGES')
  190. GOTO 9999
  191. ENDIF
  192. C
  193. ITRTR1 = 1
  194. INOET1 = (NBCMX1 * NBE1) + ITRTR1
  195. ITRAV = NBCOOR + INOET1
  196. ITRVMX = NITMAX - ITRAV
  197. CALL SMAOCR(IDE,ITR1,NBE1,COORD,
  198. > NBCOOR,IDIMC,
  199. > ITR1,NBNMX1,ITVL(ITRTR1),
  200. > NBCMX1,ITVL(INOET1),NBCOOR,
  201. > ITVL(ITRAV),ITRVMX,NCC1,iarr)
  202. IF(iarr.NE.0)THEN
  203. IERCOD = -105
  204. CALL DSERRE(1,iarr,'HEXOS',' APPEL SMAOCR')
  205. GOTO 9999
  206. ENDIF
  207. C
  208. C -------------------------
  209. C
  210. ITRTR2 = ITRAV
  211. INOET2 = (NBE2 * NBCMX2) + ITRTR2
  212. ITRAV = NBCOOR + INOET2
  213. ITRVMX = NITMAX - ITRAV
  214. CALL SMAOCR(IDE,ITR2,NBE2,COORD,
  215. > NBCOOR,IDIMC,
  216. > ITR2,NBNMX2,ITVL(ITRTR2),
  217. > NBCMX2,ITVL(INOET2),NBCOOR,
  218. > ITVL(ITRAV),ITRVMX,NCC2,iarr)
  219. IF(iarr.NE.0)THEN
  220. IERCOD = -106
  221. CALL DSERRE(1,iarr,'HEXOS',' APPEL SMAOCR')
  222. GOTO 9999
  223. ENDIF
  224. C ----------- FUSION DE INOETRI ------
  225. C CALL ESEINT(1,' ITR1 ',ITR1,NBE1*4)
  226. C CALL ESEINT(1,' ITR2 ',ITR2,NBE2*4)
  227. C CALL ESEINT(1,'INOET1 ',ITVL(INOET1),NBCOOR)
  228. C CALL ESEINT(1,'INOET2 ',ITVL(INOET2),NBCOOR)
  229. DO 10 I=1,NBCOOR
  230. IF(ITVL(I-1+INOET1).EQ.0)THEN
  231. ITVL(I-1+INOET1) = ITVL(I-1+INOET2) + NBE1
  232. ELSE
  233. IF( ITVL(I-1+INOET2).NE.0 )THEN
  234. iarr = -1
  235. IERCOD = -107
  236. CALL DSERRE(1,iarr,'HEXOS',
  237. > ' LES 2 MAILLAGES PARTANGENT 1 NOEUD')
  238. CALL ESEINT(1,'LE NOEUD ',I,1)
  239. GOTO 9999
  240. ENDIF
  241. ENDIF
  242. 10 CONTINUE
  243. C
  244. C ===========================================
  245. C ---- 2. CONSTRUCTION DES 2 GRILLES SURFACIQUES ----
  246. C ===========================================
  247. IF(ITRACE.GT.0)
  248. > CALL ESECHA(1,'-> CONTRUCTION DES 2 GRILLES',' ')
  249. C
  250. IGR1 = ITRAV
  251. NGRMX1 = NBN1
  252. IGR2 = IGR1 + NGRMX1
  253. NGRMX2 = NBN2
  254. ITRAV = IGR2 + NGRMX2
  255. ITRVMX = NITMAX - ITRAV
  256. IF( ITRVMX.LT. 0)THEN
  257. iarr = -2
  258. CALL DSERRE(1,iarr,'HEXOS',' CREATION DES GRILLES')
  259. GOTO 9999
  260. ENDIF
  261. DO 20 I=1,4
  262. NBNL(I) = 0
  263. ICOIN(I) = 0
  264. ICOIN(I+4) = 0
  265. 20 CONTINUE
  266. CALL Q4ORG2(ITR1,NBNMX1,ITVL(ITRTR1),NBCMX1,NBE1,
  267. > ITR2,NBNMX2,ITVL(ITRTR2),NBCMX2,NBE2,N1,N2,
  268. > COORD,NBCOOR,IDIMC,
  269. > ITVL(ITRAV),ITRVMX,
  270. > ITVL(IGR1),NGRMX1,ITVL(IGR2),NGRMX2,
  271. > ICOIN,NBNL,0,iarr)
  272. C
  273. C
  274. C
  275. IF(iarr.EQ.-1)THEN
  276. C
  277. C ----- PREMIER MAILLAGE ----
  278. C
  279. IF((NBNL(1).EQ.0).OR.(NBNL(2).EQ.0))THEN
  280. IERCOD = -110
  281. CALL DSERRE(1,iarr,'HEXOS',' APPEL Q4ORG2')
  282. CALL DSERRE(1,iarr,'HEXOS',
  283. > ' LE PREMIER MAILLAGE N EST PAS UNE GRILLE')
  284. GOTO 9999
  285. ENDIF
  286. IF((ICOIN(1).NE.N1).AND.(ICOIN(2).NE.N1).AND.
  287. > (ICOIN(3).NE.N1).AND.(ICOIN(4).NE.N1))THEN
  288. IERCOD = -118
  289. CALL DSERRE(1,iarr,'HEXOS',' APPEL Q4ORG2')
  290. CALL DSERRE(1,iarr,'HEXOS',
  291. > ' LE PREMIER NOEUD N EST PAS DANS LE PREMIER MAILLAGE')
  292. GOTO 9999
  293. ENDIF
  294. C ----- ORIENTATION DE IGR1 ----
  295. C
  296. DO 25 I=1,IDIMC
  297. VK(I)=(COORD((N2-1)*IDIMC+I)-COORD((N1-1)*IDIMC+I))
  298. 25 CONTINUE
  299. CALL G2ORIE(ITVL(IGR1),NBNL(1),NBNL(2),IDIMC,COORD,VK,IOP )
  300. IF( IOP.EQ. 0)THEN
  301. IERCOD = -111
  302. CALL DSERRE(1,iarr,'HEXOS',
  303. > ' ORIENTATION DE LA PREMIERE GRILLE IMPOSSIBLE')
  304. GOTO 9999
  305. ENDIF
  306. C
  307. C ----- DEUXIEME MAILLAGE ----
  308. C
  309. IF((NBNL(3).EQ.0).OR.(NBNL(4).EQ.0))THEN
  310. IERCOD = -112
  311. CALL DSERRE(1,iarr,'HEXOS',' APPEL Q4ORG2')
  312. CALL DSERRE(1,iarr,'HEXOS',
  313. > ' LE DEUXIEME MAILLAGE N EST PAS UNE GRILLE')
  314. GOTO 9999
  315. ENDIF
  316. IF((ICOIN(5).NE.N2).AND.(ICOIN(6).NE.N2).AND.
  317. > (ICOIN(7).NE.N2).AND.(ICOIN(8).NE.N2))THEN
  318. IERCOD = -122
  319. CALL DSERRE(1,iarr,'HEXOS',' APPEL Q4ORG2')
  320. CALL DSERRE(1,iarr,'HEXOS',
  321. > ' LE DEUXIEME NOEUD N EST PAS DANS LE DEUXIEME MAILLAGE')
  322. GOTO 9999
  323. ENDIF
  324. C
  325. CALL G2ORIE(ITVL(IGR2),NBNL(3),NBNL(4),IDIMC,COORD,VK,IOP )
  326. IF( IOP.EQ. 0)THEN
  327. IERCOD = -113
  328. CALL DSERRE(1,iarr,'HEXOS',
  329. > ' ORIENTATION DE LA DEUXIEME GRILLE IMPOSSIBLE')
  330. GOTO 9999
  331. ENDIF
  332. C
  333. IF((NBNL(1).GT.NBNL(3)).AND.(NBNL(2).GT.NBNL(4)))THEN
  334. C
  335. C --- ON INVERSE IGR1 ET IGR2 ---
  336. C
  337. CALL ESECHA(1,'-> ON INVERSE L ORDRE DES GRILLES ',' ')
  338. iarr = 0
  339. NGRMX1 = NBN2
  340. IGR2 = IGR1 + NGRMX1
  341. NGRMX2 = NBN1
  342. ITRAV = IGR2 + NGRMX2
  343. CALL Q4ORG2(ITR2,NBNMX2,ITVL(ITRTR2),NBCMX2,NBE2,
  344. > ITR1,NBNMX1,ITVL(ITRTR1),NBCMX1,NBE1,N2,N1,
  345. > COORD,NBCOOR,IDIMC,
  346. > ITVL(ITRAV),ITRVMX,
  347. > ITVL(IGR1),NGRMX1,ITVL(IGR2),NGRMX2,
  348. > ICOIN,NBNL,0,iarr)
  349. ENDIF
  350. C
  351. ENDIF
  352. C
  353. IF(ITRACE.GT.0)THEN
  354. CALL ESECHA(1,'-> GRILLE 1 ',' ')
  355. CALL ESEINT(1,'COLONNES LIGNES : ',NBNL(1),2)
  356. CALL ESEINT(1,'LES COINS : ',ICOIN(1),4)
  357. CALL ESECHA(1,'-> GRILLE 2 ',' ')
  358. CALL ESEINT(1,'COLONNES LIGNES : ',NBNL(3),2)
  359. CALL ESEINT(1,'LES COINS : ',ICOIN(5),4)
  360. ENDIF
  361. C
  362. IF(iarr.NE.0)THEN
  363. CALL DSERRE(1,iarr,'HEXOS',' APPEL Q4ORG2')
  364. GOTO 9999
  365. ENDIF
  366. C
  367. IF( (MOD(NBNL(1)+NBNL(3),2).NE.0).OR.
  368. > (MOD(NBNL(2)+NBNL(4),2).NE.0))THEN
  369. IERCOD = -108
  370. iarr = -1
  371. GOTO 9999
  372. ENDIF
  373. C
  374. IF(NBEMAX.EQ.0)THEN
  375. NBE3 = 0
  376. GOTO 9999
  377. ENDIF
  378. C
  379. C ===========================================
  380. C ---- 3. MAILLAGE 3D RACCORDANT LES 2 GRILLES ----
  381. C ===========================================
  382. IF(ITRACE.GT.0)
  383. > CALL ESECHA(1,'**** RACCORD 3D ****',' ')
  384. C ==========================================
  385. C --- RACCORD EN DEUX COUCHES
  386. C ==========================================
  387. IF((NBNL(3).GT.NBNL(1)).AND.(NBNL(4).GT.NBNL(2)))THEN
  388. IF(ITRACE.GT.0)
  389. > CALL ESECHA(1,' RACCORD EN 2 COUCHES : ',
  390. > ' MAILLAGE SURFACIQUE INTERMEDIAIRE ')
  391. C -----------------------------------
  392. C --- EVALUATION DE LA PLACE NECESSAIRE ---
  393. C -----------------------------------
  394. NBLIG3 = NBNL(1)
  395. NBCOL3 = (NBNL(4)-NBNL(2))/2 +2+NBCOUC-1
  396. NBRAN3 = NBNL(4)
  397. C
  398. NBEGEN = (NBLIG3-1)*(NBCOL3-1)*(NBRAN3-1)
  399. NBPGEN = NBLIG3*NBCOL3*NBRAN3
  400. C
  401. NBLIG3 = NBNL(3)
  402. NBCOL3 = (NBNL(3)-NBNL(1))/2 +2+NBCOUC-1
  403. NBRAN3 = NBNL(4)
  404. C
  405. NBEGEN = (NBLIG3-1)*(NBCOL3-1)*(NBRAN3-1) + NBEGEN
  406. NBPGEN = NBLIG3*NBCOL3*NBRAN3 + NBPGEN
  407. C
  408. C --- ON PEUT COMPRIMER EN SUPPRIMANT LES 2 MAILLAGES : ITRINO1...
  409. C
  410. C --- MAILLAGE EN H8 ---
  411. C
  412. NBNMAX = 8
  413. C
  414. CALL H8RCGG(ITVL(IGR1),NBNL(2),NBNL(1),
  415. > ITVL(IGR2),NBNL(4),NBNL(3),
  416. > COORD,NBCOOR,IDIMC,NBCOUC,RAISON,
  417. > ITVL(ITRAV),ITRVMX,
  418. > ITR3,NBNMAX,NBE3,NBN3,
  419. > NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr)
  420. IF(iarr.NE.0)THEN
  421. CALL DSERRE(1,iarr,'HEXOS',' APPEL H8RCGG')
  422. GOTO 9999
  423. ENDIF
  424. C
  425. ELSE
  426. C ==========================================
  427. C --- RACCORD EN UNE COUCHE
  428. C ==========================================
  429. IF(ITRACE.GT.0)
  430. > CALL ESECHA(1,' RACCORD EN 1 COUCHES : ',
  431. > ' MAILLAGE HEXAEDRIQUE ')
  432. C
  433. C -----------------------------------
  434. C --- EVALUATION DE LA PLACE NECESSAIRE ---
  435. C -----------------------------------
  436. NBLIG3 = NBNL(3)
  437. NBCOL3 = (NBNL(3)-NBNL(1)+NBNL(2)-NBNL(4))/2 +2+NBCOUC-1
  438. NBRAN3 = NBNL(2)
  439. C
  440. NBEGEN = (NBLIG3-1)*(NBCOL3-1)*(NBRAN3-1)
  441. NBPGEN = NBLIG3*NBCOL3*NBRAN3
  442. C
  443. C --- ON PEUT COMPRIMER EN SUPPRIMANT LES 2 MAILLAGES : ITRINO1...
  444. C
  445. C --- MAILLAGE EN H8 ---
  446. C
  447. NBNMAX = 8
  448. C
  449. CALL H8RCG2(ITVL(IGR1),NBNL(2),NBNL(1),
  450. > ITVL(IGR2),NBNL(4),NBNL(3),
  451. > COORD,NBCOOR,IDIMC,NBCOUC,RAISON,
  452. > ITVL(ITRAV),ITRVMX,
  453. > ITR3,NBNMAX,NBE3,NBN3,
  454. > NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr)
  455. ENDIF
  456. C
  457. IF(iarr.NE.0)THEN
  458. CALL DSERRE(1,iarr,'HEXOS',' APPEL H8RCG2')
  459. GOTO 9999
  460. ENDIF
  461. C
  462. C ===================================================
  463. C --- 3. COMPRESSION DU MAILLAGE ---
  464. C ===================================================
  465. C
  466. 30 CONTINUE
  467. C
  468. IF((NBNL(2).NE.NBNL(4)).OR.(NBNL(1).NE.NBNL(3)).OR.
  469. > (NOSUPR.EQ.1) )THEN
  470. C
  471. IF(ITRACE.GT.0)THEN
  472. CALL ESECHA(1,'**** POST-TRAITEMENT ****',' ')
  473. CALL ESECHA(1,'-> COMPRESSION DU MAILLAGE 3D',' ')
  474. ENDIF
  475. C
  476. C --- LA SUPPRESSION DES NOEUDS POSE UN PROBLEME
  477. C QUAND IL Y A DES NOEUDS MILIEU : IDIMC6 = 0
  478. C
  479. IDIMC6 = 0
  480. C
  481. IDE = 3
  482. NBCMAX = 0
  483. ITRTRI = 0
  484. NOEMAX = 0
  485. NOETRI = 0
  486. NBENUL = NBE3
  487. NBISOL = NBCOOR
  488. CALL NUGCNU(IDE,ITR3,NBNMAX,ITRTRI,NBCMAX,
  489. > NOETRI,NOEMAX,NBE3,COORD,IDIMC6,NBCOOR,
  490. > ITVL(ITRAV),ITRVMX,iarr)
  491. C
  492. IF(ITRACE.GT.0)THEN
  493. CALL ESEINT(1,'NOMBRE D ELEMENTS SUPPRIMES : ',NBENUL-NBE3,1)
  494. CALL ESEINT(1,'NOMBRE DE POINTS SUPPRIMES : ',NBISOL-NBCOOR,1)
  495. ENDIF
  496. ENDIF
  497. C
  498. C CALL ESEINT(1,' ITR3 ',ITR3,NBE3*8)
  499. C
  500. 9999 END
  501.  
  502.  
  503.  
  504.  
  505.  
  506.  
  507.  

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