1!$Id:$
2      subroutine ploopin(lp_max)
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: Data input routine for mesh description
11
12!      Inputs:
13!        lp_max  - Number of times to loop in root loop
14!-----[--.----+----.----+----.-----------------------------------------]
15      implicit   none
16
17      include   'iodata.h'
18      include   'iofile.h'
19      include   'setups.h'
20
21      logical    pcomp, lopen
22      character  lp_file*15,lp_ext*1, xxx*256,yyy*256
23      integer    lp_lun, lp_max, lp_num, lenx, loop_l(9)
24
25      save
26
27!     Set parameters
28
29      lp_file = 'feaploop000.0'
30      lp_lun  =  icl - 1
31      lopen   = .true.
32      do while(lopen)
33        lp_lun = lp_lun + 1
34        inquire(unit = lp_lun,opened = lopen)
35      end do ! while
36
37!     Start root file
38
39      lp_num         = 1
40      loop_l(lp_num) = lp_lun
41      open(unit = lp_lun, file = lp_file, status = 'unknown')
42      rewind(lp_lun)
43      write(lp_lun,1000) 'loop',lp_max
44
45!     Fill remaining file entries
46
47      xxx   = 'start'
48      do while(.not.pcomp(xxx,'next',4) .and. lp_num.gt.0)
49
50        read(   ior,1000) yyy
51        call pstrip(xxx,yyy,1)
52
53!       New loop encountered: Reset file structures
54
55        if(pcomp(xxx,'loop',4)) then
56
57!         Establish new filename and save to current file
58
59          write(lp_ext,'(i1)') lp_num
60          lp_file(13:13) = lp_ext
61          yyy(1:5)       = 'file='
62          yyy(6:18)      = lp_file(1:13)
63          write(lp_lun,1000) yyy(1:18)
64
65!         Establish new file structure
66
67          lopen = .true.
68          do while(lopen)
69            lp_lun       = lp_lun + 1
70            inquire(unit=lp_lun,opened=lopen)
71          end do ! while
72
73          open(unit = lp_lun, file = lp_file, status = 'unknown')
74          rewind(lp_lun)
75
76          lp_num         = lp_num + 1
77          if(lp_num.gt.9) then
78            write(iow,3000)
79            call plstop(.true.)
80          endif
81          loop_l(lp_num) = lp_lun
82        endif
83
84!       Compress amount to be written
85
86        lenx = 80
87        do while(xxx(lenx:lenx).eq.' ' .and. lenx.gt.1)
88          lenx = lenx - 1
89        end do ! while
90        write(lp_lun,1000) xxx(1:lenx)
91
92!       End of loop structure encountered: Set back to previous
93
94        if(pcomp(xxx,'next',4)) then
95
96          if(lp_num.gt.1) then
97            xxx = 'restart'
98          endif
99
100          close(lp_lun)
101          lp_num = lp_num - 1
102          lp_lun = loop_l(lp_num)
103        endif
104      end do ! while
105
106!     Format structure
107
1081000  format(a,i5)
109
1103000  format(' *ERROR* PLOOPIN: Mesh loop levels nested deeper than 9')
111
112      end
113