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! check whether SPC's and MPC's in salve nodes are compatible 20! with mortar contact 21! for 3D calculations all slave nodes involved in SPCs/MPCs (dependent and independent) are set to noLM nodes 22! 23! Author: Saskia Sitzmann 24! 25! [in] islavnode field storing the nodes of the slave surface 26! [in] imastnode field storing the nodes of the master surfaces 27! [in] nslavnode (i)pointer into field isalvnode for contact tie i 28! [in] nmastnode (i)pointer into field imastnode for contact tie i 29! [in] slavnor slave normals 30! [in,out] islavact (i) indicates, if slave node i is active (=-3 no-slave-node, =-2 no-LM-node, =-1 no-gap-node, =0 inactive node, =1 sticky node, =2 slipping/active node) 31! [in] nslavspc (2*i) pointer to islavspc... 32! [in] islavspc ... which stores SPCs for slave node i 33! [in] nsspc number of SPC for slave nodes 34! [in] nslavmpc (2*i) pointer to islavmpc... 35! [in,out] islavmpc ... which stores MPCs for slave node i 36! [in] nsmpc number of MPC for slave nodes 37! [in] nmspc number of SPC for master nodes 38! [in] nmastmpc (2*i) pointer to imastmpc... 39! [in,out] imastmpc ... which stores MPCs for master node i 40! [in] nmmpc number of MPC for master nodes 41! 42 subroutine checkspcmpc(ntie,tieset,islavnode,imastnode,nslavnode, 43 & nmastnode,slavnor,islavact,nboun,ndirboun,xboun, 44 & nodempc,coefmpc,ikboun,ilboun,nmpc2,ipompc2,nodempc2, 45 & nslavspc,islavspc,nsspc,nslavmpc,islavmpc,nsmpc, 46 & nmspc,nmastmpc,imastmpc,nmmpc) 47! 48! check whether SPC's and MPC's in salve nodes are compatible 49! with mortar contact 50! 51! author: Sitzmann,Saskia 52! 53! islavmpc(2,j)=1 directional blocking 54! islavmpc(2,j)=2 cyclic symmetry 55! 56! imastmpc(2,j)=1 directional blocking 57! imastmpc(2,j)=2 cyclic symmetry 58! imastmpc(2,j)=3 spc with displacement 59! 60 implicit none 61! 62 logical debug,incompatible,nogap,twod 63! 64 character*81 tieset(3,*) 65! 66 integer ntie,i,j,k,l,dir,dirind,dirdep,id,node, 67 & islavnode(*),imastnode(*),nslavnode(ntie+1), 68 & nmastnode(ntie+1),islavact(*),nboun,ndirboun(*), 69 & nodempc(3,*),index,nmpc2,ipompc2(*),nodempc2(3,*), 70 & ikboun(*),ilboun(*),nslavspc(2,*),islavspc(2,*),nsspc, 71 & nslavmpc(2,*),islavmpc(2,*),nsmpc,nmspc,nmastmpc(2,*), 72 & imastmpc(2,*),nmmpc,ist,zs(3),dof,node2,nsl,nc 73! 74 real*8 xboun(*),coefmpc(*),nn,n(3),fixed_disp,coefdep, 75 & slavnor(3,*),v(3),sp 76! 77 debug=.false. 78! 79! remove Lagrange Multiplier contributino for nodes which are 80! in more than one contact tie 81! 82 if(ntie.gt.1) then 83 do i=1,ntie 84 if(tieset(1,i)(81:81).ne.'C') cycle 85 do l=nslavnode(i)+1,nslavnode(i+1) 86 node=islavnode(l) 87 if(islavact(l).gt.-1) then 88 do j=1,ntie 89 if(j.ne.i) then 90 if(tieset(1,j)(81:81).ne.'C') cycle 91 call nident(islavnode(nslavnode(j)+1),node, 92 & nslavnode(j+1)-nslavnode(j),id) 93 if(id>0) then 94 if(islavnode(nslavnode(j)+id).eq.node) then 95 islavact(l)=-2 96 write(*,*)'checkspcmpc: node',node, 97 & 'tie1s',i,'tie2s',j 98 write(*,*)'in more than one contact', 99 & 'tie and set NoLM!' 100 endif 101 endif 102 call nident(imastnode(nmastnode(j)+1),node, 103 & nmastnode(j+1)-nmastnode(j),id) 104 if(id>0) then 105 if(imastnode(nmastnode(j)+id).eq.node) then 106 islavact(l)=-2 107 write(*,*)'checkspcmpc: node',node, 108 & 'tie1s',i,'tie2m',j 109 write(*,*)'in more than one', 110 & ' contact tie and set NoLM!' 111 endif 112 endif 113 endif 114 enddo 115 endif 116 enddo 117 enddo 118! 119 endif 120! 121! remove Lagrange Multiplier contribution from all slave nodes 122! involved in MPCs; 123! needed for quadratic elements 124! attention: 2D calculation are not possible right now 125! 126 do i=1,nmpc2 127 ist=ipompc2(i) 128 node=nodempc2(1,ist) 129 do j=1,ntie 130 call nident(islavnode(nslavnode(j)+1),node, 131 & nslavnode(j+1)-nslavnode(j),id) 132 if(id.gt.0) then 133 if(islavnode(nslavnode(j)+id).eq.node) then 134 islavact(nslavnode(j)+id)=-2 135 endif 136 endif 137 enddo 138 index=nodempc2(3,ist) 139! 140 if(index.ne.0) then 141 do 142 node2=nodempc2(1,index) 143 do j=1,ntie 144 call nident(islavnode(nslavnode(j)+1),node2, 145 & nslavnode(j+1)-nslavnode(j),id) 146 if(id.gt.0) then 147 if(islavnode(nslavnode(j)+id).eq.node2) then 148 islavact(nslavnode(j)+id)=-2 149 endif 150 endif 151 enddo 152 index=nodempc2(3,index) 153 if(index.eq.0) exit 154 enddo 155 endif 156 enddo 157! 158 return 159 end 160 161