Download g2polg.eso

Back to the list

   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 :  

© Cast3M 2003 - All rights reserved.
Disclaimer