Télécharger cmoda2.eso

Retour à la liste

Numérotation des lignes :

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

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