Télécharger kcent3.eso

Retour à la liste

Numérotation des lignes :

  1. C KCENT3 SOURCE BP208322 15/06/22 21:19:45 8543
  2. SUBROUTINE KCENT3(IPMAIL,NDDL,LRE,NBPGAU,IPMINT,
  3. &MELE,MFR,IVAMAT,IVACAR,NMATT,IPMATR,VROT,IIPDPG)
  4. *---------------------------------------------------------------------*
  5. * _______________________________________________ *
  6. * | | *
  7. * | calcul de la matrice de raideur centrifuge | *
  8. * |_____________________________________________| *
  9. * *
  10. * massif *
  11. * *
  12. *---------------------------------------------------------------------*
  13. * *
  14. * entrees : *
  15. * ________ *
  16. * *
  17. * ipmail pointeur sur un segment meleme *
  18. * nddl nombre de degre de liberte /noeud *
  19. * lre nombre de ddl dans la matrice de masse *
  20. * nbpgau nombre de point d'integration pour la masse *
  21. * ipmint pointeur sur un segment minte *
  22. * ipmin1 pointeur sur un segment minte (aux noeuds) *
  23. * mele numero de l'element fini *
  24. * mfr numero de la formulation * *
  25. * ivamat pointeur sur un segment mptval pour le materiau ou *
  26. * pour une matrice de hooke *
  27. * ivacar pointeur sur un segment mptval pour les *
  28. * caracteristiques *
  29. * nmatt nombre de composante de materiau (imat=1) *
  30. * iprota pointeur sur un point (vecteur vitesse de rotation) *
  31. * *
  32. * sorties : *
  33. * ________ *
  34. * *
  35. * ipmatr pointeur sur la matrice de masse de la sous-zone *
  36. * *
  37. * Didier COMBESCURE mars 2003 *
  38. *---------------------------------------------------------------------*
  39. IMPLICIT INTEGER(I-N)
  40. IMPLICIT REAL*8(A-H,O-Z)
  41. -INC CCOPTIO
  42. -INC CCHAMP
  43. -INC CCREEL
  44. -INC SMRIGID
  45. -INC SMCHAML
  46. -INC SMELEME
  47. -INC SMCOORD
  48. -INC SMINTE
  49. -INC SMMODEL
  50. c
  51. SEGMENT WRK1
  52. REAL*8 REL(LRE,LRE),XE(3,NBBB)
  53. ENDSEGMENT
  54. c
  55. SEGMENT WRK2
  56. REAL*8 SHPWRK(6,NBNO),BGENE(NDDL,LRE)
  57. ENDSEGMENT
  58. c
  59. SEGMENT WRK5
  60. REAL*8 BLX(NDDL,LRE),BLY(NDDL,LRE),BLZ(NDDL,LRE)
  61. REAL*8 BLT(NDDL,LRE)
  62. ENDSEGMENT
  63. c
  64. c
  65. SEGMENT MVELCH
  66. REAL*8 VALMAT(NV1)
  67. ENDSEGMENT
  68. c
  69. c
  70. SEGMENT MPTVAL
  71. INTEGER IPOS(NS),NSOF(NS)
  72. INTEGER IVAL(NCOSOU)
  73. CHARACTER*16 TYVAL(NCOSOU)
  74. ENDSEGMENT
  75. c
  76. DIMENSION VROT(*)
  77. DIMENSION ROME(3,3)
  78. C ,RELB(LRE,LRE)
  79. *
  80. MELEME=IPMAIL
  81. NBNN=NUM(/1)
  82. NBELEM=NUM(/2)
  83. *
  84. NV1=NMATT
  85. SEGINI,MVELCH
  86. *
  87. xMATRI=IPMATR
  88. LVAL = (LRE*(LRE+1))/2
  89. NLIGRP=LRE
  90. NLIGRD=LRE
  91.  
  92. XDPGE=0.D0
  93. YDPGE=0.D0
  94.  
  95. *
  96. NHRM=NIFOUR
  97. *
  98. MINTE=IPMINT
  99. *
  100. * Remplissage de ROME depuis VROT qui est constant dans tout le modele
  101. ROME(1,1) = (-1.D0)*((VROT(2)**2) + (VROT(3)**2))
  102. ROME(2,2) = (-1.D0)*((VROT(1)**2) + (VROT(3)**2))
  103. ROME(3,3) = (-1.D0)*((VROT(1)**2) + (VROT(2)**2))
  104. ROME(1,2) = VROT(1)*VROT(2)
  105. ROME(1,3) = VROT(1)*VROT(3)
  106. ROME(2,3) = VROT(2)*VROT(3)
  107. ROME(2,1) = ROME(1,2)
  108. ROME(3,1) = ROME(1,3)
  109. ROME(3,2) = ROME(2,3)
  110. c_______________________________________________________________________
  111. c
  112. c numero des etiquettes :
  113. c etiquettes de 1 a 98 pour traitement specifique a l element
  114. c dans la zone specifique a chaque element commencant par :
  115. c 5 continue
  116. c element 5 etiquettes 1005 2005 3005 4005 ...
  117. c 44 continue
  118. c element 44 etiquettes 1044 2044 3044 4044 ...
  119. c_______________________________________________________________________
  120. c
  121. * CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9
  122. GOTO ( 99, 99, 99, 11, 99, 11, 99, 11, 99, 11, 99
  123. * RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT
  124. & , 99, 99, 11, 11, 11, 11, 99, 99, 99, 99, 99
  125. * TET4 TE10 PYR5 PY13 COQ3 DKT POUT LISP FAC3 FAC4 FAC6
  126. & , 11, 11, 11, 11, 99, 99, 99, 99, 99, 99, 99
  127. * FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2
  128. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  129. * POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO
  130. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  131. * COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15
  132. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  133. * THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10
  134. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  135. * IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4
  136. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  137. * JOI6 JOI8 LISC TRIH DST LIC4 CERC TUYO LSE2 LITU HYT3
  138. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  139. * HYQ4 HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8
  140. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  141. * POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13
  142. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  143. * PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8
  144. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  145. * PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3
  146. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  147. * TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126
  148. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  149. * TE56 PY91 TRH6
  150. & , 99, 99, 99),MELE
  151. c_______________________________________________________________________
  152. c_______________________________________________________________________
  153. c
  154. c secteur de calcul pour les elements massifs
  155. c_______________________________________________________________________
  156. c
  157. 11 CONTINUE
  158. DIM3=1.D0
  159. NBNO=NBNN
  160. NBBB=NBNN
  161. SEGINI WRK1,WRK2
  162. I195=0
  163. I259=0
  164. DO 3004 IB=1,NBELEM
  165. c
  166. c on cherche les coordonnees des noeuds de l element ib
  167. c
  168. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  169. CALL ZERO (REL,LRE,LRE)
  170. C CALL ZERO (RELB,LRE,LRE)
  171. c
  172. c boucle sur les points de gauss
  173. c
  174. ISDJC=0
  175. DO 4004 IGAU=1,NBPGAU
  176. *
  177. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  178. 1 DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  179. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  180. IF(DJAC.EQ.0.) I259=IB
  181. DJAC=ABS(DJAC)*POIGAU(IGAU)
  182. MPTVAL=IVAMAT
  183. IF (IVAL(1).NE.0) THEN
  184. MELVAL=IVAL(1)
  185. IGMN=MIN(IGAU,VELCHE(/1))
  186. IBMN=MIN(IB,VELCHE(/2))
  187. VALMAT(1)=VELCHE(IGMN,IBMN)
  188. ELSE
  189. VALMAT(1)=0.D0
  190. ENDIF
  191. DJAC=DJAC*VALMAT(1)
  192. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  193. C
  194. 4004 CONTINUE
  195. C
  196. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  197. * SEGINI XMATRI
  198. * IMATTT(IB)=XMATRI
  199. C
  200. C On bouscule la matrice de masse
  201. C
  202. c CALL MTOKCE(LRE,NDDL,REL,VROT,RE(1,1,ib))
  203. CALL MTOKCE(LRE,NDDL,REL,ROME,RE(1,1,ib))
  204. C CALL REMPMT(REL,LRE,RE)
  205. C
  206. * SEGDES XMATRI
  207. 3004 CONTINUE
  208. IF(I195.NE.0) INTERR(1)=I195
  209. IF(I195.NE.0) CALL ERREUR(195)
  210. IF(I259.NE.0) INTERR(1)=I259
  211. IF(I259.NE.0) CALL ERREUR(259)
  212. SEGDES xMATRI
  213. SEGSUP WRK1,WRK2,MVELCH
  214. GOTO 510
  215. C
  216. c_______________________________________________________________________
  217. *
  218. 99 CONTINUE
  219. MOTERR(1:4)=NOMTP(MELE)
  220. MOTERR(5:12)='KCENT3'
  221. CALL ERREUR(86)
  222. *
  223. 510 CONTINUE
  224. RETURN
  225. END
  226. c
  227.  
  228.  
  229.  
  230.  
  231.  
  232.  
  233.  

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