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