Télécharger la plaquette Cast3M


fr en

Télécharger g2polg.eso

Retour à la liste

Numérotation des lignes : 

g2polg

  1. C G2POLG    SOURCE    CHAT      05/01/13    00:15:12     5004
  2.       SUBROUTINE G2POLG(IGR1,NBLIG1,NBCOL1,
  3.      >                  NBAJ,INLGAJ,NBLGAJ,INDICE,INCREM,
  4.      >                  COORD,IDIMC)
  5. C     **********************************************************************
  6. C     OBJET G2POLG : AJOUTE DES POINTS SUR DES LIGNES D'UN TABLEAU
  7. C
  8. C
  9. C     EN ENTREE   :
  10. C       IGR1(NBLIG1,NBCOL1) : LE TABLEAU DES INDICES DES NOEUDS (DANS COORD)
  11. C
  12. C       NBAJ       : NOMBRE D'AJOUTS
  13. C       INLGAJ()   : TABLEAU DES POSITIONS D'AJOUT
  14. C       NBLGAJ(I)  : NOMBRE DE LIGNES A AJOUTER
  15. C                    AVANT INLGAJ(I) SI NEGATIF
  16. C                    APRES INLGAJ(I) SI POSITIF
  17. C
  18. C       COORD      : COORDONNEES DES NOEUDS (A COMPLETER)
  19. C       IDIMC      : DIMENSION DE L'ESPACE
  20. C       INDICE     : INDICE POUR REMPLIR COORD
  21. C                   (LES COORDONNEES NOUVEAUX POINTS)
  22. C       INCREM     : INCREMENT DE L'INDICE
  23. C
  24. C     EN SORTIE   :
  25. C       COORD     : LE TABLEAU AVEC LES POINTS SUPPLEMENTAIRES
  26. C       INDICE    : L'INDICE INCREMENTE
  27. C
  28. C     **********************************************************************
  29.       IMPLICIT INTEGER(I-N)
  30.       INTEGER IGR1(*),NBLIG1,NBCOL1
  31.       INTEGER NBAJ,INLGAJ(*),NBLGAJ(*),INDICE,INCREM
  32.       REAL*8    COORD(*)
  33.       INTEGER IDIMC
  34. C
  35.       INTEGER  ILGAJ,I,J,K,KK,NUM1,NUM2,NBCC
  36.       REAL*8     XN,XO,XE,V12
  37. C
  38.       ILGAJ = 1
  39.       DO 50 I=1,NBLIG1
  40. C
  41. C       --- ON AJOUTE DES LIGNES AVANT ---
  42. C
  43.         IF( I.EQ. -INLGAJ(ILGAJ) )THEN
  44.         IF((ILGAJ.GT.1).AND.
  45.      >     ((I-1).EQ.INLGAJ(ILGAJ-1)))THEN
  46.           NBCC = NBLGAJ(ILGAJ) + NBLGAJ(ILGAJ-1)
  47.         ELSE
  48.           NBCC = NBLGAJ(ILGAJ)
  49.         ENDIF
  50.         XN = 1.0 / (NBCC + 1.0)
  51.         DO 25 K=1,NBLGAJ(ILGAJ)
  52.           DO 20 J = 1,NBCOL1
  53. C           --- INTERPOLATION ENTRE LA LIGNE I-1 ET I ---
  54.             NUM1 = IGR1((I-2)*NBCOL1+J)
  55.             NUM2 = IGR1((I-1)*NBCOL1+J)
  56.             DO 15 KK=1,IDIMC
  57.               XO  = COORD((NUM1-1)*IDIMC+KK)
  58.               XE  = COORD((NUM2-1)*IDIMC+KK)
  59.               V12 = COORD((NUM2-1)*IDIMC+KK) - XO
  60.               COORD((INDICE-1)*IDIMC+KK) = XE -
  61.      >           (NBLGAJ(ILGAJ) -K + 1)*V12*XN
  62. C              COORD((INDICE-1)*IDIMC+KK) = V12*XN*K + XO
  63.    15       CONTINUE
  64.             INDICE = INDICE + INCREM
  65.    20     CONTINUE
  66.    25   CONTINUE
  67.           ILGAJ = ILGAJ+1
  68.         ENDIF
  69. C
  70. C       --- ON AJOUTE DES LIGNES APRES ---
  71. C
  72.         IF((NBAJ.GE.ILGAJ).AND.( I.EQ. INLGAJ(ILGAJ)))THEN
  73.         IF((NBAJ.GT.ILGAJ).AND.
  74.      >     ((I+1).EQ.-INLGAJ(ILGAJ+1)))THEN
  75.           NBCC = NBLGAJ(ILGAJ) + NBLGAJ(ILGAJ+1)
  76.         ELSE
  77.           NBCC = NBLGAJ(ILGAJ)
  78.         ENDIF
  79.         XN = 1.0 / (NBCC + 1.0)
  80.         DO 45 K=1,NBLGAJ(ILGAJ)
  81.           DO 40 J = 1,NBCOL1
  82. C           --- INTERPOLATION ENTRE LA LIGNE I ET I+1 ---
  83.             NUM1 = IGR1((I-1)*NBCOL1+J)
  84.             NUM2 = IGR1((I  )*NBCOL1+J)
  85.             DO 35 KK=1,IDIMC
  86.               XO  = COORD((NUM1-1)*IDIMC+KK)
  87.               V12 =  COORD((NUM2-1)*IDIMC+KK) - XO
  88.               COORD((INDICE-1)*IDIMC+KK) = V12*XN*K + XO
  89.    35       CONTINUE
  90.             INDICE = INDICE + INCREM
  91.    40     CONTINUE
  92.    45   CONTINUE
  93.           ILGAJ = ILGAJ+1
  94.         ENDIF
  95.    50 CONTINUE
  96. C
  97.  9999 END
  98.  
  99.  
  100.  

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