1!$Id:$
2      function prop2p(lunit,l,tv,itime)
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: Proportional load table type 2 input/computation
11
12!                 prop = vm(i)+(vm(i+1)-vm(i))*(t-tm(i))/(tm(i+1)-tm(i)
13!                        tm(i) < t < tm(i+1)
14!      Inputs:
15!         l         - Number of data input pairs to input/record
16!                     Compute proportional load if zero.
17
18!      Outputs:
19!         prop2     - Value of total proportional load type 2
20!         tv(2,*)   - Table of times and values:
21!                       tm(*) = tv(1,*); vm(*) = tv(2,*)
22!         itime     - Activation indicator
23!-----[--.----+----.----+----.-----------------------------------------]
24      implicit  none
25
26      include  'comfil.h'
27      include  'iodata.h'
28      include  'iofile.h'
29      include  'print.h'
30
31      logical   errck, pinput, done
32      integer   l, m, ilast, itime, lunit, iosav
33      real*8    prop2p, tv(2,*), td(16)
34
35      save
36
37!     Input table of proportional loads
38
39      ilast = 0
40      itime = 1
41
42!     Rewind file to permit setting the tv(2,*) array
43
44      rewind lunit
45      iosav = ior
46      ior   = lunit
47
48!     Start read
49
50      done = .false.
51      do while(.not.done)
52102     errck = pinput(td,2*l)
53        if(errck) go to 102
54        do m = 1,l
55          if(abs(td(2*m-1))+abs(td(2*m)).ne.0.0d0
56     &                         .or. ilast.eq.0) then
57            ilast       = ilast + 1
58            tv(1,ilast) = td(2*m-1)
59            tv(2,ilast) = td(2*m)
60          else
61            done        = .true.
62          endif
63        enddo ! m
64      end do ! while
65
66      close(unit = lunit, status = 'delete')
67      ior = iosav
68
69      prop2p = 0.0d0
70
71      end
72