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