subroutine upostv(n,ndeg,ncrd,numnp,iantyp,jnode,iuid,upost, * xord,vector,inc,cptim) c c CONTACT: ap@marc.de c c implicit real*8 (a-h,o-z) c c user subroutine to define nodal post variables c n user node number c ndeg number of degrees of freedom per node c ncrd number of coordinates per node c iantyp analysis type - see PLDUMP in volume D c jnode number of vector quantities already defined - c see PLDUMP in vol D c iuid user vector number c upost user defined components of vector for this node c xord coordinates of this node c vector displacement, etc of this node. c see iantyp/jnode table in PLDUMP section in volume D c inc increment number c cptim total time c dimension upost(ndeg),xord(ncrd),vector(ndeg,jnode) c include '../common/form' include '../common/array4' include '../common/blnk' include '../common/space' c parameter(MAXDOF=6,MAXNOD=10000) common/my_common/tyforce(MAXDOF,MAXNOD) c goto (10,20) iuid c 10 continue c... store contact status c... determine internal node number of user node number n. c... n1 is internal number of node n. call nodnum(n,idum,n1,1) c c... determine contact status of this node. c... iflag=0: node n (internal nr: n1) is not contacting another body c... iflag>0: node n (internal nr: n1) is contacting another body ijk=0 md =0 call coinfo(ijk,n1,n,md,idie,ints(inf),ints(itouch), $ nbcn,ints(inbct),ints(inseg),iflag, $ idum1,idum2,idum3,irigid1,irigid2,irigid3) c if (iflag.eq.0) then upost(1)=0d0 else upost(1)=1d0 endif c do 123, i1=2,ndeg upost(i1)=0d0 123 continue c goto 9999 c... 20 continue c... store tying forces do i1=1,ndeg upost(i1) = tyforce(i1,n) enddo c... goto 9999 c 9999 continue c return end subroutine tyload(t,s,ndeg,long,nretn,iti,ityco,istyp,lm) c* * * * * * c c tie load vector or recover displacement vector at tied node. c c t load or displacement vector at nodes c s constraint matrix c ndeg number of degrees of freedom per node c long number of retained nodes c nretn number of retained nodes c iti list of retained nodes c ityco tying code c istyp tying type c* * * * * * implicit real*8 (a-h,o-z) dp c dimension t(ndeg,*),s(ndeg,*),iti(nretn),lm(ndeg) dimension forces(12) include '../common/iopts' include '../common/concom' include '../common/space' include '../common/arrays' include '../common/prepro' include '../common/develp' include '../common/dyns' c parameter(MAXDOF=6,MAXNOD=10000) common/my_common/tyforce(MAXDOF,MAXNOD) c c call mtrace(6htyload,1,0) tr c ido=ideva(14) if(ityco.le.0.or.lovl.ne.21) ido=0 c ntied=iti(1) if(ityco.eq.0.and.istyp.eq.80.and.isi.ne.0.and.itier.eq.3) * go to 11 do 10 n1=1,ndeg if(lm(n1).eq.0) go to 10 if(ido.eq.1) then nod=iti(1) if(joptit.ne.0) nod=igetsh(ints(inpnum+nod-1),1) if(nnoids.ne.0) nod=ints(inoids+nod-1) fforc=t(n1,ntied) write(kou,'(a)') '' write(kou,'(a,i6,a,i6,a,e15.5)') * ' tied node ',nod,' degree of freedom', * n1,' force :',fforc tyforce(n1,nod) = tyforce(n1,nod) + fforc endif if(ityco.eq.0.or.ityco.eq.3) t(n1,ntied)=0.d0 nstot=0 istart=2 iend=nretn if(istyp.eq.60) then if(ityco.eq.3.or.ityco.eq.2) then istart=3 iend=4 else if(ityco.eq.0.or.ityco.eq.1) then istart=2 iend=4 endif nstot=ndeg*(istart-2) else if(istyp.eq.61) then if(ityco.eq.3.or.ityco.eq.2) then istart=3 iend=6 else if(ityco.eq.0.or.ityco.eq.1) then istart=2 iend=6 endif nstot=ndeg*(istart-2) endif if(impact.eq.1) istart=2 if(impact.eq.1) nstot=0 do 2 ns1=istart,iend nn1=iti(ns1) do 3 ns2=1,ndeg nstot=nstot+1 if(ityco.eq.0.or.ityco.eq.3) then t(n1,ntied)=t(n1,ntied)+s(n1,nstot)*t(ns2,nn1) else forces(ns2)=s(n1,nstot)*t(n1,ntied) t(ns2,nn1)=t(ns2,nn1)+s(n1,nstot)*t(n1,ntied) if (ido.eq.1) then if (s(n1,nstot).ne.0d0) then fforc = -s(n1,nstot)*t(n1,ntied) nod=iti(ns1) if(joptit.ne.0) nod=igetsh(ints(inpnum+nod-1),1) if(nnoids.ne.0) nod=ints(inoids+nod-1) write(kou,'(a,i6,a,i6,a,e15.5)') * ' retained node',nod,' degree of freedom', * ns2,' force :',fforc tyforce(ns2,nod) = tyforce(ns2,nod) + fforc endif endif endif 3 continue c if(ido.eq.1) then c nod=iti(ns1) c if(joptit.ne.0) nod=igetsh(ints(inpnum+nod-1),1) c if(nnoids.ne.0) nod=ints(inoids+nod-1) c write(kou,'(a,i6)') ' forces for retained node:',nod c write(kou,'(8e15.5)') (-forces(ijk),ijk=1,ndeg) c do 4 i1=1,ndeg c tyforce(i1,nod) = -forces(i1) c 4 continue c endif 2 continue if(ityco.eq.1) t(n1,ntied)=0.d0 10 continue 11 continue if(ityco.eq.0.and.istyp.eq.80.and.isi.ne.0.and.itier.eq.3) & call rigid2(iti,nretn) if(ityco.eq.0.and.istyp.eq.60.and.itier.eq.3) then call formad(ntied,t,ndeg,iti,nretn) else if(ityco.eq.0.and.istyp.eq.61.and.itier.eq.3) then call forma3(ntied,t,ndeg,iti,nretn,n1) endif c call mtrace(6htyload,2,0) tr return end subroutine ubgitr(inc,incsub,ncycle) implicit real*8 (a-h,o-z) c dummy user subroutine that would get called at the beginning of each c iteration c parameter(MAXDOF=6,MAXNOD=10000) common/my_common/tyforce(MAXDOF,MAXNOD) c do i1=1,MAXDOF do i2=1,MAXNOD tyforce(i1,i2) = 0d0 enddo enddo c return end