Télécharger g2noq4.eso

Retour à la liste

Numérotation des lignes :

  1. C G2NOQ4 SOURCE CHAT 06/03/29 21:22:00 5360
  2. C
  3. C
  4. SUBROUTINE G2NOQ4( ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE,
  5. > INOGR,NBCOL,NBLIG,NNOMAX,iarr)
  6. C **********************************************************************
  7. C OBJET G2NOQ4 : CONSTRUIT LA GRILLE DES NOEUDS
  8. C
  9. C EN ENTREE :
  10. C ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE : UN MAILLAGE 2D
  11. C
  12. C INOGR : INDICE DES NOEUDS DE LA GRILLE (A REMPLIR)
  13. C NNOMAX : TAILLE DE INOGR
  14. C
  15. C ITVL(ITVMAX) : TABLEAU DE TRAVAIL (ENTIERS)
  16. C
  17. C EN SORTIE :
  18. C NBLIG,NBCOL : NOMBRE DE LIGNES ET DE COLONNES DE LA GRILLE
  19. C INOGR : INDICE DES NOEUDS DE LA GRILLE
  20. C INOGR((I-1)*NBCOL+J) = NOEUD DE LA COLONNE J
  21. C ET DE LA LIGNE I
  22. C iarr : 0 SI OK, -1 SI LES DONNEES SONT ERRONEES
  23. C
  24. C **********************************************************************
  25. IMPLICIT INTEGER(I-N)
  26. INTEGER ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX,NBE
  27. INTEGER INOGR(*),NBCOL,NBLIG,NNOMAX,iarr
  28. C
  29. INTEGER IEK(4),ICK(4),NKK,NN(4),NKKMAX
  30. INTEGER I,J,N1,N2,N3,N4,IECOL,ICCOL,IE,IC,IES,ICS
  31. C ========================
  32. C --------- 1. RECHERCHE DES COINS --------
  33. C ========================
  34. C
  35. NKKMAX = 4
  36. CALL G2KKM2( ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE,
  37. > NN,IEK,ICK,NKK,NKKMAX,iarr)
  38. IF( iarr.NE.0 )THEN
  39. CALL DSERRE(1,iarr,'G2NOQ4','APPEL G2KKM2')
  40. GOTO 9999
  41. ENDIF
  42. IF( NKK.NE.4 )THEN
  43. iarr = -1
  44. CALL DSERRE(1,iarr,'G2NOQ4','IL DOIT Y AVOIR 4 COINS')
  45. GOTO 9999
  46. ENDIF
  47. IF( (NN(1).NE.NN(3)).OR.(NN(2).NE.NN(4)) )THEN
  48. iarr = -1
  49. CALL DSERRE(1,iarr,'G2NOQ4',
  50. > ' LE NB DE SEGMENT DOIT ETRE EGAL SUR LES COTE OPPOSES')
  51. GOTO 9999
  52. ENDIF
  53. IF( (NN(1)*NN(2)).GT.NNOMAX )THEN
  54. iarr = -2
  55. CALL DSERRE(1,iarr,' G2NOQ4 ',' TROP DE POINTS')
  56. GOTO 9999
  57. ENDIF
  58. C =============================
  59. C --------- 2. REMPLISSAGE DE LA GRILLE --------
  60. C =============================
  61. NBCOL = NN(1)
  62. NBLIG = NN(2)
  63. IE = IEK(1)
  64. IC = ICK(1)
  65. DO 200 I=1,(NBLIG-1)
  66. C
  67. C ---- POUR CHAQUE LIGNE DE LA GRILLE ----
  68. C
  69. DO 100 J=1,(NBCOL-1)
  70. IF((IE.LE.0).OR.(IC.LE.0))THEN
  71. iarr = -1
  72. CALL DSERRE(1,iarr,'G2NOQ4',
  73. > ' LE MAILLAGE N A PAS LA STRUCTURE DE GRILLE')
  74. GOTO 9999
  75. ENDIF
  76. C
  77. C ----- PARCOURS DU Q4 ----
  78. C
  79. N1 = ITRNOE((IE-1)*NBNMAX+IC)
  80. IC = MOD(IC,NBCMAX) + 1
  81. N2 = ITRNOE((IE-1)*NBNMAX+IC)
  82. C ----- ELEMENT SUIVANT SUR LA MEME LIGNE ----
  83. CALL SESFR1(IE,IC,ITRTRI,NBCMAX,IES,ICS)
  84. ICS = MOD(ICS,NBCMAX) + 1
  85. C
  86. IC = MOD(IC,NBCMAX) + 1
  87. N3 = ITRNOE((IE-1)*NBNMAX+IC)
  88. C ----- PREMIER ELEMENT DE LA LIGNE SUIVANTE ----
  89. IF( J.EQ.1 )THEN
  90. CALL SESFR1(IE,IC,ITRTRI,NBCMAX,IECOL,ICCOL)
  91. ENDIF
  92. IC = MOD(IC,NBCMAX) + 1
  93. N4 = ITRNOE((IE-1)*NBNMAX+IC)
  94. C
  95. C ----- STOCKAGE DES NOEUDS ----
  96. C
  97. IF( I.EQ.1 )THEN
  98. INOGR((I-1)*NBCOL + J) = N1
  99. INOGR((I-1)*NBCOL + J + 1) = N2
  100. ELSE
  101. C --- ON VERIFIE L ADJACENCE DES LIGNES ---
  102. IF( (INOGR((I-1)*NBCOL + J) .NE.N1).OR.
  103. > (INOGR((I-1)*NBCOL + J + 1).NE.N2) )THEN
  104. iarr = -1
  105. CALL DSERRE(1,iarr,'G2NOQ4',
  106. > ' LES LIGNES NE SONT PAS ADJACENTES')
  107. GOTO 9999
  108. ENDIF
  109. ENDIF
  110. INOGR( I*NBCOL + J + 1) = N3
  111. INOGR( I*NBCOL + J ) = N4
  112. C ----- ON PASSE AU Q4 SUIVANT DANS LA LIGNE -----
  113. C
  114. IE = IES
  115. IC = ICS
  116. 100 CONTINUE
  117. C ----- ON PASSE A LA LIGNE SUIVANTE -----
  118. C
  119. IE = IECOL
  120. IC = ICCOL
  121. 200 CONTINUE
  122. GOTO 9999
  123. C
  124. C 8888 CALL DSERRE(1,iarr,' G2KKM2 ',' ')
  125. 9999 END
  126.  
  127.  
  128.  
  129.  

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