Télécharger la plaquette Cast3M


fr en

Télécharger g2poco.eso

Retour à la liste

Numérotation des lignes : 

g2poco

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

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