Télécharger coml11.eso

Retour à la liste

Numérotation des lignes :

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

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