Télécharger gyro3.eso

Retour à la liste

Numérotation des lignes :

  1. C GYRO3 SOURCE PV 20/03/27 21:15:12 10564
  2. SUBROUTINE GYRO3(IPMAIL,LRE,LW,MELE,IVAMAT,NMATT,IVACAR,
  3. &NCARR,IVECT,ISOUS,NBPGAU,IPMINT,IPMIN2,NDDL,MATE,CMATE,
  4. &LHOOK,IPMATR,IIPDPG)
  5. *---------------------------------------------------------------------*
  6. * _________________________________________________ *
  7. * | | *
  8. * | calcul de la matrice de couplage gyroscopique | *
  9. * | Matrice classique dans le repere inertiel | *
  10. * |________________________________________________| *
  11. * *
  12. * poutre,timo,tuyau *
  13. * *
  14. *---------------------------------------------------------------------*
  15. * *
  16. * entrees : *
  17. * ________ *
  18. * *
  19. * ipmail pointeur sur un segment meleme *
  20. * lre nombre de ddl dans la matrice de masse *
  21. * lw dimension du tableau de travail de l'element *
  22. * mele numero de l'element fini *
  23. * ivamat pointeur sur un segment mptval pour le materiau *
  24. * nmatt nombre de composante de materiau (imat=1) *
  25. * ivacar pointeur sur un segment mptval pour les caracteri- *
  26. * stiques *
  27. * ncarr nombre de caracteristiques geometriques *
  28. * ivect flag indiquant si on a entree les axes locaux *
  29. * isous numero de la sous-zone *
  30. * nbpgau nombre de point d'integration pour la masse *
  31. * ipmint pointeur sur un segment minte *
  32. * ipmin1 pointeur sur un segment minte (aux noeuds) *
  33. * nddl nombre de degre de liberte /noeud *
  34. * mate numero du materiau *
  35. * cmate nom du materiau *
  36. * vrot vecteur vitesse de rotation *
  37. * *
  38. * sorties : *
  39. * ________ *
  40. * *
  41. * ipmatr pointeur sur la matrice d'amortissement *
  42. * de la sous-zone *
  43. * *
  44. * Didier COMBESCURE mars 2003 *
  45. * *
  46. *---------------------------------------------------------------------*
  47. IMPLICIT INTEGER(I-N)
  48. IMPLICIT REAL*8(A-H,O-Z)
  49.  
  50. -INC PPARAM
  51. -INC CCOPTIO
  52. -INC CCHAMP
  53. -INC CCREEL
  54. *-
  55. -INC SMRIGID
  56. -INC SMCHAML
  57. -INC SMELEME
  58. -INC SMCOORD
  59. -INC SMINTE
  60. -INC SMMODEL
  61. C
  62. SEGMENT WRK1
  63. REAL*8 REL(LRE,LRE),XE(3,NBBB)
  64. ENDSEGMENT
  65. C
  66. SEGMENT WRK2
  67. REAL*8 SHPWRK(6,NBNO),BGENE(NDDL,LRE)
  68. ENDSEGMENT
  69. C
  70. SEGMENT WRK3
  71. REAL*8 DDHOOK(LHOOK,LHOOK)
  72. REAL*8 WORK(LW)
  73. ENDSEGMENT
  74. C
  75. SEGMENT WRK4
  76. REAL*8 BPSS(3,3),XEL(3,NBBB)
  77. ENDSEGMENT
  78. C
  79. SEGMENT WRK6
  80. REAL*8 RHOMAT(6,6)
  81. ENDSEGMENT
  82. C
  83. SEGMENT MVELCH
  84. REAL*8 VALMAT(NV1)
  85. ENDSEGMENT
  86. C
  87. SEGMENT MPTVAL
  88. INTEGER IPOS(NS),NSOF(NS)
  89. INTEGER IVAL(NCOSOU)
  90. CHARACTER*16 TYVAL(NCOSOU)
  91. ENDSEGMENT
  92. *
  93. DIMENSION CRIGI(12),CMASS(12)
  94. CHARACTER*8 CMATE
  95. *
  96. MELEME=IPMAIL
  97. NBNN=NUM(/1)
  98. NBELEM=NUM(/2)
  99. *
  100. NV1=NMATT
  101. SEGINI,MVELCH
  102. *
  103. xMATRI=IPMATR
  104. LVAL = (LRE*(LRE+1))/2
  105. NLIGRP=LRE
  106. NLIGRD=LRE
  107. *
  108. NHRM=NIFOUR
  109. *
  110. MINTE=IPMINT
  111. MINTE2=IPMIN2
  112. C_______________________________________________________________________
  113. C
  114. C NUMERO DES ETIQUETTES :
  115. C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  116. C DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR :
  117. C 5 CONTINUE
  118. C ELEMENT 5 ETIQUETTES 1005 2005 3005 4005 ...
  119. C 44 CONTINUE
  120. C ELEMENT 44 ETIQUETTES 1044 2044 3044 4044 ...
  121. C_______________________________________________________________________
  122. C
  123. GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  124. 199,99,99,99,99,99,27,99,27,99,99,99,99,99,99,99,99,99,99,99,
  125. 299,27,99,99,99,27,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  126. 399,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  127. 499,99,99,27,99,99,99,99,99,99,99,99,99,99,99,99,99),MELE
  128. GOTO 99
  129. C_______________________________________________________________________
  130. C_______________________________________________________________________
  131. C
  132. C ELEMENTS POUTRES
  133. C_______________________________________________________________________
  134. C
  135. 27 CONTINUE
  136. C
  137. C CAS DES POUTRES - TUYAUX
  138. C
  139. NBBB=NBNN
  140. SEGINI WRK1,WRK3
  141. *
  142. * cas du materiau section
  143. *
  144. NBGMAT = 0
  145. NELMAT = 0
  146. IF(CMATE.EQ.'SECTION') THEN
  147. MPTVAL=IVAMAT
  148. DO IM=1,NMATT
  149. IF(IVAL(IM).NE.0)THEN
  150. MELVAL=IVAL(IM)
  151. NBGMAT=MAX(NBGMAT,IELCHE(/1))
  152. NELMAT=MAX(NELMAT,IELCHE(/2))
  153. END IF
  154. END DO
  155. ENDIF
  156. C
  157. C BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS
  158. C
  159. DO 3027 IB=1,NBELEM
  160. C
  161. C ON CHERCHE LES COORDONNEES DE L ELEMENT IB
  162. C
  163. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  164. C
  165. C
  166. C CAS DES POUTRES
  167. C --------------
  168. C ON STOCKE DES CARACTERISTIQUES GEOMETRIQUES ET MATERIELLES DANS WORK
  169. C
  170. 5029 CONTINUE
  171. C
  172. C ON CHERCHE LES CARACTERISTIQUES DE L ELEMENT IB ( GEOMETRIE ET MASSE
  173. C
  174. C
  175. NCARR1=NCARR
  176. IF(IVECT.EQ.1) NCARR1=NCARR-1
  177. CALL ZERO(WORK,NCARR1,1)
  178. DO 4029 IGAU=1,NBNN
  179. MPTVAL=IVACAR
  180. DO 6029 IC=1,NCARR1
  181. MELVAL=IVAL(IC)
  182. IF (IVAL(IC).NE.0) THEN
  183. IBMN=MIN(IB,VELCHE(/2))
  184. IGMN=MIN(IGAU,VELCHE(/1))
  185. WORK(IC)=WORK(IC)+VELCHE(IGMN,IBMN)
  186. ELSE
  187. WORK(IC)=0.D0
  188. ENDIF
  189. IF (IGAU.EQ.NBNN) WORK(IC)=WORK(IC)/NBNN
  190. 6029 CONTINUE
  191. 4029 CONTINUE
  192. C
  193. C CAS OU ON A LU LE MOT VECTEUR
  194. C
  195. IF (IVECT.EQ.1) THEN
  196. IF (IVAL(NCARR).NE.0) THEN
  197. MELVAL=IVAL(NCARR)
  198. IBMN=MIN(IB,IELCHE(/2))
  199. IP=IELCHE(1,IBMN)
  200. IREF=(IP-1)*(IDIM+1)
  201. DO 6129 IC=1,IDIM
  202. WORK(NCARR+IC-1)=XCOOR(IREF+IC)
  203. 6129 CONTINUE
  204. ELSE
  205. DO 6229 IC=1,IDIM
  206. WORK(NCARR+IC-1)=0.
  207. 6229 CONTINUE
  208. ENDIF
  209. ENDIF
  210. C
  211. MPTVAL=IVAMAT
  212. C
  213. C CAS DES POUTRES ET TUYAU
  214. C
  215. MELVAL=IVAL(1)
  216. IF(CMATE.NE.'SECTION') THEN
  217. IBMN=MIN(IB,VELCHE(/2))
  218. C
  219. WORK(11)=VELCHE(1,IBMN)
  220. C
  221. C CAS DES TUYAUX - ON CALCULE LES CARACTERISTIQUES DE LA POUTRE
  222. C -------------- EQUIVALENTE
  223. C
  224. IF(MELE.EQ.42) CALL TUYCAG(WORK,KERRE,1)
  225. ELSE
  226. *
  227. * cas formulation section
  228. *
  229. IBMN=MIN(IB,IELCHE(/2))
  230. IPMODL=IELCHE(1,IBMN)
  231. MELVAL=IVAL(2)
  232. IBMN=MIN(IB,IELCHE(/2))
  233. IPMAT=IELCHE(1,IBMN)
  234. IF (IB.LE.NELMAT.OR.NBGMAT.GT.1)THEN
  235. CALL FRIGIE(IPMODL,IPMAT,CRIGI,CMASS)
  236. CALL DOGTIF(CMASS,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  237. ENDIF
  238. ENDIF
  239. C
  240. C ON CALCULE LA MATRICE DE COUPLAGE GYROSCOPIQUE
  241. C
  242. IF (MELE.EQ.84) THEN
  243. IF(CMATE.NE.'SECTION') THEN
  244. CALL TIMGYR(REL,LRE,WORK,XE,WORK(12),KERRE)
  245. ELSE
  246. CALL TIFGYR(REL,LRE,WORK,XE,WORK(12),LHOOK,
  247. & DDHOOK,KERRE)
  248. ENDIF
  249. ELSE
  250. CALL POUGYR(REL,LRE,WORK,XE,WORK(12),KERRE)
  251. ENDIF
  252. C
  253. IF(KERRE.EQ.0) GO TO 4027
  254. INTERR(1)=ISOUS
  255. INTERR(2)=IB
  256. SEGSUP WRK1,WRK3,MVELCH
  257. CALL ERREUR(128)
  258. SEGSUP xMATRI
  259. GO TO 510
  260. C
  261. 4027 CONTINUE
  262. * SEGINI XMATRI
  263. * IMATTT(IB)=XMATRI
  264. DO 4028 IIIA=1,LRE
  265. DO 4028 IIIB=1,LRE
  266. RE(IIIA,IIIB,ib)=REL(IIIA,IIIB)
  267. 4028 CONTINUE
  268. C
  269. 3027 CONTINUE
  270. SEGSUP WRK1,WRK3,MVELCH
  271. GO TO 510
  272. C_______________________________________________________________________
  273. *
  274. 99 CONTINUE
  275. MOTERR(1:4)=NOMTP(MELE)
  276. MOTERR(5:12)='GYRO2'
  277. CALL ERREUR(86)
  278. *
  279. 510 CONTINUE
  280. RETURN
  281. END
  282. C
  283.  
  284.  
  285.  
  286.  
  287.  
  288.  

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