c get number of currently selected nodes
numnp = ndinqr (0,DB_NUMSELECTED)
if (numnp .le. 0) go to 999
c allocate memory for x, y, & z coordinates of nodes
xcptr = HeapAllocPtr(numnp,'XCoords ',HEAP_DOUBLE,hXcptr) ycptr = HeapAllocPtr(numnp,'YCoords ',HEAP_DOUBLE,hYcptr) zcptr = HeapAllocPtr(numnp,'ZCoords ',HEAP_DOUBLE,hZcptr) ndptr = HEapAllocPtr(numnp,'Nodes ',HEAP_INTEGER,hNdptr)
c loop through all selected nodes
i=1 node = 0 xmean = 0.0d0 ymean = 0.0d0 zmean = 0.0d0 10 node = ndnext(node)
if (node .gt. 0) then
c get xyz coordinates
ksel = ndgxyz (node,xyz(1))
c store this node's xyz coordinates
dstack(xcptr + i) = xyz(1) dstack(ycptr + i) = xyz(2) dstack(zcptr + i) = xyz(3) istack(ndptr + i) = node
c while we're looping, accumulate sums to calculate means
xmean = xmean + xyz(1) ymean = ymean + xyz(2) zmean = zmean + xyz(3)
c increment index
i = i + 1
c loop back up for next selected node
goto 10
endif
call wrdisp (numnp, istack(ndptr+1))
c node = 0, at the end of node list
c calculate mean of xyz coordinates
xmean = xmean / numnp ymean = ymean / numnp zmean = zmean / numnp
c calculate standard deviation for xyz coordinates sodx = 0 sody = 0 sodz = 0 do i=1, numnp
sodx = sodx + (dstack(xcptr+i) - xmean)**2 sody = sody + (dstack(ycptr+i) - ymean)**2 sodz = sodz + (dstack(zcptr+i) - zmean)**2 enddo
stdxyz(1) = sqrt(sodx / (numnp-1)) stdxyz(2) = sqrt(sody / (numnp-1)) stdxyz(3) = sqrt(sodz / (numnp-1))
c ***** write to output file *****
iott = wrinqr(WR_OUTPUT)
write (iott,2000) stdxyz(1),stdxyz(2),stdxyz(3) 2000 format (/' STD FOR X COORDINATES:',G12.5,/,
X ' STD FOR Y COORDINATES:',G12.5,/, X ' STD FOR Z COORDINATES:',G12.5)
c ***** write to GUI window *****
call erhandler ('user03',5000,2,
x 'STD FOR X COORDINATES: %G %/ STD FOR Y
x COORDINATES: %G %/ STD FOR Z COORDINATES: %G',stdxyz(1),' ')
c release dynamically allocated memory
call HeapDealloc(hXcptr) call HeapDealloc(hYcptr) call HeapDealloc(hZcptr) call HeapDealloc(hNdptr)
c ***** required return value ***** 999 user03 = 0
return end
subroutine wrdisp (nnod, nodes) #include \ #include \
integer nnod, nodes(nnod)
external wrinqr, disget integer wrinqr, disget
integer iott,i,rc,k double precision value(4)
iott = wrinqr(WR_OUTPUT) do i=1,nnod
rc = disget(nodes(i), 1, value(1)) if (rc .eq. 0) then
write (iott,1000) nodes(i) 1000 format ('Nodes=',i3,' No x displacement constraint') else
write (iott,1010) nodes(i), (value(k), k=1,4) 1010 format ('Nodes=',i3,' UX=',4(F8.2,',')) endif enddo
return end 将上面程序编译并连接，
启动ANSYS，并输入下面的命令流，观察OUTPUT窗口的输出信息 /prep7 blc4,0,0,4,2 et,1,42 esize,.5 amesh,1 nsel,s,loc,x,4 d,all,ux,8 nsel,s,loc,x,0 d,all,ux,-9 nsel,all usr3
E. 使用ANSYS提供子程序试验矢量与矩阵的操作
以下是一个完整的程序用来说明矢量矩阵操作{c}={a}
*deck,user01 user parallel ANSYS,INC
function user01 (intin,dpin,ch4in,ch8in) #include \
external wrinqr integer wrinqr
integer user01,intin(12), iott double precision dpin(12) character*4 ch4in(12) character*8 ch8in(12) c
double precision a(3), b(4,3), c(4) integer i,j,k data a /5,6,7/
data b /3,3,9,8, 4,7,4,3, 5,9,5,2/
iott = wrinqr(2)
call vzero (c(1), 4)
write (iott, *) '*** matrix b =' do i=1,4
write (iott, 101) (b(i,k), k=1,3) enddo
write (iott, *) '*** vector a=' do i=1,3
write (iott, 100) a(i) enddo
call maxv(b(1,1),a(1),c(1), 4,3) write (iott, *) '*** vector c=' do i=1,4
write (iott, 100) c(i) enddo 100 format (F9.2, 3x) 101 format (3(F9.2, 3x))
user01 = 0 c
return end
E. 用户自定义材料
1. 拷贝相关文件
D:\%user>copy c:\\ansys55\\custom\%user\\intel\%userpl.F 2. 运行编译连接（参见用户命令） 3. 启动ANSYS（参见用户命令） D:\%user>ansys55cust -custom .\\ansys.exe -p ansysul 4. 编辑命令流文件a.dat D:\%user>edit a.dat