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