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 disp_sen_dv(nodeset,istartset,iendset,ialset,iobject, 20 & mi,nactdof,dgdu,vold,objectset,nactdofinv,neq,g0) 21! 22! calculates the sum of the square of the displacements of a node 23! set and its derivative w.r.t. the coordinates of the mesh 24! 25 implicit none 26! 27 character*81 objectset(5,*) 28! 29 integer istartset(*),iendset(*),ialset(*),nodeset,idir, 30 & idof,iobject,mi(*),nactdof(0:mi(2),*),j,k,nactdofinv(*), 31 & inode,node,neq,mt 32! 33 real*8 dgdu(*),vold(0:mi(2),*),g0(*) 34! 35! 36! 37 mt=mi(2)+1 38! 39! check for the existence of a set, else take the complete mesh 40! 41 if(nodeset.eq.0) then 42 do idof=1,neq 43 inode=nactdofinv(idof) 44 idir=inode-mt*(inode/mt); 45 node=inode/mt+1; 46 if(objectset(1,iobject)(1:8).eq.'ALL-DISP') then 47 dgdu(idof)=vold(idir,node)/g0(iobject) 48 elseif(objectset(1,iobject)(1:6).eq.'X-DISP') then 49 if(idir.eq.1) then 50 dgdu(idof)=vold(idir,node)/g0(iobject) 51 endif 52 elseif(objectset(1,iobject)(1:6).eq.'Y-DISP') then 53 if(idir.eq.2) then 54 dgdu(idof)=vold(idir,node)/g0(iobject) 55 endif 56 elseif(objectset(1,iobject)(1:6).eq.'Z-DISP') then 57 if(idir.eq.3) then 58 dgdu(idof)=vold(idir,node)/g0(iobject) 59 endif 60 endif 61 enddo 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 idof=nactdof(idir,ialset(j)) 68 if(idof.gt.0) then 69 dgdu(idof)=vold(idir,ialset(j))/g0(iobject) 70 endif 71 enddo 72 elseif(objectset(1,iobject)(1:6).eq.'X-DISP') then 73 idof=nactdof(1,ialset(j)) 74 if(idof.gt.0) then 75 dgdu(idof)=vold(1,ialset(j))/g0(iobject) 76 endif 77 elseif(objectset(1,iobject)(1:6).eq.'Y-DISP') then 78 idof=nactdof(2,ialset(j)) 79 if(idof.gt.0) then 80 dgdu(idof)=vold(2,ialset(j))/g0(iobject) 81 endif 82 elseif(objectset(1,iobject)(1:6).eq.'Z-DISP') then 83 idof=nactdof(3,ialset(j)) 84 if(idof.gt.0) then 85 dgdu(idof)=vold(3,ialset(j))/g0(iobject) 86 endif 87 endif 88 else 89 k=ialset(j-2) 90 do 91 k=k-ialset(j) 92 if(k.ge.ialset(j-1)) exit 93 if(objectset(1,iobject)(1:8).eq.'ALL-DISP') then 94 do idir=1,3 95 idof=nactdof(idir,ialset(j)) 96 if(idof.gt.0) then 97 dgdu(idof)=vold(idir,ialset(j))/g0(iobject) 98 endif 99 enddo 100 elseif(objectset(1,iobject)(1:6).eq.'X-DISP') then 101 idof=nactdof(1,ialset(j)) 102 if(idof.gt.0) then 103 dgdu(idof)=vold(1,ialset(j))/g0(iobject) 104 endif 105 elseif(objectset(1,iobject)(1:6).eq.'Y-DISP') then 106 idof=nactdof(2,ialset(j)) 107 if(idof.gt.0) then 108 dgdu(idof)=vold(2,ialset(j))/g0(iobject) 109 endif 110 elseif(objectset(1,iobject)(1:6).eq.'Z-DISP') then 111 idof=nactdof(3,ialset(j)) 112 if(idof.gt.0) then 113 dgdu(idof)=vold(3,ialset(j))/g0(iobject) 114 endif 115 endif 116 enddo 117 endif 118 enddo 119 endif 120! 121 return 122 end 123 124