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