Télécharger chatab.eso

Retour à la liste

Numérotation des lignes :

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

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