subroutine save_gridded_lines_test_routine use uEMEP_definitions implicit none real :: x_grid(10,2),y_grid(10,2),x_line(50,2),y_line(50,2) real :: line(50,4),length_line(50) integer n_grid,n_line integer l,g real :: f(50) n_grid=2 x_grid(1,:)=(/-1,1/) y_grid(1,:)=(/-1,1/) x_grid(2,:)=(/1,3/) y_grid(2,:)=(/1,3/) line(1,:)=(/.5,.5,1.,2./)!x1,y1,x2,y2 line(2,:)=(/.5,0.,-2.,-0./)!x1,y1,x2,y2 line(3,:)=(/0.,-0.2,-0.,-2./)!x1,y1,x2,y2 line(4,:)=(/2.,3.,0.5,2./)!x1,y1,x2,y2 line(5,:)=(/-2.,-3.,1.5,1.5/)!x1,y1,x2,y2 line(6,:)=(/.7,-.9,.2,.7/)!x1,y1,x2,y2 line(7,:)=(/-1.,-3.,-1.,+1./)!x1,y1,x2,y2 line(8,:)=(/-.5,-1.,3.,-1./)!x1,y1,x2,y2 line(9,:)=(/-.5,1.,3.,1./)!x1,y1,x2,y2 line(10,:)=(/1.,-3.,1.,+0./)!x1,y1,x2,y2 line(11,:)=(/-.7,-3.,-.7,+2./)!x1,y1,x2,y2 line(12,:)=(/.5,1.5,1.5,.6/)!x1,y1,x2,y2 line(13,:)=(/-1.,1.,1.,-1./)!x1,y1,x2,y2 line(14,:)=(/-1.,-1.,1.,1./)!x1,y1,x2,y2 line(15,:)=(/-1.,1.,1.,1./)!x1,y1,x2,y2 line(16,:)=(/-1.5,.3,1.5,.3/)!x1,y1,x2,y2 line(17,:)=(/-3.,2.,1.5,-3./)!x1,y1,x2,y2 line(18,:)=(/-3.,-2.,1.,1./)!x1,y1,x2,y2 line(19,:)=(/+3.,-2.,-1.,1./)!x1,y1,x2,y2 line(20,:)=(/-3.,0.,1.,-1./)!x1,y1,x2,y2 n_line=20 write(*,*) 'input data' g=1 do l=1,n_line x_line(l,1)=line(l,1) x_line(l,2)=line(l,3) y_line(l,1)=line(l,2) y_line(l,2)=line(l,4) length_line(l)=sqrt((x_line(l,1)-x_line(l,2))**2+(y_line(l,1)-y_line(l,2))**2) !write(*,*) g,l,x_grid(g,:),y_grid(g,:),x_line(l,:),y_line(l,:),length_line(l) enddo write(*,*) 'starting gridding' do g=1,n_grid do l=1,n_line f(l)=line_fraction_in_grid_func(x_grid(g,:),y_grid(g,:),x_line(l,:),y_line(l,:)) write(*,*) g,l,f(l) enddo enddo stop end subroutine save_gridded_lines_test_routine