Télécharger la plaquette Cast3M


fr en

Télécharger g2polc.eso

Retour à la liste

Numérotation des lignes : 

g2polc

  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