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 changedepterm(ikmpc,ilmpc,nmpc,mpc,idofrem,idofins)
20!
21!     changes the dependent term in ikmpc and ilmpc for MPC mpc.
22!
23      implicit none
24!
25      integer ikmpc(*),ilmpc(*),nmpc,idofrem,idofins,id,k,mpc
26!
27!     remove MPC from ikmpc
28!
29      call nident(ikmpc,idofrem,nmpc,id)
30      if(id.gt.0) then
31         if(ikmpc(id).eq.idofrem) then
32            do k=id+1,nmpc
33               ikmpc(k-1)=ikmpc(k)
34               ilmpc(k-1)=ilmpc(k)
35            enddo
36         else
37            write(*,*) '*ERROR in changedepterm'
38            write(*,*) '       ikmpc database corrupted'
39            call exit(201)
40         endif
41      else
42         write(*,*) '*ERROR in changedepterm'
43         write(*,*) '       ikmpc database corrupted'
44         call exit(201)
45      endif
46!
47!     insert new MPC
48!
49      call nident(ikmpc,idofins,nmpc-1,id)
50      if((id.gt.0).and.(ikmpc(id).eq.idofins)) then
51         write(*,*) '*ERROR in changedepterm: dependent DOF'
52         write(*,*) '       of nonlinear MPC cannot be changed'
53         write(*,*) '       since new dependent DOF is already'
54         write(*,*) '       used in another MPC'
55         call exit(201)
56      else
57         do k=nmpc,id+2,-1
58            ikmpc(k)=ikmpc(k-1)
59            ilmpc(k)=ilmpc(k-1)
60         enddo
61         ikmpc(id+1)=idofins
62         ilmpc(id+1)=mpc
63      endif
64!
65      return
66      end
67
68
69
70
71
72
73
74
75
76
77
78