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