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