Télécharger quahm1.eso

Retour à la liste

Numérotation des lignes :

  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