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 writerefinemesh(kontet,netet_,cotet,nktet,jobnamec, 20 & iquad,iedtet,iedgmid,number,jfix,iparentel,nk,iwrite) 21! 22 implicit none 23! 24 character*10 elestr 25 character*132 fnrfn,jobnamec,el_header 26! 27 integer kontet(4,*),netet_,i,j,k,nktet,node,iquad,iedtet(6,*), 28 & iedgmid(*),number(*),nk,jfix(*),iparentel(*),iwrite 29! 30 real*8 cotet(3,*) 31! 32! give nodes of the unrefined mesh which were not fixed 33! a new node number in order to avoid collisions with the 34! refined mesh 35! 36 do i=1,netet_ 37 if(kontet(1,i).ne.0) then 38 do j=1,4 39 node=kontet(j,i) 40 if((jfix(node).ne.1).and.(node.le.nk)) then 41 if(number(node).ne.0) then 42 kontet(j,i)=number(node) 43 else 44 nktet=nktet+1 45 number(node)=nktet 46 kontet(j,i)=nktet 47 do k=1,3 48 cotet(k,nktet)=cotet(k,node) 49 enddo 50 endif 51 endif 52 enddo 53 endif 54 enddo 55! 56! stores the refined mesh in input format 57! 58 do i=1,132 59 if(ichar(jobnamec(i:i)).eq.0) exit 60 enddo 61 if(i.gt.125) then 62 write(*,*) '*ERROR in writerefinemesh' 63 write(*,*) ' jobname has more than 124 characters' 64 call exit(201) 65 endif 66 fnrfn(1:i+7)=jobnamec(1:i-1)//'.rfn.inp' 67! 68! storing the mesh in input format 69! 70 open(2,file=fnrfn(1:i+7),status='unknown',position='append') 71! 72! storing the nodes 73! 74 write(2,102) 75 102 format('*NODE') 76 do i=1,nktet 77! 78! setting too small numbers to zero (else the exponent in the 79! output contains 3 digits and the letter "D" is omitted) 80! 81 do j=1,3 82 if(dabs(cotet(j,i)).lt.1.d-99) cotet(j,i)=0.d0 83 enddo 84 write(2,100) i,(cotet(j,i),j=1,3) 85 enddo 86! 87! storing the tetrahedral elements 88! 89 if(iquad.eq.0) then 90 do i=1,netet_ 91 if(kontet(1,i).ne.0) then 92! 93! keyword card 94! 95 write(elestr,'(i10)') iparentel(i) 96 do k=1,10 97 if(elestr(k:k).ne.' ') exit 98 enddo 99 el_header='*ELEMENT,PARENT='//elestr(k:10)// 100 & ',TYPE=C3D4' 101 write(2,*) el_header(1:36-k+1) 102! 103! topology 104! 105 write(2,101) i,(kontet(j,i),j=1,4) 106 endif 107 enddo 108 else 109 do i=1,netet_ 110 if(kontet(1,i).ne.0) then 111! 112! keyword card 113! 114 write(elestr,'(i10)') iparentel(i) 115 do k=1,11 116 if(elestr(k:k).ne.' ') exit 117 enddo 118 el_header='*ELEMENT,PARENT='//elestr(k:10)// 119 & ',TYPE=C3D10' 120 write(2,*) el_header(1:37-k+1) 121! 122! topology 123! 124 write(2,101) i,(kontet(j,i),j=1,4), 125 & (iedgmid(iedtet(j,i)),j=1,6) 126 endif 127 enddo 128 endif 129! 130 close(2) 131! 132 100 format(i10,',',e20.13,',',e20.13,',',e20.13) 133 101 format(11(i10,',')) 134! 135 if(iwrite.eq.1) then 136 write(*,*) '*INFO in writerefinemesh:' 137 write(*,*) ' not (completely) projected nodes' 138 write(*,*) ' are stored in file' 139 write(*,*) ' WarnNodeNotProjected.nam' 140 write(*,*) ' This file can be loaded into' 141 write(*,*) ' an active cgx-session by typing' 142 write(*,*) 143 & ' read WarnNodeNotProjected.nam inp' 144 write(*,*) 145 close(40) 146 else 147 close(40,status='delete') 148 endif 149! 150 return 151 end 152