1 : C REPART SOURCE FANDEUR 10/01/12 21:15:51 6600 2 : subroutine repart(mrigid) 3 : * 4 : * repartitionne une raideur pour la limiter a un enregistrement gemat 5 : * par sous-zone. Ca optimise gemat. 6 : * 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8(A-H,O-Z) 9 : 10 : -INC SMELEME 11 : -INC SMRIGID 12 : 13 : MACRO, MSLS1(IS) = JSG(IS+1) 14 : MACRO, JSG = OOV 15 : MACRO, JDE = OOA 16 : MACRO, MDISG(ID) 17 : MDISG = (SIGN(ABS(JDE(OOT+(ID))+OOT),OOT)-MSLZ1) 18 : ENDMACRO 19 : MACRO, MSLZ1 = 4 20 : 21 : INTEGER OOOVAL 22 : * 23 : LTRK=OOOVAL(1,4) 24 : if (LTRK.eq.0) LTRK=oooval(1,1) 25 : 26 : iafair=0 27 : nbs=0 28 : segact mrigid 29 : do 100 irig=1,irigel(/2) 30 : xmatri=irigel(4,irig) 31 : LSEG=MSLS1(MDISG(xmatri)) 32 : * write (6,*) ' repart lseg ',lseg 33 : nblprt=(LSEG-1)/LTRK + 1 34 : meleme=irigel(1,irig) 35 : segact meleme 36 : nbelem=num(/2) 37 : nblmax=(nbelem-1)/nblprt+1 38 : nblprt=(nbelem-1)/nblmax+1 39 : if (nbelem.gt.nblmax) iafair=1 40 : * if (nblprt.gt.1) iafair=1 41 : nbs=nbs+nblprt 42 : * write (6,*) ' re nblmax ',nbelem,nblmax 43 : * write (6,*) ' nblprt vaut ',nblprt 44 : segdes meleme 45 : 100 continue 46 : * write(6,*) 'nrigel nbs',irigel(/1),nbs 47 : if (iafair.eq.0) then 48 : segdes,mrigid 49 : return 50 : endif 51 : * 52 : * il y a du travail à faire 53 : nrigel=nbs 54 : segini ri1 55 : ri1.iforig=iforig 56 : ri1.mtymat=mtymat 57 : nbs=0 58 : nbsous=0 59 : nbref=0 60 : do 200 irig=1,irigel(/2) 61 : xmatri=irigel(4,irig) 62 : LSEG=MSLS1(MDISG(xmatri)) 63 : nblprt=(LSEG+1)/LTRK + 1 64 : meleme=irigel(1,irig) 65 : segact meleme 66 : nbnn=num(/1) 67 : nbelee=num(/2) 68 : nblmax=(nbelee-1)/nblprt+1 69 : nblprt=(nbelee-1)/nblmax+1 70 : if (nbelee.le.nblmax) then 71 : * if (nblprt.eq.1) then 72 : nbs=nbs+1 73 : ri1.coerig(nbs)=coerig(irig) 74 : do im=1,irigel(/1) 75 : ri1.irigel(im,nbs)=irigel(im,irig) 76 : enddo 77 : else 78 : segact xmatri 79 : nligrd=re(/1) 80 : nligrp=re(/2) 81 : do 250 ipar=1,nblprt 82 : nbs=nbs+1 83 : jpar=nblmax*(ipar-1) 84 : nbelem=min(nblmax,nbelee-jpar) 85 : segini ipt2 86 : ipt2.itypel=itypel 87 : do 260 iel=1,nbelem 88 : jel=iel+jpar 89 : do 270 in=1,nbnn 90 : ipt2.num(in,iel)=num(in,jel) 91 : 270 continue 92 : ipt2.icolor(iel)=icolor(jel) 93 : 260 continue 94 : segdes ipt2 95 : nelrig=nbelem 96 : segini xmatr1 97 : do 280 iel=1,nelrig 98 : jel=iel+jpar 99 : do 280 ip=1,nligrp 100 : do 280 id=1,nligrd 101 : xmatr1.re(id,ip,iel)=re(id,ip,jel) 102 : 280 continue 103 : segdes xmatr1 104 : ri1.coerig(nbs)=coerig(irig) 105 : ri1.irigel(1,nbs)=ipt2 106 : ri1.irigel(2,nbs)=irigel(2,irig) 107 : ri1.irigel(3,nbs)=irigel(3,irig) 108 : ri1.irigel(4,nbs)=xmatr1 109 : do im=5,irigel(/1) 110 : ri1.irigel(im,nbs)=irigel(im,irig) 111 : enddo 112 : 250 continue 113 : segsup xmatri 114 : endif 115 : segdes meleme 116 : 200 continue 117 : segdes ri1 118 : segsup mrigid 119 : mrigid=ri1 120 : return 121 : end 122 : 123 :
© Cast3M 2003 - All rights reserved.
Disclaimer