-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathgenlattice1.f90
131 lines (118 loc) · 3.24 KB
/
genlattice1.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
module param
integer, parameter :: row = 7, crow = 7
integer, parameter :: sca = row*crow
integer, parameter :: deg = 3
end module
!include "networklibstandard.f90"
include "libdf1.f90"
program main
use param
use biolibs_fixedscale
implicit none
integer :: thenet(sca, deg)
integer :: i, j, k
real :: x0, y0, x1, y1, nl, ny, zz, nx, m, ab, fab
open (unit=19, file='latpos')
thenet = 0
do i = 0, row - 1
do j = 2, crow
call pedge(thenet, sca, deg, i*crow + j, i*crow + j - 1) !:行内连接
end do
!call pedge(thenet,sca,deg,i*crow+1,i*crow+crow)
end do
do i = 1, row - 1
do j = 1, crow
if ((i)*crow + j <= sca) then
if (mod(i, 2) == 1 .and. mod(j, 2) == 1) then
call pedge(thenet, sca, deg, i*crow + j, (i - 1)*crow + j)
end if
if (mod(i, 2) == 0 .and. mod(j, 2) == 0) then
call pedge(thenet, sca, deg, i*crow + j, (i - 1)*crow + j)
end if
end if
end do
end do
!call deledge(thenet,sca,deg,sca,sca-1)
!all deledge(thenet,sca,deg,1,2)
!call disorderzbound(thenet,row,crow,2,0.1)
open (unit=11, file='latticeb')
open (unit=13, file='latview1.csv')
!write the crystal lattice
do i = 1, sca
!~ do j = 1, deg
write (11, *) i,(thenet(i, j),j=1,deg) !(thenet(i,j),',',j=1,deg)
!~ end do
end do
do i = 1, sca
call coordi(i, crow, row, x0, y0, fab)
do j = 1, deg
if (thenet(i, j) /= 0) then
call coordi(thenet(i, j), crow, row, x1, y1, fab)
write (13, *) x0, ',', y0, ',', x1, ',', y1
end if
end do
end do
do i = 1, sca
m = 0
do j = 1, deg
if (thenet(i, j) /= 0) m = 1
end do
if (m /= 0) call coordi(i, crow, row, x0, y0, ab)
write (19, *) x0, y0, ab
end do
end program main
subroutine disorderzbound(thenet, row, crow, zl, ds)
use biolibs_fixedscale
implicit none
integer :: thenet(row*crow, 3)
integer :: row, crow, zl, i, j, k
real :: ds, s
call sr1and()
do i = 0, zl - 1
do j = 1, crow
call radm(s)
if (s <= ds) then
call remove(thenet, row, crow, i*crow + j)
write (*, *) i*crow + j
end if
end do
end do
do i = row - zl, row - 1
do j = 1, crow
call radm(s)
if (s <= ds) then
call remove(thenet, row, crow, i*crow + j)
write (*, *) i*crow + j
end if
end do
end do
end subroutine disorderzbound
subroutine remove(thenet, row, crow, n)
use biolibs_fixedscale
implicit none
integer :: thenet(row*crow, 3)
integer :: row, crow, n1, n2, i, j, maxdeg, n
maxdeg = 3
n1 = n
do i = 1, 3
n2 = thenet(n, i)
if (n2 /= 0) then
call deledge(thenet, row*crow, maxdeg, n1, n2)
end if
end do
end subroutine remove
subroutine coordi(i, crow, row, x, y, ab)
implicit none
integer :: i, crow, row, nx, ny
real :: x, y, ab
nx = i/crow
ny = mod(i, crow)
if (ny == 0) then
nx = nx - 1
ny = crow
end if
x = 1.732*ny/2
y = 1.5*(nx) + (-1)**(nx + ny + 1)*0.25
if (mod(nx, 2) == mod(ny, 2)) ab = 0
if (mod(nx, 2) /= mod(ny, 2)) ab = 1
end subroutine coordi