Télécharger g2polc.eso

Retour à la liste

Numérotation des lignes :

  1. C G2POLC SOURCE CHAT 06/03/29 21:22:18 5360
  2. C
  3. SUBROUTINE G2POLC(IGR1,NBLIG1,NBCOL1,
  4. > NBAJ,NBCOAJ,INCOAJ,NBLGAJ,INLGAJ,
  5. > INDICE,INCREM,COORD,NBCOOR,IDIMC,
  6. > ITVL,NITMAX,
  7. > IGR,NBLIG,NBCOL,iarr)
  8. C **********************************************************************
  9. C OBJET G2POLC : AJOUTE LIGNES ET COLONNES A UNE GRILLE GEOMETRIQUE
  10. C
  11. C EN ENTREE :
  12. C IGR1(NBCOL1,NBLIG1) : TABLEAU D'INDICES DES NOEUDS
  13. C IDIMC : DIMENSION DE L'ESPACE (=3)
  14. C COORD : TABLEAU DES COORDONNEES DES NOEUDS
  15. C NBCOOR: NOMBRE DE POINTS DANS LE TABLEAU COORD
  16. C
  17. C NBAJ(1) : NOMBRE D'AJOUTS DE COLONNES
  18. C INCOAJ() : TABLEAU DES POSITIONS D'AJOUT
  19. C NBCOAJ(I) : NOMBRE DE COLONNES A AJOUTER
  20. C AVANT INCOAJ(I) SI NEGATIF
  21. C APRES INCOAJ(I) SI POSITIF
  22. C NBAJ(2) : NOMBRE D'AJOUTS DE LIGNES
  23. C INLGAJ() : TABLEAU DES POSITIONS D'AJOUT
  24. C NBLGAJ(I) : NOMBRE DE LIGNES A AJOUTER
  25. C AVANT INLGAJ(I) SI NEGATIF
  26. C APRES INLGAJ(I) SI POSITIF
  27. C
  28. C INDICE : INDICE POUR REMPLIR LES NOUVELLES COLONNES
  29. C INCREM : INCREMENT DE L'INDICE
  30. C
  31. C ITVL : TABLEAU DE TRAVAIL (ENTIERS)
  32. C NITMAX: TAILLE DU TABLEAU ITVL
  33. C ON A BESOIN DU TABLEAU DE TRAVAIL SEULEMENT SI ON AJOUTE
  34. C SIMULTANEMENT DES LIGNES ET DES COLONNES. LA PLACE NECES-
  35. C SAIRE EST DE : (NBCOL1+NBCOAJ(i))*NBLIG1
  36. C
  37. C EN SORTIE :
  38. C IGR(NBCOL,NBLIG) : TABLEAU D'INDICES MODIFIES
  39. C COORD,NBCOOR : POINTS AJOUTES
  40. C
  41. C **********************************************************************
  42. IMPLICIT INTEGER(I-N)
  43. INTEGER IGR1(*),NBLIG1,NBCOL1
  44. INTEGER NBCOAJ(*),INCOAJ(*),NBLGAJ(*),INLGAJ(*),NBAJ(*)
  45. REAL*8 COORD(*)
  46. INTEGER INDICE,INCREM,IDIMC,NBCOOR,ITVL(*),NITMAX
  47. INTEGER IGR(*),NBLIG,NBCOL,iarr
  48. C
  49. INTEGER INDXYZ,I,IGR11,NBCO11,NBLG11,IOP
  50. C
  51. INDXYZ = INDICE
  52. NBCOL = NBCOL1
  53. NBLIG = NBLIG1
  54. IGR11 = 1
  55. C
  56. C ==============================
  57. C --- ON AJOUTE DES COLONNES A GR1 ---
  58. C ==============================
  59. C
  60. DO 10 I=1,NBAJ(1)
  61. NBCOL = NBCOL + NBCOAJ(I)
  62. 10 CONTINUE
  63. DO 20 I=1,NBAJ(2)
  64. NBLIG = NBLIG + NBLGAJ(I)
  65. 20 CONTINUE
  66. C
  67. IF( NBCOL.GT.NBCOL1 )THEN
  68. IF( NBLIG.GT.NBLIG1 )THEN
  69. C ---- ON A BESOIN D'UN TABLEAU TAMPON ----
  70. IF( NITMAX.LT. (IGR11-1+NBCOL*NBLIG1))THEN
  71. iarr = -2
  72. CALL DSERRE(1,iarr,'G2POLC',' POUR COMPLETER LA GRILLE ')
  73. CALL ESEINT(1,'PLACE NECESSAIRE ',NBCOL*NBLIG,1)
  74. GOTO 9999
  75. ENDIF
  76. CALL G2MOCO(IGR1,NBLIG1,NBCOL1,
  77. > NBAJ(1),INCOAJ,NBCOAJ,INDICE,INCREM,
  78. > ITVL(IGR11),NBLG11,NBCO11)
  79. ELSE
  80. CALL G2MOCO(IGR1,NBLIG1,NBCOL1,
  81. > NBAJ(1),INCOAJ,NBCOAJ,INDICE,INCREM,
  82. > IGR,NBLIG,NBCOL)
  83. ENDIF
  84. C
  85. CALL G2POCO(IGR1,NBLIG1,NBCOL1,
  86. > NBAJ(1),INCOAJ,NBCOAJ,INDXYZ,INCREM,
  87. > COORD,IDIMC)
  88. NBCOOR = INDXYZ - 1
  89. ENDIF
  90. C
  91. C ============================
  92. C --- ON AJOUTE DES LIGNES A GR1 ---
  93. C ============================
  94. C
  95. IF(NBLIG.EQ.NBLIG1)THEN
  96. IF(NBCOL.EQ.NBCOL1)THEN
  97. IOP = 1
  98. CALL G2COPY(IGR1,NBCOL1,NBLIG1,IOP,
  99. > IGR,NBCOL,NBLIG )
  100. ENDIF
  101. GOTO 9999
  102. ENDIF
  103. C
  104. IF( NBCOL.EQ.NBCOL1 ) THEN
  105. CALL G2MOLG(IGR1,NBLIG1,NBCOL1,
  106. > NBAJ(2),INLGAJ,NBLGAJ,INDICE,INCREM,
  107. > IGR,NBLIG,NBCOL)
  108. CALL G2POLG(IGR1,NBLIG1,NBCOL1,
  109. > NBAJ(2),INLGAJ,NBLGAJ,INDXYZ,INCREM,
  110. > COORD,IDIMC)
  111. ELSE
  112. CALL G2MOLG(ITVL(IGR11),NBLG11,NBCO11,
  113. > NBAJ(2),INLGAJ,NBLGAJ,INDICE,INCREM,
  114. > IGR,NBLIG,NBCOL)
  115. C CORRECTION BUG : IGR11 REMPLACE PAR ITVL(IGR11)
  116. CALL G2POLG(ITVL(IGR11),NBLG11,NBCO11,
  117. > NBAJ(2),INLGAJ,NBLGAJ,INDXYZ,INCREM,
  118. > COORD,IDIMC)
  119. ENDIF
  120. NBCOOR = INDXYZ - 1
  121. C
  122. 9999 END
  123.  
  124.  
  125.  
  126.  

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