Sources Esope | Cast3M

trihm1
C TRIHM1    SOURCE    CHAT      05/01/13    03:47:06     5004
      SUBROUTINE TRIHM1(IGAU,ITEL,MFR,NBNO,XEL,SHPTOT,SHP,IFOU,NHARM,
     #                         B11,B22,SFLU,POIGAU,VKL22,LRE,REL,IRET)
C=======================================================================
C
C    CALCULE LES TERMES  EN  PI * PI  DE  LA  MATRICE   DE
C           MASSE  DANS  LE  CAS  AXISYMETRIQUE OU FOURIER  POUR
C                  LA FORMULATION (37) HOMOGENE
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     XEL =COORDONNEES  DE L ELEMENT
C     IFOU=IFOUR DE CCOPTIO
C     NHARM=NUMERO DU MODE DE FOURIER
C     B11,B22 =  PERMEABILITE ACOUSTIQUE DU MILIEU
C     SFLU = SURFACE  FLUIDE  DANS LA CELLULE ELEMENTAIRE
C     POIGAU=MINTE.POIGAU(IGAU)
C     VKL22=-(COEFPI**2)/(RHOF*SCEL)
C     LRE =NOMBRE DE D.D.L DE LA MATRICE  DE  RIGIDITE
C     SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES
C  ZONE DE TRAVAIL
C     SHP(6,NBNO)=TABLEAU DE TRAVAIL
C OUTPUT
C     REL=MATRICE DE MASSE
C     IRET : INDICATEUR  = 1 : SUCCES
C                        = 0 : ECHEC (ELEMENT  MELE  INCOMPATIBLE
C                                     AVEC  LA  FORMULATION       )
C                        = 2 : ECHEC (JACOBIEN  NUL )
C                        = 3 : ECHEC (ROUTINE  N EST VALABLE  QU   EN
C                                     FOURIER  OU  AXISYMETRIQUE  )
C                        = 4 : ECHEC (RAYON     NUL )
C=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION XEL(3,*),SHP(6,*),SHPTOT(6,NBNO,*),REL(LRE,*)
      IF (ITEL.EQ.92)              GOTO 10
C
C     ERREUR : TYPE D' ELEMENT  INCOMPATIBLE AVEC LA FORMULATION
C
      IRET = 0
      GOTO 666
  10  CONTINUE
      IF (IFOU.EQ.0.OR.IFOU.EQ.1)  GOTO 11
C
C     MESSAGE D ERREUR :  ROUTINE  N  EST  VALABLE  QU  EN FOURIER
C                     OU   EN   AXISYMETRIQUE
C
      IRET = 3
      GOTO 666
  11  CONTINUE
C
C     ELEMENTS HOMOGENEISES TRIH   EN AXISYMETRIE OU EN FOURIER
C          NBDL = LRE/NBNO  NOMBRE DE D.D.L PAR NOEUD
C
      B33  = SFLU
      NBDL = LRE/NBNO
C
C     SHP(1,I) : FONCTION DE FORME
C     SHP(2,I) : DERIVEE % R DE LA FONCTION DE FORME
C     SHP(3,I) : DERIVEE % Z DE LA FONCTION DE FORME
C
      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)
  101 CONTINUE
      CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NHARM,2,1.D0,RR,DJAC)
      IF (DJAC.EQ.0.) GOTO 667
      IF ( IFOU.EQ.0) THEN
C
C     CAS    AXISYMETRIQUE
C
      DJAC  = ABS(DJAC)*POIGAU
      IX1=0
      IY1=0
      DO   102 IX=2,LRE ,NBDL
      IX1=IX1 + 1
      DO   103 IY=2,IX  ,NBDL
      IY1=IY1 + 1
      REL(IY,IX) = REL(IY,IX) + VKL22*DJAC*(0.5D0*(B11+B22)*SHP(2,IX1)*
     #SHP(2,IY1) + B33*SHP(3,IX1)*SHP(3,IY1))
      REL(IX,IY) = REL(IY,IX)
  103 CONTINUE
      IY1=0
  102 CONTINUE
      IRET = 1
      ELSE
C
C     CAS ANALYSE EN FOURIER
C
      IF (RR.EQ.0.) GOTO 668
      DJAC  = ABS(DJAC)
      DJAC1 = DJAC*POIGAU
      DJAC2 = DJAC*POIGAU/(RR**2)
      IX1=0
      IY1=0
      DO   104 IX=2,LRE ,NBDL
      IX1=IX1 + 1
      DO   105 IY=2,IX  ,NBDL
      IY1=IY1 + 1
      REL(IY,IX)=REL(IY,IX)+VKL22*(DJAC1*(0.5D0*(B11+B22)*SHP(2,IX1)*
     #SHP(2,IY1)+B33*SHP(3,IX1)*SHP(3,IY1))+0.5D0*NHARM*NHARM*DJAC2*
     #(B11+B22)*SHP(1,IY1)*SHP(1,IX1))
      REL(IX,IY) = REL(IY,IX)
  105 CONTINUE
      IY1=0
  104 CONTINUE
      IRET = 1
      ENDIF
      GOTO  666
C
C     MESSAGE D ERREUR : ELEMENT A  SURFACE  NULLE
C
 667  CONTINUE
      IRET = 2
      GOTO  666
C
C     MESSAGE D ERREUR : LE RAYON EST NUL (IL FAUT AUGMENTER LE  NOMBRE
C          DE POINTS  D  INTEGRATION  DANS ICLEM(17)  )
C
 668  CONTINUE
      IRET = 4
      GOTO  666
C
 666  CONTINUE
      RETURN
      END