1!$Id:$ 2 subroutine paboun(td,x,ang,ntyp,ndm,numnp,numprt,prt,prth) 3 4! * * F E A P * * A Finite Element Analysis Program 5 6!.... Copyright (c) 1984-2017: Regents of the University of California 7! All rights reserved 8 9!-----[--.----+----.----+----.-----------------------------------------] 10! Purpose: Set angle for sloping boundary based on coordinates 11 12! Inputs: 13! td(*) - Array containing coordinate of search and angle 14! x(ndm,*) - Nodal coordinates 15! ntyp(*) - Node type ( < zero for inactive) 16! ndm - Spatial dimension of mesh 17! numnp - Number of nodes in mesh 18! numprt - Print counter 19! prt - Print generated data if true 20! prth - Print title/header if true 21 22! Outputs: 23! ang(*) - Angles for sloping boundary conditions 24!-----[--.----+----.----+----.-----------------------------------------] 25 implicit none 26 27 include 'iofile.h' 28 29 logical prt,prth,clflg 30 integer ndm,numnp,numprt, n,nbc 31 real*8 xmn, tmn 32 33 integer ntyp(*) 34 real*8 x(ndm,numnp),ang(*),td(*) 35 36 real*8 dotx 37 38 save 39 40! Find closest node to input coordinates 41 42 if(prt .and. numprt.le.0) then 43 call prtitl(prth) 44 write(iow,2000) 45 if(ior.lt.0) write(*,2000) 46 numprt = 50 47 endif 48 49 clflg = .false. 50 do n = 1,numnp 51 if(ntyp(n).ge.0) then 52 tmn = dotx(td(1),x(1,n),ndm) 53 if(clflg) then 54 if(tmn.lt.xmn) then 55 xmn = tmn 56 nbc = n 57 endif 58 else 59 xmn = tmn 60 nbc = n 61 clflg = .true. 62 endif 63 endif 64 end do 65 66! Set angle 67 68 if(clflg) then 69 ang(nbc) = td(ndm+1) 70 71! Output current restraint codes set 72 73 if(prt) then 74 write(iow,2001) nbc,ang(nbc) 75 if(ior.lt.0) then 76 write(*,2001) nbc,ang(nbc) 77 endif 78 numprt = numprt - 1 79 endif 80 endif 81 82! Format 83 842000 format(' C o o r d i n a t e N o d a l A n g l e s'/ 85 & /(4x,'Node Angle')) 86 872001 format(i8,1p,e12.4) 88 89 end 90