module cdraw_data implicit none real(4)::xmin,xmax,ymin,ymax,zmin,zmax integer::ind,ibc real(4)::baselength,baseheight real(4)::bavx,bfvx real(4)::bavz,bfvz character::strx*100,stry*100 end module cdraw_data program f90_GMTheat !Drawing by GMT !2-dimensional unsteady heat conduction analysis use cdraw_data implicit none integer::i,j,n,ne character(len=100)::strcom !Comment integer::NODT !Number of nodes integer::NELT !Number of elements integer::MATEL !Number of material sets integer::KOT !Number of nodes with given temperature integer::KOC !Number of sides with the condition of heat transfer boundary integer::nod=4 !Number of nodes per element integer::nhen=1 !Number of degree of freedom per node integer,allocatable::kakom(:,:) !Element connectivity integer,allocatable::matno(:) !Material set number real(4),allocatable::x(:) !x-coordinate of node real(4),allocatable::y(:) !y-coordinate of node integer,allocatable::nokt(:) !Node number with given temperature integer,allocatable::nekc(:,:) !Element number and side number with the condition of heat transfer boundary integer::kchen !work for side number with heat transfer boundary real(4)::delta !Time increment integer::itmax !Number of time history steps integer::nout !Number of of nodes for all time history steps integer::ntout !Frequency of output of all node's temperatures real(4),allocatable::ttime(:) !Time integer,allocatable::noout(:) !Node number for output of temperature of all time history steps integer,allocatable::nntout(:) !Step number for all node's temperarture output real(4),allocatable::tempe_n(:,:)!Nodal temperature for output of all time history steps real(4),allocatable::tempe_s(:,:)!Nodal temperature for output of all node's temperatures integer::io real(4)::rw,alp(1:4) integer::iw character,allocatable::str(:)*20 character::strdum*100,str1*20 real(4)::fact0=1e-10 character::linebuf*1000 character::fnameR*50 call getarg(1,fnameR) !Input fule name open(11,file=fnameR,status='old') read(11,'(a)') strcom read(11,'()') read(11,*) NODT,NELT,MATEL,KOT,KOC,delta,nout,ntout,itmax allocate(kakom(1:NELT,1:4)) allocate(matno(1:NELT)) allocate(x(1:NODT)) allocate(y(1:NODT)) allocate(nokt(1:KOT)) allocate(nekc(1:KOC,1:2)) allocate(noout(1:nout)) allocate(nntout(1:ntout+1)) allocate(ttime(1:itmax+1)) allocate(tempe_n(1:itmax+1,1:nout)) allocate(tempe_s(1:NODT,1:ntout+1)) if(ntout<=nout)allocate(str(1:nout)) if(nout<=ntout)allocate(str(1:ntout)) read(11,'()') read(11,'()') j=0 do i=1,NODT read(11,*) iw,x(i),y(i),n,rw if(n==1)then j=j+1 nokt(j)=i end if end do read(11,'()') read(11,'()') i=0 do ne=1,NELT read(11,*) iw,(kakom(ne,j),j=1,nod),(alp(j),j=1,4),rw,rw,rw,rw,rw,matno(ne) do j=1,4 if(fact0' write(12,*) (x(i)),' ',(y(i)) write(12,*) (x(j)),' ',(y(j)) write(12,*) (x(k)),' ',(y(k)) write(12,*) (x(l)),' ',(y(l)) end if end do close (12) end do if(0' write(13,*) x(i),y(i),tempe_s(i,n) write(13,*) x(j),y(j),tempe_s(j,n) write(13,*) x(k),y(k),tempe_s(k,n) write(13,*) x(l),y(l),tempe_s(l,n) write(13,*) x(i),y(i),tempe_s(i,n) end do close(13) end do end subroutine DAT_XYZ subroutine MAKE_BAT(MATEL,KOT,KOC,delta,nntout,ntout) integer,intent(in)::MATEL,KOT,KOC,ntout integer,intent(in)::nntout(1:ntout+1) real(4),intent(in)::delta integer::i,n,ma character::srangex*100,srangez*100,sscalex*100,sscalez*100,sstep*50,filename*50 character::sbx*50,sbz*50,ssx*100,ssy*100,ssz*100,sinpf*50 character::scol*50,snum*50,spsize*50,scsize*50 character::strw1*50,strw2*50,strw3*50,strw4*50,strw5*50,strw6*50 real(4)::psize,ds,work character(len=3)::col_r(1:MATEL),col_g(1:MATEL),col_b(1:MATEL) character(len=11)::col_mesh(1:MATEL) psize=0.015*baselength ds=bfvx open (11, file='_col_mesh.txt', status='old') do i=1,MATEL read(11,*) col_r(i),col_g(i),col_b(i) col_mesh(i)=trim(adjustl(col_r(i)))//'/'//trim(adjustl(col_g(i)))//'/'//trim(adjustl(col_b(i))) end do close(11) write(strw1,'(f10.3)') xmin-ds; write(strw2,'(f10.3)') xmax; write(strw3,'(f10.3)') ymin-ds; write(strw4,'(f10.3)') ymax; srangex='set rangex='//trim(adjustl(strw1))//'/'//trim(adjustl(strw2))& //'/'//trim(adjustl(strw3))//'/'//trim(adjustl(strw4)) write(strw1,'(f10.3)') xmin; write(strw2,'(f10.3)') xmax; write(strw3,'(f10.3)') ymin; write(strw4,'(f10.3)') ymax; write(strw5,'(f10.3)') zmin; write(strw6,'(f10.3)') zmax; srangez='set rangez='//trim(adjustl(strw1))//'/'//trim(adjustl(strw2))& //'/'//trim(adjustl(strw3))//'/'//trim(adjustl(strw4))& //'/'//trim(adjustl(strw5))//'/'//trim(adjustl(strw6)) write(strw1,'(f10.3)') baselength/(xmax-xmin)*(xmax-xmin) write(strw2,'(f10.3)') baselength/(xmax-xmin)*(ymax-ymin) write(strw3,'(f10.3)') baseheight sscalex='set scalex='//trim(adjustl(strw1))//'/'//trim(adjustl(strw2)) sscalez='set scalez='//trim(adjustl(strw3)) write(strw1,'(f10.3)') bavx write(strw2,'(f10.3)') bfvx sbx='set bax=a'//trim(adjustl(strw1))//'f'//trim(adjustl(strw2)) write(strw1,'(f10.3)') bavz write(strw2,'(f10.3)') bfvz sbz='set baz=a'//trim(adjustl(strw1))//'f'//trim(adjustl(strw2)) ssx='set strx="'//trim(adjustl(strx))//'"' ssy='set stry="'//trim(adjustl(stry))//'"' ssz='set strz="Temperature (@%%12%%\260@%%%%C)"' write(strw1,'(f10.3)') psize spsize='set psize='//trim(adjustl(strw1)) write(strw1,'(f10.3)') psize*4.0 scsize='set csize='//trim(adjustl(strw1)) open (12, file='bat_gmt_xyz.bat', status='replace') write(12,'(a)') 'gmtset ANOT_FONT_SIZE 12' write(12,'(a)') 'gmtset ANOT_OFFSET 0.2c' write(12,'(a)') 'gmtset LABEL_FONT_SIZE 12' write(12,'(a)') 'gmtset LABEL_OFFSET 0.5c' write(12,'(a)') trim(adjustl(srangex)) write(12,'(a)') trim(adjustl(srangez)) write(12,'(a)') trim(adjustl(sscalex)) write(12,'(a)') trim(adjustl(sscalez)) write(12,'(a)') trim(adjustl(sbx)) write(12,'(a)') trim(adjustl(sbz)) write(12,'(a)') trim(adjustl(ssx)) write(12,'(a)') trim(adjustl(ssy)) write(12,'(a)') trim(adjustl(ssz)) write(12,'(a)') trim(adjustl(spsize)) write(12,'(a)') trim(adjustl(scsize)) write(12,'()') !Drawing of mesh write(12,'(a)') 'rem *** Drawing of mesh ***' write(12,'(a)') 'set fig=fig_gmt_mesh.eps' write(12,'(a)') 'psbasemap -R%rangex% -JX%scalex% -B%bax%:%strx%:/%bax%:%stry%:WS -P -K > %fig%' do ma=1,MATEL write (strw1,'(i2.2)') ma snum='set num='//trim(adjustl(strw1)) scol='set col='//col_mesh(ma) write(12,'(a)') trim(adjustl(snum)) write(12,'(a)') trim(adjustl(scol)) write(12,'(a)') 'psxy _mesh%num%.txt -R -J -W0.5/black -G%col% -K -O >> %fig%' end do if(0> %fig%' write(12,'(a)') 'pstext _text_ne.txt -R -J -N -K -O >> %fig%' write(12,'(a)') 'pstext _text_nd.txt -R -J -N -K -O >> %fig%' end if if(0> %fig%' if(0> %fig%' end if write(12,'(a)') 'echo 0 0 | psxy -R -J -Sp -O >> %fig%' write(12,'()') if(0 %fig%' write(12,'(a)') 'psxyz %inpf% -JX -JZ -R -W1 -E150/30 -M -K -O >> %fig%' write(12,'(a)') 'echo 0.90 0.90 14 0 0 TL %step% | pstext -R0/1/0/1 -JX -N -O >> %fig%' end do end if write(12,'()') write(12,'(a)') 'set fig=' write(12,'(a)') 'set step=' write(12,'(a)') 'set inpf=' write(12,'(a)') 'set rangex=' write(12,'(a)') 'set rangez=' write(12,'(a)') 'set scalex=' write(12,'(a)') 'set scalez=' write(12,'(a)') 'set bax=' write(12,'(a)') 'set baz=' write(12,'(a)') 'set strx=' write(12,'(a)') 'set stry=' write(12,'(a)') 'set strz=' write(12,'(a)') 'set psize=' write(12,'(a)') 'set csize=' write(12,'(a)') 'del .gmt*' close(12) end subroutine MAKE_BAT subroutine del_spaces(s) character (*), intent (inout) :: s character (len=len(s)) tmp integer i, j j = 1 do i = 1, len(s) if (s(i:i)==' ') cycle tmp(j:j) = s(i:i) j = j + 1 end do s = tmp(1:j-1) end subroutine del_spaces end program f90_GMTheat