1!$Id:$
2      subroutine pload(id,f1,dr,prop,flg)
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: Form nodal load vector for current time
11
12!      Inputs:
13!         id(*)    - Equation numbers for degree of freedom
14!         prop     - Total proportional load level
15!         flg      - Flag: Form residual if true; else reactions
16
17!      Outputs:
18!         f1(*)    - Total nodal load for t_n+1
19!         dr(*)    - Total reaction/residual
20!-----[--.----+----.----+----.-----------------------------------------]
21
22      implicit  none
23
24      include  'ddata.h'
25      include  'fdata.h'
26      include  'p_int.h'
27      include  'prld1.h'
28      include  'sdata.h'
29
30      include  'pointer.h'
31      include  'comblk.h'
32
33      logical   flg
34      integer   j,n, ipro
35      integer   id(*)
36      real*8    prop,thn, f1(nneq,*),dr(*)
37
38!     Set force vectors for t_n+1
39
40      fl(11) = .false.
41      do n = 1,nneq
42
43!               F
44        fp(1) = np(27) + n - 1
45        fp(2) = fp(1) + nneq
46!               FU
47        fp(3) = np(28) + n - 1
48        fp(4) = fp(3) + nneq
49!               F0
50        fp(5) = fp(4) + nneq
51        fp(6) = fp(5) + nneq
52
53!                   FPRO
54        ipro = mr(np(29)+n-1)
55        if(ipro.eq.0) then     ! {
56          if(id(n).gt.0) then
57            f1(n,1) = hr(fp(1))*prop  + hr(fp(5)) + hr(fp(3))
58          else
59            f1(n,1) = hr(fp(2))*prop  + hr(fp(6)) + hr(fp(4))
60          endif
61          f1(n,3)   = hr(fp(1))*prop + hr(fp(5)) + hr(fp(3))
62        else
63          if(id(n).gt.0) then
64            f1(n,1) = hr(fp(1))*prldv(ipro) + hr(fp(5)) + hr(fp(3))
65          else
66            f1(n,1) = hr(fp(2))*prldv(ipro) + hr(fp(6)) + hr(fp(4))
67          endif
68          f1(n,3) = hr(fp(1))*prldv(ipro) + hr(fp(5)) + hr(fp(3))
69        endif                  ! if }
70      end do ! n
71
72!     Initialize residual/reaction
73
74      if(flg) then
75        do n = 1,nneq
76          dr(n) = 0.0d0
77        end  do ! n
78      endif
79
80!     Compute interpolated load vector
81
82      thn = 1.0d0 - theta(3)
83
84      do n = 1,nneq
85        j = id(n)
86        if(j.gt.0) then
87          if(flg) then
88            dr(j) = dr(j) + theta(3)*f1(n,1) + thn*f1(n,2)
89          else
90            dr(n) =         theta(3)*f1(n,1) + thn*f1(n,2)
91          endif
92        endif
93      end do ! n
94
95      end
96