1! 2! CalculiX - A 3-dimensional finite element program 3! Copyright (C) 1998-2021 Guido Dhondt 4! 5! This program is free software; you can redistribute it and/or 6! modify it under the terms of the GNU General Public License as 7! published by the Free Software Foundation(version 2); 8! 9! 10! This program is distributed in the hope that it will be useful, 11! but WITHOUT ANY WARRANTY; without even the implied warranty of 12! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13! GNU General Public License for more details. 14! 15! You should have received a copy of the GNU General Public License 16! along with this program; if not, write to the Free Software 17! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18! 19 subroutine calinput_rfn(co,filab,set,istartset,iendset,ialset, 20 & nset,nset_,nalset,nalset_,mi,kon,ipkon,lakon,nkon,ne,ne_, 21 & iponor,xnor,istep,ipoinp,inp,iaxial,ipoinpc,network, 22 & nlabel,iuel,nuel_,ielmat,inpc,iperturb,iprestr,nk,nk_,ntie, 23 & tieset,iparentel) 24! 25 implicit none 26! 27 logical solid,out3d 28! 29 character*1 inpc(*) 30 character*8 lakon(*) 31 character*81 set(*),tieset(3,*) 32 character*87 filab(*) 33 character*132 textpart(16) 34! 35 integer kon(*),i,istartset(*),iendset(*),ialset(*),nset,nset_, 36 & nalset,nalset_,mi(*),ipkon(*),nkon,ne,ne_,ixfree,ielmat(*), 37 & iponor(2,*),istep,istatrfn,n,iline,ipol,inl,ipoinp(2,*), 38 & inp(3,*),iaxial,ipoinpc(0:*),network,nlabel,iuel,nuel_,ier, 39 & iperturb(*),iprestr,key,nk,nk_,ntie,iparentel(*) 40! 41 real*8 co(3,*),xnor(*) 42! 43 integer nentries 44 parameter(nentries=18) 45! 46 ier=0 47! 48 do i=1,nentries 49 if(ipoinp(1,i).ne.0) then 50 ipol=i 51 inl=ipoinp(1,i) 52 iline=inp(1,inl)-1 53 exit 54 endif 55 enddo 56! 57 call getnewline(inpc,textpart,istatrfn,n,key,iline,ipol,inl, 58 & ipoinp,inp,ipoinpc) 59! 60 loop: do 61! 62 if(istatrfn.lt.0) exit 63! 64 if(textpart(1)(1:8).eq.'*ELEMENT') then 65 call elements(inpc,textpart,kon,ipkon,lakon,nkon, 66 & ne,ne_,set,istartset,iendset,ialset,nset,nset_,nalset, 67 & nalset_,mi(1),ixfree,iponor,xnor,istep,istatrfn,n,iline, 68 & ipol,inl,ipoinp,inp,iaxial,ipoinpc,solid, 69 & network,filab,nlabel,out3d,iuel,nuel_,ier,iparentel) 70! 71 elseif(textpart(1)(1:12).eq.'*MODELCHANGE') then 72 call modelchanges(inpc,textpart,tieset,istatrfn,n,iline, 73 & ipol,inl,ipoinp,inp,ntie,ipoinpc,istep,ipkon,nset, 74 & istartset,iendset,set,ialset,ne,mi,ielmat,iprestr, 75 & iperturb,ier) 76! 77 elseif(textpart(1)(1:5).eq.'*NODE') then 78 call nodes(inpc,textpart,co,nk,nk_,set,istartset,iendset, 79 & ialset,nset,nset_,nalset,nalset_,istep,istatrfn,n,iline, 80 & ipol,inl,ipoinp,inp,ipoinpc,ier) 81! 82! check for zero-character-lines? 83! 84 elseif(ipoinpc(iline-1).eq.ipoinpc(iline)) then 85 call getnewline(inpc,textpart,istatrfn,n,key,iline,ipol,inl, 86 & ipoinp,inp,ipoinpc) 87! 88 else 89 write(*,*) '*WARNING in calinput_rfn. Card image cannot be', 90 & ' interpreted:' 91 call inputwarning(inpc,ipoinpc,iline, 92 & "the input file%") 93 call getnewline(inpc,textpart,istatrfn,n,key,iline,ipol,inl, 94 & ipoinp,inp,ipoinpc) 95 endif 96! 97 if(ier.eq.1) then 98 do 99 call getnewline(inpc,textpart,istatrfn,n,key,iline,ipol,inl, 100 & ipoinp,inp,ipoinpc) 101 if(key.eq.1) exit 102 enddo 103 ier=2 104 endif 105! 106 enddo loop 107! 108 if(ier.ge.1) then 109 write(*,*) '*ERROR in calinput: at least one fatal' 110 write(*,*) ' error message while reading the' 111 write(*,*) ' input deck: CalculiX stops.' 112 write(*,*) 113 call exit(201) 114 endif 115! 116 return 117 end 118