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 smoothbadvertex(cotet,kontet,ipoeln,ieln,nbadnodes, 20 & ibadnodes,iponn,inn,iexternnode,ipoeled,ieled,iedgmid,iedtet) 21! 22! optimizing the position of bad vertex nodes by means of fminsi; 23! bad vertex nodes are vertex nodes on the free surface which 24! were not successfully projected in projectvertexnodes.f 25! 26 implicit none 27! 28 integer ibadnodes(*),nbadnodes,i,node,iexternnode(*),k,index,n, 29 & iponn(*),neigh,inn(2,*),ier,kontet(4,*),ipoeln(*),ieln(2,*), 30 & ipoeled(*),ieled(2,*),iedgmid(*),iedtet(6,*),iedge 31! 32 real*8 cotet(3,*),cpycotet(3),x(3),fuvertex,eps(3),fmin 33! 34 external fuvertex 35! 36 do i=1,nbadnodes 37 neigh=ibadnodes(i) 38! 39! only subsurface neighbors are optimized 40! 41 if(iexternnode(neigh).ne.0) cycle 42! 43! saving the original coordinates 44! 45 do k=1,3 46 cpycotet(k)=cotet(k,neigh) 47 x(k)=cotet(k,neigh) 48 eps(k)=0.d0 49 enddo 50! 51! starting function value (not really necessary, just in 52! case one want to print this value) 53! 54 n=3 55 fmin=fuvertex(n,x,cotet,kontet,ipoeln,ieln,neigh,iedge, 56 & ipoeled,ieled,iedgmid,iedtet) 57! 58! calling the optimizer 59! 60 ier=0 61 call fminsirefine(n,x,fuvertex,eps,fmin,ier,cotet, 62 & kontet,ipoeln,ieln,neigh,iedge, 63 & ipoeled,ieled,iedgmid,iedtet) 64! 65! restoring the original coordinates in case of error 66! 67 if(ier.ne.0) then 68 do k=1,3 69 cotet(k,neigh)=cpycotet(k) 70 enddo 71 else 72 do k=1,3 73 cotet(k,neigh)=x(k) 74 enddo 75 endif 76! 77 enddo 78! 79 return 80 end 81