1
2! Copyright (C) 2015 J. K. Dewhurst, S. Sharma and E. K. U. Gross.
3! This file is distributed under the terms of the GNU General Public License.
4! See the file COPYING for license details.
5
6pure subroutine plotpt3d(vpl)
7use modmain
8implicit none
9! arguments
10real(8), intent(out) :: vpl(3,np3d(1)*np3d(2)*np3d(3))
11! local variables
12integer ip,i1,i2,i3
13real(8) v1(3),v2(3),v3(3)
14real(8) t1,t2,t3
15! generate 3D grid from corner vectors
16v1(:)=vclp3d(:,1)-vclp3d(:,0)
17v2(:)=vclp3d(:,2)-vclp3d(:,0)
18v3(:)=vclp3d(:,3)-vclp3d(:,0)
19ip=0
20do i3=0,np3d(3)-1
21  t3=dble(i3)/dble(np3d(3))
22  do i2=0,np3d(2)-1
23    t2=dble(i2)/dble(np3d(2))
24    do i1=0,np3d(1)-1
25      t1=dble(i1)/dble(np3d(1))
26      ip=ip+1
27      vpl(:,ip)=t1*v1(:)+t2*v2(:)+t3*v3(:)+vclp3d(:,0)
28    end do
29  end do
30end do
31end subroutine
32
33