Télécharger h8rcgi.eso

Retour à la liste

Numérotation des lignes :

  1. C H8RCGI SOURCE CHAT 06/03/29 21:23:09 5360
  2. SUBROUTINE H8RCGI(IGR11,NBLG11,NBCO11,
  3. > IGR22,NBLG22,NBCO22,COORD,NBCOOR,IDIMC,NBCOUC,RAISON,
  4. > NBLIG3,NBCOL3,NBRAN3,IARETE,NARETE,
  5. > ITVL,NITMAX,
  6. > ITRNOE,NBNMAX,NBE,NBP,
  7. > NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr)
  8. C **********************************************************************
  9. C OBJET H8RCGI : MAILLAGE H8 S'APPUYANT 2 GRILLES IDENTIQUES
  10. C
  11. C ON GENERE UNE GRILLE 3D QUI S'APPUIT INITIALEMENT SUR LES GRILLES
  12. C IGR11 ET IGR22 PUIS ON APPLIQUE DES "COUPER-COLLER" DONNES (NARETE)
  13. C
  14. C EN ENTREE :
  15. C
  16. C IGR11,NBLIG11,NBCOL11 : LA PREMIERE GRILLE
  17. C IGR22,NBLIG22,NBCOL22 : LA DEUXIEME GRILLE
  18. C COORD,NBCOOR,IDIMC : POSITION DES NOEUDS
  19. C
  20. C NBCOUC : NOMBRE DE COUCHES SUPPLEMENTAIRES
  21. C (PAR DEFAUT 1 SEULE COUCHE)
  22. C NBLIG3,NBCOL3,NBRAN3 : GRILLE 3D DE RACCORD
  23. C IARETE,NARETE : INDICE ET CARDINAUX DES RANGEES A COUPER
  24. C A ET RECOLLER
  25. C
  26. C ITVL : TABLEAU D'ENTIERS POUR LES CALCULS
  27. C NITMAX : TAILLE DE ITVL, LA PLACE NECESSAIRE EST DE
  28. C NBLIG3*NBCOL3*NBRAN3 AU MINIMUM, SI ICOMPR= 0
  29. C SINON IL FAUT AJOUTER : NBLIG3*NBCOL3*(NBRAN3-2) + NBCOOR
  30. C
  31. C ITRNOE : TABLEAU DES ELEMENTS (A REMPLIR)
  32. C NBEMAX : NOMBRE MAXIMUM D'ELEMENTS
  33. C NBPMAX : NOMBRE MAXIMUM DE NOEUDS (LIE A LA TAILLE DE COORD)
  34. C
  35. C ICOMPR : FLAG DE COMPRESSION
  36. C ICOMPR = 0 LES NOEUDS ISOLES NE SONT PAS SUPPRIMES
  37. C LES ELEMENTS NULS " " " "
  38. C
  39. C EN SORTIE :
  40. C
  41. C ITRNOE,NBNMAX,ITRTRI,NBE,NBP : LE MAILLAGE RESULTANT
  42. C iarr : CODE D'ERREUR -1 SI DONNEES INCORRECTES
  43. C -2 SI TABLEAUX INSUFFISANTS
  44. C
  45. C REMARQUE : L'ALGORITHME GENERE LES NOEUDS D'UNE GRILLE COMPLETE
  46. C APRES LE COUPER-COLLER CERTAIN NOEUDS DEVIENDRONT ISOLES
  47. C ET CERTAIN ELEMENTS SERONT NON VALIDES (NULS).
  48. C LE FLAG "ICOMPR" PERMET DE LES SUPPRIMER
  49. C **********************************************************************
  50. IMPLICIT INTEGER(I-N)
  51. INTEGER IGR11(*),NBLG11,NBCO11
  52. INTEGER IGR22(*),NBLG22,NBCO22
  53. REAL*8 COORD(*),RAISON
  54. INTEGER IDIMC,NBCOOR,NBCOUC
  55. INTEGER NBLIG3,NBCOL3,NBRAN3,IARETE(*),NARETE(*)
  56. INTEGER ITVL(*),NITMAX
  57. INTEGER ITRNOE(*),NBNMAX,NBE,NBP
  58. INTEGER NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr
  59. C
  60. C COMMON /CGEPSI/ XYZHUG,XYZMIN,XYZEPS
  61. C REAL*8 XYZHUG,XYZMIN,XYZEPS
  62. C
  63. INTEGER IGR3
  64. INTEGER INDICE,I,J,K
  65. REAL*8 XO,V12,XN,COEF,XYZEPS
  66. INTEGER NRANAJ,INDXYZ,NUM1,NUM2,KK
  67. INTEGER NOETRI,NBISOL,NOEMAX,NBENUL
  68. INTEGER IDE,NBCMAX,ITRTRI,INUL
  69. XYZEPS=1.D-10
  70. C
  71. C =======================================
  72. C --- 2.CREATION D'UNE GRILLE 3D ET COLLAGE ---
  73. C =======================================
  74. C
  75. IF(ITRACE.GT.0)
  76. > CALL ESECHA(1,
  77. > '2. CREATION DE LA GRILLES 3D ET COLLAGE : ',' ')
  78. C
  79. IGR3 = 1
  80. C INUL = 0
  81. C CALL G3CRSP( NBLIG3,NBCOL3,NBRAN3,INUL,INUL,ITVL(IGR3) )
  82. DO 141 I=1,NBLIG3*NBCOL3*NBRAN3
  83. 141 ITVL(I) = 0
  84. C
  85. C ---------------------------------------------
  86. C --- 2.1 TRANSFERT DES 2 FACES DANS LA GRILLE 3D ---
  87. C ---------------------------------------------
  88. C --- ON TRANSFERT ---
  89. C IGR1 = (I,J) -> (1,I,J)
  90. C
  91. C
  92. DO 150 I=1,NBCO11
  93. DO 140 J=1,NBLG11
  94. ITVL((J-1)*NBLIG3*NBCOL3 + (I-1)*NBCOL3+IGR3) =
  95. > IGR11((J-1)*NBCO11+I)
  96. 140 CONTINUE
  97. 150 CONTINUE
  98. C
  99. C IGR2 = (I,J) -> (NBCOL,I,J)
  100. C
  101. DO 170 I=1,NBCO22
  102. DO 160 J=1,NBLG22
  103. ITVL((J-1)*NBLIG3*NBCOL3 + (I-1)*NBCOL3+NBCOL3+IGR3-1) =
  104. > IGR22((J-1)*NBCO22+I)
  105. 160 CONTINUE
  106. 170 CONTINUE
  107. C
  108. INDICE = NBCOOR + 1
  109. DO 190 I=1,(NBRAN3*NBCOL3*NBLIG3)
  110. IF( ITVL(IGR3+I-1).EQ.0 )THEN
  111. ITVL(IGR3+I-1) = INDICE
  112. INDICE = INDICE + 1
  113. ENDIF
  114. 190 CONTINUE
  115. C
  116. C ------------------------------------
  117. C --- 2.2 COLLAGE DES ARETES DU MAILLAGE ---
  118. C ------------------------------------
  119. C
  120. C --- ON PASSE SUR LA STRUCTURE MAILLAGE ---
  121. C
  122. IF(ITRACE.GT.0)THEN
  123. CALL ESECHA(1,'-> CONNECTIQUE GRILLE 3D ET COLLAGE',' ')
  124. CALL ESEINT(1,'COLONNES ',NBCOL3,1)
  125. CALL ESEINT(1,'LIGNES ',NBLIG3,1)
  126. CALL ESEINT(1,'RANGEES ',NBRAN3,1)
  127. CALL ESEINT(1,'A COLLER SUR LES ARETES 7,8,10 ET 2 ',
  128. > NARETE(1),4)
  129. ENDIF
  130. C
  131. CALL H8CRSP(NBCOL3-1,NBLIG3-1,NBRAN3-1,
  132. > ITRNOE,NBNMAX,NBE,NBP,iarr)
  133. C
  134. C --- 1.2 COLLAGE DES ARETES (SUR LE MAILLAGE !) ---
  135. C
  136. DO 10 I=1,4
  137. CALL G3GLKK(IARETE(I),NARETE(I),
  138. > (NBLIG3-1),(NBCOL3-1),(NBRAN3-1),
  139. > ITRNOE,NBNMAX,iarr)
  140. 10 CONTINUE
  141. IF( iarr.NE.0)THEN
  142. CALL DSERRE(1,iarr,'H8RCG2','APPEL G3GLKK')
  143. GOTO 9999
  144. ENDIF
  145. C
  146. C --- RENUMEROTATION DES NOEUDS DU MAILLAGE ---
  147. C PAR LES NOEUDS DE LA GRILLE
  148. C
  149. DO 5 I=1,NBE*NBNMAX
  150. IF(ITRNOE(I).GT.0)ITRNOE(I) = ITVL(IGR3+ITRNOE(I)-1)
  151. 5 CONTINUE
  152. C
  153. C ----------------------------
  154. C --- INTERPOLATION LINEAIRE POUR
  155. C COMPLETER LA GRILLE 3D ---
  156. C ----------------------------
  157. C
  158. INDXYZ = NBCOOR + 1
  159. IF(ITRACE.GT.0)
  160. > CALL ESECHA(1,'-> COORDONNEES GRILLE 3D ',' ')
  161. C
  162. C NRANAJ = NARETE(1)+NARETE(3)
  163. NRANAJ = NBCOL3 - 2
  164. XN = 1 - RAISON**(NRANAJ+1)
  165. IF((XN.LE.XYZEPS).AND.(XN.GE.-XYZEPS))THEN
  166. RAISON = 1.0
  167. XN = 1.0 / (NRANAJ + 1.0)
  168. ELSE
  169. XN = 1.0 / XN
  170. ENDIF
  171. C
  172. DO 100 I=1,NBLG11
  173. DO 90 J=1,NBCO11
  174. DO 80 K=1,NRANAJ
  175. C --- INTERPOLATION ENTRE LE PLAN IGR11 ET IGR22 ---
  176. NUM1 = IGR11((I-1)*NBCO11+J)
  177. NUM2 = IGR22((I-1)*NBCO11+J)
  178. IF( RAISON.EQ.1 )THEN
  179. COEF = K
  180. ELSE
  181. COEF = 1 - RAISON**K
  182. ENDIF
  183. DO 70 KK=1,IDIMC
  184. XO = COORD((NUM1-1)*IDIMC+KK)
  185. V12 = COORD((NUM2-1)*IDIMC+KK) - XO
  186. COORD((INDXYZ-1)*IDIMC+KK) = V12*XN*COEF + XO
  187. 70 CONTINUE
  188. INDXYZ = INDXYZ + 1
  189. 80 CONTINUE
  190. 90 CONTINUE
  191. 100 CONTINUE
  192. NBCOOR = INDXYZ - 1
  193. C
  194. C ============================
  195. C --- 3. COMPRESSION DES NOEUDS ---
  196. C ============================
  197. C
  198. IF( ICOMPR.EQ. 0 )GO TO 9999
  199. IF(ITRACE.GT.0)
  200. > CALL ESECHA(1,'* POST TRAITEMENT : ',' COMPRESSION ')
  201. C
  202. IDE = 3
  203. NBCMAX = 0
  204. ITRTRI = 0
  205. NOEMAX = 0
  206. NOETRI = 0
  207. NBENUL = NBE
  208. NBISOL = NBP
  209. CALL NUGCNU(IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  210. > NOETRI,NOEMAX,NBE,COORD,IDIMC,NBP,
  211. > ITVL,NITMAX,iarr)
  212. C
  213. IF(ITRACE.GT.0)THEN
  214. CALL ESECHA(1,'* MAILLAGE -> COMPRESSION ',' ')
  215. CALL ESEINT(1,'NOMBRE D ELEMENTS SUPPRIMES : ',NBENUL-NBE,1)
  216. CALL ESEINT(1,'NOMBRE DE POINTS SUPPRIMES : ',NBISOL-NBP,1)
  217. ENDIF
  218. C
  219. 9999 END
  220.  
  221.  
  222.  
  223.  

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