Sources Esope | Cast3M

shmacr
C SHMACR    SOURCE    MAGN      05/02/18    21:16:22     5031
      SUBROUTINE SHMACR(QSI,ETA,DZE,MELE,SHP,IRET)
C=======================================================================
C
C     FONCTIONS DE FORME ET LEUR DERIVEES  CENTREP1
C
C=======================================================================
      IMPLICIT REAL*8(A-H,O-Z)
      PARAMETER(UNDEMI=.5D0,DEUX=2.D0)
      PARAMETER(TROIS=3.D0,QUATRE=4.D0)
      DIMENSION SHP(6,*)
C=======================================================================
C     QSI ETA DZE COORDONNEES REDUITES 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 2
C               3 NOEUDS TRIANGLE
C=======================================================================
      IRET=1
 
C    CAS MACRO pour un element geometrique de type TRI6
      IF(MELE.EQ.224.OR.MELE.EQ.231) THEN
 
          SHP(1,1)=0.D0
          SHP(1,2)=0.D0
          SHP(1,3)=0.D0
          SHP(1,4)=0.D0
          SHP(1,5)=0.D0
          SHP(1,6)=0.D0
          SHP(2,1)=0.D0
          SHP(2,2)=0.D0
          SHP(2,3)=0.D0
          SHP(2,4)=0.D0
          SHP(2,5)=0.D0
          SHP(2,6)=0.D0
          SHP(3,1)=0.D0
          SHP(3,2)=0.D0
          SHP(3,3)=0.D0
          SHP(3,4)=0.D0
          SHP(3,5)=0.D0
          SHP(3,6)=0.D0
      IF (QSI.GE.0.D0.AND.QSI.LE.0.5D0) THEN
        IF (ETA.LE.(0.5D0-QSI)) THEN
* Omega1
          SHP(1,1)=2.D0*(0.5D0-QSI-ETA)
          SHP(1,2)=2.D0*QSI
          SHP(1,6)=2.D0*ETA
          SHP(2,1)=-2.D0
          SHP(2,2)=2.D0
          SHP(2,6)=0.D0
          SHP(3,1)=-2.D0
          SHP(3,2)=0.D0
          SHP(3,6)=2.D0
        ELSEIF (ETA.GE.0.5D0.AND.ETA.LE.(1.D0-QSI)) THEN
* Omega3
          SHP(1,4)=2.D0*QSI
          SHP(1,5)=2.D0*(ETA-0.5D0)
          SHP(1,6)=2.D0*(1.0D0-QSI-ETA)
          SHP(2,4)=2.D0
          SHP(2,5)=0.D0
          SHP(2,6)=-2.D0
          SHP(3,4)=0.D0
          SHP(3,5)=2.D0
          SHP(3,6)=-2.D0
        ELSEIF (ETA.LE.0.5D0.AND.ETA.GE.(0.5D0-QSI)) THEN
* Omega4
          SHP(1,2)=1.D0-2.D0*ETA
          SHP(1,4)=2.D0*(QSI+ETA-0.5D0)
          SHP(1,6)=1.D0-2.D0*QSI
          SHP(2,2)=0.D0
          SHP(2,4)=2.D0
          SHP(2,6)=-2.D0
          SHP(3,2)=-2.D0
          SHP(3,4)=2.D0
          SHP(3,6)=0.D0
        ENDIF
      ELSEIF (QSI.GE.0.5D0.AND.QSI.LE.1.D0) THEN
        IF (ETA.LE.(1.D0-QSI)) THEN
* Omega2
          SHP(1,2)=2.D0*(1.D0-QSI-ETA)
          SHP(1,3)=2.D0*(QSI-0.5D0)
          SHP(1,4)=2.D0*ETA
          SHP(2,2)=-2.D0
          SHP(2,3)=2.D0
          SHP(2,4)=0.D0
          SHP(3,2)=-2.D0
          SHP(3,3)=0.D0
          SHP(3,4)=2.D0
        ENDIF
      ENDIF
C    CAS MACRO pour un element geometrique de type QUA9
      ELSEIF(MELE.EQ.225.OR.MELE.EQ.232) THEN
 
          SHP(1,1)=0.D0
          SHP(1,2)=0.D0
          SHP(1,3)=0.D0
          SHP(1,4)=0.D0
          SHP(1,5)=0.D0
          SHP(1,6)=0.D0
          SHP(1,7)=0.D0
          SHP(1,8)=0.D0
          SHP(1,9)=0.D0
          SHP(2,1)=0.D0
          SHP(2,2)=0.D0
          SHP(2,3)=0.D0
          SHP(2,4)=0.D0
          SHP(2,5)=0.D0
          SHP(2,6)=0.D0
          SHP(2,7)=0.D0
          SHP(2,8)=0.D0
          SHP(2,9)=0.D0
          SHP(3,1)=0.D0
          SHP(3,2)=0.D0
          SHP(3,3)=0.D0
          SHP(3,4)=0.D0
          SHP(3,5)=0.D0
          SHP(3,6)=0.D0
          SHP(3,7)=0.D0
          SHP(3,8)=0.D0
          SHP(3,9)=0.D0
      IF (QSI.GE.-1.D0.AND.QSI.LE.0.D0) THEN
        IF (ETA.GE.-1.D0.AND.ETA.LE.0.D0) THEN
* Omega1
          SHP(1,1)=QSI*ETA
          SHP(1,2)=-ETA*(1.D0+QSI)
          SHP(1,8)=-QSI*(1.D0+ETA)
          SHP(1,9)=(1.D0+QSI)*(1.D0+ETA)
          SHP(2,1)=ETA
          SHP(3,1)=QSI
          SHP(2,2)=-ETA
          SHP(3,2)=-(1.D0+QSI)
          SHP(2,8)=-(1.D0+ETA)
          SHP(3,8)=-QSI
          SHP(2,9)=1.D0+ETA
          SHP(3,9)=1.D0+QSI
        ELSEIF (ETA.GE.0.D0.AND.ETA.LE.1.D0) THEN
* Omega4
          SHP(1,6)=ETA*(1.D0+QSI)
          SHP(1,7)=-QSI*ETA
          SHP(1,8)=-QSI*(1.D0-ETA)
          SHP(1,9)=(1.D0+QSI)*(1.D0-ETA)
          SHP(2,6)=ETA
          SHP(3,6)=1.D0+QSI
          SHP(2,7)=-ETA
          SHP(3,7)=-QSI
          SHP(2,8)=-(1.D0-ETA)
          SHP(3,8)=QSI
          SHP(2,9)=1.D0-ETA
          SHP(3,9)=-(1.D0+QSI)
        ENDIF
      ELSEIF (QSI.GE.0.D0.AND.QSI.LE.1.D0) THEN
        IF (ETA.GE.-1.D0.AND.ETA.LE.0.D0) THEN
* Omega2
          SHP(1,2)=-ETA*(1.D0-QSI)
          SHP(1,3)=-QSI*ETA
          SHP(1,4)=QSI*(1.D0+ETA)
          SHP(1,9)=(1.D0-QSI)*(1.D0+ETA)
          SHP(2,2)=ETA
          SHP(3,2)=-(1.D0-QSI)
          SHP(2,3)=-ETA
          SHP(3,3)=-QSI
          SHP(2,4)=1.D0+ETA
          SHP(3,4)=QSI
          SHP(2,9)=-(1.D0+ETA)
          SHP(3,9)=1.D0-QSI
        ELSEIF (ETA.GE.0.D0.AND.ETA.LE.1.D0) THEN
* Omega3
          SHP(1,4)=QSI*(1.D0-ETA)
          SHP(1,5)=QSI*ETA
          SHP(1,6)=ETA*(1.D0-QSI)
          SHP(1,9)=(1.D0-QSI)*(1.D0-ETA)
          SHP(2,4)=1.D0-ETA
          SHP(3,4)=-QSI
          SHP(2,5)=ETA
          SHP(3,5)=QSI
          SHP(2,6)=-ETA
          SHP(3,6)=1.D0-QSI
          SHP(2,9)=-(1.D0-ETA)
          SHP(3,9)=-(1.D0-QSI)
        ENDIF
      ENDIF
 
*      WRITE(6,*)'SHP:',SHP(1,1),SHP(1,2),SHP(1,3),SHP(1,4)
*      WRITE(6,*) SHP(1,5),SHP(1,6),SHP(1,7),SHP(1,8),SHP(1,9)
 
      ENDIF
 
      RETURN
      END