Télécharger trihm2.eso

Retour à la liste

Numérotation des lignes :

trihm2
  1. C TRIHM2 SOURCE CHAT 05/01/13 03:47:09 5004
  2. SUBROUTINE TRIHM2(IGAU,ITEL,MFR,NBNO,XEL,SHPTOT,SHP,IFOU,
  3. # NHARM,VKL12,VKL23,VKL33,POIGAU,ISDJC,LRE,REL,IRET)
  4. C=======================================================================
  5. C
  6. C CALCULE LES TERMES EN P * PI ,PI * (UR,RT) ,(UR,RT) *(UR,RT)
  7. C (UT,RR) * (UT,RR) , PI * (UT,RR) DE LA MATRICE
  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 VKL12=-((COEFPI*COEFPR)/(RHOF*C**2))*SFLU/SCEL
  20. C VKL23=(BET11+BET22)*COEFPI/(2.*SCEL)
  21. C VKL33=(RHOS*2.+RHOF*(BET11+BET22))/SCEL
  22. C POIGAU=MINTE.POIGAU(IGAU)
  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 ISDJC = INDICATEUR SUR LE SIGNE DU JACOBIEN
  26. C ZONE DE TRAVAIL
  27. C SHP(5,NBNO)=TABLEAU DE TRAVAIL
  28. C OUTPUT
  29. C ISDJC = INDICATEUR SUR LE SIGNE DU JACOBIEN
  30. C REL=MATRICE DE MASSE
  31. C IRET:INDICATEUR = 1 : SUCCES
  32. C 0 : ECHEC (ELEMENT MELE INCOMPATIBLE )
  33. C 2 : ECHEC (JACOBIEN NUL )
  34. C 3 :ECHEC (ROUTINE N EST VALABLE QU
  35. C EN AXISYMETRIQUE OU FOURIER )
  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.92) 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 TRIH EN AXISYMETRIE OU EN FOURIER
  57. C NBDL = LRE/NBNO NOMBRE DE D.D.L PAR NOEUD
  58. C
  59. NBDL = LRE /NBNO
  60. C
  61. C SHP(1,I) : FONCTION DE FORME
  62. C SHP(2,I) : DERIVEE % R DE LA FONCTION DE FORME
  63. C SHP(3,I) : DERIVEE % Z DE LA FONCTION DE FORME
  64. C
  65. DO 101 NP=1,NBNO
  66. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  67. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  68. SHP(3,NP)=SHPTOT(3,NP,IGAU)
  69. 101 CONTINUE
  70. CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NHARM,2,1.D0,RR,DJAC)
  71. IF (DJAC.EQ.0.) GOTO 667
  72. IF (DJAC.LT.0.) ISDJC = ISDJC + 1
  73. C
  74. C SHP(4,I) : FONCTION DE FORME DE UR (DEPLACEMENTS)
  75. C SHP(5,I) : FONCTION DE FORME DE (DUR/DZ) (ROTATIONS)
  76. C
  77. SHP(4,1)=SHP(1,1)*(1.D0-SHP(1,2)*SHP(1,2)-SHP(1,3)*SHP(1,3)) +
  78. # SHP(1,1)*SHP(1,1)*(SHP(1,2)+SHP(1,3))
  79. SHP(4,2)=SHP(1,2)*(1.D0-SHP(1,1)*SHP(1,1)-SHP(1,3)*SHP(1,3)) +
  80. # SHP(1,2)*SHP(1,2)*(SHP(1,1)+SHP(1,3))
  81. SHP(4,3)=SHP(1,3)*(1.D0-SHP(1,1)*SHP(1,1)-SHP(1,2)*SHP(1,2)) +
  82. # SHP(1,3)*SHP(1,3)*(SHP(1,1)+SHP(1,2))
  83. C
  84. C A1=SHP(2,1) , A2=SHP(2,2) , A3 = SHP(2,3)
  85. C
  86. A1=XEL(2,2)-XEL(2,3)
  87. A2=XEL(2,3)-XEL(2,1)
  88. A3=XEL(2,1)-XEL(2,2)
  89. SHP(5,1)= SHP(1,1)*SHP(1,1)*(A2*SHP(1,3)-A3*SHP(1,2)) +
  90. # 0.5D0*SHP(1,1)*SHP(1,2)*SHP(1,3)*(A2-A3)
  91. SHP(5,2)= SHP(1,2)*SHP(1,2)*(A3*SHP(1,1)-A1*SHP(1,3)) +
  92. # 0.5D0*SHP(1,1)*SHP(1,2)*SHP(1,3)*(A3-A1)
  93. SHP(5,3)= SHP(1,3)*SHP(1,3)*(A1*SHP(1,2)-A2*SHP(1,1)) +
  94. # 0.5D0*SHP(1,1)*SHP(1,2)*SHP(1,3)*(A1-A2)
  95. C
  96. C TERMES EN P * PI
  97. C
  98. DJAC1 = ABS(DJAC)*POIGAU
  99. IX1=0
  100. IY1=0
  101. DO 102 IX=2,LRE ,NBDL
  102. IX1=IX1 + 1
  103. DO 103 IY=1,IX ,NBDL
  104. IY1=IY1 + 1
  105. REL(IY,IX) = REL(IY,IX) + VKL12*DJAC1*SHP(1,IX1)*SHP(1,IY1)
  106. REL(IX,IY) = REL(IY,IX)
  107. 103 CONTINUE
  108. IY1=0
  109. 102 CONTINUE
  110. DO 104 IX=2+NBDL,LRE ,NBDL
  111. IX2=IX - NBDL
  112. DO 105 IY=1,IX2 ,NBDL
  113. REL(IY+1,IX-1) = REL(IY,IX)
  114. REL(IX-1,IY+1) = REL(IY+1,IX-1)
  115. 105 CONTINUE
  116. 104 CONTINUE
  117. C
  118. C TERMES EN PI * (UR , RT )
  119. C
  120. IX1=0
  121. IY1=0
  122. DO 106 IX=3,LRE ,NBDL
  123. IX1=IX1 + 1
  124. DO 107 IY=2,IX ,NBDL
  125. IY1=IY1 + 1
  126. REL(IY,IX) = REL(IY,IX) + VKL23*DJAC1*SHP(2,IY1)*SHP(4,IX1)
  127. REL(IY,IX+1) = REL(IY,IX+1) + VKL23*DJAC1*SHP(2,IY1)*SHP(5,IX1)
  128. REL(IX,IY) = REL(IY,IX)
  129. REL(IX+1,IY) = REL(IY,IX+1)
  130. 107 CONTINUE
  131. IY1=0
  132. 106 CONTINUE
  133. IX1=1
  134. IY1=0
  135. DO 108 IX=2+NBDL,LRE ,NBDL
  136. IX1=IX1 + 1
  137. DO 109 IY=3,IX ,NBDL
  138. IY1=IY1 + 1
  139. REL(IY,IX) = REL(IY,IX) + VKL23*DJAC1*SHP(2,IX1)*SHP(4,IY1)
  140. REL(IY+1,IX) = REL(IY+1,IX) + VKL23*DJAC1*SHP(2,IX1)*SHP(5,IY1)
  141. REL(IX,IY) = REL(IY,IX)
  142. REL(IX,IY+1) = REL(IY+1,IX)
  143. 109 CONTINUE
  144. IY1=0
  145. 108 CONTINUE
  146. IF ( IFOU.EQ.1) THEN
  147. C
  148. C TERMES EN PI * (UT , RR )
  149. C NON NULS QU EN FOURIER
  150. C
  151. DJAC2 = ABS(DJAC)*POIGAU
  152. VKL25 = -1.D0* VKL23*NHARM
  153. IX1=0
  154. IY1=0
  155. DO 110 IX=5,LRE ,NBDL
  156. IX1=IX1 + 1
  157. DO 111 IY=2,IX ,NBDL
  158. IY1=IY1 + 1
  159. REL(IY,IX) = REL(IY,IX) + VKL25*DJAC2*SHP(1,IY1)*SHP(4,IX1)
  160. REL(IY,IX+1) = REL(IY,IX+1) + VKL25*DJAC2*SHP(1,IY1)*SHP(5,IX1)
  161. REL(IX,IY) = REL(IY,IX)
  162. REL(IX+1,IY) = REL(IY,IX+1)
  163. 111 CONTINUE
  164. IY1=0
  165. 110 CONTINUE
  166. IX1=1
  167. IY1=0
  168. DO 112 IX=2+NBDL,LRE ,NBDL
  169. IX1=IX1 + 1
  170. DO 113 IY=5,IX ,NBDL
  171. IY1=IY1 + 1
  172. REL(IY,IX) = REL(IY,IX) + VKL25*DJAC2*SHP(1,IX1)*SHP(4,IY1)
  173. REL(IY+1,IX) = REL(IY+1,IX) + VKL25*DJAC2*SHP(1,IX1)*SHP(5,IY1)
  174. REL(IX,IY) = REL(IY,IX)
  175. REL(IX,IY+1) = REL(IY+1,IX)
  176. 113 CONTINUE
  177. IY1=0
  178. 112 CONTINUE
  179. ENDIF
  180. C
  181. C TERMES EN (UR,RT ) * (UR , RT )
  182. C
  183. IX1=0
  184. IY1=0
  185. DO 114 IX=3,LRE ,NBDL
  186. IX1=IX1 + 1
  187. DO 115 IY=3,IX ,NBDL
  188. IY1=IY1 + 1
  189. REL(IY,IX) = REL(IY,IX) + VKL33*DJAC1*SHP(4,IY1)*SHP(4,IX1)
  190. REL(IY,IX+1) = REL(IY,IX+1) + VKL33*DJAC1*SHP(4,IY1)*SHP(5,IX1)
  191. REL(IY+1,IX) = REL(IY+1,IX) + VKL33*DJAC1*SHP(5,IY1)*SHP(4,IX1)
  192. REL(IY+1,IX+1) = REL(IY+1,IX+1)+VKL33*DJAC1*SHP(5,IY1)*SHP(5,IX1)
  193. REL(IX,IY) = REL(IY,IX)
  194. REL(IX+1,IY) = REL(IY,IX+1)
  195. REL(IX,IY+1) = REL(IY+1,IX)
  196. REL(IX+1,IY+1) = REL(IY+1,IX+1)
  197. 115 CONTINUE
  198. IY1=0
  199. 114 CONTINUE
  200. IF ( IFOU.EQ.1) THEN
  201. C
  202. C TERMES EN (UT,RR ) * (UT , RR )
  203. C NON NULS QU EN FOURIER
  204. C
  205. DO 116 IX=3,LRE ,NBDL
  206. DO 117 IY=3,LRE ,NBDL
  207. IX2=IX + 2
  208. IY2=IY + 2
  209. REL(IX2,IY2) = REL(IX,IY)
  210. REL(IX2+1,IY2) = REL(IX+1,IY)
  211. REL(IX2,IY2+1) = REL(IX,IY+1)
  212. REL(IX2+1,IY2+1) = REL(IX+1,IY+1)
  213. 117 CONTINUE
  214. 116 CONTINUE
  215. ENDIF
  216. IRET = 1
  217. GOTO 666
  218. C
  219. C MESSAGE D ERREUR : ELEMENT A SURFACE NULLE
  220. C
  221. 667 CONTINUE
  222. IRET = 2
  223. GOTO 666
  224. C
  225. 666 CONTINUE
  226. RETURN
  227. END
  228.  
  229.  
  230.  
  231.  

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