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 controlss(inpc,textpart,ctrl,istep,istat,n,iline,ipol,
20     &  inl,ipoinp,inp,ipoinpc,ier)
21!
22!     reading the input deck: *CONTROLS
23!
24      implicit none
25!
26      character*1 inpc(*)
27      character*132 textpart(16)
28!
29      integer i,j,k,istep,istat,n,key,iline,ipol,inl,ipoinp(2,*),
30     &  inp(3,*),ipoinpc(0:*),ier
31!
32      real*8 ctrl(*)
33!
34      do i=2,n
35         if(textpart(i)(1:5).eq.'RESET') then
36            ctrl(1)=4.5d0
37            ctrl(2)=8.5d0
38            ctrl(3)=9.5d0
39            ctrl(4)=16.5d0
40            ctrl(5)=10.5d0
41            ctrl(6)=4.5d0
42            ctrl(7)=0.d0
43            ctrl(8)=5.5d0
44            ctrl(9)=0.d0
45            ctrl(10)=0.d0
46            ctrl(11)=0.25d0
47            ctrl(12)=0.5d0
48            ctrl(13)=0.75d0
49            ctrl(14)=0.85d0
50            ctrl(15)=0.d0
51            ctrl(16)=0.d0
52            ctrl(17)=1.5d0
53            ctrl(18)=0.d0
54            ctrl(19)=0.005d0
55            ctrl(20)=0.01d0
56            ctrl(21)=0.d0
57            ctrl(22)=0.d0
58            ctrl(23)=0.02d0
59            ctrl(24)=1.d-5
60            ctrl(25)=1.d-3
61            ctrl(26)=1.d-8
62            ctrl(27)=1.d30
63            ctrl(28)=1.5d0
64            ctrl(29)=0.25d0
65            ctrl(30)=1.01d0
66            ctrl(31)=1.d0
67            ctrl(32)=1.d0
68            ctrl(33)=5.d-7
69            ctrl(34)=5.d-7
70            ctrl(35)=5.d-7
71            ctrl(36)=5.d-7
72            ctrl(37)=5.d-7
73            ctrl(38)=5.d-7
74            ctrl(39)=5.d-7
75!
76!           ctrl(40) is used for the parameter CETOL on *visco
77!
78            ctrl(41)=1.d20
79            ctrl(42)=1.d20
80            ctrl(43)=1.d20
81            ctrl(44)=1.d20
82            ctrl(45)=1.d20
83            ctrl(46)=1.d20
84            ctrl(47)=1.d20
85            ctrl(48)=1.5d0
86            ctrl(49)=0.5d0
87            ctrl(50)=20.5d0
88            ctrl(51)=0.5d0
89            ctrl(52)=1.5d0
90            ctrl(53)=1.5d0
91            ctrl(54)=1.d-3
92            ctrl(55)=1.d-1
93            ctrl(56)=100.5d0
94            ctrl(57)=60.5d0
95            write(*,*)
96            write(*,*)
97     &         '*INFO: control parameters reset to default'
98            exit
99!
100         elseif(textpart(i)(1:29).eq.'PARAMETERS=TIMEINCREMENTATION')
101     &      then
102            call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
103     &           ipoinp,inp,ipoinpc)
104            if((istat.lt.0).or.(key.eq.1)) return
105            do j=1,min(8,n)
106               if(textpart(j)(1:1).eq.' ') cycle
107               read(textpart(j)(1:10),'(i10)',iostat=istat) k
108               if(istat.gt.0) then
109                  call inputerror(inpc,ipoinpc,iline,
110     &                 "*CONTROLS%",ier)
111                  return
112               endif
113               ctrl(j)=dble(k)+0.5d0
114            enddo
115            call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
116     &           ipoinp,inp,ipoinpc)
117            if((istat.lt.0).or.(key.eq.1)) return
118            do j=1,min(8,n)
119               if(textpart(j)(1:1).eq.' ') cycle
120               read(textpart(j)(1:20),'(f20.0)',iostat=istat) ctrl(j+10)
121               if(istat.gt.0) then
122                  call inputerror(inpc,ipoinpc,iline,
123     &                 "*CONTROLS%",ier)
124                  return
125               endif
126            enddo
127            write(*,*) '*INFO: time control parameters set to:'
128            write(*,*) '       i0 = ',int(ctrl(1))
129            write(*,*) '       ir = ',int(ctrl(2))
130            write(*,*) '       ip = ',int(ctrl(3))
131            write(*,*) '       ic = ',int(ctrl(4))
132            write(*,*) '       il = ',int(ctrl(5))
133            write(*,*) '       ig = ',int(ctrl(6))
134            write(*,*) '       is = ',int(ctrl(7))
135            write(*,*) '       ia = ',int(ctrl(8))
136            write(*,*) '       ij = ',int(ctrl(9))
137            write(*,*) '       it = ',int(ctrl(10))
138            write(*,*) '       df = ',ctrl(11)
139            write(*,*) '       dc = ',ctrl(12)
140            write(*,*) '       db = ',ctrl(13)
141            write(*,*) '       da = ',ctrl(14)
142            write(*,*) '       ds = ',ctrl(15)
143            write(*,*) '       dh = ',ctrl(16)
144            write(*,*) '       dd = ',ctrl(17)
145            write(*,*) '       wg = ',ctrl(18)
146            exit
147!
148         elseif(textpart(i)(1:16).eq.'PARAMETERS=FIELD') then
149            call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
150     &           ipoinp,inp,ipoinpc)
151            if((istat.lt.0).or.(key.eq.1)) return
152            do j=1,min(8,n)
153               if(textpart(j)(1:1).eq.' ') cycle
154               read(textpart(j)(1:20),'(f20.0)',iostat=istat) ctrl(j+18)
155               if(istat.gt.0) then
156                  call inputerror(inpc,ipoinpc,iline,
157     &                 "*CONTROLS%",ier)
158                  return
159               endif
160            enddo
161            write(*,*) '*INFO: field control parameters set to:'
162            write(*,*) '       ran = ',ctrl(19)
163            write(*,*) '       can = ',ctrl(20)
164            write(*,*) '       qa0 = ',ctrl(21)
165            write(*,*) '       qau = ',ctrl(22)
166            write(*,*) '       rap = ',ctrl(23)
167            write(*,*) '        ea = ',ctrl(24)
168            write(*,*) '       cae = ',ctrl(25)
169            write(*,*) '       ral = ',ctrl(26)
170            exit
171!
172         elseif(textpart(i)(1:21).eq.'PARAMETERS=LINESEARCH') then
173            call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
174     &           ipoinp,inp,ipoinpc)
175            if((istat.lt.0).or.(key.eq.1)) return
176            do j=1,min(5,n)
177               if(textpart(j)(1:1).eq.' ') cycle
178               read(textpart(j)(1:20),'(f20.0)',iostat=istat) ctrl(j+27)
179               if(istat.gt.0) then
180                  call inputerror(inpc,ipoinpc,iline,
181     &                 "*CONTROLS%",ier)
182                  return
183               endif
184            enddo
185            write(*,*) '*INFO: line search control parameters set to:'
186            write(*,*) '       nls = ',ctrl(28)
187            write(*,*) '       smaxls = ',ctrl(29)
188            write(*,*) '       sminls = ',ctrl(30)
189            write(*,*) '       fls = ',ctrl(31)
190            write(*,*) '       etls = ',ctrl(32)
191            exit
192!
193         elseif(textpart(i)(1:18).eq.'PARAMETERS=NETWORK') then
194            call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
195     &           ipoinp,inp,ipoinpc)
196            if((istat.lt.0).or.(key.eq.1)) return
197            do j=1,min(7,n)
198               if(textpart(j)(1:1).eq.' ') cycle
199               read(textpart(j)(1:20),'(f20.0)',iostat=istat) ctrl(j+32)
200               if(istat.gt.0) then
201                  call inputerror(inpc,ipoinpc,iline,
202     &                 "*CONTROLS%",ier)
203                  return
204               endif
205            enddo
206            write(*,*) '*INFO: network control parameters set to:'
207            write(*,*) '       c1t = ',ctrl(33)
208            write(*,*) '       c1f = ',ctrl(34)
209            write(*,*) '       c1p = ',ctrl(35)
210            write(*,*) '       c2t = ',ctrl(36)
211            write(*,*) '       c2f = ',ctrl(37)
212            write(*,*) '       c2p = ',ctrl(38)
213            write(*,*) '       c2a = ',ctrl(39)
214            call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
215     &           ipoinp,inp,ipoinpc)
216            if((istat.lt.0).or.(key.eq.1)) return
217            do j=1,min(6,n)
218               if(textpart(j)(1:1).eq.' ') cycle
219               read(textpart(j)(1:20),'(f20.0)',iostat=istat) ctrl(j+40)
220               if(istat.gt.0) then
221                  call inputerror(inpc,ipoinpc,iline,
222     &                 "*CONTROLS%",ier)
223                  return
224               endif
225            enddo
226            write(*,*) '       a1t = ',ctrl(41)
227            write(*,*) '       a1f = ',ctrl(42)
228            write(*,*) '       a1p = ',ctrl(43)
229            write(*,*) '       a2t = ',ctrl(44)
230            write(*,*) '       a2f = ',ctrl(45)
231            write(*,*) '       a2p = ',ctrl(46)
232            exit
233         elseif(textpart(i)(1:14).eq.'PARAMETERS=CFD') then
234            call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
235     &           ipoinp,inp,ipoinpc)
236            if((istat.lt.0).or.(key.eq.1)) return
237            do j=1,min(4,n)
238               if(textpart(j)(1:1).eq.' ') cycle
239               read(textpart(j)(1:20),'(f20.0)',iostat=istat) ctrl(j+49)
240               if(istat.gt.0) then
241                  call inputerror(inpc,ipoinpc,iline,
242     &                 "*CONTROLS%",ier)
243                  return
244               endif
245            enddo
246            write(*,*) '*INFO: CFD control parameters set to:'
247            write(*,*) '       iitf = ',int(ctrl(50))
248            write(*,*) '       iitg = ',int(ctrl(51))
249            write(*,*) '       iitp = ',int(ctrl(52))
250            write(*,*) '       iitpt = ',int(ctrl(53))
251            exit
252         elseif(textpart(i)(1:18).eq.'PARAMETERS=CONTACT') then
253            call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
254     &           ipoinp,inp,ipoinpc)
255            if((istat.lt.0).or.(key.eq.1)) return
256            do j=1,min(4,n)
257               if(textpart(j)(1:1).eq.' ') cycle
258               read(textpart(j)(1:20),'(f20.0)',iostat=istat) ctrl(j+53)
259               if(istat.gt.0) then
260                  call inputerror(inpc,ipoinpc,iline,
261     &                 "*CONTROLS%",ier)
262                  return
263               endif
264               if(j.ge.3) ctrl(j+53)=ctrl(j+53)+0.5d0
265            enddo
266!
267!           check range of parameters
268!
269            if(ctrl(54).lt.0.d0) then
270               write(*,*) '*ERROR reading *CONTROLS'
271               write(*,*) '       delcon should be positive'
272               call inputerror(inpc,ipoinpc,iline,
273     &              "*CONTROLS%",ier)
274            endif
275!
276            if((ctrl(55).lt.0.d0).or.(ctrl(55).gt.1.d0)) then
277               write(*,*) '*ERROR reading *CONTROLS'
278               write(*,*)
279     &        '       alea should belong to the interval [0.,1.]'
280               call inputerror(inpc,ipoinpc,iline,
281     &              "*CONTROLS%",ier)
282            endif
283!
284            if(ctrl(56).lt.1.d0) then
285               write(*,*) '*ERROR reading *CONTROLS'
286               write(*,*) '       kscalemax must be at least 1'
287               call inputerror(inpc,ipoinpc,iline,
288     &              "*CONTROLS%",ier)
289            endif
290!
291            if(ctrl(57).lt.1.d0) then
292               write(*,*) '*ERROR reading *CONTROLS'
293               write(*,*) '       itf2f must be at least 1'
294               call inputerror(inpc,ipoinpc,iline,
295     &              "*CONTROLS%",ier)
296            endif
297!
298            write(*,*) '*INFO: CONTACT control parameter set to:'
299            write(*,*) '       delcon = ',ctrl(54)
300            write(*,*) '       alea = ',ctrl(55)
301            write(*,*) '       kscalemax = ',int(ctrl(56))
302            write(*,*) '       itf2f = ',int(ctrl(57))
303            exit
304         else
305            write(*,*)
306     &        '*WARNING in controlss: parameter not recognized:'
307            write(*,*) '         ',
308     &                 textpart(i)(1:index(textpart(i),' ')-1)
309            call inputwarning(inpc,ipoinpc,iline,
310     &"*CONTROLS%")
311         endif
312      enddo
313!
314      call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
315     &     ipoinp,inp,ipoinpc)
316!
317      return
318      end
319
320
321
322
323
324
325
326
327