Télécharger cmoda2.eso

Retour à la liste

Numérotation des lignes :

  1. C CMODA2 SOURCE BP208322 17/03/01 21:15:55 9325
  2. SUBROUTINE CMODA2(wrk52,wrk53,xdt,
  3. & IB,IGAU,NBPGAU,NBGMAT,NELMAT,IFOURB)
  4. *
  5. *
  6. *
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8 (A-H,O-Z)
  9. -INC CCOPTIO
  10. -INC CCREEL
  11. -INC DECHE
  12. -INC SMLREEL
  13. -INC SMEVOLL
  14. -INC SMLMOTS
  15. -INC SMELEME
  16. -INC SMCHPOI
  17.  
  18. CHARACTER*4 lesinc(7),lesdua(7)
  19. DATA lesinc/'UX','UY','UZ','RX','RY','RZ','UR'/
  20. DATA lesdua/'FX','FY','FZ','MX','MY','MZ','FR'/
  21. *
  22. IF (cmate.eq.'MODAL') THEN
  23. c caracteristiques freq, mass
  24. freq1 = valmat(1)
  25. xmass1 = valmat(2)
  26. omeg1 = 2. * xpi * freq1
  27. xamor1 = valmat(4)
  28. *
  29. do jj = 1,epstf(/1)
  30. if (jj.eq.1) jjsi = 1
  31. if (jj.eq.2) jjsi = 3
  32. effx = epstf(jj)
  33. sigf(jjsi) = effx * xmass1 * omeg1 * omeg1
  34. c write(6,*) 'cda2 ', jj, effx, xmass1,omeg1,sigf(jjsi)
  35. if (ifomod.eq.6.) then
  36. omef = 2.*xpi*tempf
  37. sigf(jjsi) = sigf(jjsi) - (effx * xmass1 * omef * omef)
  38. * write(6,*) sigf(1), effx, xmass1 , (omef*omef)
  39. if (jj.eq.2) sigf(jjsi) = sigf(jjsi) * (-1)
  40. if (xamor1.ne.0..and.epstf(/1).gt.1) then
  41. if (jj.eq.1) j2 = 2
  42. if (jj.eq.2) j2 = 1
  43. sigf(jjsi) = sigf(jjsi) + omef*xamor1*omeg1*xmass1*epstf(j2)
  44. endif
  45. * write(6,*) 'cda2 ', jj, effx, freq1,xmass1,omeg1,sigf(jjsi)
  46. endif
  47. enddo
  48. ENDIF
  49.  
  50. IF (cmate.eq.'STATIQUE'.or.cmate.eq.'MODAL') THEN
  51.  
  52. IPCHPO = 0
  53. if (cmate.eq.'STATIQUE') then
  54. if (valmat(5).gt.0) then
  55. lricr = nint(valmat(5))
  56. ipmmod = nint(valmat(6))
  57. ipmsta = nint(valmat(7))
  58. lmacr = nint(valmat(8))
  59. lamcr = nint(valmat(9))
  60. else
  61. call erreur(26)
  62. return
  63. endif
  64. elseif(cmate.eq.'MODAL') then
  65. if (valmat(7).gt.0) then
  66. lricr = nint(valmat(7))
  67. ipmmod = 0
  68. ipmsta = nint(valmat(8))
  69. lmacr = nint(valmat(9))
  70. lamcr = nint(valmat(10))
  71. else
  72. return
  73. endif
  74. endif
  75. mlreel = lricr
  76. segact mlreel
  77.  
  78. if(ifomod.eq.6) then
  79. mlree1 = lmacr
  80. segact mlree1
  81. omef = 2.*xpi*tempf
  82. if (mlree1.prog(/1).le.0)then
  83. call erreur(5)
  84. return
  85. endif
  86. if (lamcr.gt.0) then
  87. mlree2 = lamcr
  88. segact mlree2
  89. endif
  90. endif
  91. *
  92. if (prog(/1).le.0) then
  93. call erreur(5)
  94. return
  95. endif
  96.  
  97. JG0 = 0
  98. DO 212 jj = 1,epstf(/1)
  99. if (jj.eq.1) jjsi = 1
  100. if (jj.eq.2) jjsi = 3
  101. if (jj.eq.1) j2 = 2
  102. if (jj.eq.2) j2 = 1
  103. effx = epstf(jj)
  104. sigf(2) = 0
  105. c write(6,*) 'c2',prog(/1),mlree1.prog(/1),lamcr,effx
  106.  
  107. IF (cmate.eq.'STATIQUE') THEN
  108. if (prog(/1).eq.1) then
  109. sigf(jjsi) = effx * prog(1)
  110. if(ifomod.eq.6) then
  111. sigf(jjsi) = sigf(jjsi) - (effx * mlree1.prog(1) * omef * omef)
  112. if (jj.eq.2) sigf(jjsi) = sigf(jjsi) * (-1)
  113. if (lamcr.gt.0) then
  114. if (mlree2.prog(1).ne.0..and.epstf(/1).gt.1) then
  115. sigf(jjsi) = sigf(jjsi) + omef*mlree2.prog(1)*epstf(j2)
  116. endif
  117. endif
  118. endif
  119. goto 212
  120. if (jj.eq.epstf(/1)) then
  121. segdes mlreel
  122. if (ifomod.eq.6) then
  123. segdes mlree1
  124. if (lamcr.gt.0) segdes mlree2
  125. endif
  126. return
  127. endif
  128. else
  129. sigf(jjsi) = 0.d0
  130. endif
  131. ENDIF
  132.  
  133. *
  134. if (jj.eq.1) then
  135. NSOUPO = 1
  136. if(ipmmod.gt.0.and.ipmsta.gt.0) NSOUPO = 2
  137. NAT=1
  138. SEGINI,MCHPOI
  139. IPCHPO = MCHPOI
  140. MTYPOI = 'FMODSTA'
  141. IFOPOI = IFOUR
  142. * nature diffuse
  143. JATTRI(1) = 1
  144. nmo0 = 0
  145. KIPCHP = 0
  146. if (ipmmod.gt.0) then
  147. NC = epstf(/1)
  148. SEGINI,MSOUPO
  149. KIPCHP = KIPCHP + 1
  150. IPCHP(KIPCHP) = MSOUPO
  151. NOCOMP(1) = 'FALF'
  152. NOHARM(1) = NIFOUR
  153. if (epstf(/1).eq.2) then
  154. NOCOMP(2) = 'IFAL'
  155. NOHARM(2) = NIFOUR
  156. endif
  157. IGEOC = ipmmod
  158. ipt1 = ipmmod
  159. segact ipt1
  160. N = ipt1.num(/2)
  161. nmo0 = N
  162. JG0 = JG0 + N
  163. SEGINI,MPOVAL
  164. IPOVAL = MPOVAL
  165. ipomo0 = ipoval
  166. endif
  167. endif
  168. *
  169. if (ipmmod.gt.0) then
  170. N = nmo0
  171. mpoval = ipomo0
  172. do ii = 1,N
  173. c write(6,*) 'cc',vpocha(/1),vpocha(/2),ii,jj,prog(/1)
  174. vpocha(ii,jj) = prog(ii)*effx
  175. if (ifomod.eq.6) then
  176. vpocha(ii,jj) = vpocha(ii,jj) - (effx*mlree1.prog(ii)*omef*omef)
  177. if (jj.eq.2) vpocha(ii,jj) = vpocha(ii,jj) * (-1)
  178. if (lamcr.gt.0) then
  179. if (mlree2.prog(ii).ne.0..and.epstf(/1).gt.1) then
  180. vpocha(ii,jj) = vpocha(ii,jj) + omef*mlree2.prog(ii)*epstf(j2)
  181. endif
  182. endif
  183. endif
  184. * write(6,*)'m',effx,ii,ipt1.num(1,ii),mlree1.prog(ii),vpocha(ii,1)
  185. enddo
  186.  
  187. if (jj.eq.epstf(/1)) SEGDES,MPOVAL,MSOUPO
  188. endif
  189.  
  190. if (jj.eq.1) then
  191. if (ipmsta.gt.0) then
  192. NC = epstf(/1)
  193. SEGINI,MSOUPO
  194. KIPCHP = KIPCHP + 1
  195. IPCHP(KIPCHP) = MSOUPO
  196. NOCOMP(1) = 'FBET'
  197. NOHARM(1) = NIFOUR
  198. if (epstf(/1).eq.2) then
  199. NOCOMP(2) = 'IFBE'
  200. NOHARM(2) = NIFOUR
  201. endif
  202. IGEOC = ipmsta
  203. ipt1 = ipmsta
  204. segact ipt1
  205. N = ipt1.num(/2)
  206. nst0 = N
  207. SEGINI,MPOVAL
  208. IPOVAL = MPOVAL
  209. ipost0 = ipoval
  210. endif
  211. endif
  212. *
  213. if (ipmsta.gt.0) then
  214. N = nst0
  215. mpoval = ipost0
  216. do ii = 1,N
  217. vpocha(ii,jj) = prog(JG0 + ii)*effx
  218. if (ifomod.eq.6) then
  219. vpocha(ii,jj) = vpocha(ii,jj) -
  220. & (effx*mlree1.prog(JG0 + ii)*omef*omef)
  221. if (jj.eq.2) vpocha(ii,jj) = vpocha(ii,jj) * (-1)
  222. if (lamcr.gt.0) then
  223. if (mlree2.prog(JG0 + ii).ne.0..and.epstf(/1).gt.1) then
  224. vpocha(ii,jj) = vpocha(ii,jj) +
  225. &omef*mlree2.prog(JG0 + ii)*epstf(j2)
  226. endif
  227. endif
  228. endif
  229. c write(6,*)'s',effx,ii,ipt1.num(1,ii),mlree2.prog(JG0 +ii),
  230. c &vpocha(ii,1),ipchpo
  231. enddo
  232. c write(6,*)'s',(mlree2.prog(JG0+ii),ii=1,N),(vpocha(ii,jj),ii=1,N)
  233. if (jj.eq.epstf(/1)) SEGDES,MPOVAL
  234. endif
  235.  
  236. 212 CONTINUE
  237. * ENDDO
  238.  
  239. if (IPCHPO.gt.0) segdes MCHPOI
  240. sigf(2) = IPCHPO
  241. c write(6,*) cmate,epstf(/1),epstf(1),epstf(2)
  242. c write(6,*)'c2',cmate,sigf(/1),jj,(sigf(ll),ll = 1,sigf(/1))
  243. segdes mlreel
  244. if (ifomod.eq.6) then
  245. segdes mlree1
  246. if (lamcr.gt.0) segdes mlree2
  247. endif
  248. return
  249. ENDIF
  250.  
  251.  
  252. IF (cmate.EQ.'IMPELAST'.or.cmate.eq.'IMPVOIGT') THEN
  253. xraid = xmat(1)
  254.  
  255. do ig = 1,epstf(/1)
  256. sigf(ig) = xraid * epstf(ig)
  257. enddo
  258. * write(6,*) 'cmoda2', (sigf(ll), ll = 1,3)
  259. IF (cmate.eq.'IMPVOIGT') THEN
  260. xvisc = xmat(2)
  261. do ig = 1,epstf(/1)
  262. sigf(ig) = sigf(ig) + (xvisc* (epstf(ig) - epst0(ig)) / xdt)
  263. enddo
  264. ENDIF
  265. IF (mele.eq.45) THEN
  266. ENDIF
  267. ENDIF
  268.  
  269.  
  270. IF (cmate.EQ.'IMPREUSS') THEN
  271. xraid = xmat(1)
  272. xvisc = xmat(2)
  273. do ig = 1,epstf(/1)
  274. xepe0 = var0(ig)
  275.  
  276. if (xdt.ne.0) then
  277. * xx = (epstf(ig) - epst0(ig) + xepe0) * xvisc / xdt
  278. yy = (xraid + (xvisc /xdt))
  279. xx = (xraid*epstf(ig)) + (xvisc*xepe0/xdt)
  280. varf(ig) = xx / yy
  281. else
  282. varf(ig) = var0(ig)
  283. endif
  284. sigf(ig) = (epstf(ig)- varf(ig)) * xraid
  285. enddo
  286. * write(6,*) 'cmoda2 ',epstf(/1), epin0(/1),xepe0, epstf(1)
  287. ENDIF
  288.  
  289. if(ifomod.eq.6) then
  290. IF (cmate.EQ.'IMPCOMPL') THEN
  291. xraid = xmat(2)
  292. xamo1 = xmat(3)
  293. xmass1 = xmat(4)
  294. omef = 2.*xpi*tempf
  295. * write(6,*) 'ccompl', xraid,xamo1,xmass1,epstf(/1),sigf(/1)
  296. do ig = 1,epstf(/1)
  297. if (ig.eq.1) j2 = 2
  298. if (ig.eq.2) j2 = 1
  299. effx = epstf(ig)
  300. sigf(ig) = xraid * epstf(ig)
  301. if(xmass1.gt.0) then
  302. sigf(1) = sigf(1) - (effx * xmass1 * omef * omef)
  303. * write(6,*) sigf(1), effx, xmass1 , (omef*omef)
  304. endif
  305. if (ig.eq.2) sigf(ig) = sigf(ig)*(-1)
  306. if (xamo1.ne.0.) sigf(ig) = sigf(ig) + xamo1*omef*epstf(j2)
  307. enddo
  308. * write(6,*) (epstf(ij),ij=1,2),(sigf(ij),ij=1,2)
  309. ENDIF
  310. endif
  311.  
  312. RETURN
  313. END
  314.  
  315.  
  316.  
  317.  
  318.  
  319.  
  320.  
  321.  
  322.  
  323.  
  324.  
  325.  
  326.  
  327.  
  328.  
  329.  

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