Télécharger chatab.eso

Retour à la liste

Numérotation des lignes :

  1. C CHATAB SOURCE PV 14/04/09 21:15:06 8028
  2. subroutine chatab
  3. implicit real*8(a-h,o-z)
  4. implicit integer (i-n)
  5. *
  6. * ce sous programme permet de changer fabriquer un chargement
  7. * defini par deux tables pour le type demandé. ou pour tous les types.
  8. * il ne travaille que sur les chpoints.
  9. *
  10. -INC CCOPTIO
  11. -INC SMCHARG
  12. -INC SMCOORD
  13. -INC SMCHPOI
  14. -INC TMTRAV
  15. -INC SMELEME
  16. -INC SMLREEL
  17. -INC SMTABLE
  18. segment nominc
  19. character*4 noinc(ml)
  20. integer noh(ml)
  21. endsegment
  22. segment mtempo
  23. real*8 tempo(ml)
  24. endsegment
  25. segment iliste
  26. integer listem (ibon)
  27. endsegment
  28. segment mbbb
  29. real*8 bbb(ntem,nnin,nnnoe)
  30. endsegment
  31. pointeur mlree4.mlreel
  32. segment ipass(nnin)
  33. *
  34. segment icpr(xcoor(/1)/( idim+1))
  35. character*4 moty
  36. call lirobj ('CHARGEME',mcharg,1,iretou)
  37. if(ierr.ne.0) return
  38. moty=' '
  39. call lircha(moty,0,ilong)
  40. segact mcharg
  41. ik= kcharg(/1)
  42. *
  43. * on verifie que le type de chargement demandé existe
  44. *
  45. ibon=0
  46. do ikk=1,ik
  47. if(chanom(ikk).eq.moty) ibon=ibon+1
  48. enddo
  49. if(ibon.eq.0) then
  50. call erreur(19)
  51. return
  52. endif
  53. *
  54. * on verifie que les chargelments concernés ont des objets chpoint
  55. *
  56. ibon=0
  57. iprem=0
  58. do ikk=1,ik
  59. if(chanom(ikk).eq.moty)then
  60. icharg=kcharg(ikk)
  61. segact icharg
  62. if(chatyp.eq.'CHPOINT ') then
  63. ibon=ibon+1
  64. if(iprem.eq.0) iprem=ikk
  65. endif
  66. endif
  67. enddo
  68. if(ibon.eq.0) then
  69. call erreur(19)
  70. return
  71. endif
  72. *
  73. * on duplique le'objet en sautant ceux qui vont etre transformés
  74. *
  75. N= ik - ibon + 1
  76. segini mchar1
  77. ipl=1
  78. do ikk=1,N
  79. if(chanom(ikk).eq.moty)then
  80. icharg=kcharg(ikk)
  81. if(chatyp.ne.'CHPOINT ') then
  82. mchar1.kcharg(ipl)=kcharg(ikk)
  83. mchar1.CHANAT(ipl)=CHANAT(ikk)
  84. mchar1.CHANOM(ipl)=CHANOM(ikk)
  85. mchar1.CHAMOB(ipl)=CHAMOB(ikk)
  86. mchar1.CHALIE(ipl)=CHALIE(ikk)
  87. ipl=ipl+1
  88. endif
  89. endif
  90. enddo
  91. *
  92. * debut du travail
  93. *
  94. * on fabrique la liste des inconnues
  95. *
  96. ml=100
  97. segini nominc
  98. nnin=0
  99. do ikk=1,ik
  100. if(chanom(ikk).eq.moty)then
  101. icharg=kcharg(ikk)
  102. if(chatyp.eq.'CHPOINT ') then
  103. mchpoi=ichpo1
  104. segact mchpoi
  105. do ipc=1,ipchp(/1)
  106. msoupo=ipchp(ipc)
  107. segact msoupo
  108. do nc=1,nocomp(/2)
  109. do nomb=1,nnin
  110. if( nocomp(nc).eq.noinc(nomb)) go to 1
  111. enddo
  112. nnin=nnin+1
  113. if( nnin.gt.ml) then
  114. ml= ml+100
  115. segadj nominc
  116. endif
  117. noinc(nnin)=nocomp(nc)
  118. noh(nnin)=noharm(nc)
  119. 1 continue
  120. enddo
  121. enddo
  122. endif
  123. endif
  124. enddo
  125. *
  126. * on fabrique la liste des temps
  127. *
  128. ml = 500
  129. segini mtempo
  130. segini iliste
  131. mlree3=0
  132. do ikk=1,ik
  133. if(chanom(ikk).eq.moty)then
  134. icharg=kcharg(ikk)
  135. if(chatyp.eq.'CHPOINT ') then
  136. mlree1=ichpo2
  137. do ikkm1= 1,ikk-1
  138. if( listem(ikkm1) . eq . mlree1) go to 2
  139. enddo
  140. listem(ikk)=mlree1
  141. if(mlree3.eq.0) then
  142. segini,mlree3=mlree1
  143. else
  144. segact mlree1
  145. jg1=mlree1.prog(/1)
  146. jg3=mlree3.prog(/1)
  147. jg= mlree1.prog(/1)+mlree3.prog(/1)
  148. segini mlree2
  149. i3=1
  150. i1=1
  151. i2=1
  152. 3 continue
  153. if( mlree1.prog(I1).le.mlree3.prog(i3))then
  154. mlree2.prog(i2)=mlree1.prog(I1)
  155. i2=i2+1
  156. if( mlree3.prog(i3).eq.mlree1.prog(I1)) i3 = i3 +1
  157. i1=i1+1
  158. else
  159. mlree2.prog(i2)=mlree3.prog(I3)
  160. i2=i2+1
  161. i3=i3+1
  162. endif
  163. if(i1+i3.le.jg1+jg3)then
  164. if( i1.gt. jg1) then
  165. i2=i2-1
  166. i3=i3-1
  167. do ifi=1,jg3-i3
  168. mlree2.prog(i2+ifi)=mlree3.prog(i3+ifi)
  169. enddo
  170. i2=I2+jg3-i3
  171. elseif (i3.gt.jg3) then
  172. i2=i2-1
  173. i1=i1-1
  174. do ifi=1,jg1-i1
  175. mlree2.prog(i2+ifi)=mlree1.prog(i1+ifi)
  176. enddo
  177. i2=I2+jg1-i1
  178. else
  179. go to 3
  180. endif
  181. endif
  182. jg=i2-1
  183. segsup mlree3
  184. segadj mlree2
  185. mlree3=mlree2
  186. segdes mlree1
  187. endif
  188. endif
  189. endif
  190. 2 continue
  191. enddo
  192.  
  193. ntem=mlree3.prog(/1)
  194. xmax= mlree3.prog(ntem)
  195. xprec= xmax /ntem * 1.d-4
  196. *
  197. * on fabrique la liste des points concernés
  198. *
  199. segini icpr
  200. nnnoe=0
  201. do ikk=1,ik
  202. if(chanom(ikk).eq.moty)then
  203. icharg=kcharg(ikk)
  204. if(chatyp.eq.'CHPOINT ') then
  205. mchpoi=ichpo1
  206. do ipc=1,ipchp(/1)
  207. msoupo=ipchp(ipc)
  208. meleme=igeoc
  209. segact meleme
  210. do iel=1,num(/2)
  211. ip=num(1,iel)
  212. if(icpr(ip).eq.0) then
  213. nnnoe=nnnoe+1
  214. icpr(ip)=nnnoe
  215. endif
  216. enddo
  217. enddo
  218. endif
  219. endif
  220. enddo
  221. nbnn=1
  222. nbelem=nnnoe
  223. nbsous=0
  224. nbref=0
  225. segini ipt4
  226. ipt4.itypel=1
  227. do ip=1,icpr(/1)
  228. if(icpr(ip).ne.0) then
  229. ipt4.num(1,icpr(ip))=ip
  230. endif
  231. enddo
  232. segdes ipt4
  233. *
  234. * on cree le segment mtrav et on cree le segment contenant tous les
  235. * ntem chpoints
  236. *
  237. * write(6,*)'ntem nnin nnnoe tot ',ntem,nnin,nnnoe,ntem*nnin*nnnoe
  238. segini mtrav
  239. segini mbbb
  240. *
  241. * on remplit les tableaux bbb en prenant chargement par chargement
  242. *
  243. segini ipass
  244. jg3=mlree3.prog(/1)
  245. do ikk=1,ik
  246. if(chanom(ikk).eq.moty)then
  247. icharg=kcharg(ikk)
  248. if(chatyp.eq.'CHPOINT ') then
  249. * write(6,*) ' traitement du chargement numero ',ikk
  250. mchpoi=ichpo1
  251. mlree1=ichpo2
  252. mlree4=ichpo3
  253. segact mlree4
  254. segact mlree1
  255. jg1=mlree1.prog(/1)
  256. do ipc=1,ipchp(/1)
  257. msoupo=ipchp(ipc)
  258. meleme=igeoc
  259. segact meleme
  260. mpoval=ipoval
  261. segact mpoval
  262. * on cherche la correspondance nocomp -> noinc
  263. do ipu=1,nocomp(/2)
  264. do jpu=1,nnin
  265. if( nocomp(ipu).eq.noinc(jpu)) then
  266. ipass (ipu)=jpu
  267. go to 5
  268. endif
  269. enddo
  270. 5 continue
  271. enddo
  272. * on boucle sur les temps
  273. I1=1
  274. i3=1
  275. 6 continue
  276. if( mlree3.prog(i3).lt.mlree1.prog(i1)) then
  277. if( i1.eq.1) then
  278. coe = mlree4.prog(1)
  279. else
  280. coe = mlree4.prog(i1-1) +
  281. $ (mlree3.prog(i3) -mlree1.prog(i1-1))/
  282. $ (mlree1.prog(i1) -mlree1.prog(i1-1))*
  283. $ (mlree4.prog(i1)-mlree4.prog(i1-1))
  284. endif
  285. elseif (mlree3.prog(i3).eq.mlree1.prog(i1)) then
  286. coe = mlree4.prog(i1)
  287. i1=I1+1
  288. else
  289. if(i1.eq.jg1) then
  290. coe = mlree4.prog(i1)
  291. else
  292. i1=i1+1
  293. go to 6
  294. endif
  295. endif
  296. do ipp=1,vpocha(/1)
  297. ie=icpr(num(1,ipp))
  298. do inn=1,vpocha(/2)
  299. icomp=ipass(inn)
  300. bbb(i3,icomp,ie)=bbb(i3,icomp,ie)+vpocha(ipp,inn)*coe
  301. enddo
  302. enddo
  303. i3=i3+1
  304. if(i3.le.jg3) go to 6
  305. segdes mpoval,meleme
  306. enddo
  307. segdes mlree1,mlree4,icharg
  308. endif
  309. endif
  310.  
  311. enddo
  312. *
  313. * il faut creer le chargement de type table
  314. *
  315. nc=nnin
  316. n=nnnoe
  317. m=ntem
  318. segini mtab1,mtab2
  319. mtab1.mlotab=ntem
  320. mtab2.mlotab=ntem
  321. do i=1,ntem
  322. mtab1.mtabti(i)='ENTIER'
  323. mtab1.mtabii(i)=i-1
  324. mtab1.mtabtv(i)='CHPOINT '
  325. mtab2.mtabti(i)='ENTIER'
  326. mtab2.mtabii(i)=i-1
  327. mtab2.mtabtv(i)='FLOTTANT'
  328. mtab2.rmtabv(i)=mlree3.prog(i)
  329. nsoupo=1
  330. nat=1
  331. segini mchpoi
  332. mtab1.mtabiv(i)=mchpoi
  333. mtypoi='FORCES'
  334. jattri(1)=2
  335. segini msoupo
  336. ipchp(1)=msoupo
  337. igeoc=ipt4
  338. segini mpoval
  339. ipoval=mpoval
  340. do io=1,nnin
  341. nocomp(io)=noinc(io)
  342. noharm(io)=noh(io)
  343. enddo
  344. do ip=1,nc
  345. do io=1,n
  346. vpocha(io,ip) = bbb(i,ip,io)
  347. enddo
  348. enddo
  349. segdes mpoval
  350. segdes msoupo
  351. segdes mchpoi
  352. enddo
  353. segdes mtab1,mtab2
  354. segdes mlree3
  355. segini icharg
  356. mchar1.kcharg(ipl)=icharg
  357. mchar1.chanat(ipl)='FORCE'
  358. mchar1.CHANOM(ipl)=CHANOM(iprem)
  359. mchar1.CHAMOB(ipl)=CHAMOB(iprem)
  360. mchar1.CHALIE(ipl)=CHALIE(iprem)
  361. CHATYP='TABLE '
  362. ichpo1=mtab2
  363. ichpo2=mtab1
  364. segdes icharg
  365. segdes mchar1,mcharg
  366. call ecrobj('CHARGEME',mchar1)
  367.  
  368. return
  369. end
  370.  
  371.  
  372.  
  373.  

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