1!
2!     CalculiX - A 3-dimensional finite element program
3!              Copyright (C) 1998 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 writemeshinp(kontet,netet_,cotet,nktet,ij,ipoed,iedg,
20     &  iexternedg,quality)
21!
22      implicit none
23!
24      character*1 ending
25      character*132 fninp
26!
27      integer kontet(4,*),netet_,i,j,nsom,nktet,ij,index,iedg(3,*),
28     &     iexternedg(*),ipoed(*),node
29!
30      real*8 cotet(3,*),quality(*),qualnod(nktet)
31!
32!     storing the mesh in input format
33!
34      write(ending,'(i1)') ij
35      fninp='finemesh.inp'//ending
36      open(2,file=fninp(1:13),status='unknown')
37!
38!     storing the nodes
39!
40      write(2,*) '*NODE'
41      do i=1,nktet
42         write(2,100) i,(cotet(j,i),j=1,3)
43      enddo
44!
45!     storing the elements
46!
47      write(2,*) '*ELEMENT,TYPE=C3D4,ELSET=TET'
48      nsom=0
49      do i=1,netet_
50         if(kontet(1,i).le.0) cycle
51         nsom=nsom+1
52         write(2,101) i,(kontet(j,i),j=1,4)
53      enddo
54      write(*,*) 'number of tetrahedra= ',nsom
55!
56 100  format(i10,',',e20.13,',',e20.13,',',e20.13)
57 101  format(5(i10,','))
58 102  format(i10,',1.')
59!
60      write(2,*) '*TEMPERATURE'
61      loop1: do i=1,nktet
62        index=ipoed(i)
63        do
64          if(index.eq.0) cycle loop1
65          if(iexternedg(index).gt.0) then
66            write(2,102) iedg(1,index)
67            write(2,102) iedg(2,index)
68          endif
69          index=iedg(3,index)
70        enddo
71      enddo loop1
72!
73!     calculating the max quality measure (= worst quality) in the
74!     nodes
75!
76      do i=1,nktet
77        qualnod(i)=0.d0
78      enddo
79!
80      do i=1,netet_
81        if(kontet(1,i).le.0) cycle
82        do j=1,4
83          node=kontet(j,i)
84          qualnod(node)=max(qualnod(node),quality(i))
85        enddo
86      enddo
87!
88      write(2,*) '*INITIAL CONDITIONS,TYPE=PRESSURE'
89      do i=1,nktet
90        write(2,100) i,qualnod(i)
91      enddo
92!
93      close(2)
94!
95      return
96      end
97