Télécharger corio3.eso

Retour à la liste

Numérotation des lignes :

  1. C CORIO3 SOURCE BP208322 15/06/22 21:16:46 8543
  2. SUBROUTINE CORIO3(IPMAIL,NDDL,LRE,NBPGAU,IPMINT,
  3. &MELE,MFR,IVAMAT,IVACAR,NMATT,IPMATR,VROT,NUMLIS,IIPDPG)
  4. *---------------------------------------------------------------------*
  5. * __________________________________________________ *
  6. * | | *
  7. * | calcul de la matrice de couplage gyroscopique | *
  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. * vrot vecteur vitesse de rotation *
  31. * *
  32. * sorties : *
  33. * ________ *
  34. * *
  35. * ipmatr pointeur sur la matrice de couplage gyroscopique *
  36. * de la sous-zone *
  37. * *
  38. * Didier COMBESCURE mars 2003 *
  39. *---------------------------------------------------------------------*
  40. IMPLICIT INTEGER(I-N)
  41. IMPLICIT REAL*8(A-H,O-Z)
  42. -INC CCOPTIO
  43. -INC CCHAMP
  44. -INC CCREEL
  45. -INC SMRIGID
  46. -INC SMCHAML
  47. -INC SMELEME
  48. -INC SMCOORD
  49. -INC SMINTE
  50. -INC SMMODEL
  51. c
  52. SEGMENT WRK1
  53. REAL*8 REL(LRE,LRE),XE(3,NBBB)
  54. ENDSEGMENT
  55. c
  56. SEGMENT WRK2
  57. REAL*8 SHPWRK(6,NBNO),BGENE(NDDL,LRE)
  58. ENDSEGMENT
  59. c
  60. SEGMENT WRK5
  61. REAL*8 BLX(NDDL,LRE),BLY(NDDL,LRE),BLZ(NDDL,LRE)
  62. REAL*8 BLT(NDDL,LRE)
  63. ENDSEGMENT
  64. c
  65. SEGMENT MVELCH
  66. REAL*8 VALMAT(NV1)
  67. ENDSEGMENT
  68. c
  69. SEGMENT MPTVAL
  70. INTEGER IPOS(NS),NSOF(NS)
  71. INTEGER IVAL(NCOSOU)
  72. CHARACTER*16 TYVAL(NCOSOU)
  73. ENDSEGMENT
  74. c
  75. DIMENSION VROT(*)
  76. *
  77. MELEME=IPMAIL
  78. c* SEGACT,MELEME
  79. NBNN=NUM(/1)
  80. NBELEM=NUM(/2)
  81. *
  82. NV1=NMATT
  83. SEGINI,MVELCH
  84. *
  85. xMATRI=IPMATR
  86. c* SEGACT,xMATRI
  87. C* NLIGRP=LRE
  88. C* NLIGRD=LRE
  89.  
  90. XDPGE=0.D0
  91. YDPGE=0.D0
  92. *
  93. NHRM=NIFOUR
  94. *
  95. MINTE=IPMINT
  96. c* SEGACT,MINTE
  97.  
  98. c_______________________________________________________________________
  99. c
  100. c numero des etiquettes :
  101. c etiquettes de 1 a 98 pour traitement specifique a l element
  102. c dans la zone specifique a chaque element commencant par :
  103. c 5 continue
  104. c element 5 etiquettes 1005 2005 3005 4005 ...
  105. c 44 continue
  106. c element 44 etiquettes 1044 2044 3044 4044 ...
  107. c_______________________________________________________________________
  108. c
  109. * CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9
  110. GOTO ( 99, 99, 99, 21, 99, 21, 99, 21, 99, 21, 99
  111. * RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT
  112. & , 99, 99, 11, 11, 11, 11, 99, 99, 99, 99, 99
  113. * TET4 TE10 PYR5 PY13 COQ3 DKT POUT LISP FAC3 FAC4 FAC6
  114. & , 11, 11, 11, 11, 99, 99, 99, 99, 99, 99, 99
  115. * FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2
  116. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  117. * POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO
  118. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  119. * COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15
  120. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  121. * THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10
  122. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  123. * IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4
  124. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  125. * JOI6 JOI8 LISC TRIH DST LIC4 CERC TUYO LSE2 LITU HYT3
  126. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  127. * HYQ4 HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8
  128. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  129. * POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13
  130. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  131. * PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8
  132. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  133. * PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3
  134. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  135. * TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126
  136. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  137. * TE56 PY91 TRH6
  138. & , 99, 99, 99),MELE
  139. c_______________________________________________________________________
  140. c
  141. c secteur de calcul pour les elements massifs
  142. c_______________________________________________________________________
  143. c
  144. 11 CONTINUE
  145. DIM3=1.D0
  146. NBNO=NBNN
  147. NBBB=NBNN
  148. SEGINI WRK1,WRK2
  149. DO 1005 IB=1,NBELEM
  150. c
  151. c on cherche les coordonnees des noeuds de l element ib
  152. c
  153. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  154. CALL ZERO (REL,LRE,LRE)
  155. c
  156. c boucle sur les points de gauss
  157. c
  158. ISDJC=0
  159. DO 1004 IGAU=1,NBPGAU
  160. *
  161. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  162. 1 DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  163. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  164. IF (DJAC.EQ.0.) THEN
  165. INTERR(1)= IB
  166. CALL ERREUR(259)
  167. GOTO 9011
  168. ENDIF
  169. DJAC=ABS(DJAC)*POIGAU(IGAU)
  170. MPTVAL=IVAMAT
  171. IF (IVAL(1).NE.0) THEN
  172. MELVAL=IVAL(1)
  173. IGMN=MIN(IGAU,VELCHE(/1))
  174. IBMN=MIN(IB,VELCHE(/2))
  175. VALMAT(1)=VELCHE(IGMN,IBMN)
  176. ELSE
  177. VALMAT(1)=0.D0
  178. ENDIF
  179. DJAC=DJAC*VALMAT(1)
  180. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  181. C
  182. 1004 CONTINUE
  183. C
  184. C+DC On bouscule la matrice de masse
  185. C
  186. IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN
  187. INTERR(1)=IB
  188. CALL ERREUR(195)
  189. GOTO 9011
  190. ENDIF
  191. c
  192. c remplissage de xmatri
  193. c
  194. CALL MTOGYR(LRE,NDDL,REL,VROT,RE(1,1,ib))
  195. C
  196. 1005 CONTINUE
  197.  
  198. 9011 CONTINUE
  199. SEGSUP WRK1,WRK2
  200. GOTO 510
  201. C
  202. c_______________________________________________________________________
  203. c
  204. c secteur de calcul pour les elements 2D en mode de Fourier
  205. c_______________________________________________________________________
  206. c
  207. 21 CONTINUE
  208. DIM3=1.D0
  209. NBNO=NBNN
  210. NBBB=NBNN
  211. SEGINI WRK1,WRK2
  212. DO 2005 IB=1,NBELEM
  213. c
  214. c on cherche les coordonnees des noeuds de l element ib
  215. c
  216. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  217. CALL ZERO (REL,LRE,LRE)
  218. c
  219. c boucle sur les points de gauss
  220. c
  221. ISDJC=0
  222. DO 2004 IGAU=1,NBPGAU
  223. *
  224. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE/2,IFOUR,NIFOUR,NDDL/2,
  225. 1 DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  226. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  227. IF(DJAC.EQ.0.) THEN
  228. INTERR(1)= IB
  229. CALL ERREUR(259)
  230. GOTO 9021
  231. ENDIF
  232. DJAC=ABS(DJAC)*POIGAU(IGAU)
  233. MPTVAL=IVAMAT
  234. IF (IVAL(1).NE.0) THEN
  235. MELVAL=IVAL(1)
  236. IGMN=MIN(IGAU,VELCHE(/1))
  237. IBMN=MIN(IB,VELCHE(/2))
  238. VALMAT(1)=VELCHE(IGMN,IBMN)
  239. ELSE
  240. VALMAT(1)=0.D0
  241. ENDIF
  242. DJAC=DJAC*VALMAT(1)
  243. CALL NTNST(BGENE,DJAC,LRE/2,NDDL/2,REL)
  244. C
  245. 2004 CONTINUE
  246. C
  247. IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN
  248. INTERR(1)=IB
  249. CALL ERREUR(195)
  250. GOTO 9021
  251. ENDIF
  252. c
  253. c remplissage de xmatri
  254. c
  255. IF (NUMLIS.EQ.1) THEN
  256. CALL MTOGY2(LRE/2,NDDL/2,REL,VROT,RE(1,1,ib))
  257. ELSE
  258. CALL MTOGYF(LRE/2,NDDL/2,REL,VROT,RE(1,1,ib))
  259. ENDIF
  260. C
  261. 2005 CONTINUE
  262.  
  263. 9021 CONTINUE
  264. SEGSUP WRK1,WRK2
  265. GOTO 510
  266. c_______________________________________________________________________
  267. *
  268. 99 CONTINUE
  269. MOTERR(1:4)=NOMTP(MELE)
  270. MOTERR(5:12)='CORIO3'
  271. CALL ERREUR(86)
  272. *
  273. 510 CONTINUE
  274. SEGSUP,MVELCH
  275.  
  276. RETURN
  277. END
  278.  
  279.  
  280.  
  281.  

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