Télécharger la plaquette Cast3M


fr en

Télécharger quahm1.eso

Retour à la liste

Numérotation des lignes : 

quahm1

  1. C QUAHM1    SOURCE    CHAT      05/01/13    02:40:50     5004
  2. C QUAHM1    SOURCE    AM1       95/11/24    22:53:28     1918
  3.       SUBROUTINE QUAHM1(IGAU,ITEL,MFR,NBNO,XEL,SHPTOT,SHP,IFOU,NHARM,
  4.      #                         B11,B22,SFLU,POIGAU,VKL22,LRE,REL,IRET)
  5. C=======================================================================
  6. C
  7. C    CALCULE LES TERMES  EN  PI * PI  DE  LA  MATRICE   DE
  8. C           MASSE  DANS  LE  CAS  AXISYMETRIQUE OU FOURIER  POUR
  9. C                  LA FORMULATION (37) HOMOGENE
  10. C=======================================================================
  11. C  INPUT
  12. C     IGAU=NUMERO DU POINT DE GAUSS
  13. C     ITEL=NUMERO DE L ELEMENT DANS NOMTP
  14. C     MFR =NUMERO DE LA FORMULATION
  15. C     NBNO=NOMBRE DE NOEUDS
  16. C     XEL =COORDONNEES  DE L ELEMENT
  17. C     IFOU=IFOUR DE CCOPTIO
  18. C     NHARM=NUMERO DU MODE DE FOURIER
  19. C     B11,B22 =  PERMEABILITE ACOUSTIQUE DU MILIEU
  20. C     SFLU = SURFACE  FLUIDE  DANS LA CELLULE ELEMENTAIRE
  21. C     POIGAU=MINTE.POIGAU(IGAU)
  22. C     VKL22=-(COEFPI**2)/(RHOF*SCEL)
  23. C     LRE =NOMBRE DE D.D.L DE LA MATRICE  DE  RIGIDITE
  24. C     SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES
  25. C  ZONE DE TRAVAIL
  26. C     SHP(6,NBNO)=TABLEAU DE TRAVAIL
  27. C OUTPUT
  28. C     REL=MATRICE DE MASSE
  29. C     IRET : INDICATEUR  = 1 : SUCCES
  30. C                        = 0 : ECHEC (ELEMENT  MELE  INCOMPATIBLE
  31. C                                     AVEC  LA  FORMULATION       )
  32. C                        = 2 : ECHEC (JACOBIEN  NUL )
  33. C                        = 3 : ECHEC (ROUTINE  N EST VALABLE  QU   EN
  34. C                                     FOURIER  OU  AXISYMETRIQUE  )
  35. C                        = 4 : ECHEC (RAYON     NUL )
  36. C=======================================================================
  37.       IMPLICIT INTEGER(I-N)
  38.       IMPLICIT REAL*8(A-H,O-Z)
  39.       DIMENSION XEL(3,*),SHP(6,*),SHPTOT(6,NBNO,*),REL(LRE,*)
  40.       IF (ITEL.EQ.126)              GOTO 10
  41. C
  42. C     ERREUR : TYPE D' ELEMENT  INCOMPATIBLE AVEC LA FORMULATION
  43. C
  44.       IRET = 0
  45.       GOTO 666
  46.   10  CONTINUE
  47.       IF (IFOU.EQ.0.OR.IFOU.EQ.1)  GOTO 11
  48. C
  49. C     MESSAGE D ERREUR :  ROUTINE  N  EST  VALABLE  QU  EN FOURIER
  50. C                     OU   EN   AXISYMETRIQUE
  51. C
  52.       IRET = 3
  53.       GOTO 666
  54.   11  CONTINUE
  55. C
  56. C     ELEMENTS HOMOGENEISES QUAH   EN AXISYMETRIE OU EN FOURIER
  57. C          NBDL = LRE/NBNO  NOMBRE DE D.D.L PAR NOEUD
  58. C
  59.       B33  = SFLU
  60.       NBDL = LRE/NBNO
  61. C
  62. C     SHP(1,I) : FONCTION DE FORME
  63. C     SHP(2,I) : DERIVEE % R DE LA FONCTION DE FORME
  64. C     SHP(3,I) : DERIVEE % Z DE LA FONCTION DE FORME
  65. C
  66.       DO 101 NP=1,NBNO
  67.       SHP(1,NP)=SHPTOT(1,NP,IGAU)
  68.       SHP(2,NP)=SHPTOT(2,NP,IGAU)
  69.       SHP(3,NP)=SHPTOT(3,NP,IGAU)
  70.   101 CONTINUE
  71. C
  72. C
  73.       CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NHARM,2,1.D0,RR,DJAC)
  74.       IF (DJAC.EQ.0.) GOTO 667
  75.       IF ( IFOU.EQ.0) THEN
  76.  
  77. C
  78. C     CAS    AXISYMETRIQUE
  79. C
  80.       DJAC  = ABS(DJAC)*POIGAU
  81.  
  82.       IX1=0
  83.       IY1=0
  84.       DO   102 IX=2,LRE ,NBDL
  85.       IX1=IX1 + 1
  86.       DO   103 IY=2,IX  ,NBDL
  87.       IY1=IY1 + 1
  88.       REL(IY,IX) = REL(IY,IX) + VKL22*DJAC*(0.5D0*(B11+B22)*SHP(2,IX1)*
  89.      #SHP(2,IY1)
  90.      # + B33*SHP(3,IX1)*SHP(3,IY1))
  91.       REL(IX,IY) = REL(IY,IX)
  92.   103 CONTINUE
  93.       IY1=0
  94.   102 CONTINUE
  95.       IRET = 1
  96.       ELSE
  97. C
  98. C     CAS ANALYSE EN FOURIER
  99. C
  100. C
  101. C
  102.       IF (RR.EQ.0.) GOTO 668
  103.       DJAC  = ABS(DJAC)
  104.       DJAC1 = DJAC*POIGAU
  105.       DJAC2 = DJAC*POIGAU/(RR**2)
  106. C
  107.       IX1=0
  108.       IY1=0
  109.       DO   104 IX=2,LRE ,NBDL
  110.       IX1=IX1 + 1
  111.       DO   105 IY=2,IX  ,NBDL
  112.       IY1=IY1 + 1
  113. C
  114.       COEF1 = 0.5D0*(B11+B22)*SHP(2,IX1)*SHP(2,IY1)
  115.       COEF2 = B33*SHP(3,IX1)*SHP(3,IY1)
  116.       COEF3 = 0.5D0*NHARM*NHARM*(B11+B22)*SHP(1,IY1)*SHP(1,IX1)
  117. C
  118.       REL(IY,IX)=REL(IY,IX)+VKL22*(DJAC1*(COEF1 + COEF2)
  119.      #+DJAC2*COEF3)
  120.       REL(IX,IY) = REL(IY,IX)
  121.   105 CONTINUE
  122.       IY1=0
  123.   104 CONTINUE
  124.       IRET = 1
  125.       ENDIF
  126.       GOTO  666
  127. C
  128. C     MESSAGE D ERREUR : ELEMENT A  SURFACE  NULLE
  129. C
  130.  667  CONTINUE
  131.       IRET = 2
  132.       GOTO  666
  133. C
  134. C     MESSAGE D ERREUR : LE RAYON EST NUL (IL FAUT AUGMENTER LE  NOMBRE
  135. C          DE POINTS  D  INTEGRATION  DANS ICLEM(17)  )
  136. C
  137.  668  CONTINUE
  138.       IRET = 4
  139.       GOTO  666
  140. C
  141.  666  CONTINUE
  142.       RETURN
  143.       END
  144.  
  145.  
  146.  
  147.  
  148.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales