Sources Esope | Cast3M

shpoly
C SHPOLY    SOURCE    CHAT      05/01/13    03:15:46     5004
C SHAPE     SOURCE    BALD      96/02/07    21:19:39     2024
      SUBROUTINE SHPOLY(QSI,ETA,DZE,NUPT,MELE,SHP,IRET)
C=======================================================================
C
C     FONCTIONS DE FORME ET LEUR DERIVEES
C
C=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C    Include contenant quelques constantes dont XPI :
-INC CCREEL
      DIMENSION SHP(6,*)
C
C     DISTANCE DES POINTS A UN POLYGONE A N COTES
C
      REAL*8 DIST(14)
      REAL*8 DDISDQ(14)
      REAL*8 DDISDE(14)
      REAL*8 NUMER(14)
      REAL*8 DNUMDQ(14)
      REAL*8 DNUMDE(14)
      INTEGER NBNO(111:122)
C
C     NOMBRE DE NOEUDS EN FONCTION DU NUMERO D'ELEMENT
C
      DATA NBNO/3,4,5,6,7,8,9,10,11,12,13,14/
C
C=======================================================================
C     QSI ETA DZE COORDONNEES REDUITES DU POINT DE GAUSS
C     NUPT NUMERO DU POINT DE GAUSS
C
C     SHP FONCTIONS DE FORME SHP(1,INO) FONCTIONS DE FORME DU ND INO
C                            SHP(2,INO) DERIVEES PR RPPRT A QSI
C                            SHP(3,INO) DERIVEES PR RPPRT A ETA
C                            SHP(4,INO) DERIVEES PR RPPRT A DZE
C                            SHP(5,INO) DERIVEES PR RPPRT A 4
C                               COORDONNEES BARYCENTRIQUES
C     CAS DE DIMENSION 1
C               2 OU 3 NOEUDS LIGNE
C               2 NOEUDS POLYNOME DE HERMITE ET DERIVEES
C     CAS DE DIMENSION 2
C               3 OU 6 NOEUDS TRIANGLE
C               4 OU 8 NOEUDS QUADRILATERE
C               9 NOEUDS QUADRILATERE
C               N NOEUDS POLYGONE A N COTES
C     CAS DE DIMENSION 3 FAIT DANS SHAPE3    ETIQUETTE 50
C               4 OU 10 NOEUDS TETRAEDRE
C               5 OU 13 NOEUDS PYRAMIDE
C               6 OU 15 NOEUDS PRISME
C               8 OU 20 NOEUDS CUBE
C=======================================================================
      IRET=1
C
C     FONCTIONS DE FORME BIDIMENSIONNELLES
C
C     FONCTIONS DE POYGONE A N NOEUDS
C
      N = NBNO(MELE)
C
C     CALCUL DES DISTANCES ET DES DERIVEES DU POINT AUX COTES DU POLYGONE
C
      COPISN = COS (XPI/N)
C
      DO 1010, I = 1, N
C
         ALPHA = 2*XPI*(I-1)/N
         COSIN = COS(ALPHA)
         SINUS = SIN(ALPHA)
C
         DIST(I) = COPISN - QSI * COSIN - ETA * SINUS
         DDISDQ(I) = - COSIN
         DDISDE(I) = - SINUS
C
 1010 CONTINUE
C
C     CALCUL DES NUMERATEURS ET DENOMINATEUR DES FRACTIONS RATIONNELLES ET DERIVEES
C
      DENOM  = 0.D0
      DDENDQ = 0.D0
      DDENDE = 0.D0
C
      DO 1020 I = 1, N
C
         NUMER(I) = 1.D0
         DNUMDQ(I) = 0.D0
         DNUMDE(I) = 0.D0
C
         DO 1015 J = 1, N
C
            IF ((J.NE.I).AND.(J.NE.I+1).AND.((I.NE.N).OR.(J.NE.1))) THEN
C
               NUMER(I) = NUMER(I) * DIST(J)
C
C           CALCUL DU PRODUIT DES DISTANCES POUR LA DERIVEE
C
               PROD = 1.D0
C
               DO 1013 K = 1, N
C
                  IF   ((K.NE.I).AND.(K.NE.I+1).AND.((I.NE.N).OR.(K.NE.1
     $                 )).AND.(K.NE.J)) THEN
C
                     PROD = PROD * DIST(K)
C
                  END IF
C
 1013          CONTINUE
C
               DNUMDQ(I) = DNUMDQ(I) + PROD * DDISDQ(J)
               DNUMDE(I) = DNUMDE(I) + PROD * DDISDE(J)
C
            END IF
C
 1015    CONTINUE
C
         DENOM = DENOM+NUMER(I)
         DDENDQ = DDENDQ + DNUMDQ(I)
         DDENDE = DDENDE + DNUMDE(I)
C
 1020 CONTINUE
C
C     CALCUL DES FONCTIONS DE FORME ET DE LEURS DERIVEES
C
      DO 1030, I = 1, N
C
         SHP(1,I) = NUMER(I)/DENOM
         SHP(2,I) = (DNUMDQ(I)*DENOM - NUMER(I)*DDENDQ)/(DENOM*DENOM)
         SHP(3,I) = (DNUMDE(I)*DENOM - NUMER(I)*DDENDE)/(DENOM*DENOM)
C
 1030 CONTINUE
C
      END