c$Id:$ subroutine uplot1(ctl) c * * F E A P * * A Finite Element Analysis Program c.... Copyright (c) 1984-2014: Regents of the University of California c All rights reserved c-----[--.----+----.----+----.-----------------------------------------] c Modification log Date (dd/mm/year) c Original version 04/21/2014 c-----[--.----+----.----+----.-----------------------------------------] c Purpose: Plot flux vectors 2D heat transfer problems c c Author: S. Govindjee c Inputs: c ctl(1) - == 0 for tail at node, == 1 for head at node c ctl(2) - scaling factor if you are not happy with the default c c Outputs: c Plot of flux vectors to the screen c-----[--.----+----.----+----.-----------------------------------------] implicit none include 'cdata.h' include 'eldatp.h' include 'fdata.h' include 'plcapt.h' include 'pdata3.h' include 'pointer.h' include 'prflag.h' include 'prstrs.h' include 'pview.h' include 'sdata.h' include 'umac1.h' ! uct include 'comblk.h' logical pcomp,setvar,palloc integer i real*8 ctl(3), testa(2,numnp),xscale c Provide user plot name if (pcomp(uct,'plt1',4)) then uct = 'vecf' c Perform user plot function else c ctl(1) == 0 tail at node c == 1 head at node c ctl(2) == scaling factor c Set the plot caption call plopen call pppcol(3,0) c Set scale factor if requested xscale = 1.d0 if(ctl(2).ne.0.d0) then xscale = 1.d0/ctl(2) endif c Allocate space for the projecdtion if necessary if(plfl) then setvar = palloc( 57,'NDER',numnp*8 ,2) setvar = palloc( 58,'NDNP',numnp*npstr,2) setvar = palloc( 60,'NDNS',max(nen*npstr,nst*nst),2) setvar = palloc(207,'NSCR',numel ,2) nper = np(57) npnp = np(58) plfl =.false. if(histpltfl) then setvar = palloc(304,'HSELM',nen*hplmax ,2) setvar = palloc(305,'HDNP ',numnp*hplmax,2) endif endif ner = nper nph = npnp c Project if needed if(.not.fl(11)) then call pjstrs(trifl) endif c Set up general 3D plotting arrays including the all important c mask arrary mr(np(111)) call pdefm(hr(npxx),hr(npuu),cs,ndm,ndf,numnp,hr(np(53))) setvar = palloc(111,'TEMP1',numnp,1) call pnumna(mr(np(33)),nen1,nen,numel,mr(np(111))) c Extract the x,y flux components from the projected values do i = 0,numnp-1 testa(1,i+1) = hr(nph+numnp+numnp*(13-1)+i) ! first component q_x testa(2,i+1) = hr(nph+numnp+numnp*(14-1)+i) ! second component q_y end do c Set up the vectors and plot them call pltvec(hr(np(53)),testa,mr(np(111)), & 3,numnp,nint(ctl(1)),xscale) c Set the projection flag since we have now done it c Clean up the memory and put the time stamp on the plot fl(11) = .true. setvar = palloc(111,'TEMP1',0,1) call pltime() end if end subroutine pltvec(x,f,ip,ndm,numnp,n1,ct) c * * F E A P * * A Finite Element Analysis Program c.... Copyright (c) 1984-2014: Regents of the University of California c All rights reserved c-----[--.----+----.----+----.-----------------------------------------] c Modification log Date (dd/mm/year) c Original version 04/21/2014 c-----[--.----+----.----+----.-----------------------------------------] c Purpose: Draw flux vectors on mesh c c Author: S. Govindjee c Inputs: c x(ndm,*) - Nodal coordinates for mesh [np(53) -> 3D coord, always] c f(2,*) - Nodal forces c ip(*) - active nodes c ndm - Dimension of x array c numnp - Number of nodes in mesh c n1 - Flag, place tip at node if > 0 c ct - explicit scale factor c Outputs: c none - Plot outputs to screen/file c-----[--.----+----.----+----.-----------------------------------------] implicit none include 'iofile.h' include 'pdata1.h' include 'pdata4.h' include 'pdatay.h' include 'pdatxt.h' include 'pointer.h' include 'rigid1.h' include 'comblk.h' logical vfl,zoom integer ndm,numnp,n1,nsy, i,j,n, ip(*) real*8 fm,dx1,dx2,dx3,d, ct real*8 dd(3),xx(3,4),x(ndm,*),f(2,*), tbuf(2), fms(1) save c Compute longest flux vector fm = 0.d0 do n = 1,numnp c Check that node is active and that it is in the view if(ip(n).gt.0 .and. mr(npty+n-1).ge.0 & .and. zoom(x(1,n),ndm)) then d = 0.d0 do i = 1,2 c Account for possible dof reorderings j = pdf(i) if(j.gt.0 .and. j.le.2) then d = d + f(j,n)**2 end if end do ! i fm = max(fm,d) endif end do ! n c Parallel exchange to set common scale fms(1) = fm call pfeapsr(fms,tbuf, 1, .false.) fm = max(fm,fms(1)) c Zero length vectors if(fm.le.0.0d0) then if(iow.lt.0) write(*,2000) c Compute vector at each node else do i = 1,3 xx(i,1) = 0.0d0 xx(i,2) = 0.0d0 xx(i,3) = 0.0d0 xx(i,4) = 0.0d0 end do ! i fm = ct*2.d0*sqrt(fm)*scale*40.d0 do nsy = 1,nsym do n = 1,numnp c Check that node is active and in the view if(ip(n).gt.0 .and. zoom(x(1,n),ndm)) then vfl = .false. do i = 1,3 dd(i) = 0.0d0 end do ! i do i = 1,2 j = pdf(i) if(j.gt.0 .and. j.le.2) then dd(i) = f(j,n) vfl = .true. endif end do ! i c Setup the vector if(vfl) then dd(1) = dd(1)/fm dd(2) = dd(2)/fm if(ndm.ge.3) then dd(3) = dd(3)/fm xx(3,1) = x(3,n) xx(3,2) = xx(3,1) + dd(3) xx(3,3) = xx(3,2) -.6d0*dd(3) + .2d0*(dd(1)+dd(2)) xx(3,4) = xx(3,2) -.6d0*dd(3) - .2d0*(dd(1)+dd(2)) endif xx(1,1) = x(1,n) xx(2,1) = x(2,n) xx(1,2) = xx(1,1) + dd(1) xx(2,2) = xx(2,1) + dd(2) xx(1,3) = xx(1,2) -.6d0*dd(1) - .2d0*(dd(2)+dd(3)) xx(2,3) = xx(2,2) -.6d0*dd(2) + .2d0*(dd(1)+dd(3)) xx(1,4) = xx(1,2) -.6d0*dd(1) + .2d0*(dd(2)+dd(3)) xx(2,4) = xx(2,2) -.6d0*dd(2) - .2d0*(dd(1)+dd(3)) c Plot vector (noting correct symmetry) do i = 1,4 do j = 1,3 xx(j,i) = (xx(j,i) - xsyc(j))*xsym(j,nsy) + xsyc(j) end do ! j end do ! i if(n1.eq.0) then dx1 = 0.d0 dx2 = 0.d0 dx3 = 0.d0 else dx1 = xx(1,1) - xx(1,2) dx2 = xx(2,1) - xx(2,2) dx3 = xx(3,1) - xx(3,2) endif call plotl(xx(1,1)+dx1,xx(2,1)+dx2,xx(3,1)+dx3,3) call plotl(xx(1,2)+dx1,xx(2,2)+dx2,xx(3,2)+dx3,2) call plotl(xx(1,3)+dx1,xx(2,3)+dx2,xx(3,3)+dx3,2) call plotl(xx(1,4)+dx1,xx(2,4)+dx2,xx(3,4)+dx3,2) call plotl(xx(1,2)+dx1,xx(2,2)+dx2,xx(3,2)+dx3,2) endif endif end do ! n end do ! nsy endif 2000 format(' Zero values acting on mesh ') end