Télécharger h8rcg2.eso

Retour à la liste

Numérotation des lignes :

  1. C H8RCG2 SOURCE CHAT 06/03/29 21:23:00 5360
  2. C
  3. C
  4. C
  5. SUBROUTINE H8RCG2(IGR1,NBLIG1,NBCOL1,
  6. > IGR2,NBLIG2,NBCOL2,COORD,NBCOOR,IDIMC,NBCOUC,RAISON,
  7. > ITVL,NITMAX,
  8. > ITRNOE,NBNMAX,NBE,NBP,
  9. > NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr)
  10. C **********************************************************************
  11. C OBJET H8RCG2 : MAILLAGE H8 RACCORDANT 2 GRILLES COMPATIBLES
  12. C OBJET EN 1 COUCHE MINI.(NBCOL2 >= NBCOL1,NBLIG2 <= NBLIG1)
  13. C
  14. C LES GRILLES IGR1 ET IGR2 SONT ORIENTEES DE LA MEME FACON
  15. C AVEC UNE ORIGINE COMPATIBLE IGR1(1) CORRESPOND A IGR2(1)
  16. C ET AVEC NBCOL2 >= NBCOL1 ET NBLIG2 <= NBLIG1
  17. C
  18. C APPELS : H8RCGI
  19. C
  20. C EN ENTREE :
  21. C
  22. C IGR1,NBLIG1,NBCOL1 : LA PREMIERE GRILLE
  23. C IGR CONTIENT LES NUMEROS DES NOEUDS
  24. C IGR2,NBLIG2,NBCOL2 : LA DEUXIEME GRILLE
  25. C NBCOUC : NOMBRE DE COUCHES SUPPLEMENTAIRES
  26. C (PAR DEFAUT 1 SEULE COUCHE)
  27. C
  28. C COORD,IDIMC : POSITION DES NOEUDS
  29. C
  30. C ITVL : TABLEAU D'ENTIERS POUR LES CALCULS
  31. C NITMAX : TAILLE DE ITVL, LA PLACE NECESSAIRE EST DE
  32. C NBLIG1*NBCOL2*NBRAN SI ICOMPR= 0
  33. C SINON IL FAUT AJOUTER : NBLIG3*NBCOL3*(NBRAN3-2) + NBCOOR
  34. C AVEC NBRAN = (3+NBCOUC+NBCOL2+NBLIG2-NBCOL1-NBLIG1)
  35. C
  36. C ITRNOE : TABLEAU DES ELEMENTS (A REMPLIR)
  37. C NBEMAX : NOMBRE MAXIMUM D'ELEMENTS
  38. C NBNMAX : NOMBRE MAXIMUM DE NOEUDS (LIE A LA TAILLE DE COORD)
  39. C
  40. C ICOMPR : FLAG DE COMPRESSION
  41. C ICOMPR = 0 LES NOEUDS ISOLES NE SONT PAS SUPPRIMES
  42. C LES ELEMENTS NULS " " " "
  43. C
  44. C EN SORTIE :
  45. C
  46. C ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE,NBP : LE MAILLAGE RESULTANT
  47. C iarr : CODE D'ERREUR -1 SI DONNEES INCORRECTES
  48. C -2 SI TABLEAUX INSUFFISANTS
  49. C
  50. C REMARQUE : L'ALGORITHME GENERE LES NOEUDS D'UNE GRILLE COMPLETE
  51. C APRES LE COUPER-COLLER CERTAIN NOEUDS DEVIENDRONT ISOLES
  52. C ET CERTAIN ELEMENTS SERONT NON VALIDES (NULS).
  53. C LE FLAG "ICOMPR" PERMET DE LES SUPPRIMER
  54. C **********************************************************************
  55. IMPLICIT INTEGER(I-N)
  56. INTEGER IGR1(*),NBLIG1,NBCOL1
  57. INTEGER IGR2(*),NBLIG2,NBCOL2
  58. REAL*8 COORD(*),RAISON
  59. INTEGER IDIMC,NBCOOR,NBCOUC,ITVL(*),NITMAX
  60. INTEGER ITRNOE(*),NBNMAX,NBE,NBP
  61. INTEGER NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr
  62. C
  63. INTEGER NBCO11,NBCO22,NBCOL3,NBLG11,NBLG22,NBLIG3,NBRAN3
  64. INTEGER IGR11,IGR22
  65. INTEGER IARETE(4),NARETE(4)
  66. INTEGER INDICE,INCREM
  67. INTEGER NBCOAJ(2),INCOAJ(2),NBLGAJ(2),INLGAJ(2),NBAJ(2)
  68. INTEGER ITRAV
  69. C
  70. C ===============================================
  71. C --- 0. VERIFICATIONS DES CONDITIONS D'APPLICATION ---
  72. C ===============================================
  73. NBE = 0
  74. IF((NBCOL1.GT.NBCOL2).OR.(NBLIG2.GT.NBLIG1))THEN
  75. iarr = -1
  76. CALL DSERRE(1,iarr,'H8RCG2',' INVERSER LES 2 GRILLES ')
  77. GOTO 9999
  78. ENDIF
  79. C
  80. IF( ( MOD(NBCOL1+NBCOL2,2).NE.0 ).OR.
  81. > ( MOD(NBLIG1+NBLIG2,2).NE.0 ))THEN
  82. iarr = -1
  83. CALL DSERRE(1,iarr,'H8RCG2',
  84. > ' PARITE : UNE COUCHE INSUFFISANTE ')
  85. GOTO 9999
  86. ENDIF
  87. C
  88. IF(((NBCOL1.LT.NBCOL2).AND.(NBLIG1.LT.NBLIG2)).OR.
  89. > ((NBCOL1.GT.NBCOL2).AND.(NBLIG1.GT.NBLIG2)))THEN
  90. iarr = -1
  91. CALL DSERRE(1,iarr,'H8RCG2',' DEUX COUCHES NECESSAIRES ')
  92. GOTO 9999
  93. ENDIF
  94. C
  95. IARETE(1) = 7
  96. IARETE(2) = 8
  97. IARETE(3) = 10
  98. IARETE(4) = 2
  99. NARETE(1) = ( NBCOL2 - NBCOL1 ) / 2
  100. NARETE(2) = ( NBCOL2 - NBCOL1 ) / 2
  101. NARETE(3) = ( NBLIG1 - NBLIG2 ) / 2
  102. NARETE(4) = ( NBLIG1 - NBLIG2 ) / 2
  103. C
  104. NBLIG3 = NBCOL2
  105. NBCOL3 = NARETE(1)+NARETE(3)+2 +NBCOUC-1
  106. NBRAN3 = NBLIG1
  107. C
  108. NBE = (NBLIG3-1)*(NBCOL3-1)*(NBRAN3-1)
  109. NBP = NBLIG3*NBCOL3*NBRAN3
  110. IF((NBEMAX.LT.NBE).OR.(NBPMAX.LT.NBP))THEN
  111. iarr = -2
  112. CALL DSERRE(1,iarr,'H8RCG2',' POUR LE MAILLAGE 3D ')
  113. CALL ESEINT(1,'PLACE NECESSAIRE POUR LES ELEMENTS',NBEMAX,1)
  114. CALL ESEINT(1,'PLACE NECESSAIRE POUR LES NOEUDS',NBPMAX,1)
  115. GOTO 9999
  116. ENDIF
  117. C ============================
  118. C --- 1. CREATION DES GRILLES 2D ---
  119. C ============================
  120. C -------------------------------------
  121. C --- ON COMPLETE LES GRILLES A RACCORDER ---
  122. C -------------------------------------
  123. C (NBLIG1',NBCOL1') = (NBLIG2',NBCOL2')
  124. C
  125. IF(ITRACE.GT.0)
  126. > CALL ESECHA(1,'1. ON COMPLETE DES GRILLES SURFACIQUES : ',' ')
  127. C
  128. INDICE = NBCOOR+1
  129. INCREM = 1
  130. IF(ITRACE.GT.0)THEN
  131. CALL ESECHA(1,'-> NOUVEAUX NOEUDS',' ')
  132. CALL ESEINT(1,'A PARTIR DU NUMERO ',INDICE,1)
  133. ENDIF
  134. C
  135. C --- ON AJOUTE DES COLONNES A GR1 ---
  136. C
  137. NBAJ(1) = 2
  138. NBAJ(2) = 0
  139. INCOAJ(1) = 1
  140. NBCOAJ(1) = (NBCOL2-NBCOL1) / 2
  141. NBCOAJ(2) = (NBCOL2-NBCOL1) / 2
  142. INCOAJ(2) = -NBCOL1
  143. C
  144. IGR11 = 1
  145. ITRAV = 1
  146. IF( NITMAX.LT. (IGR11-1+ NBCOL2*NBLIG1))THEN
  147. iarr = -2
  148. CALL DSERRE(1,iarr,'H8RCG2',' POUR COMPLETER LA GRILLE ')
  149. CALL ESEINT(1,'PLACE NECESSAIRE ',NBCOL2*NBLIG1,1)
  150. GOTO 9999
  151. ENDIF
  152. C
  153. CALL G2POLC(IGR1,NBLIG1,NBCOL1,
  154. > NBAJ,NBCOAJ,INCOAJ,NBLGAJ,INLGAJ,
  155. > INDICE,INCREM,COORD,NBCOOR,IDIMC,
  156. > ITVL(ITRAV),0,
  157. > ITVL(IGR11),NBLG11,NBCO11,iarr)
  158. IF(iarr.NE.0)THEN
  159. CALL DSERRE(1,iarr,'H8RCG2',' APPEL G2POLC ')
  160. GOTO 9999
  161. ENDIF
  162. C
  163. IF(ITRACE.GT.0)THEN
  164. CALL ESECHA(1,'-> GRILLE 1 COMPLETEE',' ')
  165. CALL ESEINT(1,'COLONNES ',NBCO11,1)
  166. CALL ESEINT(1,'LIGNES ',NBLG11,1)
  167. ENDIF
  168. C
  169. C --- ON AJOUTE DES LIGNES A GR2 ---
  170. C
  171. NBAJ(1) = 0
  172. NBAJ(2) = 2
  173. INLGAJ(1) = 1
  174. NBLGAJ(1) = (NBLIG1-NBLIG2) / 2
  175. NBLGAJ(2) = (NBLIG1-NBLIG2) / 2
  176. INLGAJ(2) = -NBLIG2
  177. C
  178. IGR22 = IGR11 + NBLIG1*NBCOL2
  179. IF( NITMAX.LT. (IGR22-1+ NBLIG1*NBCOL2))THEN
  180. iarr = -2
  181. CALL DSERRE(1,iarr,'H8RCG2',' POUR COMPLETER LA GRILLE ')
  182. CALL ESEINT(1,'PLACE NECESSAIRE ',
  183. > IGR22-1+NBLIG1*NBCOL2,1)
  184. GOTO 9999
  185. ENDIF
  186. C
  187. CALL G2POLC(IGR2,NBLIG2,NBCOL2,
  188. > NBAJ,NBCOAJ,INCOAJ,NBLGAJ,INLGAJ,
  189. > INDICE,INCREM,COORD,NBCOOR,IDIMC,
  190. > ITVL(ITRAV),0,
  191. > ITVL(IGR22),NBLG22,NBCO22,iarr)
  192. IF(iarr.NE.0)THEN
  193. CALL DSERRE(1,iarr,'H8RCG2',' APPEL G2POLC ')
  194. GOTO 9999
  195. ENDIF
  196. C
  197. IF(ITRACE.GT.0)THEN
  198. CALL ESECHA(1,'-> GRILLE 2 COMPLETEE',' ')
  199. CALL ESEINT(1,'COLONNES ',NBCO22,1)
  200. CALL ESEINT(1,'LIGNES ',NBLG22,1)
  201. ENDIF
  202. C ============================
  203. C --- 2. CREATION DU RACCORD 3D ---
  204. C ============================
  205. C
  206. NBCOOR = INDICE - 1
  207. ITRAV = IGR22 + NBLIG1*NBCOL2
  208. IF( NBLIG3*NBCOL3*NBRAN3 .GT. (NITMAX-ITRAV+1))THEN
  209. iarr = -2
  210. CALL DSERRE(1,iarr,'H8RCG2',' POUR LE RACCORD ')
  211. CALL ESEINT(1,'PLACE NECESSAIRE ',
  212. > NBLIG3*NBCOL3*NBRAN3+ITRAV,1)
  213. GOTO 9999
  214. ENDIF
  215. CALL H8RCGI(ITVL(IGR11),NBLG11,NBCO11,
  216. > ITVL(IGR22),NBLG22,NBCO22,
  217. > COORD,NBCOOR,IDIMC,NBCOUC,RAISON,
  218. > NBLIG3,NBCOL3,NBRAN3,IARETE,NARETE,
  219. > ITVL(ITRAV),(NITMAX-ITRAV+1),
  220. > ITRNOE,NBNMAX,NBE,NBP,
  221. > NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr)
  222. C
  223. C
  224. 9999 END
  225.  
  226.  
  227.  
  228.  

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