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 objective_disp(nodeset,istartset,iendset,ialset, 20 & nk,idesvarc,iobject,mi,g0,nobject,vold,objectset) 21! 22! calculates the sum of the square of the displacements of a node 23! set 24! 25 implicit none 26! 27 character*81 objectset(5,*) 28! 29 integer nk,istartset(*),iendset(*),ialset(*),nodeset,idir, 30 & idesvarc,iobject,mi(*),j,k,nobject,idesvar 31! 32 real*8 g0(nobject),vold(0:mi(2),*) 33! 34! 35! 36 idesvar=idesvarc+1 37! 38 g0(iobject)=0.d0 39! 40! check for the existence of a set, else take the complete mesh 41! 42 if(nodeset.eq.0) then 43 if(objectset(1,iobject)(1:8).eq.'ALL-DISP') then 44 do j=1,nk 45 do idir=1,3 46 g0(iobject)=g0(iobject)+vold(idir,j)**2 47 enddo 48 enddo 49 elseif(objectset(1,iobject)(1:6).eq.'X-DISP') then 50 do j=1,nk 51 g0(iobject)=g0(iobject)+vold(1,j)**2 52 enddo 53 elseif(objectset(1,iobject)(1:6).eq.'Y-DISP') then 54 do j=1,nk 55 g0(iobject)=g0(iobject)+vold(2,j)**2 56 enddo 57 elseif(objectset(1,iobject)(1:6).eq.'Z-DISP') then 58 do j=1,nk 59 g0(iobject)=g0(iobject)+vold(3,j)**2 60 enddo 61 endif 62 else 63 do j=istartset(nodeset),iendset(nodeset) 64 if(ialset(j).gt.0) then 65 if(objectset(1,iobject)(1:8).eq.'ALL-DISP') then 66 do idir=1,3 67 g0(iobject)=g0(iobject)+vold(idir,ialset(j))**2 68 enddo 69 elseif(objectset(1,iobject)(1:6).eq.'X-DISP') then 70 g0(iobject)=g0(iobject)+vold(1,ialset(j))**2 71 elseif(objectset(1,iobject)(1:6).eq.'Y-DISP') then 72 g0(iobject)=g0(iobject)+vold(2,ialset(j))**2 73 elseif(objectset(1,iobject)(1:6).eq.'Z-DISP') then 74 g0(iobject)=g0(iobject)+vold(3,ialset(j))**2 75 endif 76 else 77 k=ialset(j-2) 78 do 79 k=k-ialset(j) 80 if(k.ge.ialset(j-1)) exit 81 if(objectset(1,iobject)(1:8).eq.'ALL-DISP') then 82 do idir=1,3 83 g0(iobject)=g0(iobject)+vold(idir,k)**2 84 enddo 85 elseif(objectset(1,iobject)(1:6).eq.'X-DISP') then 86 g0(iobject)=g0(iobject)+vold(1,k)**2 87 elseif(objectset(1,iobject)(1:6).eq.'Y-DISP') then 88 g0(iobject)=g0(iobject)+vold(2,k)**2 89 elseif(objectset(1,iobject)(1:6).eq.'Z-DISP') then 90 g0(iobject)=g0(iobject)+vold(3,k)**2 91 endif 92 enddo 93 endif 94 enddo 95 endif 96! 97! Euclidian length 98! 99 g0(iobject)=dsqrt(g0(iobject)) 100! 101 return 102 end 103 104