Sources Esope | Cast3M

shpoly
C SHPOLY    SOURCE    OF166741  24/07/25    21:15:04     11950          
 
C=======================================================================
C
C     FONCTIONS DE FORME ET LEUR DERIVEES - ELEMENTS 2D POLYGONES
C
C=======================================================================
C     QSI ETA DZE COORDONNEES REDUITES DU POINT DE GAUSS
C     (DZE non utilise car ici element 2D)
C     MELE numero de l'element POLYgone a N cotes (= 108 + N)
C
C     SHP FONCTIONS DE FORME :
C        - SHP(1,INO) FONCTIONS DE FORME DU ND INO
C        - SHP(2,INO) DERIVEE PR RPPRT A QSI
C        - SHP(3,INO) DERIVEE PR RPPRT A ETA
C        - SHP(4,INO) DERIVEE PR RPPRT A DZE (non utilisee ici)
C        - SHP(5,INO) non utilisee ici
C        - SHP(6,INO) non utilisee ici
C
C     IRET = 0 en cas d'erreur, = 1 en cas "normal"
C=======================================================================
 
      SUBROUTINE SHPOLY (QSI,ETA,DZE,MELE,SHP,IRET)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
C    Include contenant quelques constantes mathematiques dont XPI :
-INC CCREEL
 
      DIMENSION SHP(6,*)
 
      PARAMETER (NPOMAX = 20)
C     DISTANCE DES POINTS A UN POLYGONE A N COTES
 
      REAL*8  DIST(NPOMAX), DDISDQ(NPOMAX), DDISDE(NPOMAX),
     &       NUMER(NPOMAX), DNUMDQ(NPOMAX), DNUMDE(NPOMAX)
 
C     NOMBRE DE NOEUDS EN FONCTION DU NUMERO D'ELEMENT MELE (108+NBNO)
 
      INTEGER NBNO(111:122)
      DATA NBNO / 3,4,5,6,7,8,9,10,11,12,13,14 /
 
      IRET = 1
 
C     FONCTIONS DE FORME BIDIMENSIONNELLES
C     FONCTIONS DE POLYGONE A N NOEUDS
 
      N = NBNO(MELE)
 
c*      IF (N.GT.NPOMAX) THEN
c*        IRET = 0
c*        CALL ERREUR(5)
c*        RETURN
c*      ENDIF
 
C     CALCUL DES DISTANCES ET DES DERIVEES DU POINT AUX COTES DU POLYGONE
 
      COPISN = COS(XPI/N)
 
      DO I = 1, N
 
         ALPHA = 2.D0*XPI*(I-1)/N
         COSIN = COS(ALPHA)
         SINUS = SIN(ALPHA)
 
         DIST(I) = COPISN - QSI * COSIN - ETA * SINUS
         DDISDQ(I) = - COSIN
         DDISDE(I) = - SINUS
 
      ENDDO
 
C     CALCUL DES NUMERATEURS ET DENOMINATEUR DES FRACTIONS RATIONNELLES ET DERIVEES
 
      DENOM  = 0.D0
      DDENDQ = 0.D0
      DDENDE = 0.D0
 
      DO I = 1, N
 
         NUMER(I)  = 1.D0
         DNUMDQ(I) = 0.D0
         DNUMDE(I) = 0.D0
 
         DO J = 1, N
 
            IF ( (J.NE.I) .AND. (J.NE.I+1) .AND.
     &           ((I.NE.N).OR.(J.NE.1)) ) THEN
 
               NUMER(I) = NUMER(I) * DIST(J)
 
C           CALCUL DU PRODUIT DES DISTANCES POUR LA DERIVEE
 
               PROD = 1.D0
 
               DO K = 1, N
 
                  IF ( (K.NE.I) .AND. (K.NE.I+1) .AND. 
     &                 ((I.NE.N).OR.(K.NE.1)) .AND. (K.NE.J) ) THEN
 
                     PROD = PROD * DIST(K)
 
                  END IF
 
               ENDDO
 
               DNUMDQ(I) = DNUMDQ(I) + PROD * DDISDQ(J)
               DNUMDE(I) = DNUMDE(I) + PROD * DDISDE(J)
 
            END IF
 
         ENDDO
 
         DENOM  = DENOM  + NUMER(I)
         DDENDQ = DDENDQ + DNUMDQ(I)
         DDENDE = DDENDE + DNUMDE(I)
 
      ENDDO
 
      if (abs(denom).lt.1.E-18) then
c*        write(*,*) 'SHPOLY : DENOM "nul" =',DENOM,DDENDQ,DDENDE
        denom = 1.E-18
      endif
 
C     CALCUL DES FONCTIONS DE FORME ET DE LEURS DERIVEES
      DO I = 1, N
        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**        SHP(4,I) = 0.D0
c**        SHP(5,I) = 0.D0
c**        SHP(6,I) = 0.D0
      ENDDO
 
c      return
      END