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 forcadd(node,i,val,nodeforc,ndirforc,xforc, 20 & nforc,nforc_,iamforc,iamplitude,nam,ntrans,trab,inotr,co, 21 & ikforc,ilforc,isector,add,user,idefforc,ipompc,nodempc, 22 & nmpc,ikmpc,ilmpc,labmpc) 23! 24! adds a cload condition to the data base 25! 26 implicit none 27! 28 logical add,user 29! 30 character*20 labmpc(*) 31! 32 integer nodeforc(2,*),ndirforc(*),node,i,nforc,nforc_,j, 33 & iamforc(*),iamplitude,nam,ntrans,inotr(2,*),itr,idf(3), 34 & ikforc(*),ilforc(*),idof,id,k,isector,idefforc(*),ipompc(*), 35 & nodempc(3,*),nmpc,ikmpc(*),ilmpc(*) 36! 37 real*8 xforc(*),val,trab(7,*),a(3,3),co(3,*) 38! 39 if(ntrans.eq.0) then 40 itr=0 41 else 42 itr=inotr(1,node) 43 endif 44! 45! checking for boundary conditions on rotational dofs of 46! distributing couplings 47! 48 if((i.ge.4).and.(i.le.6)) then 49! 50! rotational dof 51! 52 idof=8*(node-1)+i 53 call nident(ikmpc,idof,nmpc,id) 54 if(id.gt.0) then 55 if(ikmpc(id).eq.idof) then 56 if(labmpc(ilmpc(id))(1:14).eq.'ROTTRACOUPLING') then 57 node=nodempc(1,nodempc(3,ipompc(ilmpc(id)))) 58 i=nodempc(2,nodempc(3,ipompc(ilmpc(id)))) 59 itr=0 60 endif 61 endif 62 endif 63 endif 64! 65! change: transformations on rotations are taken into account 66! by the normal of the mean rotation MPC, not by expanding the 67! MPC in Carthesian coordinates 68! 69! 70! no transformation applies to the node 71! 72 idof=8*(node-1)+i 73 call nident(ikforc,idof,nforc,id) 74 if(id.gt.0) then 75 do 76 if(ikforc(id).eq.idof) then 77 k=ilforc(id) 78 if(nodeforc(2,k).eq.isector) then 79 if(add.or.(idefforc(k).eq.1)) then 80 if(nam.gt.0) then 81 if(iamforc(k).ne.iamplitude) then 82 write(*,*) '*ERROR in forcadd:' 83 write(*,*) ' it is not allowed to ' 84 write(*,*)' define two concentrated' 85 write(*,*) ' loads/fluxes' 86 write(*,*) ' different amplitudes ' 87 write(*,*) ' in one step' 88 write(*,*) 'node: ',node,' dof:',i 89 call exit(201) 90 endif 91 endif 92 xforc(k)=xforc(k)+val 93 else 94 xforc(k)=val 95 if(.not.user) idefforc(k)=1 96 endif 97 if(nam.gt.0) iamforc(k)=iamplitude 98 return 99 endif 100 id=id-1 101 if(id.eq.0) exit 102 else 103 exit 104 endif 105 enddo 106 endif 107! 108 nforc=nforc+1 109 if(nforc.gt.nforc_) then 110 write(*,*) '*ERROR in forcadd: increase nforc_' 111 call exit(201) 112 endif 113 nodeforc(1,nforc)=node 114 nodeforc(2,nforc)=isector 115 ndirforc(nforc)=i 116 xforc(nforc)=val 117 if(.not.user) idefforc(nforc)=1 118 if(nam.gt.0) iamforc(nforc)=iamplitude 119! 120! updating ikforc and ilforc 121! 122 do j=nforc,id+2,-1 123 ikforc(j)=ikforc(j-1) 124 ilforc(j)=ilforc(j-1) 125 enddo 126 ikforc(id+1)=idof 127 ilforc(id+1)=nforc 128! 129 return 130 end 131 132