Alex
5 years ago
parent
624886bbe9
commit
8217e8b51c
@ -1,96 +1,94 @@
|
||||
# CAC_Model_Builder
|
||||
This is a tool for building models in CAC. Commands and usage options are below.
|
||||
This is a tool for building models in CAC. Commands and usage options are below. This code is intended to follow the atomsk code fairly closely.
|
||||
|
||||
## Modes
|
||||
|
||||
The modes follow similarly to the modes you find when using atomsk. The modes will be listed below alongside their syntax and other usage instructions. As a note, if a mode is being used then it has to come first.
|
||||
|
||||
## Flow of commands
|
||||
### Mode Create
|
||||
|
||||
```flow
|
||||
op1=>operation: Define atom types and lattices to be used
|
||||
op2=>operation: Define regions and build
|
||||
op3=>operation: Define modifiers
|
||||
op4=>operation: Output data files
|
||||
op1->op2->op3->op4
|
||||
```
|
||||
cacmb --create name element_type lattice_parameter esize
|
||||
```
|
||||
|
||||
Mode create has the following parameters:
|
||||
|
||||
`name` - User defined name that either defines the atom type or the lattice type if using the basis option
|
||||
|
||||
## Command syntax
|
||||
`element_type` - Specifies which element type to use, this dictates the crystal being build. Current acceptable options for element_type are:
|
||||
|
||||
### Atom types command
|
||||
* FCC - Uses the Rhombohedral primitive fcc unit cell as the finite element.
|
||||
|
||||
```
|
||||
atom_types num_atoms {name mass}
|
||||
```
|
||||
|
||||
The parameters for the atoms command are:
|
||||
|
||||
`num_atoms` - number of atom types defined for this model building session
|
||||
`lattice_parameter` - The lattice parameter for the crystal structure.
|
||||
|
||||
`{}` - indicate that the contents must be repeated `num_atoms` times.
|
||||
`esize` - Number of atoms per edge of the finite element. A value of 2 signifies full atomistic resolution and is the lowest number acceptable.
|
||||
|
||||
`name` - Elemental name of atom
|
||||
|
||||
`mass` - mass of the atom
|
||||
|
||||
This command should only be called once, defining all atoms in one go. The atom types will then be defined in numeric order with the first atom defined being type one and the last one being type `num_atoms`.
|
||||
|
||||
### Lattice command
|
||||
**Example**
|
||||
|
||||
```
|
||||
lattice id lattice_type lattice_parameter [type atom_type] [basis num_basis_atoms {type posx posy posz}]
|
||||
cacmb --create Cu fcc 3.615 11
|
||||
```
|
||||
|
||||
The parameters for the lattice command are:
|
||||
|
||||
`id` - User defined id for this lattice type
|
||||
Creates a copper element with a lattice parameter of 3.615 with 11 atoms per side
|
||||
|
||||
`lattice_type` - One of predefined lattice types which specifies the element type used. Current accepted options are: `FCC`
|
||||
#### Optional keywords
|
||||
|
||||
`type` - Optional keyword which defines the atom type used for the lattice. This is used in place of basis if atoms are at lattice positions in these elements.
|
||||
**Orient**
|
||||
|
||||
`atom_type` - The atom type which corresponds to the atoms at the lattice positions of the current element
|
||||
``` orient [hkl] [hkl] [hkl]
|
||||
orient [hkl] [hkl] [hkl]
|
||||
```
|
||||
|
||||
`basis` - Optional keyword which is used in order to define the basis atoms instead of using the default definition. If basis is not included the following commands also are not included.
|
||||
Default orientation is `[100] [010] [001]`. If this keyword is present then the user must provide the orientation matrix in form `[hkl] [hkl] [hkl]`.
|
||||
|
||||
`num_basis_atoms` are the number of basis atoms in this element.
|
||||
*Example:* `orient [-112] [110] [-11-1]`
|
||||
|
||||
`{}` - indicate that the contents must be repeated `num_basis_atoms` times.
|
||||
**Basis**
|
||||
|
||||
`type` - the atom type of the atom.
|
||||
```
|
||||
basis num atom_name x y z
|
||||
```
|
||||
|
||||
`posx posy posz` - The position of the basis atom relative to the lattice point at (0,0,0)
|
||||
Default basis has `atom_name = name` with position (0,0,0). If used then the `atom_name x y z` must be include `num` times.
|
||||
|
||||
**Either type or basis keywords must be present in the lattice command, both cannot be used.**
|
||||
*Example:* `basis 2 Mg 0 0 0 Mg 0.5 0.288675 0.81647`
|
||||
|
||||
## Region Command
|
||||
**Duplicate**
|
||||
|
||||
```
|
||||
region id lattice_id element_size units lenx leny lenz [zigzag] [origin x y z] [cat region_id dim [nomatch]] [orient [hkl] [hkl] [hkl]]
|
||||
duplicate numx numy numz
|
||||
```
|
||||
|
||||
`id` - User defined id for this region
|
||||
Default duplicate is `1 1 1`. This is used to replicate the element along each dimensions. This cannot be used if the keyword dimensions is included. By default jagged edges along boundaries are filled if duplicate is greater than `1 1 1`.
|
||||
|
||||
`lattice_id` - The lattice type for this region
|
||||
*Example:* `duplicate 10 10 10`
|
||||
|
||||
`element_size` - The element size used for this region defined as the number of atoms per element edge. An element size of 2 means that this region is at full atomistic resolution.
|
||||
**Dimensions**
|
||||
|
||||
```
|
||||
dimensions dimx dimy dimz
|
||||
```
|
||||
|
||||
`units` - Either `lattice` or `box` which adjusts how the length values are calculated. Units `lattice` means the region will consist of `len` number of elements for every dim. Units `box` are defined in angstroms.
|
||||
There is no default dimensions as duplicate is the default option. This command assigns a box with user-assigned dimensions and fills it with the desired element. By default atoms fill in the jagged edges at the boundaries if the dimensions command is included.
|
||||
|
||||
`lenx leny lenz` - The lengths of the box in each dimension in the user defined units
|
||||
Example: `dimensions 100 100 100`
|
||||
|
||||
`zigzag` - Optional keyword which specifies if regions built with elements should have filled in boundaries (using atoms). If zigzag isn't present then the regions are built with filled in boundaries by default
|
||||
**ZigZag**
|
||||
|
||||
`origin x y z` - Optional keyword which specifies the origin of the current region in angstroms. The region boundaries are then (x, x+lenx), (y, y+leny), (z,z+lenz).
|
||||
```
|
||||
zigzag boolx booly boolz
|
||||
```
|
||||
|
||||
`cat region_id outregionid dim [nomatch] ` - Optional keyword which stacks the current region on the face of another region defined by `dim`. `region_id` is the id of the region which is already build. `outregionid` is the user defined id of the combined stacked region which can be used with further merge commands. Default behavior is to expand the smallest region to match the larger one, using the optional keyword `nomatch` preserves the original regions and does not attempt to match the boundaries.
|
||||
Default zigzag is `f f f`. This command specifies whether a boundary should be left jagged (i.e. in essence not filled in). If `boolx` is `t` than the x dimension is left jagged and if it is `f` then the x dimension is filled.
|
||||
|
||||
`orient [hkl] [hkl] [hkl]` simply orients the unit cell of this region. This defaults to [100] [010] [001]
|
||||
*Example:* `zigzag t f t` gives a box with jagged edges in the x and z and filled edges in the y.
|
||||
|
||||
### Write command
|
||||
**Origin**
|
||||
|
||||
```
|
||||
write file_name
|
||||
origin x y z
|
||||
```
|
||||
|
||||
Self explanatory.
|
||||
Default origin is `0 0 0`. This command just sets the origin for where the simulation cell starts building.
|
||||
|
||||
*Example:* `origin 10 0 1`
|
||||
@ -1,7 +0,0 @@
|
||||
#This is an example input script for the CAC model builder
|
||||
|
||||
atom_types 1 Cu 63.546
|
||||
lattice 1 fcc 3.615 type 1
|
||||
|
||||
#region 1 1 2 lattice 20 20 20
|
||||
#write atoms.xyz
|
||||
@ -1,18 +1,34 @@
|
||||
CC=ifort
|
||||
FC=ifort
|
||||
FFLAGS=-c -mcmodel=large -debug -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone
|
||||
|
||||
OBJECTS= main.o elements.o lattice.o subroutines.o precision_comm_module.o
|
||||
#FFLAGS=-c -mcmodel=large -debug -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone
|
||||
FFLAGS=-c -mcmodel=large -Ofast
|
||||
MODES=mode_create.o
|
||||
OBJECTS=main.o elements.o io.o subroutines.o functions.o atoms.o call_mode.o build_subroutines.o $(MODES)
|
||||
|
||||
.SUFFIXES:
|
||||
.SUFFIXES: .c .f .f90 .F90 .o
|
||||
|
||||
builder: $(OBJECTS)
|
||||
cacmb: $(OBJECTS)
|
||||
$(FC) $(OBJECTS) -o $@
|
||||
|
||||
.f90.o:
|
||||
$(FC) $(FFLAGS) $<
|
||||
|
||||
main.o lattice.o elements.o region.o subroutines.o : precision_comm_module.o
|
||||
lattice.o : subroutines.o
|
||||
main.o : elements.o lattice.o region.o
|
||||
.PHONY: clean
|
||||
clean:
|
||||
$(RM) cacmb *.o
|
||||
|
||||
testfuncs: testfuncs.o functions.o subroutines.o
|
||||
$(FC) testfuncs.o functions.o build_subroutines.o subroutines.o elements.o -o $@
|
||||
|
||||
.PHONY: cleantest
|
||||
cleantest:
|
||||
$(RM) testfuncs testfuncs.o
|
||||
|
||||
$(OBJECTS) : parameters.o
|
||||
atoms.o subroutines.o testfuncs.o : functions.o
|
||||
main.o io.o build_subroutines.o: elements.o
|
||||
call_mode.o : $(MODES)
|
||||
$(MODES) io.o: atoms.o
|
||||
$(MODES) main.o : io.o
|
||||
testfuncs.o elements.o mode_create.o: subroutines.o
|
||||
testfuncs.o : build_subroutines.o
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,24 @@
|
||||
subroutine call_mode(arg_num,mode)
|
||||
!This code is used to parse the command line argument for the mode information and calls the required
|
||||
!mode module.
|
||||
|
||||
use mode_create
|
||||
use parameters
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: arg_num
|
||||
character(len=100), intent(in) :: mode
|
||||
|
||||
select case(mode)
|
||||
case('--create')
|
||||
call create(arg_num)
|
||||
|
||||
case default
|
||||
print *, "Mode ", mode, " currently not accepted. Please check documentation for ", &
|
||||
"accepted modes and rerun."
|
||||
|
||||
stop 3
|
||||
|
||||
end select
|
||||
end subroutine call_mode
|
||||
@ -1,32 +1,187 @@
|
||||
module elements
|
||||
|
||||
!This module contains the elements data structures, structures needed for building regions
|
||||
!and operations that are done on elements
|
||||
use parameters
|
||||
use subroutines
|
||||
implicit none
|
||||
|
||||
use precision_comm_module
|
||||
!Data structures used to represent the CAC elements. Each index represents an element
|
||||
integer,allocatable :: tag_ele(:) !Element tag (used to keep track of id's
|
||||
character(len=100), allocatable :: type_ele(:) !Element type
|
||||
integer, allocatable :: size_ele(:), lat_ele(:) !Element siz
|
||||
real(kind=dp), allocatable :: r_node(:,:,:,:) !Nodal position array
|
||||
|
||||
implicit none
|
||||
integer :: ele_num=0 !Number of elements
|
||||
|
||||
!Data structure used to represent atoms
|
||||
integer, allocatable :: tag_atom(:) !atom id
|
||||
character(len=100), allocatable:: type_atom(:) !atom type
|
||||
real(kind =dp),allocatable :: r_atom(:,:) !atom position
|
||||
integer :: atom_num=0 !Number of atoms
|
||||
|
||||
!Variables for creating elements based on primitive cells
|
||||
real(kind=dp) :: cubic_cell(3,8), fcc_cell(3,8), fcc_mat(3,3), fcc_inv(3,3)
|
||||
integer :: cubic_faces(4,6)
|
||||
|
||||
!Below are lattice type arrays which provide information on the general form of the elements.
|
||||
!We currently have a limit of 10 lattice types for simplicities sake but this can be easily increased.
|
||||
|
||||
integer :: max_ng_node, ng_node(10) !Max number of nodes per element and number of nodes per element for each lattice type
|
||||
|
||||
!These variables contain information on the basis, for simplicities sake we limit
|
||||
!the user to the definition of 10 lattice types with 10 basis atoms at each lattice point.
|
||||
!This can be easily increased with no change to efficiency
|
||||
integer :: max_basisnum, basisnum(10)!Max basis atom number, number of basis atoms in each lattice type
|
||||
character(len=2) :: basis_type(10,10) !Atom type of each basis
|
||||
real(kind=dp) :: basis_pos(3,10,10) !Basis atom positions
|
||||
|
||||
!Simulation cell parameters
|
||||
real(kind=dp) :: box_bd(6)
|
||||
|
||||
|
||||
public
|
||||
contains
|
||||
|
||||
subroutine lattice_init
|
||||
!This subroutine just intializes variables needed for building the different finite
|
||||
!element types
|
||||
|
||||
!First initialize the cubic cell
|
||||
cubic_cell = reshape((/ 0.0_dp, 0.0_dp, 0.0_dp, &
|
||||
1.0_dp, 0.0_dp, 0.0_dp, &
|
||||
1.0_dp, 1.0_dp, 0.0_dp, &
|
||||
0.0_dp, 1.0_dp, 0.0_dp, &
|
||||
0.0_dp, 0.0_dp, 1.0_dp, &
|
||||
1.0_dp, 0.0_dp, 1.0_dp, &
|
||||
1.0_dp, 1.0_dp, 1.0_dp, &
|
||||
0.0_dp, 1.0_dp, 1.0_dp /), &
|
||||
shape(fcc_cell))
|
||||
|
||||
!Now we create a list containing the list of vertices needed to describe the 6 cube faces
|
||||
cubic_faces(:,1) = (/ 1, 4, 8, 5 /)
|
||||
cubic_faces(:,2) = (/ 2, 3, 7, 6 /)
|
||||
cubic_faces(:,3) = (/ 1, 2, 6, 5 /)
|
||||
cubic_faces(:,4) = (/ 3, 4, 8, 7 /)
|
||||
cubic_faces(:,5) = (/ 1, 2, 3, 4 /)
|
||||
cubic_faces(:,6) = (/ 5, 6, 7, 8 /)
|
||||
|
||||
!!Now initialize the fcc primitive cell
|
||||
fcc_cell = reshape((/ 0.0_dp, 0.0_dp, 0.0_dp, &
|
||||
0.5_dp, 0.5_dp, 0.0_dp, &
|
||||
0.5_dp, 1.0_dp, 0.5_dp, &
|
||||
0.0_dp, 0.5_dp, 0.5_dp, &
|
||||
0.5_dp, 0.0_dp, 0.5_dp, &
|
||||
1.0_dp, 0.5_dp, 0.5_dp, &
|
||||
1.0_dp, 1.0_dp, 1.0_dp, &
|
||||
0.5_dp, 0.5_dp, 1.0_dp /), &
|
||||
shape(fcc_cell))
|
||||
|
||||
fcc_mat = reshape((/ 0.5_dp, 0.5_dp, 0.0_dp, &
|
||||
0.0_dp, 0.5_dp, 0.5_dp, &
|
||||
0.5_dp, 0.0_dp, 0.5_dp /), &
|
||||
shape(fcc_mat))
|
||||
call matrix_inverse(fcc_mat,3,fcc_inv)
|
||||
|
||||
max_basisnum = 0
|
||||
basisnum(:) = 0
|
||||
basis_pos(:,:,:) = 0.0_dp
|
||||
ng_node(:) = 0
|
||||
end subroutine lattice_init
|
||||
|
||||
subroutine cell_init(lapa,esize,ele_type, orient_mat, cell_mat)
|
||||
!This subroutine uses the user provided information to transform the finite element cell to the correct
|
||||
!size, orientation, and dimensions using the esize, lattice parameter, element_type, and orientation provided
|
||||
!by the user
|
||||
|
||||
integer, intent(in) :: esize
|
||||
real(kind=dp), intent(in) :: lapa, orient_mat(3,3)
|
||||
character(len=100), intent(in) :: ele_type
|
||||
|
||||
real(kind=dp), dimension(3,max_ng_node), intent(out) :: cell_mat
|
||||
|
||||
select case(trim(ele_type))
|
||||
|
||||
case('fcc')
|
||||
cell_mat(:,1:8) = lapa * ((esize-1)*matmul(orient_mat, fcc_cell))
|
||||
case default
|
||||
print *, "Element type ", trim(ele_type), " currently not accepted"
|
||||
stop
|
||||
end select
|
||||
|
||||
end subroutine cell_init
|
||||
|
||||
subroutine alloc_ele_arrays(n,m)
|
||||
!This subroutine used to provide initial allocation for the atom and element arrays
|
||||
|
||||
integer, intent(in) :: n, m !n-size of element arrays, m-size of atom arrays
|
||||
|
||||
integer :: allostat
|
||||
|
||||
!Allocate element arrays
|
||||
if(n > 0) then
|
||||
allocate(tag_ele(n), type_ele(n), size_ele(n), lat_ele(n), r_node(3,max_basisnum, max_ng_node,n), &
|
||||
stat=allostat)
|
||||
if(allostat > 0) then
|
||||
print *, "Error allocating element arrays in elements.f90 because of: ", allostat
|
||||
stop
|
||||
end if
|
||||
end if
|
||||
|
||||
if(m > 0) then
|
||||
!Allocate atom arrays
|
||||
allocate(tag_atom(m), type_atom(m), r_atom(3,m), stat=allostat)
|
||||
if(allostat > 0) then
|
||||
print *, "Error allocating atom arrays in elements.f90 because of: ", allostat
|
||||
stop
|
||||
end if
|
||||
end if
|
||||
end subroutine
|
||||
|
||||
subroutine add_element(type, size, lat, r)
|
||||
!Subroutine which adds an element to the element arrays
|
||||
integer, intent(in) :: size, lat
|
||||
character(len=100), intent(in) :: type
|
||||
real(kind=dp), intent(in) :: r(3, max_basisnum, max_ng_node)
|
||||
|
||||
ele_num = ele_num + 1
|
||||
tag_ele(ele_num) = ele_num
|
||||
type_ele(ele_num) = type
|
||||
size_ele(ele_num) = size
|
||||
lat_ele(ele_num) = lat
|
||||
r_node(:,:,:,ele_num) = r(:,:,:)
|
||||
|
||||
|
||||
end subroutine add_element
|
||||
|
||||
subroutine add_atom(type, r)
|
||||
!Subroutine which adds an atom to the atom arrays
|
||||
character(len=2), intent(in) :: type
|
||||
real(kind=dp), intent(in), dimension(3) :: r
|
||||
|
||||
!This is the data structure which is used to represent the CAC elements
|
||||
type element
|
||||
integer :: tag = 0 !Element tag (used to keep track of id's
|
||||
integer :: type = 0 !Lattice type of the element
|
||||
integer :: size = 0 !Element size
|
||||
!Nodal position array below only works for wedge or fcc elements
|
||||
real(kind=wp) :: r_node(3,8)
|
||||
end type
|
||||
atom_num = atom_num+1
|
||||
tag_atom(atom_num) = atom_num
|
||||
type_atom(atom_num) = type
|
||||
r_atom(:,atom_num) = r(:)
|
||||
|
||||
!Finite element array
|
||||
type(element), allocatable :: element_array(:)
|
||||
end subroutine add_atom
|
||||
|
||||
integer :: ele_num
|
||||
subroutine def_ng_node(n, element_types)
|
||||
!This subroutine defines the maximum node number among n element types
|
||||
integer, intent(in) :: n !Number of element types
|
||||
character(len=100), dimension(n) :: element_types !Array of element type strings
|
||||
|
||||
!Data structure used to represent atoms
|
||||
type atom
|
||||
integer :: tag = 0
|
||||
integer :: type = 0
|
||||
real(kind =wp) :: r
|
||||
end type
|
||||
integer :: i
|
||||
|
||||
type(atom), allocatable :: atoms(:)
|
||||
max_ng_node = 0
|
||||
|
||||
integer :: atom_num
|
||||
do i=1, n
|
||||
select case(trim(adjustl(element_types(i))))
|
||||
case('fcc')
|
||||
ng_node(i) = 8
|
||||
end select
|
||||
|
||||
if(ng_node(i) > max_ng_node) max_ng_node = ng_node(i)
|
||||
end do
|
||||
end subroutine def_ng_node
|
||||
end module elements
|
||||
@ -0,0 +1,235 @@
|
||||
module functions
|
||||
|
||||
use parameters
|
||||
|
||||
implicit none
|
||||
|
||||
public
|
||||
contains
|
||||
|
||||
|
||||
! Functions below this comment are taken from the functions module of atomsk
|
||||
!********************************************************
|
||||
! STRUPCASE
|
||||
! This function reads a string of any length
|
||||
! and capitalizes all letters.
|
||||
!********************************************************
|
||||
FUNCTION StrUpCase (input_string) RESULT (UC_string)
|
||||
!
|
||||
IMPLICIT NONE
|
||||
CHARACTER(*),PARAMETER:: lower_case = 'abcdefghijklmnopqrstuvwxyz'
|
||||
CHARACTER(*),PARAMETER:: upper_case = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
|
||||
CHARACTER(*),INTENT(IN):: input_string
|
||||
CHARACTER(LEN(Input_String)):: UC_string !Upper-Case string that is produced
|
||||
INTEGER:: i, n
|
||||
!
|
||||
IF(LEN(input_string)==0) RETURN
|
||||
UC_string = input_string
|
||||
! Loop over string elements
|
||||
DO i=1,LEN(UC_string)
|
||||
!Find location of letter in lower case constant string
|
||||
n = INDEX( lower_case, UC_string(i:i) )
|
||||
!If current substring is a lower case letter, make it upper case
|
||||
IF(n>0) THEN
|
||||
UC_string(i:i) = upper_case(n:n)
|
||||
ENDIF
|
||||
END DO
|
||||
!
|
||||
END FUNCTION StrUpCase
|
||||
|
||||
!********************************************************
|
||||
! STRDNCASE
|
||||
! This function reads a string of any length
|
||||
! and transforms all letters to lower case.
|
||||
!********************************************************
|
||||
FUNCTION StrDnCase (input_string) RESULT (lc_string)
|
||||
!
|
||||
IMPLICIT NONE
|
||||
CHARACTER(*),PARAMETER:: lower_case = 'abcdefghijklmnopqrstuvwxyz'
|
||||
CHARACTER(*),PARAMETER:: upper_case = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
|
||||
CHARACTER(*),INTENT(IN):: input_string
|
||||
CHARACTER(LEN(Input_String)):: lc_string !Lower-Case string that is produced
|
||||
INTEGER:: i, n
|
||||
!
|
||||
IF(LEN(input_string)==0) RETURN
|
||||
lc_string = input_string
|
||||
! Loop over string elements
|
||||
DO i=1,LEN(lc_string)
|
||||
!Find location of letter in upper case constant string
|
||||
n = INDEX( upper_case, lc_string(i:i) )
|
||||
!If current substring is an upper case letter, make it lower case
|
||||
IF(n>0) THEN
|
||||
lc_string(i:i) = lower_case(n:n)
|
||||
ENDIF
|
||||
END DO
|
||||
!
|
||||
END FUNCTION StrDnCase
|
||||
|
||||
pure function matrix_normal(a, n)
|
||||
|
||||
integer :: i
|
||||
integer, intent(in) :: n
|
||||
real(kind = dp), dimension(n) :: v
|
||||
real(kind = dp), dimension(n, n),intent(in) :: a
|
||||
real(kind = dp), dimension(n,n) :: matrix_normal
|
||||
|
||||
matrix_normal(:, :) = a(:, :)
|
||||
|
||||
do i = 1, n
|
||||
|
||||
v(:) = a(i,:)
|
||||
|
||||
matrix_normal(i, :) = v(:) / norm2(v)
|
||||
|
||||
end do
|
||||
|
||||
return
|
||||
end function matrix_normal
|
||||
|
||||
pure function cross_product(a, b)
|
||||
!Function which finds the cross product of two vectors
|
||||
|
||||
real(kind = dp), dimension(3), intent(in) :: a, b
|
||||
real(kind = dp), dimension(3) :: cross_product
|
||||
|
||||
cross_product(1) = a(2) * b(3) - a(3) * b(2)
|
||||
cross_product(2) = a(3) * b(1) - a(1) * b(3)
|
||||
cross_product(3) = a(1) * b(2) - a(2) * b(1)
|
||||
|
||||
return
|
||||
end function cross_product
|
||||
|
||||
pure function identity_mat(n)
|
||||
!Returns the nxn identity matrix
|
||||
|
||||
integer :: i
|
||||
integer, intent(in) :: n
|
||||
real(kind = dp), dimension(n, n) :: identity_mat
|
||||
|
||||
identity_mat(:, :) = 0.0_dp
|
||||
do i = 1, n
|
||||
identity_mat(i, i) = 1.0_dp
|
||||
end do
|
||||
|
||||
return
|
||||
end function identity_mat
|
||||
|
||||
pure function triple_product(a, b, c)
|
||||
!triple product between three 3*1 vectors
|
||||
|
||||
real(kind = dp) :: triple_product
|
||||
real(kind = dp), dimension(3), intent(in) :: a, b, c
|
||||
triple_product = dot_product(a, cross_product(b, c))
|
||||
|
||||
return
|
||||
end function triple_product
|
||||
|
||||
function in_bd_lat(v, box_faces, box_norms)
|
||||
!This function returns whether the point is within the transformed box boundaries. The transformed
|
||||
!box being the transformed simulation cell in the lattice basis
|
||||
|
||||
!Input/output variables
|
||||
real(kind=dp), dimension(3), intent(in) :: v !integer lattice position
|
||||
real(kind=dp), dimension(3,6), intent(in) :: box_faces !Centroid of all the box faces
|
||||
real(kind=dp), dimension(3,6), intent(in) :: box_norms !Box face normals
|
||||
logical :: in_bd_lat
|
||||
|
||||
!Other variables
|
||||
integer :: i
|
||||
real(kind=dp) :: pt_to_face(3)
|
||||
|
||||
in_bd_lat = .true.
|
||||
|
||||
!Check if point is in box bounds, this works by comparing the dot product of the face normal and the
|
||||
!vector from the point to the face. If the dot product is greater than 0 then the point is behind the face
|
||||
!if it is equal to zero then the point is on the face, if is less than 0 the the point is in front of the face.
|
||||
do i = 1, 6
|
||||
pt_to_face(:) = box_faces(:, i) - v
|
||||
if(dot_product(pt_to_face, box_norms(:,i)) <= 0) then
|
||||
in_bd_lat = .false.
|
||||
exit
|
||||
end if
|
||||
end do
|
||||
|
||||
return
|
||||
end function in_bd_lat
|
||||
|
||||
function in_block_bd(v, box_bd)
|
||||
!This function returns whether a point is within a block in 3d
|
||||
|
||||
!Input/output
|
||||
real(kind=dp), dimension(3), intent(in) :: v
|
||||
real(kind=dp), dimension(6), intent(in) :: box_bd
|
||||
logical :: in_block_bd
|
||||
|
||||
!Other variables
|
||||
integer :: i
|
||||
|
||||
in_block_bd = .true.
|
||||
|
||||
do i =1 ,3
|
||||
!Check upper bound
|
||||
if(v(i) > (box_bd(2*i)+10.0_dp**(-10)) ) then
|
||||
in_block_bd =.false.
|
||||
exit
|
||||
!Check lower bound
|
||||
else if (v(i) < (box_bd(2*i-1)-10.0_dp**(-10))) then
|
||||
in_block_bd = .false.
|
||||
exit
|
||||
end if
|
||||
end do
|
||||
end function in_block_bd
|
||||
|
||||
function lcm(a,b)
|
||||
!This function returns the smallest least common multiple of two numbers
|
||||
|
||||
real(kind=dp), intent(in) :: a, b
|
||||
real(kind=dp) :: lcm
|
||||
|
||||
integer :: aint, bint, gcd, remainder, placeholder
|
||||
|
||||
!Cast the vector positions to ints. There will be some error associated with this calculation
|
||||
aint = a*10**2
|
||||
bint = b*10**2
|
||||
|
||||
!Calculate greated common divisor
|
||||
gcd = aint
|
||||
placeholder = bint
|
||||
do while(placeholder /= 0)
|
||||
remainder = modulo(gcd, placeholder)
|
||||
gcd = placeholder
|
||||
placeholder=remainder
|
||||
end do
|
||||
lcm = real((aint*bint),dp)/(real(gcd,dp))* 10.0_dp**(-2.0_dp)
|
||||
end function lcm
|
||||
|
||||
function is_neighbor(rl, rk, r_in, r_out)
|
||||
!This function checks to see if two atoms are within a shell with an inner radius r_in and outer radius
|
||||
!r_out
|
||||
real(kind=dp), intent(in) :: r_in, r_out
|
||||
real(kind=dp), dimension(3), intent(in) :: rl, rk
|
||||
logical :: is_neighbor
|
||||
|
||||
!Internal variable
|
||||
real(kind=dp) :: rlk
|
||||
|
||||
rlk = norm2(rk - rl)
|
||||
is_neighbor=.true.
|
||||
if((rlk>r_out).or.(rlk < r_in)) is_neighbor = .false.
|
||||
|
||||
return
|
||||
end function is_neighbor
|
||||
|
||||
function is_equal(A, B)
|
||||
!This function checks if too numbers are equal within a tolerance
|
||||
real(kind=dp), intent(in) :: A, B
|
||||
logical :: is_equal
|
||||
|
||||
if((A>(B - 10.0_dp**-10)).and.(A < (B+10.0_dp**-10))) then
|
||||
is_equal = .true.
|
||||
else
|
||||
is_equal = .false.
|
||||
end if
|
||||
return
|
||||
end function is_equal
|
||||
end module functions
|
||||
@ -0,0 +1,177 @@
|
||||
module io
|
||||
|
||||
use elements
|
||||
use parameters
|
||||
use atoms
|
||||
|
||||
implicit none
|
||||
|
||||
integer :: outfilenum = 0
|
||||
character(len=100) :: outfiles(10)
|
||||
|
||||
public
|
||||
contains
|
||||
|
||||
subroutine get_out_file(filename)
|
||||
|
||||
implicit none
|
||||
|
||||
character(len=100), intent(in) :: filename
|
||||
character(len=100) :: temp_outfile
|
||||
character(len=1) :: overwrite
|
||||
logical :: file_exists
|
||||
|
||||
!If no filename is provided then this function is called with none and prompts user input
|
||||
if (filename=='none') then
|
||||
print *, "Please specify a filename or extension to output to:"
|
||||
read(*,*) temp_outfile
|
||||
else
|
||||
temp_outfile = filename
|
||||
end if
|
||||
|
||||
!Infinite loop which only exists if user provides valid filetype
|
||||
overwrite = 'r'
|
||||
do while(.true.)
|
||||
|
||||
!Check to see if file exists, if it does then ask user if they would like to overwrite the file
|
||||
inquire(file=trim(temp_outfile), exist=file_exists)
|
||||
if (file_exists) then
|
||||
if (overwrite == 'r') print *, "File ", trim(temp_outfile), " already exists. Would you like to overwrite? (Y/N)"
|
||||
read(*,*) overwrite
|
||||
if((scan(overwrite, "n") > 0).or.(scan(overwrite, "N") > 0)) then
|
||||
print *, "Please specify a new filename with extension:"
|
||||
read(*,*) temp_outfile
|
||||
else if((scan(overwrite, "y") > 0).or.(scan(overwrite, "Y") > 0)) then
|
||||
continue
|
||||
else
|
||||
print *, "Please pick either y or n"
|
||||
read(*,*) overwrite
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
if (scan(temp_outfile,'.',.true.) == 0) then
|
||||
print *, "No extension included on filename, please type a full filename that includes an extension."
|
||||
read(*,*) temp_outfile
|
||||
cycle
|
||||
end if
|
||||
select case(temp_outfile(scan(temp_outfile,'.',.true.)+1:))
|
||||
case('xyz')
|
||||
outfilenum=outfilenum+1
|
||||
outfiles(outfilenum) = temp_outfile
|
||||
exit
|
||||
case('lmp')
|
||||
outfilenum=outfilenum+1
|
||||
outfiles(outfilenum) = temp_outfile
|
||||
exit
|
||||
|
||||
case default
|
||||
print *, "File type: ", trim(temp_outfile(scan(temp_outfile,'.',.true.):)), "not currently accepted. ", &
|
||||
"please input a filename with extension from following list: xyz."
|
||||
read(*,*) temp_outfile
|
||||
|
||||
end select
|
||||
end do
|
||||
|
||||
end subroutine get_out_file
|
||||
|
||||
|
||||
subroutine write_out
|
||||
!This subroutine loops over alll of the outfile types defined and calls the correct writing subroutine
|
||||
|
||||
integer :: i
|
||||
|
||||
do i = 1, outfilenum
|
||||
!Pull out the extension of the file and call the correct write subroutine
|
||||
select case(trim(adjustl(outfiles(i)(scan(outfiles(i),'.',.true.)+1:))))
|
||||
case('xyz')
|
||||
call write_xyz(outfiles(i))
|
||||
case('lmp')
|
||||
call write_lmp(outfiles(i))
|
||||
case default
|
||||
print *, "The extension ", trim(adjustl(outfiles(i)(scan(outfiles(i),'.',.true.)+1:))), &
|
||||
" is not accepted for writing. Please select from: xyz and try again"
|
||||
stop
|
||||
|
||||
end select
|
||||
end do
|
||||
end subroutine write_out
|
||||
|
||||
|
||||
|
||||
subroutine write_xyz(file)
|
||||
!This is the simplest visualization subroutine, it writes out all nodal positions and atom positions to an xyz file
|
||||
character(len=100), intent(in) :: file
|
||||
|
||||
integer :: node_num, i, inod, ibasis
|
||||
|
||||
open(unit=11, file=trim(adjustl(file)), action='write', status='replace',position='rewind')
|
||||
|
||||
!Calculate total node number
|
||||
node_num=0
|
||||
do i = 1, ele_num
|
||||
node_num = node_num + basisnum(lat_ele(i))*ng_node(lat_ele(i))
|
||||
end do
|
||||
|
||||
!Write total number of atoms + elements
|
||||
write(11, '(i16)') node_num+atom_num
|
||||
|
||||
!Write comment line
|
||||
write(11, '(a)') "#Node + atom file created using cacmb"
|
||||
|
||||
!Write nodal positions
|
||||
do i = 1, ele_num
|
||||
do inod = 1, ng_node(lat_ele(i))
|
||||
do ibasis = 1, basisnum(lat_ele(i))
|
||||
write(11, '(a, 3f23.15)') basis_type(ibasis,lat_ele(i)), r_node(:,ibasis,inod,i)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
!Write atom positions
|
||||
do i = 1, atom_num
|
||||
write(11, '(a, 3f23.15)') type_atom(i), r_atom(:,i)
|
||||
end do
|
||||
|
||||
!Finish writing
|
||||
close(11)
|
||||
end subroutine write_xyz
|
||||
|
||||
subroutine write_lmp(file)
|
||||
|
||||
integer :: write_num, i
|
||||
character(len=100), intent(in) :: file
|
||||
!This subroutine writes out a .lmp style dump file
|
||||
|
||||
open(unit=11, file=trim(adjustl(file)), action='write', status='replace',position='rewind')
|
||||
|
||||
!Comment line
|
||||
write(11, '(a)') '# lmp file made with cacmb'
|
||||
write(11, '(a)')
|
||||
!Calculate total atom number
|
||||
write_num = atom_num
|
||||
!Write total number of atoms + elements
|
||||
write(11, '(i16, a)') write_num, ' atoms'
|
||||
!Write number of atom types
|
||||
write(11, '(i16, a)') 1, ' atom types'
|
||||
|
||||
write(11,'(a)') ' '
|
||||
!Write box bd
|
||||
write(11, '(2f23.15, a)') box_bd(1:2), ' xlo xhi'
|
||||
write(11, '(2f23.15, a)') box_bd(3:4), ' ylo yhi'
|
||||
write(11, '(2f23.15, a)') box_bd(5:6), ' zlo zhi'
|
||||
|
||||
!Masses
|
||||
write(11, '(a)') 'Masses'
|
||||
write(11, '(a)') ' '
|
||||
write(11, '(i16, f23.15)') 1, 63.546
|
||||
write(11, '(a)') ' '
|
||||
|
||||
!Write atom positions
|
||||
write(11, '(a)') 'Atoms'
|
||||
write(11, '(a)') ' '
|
||||
do i = 1, atom_num
|
||||
write(11, '(2i16, 3f23.15)') i, 1, r_atom(:,i)
|
||||
end do
|
||||
end subroutine write_lmp
|
||||
end module io
|
||||
@ -1,95 +0,0 @@
|
||||
module lattice
|
||||
|
||||
use precision_comm_module
|
||||
use subroutines
|
||||
|
||||
implicit none
|
||||
|
||||
integer :: atom_types
|
||||
|
||||
!Atom type variables
|
||||
character(len=2), dimension(10) :: atom_names
|
||||
real(kind=wp), dimension(10) :: atom_masses
|
||||
|
||||
!Lattice_type variables
|
||||
integer :: lat_num
|
||||
character(len=10), dimension(10) :: lattice_id, lattice_type
|
||||
real(kind=wp), dimension(10) :: lapa
|
||||
integer(kind=wp), dimension(10) :: basis_atom_num
|
||||
integer(kind=wp), dimension(10,10) :: basis_type
|
||||
real(kind=wp), dimension(3,10,10) ::basis_pos
|
||||
|
||||
!Unit Cell variables
|
||||
real(kind = wp) :: fcc_cell(3,8), fcc_mat(3,3)
|
||||
|
||||
public
|
||||
contains
|
||||
|
||||
subroutine lattice_init
|
||||
|
||||
!Initialize needed variables
|
||||
lat_num=0
|
||||
basis_atom_num(:) = 0
|
||||
|
||||
!Initialize finite element cells to be used
|
||||
|
||||
!First initialize the primitive fcc cell
|
||||
fcc_cell = reshape((/ 0.0_wp, 0.0_wp, 0.0_wp, &
|
||||
0.5_wp, 0.5_wp, 0.0_wp, &
|
||||
0.5_wp, 1.0_wp, 0.5_wp, &
|
||||
0.0_wp, 0.5_wp, 0.5_wp, &
|
||||
0.5_wp, 0.0_wp, 0.5_wp, &
|
||||
1.0_wp, 0.5_wp, 0.5_wp, &
|
||||
1.0_wp, 1.0_wp, 1.0_wp, &
|
||||
0.5_wp, 0.5_wp, 1.0_wp /), &
|
||||
shape(fcc_cell))
|
||||
|
||||
fcc_mat = reshape((/ 0.5_wp, 0.5_wp, 0.0_wp, &
|
||||
0.5_wp, 0.5_wp, 0.5_wp, &
|
||||
0.5_wp, 0.0_wp, 0.5_wp /), &
|
||||
shape(fcc_mat))
|
||||
end subroutine lattice_init
|
||||
!This subroutine defines the atom type arrays
|
||||
subroutine atom_type_parse(line)
|
||||
|
||||
character(len=100), intent(in) :: line
|
||||
character(len=100) :: errorloc
|
||||
integer :: ia, error
|
||||
character(len=20) :: label
|
||||
|
||||
read(line, *, iostat=error) label, atom_types, (atom_names(ia), atom_masses(ia), ia=1, atom_types)
|
||||
errorloc="lattice:22"
|
||||
call read_error_check(error,errorloc)
|
||||
|
||||
end subroutine atom_type_parse
|
||||
|
||||
!This subroutine defines the lattice types and the unit cells for the lattice types
|
||||
subroutine lattice_parse(line)
|
||||
character(len=100), intent(in) :: line
|
||||
integer :: ia, error
|
||||
character(len=20) :: label, kw
|
||||
character(len=100) :: errorloc
|
||||
|
||||
lat_num = lat_num + 1
|
||||
read(line, *, iostat=error) label, lattice_id(lat_num), lattice_type(lat_num), lapa(lat_num), kw
|
||||
errorloc="lattice:77"
|
||||
call read_error_check(error, errorloc)
|
||||
|
||||
select case(kw)
|
||||
case("type")
|
||||
read(line(scan(line, "type"):), *, iostat=error) label, basis_type(1,1)
|
||||
errorloc="lattice:56"
|
||||
call read_error_check(error,errorloc)
|
||||
case("basis")
|
||||
read(line(scan(line, "basis"):), *, iostat=error) label, basis_atom_num(lat_num), (basis_type(ia, lat_num) ,&
|
||||
basis_pos(1:3,ia,lat_num), ia = 1, basis_atom_num(lat_num))
|
||||
errorloc="lattice:59"
|
||||
call read_error_check(error,errorloc)
|
||||
case default
|
||||
print *, "Keyword ", kw, " is not accepted in the lattice command"
|
||||
stop "Exit with error"
|
||||
end select
|
||||
|
||||
|
||||
end subroutine lattice_parse
|
||||
end module lattice
|
||||
@ -1,52 +1,39 @@
|
||||
program main
|
||||
|
||||
use precision_comm_module
|
||||
use elements
|
||||
use lattice
|
||||
use region
|
||||
!**************************** CACmb *******************************
|
||||
!* CAC model building toolkit *
|
||||
! ____________ *
|
||||
! / / *
|
||||
! / / *
|
||||
! /___________/ *
|
||||
! _|_ _|_ _|____________ *
|
||||
! / / *
|
||||
! / / *
|
||||
! /___________/ *
|
||||
! *
|
||||
!*******************************************************************
|
||||
|
||||
integer :: iosline, iospara
|
||||
logical :: flags(4)
|
||||
character(len=100) :: line, command, errorloc
|
||||
use parameters
|
||||
use elements
|
||||
use io
|
||||
|
||||
|
||||
iosline = 0
|
||||
iospara = 0
|
||||
flags(:) = .false.
|
||||
integer :: arg_num
|
||||
character(len=100) :: mode
|
||||
|
||||
call lattice_init
|
||||
|
||||
!Main command loop
|
||||
do while (iosline == 0)
|
||||
! Command line parsing
|
||||
arg_num = command_argument_count()
|
||||
|
||||
read(*, '(a)', iostat=iosline) line
|
||||
errorloc="read_input:line"
|
||||
call read_error_check(iosline, errorloc)
|
||||
!Determine if a mode is being used and what it is. The first argument has to be the mode
|
||||
!if a mode is being used
|
||||
call get_command_argument(1, mode)
|
||||
|
||||
!Check for comment character (#)
|
||||
if ((scan(line, '#')/= 1).and.(line/='')) then
|
||||
read(line, *, iostat = iospara) command
|
||||
errorloc="read_input:command"
|
||||
call read_error_check(iosline, errorloc)
|
||||
mode = trim(adjustl(mode))
|
||||
if (mode(1:2) == '--') then
|
||||
call call_mode(arg_num, mode)
|
||||
end if
|
||||
|
||||
select case(command)
|
||||
case('atom_types')
|
||||
call atom_type_parse(line)
|
||||
flags(1) = .true.
|
||||
case('lattice')
|
||||
if(flags(1).eqv..false.) then
|
||||
print *, "Please define atom types before defining lattice types"
|
||||
stop 3
|
||||
end if
|
||||
call lattice_parse(line)
|
||||
flags(2) =.true.
|
||||
! case('region')
|
||||
! call build_region(line)
|
||||
! case('write')
|
||||
! call write_parse(line)
|
||||
case default
|
||||
print *, "The command ", trim(command), " is not currently accepted",&
|
||||
" please check input script and try again."
|
||||
end select
|
||||
end if
|
||||
end do
|
||||
!Finish by writing the files
|
||||
call write_out
|
||||
end program main
|
||||
@ -0,0 +1,432 @@
|
||||
module mode_create
|
||||
!This mode is intended for creating element/atom regions and writing them to specific files.
|
||||
|
||||
use parameters
|
||||
use atoms
|
||||
use io
|
||||
use subroutines
|
||||
|
||||
implicit none
|
||||
|
||||
character(len=100) :: name, element_type
|
||||
real(kind = dp) :: lattice_parameter, orient(3,3), cell_mat(3,8), box_len(3), basis(3,3), origin(3), maxlen(3), &
|
||||
orient_inv(3,3), box_vert(3,8), ox_bd(6), maxbd(3), lattice_space(3)
|
||||
integer :: esize, duplicate(3), ix, iy, iz, box_lat_vert(3,8), lat_num, lat_atom_num, bd_in_lat(6)
|
||||
logical :: dup_flag, dim_flag
|
||||
|
||||
real(kind=dp), allocatable :: r_lat(:,:,:), r_atom_lat(:,:)
|
||||
public
|
||||
contains
|
||||
|
||||
subroutine create(arg_num)
|
||||
! Main subroutine which controls execution
|
||||
|
||||
integer, intent(in) :: arg_num
|
||||
character(len=100) :: textholder
|
||||
|
||||
integer :: i, ibasis, inod
|
||||
real(kind=dp) :: r(3), periodvone(3), periodvtwo(3)
|
||||
real(kind=dp), allocatable :: r_node(:,:,:)
|
||||
|
||||
!Initialize default parameters
|
||||
orient = reshape((/ 1.0_dp, 0.0_dp, 0.0_dp, 0.0_dp, 1.0_dp, 0.0_dp, 0.0_dp, 0.0_dp, 1.0_dp /), shape(orient))
|
||||
cell_mat(:,:)=0.0_dp
|
||||
name =''
|
||||
element_type = ''
|
||||
esize=0
|
||||
lattice_parameter=0.0_dp
|
||||
duplicate(:) = 0
|
||||
box_len(:) = 0.0_dp
|
||||
dup_flag = .false.
|
||||
dim_flag = .false.
|
||||
basisnum = 0
|
||||
lat_num = 0
|
||||
lat_atom_num = 0
|
||||
|
||||
!First we parse the command
|
||||
call parse_command(arg_num)
|
||||
|
||||
! Before building do a check on the file
|
||||
if (outfilenum == 0) then
|
||||
textholder = 'none'
|
||||
call get_out_file(textholder)
|
||||
end if
|
||||
|
||||
!Now we setup the unit element and call other init subroutines
|
||||
call def_ng_node(1, element_type)
|
||||
|
||||
allocate(r_node(3,max_basisnum,max_ng_node))
|
||||
|
||||
if(dup_flag) then
|
||||
|
||||
!We initialize the cell with a lattice_parameter of 1 because we will add the lattice parameter later
|
||||
call cell_init(1.0_dp, esize, element_type, orient, cell_mat)
|
||||
|
||||
|
||||
do i = 1, 8
|
||||
box_vert(:,i) = duplicate(:)*lattice_space(:)*cubic_cell(:,i) + origin(:)
|
||||
end do
|
||||
call matrix_inverse(orient,3,orient_inv)
|
||||
!Now get the rotated box vertex positions in lattice space. Should be integer units
|
||||
box_lat_vert = int(matmul(fcc_inv, matmul(orient_inv, box_vert)))+1
|
||||
!Find the new maxlen
|
||||
maxbd = maxval(matmul(orient,matmul(fcc_mat,box_lat_vert)),2)
|
||||
do i = 1, 3
|
||||
box_bd(2*i) = maxval(box_vert(i,:)) - 0.1_dp*lattice_space(i)
|
||||
box_bd(2*i-1) = origin(i)
|
||||
end do
|
||||
|
||||
!and then call the build function with the correct transformation matrix
|
||||
select case(trim(adjustl(element_type)))
|
||||
case('fcc')
|
||||
! periodvone(:) = matmul(orient, reshape((/ 1, 1, 0 /),(/ 3 /)))
|
||||
! periodvtwo(:) = matmul(orient, reshape((/ 1, 1, 2 /),(/ 3 /)))
|
||||
|
||||
! do i = 1, 3
|
||||
! if (periodvone(i) < lim_zero) then
|
||||
! ! box_bd(2*i) =floor(box_bd(2*i)/periodvtwo(i))*periodvtwo(i)
|
||||
! box_bd(2*i) = box_bd(2*i) - 0.5*periodvtwo(i)
|
||||
! else if(periodvtwo(i) < lim_zero) then
|
||||
! ! box_bd(2*i) =floor(box_bd(2*i)/periodvone(i))*periodvone(i)
|
||||
! box_bd(2*i) = box_bd(2*i) - 0.5*periodvone(i)
|
||||
! else
|
||||
! ! box_bd(2*i) = floor(box_bd(2*i)/lcm(periodvone(i),periodvtwo(i)))*lcm(periodvone(i),periodvtwo(i))
|
||||
! box_bd(2*i) = box_bd(2*i) - 0.5*lcm(periodvone(i),periodvtwo(i))
|
||||
|
||||
! end if
|
||||
! end do
|
||||
|
||||
call lattice_in_box(box_lat_vert, fcc_mat)
|
||||
case default
|
||||
print *, "Element type ", trim(adjustl(element_type)), " not accepted in mode create, please specify a supported ", &
|
||||
"element type"
|
||||
stop 3
|
||||
end select
|
||||
|
||||
!Now that it is multiply by the lattice parameter
|
||||
box_bd = box_bd*lattice_parameter
|
||||
else if(dim_flag) then
|
||||
continue
|
||||
else
|
||||
|
||||
call cell_init(lattice_parameter, esize, element_type, orient, cell_mat)
|
||||
!If the user doesn't pass any build instructions than we just put the cell mat into the element_array
|
||||
call alloc_ele_arrays(1,0)
|
||||
|
||||
!Add the basis atoms to the unit cell
|
||||
do inod = 1, max_ng_node
|
||||
do ibasis = 1, basisnum(1)
|
||||
r_node(:,ibasis,inod) = cell_mat(:,inod) + basis_pos(:,ibasis,1) + origin(:)
|
||||
end do
|
||||
end do
|
||||
|
||||
call add_element(element_type, esize, 1, r_node)
|
||||
end if
|
||||
|
||||
!If we passed the dup_flag or dim_flag then we have to convert the lattice points and add them to the atom/element arrays
|
||||
if(dup_flag.or.dim_flag) then
|
||||
!Allocate variables
|
||||
call alloc_ele_arrays(lat_num, lat_atom_num*basisnum(1))
|
||||
if(lat_atom_num > 0) then
|
||||
!Check for periodicity
|
||||
do i = 1, lat_atom_num
|
||||
do ibasis = 1, basisnum(1)
|
||||
call add_atom(basis_type(ibasis,1), (r_atom_lat(:,i)*lattice_parameter)+basis_pos(:,ibasis,1))
|
||||
end do
|
||||
end do
|
||||
deallocate(r_atom_lat)
|
||||
end if
|
||||
end if
|
||||
|
||||
end subroutine create
|
||||
!This subroutine parses the command and pulls out information needed for mode_create
|
||||
subroutine parse_command(arg_num)
|
||||
|
||||
integer, intent(in) :: arg_num
|
||||
|
||||
integer :: arg_pos, ori_pos, i, j, arglen, stat
|
||||
character(len=100) :: textholder
|
||||
character(len=8) :: orient_string
|
||||
|
||||
|
||||
!Pull out all required positional arguments
|
||||
call get_command_argument(2, name, arglen)
|
||||
if(arglen==0) STOP "Name is missing in mode create"
|
||||
|
||||
call get_command_argument(3,element_type, arglen)
|
||||
if(arglen==0) STOP "Element_type is missing in mode create"
|
||||
|
||||
call get_command_argument(4,textholder, arglen)
|
||||
if(arglen==0) STOP "Lattice Parameter is missing in mode create"
|
||||
read(textholder, *, iostat=stat) lattice_parameter
|
||||
if(stat > 0) STOP "Error reading lattice parameter"
|
||||
|
||||
call get_command_argument(5, textholder, arglen)
|
||||
if(arglen==0) STOP "Esize missing in mode create"
|
||||
read(textholder, *, iostat=stat) esize
|
||||
if(stat > 0) STOP "Error reading esize"
|
||||
|
||||
arg_pos = 6
|
||||
!Check for optional keywords
|
||||
do while(.true.)
|
||||
if(arg_pos > command_argument_count()) exit
|
||||
!Pull out the next argument which should either be a keyword or an option
|
||||
call get_command_argument(arg_pos, textholder)
|
||||
textholder=adjustl(textholder)
|
||||
arg_pos=arg_pos+1
|
||||
|
||||
!Choose what to based on what the option string is
|
||||
select case(trim(textholder))
|
||||
|
||||
!If orient command is passed extract the orientation to numeric array format
|
||||
case('orient')
|
||||
do i = 1, 3
|
||||
call get_command_argument(arg_pos, orient_string, arglen)
|
||||
if (arglen==0) STOP "Missing orientation in orient command of mode create"
|
||||
arg_pos = arg_pos+1
|
||||
ori_pos=2
|
||||
do j = 1,3
|
||||
if (orient_string(ori_pos:ori_pos) == '-') then
|
||||
ori_pos = ori_pos + 1
|
||||
read(orient_string(ori_pos:ori_pos), *, iostat=stat) orient(i,j)
|
||||
if (stat>0) STOP "Error reading orient value"
|
||||
orient(i,j) = -orient(i,j)
|
||||
ori_pos = ori_pos + 1
|
||||
else
|
||||
read(orient_string(ori_pos:ori_pos), *, iostat=stat) orient(i,j)
|
||||
if(stat>0) STOP "Error reading orient value"
|
||||
ori_pos=ori_pos + 1
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
|
||||
|
||||
|
||||
!If the duplicate command is passed then we extract the information on the new bounds.
|
||||
case('duplicate')
|
||||
dup_flag = .true.
|
||||
do i = 1, 3
|
||||
call get_command_argument(arg_pos, textholder)
|
||||
read(textholder, *) duplicate(i)
|
||||
arg_pos = arg_pos + 1
|
||||
end do
|
||||
|
||||
case('origin')
|
||||
do i = 1, 3
|
||||
call get_command_argument(arg_pos, textholder)
|
||||
read(textholder, *) origin(i)
|
||||
arg_pos = arg_pos + 1
|
||||
end do
|
||||
print *, origin
|
||||
!If a filetype is passed then we add name.ext to the outfiles list
|
||||
case('xyz')
|
||||
textholder = trim(adjustl(name)) //'.xyz'
|
||||
call get_out_file(textholder)
|
||||
|
||||
case default
|
||||
!Check to see if it is an option command, if so then mode_create must be finished
|
||||
if(textholder(1:1) == '-') then
|
||||
exit
|
||||
|
||||
!Check to see if a filename was passed
|
||||
elseif(scan(textholder,'.',.true.) > 0) then
|
||||
call get_out_file(textholder)
|
||||
end if
|
||||
end select
|
||||
end do
|
||||
|
||||
!Calculate the lattice periodicity length in lattice units
|
||||
do i = 1, 3
|
||||
lattice_space(i) = norm2(orient(i,:))
|
||||
end do
|
||||
|
||||
!Check special periodicity relations
|
||||
select case(trim(adjustl(element_type)))
|
||||
case('fcc')
|
||||
do i = 1,3
|
||||
print *, orient(i,:)
|
||||
!Check if one of the directions is 110
|
||||
if ((is_equal(abs(orient(i,1)), abs(orient(i,2))).and.(is_equal(orient(i,3),0.0_dp))).or.&
|
||||
(is_equal(abs(orient(i,2)), abs(orient(i,3))).and.(is_equal(orient(i,1),0.0_dp))).or.&
|
||||
(is_equal(abs(orient(i,3)), abs(orient(i,1))).and.(is_equal(orient(i,2),0.0_dp)))) then
|
||||
|
||||
print *, '110', i
|
||||
lattice_space(i) = 0.5_dp * lattice_space(i)
|
||||
|
||||
!Check if one direction is 112
|
||||
else if ((is_equal(abs(orient(i,1)), abs(orient(i,2))).and.(is_equal(abs(orient(i,3)),2.0_dp*abs(orient(i,1))))).or.&
|
||||
(is_equal(abs(orient(i,2)), abs(orient(i,3))).and.(is_equal(abs(orient(i,1)),2.0_dp*abs(orient(i,2))))).or.&
|
||||
(is_equal(abs(orient(i,3)), abs(orient(i,1))).and.(is_equal(abs(orient(i,2)),2.0_dp*abs(orient(i,3))))))&
|
||||
then
|
||||
|
||||
print *, '112 ', i
|
||||
lattice_space(i) = 0.5_dp * lattice_space(i)
|
||||
|
||||
end if
|
||||
end do
|
||||
end select
|
||||
!Now normalize the orientation matrix
|
||||
orient = matrix_normal(orient,3)
|
||||
|
||||
!If we haven't defined a basis then define the basis and add the default basis atom type and position
|
||||
if (basisnum(1) == 0) then
|
||||
max_basisnum = 1
|
||||
basisnum(1) = 1
|
||||
basis_type(1,1) = name !If basis command not defined then we use name as the atom_name
|
||||
basis_pos(:,1,1) = 0.0_dp
|
||||
end if
|
||||
end subroutine
|
||||
|
||||
subroutine lattice_in_box(box_in_lat, transform_matrix)
|
||||
!This subroutine returns all the lattice points in the box in r_lat
|
||||
|
||||
!Inputs
|
||||
integer, dimension(3,8), intent(in) :: box_in_lat !The box vertices transformed to lattice space
|
||||
real(kind=dp), dimension(3,3), intent(in) :: transform_matrix !The transformation matrix from lattice_space to real space
|
||||
!Internal variables
|
||||
integer :: i, j, bd_in_lat(6), ix, iy, iz, numlatpoints
|
||||
real(kind=dp) :: box_face_center(3,6), face_normals(3,6), Cx(2), Cy, Cz, A(2), v(3)
|
||||
real(kind=dp), allocatable :: resize_lat_array(:,:)
|
||||
|
||||
!First find the bounding lattice points (min and max points for the box in each dimension)
|
||||
numlatpoints = 1
|
||||
do i = 1, 3
|
||||
bd_in_lat(2*i-1) = minval(box_in_lat(i,:))
|
||||
bd_in_lat(2*i) = maxval(box_in_lat(i,:))
|
||||
numlatpoints = numlatpoints*(bd_in_lat(2*i)-bd_in_lat(2*i-1))
|
||||
end do
|
||||
|
||||
!Allocate the correct lat variable
|
||||
select case(esize)
|
||||
!Atomistics
|
||||
case(2)
|
||||
allocate(r_atom_lat(3,numlatpoints))
|
||||
case default
|
||||
continue
|
||||
end select
|
||||
!Calculate the box_face centroids and box face normals. This is used in the centroid code.
|
||||
box_face_center(:,:) = 0.0_dp
|
||||
face_normals = reshape((/ -1.0_dp, 0.0_dp, 0.0_dp, &
|
||||
1.0_dp, 0.0_dp, 0.0_dp, &
|
||||
0.0_dp, -1.0_dp, 0.0_dp, &
|
||||
0.0_dp, 1.0_dp, 0.0_dp, &
|
||||
0.0_dp, 0.0_dp, -1.0_dp, &
|
||||
0.0_dp, 0.0_dp, 1.0_dp /),&
|
||||
shape(face_normals))
|
||||
!Face normals
|
||||
select case(trim(adjustl(element_type)))
|
||||
case('fcc')
|
||||
do i = 1, 6
|
||||
!Box face normal
|
||||
face_normals(:,i) = matmul(fcc_inv, matmul(orient_inv, face_normals(:,i)))
|
||||
end do
|
||||
end select
|
||||
|
||||
!Face centroids
|
||||
do i =1, 6
|
||||
|
||||
!Initialize variables
|
||||
A(:) = 0.0_dp
|
||||
Cx(:) = 0.0_dp
|
||||
Cy = 0.0_dp
|
||||
Cz = 0.0_dp
|
||||
|
||||
!Calculate all terms using a projection onto the xy and xz planes and then using the 2d equation
|
||||
!for centroid of a plane. This is why we calculate the x centroid twice.
|
||||
do j = 1, 4
|
||||
! A(1) = A(1) + 0.5*(box_in_lat(1,cubic_faces(j,i))*box_in_lat(2,cubic_faces(j+1,i)) &
|
||||
! - box_in_lat(1,cubic_faces(j+1,i))*box_in_lat(2,cubic_faces(j,i)))
|
||||
|
||||
! !Centroid in x from xy plane
|
||||
! Cx(1) = Cx(1) + (box_in_lat(1,cubic_faces(j,i))+box_in_lat(1,cubic_faces(j+1,i)))* &
|
||||
! (box_in_lat(1,cubic_faces(j,i))*box_in_lat(2,cubic_faces(j+1,i)) &
|
||||
! - box_in_lat(1,cubic_faces(j+1,i))*box_in_lat(2,cubic_faces(j,i)))
|
||||
|
||||
! !Centroid in y from xy plane
|
||||
! Cy = Cy + (box_in_lat(2,cubic_faces(j,i))+box_in_lat(2,cubic_faces(j+1,i)))* &
|
||||
! (box_in_lat(1,cubic_faces(j,i))*box_in_lat(2,cubic_faces(j+1,i)) &
|
||||
! - box_in_lat(1,cubic_faces(j+1,i))*box_in_lat(2,cubic_faces(j,i)))
|
||||
|
||||
! A(2) = A(2) + 0.5*(box_in_lat(1,cubic_faces(j,i))*box_in_lat(3,cubic_faces(j+1,i)) &
|
||||
! - box_in_lat(1,cubic_faces(j+1,i))*box_in_lat(3,cubic_faces(j,i)))
|
||||
|
||||
! !Centroid in x from xz plane
|
||||
! Cx(2) = Cx(2) + (box_in_lat(1,cubic_faces(j,i))+box_in_lat(1,cubic_faces(j+1,i)))* &
|
||||
! (box_in_lat(1,cubic_faces(j,i))*box_in_lat(3,cubic_faces(j+1,i)) &
|
||||
! - box_in_lat(1,cubic_faces(j+1,i))*box_in_lat(3,cubic_faces(j,i)))
|
||||
|
||||
! !Centroid in z from xz plane
|
||||
! Cz = Cz + (box_in_lat(3,cubic_faces(j,i))+box_in_lat(3,cubic_faces(j+1,i)))* &
|
||||
! (box_in_lat(1,cubic_faces(j,i))*box_in_lat(3,cubic_faces(j+1,i)) &
|
||||
! - box_in_lat(1,cubic_faces(j+1,i))*box_in_lat(3,cubic_faces(j,i)))
|
||||
|
||||
! print *, j, i, Cx, Cy, Cz, A
|
||||
Cx(1) = Cx(1) + box_in_lat(1,cubic_faces(j,i))*0.25
|
||||
Cy = Cy + box_in_lat(2,cubic_faces(j,i))*0.25
|
||||
Cz = Cz + box_in_lat(3,cubic_faces(j,i))*0.25
|
||||
|
||||
end do
|
||||
|
||||
! Cx = Cx * 1/(6*A)
|
||||
! if(Cx(1) /= Cx(2)) then
|
||||
! call error_message(7)
|
||||
! end if
|
||||
! Cy = Cy* 1/(6*A(1))
|
||||
! Cz = Cz*1/(6*A(2))
|
||||
|
||||
box_face_center(:,i) = (/ Cx(1), Cy, Cz /)
|
||||
end do
|
||||
|
||||
!Loop over all of lattice points within the boundary, we choose between two loops. One for the atomistic case
|
||||
!and one for the regular case
|
||||
print *, box_bd
|
||||
if (esize==2) then
|
||||
!atomistics
|
||||
do iz = bd_in_lat(5)-5, bd_in_lat(6)+5
|
||||
do iy = bd_in_lat(3)-5, bd_in_lat(4)+5
|
||||
do ix = bd_in_lat(1)-5, bd_in_lat(2)+5
|
||||
v= (/ real(ix,dp), real(iy, dp), real(iz,dp) /)
|
||||
|
||||
!Transform point back to real space for easier checking
|
||||
v = matmul(orient, matmul(transform_matrix,v))
|
||||
!If within the boundaries
|
||||
if(in_block_bd(v, box_bd)) then
|
||||
lat_atom_num = lat_atom_num + 1
|
||||
r_atom_lat(:,lat_atom_num) = v
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
else
|
||||
continue
|
||||
end if
|
||||
|
||||
end subroutine lattice_in_box
|
||||
|
||||
|
||||
subroutine error_message(errorid)
|
||||
|
||||
integer, intent(in) :: errorid
|
||||
|
||||
select case(errorid)
|
||||
case(1)
|
||||
STOP "Name is missing."
|
||||
case(2)
|
||||
print *, "Element_type is missing"
|
||||
case(3)
|
||||
print *, "Lattice_parameter is missing"
|
||||
case(4)
|
||||
print *, "Lattice parameter is not in float form"
|
||||
case(5)
|
||||
print *, "Esize is missing"
|
||||
case(6)
|
||||
print *, "Esize is not in integer form"
|
||||
case(7)
|
||||
print *, "Cx(1) should equal Cx(2) in plane centroid finding algorithm. Please double check implementation"
|
||||
end select
|
||||
|
||||
STOP 3
|
||||
end subroutine error_message
|
||||
|
||||
|
||||
end module mode_create
|
||||
@ -0,0 +1,8 @@
|
||||
module parameters
|
||||
|
||||
implicit none
|
||||
|
||||
integer, parameter :: dp= selected_real_kind(15,307)
|
||||
real(kind=dp), parameter :: lim_zero = epsilon(1.0_dp), &
|
||||
lim_large = huge(1.0_dp)
|
||||
end module parameters
|
||||
@ -1,13 +0,0 @@
|
||||
module precision_comm_module
|
||||
|
||||
implicit none
|
||||
|
||||
integer, parameter :: &
|
||||
dp = selected_real_kind(15, 307), & ! double real
|
||||
qp = selected_real_kind(33, 4931), & ! quadrupole real
|
||||
wp = dp
|
||||
|
||||
integer, save :: &
|
||||
mpi_wp
|
||||
|
||||
end module precision_comm_module
|
||||
@ -1,14 +0,0 @@
|
||||
module region
|
||||
use precision_comm_module
|
||||
|
||||
implicit none
|
||||
|
||||
public
|
||||
contains
|
||||
|
||||
subroutine build_region(line)
|
||||
|
||||
character(len=100), intent(in) :: line
|
||||
|
||||
end subroutine build_region
|
||||
end module region
|
||||
Loading…
Reference in new issue