Télécharger coml11.eso

Retour à la liste

Numérotation des lignes :

coml11
  1. C COML11 SOURCE JK148537 23/09/08 21:15:03 11733
  2.  
  3. SUBROUTINE COML11(iqmod,wrk52,wrk53,ib,igau, itruli,iretou)
  4.  
  5. IMPLICIT REAL*8(a-h,o-z)
  6. IMPLICIT INTEGER(I-N)
  7.  
  8.  
  9. -INC PPARAM
  10. -INC CCOPTIO
  11. -INC CCREEL
  12. * segment deroulant le mcheml
  13. -INC DECHE
  14. -INC SMCHPOI
  15. -INC SMELEME
  16. -INC SMLENTI
  17. -INC SMLREEL
  18. -INC SMMODEL
  19. *-------------------------------------------------------------
  20. * MODELES DE LIAISONS autres que DYNE
  21. *-------------------------------------------------------------
  22. ** segment sous-structures dynamiques
  23. segment struli
  24. integer itlia,itbmod,momoda, mostat,itmail,molia
  25. integer ldefo(np1),lcgra(np1),lsstru(np1)
  26. integer nsstru,nndefo,nliab,nsb,na2,idimb
  27. integer ktliab,ktphi,ktq,ktres,kpref,ktkam,kcpr,ktpas
  28. INTEGER NIPALB,NXPALB,NPLBB,NPLB,NIP,jliaib
  29. * ichain segment MLENTI initialise dans dyne12 (tjs actif si > 0)
  30. INTEGER ICHAIN
  31. endsegment
  32.  
  33. SEGMENT,MTQ
  34. REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4)
  35. REAL*8 WEXT(NA1,2),WINT(NA1,2)
  36. ENDSEGMENT
  37.  
  38. SEGMENT,MPREF
  39. INTEGER IPOREF(NPREF)
  40. ENDSEGMENT
  41. POINTEUR MPRE1.MPREF
  42. *
  43. CHARACTER*(LOCOMP) mmcc
  44.  
  45. imodel = iqmod
  46. struli = itruli
  47.  
  48. IF (CMATEE.eq.'NEWMOD') THEN
  49.  
  50. xjeu = valmat(1)
  51. xmass0 = valmat(2)
  52. omeg0 = valmat(3)*2.*xpi
  53. xexce = 0.d0
  54. if (valmat(/1).gt.1) then
  55. xexce = valmat(4)
  56. xmu = valmat(5)
  57. mmode2 = int(valmat(6))
  58. endif
  59.  
  60. xdelt = tempf - temp0
  61. if (xdelt.eq.0.or.xmass0.eq.0) then
  62. moterr(1:50) = 'utilisation inappropriée revoir masse et pdt'
  63. call erreur(-385)
  64. interr(1) = imodel
  65. moterr(1:16) = conmod
  66. call erreur(-386)
  67. call erreur(21)
  68. return
  69. endif
  70.  
  71. nexo = exova0(/1)
  72. do ix = 1,nexo
  73. if (nomexo(ix).eq.'VALF') then
  74. alpoin0 = exova0(ix)
  75. endif
  76. enddo
  77.  
  78. * vitesse algo Newmark
  79. unsurh = 1./xdelt
  80. zdept = deplf(1) - depl0(1)
  81. yviti = (2.d0*unsurh*zdept) - alpoin0
  82.  
  83. xk0 = omeg0 * omeg0 * xmass0
  84. * applique correction Newmark, voir Verpeaux Charras
  85. depchoc = 0.d0
  86. if (xjeu.gt.0) then
  87. if ((deplf(1) - xexce).ge.((1.d0 - xzprec)*xjeu)) then
  88. depchoc = xjeu + xexce
  89. endif
  90. else if (xjeu.lt.0) then
  91. if ((deplf(1) - xexce).le.((1.d0 - xzprec)*xjeu)) then
  92. depchoc = xjeu + xexce
  93. endif
  94. endif
  95.  
  96. if (depchoc.ne.0.d0) then
  97. xreac = (xk0 + (xmass0*4.d0/xdelt/xdelt))*
  98. &(depchoc - depl0(1)) - forcf(1) - forc0(1)
  99. &+ (2.d0*xk0*depl0(1)) - (4.d0*xmass0*alpoin0/xdelt)
  100.  
  101. deltaer = xreac * (depchoc - depl0(1)) / 2.d0
  102.  
  103. upoint0 = (2.d0*(depchoc -depl0(1))/xdelt) - alpoin0
  104. xb = xreac * xdelt * upoint0
  105. xa = xdelt*xdelt*xreac*xreac/2.d0/xmass0
  106. xdelta = xb*xb - xa*deltaer*4.d0
  107. if (xdelta.lt.0.) then
  108. call erreur(21)
  109. return
  110. endif
  111. r_z = sqrt(xdelta)
  112. xlambc1 = (-xb + r_z)/(2.d0*xa)
  113. xlambc2 = (-xb - r_z)/(2.d0*xa)
  114.  
  115. alpoinc1 = xlambc1*xdelt*xreac/xmass0
  116. alpoinc2 = xlambc2*xdelt*xreac/xmass0
  117.  
  118. if(((upoint0+alpoinc1)*xreac).gt.0.) then
  119. xcvit = alpoinc1
  120. elseif(((upoint0+alpoinc2)*xreac).gt.0.) then
  121. xcvit = alpoinc2
  122. else
  123. xcvit = 0.d0
  124. endif
  125.  
  126. NC = 2
  127. xreac = xreac * (-1.d0)
  128. else
  129. xreac = 0.d0
  130. xcvit = 0.d0
  131. varf(1) = 0.d0
  132. return
  133. endif
  134.  
  135. meleme = itmail
  136. segact meleme
  137. if (lisous(/1).eq.0) then
  138. ipmmod = itmail
  139. ipmsta = 0
  140. else
  141. ipmmod = lisous(1)
  142. ipmsta = lisous(2)
  143. endif
  144. segdes meleme
  145. meleme = ipmail
  146. segact meleme
  147. ipt1 = ipmmod
  148. segact ipt1
  149. mmcc = ' '
  150. do ijn =1,ipt1.num(/2)
  151. if (num(igau,ib).eq.ipt1.num(1,ijn)) mmcc = 'FALF'
  152. enddo
  153. if (mmcc.ne.'FALF') then
  154. ipt1 = ipmsta
  155. segact ipt1
  156. do ijn =1,ipt1.num(/2)
  157. if (num(igau,ib).eq.ipt1.num(1,ijn)) mmcc = 'FBET'
  158. enddo
  159. endif
  160.  
  161. NSOUPO = 1
  162. NAT=1
  163. SEGINI,MCHPOI
  164. IPCHPO = MCHPOI
  165. MTYPOI = 'FLIAISONS'
  166. IFOPOI = IFOUR
  167. * nature diffuse
  168. JATTRI(1) = 1
  169. nmost0 = 0
  170. KIPCHP = 0
  171. SEGINI,MSOUPO
  172. KIPCHP = KIPCHP + 1
  173. IPCHP(KIPCHP) = MSOUPO
  174. NOCOMP(1) = mmcc
  175. NOHARM(1) = NIFOUR
  176. NBNN = 1
  177. NBELEM = 1
  178. NBSOUS = 0
  179. NBREF = 0
  180. SEGINI IPT2
  181. IPT2.ITYPEL = 1
  182. IPT2.NUM(1,1) = num(igau,ib)
  183. segdes ipt2
  184. IGEOC = ipt2
  185. N = 1
  186. SEGINI,MPOVAL
  187. IPOVAL = MPOVAL
  188. vpocha(1,1) = xreac
  189.  
  190. if(NC.eq.2) then
  191. NOCOMP(2) = mmcc
  192. NOCOMP(2)(1:1) = 'V'
  193. NOHARM(2) = NIFOUR
  194. vpocha(1,2) = xcvit + yviti
  195. endif
  196. SEGDES,MPOVAL,MSOUPO
  197.  
  198. varf(1) = IPCHPO
  199.  
  200. * avec frottement
  201.  
  202. if (xmu.gt.0. .and.mmode2.gt.0) then
  203. mpref = kpref
  204. npref = iporef(/1)
  205. segini mpre1
  206. mtq = ktq
  207. segact mmode2
  208. nsoupo = 1 + mmode2.kmodel(/1)
  209. segadj mchpoi
  210. do im2 = 1, mmode2.kmodel(/1)
  211. imode2 = mmode2.kmodel(im2)
  212. segact imode2
  213. nomid = lnomid(2)
  214. segact nomid
  215. NC = lesobl(/2) + lesfac(/2)
  216. iptu = imode2.imamod
  217. call change(iptu,1)
  218. ipt3 = iptu
  219. segact ipt3
  220. N = ipt3.num(/2)
  221. SEGINI,MPOVAL
  222. do 187 in = 1,N
  223. if (ipt3.num(1,in).eq.num(ib,igau)) then
  224. * write(6,*) 'données erronnées'
  225. call erreur(21)
  226. return
  227. endif
  228. do lf = 1,npref
  229. if (ipt3.num(1,in).eq.iporef(lf)) then
  230. mpre1.iporef(lf) = mpre1.iporef(lf) + 1
  231. if (mpre1.iporef(lf).gt.1) then
  232. * write(6,*) 'données erronnées'
  233. call erreur(21)
  234. return
  235. endif
  236. do jj = 1,NC
  237. if (q2(lf,2).ne.0.d0) then
  238. vpocha(in,jj) = (-1.d0)*q2(lf,2)/ABS(q2(lf,2))
  239. else
  240. vpocha(in,jj) = 0.d0
  241. endif
  242. enddo
  243. goto 187
  244. endif
  245. enddo
  246. * write(6,*)' ne fait pas partie du modele'
  247. call erreur(21)
  248. return
  249. 187 continue
  250. *
  251. SEGINI,MSOUPO
  252. KIPCHP = KIPCHP + 1
  253. IPCHP(KIPCHP) = MSOUPO
  254. ncobl = lesobl(/2)
  255. do jj = 1,ncobl
  256. NOCOMP(jj) = lesobl(jj)
  257. NOHARM(jj) = NIFOUR
  258. enddo
  259. if (lesfac(/2).gt.0) then
  260. do jj = 1,lesfac(/2)
  261. NOCOMP(ncobl + jj) = lesfac(jj)
  262. NOHARM(ncobl + jj) = NIFOUR
  263. enddo
  264. endif
  265. IGEOC = ipt3
  266. IPOVAL = MPOVAL
  267. *
  268. do ii = 1,N
  269. do jj = 1, NC
  270. vpocha(ii,jj) = vpocha(ii,jj)*xmu * ABS(xreac)
  271. enddo
  272. enddo
  273.  
  274. SEGDES,MPOVAL,MSOUPO,imode2
  275. enddo
  276. segdes mmode2
  277. endif
  278.  
  279. segdes MCHPOI
  280. varf(1) = IPCHPO
  281.  
  282. ENDIF
  283.  
  284. RETURN
  285. END
  286.  
  287.  
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  

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