Télécharger h8rcgg.eso

Retour à la liste

Numérotation des lignes :

h8rcgg
  1. C H8RCGG SOURCE CHAT 06/03/29 21:23:05 5360
  2. C **********************************************************************
  3. C FICHIER : GR3D_RACC.F
  4. C OBJET : RACCORD DE 2 MAILLAGES GRILLES.
  5. C FONCT. :
  6. C
  7. C OBJET H8RCGG : MAILLAGE H8 RACCORDANT 2 GRILLES COMPATIBLES
  8. C OBJET EN 2 COUCHES MINI.(NBCOL2 >= NBCOL1,NBLIG2 >= NBLIG1)
  9. C OBJET H8RCG2 : MAILLAGE H8 RACCORDANT 2 GRILLES COMPATIBLES
  10. C OBJET EN 1 COUCHE MINI.(NBCOL2 >= NBCOL1,NBLIG2 <= NBLIG1)
  11. C OBJET H8RCGI : MAILLAGE H8 S'APPUYANT 2 GRILLES IDENTIQUES
  12. C
  13. C AUTEUR : O. STAB
  14. C DATE : 06.96
  15. C MODIFICATIONS :
  16. C AUTEUR, DATE, OBJET :
  17. C
  18. C
  19. C **********************************************************************
  20. C
  21. SUBROUTINE H8RCGG(IGR1,NBLIG1,NBCOL1,
  22. > IGR2,NBLIG2,NBCOL2,COORD,NBCOOR,IDIMC,NBCOUC,RAISON,
  23. > ITVL,NITMAX,
  24. > ITRNOE,NBNMAX,NBE,NBP,
  25. > NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr)
  26. C **********************************************************************
  27. C OBJET H8RCGG : MAILLAGE H8 RACCORDANT 2 GRILLES COMPATIBLES
  28. C OBJET EN 2 COUCHES MINI.(NBCOL2 >= NBCOL1,NBLIG2 >= NBLIG1)
  29. C
  30. C LES GRILLES IGR1 ET IGR2 SONT ORIENTEES DE LA MEME FACON
  31. C AVEC UNE ORIGINE COMPATIBLE IGR1(1) CORRESPOND A IGR2(1)
  32. C
  33. C APPELS : H8RCG2
  34. C
  35. C EN ENTREE :
  36. C
  37. C IGR1,NBLIG1,NBCOL1 : LA PREMIERE GRILLE
  38. C IGR CONTIENT LES NUMEROS DES NOEUDS
  39. C IGR2,NBLIG2,NBCOL2 : LA DEUXIEME GRILLE
  40. C NBCOUC : NOMBRE DE COUCHES SUPPLEMENTAIRES
  41. C (PAR DEFAUT 1 SEULE COUCHE)
  42. C
  43. C COORD,IDIMC : POSITION DES NOEUDS
  44. C
  45. C ITVL : TABLEAU D'ENTIERS POUR LES CALCULS
  46. C NITMAX : TAILLE DE ITVL, LA PLACE NECESSAIRE EST DE
  47. C 2*NBCOL1*NBLIG2 POUR LA GRILLE INTERMEDIAIRE
  48. C + NBLIG1*NBCOL2*NBRAN
  49. C SI ICOMPR != 0 IL FAUT AJOUTER :
  50. C NBLIG3*NBCOL3*(NBRAN3-2) + NBCOOR
  51. C AVEC NBRAN = (3+NBCOUC+NBCOL2+NBLIG2-NBCOL1-NBLIG1)
  52. C
  53. C ITRNOE : TABLEAU DES ELEMENTS (A REMPLIR)
  54. C NBEMAX : NOMBRE MAXIMUM D'ELEMENTS
  55. C NBNMAX : NOMBRE MAXIMUM DE NOEUDS (LIE A LA TAILLE DE COORD)
  56. C
  57. C ICOMPR : FLAG DE COMPRESSION
  58. C ICOMPR = 0 LES NOEUDS ISOLES NE SONT PAS SUPPRIMES
  59. C LES ELEMENTS NULS " " " "
  60. C
  61. C EN SORTIE :
  62. C
  63. C ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE,NBP : LE MAILLAGE RESULTANT
  64. C iarr : CODE D'ERREUR -1 SI DONNEES INCORRECTES
  65. C -2 SI TABLEAUX INSUFFISANTS
  66. C
  67. C REMARQUE : L'ALGORITHME GENERE LES NOEUDS D'UNE GRILLE COMPLETE
  68. C APRES LE COUPER-COLLER CERTAIN NOEUDS DEVIENDRONT ISOLES
  69. C ET CERTAIN ELEMENTS SERONT NON VALIDES (NULS).
  70. C LE FLAG "ICOMPR" PERMET DE LES SUPPRIMER
  71. C **********************************************************************
  72. IMPLICIT INTEGER(I-N)
  73. INTEGER IGR1(*),NBLIG1,NBCOL1
  74. INTEGER IGR2(*),NBLIG2,NBCOL2
  75. REAL*8 COORD(*),RAISON,XYZEPS
  76. INTEGER IDIMC,NBCOOR,NBCOUC,ITVL(*),NITMAX
  77. INTEGER ITRNOE(*),NBNMAX,NBE,NBP
  78. INTEGER NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr
  79. C
  80. C COMMON /CGEPSI/ XYZHUG,XYZMIN,XYZEPS
  81. CS REAL*8 XYZHUG,XYZMIN,XYZEPS
  82. C
  83. INTEGER NBLIG3,NBCOL3,NBRAN3,NBEGEN,NBPGEN
  84. INTEGER IGR3,ITRAV,ITRVMX,INDICE,ITRNO3,NBE3
  85. INTEGER NBCOU1,NBCOU2
  86. REAL*8 RAPP,CNDELG,CNDECO,RAISO3,RBCOU1,RBCOU2,UNR
  87. C
  88. C -----------------------------------
  89. C --- EVALUATION DE LA PLACE NECESSAIRE ---
  90. C -----------------------------------
  91. XYZEPS=1.d-10
  92. NBLIG3 = NBCOL1
  93. NBCOL3 = (NBLIG2-NBLIG1)/2 +2+NBCOUC-1
  94. NBRAN3 = NBLIG2
  95. C
  96. NBEGEN = (NBLIG3-1)*(NBCOL3-1)*(NBRAN3-1)
  97. NBPGEN = NBLIG3*NBCOL3*NBRAN3
  98. C
  99. NBLIG3 = NBCOL2
  100. NBCOL3 = (NBCOL2-NBCOL1)/2 +2+NBCOUC-1
  101. NBRAN3 = NBLIG2
  102. C
  103. NBEGEN = (NBLIG3-1)*(NBCOL3-1)*(NBRAN3-1) + NBEGEN
  104. NBPGEN = NBLIG3*NBCOL3*NBRAN3 + NBPGEN
  105. C
  106. C --- MAILLAGE EN H8 ---
  107. C
  108. IF((NBEMAX.LT.NBEGEN).OR.(NBPMAX.LT.NBPGEN))THEN
  109. iarr = -2
  110. GOTO 9999
  111. ENDIF
  112. C
  113. IGR3 = 1
  114. C ITRAV = NBCOL2*NBLIG1 + IGR3
  115. C
  116. C BUG18 : PLACE INSUFISANTE - CORRECT 17.03.97 O.STAB
  117. C
  118. ITRAV = MAX(NBCOL2*NBLIG1,NBCOL1*NBLIG2) + IGR3
  119. ITRVMX = NITMAX - ITRAV
  120. INDICE = NBCOOR + 1
  121. C --- IGR1 -> IGR3 AUGMENTANT LES LIGNES ---
  122. C
  123. C ===============================
  124. C ---- REPARTITION SUR LES 2 COUCHES ----
  125. C ===============================
  126. C
  127. C CNBCO = (NBCOL2 - NBCOL1 )/2 + 1
  128. C CNBLG = (NBLIG2 - NBLIG1 )/2 + 1
  129. C RAPP = CNBLG / (CNBLG+CNBCO)
  130. C
  131. CNDELG = (NBLIG2 - NBLIG1)/2.0 + 1.0
  132. CNDECO = (NBCOL2 - NBCOL1)/2.0 + 1.0
  133. UNR = 1.0
  134. RBCOU1 = MAX((NBCOUC*CNDELG)/(CNDELG+CNDECO), UNR)
  135. RBCOU2 = MAX((NBCOUC*CNDECO)/(CNDELG+CNDECO), UNR)
  136. NBCOU1 = NINT(RBCOU1)
  137. NBCOU2 = NINT(RBCOU2)
  138. C
  139. RAPP = 1. - RAISON**(NBCOU1+NBCOU2)
  140. IF((RAPP.LE.XYZEPS).AND.(RAPP.GE.-XYZEPS))THEN
  141. C RAPP = N1 / (N1 + N2)
  142. RAPP = CNDELG / (CNDELG+CNDECO)
  143. C RAISO3 = RAISON
  144. ELSE
  145. RAPP =(1.-RAISON**NBCOU1)/(1.-RAISON**(NBCOU1+NBCOU2))
  146. C RAISO3 = RAISON**NBCOU1
  147. ENDIF
  148. RAISO3 = RAISON
  149. C
  150. CALL G2LLG2(IGR1,NBLIG1,NBCOL1,
  151. > IGR2,NBLIG2,NBCOL2,
  152. > COORD,NBCOOR,IDIMC,INDICE,RAPP,
  153. > ITVL(ITRAV),ITRVMX,
  154. > ITVL(IGR3),NBLIG3,NBCOL3,ITRACE,iarr)
  155. C
  156. IF(iarr.NE.0)THEN
  157. CALL DSERRE(1,iarr,'ESG3CR',' APPEL G2LLG2')
  158. GOTO 9999
  159. ENDIF
  160. C
  161. IF(ITRACE.GT.0)THEN
  162. CALL ESECHA(1,'-> GRILLE INTERMEDIAIRE ',' ')
  163. CALL ESEINT(1,'COLONNES : ',NBCOL3,1)
  164. CALL ESEINT(1,'LIGNES : ',NBLIG3,1)
  165. CALL ESEINT(1,'NOEUDS GENERES : ',INDICE - 1 - NBCOOR,1)
  166. ENDIF
  167. NBCOOR = INDICE - 1
  168. C
  169. IF(ITRACE.GT.0)CALL ESECHA(1,' PREMIERE COUCHE : ',' ')
  170. ITRVMX = NITMAX - ITRAV
  171. RAISO3 = 1.0 / RAISON
  172. CALL H8RCG2(ITVL(IGR3),NBLIG3,NBCOL3,
  173. > IGR1,NBLIG1,NBCOL1,
  174. > COORD,NBCOOR,IDIMC,NBCOU1,RAISO3,
  175. > ITVL(ITRAV),ITRVMX,
  176. > ITRNOE,NBNMAX,NBE,NBP,
  177. > NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr)
  178. C
  179. IF(ITRACE.GT.0)CALL ESECHA(1,' DEUXIEME COUCHE : ',' ')
  180. ITRNO3 = NBNMAX*NBE + 1
  181. RAISO3 = RAISON
  182. CALL H8RCG2(ITVL(IGR3),NBLIG3,NBCOL3,
  183. > IGR2,NBLIG2,NBCOL2,
  184. > COORD,NBCOOR,IDIMC,NBCOU2,RAISO3,
  185. > ITVL(ITRAV),ITRVMX,
  186. > ITRNOE(ITRNO3),NBNMAX,NBE3,NBP,
  187. > NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr)
  188. NBE = NBE + NBE3
  189. C
  190. 9999 END
  191.  
  192.  
  193.  
  194.  

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