Télécharger g2kkm2.eso

Retour à la liste

Numérotation des lignes :

  1. C G2KKM2 SOURCE CHAT 06/03/29 21:21:45 5360
  2. C
  3. C **********************************************************************
  4. C FICHIER : GR2D_INTERFACE.F
  5. C
  6. C RECONNAISSANCE D'UN MAILLAGE DE TYPE GRILLE
  7. C INTERFACE MAILLAGE ET GRILLE
  8. C
  9. C OBJET :
  10. C
  11. C OBJET G2KKM2 : IDENTIFIE LES COINS DANS UN MAILLAGE 2D
  12. C OBJET G2NOQ4 : CONSTRUIT LA GRILLE DES NOEUDS
  13. C OBJET G2ORQ4 : CREATION D'UNE GRILLE ORIENTE A PARTIR D'UN MAILLAGE
  14. C OBJET Q4ORG2 : TRANSFORME 2 MAILLAGES Q4 EN 2 GRILLES COMPATIBLES
  15. C
  16. C AUTEUR : O. STAB
  17. C DATE : 06.96
  18. C MODIFICATIONS :
  19. C AUTEUR, DATE, OBJET :
  20. C
  21. C
  22. C **********************************************************************
  23. C
  24. C
  25. SUBROUTINE G2KKM2( ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE,
  26. > NN,IEK,ICK,NKK,NKKMAX,iarr)
  27. C **********************************************************************
  28. C OBJET G2KKM2 : IDENTIFIE LES COINS DANS UN MAILLAGE 2D
  29. C
  30. C EN ENTREE :
  31. C ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE : UN MAILLAGE 2D
  32. C NKKMAX : NOMBRE MAXIMUM DE COINS
  33. C
  34. C EN SORTIE :
  35. C NN : NOMBRE DE NOEUDS ENTRE 2 COINS
  36. C (IEK,ICK)(I) --- NN(I) --- (IEK,ICK)(I+1)
  37. C (IEK,ICK) : INDICE DES COINS = ITRNOE((IEK-1)*NBNMAX+ICK)
  38. C
  39. C NKK : NOMBRE DE COINS
  40. C iarr : 0 SI OK, -1 SI LES DONNEES SONT ERRONEES
  41. C
  42. C REMARQUE : FONCTIONNE SUR DES MAILLAGE MIXTES
  43. C
  44. C **********************************************************************
  45. IMPLICIT INTEGER(I-N)
  46. INTEGER ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX,NBE
  47. INTEGER NN(*),IEK(*),ICK(*),NKK,NKKMAX,iarr
  48. C
  49. INTEGER I,IE,IC,NBC,J,IES,ICS,IDEB
  50. INTEGER STRNBN
  51. EXTERNAL STRNBN
  52. C
  53. C --------- INITIALISATION ------------------
  54. DO 10 I=1,NKKMAX
  55. NN(I) = 0
  56. IEK(I) = 0
  57. ICK(I) = 0
  58. 10 CONTINUE
  59. NKK = 0
  60. C
  61. C --------- 1. RECHERCHE D'UN ELEMENT DE LA FRONTIERE --------
  62. IE = 0
  63. 20 IE = IE + 1
  64. IF(IE.GT.NBE)THEN
  65. iarr = -1
  66. CALL DSERRE(1,iarr,' G2KKM2 ',
  67. > ' ON NE TROUVE PAS DE FRONTIERE SUR LES NBE ELEMENTS ')
  68. GOTO 9999
  69. ENDIF
  70. NBC = STRNBN(IE,ITRNOE,NBNMAX)
  71. IC = 0
  72. DO 30 J=1,NBC
  73. IF(ITRTRI((IE-1)*NBCMAX+J).EQ.0)IC = J
  74. 30 CONTINUE
  75. IF( IC.EQ.0 )GOTO 20
  76. C
  77. C --------- 2. PARCOURS DE LA FRONTIERE -------
  78. C
  79. IDEB = IE
  80. C --- 1. UN ELEMENT AVEC UNE ARETE FRONTIERE ---
  81. C ON PASSE A L'ARETE SUIVANTE PUIS SUR L'ELEMENT
  82. C
  83. 100 NBC = STRNBN(IE,ITRNOE,NBNMAX)
  84. IC = MOD(IC,NBC) + 1
  85. CALL SESFR1(IE,IC,ITRTRI,NBCMAX,IES,ICS)
  86. IF(NKK.NE.0)NN(NKK) = NN(NKK) + 1
  87. C
  88. C --- UN COIN TOPOLOGIQUE ---
  89. IF( IES.EQ.0 )THEN
  90. C --- ON RETROUVE LE PREMIER COIN ---
  91. C IF( IKK(1).EQ.ITRNOE((IE-1)*NBNMAX+IC))GOTO 9999
  92. IF( ITRNOE((IEK(1)-1)*NBNMAX+ICK(1)).EQ.
  93. > ITRNOE((IE-1)*NBNMAX+IC) )GOTO 9999
  94. NKK = NKK + 1
  95. IEK(NKK) = IE
  96. ICK(NKK) = IC
  97. C IKK(NKK) = ITRNOE((IE-1)*NBNMAX+IC)
  98. NN(NKK) = 1
  99. ICS = IC
  100. C ICS = MOD(IC,NBCMAX) + 1
  101. IES = IE
  102. ELSE
  103. C --- ON PASSE SUR L'ARETE DE FRONTIERE ---
  104. ICS = MOD(ICS,NBCMAX) + 1
  105. ENDIF
  106. C
  107. IF(ITRTRI((IES-1)*NBCMAX+ICS).NE.0)THEN
  108. iarr = -1
  109. CALL DSERRE(1,iarr,' G2KKM2 ',
  110. > ' ON A PERDU LA FRONTIERE ')
  111. GOTO 9999
  112. ENDIF
  113. IE = IES
  114. IC = ICS
  115. C --- IL N'Y A PAS DE COIN : POUR EVITER LES BOUCLES ---
  116. IF((IE.EQ.IDEB).AND.(NKK.EQ.0))GOTO 9999
  117. C
  118. GOTO 100
  119. C
  120. 9999 END
  121.  
  122.  
  123.  
  124.  

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