Initial commit with working atom and lattice type parsing

2019-09-25 20:11:10 -04:00 · 2019-09-25 20:11:10 -04:00 · 624886bbe9
commit 624886bbe9
parent 552dd3cada
9 changed files with 350 additions and 1 deletions
--- a/src/lattice.f90
+++ b/src/lattice.f90
@ -0,0 +1,95 @@
+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