program f90_DOMAIN ! 後から領域定義したものが優先される ! 領域境界線上の点はその領域に含まれる.ただし後からの定義が優先される. ! 領域境界点は時計回り・反時計回りいずれも可.境界が閉じる1点前までの座標を入力する. implicit none integer,parameter::ntmax=10 integer,parameter::mdmax=100 integer::NELT,MATEL integer,allocatable::matno(:) real(8),allocatable::xg(:),yg(:) integer::nt(1:ntmax) real(8):: x_dom(1:ntmax,1:mdmax),y_dom(1:ntmax,1:mdmax) integer::i,j,ne character(len=50)::fnameR character(len=50)::dummy call getarg(1,fnameR) ! Input of Domain data open(11,file=fnameR,status='old') read(11,*) MATEL do i=1,MATEL read(11,*) nt(i) do j=1,nt(i) read(11,*) x_dom(i,j),y_dom(i,j) end do end do read(11,*) NELT allocate(matno(1:NELT)) allocate(xg(1:NELT),yg(1:NELT)) do ne=1,NELT read(11,*) xg(ne),yg(ne) end do close(11) ! Definition of Domain (material No.) call DEFDOM(NELT,MATEL,nt,x_dom,y_dom,xg,yg,matno,ntmax,mdmax) do i=1,MATEL dummy(1:50)='' write (dummy,'("_mat_",i2.2,".txt")') i open(12,file=dummy,status='replace') do ne=1,NELT if(matno(ne)==i)write(12,'(2(e15.7))') xg(ne),yg(ne) end do close(12) end do open(12,file='_mat_00.txt',status='replace') do ne=1,NELT if(matno(ne)==0)write(12,'(2(e15.7))') xg(ne),yg(ne) end do close(12) stop contains subroutine DEFDOM(NELT,MATEL,nt,x_dom,y_dom,xg,yg,matno,ntmax,mdmax) integer,intent(in)::NELT,MATEL,ntmax,mdmax integer,intent(in)::nt(1:ntmax) real(8),intent(in):: x_dom(1:ntmax,1:mdmax),y_dom(1:ntmax,1:mdmax) real(8),intent(in)::xg(1:NELT),yg(1:NELT) integer,intent(out)::matno(1:NELT) real(8)::theta,dx1,dy1,dx2,dy2,r1,r2,cs,sn integer::i,j,ne,j1,j2 real(8),parameter::pi=3.14159265358979323846D0 real(8),parameter::eps=1D-10 do ne=1,NELT matno(ne)=0 do i=1,MATEL theta=0.0D0 do j=1,nt(i) j1=j j2=j+1 if(j1==nt(i))j2=1 dx1=x_dom(i,j1)-xg(ne) dy1=y_dom(i,j1)-yg(ne) dx2=x_dom(i,j2)-xg(ne) dy2=y_dom(i,j2)-yg(ne) r1=sqrt(dx1*dx1+dy1*dy1) r2=sqrt(dx2*dx2+dy2*dy2) if(eps