Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
fleur
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
52
Issues
52
List
Boards
Labels
Service Desk
Milestones
Operations
Operations
Incidents
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
fleur
fleur
Commits
970b8d82
Commit
970b8d82
authored
Oct 24, 2016
by
Gregor Michalicek
1
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Rearranged commit
ee1d1e88
.
This looks a little bit nicer.
parent
ee1d1e88
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
51 additions
and
54 deletions
+51
-54
inpgen/crystal.f
inpgen/crystal.f
+40
-2
inpgen/spg_gen.f
inpgen/spg_gen.f
+11
-52
No files found.
inpgen/crystal.f
View file @
970b8d82
...
...
@@ -60,8 +60,8 @@
INTEGER
,
PARAMETER
::
neig12
=
12
!===> Local Variables
LOGICAL
lerr
,
err_setup
,
invsym
INTEGER
i
,
j
,
n
,
m
,
na
,
nt
,
mdet
,
mtr
,
nop0
,
fh
LOGICAL
lerr
,
err_setup
,
invsym
,
inversionOp
INTEGER
i
,
j
,
k
,
n
,
m
,
na
,
nt
,
mdet
,
mtr
,
nop0
,
fh
REAL
t
,
volume
,
eps7
,
eps12
INTEGER
optype
(
nop48
)
...
...
@@ -170,6 +170,44 @@
>
atomid
,
atompos
,
natin
,
nop48
,
neig12
,
<
ntype
,
nat
,
nops
,
mrot
,
tau
,
<
neq
,
ntyrep
,
zatom
,
natype
,
natrep
,
natmap
,
pos
)
! Check whether there is an inversion center that is not at the
! origin and if one is found shift the crystal such that the
! inversion is with respect to the origin. Then recalculate
! symmetry operations.
inversionOp
=
-1
symOpLoop
:
DO
k
=
1
,
nops
DO
i
=
1
,
3
DO
j
=
1
,
3
IF
(
i
.EQ.
j
)
THEN
IF
(
mrot
(
i
,
j
,
k
)
.NE.
-1
)
CYCLE
symOpLoop
ELSE
IF
(
mrot
(
i
,
j
,
k
)
.NE.
0
)
CYCLE
symOpLoop
END
IF
IF
((
i
.EQ.
3
)
.AND.
(
j
.EQ.
3
))
THEN
inversionOp
=
k
EXIT
symOpLoop
END
IF
END
DO
END
DO
END
DO
symOpLoop
IF
(
inversionOp
.GT.
0
)
THEN
IF
(
ANY
(
ABS
(
tau
(:,
inversionOp
))
.GT.
eps7
))
THEN
WRITE
(
*
,
*
)
'Found inversion center at finite position.'
WRITE
(
*
,
*
)
'Shifting crystal by:'
WRITE
(
*
,
'(3f15.10)'
)
0.5
*
tau
(:,
inversionOp
)
WRITE
(
*
,
*
)
''
DO
k
=
1
,
ABS
(
natin
)
atompos
(:,
k
)
=
atompos
(:,
k
)
+
0.5
*
tau
(:,
inversionOp
)
END
DO
DEALLOCATE
(
neq
,
ntyrep
,
zatom
,
mrot
,
tau
)
CALL
spg_gen
(
>
dispfh
,
outfh
,
errfh
,
dispfn
,
>
.FALSE.
,
symor
,
as
,
bs
,
scale
,
>
atomid
,
atompos
,
natin
,
nop48
,
neig12
,
<
ntype
,
nat
,
nops
,
mrot
,
tau
,
<
neq
,
ntyrep
,
zatom
,
natype
,
natrep
,
natmap
,
pos
)
END
IF
END
IF
ENDIF
WHERE
(
abs
(
tau
)
<
eps7
)
tau
=
0.00
...
...
inpgen/spg_gen.f
View file @
970b8d82
...
...
@@ -43,7 +43,7 @@
INTEGER
index_op
(
nop48
),
num_tr
(
nop48
)
INTEGER
mtmp
(
3
,
3
),
mp
(
3
,
3
)
INTEGER
u
,
v
,
w
,
inversionOp
INTEGER
u
,
v
,
w
INTEGER
i
,
j
,
k
,
n
,
mop
,
nc
,
new
,
ns
,
nt
,
ntypm
,
ind
(
1
),
iTr
,
maxTrVecs
INTEGER
ity
(
natin
),
npaint
,
ipaint
(
natin
)
INTEGER
ios
,
istep0
,
binSize
,
maxBinSize
...
...
@@ -70,22 +70,6 @@
>
as
,
bs
,
scale
,
nop48
,
neig12
,
<
mops
,
mmrot
)
!---> read in atomic positions and shift to (-1/2,1/2] in lattice
!---> coords. also read in identification (atomic) number (atomid)
!---> to distinguish different atom types (need not be atomic number)
DO
n
=
1
,
natin
IF
(
cartesian
)
THEN
! convert to lattice coords. if necessary
atompos
(:,
n
)
=
matmul
(
bs
,
atompos
(:,
n
)
)
ENDIF
END
DO
200
CONTINUE
!The routine jumps back to this point with shifted atom positions
!an inversion center is found that is not the origin
DO
n
=
1
,
natin
pos
(:,
n
)
=
atompos
(:,
n
)
-
anint
(
atompos
(:,
n
)
-
eps7
)
END
DO
ALLOCATE
(
mtable
(
mops
,
mops
)
)
CALL
close_pt
(
! check closure and get
>
mops
,
mmrot
,
! multiplication table
...
...
@@ -99,6 +83,16 @@
ENDDO
ENDDO
!---> read in atomic positions and shift to (-1/2,1/2] in lattice
!---> coords. also read in identification (atomic) number (atomid)
!---> to distinguish different atom types (need not be atomic number)
DO
n
=
1
,
natin
IF
(
cartesian
)
THEN
! convert to lattice coords. if necessary
atompos
(:,
n
)
=
matmul
(
bs
,
atompos
(:,
n
)
)
ENDIF
pos
(:,
n
)
=
atompos
(:,
n
)
-
anint
(
atompos
(:,
n
)
-
eps7
)
ENDDO
!---> store the positions (in lattice coord.s) given in the input file
! ALLOCATE ( inipos(3,natin) )
! DO n=1,natin
...
...
@@ -514,8 +508,6 @@
! if( nopd < nops )then
! nopd = nops
! endif
IF
(
ALLOCATED
(
mrot
))
DEALLOCATE
(
mrot
)
IF
(
ALLOCATED
(
tau
))
DEALLOCATE
(
tau
)
ALLOCATE
(
mrot
(
3
,
3
,
nops
),
tau
(
3
,
nops
)
)
DO
n
=
1
,
nops
...
...
@@ -572,42 +564,9 @@
ENDDO
ENDDO
! Check whether there is an inversion center that is not the origin
! and shift the crystal if there is one. Then calculate symmetries again.
inversionOp
=
-1
symOpLoop
:
DO
k
=
1
,
nops
DO
i
=
1
,
3
DO
j
=
1
,
3
IF
(
i
.EQ.
j
)
THEN
IF
(
mrot
(
i
,
j
,
k
)
.NE.
-1
)
CYCLE
symOpLoop
ELSE
IF
(
mrot
(
i
,
j
,
k
)
.NE.
0
)
CYCLE
symOpLoop
END
IF
IF
((
i
.EQ.
3
)
.AND.
(
j
.EQ.
3
))
THEN
inversionOp
=
k
EXIT
symOpLoop
END
IF
END
DO
END
DO
END
DO
symOpLoop
IF
(
inversionOp
.GT.
0
)
THEN
IF
(
ANY
(
ABS
(
tau
(:,
inversionOp
))
.GT.
eps7
))
THEN
WRITE
(
*
,
*
)
'Found inversion center at finite position.'
WRITE
(
*
,
*
)
'Shifting crystal by:'
WRITE
(
*
,
'(3f15.10)'
)
0.5
*
tau
(:,
inversionOp
)
WRITE
(
*
,
*
)
''
DO
k
=
1
,
ABS
(
natin
)
atompos
(:,
k
)
=
atompos
(:,
k
)
+
0.5
*
tau
(:,
inversionOp
)
END
DO
GO TO
200
END
IF
END
IF
! if( ntypd < ntype )then
! ntypd = ntype
! endif
ALLOCATE
(
neq
(
ntype
),
ntyrep
(
ntype
),
zatom
(
ntype
)
)
neq
(
1
:
ntype
)
=
0
...
...
Jens Bröder
@broeder
mentioned in issue
#58 (closed)
·
Oct 28, 2016
mentioned in issue
#58 (closed)
mentioned in issue #58
Toggle commit list
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment