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 writecvg(istep,iinc,icutb,iit,ne,ne0,ram,qam,cam,uam,
20     &  ithermal)
21!
22      implicit none
23!
24!     writes convergence information in the .cvg-file
25!
26      integer istep,iinc,iit,ne,ne0,ithermal(*),icutb
27!
28      real*8 ram(*),qam(*),cam(*),uam(*),residforce,corrdisp,
29     &  residflux,corrtemp
30!
31      if(ithermal(1).eq.2) then
32         residforce=0.d0
33         corrdisp=0.d0
34      else
35         if(dabs(qam(1)).lt.1.d-30) then
36            if(dabs(ram(1)).lt.1.d-30) then
37               residforce=1.d-30
38            else
39               residforce=1.d30
40            endif
41         else
42            residforce=ram(1)/qam(1)*100.d0
43         endif
44!
45         if(dabs(uam(1)).lt.1.d-30) then
46            if(dabs(cam(1)).lt.1.d-30) then
47               corrdisp=1.d-30
48            else
49               corrdisp=1.d30
50            endif
51         else
52            corrdisp=cam(1)/uam(1)*100.d0
53         endif
54      endif
55!
56      if(ithermal(1).le.1) then
57         residflux=0.d0
58         corrtemp=0.d0
59      else
60         if(dabs(qam(2)).lt.1.d-30) then
61            if(dabs(ram(2)).lt.1.d-30) then
62               residflux=1.d-30
63            else
64               residflux=1.d30
65            endif
66         else
67            residflux=ram(2)/qam(2)*100.d0
68         endif
69         if(dabs(uam(2)).lt.1.d-30) then
70            if(dabs(cam(2)).lt.1.d-30) then
71               corrtemp=1.d-30
72            else
73               corrtemp=1.d30
74            endif
75         else
76            corrtemp=cam(2)/uam(2)*100.d0
77         endif
78      endif
79!
80      write(11,'(2x,i4,2x,i4,2x,i4,2x,i4,2x,i7,4(1x,e11.4))') istep,
81     &  iinc,icutb+1,iit,ne-ne0,residforce,corrdisp,residflux,corrtemp
82!
83      flush(11)
84!
85      return
86      end
87