CalculiX  2.13
A Free Software Three-Dimensional Structural Finite Element Program
controlss.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine controlss (inpc, textpart, ctrl, istep, istat, n, iline, ipol, inl, ipoinp, inp, ipoinpc)
 

Function/Subroutine Documentation

◆ controlss()

subroutine controlss ( character*1, dimension(*)  inpc,
character*132, dimension(16)  textpart,
real*8, dimension(*)  ctrl,
integer  istep,
integer  istat,
integer  n,
integer  iline,
integer  ipol,
integer  inl,
integer, dimension(2,*)  ipoinp,
integer, dimension(3,*)  inp,
integer, dimension(0:*)  ipoinpc 
)
21 !
22 ! reading the input deck: *STEP
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:*)
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.
43  ctrl(8)=5.5d0
44  ctrl(9)=0.
45  ctrl(10)=0.
46  ctrl(11)=0.25d0
47  ctrl(12)=0.5d0
48  ctrl(13)=0.75d0
49  ctrl(14)=0.85d0
50  ctrl(15)=0.
51  ctrl(16)=0.
52  ctrl(17)=1.5d0
53  ctrl(18)=0.
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  write(*,*)
76  write(*,*)
77  & '*INFO: control parameters reset to default'
78  exit
79 !
80  elseif(textpart(i)(1:29).eq.'PARAMETERS=TIMEINCREMENTATION')
81  & then
82  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
83  & ipoinp,inp,ipoinpc)
84  do j=1,n
85  read(textpart(j)(1:10),'(i10)',iostat=istat) k
86  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
87  &"*CONTROLS%")
88  ctrl(j)=dble(k)+0.5d0
89  enddo
90  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
91  & ipoinp,inp,ipoinpc)
92  do j=1,n
93  read(textpart(j)(1:20),'(f20.0)',iostat=istat) ctrl(j+10)
94  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
95  &"*CONTROLS%")
96  enddo
97  write(*,*) '*INFO: time control parameters set to:'
98  write(*,*) ' i0 = ',int(ctrl(1))
99  write(*,*) ' ir = ',int(ctrl(2))
100  write(*,*) ' ip = ',int(ctrl(3))
101  write(*,*) ' ic = ',int(ctrl(4))
102  write(*,*) ' il = ',int(ctrl(5))
103  write(*,*) ' ig = ',int(ctrl(6))
104  write(*,*) ' is = ',int(ctrl(7))
105  write(*,*) ' ia = ',int(ctrl(8))
106  write(*,*) ' ij = ',int(ctrl(9))
107  write(*,*) ' it = ',int(ctrl(10))
108  write(*,*) ' df = ',ctrl(11)
109  write(*,*) ' dc = ',ctrl(12)
110  write(*,*) ' db = ',ctrl(13)
111  write(*,*) ' da = ',ctrl(14)
112  write(*,*) ' ds = ',ctrl(15)
113  write(*,*) ' dh = ',ctrl(16)
114  write(*,*) ' dd = ',ctrl(17)
115  write(*,*) ' wg = ',ctrl(18)
116  exit
117 !
118  elseif(textpart(i)(1:16).eq.'PARAMETERS=FIELD') then
119  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
120  & ipoinp,inp,ipoinpc)
121  do j=1,n
122  read(textpart(j)(1:20),'(f20.0)',iostat=istat) ctrl(j+18)
123  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
124  &"*CONTROLS%")
125  enddo
126  write(*,*) '*INFO: field control parameters set to:'
127  write(*,*) ' ran = ',ctrl(19)
128  write(*,*) ' can = ',ctrl(20)
129  write(*,*) ' qa0 = ',ctrl(21)
130  write(*,*) ' qau = ',ctrl(22)
131  write(*,*) ' rap = ',ctrl(23)
132  write(*,*) ' ea = ',ctrl(24)
133  write(*,*) ' cae = ',ctrl(25)
134  write(*,*) ' ral = ',ctrl(26)
135  exit
136 !
137  elseif(textpart(i)(1:21).eq.'PARAMETERS=LINESEARCH') then
138  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
139  & ipoinp,inp,ipoinpc)
140  do j=1,n
141  read(textpart(j)(1:20),'(f20.0)',iostat=istat) ctrl(j+27)
142  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
143  &"*CONTROLS%")
144  enddo
145  write(*,*) '*INFO: line search control parameters set to:'
146  write(*,*) ' nls = ',ctrl(28)
147  write(*,*) ' smaxls = ',ctrl(29)
148  write(*,*) ' sminls = ',ctrl(30)
149  write(*,*) ' fls = ',ctrl(31)
150  write(*,*) ' etls = ',ctrl(32)
151  exit
152 !
153  elseif(textpart(i)(1:18).eq.'PARAMETERS=NETWORK') then
154  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
155  & ipoinp,inp,ipoinpc)
156  do j=1,n
157  read(textpart(j)(1:20),'(f20.0)',iostat=istat) ctrl(j+32)
158  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
159  &"*CONTROLS%")
160  enddo
161  write(*,*) '*INFO: network control parameters set to:'
162  write(*,*) ' c1t = ',ctrl(33)
163  write(*,*) ' c1f = ',ctrl(34)
164  write(*,*) ' c1p = ',ctrl(35)
165  write(*,*) ' c2t = ',ctrl(36)
166  write(*,*) ' c2f = ',ctrl(37)
167  write(*,*) ' c2p = ',ctrl(38)
168  write(*,*) ' c2a = ',ctrl(39)
169  exit
170  else
171  write(*,*)
172  & '*WARNING in controlss: parameter not recognized:'
173  write(*,*) ' ',
174  & textpart(i)(1:index(textpart(i),' ')-1)
175  call inputwarning(inpc,ipoinpc,iline,
176  &"*CONTROLS%")
177  endif
178  enddo
179 !
180  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
181  & ipoinp,inp,ipoinpc)
182 !
183  return
subroutine inputwarning(inpc, ipoinpc, iline, text)
Definition: inputwarning.f:20
subroutine getnewline(inpc, textpart, istat, n, key, iline, ipol, inl, ipoinp, inp, ipoinpc)
Definition: getnewline.f:21
subroutine inputerror(inpc, ipoinpc, iline, text)
Definition: inputerror.f:20
Hosted by OpenAircraft.com, (Michigan UAV, LLC)