Télécharger gyro3.eso

Retour à la liste

Numérotation des lignes :

  1. C GYRO3 SOURCE BP208322 15/06/22 21:19:07 8543
  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. -INC CCOPTIO
  50. -INC CCHAMP
  51. -INC CCREEL
  52. *-
  53. -INC SMRIGID
  54. -INC SMCHAML
  55. -INC SMELEME
  56. -INC SMCOORD
  57. -INC SMINTE
  58. -INC SMMODEL
  59. C
  60. SEGMENT WRK1
  61. REAL*8 REL(LRE,LRE),XE(3,NBBB)
  62. ENDSEGMENT
  63. C
  64. SEGMENT WRK2
  65. REAL*8 SHPWRK(6,NBNO),BGENE(NDDL,LRE)
  66. ENDSEGMENT
  67. C
  68. SEGMENT WRK3
  69. REAL*8 DDHOOK(LHOOK,LHOOK)
  70. REAL*8 WORK(LW)
  71. ENDSEGMENT
  72. C
  73. SEGMENT WRK4
  74. REAL*8 BPSS(3,3),XEL(3,NBBB)
  75. ENDSEGMENT
  76. C
  77. SEGMENT WRK6
  78. REAL*8 RHOMAT(6,6)
  79. ENDSEGMENT
  80. C
  81. SEGMENT MVELCH
  82. REAL*8 VALMAT(NV1)
  83. ENDSEGMENT
  84. C
  85. SEGMENT MPTVAL
  86. INTEGER IPOS(NS),NSOF(NS)
  87. INTEGER IVAL(NCOSOU)
  88. CHARACTER*16 TYVAL(NCOSOU)
  89. ENDSEGMENT
  90. *
  91. DIMENSION CRIGI(12),CMASS(12)
  92. CHARACTER*8 CMATE
  93. *
  94. MELEME=IPMAIL
  95. NBNN=NUM(/1)
  96. NBELEM=NUM(/2)
  97. *
  98. NV1=NMATT
  99. SEGINI,MVELCH
  100. *
  101. xMATRI=IPMATR
  102. LVAL = (LRE*(LRE+1))/2
  103. NLIGRP=LRE
  104. NLIGRD=LRE
  105. *
  106. NHRM=NIFOUR
  107. *
  108. MINTE=IPMINT
  109. MINTE2=IPMIN2
  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. GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  122. 199,99,99,99,99,99,27,99,27,99,99,99,99,99,99,99,99,99,99,99,
  123. 299,27,99,99,99,27,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  124. 399,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  125. 499,99,99,27,99,99,99,99,99,99,99,99,99,99,99,99,99),MELE
  126. GOTO 99
  127. C_______________________________________________________________________
  128. C_______________________________________________________________________
  129. C
  130. C ELEMENTS POUTRES
  131. C_______________________________________________________________________
  132. C
  133. 27 CONTINUE
  134. C
  135. C CAS DES POUTRES - TUYAUX
  136. C
  137. NBBB=NBNN
  138. SEGINI WRK1,WRK3
  139. *
  140. * cas du materiau section
  141. *
  142. NBGMAT = 0
  143. NELMAT = 0
  144. IF(CMATE.EQ.'SECTION') THEN
  145. MPTVAL=IVAMAT
  146. DO IM=1,NMATT
  147. IF(IVAL(IM).NE.0)THEN
  148. MELVAL=IVAL(IM)
  149. NBGMAT=MAX(NBGMAT,IELCHE(/1))
  150. NELMAT=MAX(NELMAT,IELCHE(/2))
  151. END IF
  152. END DO
  153. ENDIF
  154. C
  155. C BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS
  156. C
  157. DO 3027 IB=1,NBELEM
  158. C
  159. C ON CHERCHE LES COORDONNEES DE L ELEMENT IB
  160. C
  161. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  162. C
  163. C
  164. C CAS DES POUTRES
  165. C --------------
  166. C ON STOCKE DES CARACTERISTIQUES GEOMETRIQUES ET MATERIELLES DANS WORK
  167. C
  168. 5029 CONTINUE
  169. C
  170. C ON CHERCHE LES CARACTERISTIQUES DE L ELEMENT IB ( GEOMETRIE ET MASSE
  171. C
  172. C
  173. NCARR1=NCARR
  174. IF(IVECT.EQ.1) NCARR1=NCARR-1
  175. CALL ZERO(WORK,NCARR1,1)
  176. DO 4029 IGAU=1,NBNN
  177. MPTVAL=IVACAR
  178. DO 6029 IC=1,NCARR1
  179. MELVAL=IVAL(IC)
  180. IF (IVAL(IC).NE.0) THEN
  181. IBMN=MIN(IB,VELCHE(/2))
  182. IGMN=MIN(IGAU,VELCHE(/1))
  183. WORK(IC)=WORK(IC)+VELCHE(IGMN,IBMN)
  184. ELSE
  185. WORK(IC)=0.D0
  186. ENDIF
  187. IF (IGAU.EQ.NBNN) WORK(IC)=WORK(IC)/NBNN
  188. 6029 CONTINUE
  189. 4029 CONTINUE
  190. C
  191. C CAS OU ON A LU LE MOT VECTEUR
  192. C
  193. IF (IVECT.EQ.1) THEN
  194. IF (IVAL(NCARR).NE.0) THEN
  195. MELVAL=IVAL(NCARR)
  196. IBMN=MIN(IB,IELCHE(/2))
  197. IP=IELCHE(1,IBMN)
  198. IREF=(IP-1)*(IDIM+1)
  199. DO 6129 IC=1,IDIM
  200. WORK(NCARR+IC-1)=XCOOR(IREF+IC)
  201. 6129 CONTINUE
  202. ELSE
  203. DO 6229 IC=1,IDIM
  204. WORK(NCARR+IC-1)=0.
  205. 6229 CONTINUE
  206. ENDIF
  207. ENDIF
  208. C
  209. MPTVAL=IVAMAT
  210. C
  211. C CAS DES POUTRES ET TUYAU
  212. C
  213. MELVAL=IVAL(1)
  214. IF(CMATE.NE.'SECTION') THEN
  215. IBMN=MIN(IB,VELCHE(/2))
  216. C
  217. WORK(11)=VELCHE(1,IBMN)
  218. C
  219. C CAS DES TUYAUX - ON CALCULE LES CARACTERISTIQUES DE LA POUTRE
  220. C -------------- EQUIVALENTE
  221. C
  222. IF(MELE.EQ.42) CALL TUYCAG(WORK,KERRE,1)
  223. ELSE
  224. *
  225. * cas formulation section
  226. *
  227. IBMN=MIN(IB,IELCHE(/2))
  228. IPMODL=IELCHE(1,IBMN)
  229. MELVAL=IVAL(2)
  230. IBMN=MIN(IB,IELCHE(/2))
  231. IPMAT=IELCHE(1,IBMN)
  232. IF (IB.LE.NELMAT.OR.NBGMAT.GT.1)THEN
  233. CALL FRIGIE(IPMODL,IPMAT,CRIGI,CMASS)
  234. CALL DOGTIF(CMASS,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  235. ENDIF
  236. ENDIF
  237. C
  238. C ON CALCULE LA MATRICE DE COUPLAGE GYROSCOPIQUE
  239. C
  240. IF (MELE.EQ.84) THEN
  241. IF(CMATE.NE.'SECTION') THEN
  242. CALL TIMGYR(REL,LRE,WORK,XE,WORK(12),KERRE)
  243. ELSE
  244. CALL TIFGYR(REL,LRE,WORK,XE,WORK(12),LHOOK,
  245. & DDHOOK,KERRE)
  246. ENDIF
  247. ELSE
  248. CALL POUGYR(REL,LRE,WORK,XE,WORK(12),KERRE)
  249. ENDIF
  250. C
  251. IF(KERRE.EQ.0) GO TO 4027
  252. INTERR(1)=ISOUS
  253. INTERR(2)=IB
  254. SEGSUP WRK1,WRK3,MVELCH
  255. CALL ERREUR(128)
  256. SEGSUP xMATRI
  257. GO TO 510
  258. C
  259. 4027 CONTINUE
  260. * SEGINI XMATRI
  261. * IMATTT(IB)=XMATRI
  262. DO 4028 IIIA=1,LRE
  263. DO 4028 IIIB=1,LRE
  264. RE(IIIA,IIIB,ib)=REL(IIIA,IIIB)
  265. 4028 CONTINUE
  266. C
  267. * SEGDES XMATRI
  268. 3027 CONTINUE
  269. SEGDES xMATRI
  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.  

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