Sources Esope | Cast3M

cubhr1
C CUBHR1    SOURCE    CHAT      05/01/12    22:32:36     5004
C CUBHR1    SOURCE    AM1       95/11/24    22:55:49     1918
      SUBROUTINE CUBHR1(IGAU,ITEL,MFR,NBNO,NIFOU,XEL,
     #                  SHPTOT,SHP,NST,ISDJC,XGENE,DJAC,IRET)
C=======================================================================
C
C    CALCULE LA MATRICE XGENE (NECESSAIRE POUR LE CALCUL  DE LA MATRICE
C       DE RIGIDITE DANS LE CAS DE LA FORMULATION (37) HOMOGENE    )
C          ROUTINE FORTRAN PUR
C=======================================================================
C  INPUT
C     IGAU=NUMERO DU POINT DE GAUSS
C     ITEL=NUMERO DE L ELEMENT DANS NOMTP
C     MFR =NUMERO DE LA FORMULATION
C     NBNO=NOMBRE DE NOEUDS
C     LRE =NOMBRE DE COLONNES DE LA MATRICE B
C     IFOU=IFOUR DE CCOPTIO
C     NIFOU=NIFOUR DE CCOPTIO
C     XEL =COORDONNEES  DE L ELEMENT
C     SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES
C     ISDJC = INDICATEUR SUR LE SIGNE DU JACOBIEN
C  ZONE DE TRAVAIL
C     SHP(6,NBNO)=TABLEAU DE TRAVAIL
C  OUTPUT
C     ISDJC = INDICATEUR SUR LE SIGNE DU JACOBIEN
C     NST =NBRE DE COLONNES DE LA MATRICE XGENE
C     DJAC=JACOBIEN
C     XGENE(NBNO,NST)=MATRICE (DE FONCTION DE FORME )
C     IRET= INDICATEUR  =  1 : SUCCES
C                       =  0 : ECHEC (ELEMENT INCOMPATIBLE )
C                       =  2 : ECHEC (JACOBIEN NUL         )
C=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION XEL(3,*),XGENE((NBNO*2),2),SHP(6,*),SHPTOT(6,NBNO,*)
      IF (ITEL.EQ.127)              GOTO 10
C
C     ERREUR : TYPE D' ELEMENT  INCOMPATIBLE AVEC LA FORMULATION
C
      IRET = 0
      GOTO 666
  10  CONTINUE
      DO 101 NP=1,NBNO
      SHP(1,NP)=SHPTOT(1,NP,IGAU)
      SHP(2,NP)=SHPTOT(2,NP,IGAU)
      SHP(3,NP)=SHPTOT(3,NP,IGAU)
      SHP(4,NP)=SHPTOT(4,NP,IGAU)
  101 CONTINUE
      IDIM=3
      CALL JACOBI(XEL,SHP,IDIM,NBNO,DJAC)
C      WRITE(6,*)'DJAC1',DJAC
      IRET = 1
      IF (DJAC.LT.0.) ISDJC = ISDJC + 1
      DJAC = ABS(DJAC)
C
C     CAS  D'UN CALCUL TRIDIMENSIONNEL
C
      NST = 2
C
      CALL ZERO(XGENE,NBNO,NST)
      DO 103 NP=1,NBNO
      XGENE(NP,1)=SHP(1,NP)
  103 CONTINUE
C
      A1 = XEL(3,8) - XEL(3,1)
      A1 = ABS(A1)
      A2 = XEL(3,7) - XEL(3,1)
      A2 = ABS(A2)
      A3 = XEL(3,6) - XEL(3,1)
      A3 = ABS(A3)
      A4 = XEL(3,5) - XEL(3,1)
      A4 = ABS(A4)
      A5 = XEL(3,4) - XEL(3,1)
      A5 = ABS(A5)
      A6 = XEL(3,3) - XEL(3,1)
      A6 = ABS(A6)
      A7 = XEL(3,2) - XEL(3,1)
      A7 = ABS(A7)
C
      A3 = (0.25D0)*(A1+A2+A3+A4+A5+A6+A7)
C
      S1=SHP(1,1)+SHP(1,4)+SHP(1,5)+SHP(1,8)
      S2=SHP(1,2)+SHP(1,3)+SHP(1,6)+SHP(1,7)
C
      T1=SHP(1,1)+SHP(1,2)+SHP(1,5)+SHP(1,6)
      T2=SHP(1,3)+SHP(1,4)+SHP(1,7)+SHP(1,8)
C
      ZH=SHP(1,5)+SHP(1,6)+SHP(1,7)+SHP(1,8)
C
C     DERIVEES SECONDES DES FONCTIONS Z
C
      ZS1=(-6.D0/(A3**2))+((12.D0/(A3**2))*ZH)
      ZS2=-1.D0*ZS1
      ZS3=(-4.D0/A3)+((6.D0/A3)*ZH)
      ZS4=(-2.D0/A3)+((6.D0/A3)*ZH)
C
C     FONCTIONS UTILISEES DANS TRIHR2.ESO
C
      XGENE(1,2)=S1*T1*ZS1
      XGENE(2,2)=S2*T1*ZS1
      XGENE(3,2)=S2*T2*ZS1
      XGENE(4,2)=S1*T2*ZS1
      XGENE(5,2)=S1*T1*ZS2
      XGENE(6,2)=S2*T1*ZS2
      XGENE(7,2)=S2*T2*ZS2
      XGENE(8,2)=S1*T2*ZS2
 
      XGENE(9,2)=S1*T1*ZS3
      XGENE(10,2)=S2*T1*ZS3
      XGENE(11,2)=S2*T2*ZS3
      XGENE(12,2)=S1*T2*ZS3
      XGENE(13,2)=S1*T1*ZS4
      XGENE(14,2)=S2*T1*ZS4
      XGENE(15,2)=S2*T2*ZS4
      XGENE(16,2)=S1*T2*ZS4
C
      IRET=1
C
 666  CONTINUE
      RETURN
      END