Télécharger corio3.eso

Retour à la liste

Numérotation des lignes :

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

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