diff --git a/src/Makefile b/src/Makefile index c84186e..e1a1145 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,6 +1,7 @@ + FC=ifort -#FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -FFLAGS=-mcmodel=large -Ofast +FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin +#FFLAGS=-mcmodel=large -Ofast MODES=mode_create.o mode_merge.o mode_convert.o OBJECTS=main.o elements.o io.o subroutines.o functions.o atoms.o call_mode.o box.o $(MODES) @@ -8,7 +9,7 @@ OBJECTS=main.o elements.o io.o subroutines.o functions.o atoms.o call_mode.o box .SUFFIXES: .c .f .f90 .F90 .o cacmb: $(OBJECTS) - $(FC) $(FFLAGS) $(OBJECTS) -o $@ + $(FC) $(FFLAGS) $(OBJECTS) parameters.o -o $@ .f90.o: $(FC) $(FFLAGS) -c $< @@ -30,4 +31,4 @@ main.o io.o build_subroutines.o: elements.o call_mode.o : $(MODES) $(MODES) io.o: atoms.o box.o $(MODES) main.o : io.o -testfuncs.o elements.o mode_create.o: subroutines.o +testfuncs.o elements.o mode_create.o: subroutines.o \ No newline at end of file diff --git a/src/elements.f90 b/src/elements.f90 index 22e6eff..d6545d6 100644 --- a/src/elements.f90 +++ b/src/elements.f90 @@ -101,10 +101,28 @@ module elements real(kind=dp), dimension(3,max_ng_node), intent(out) :: cell_mat + integer :: inod, i + real(kind=dp), dimension(3,max_ng_node) :: adjustVar + + adjustVar(:,:) = 0.0_dp + select case(trim(ele_type)) case('fcc') - cell_mat(:,1:8) = lapa * ((esize-1)*matmul(orient_mat, fcc_cell)) + if(lmpcac) then + do inod = 1, 8 + do i = 1,3 + if(is_equal(cubic_cell(i, inod),0.0_dp)) then + adjustVar(i,inod) = -0.5_dp + else + adjustVar(i, inod) = 0.5_dp + end if + end do + end do + adjustVar(:,1:8) = matmul(fcc_mat, adjustVar(:,1:8)) + end if + cell_mat(:, 1:8) = fcc_cell + adjustVar(:,1:8) + cell_mat(:,1:8) = lapa * ((esize-1)*matmul(orient_mat, cell_mat(:,1:8))) case default print *, "Element type ", trim(ele_type), " currently not accepted" stop diff --git a/src/io.f90 b/src/io.f90 index dd49096..9d5537a 100644 --- a/src/io.f90 +++ b/src/io.f90 @@ -9,7 +9,7 @@ module io integer :: outfilenum = 0, infilenum = 0 character(len=100) :: outfiles(10), infiles(10) - logical lmpcac + public contains @@ -78,53 +78,6 @@ module io end subroutine get_out_file - subroutine get_in_file(filename) - - implicit none - - character(len=100), intent(in) :: filename - character(len=100) :: temp_infile - 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 with extension to read in:" - read(*,*) temp_infile - else - temp_infile = filename - end if - - !Infinite loop which only exists if user provides valid filetype - do while(.true.) - - !Check to see if file exists, if it doesn't then ask the user for another input - inquire(file=trim(temp_infile), exist=file_exists) - if (.not.file_exists) then - print *, "The file ", temp_infile, "does not exist, please input an existing file to read in." - read(*,*) temp_infile - cycle - end if - - if (scan(temp_infile,'.',.true.) == 0) then - print *, "No extension included on filename, please type a full filename that includes an extension." - read(*,*) temp_infile - cycle - end if - select case(temp_infile(scan(temp_infile,'.',.true.)+1:)) - case('cac') - infilenum=infilenum+1 - infiles(infilenum) = temp_infile - exit - case default - print *, "File type: ", trim(temp_infile(scan(temp_infile,'.',.true.):)), " not currently accepted. ", & - "please input a filename with extension from following list: cac." - read(*,*) temp_infile - - end select - end do - - end subroutine get_in_file - subroutine write_out !This subroutine loops over alll of the outfile types defined and calls the correct writing subroutine diff --git a/src/main.f90 b/src/main.f90 index a681d33..f90b731 100644 --- a/src/main.f90 +++ b/src/main.f90 @@ -27,6 +27,17 @@ program main ! Command line parsing arg_num = command_argument_count() + !First check if we are writing out to lammpscac format by looping over all arguments + do i = 1, arg_num + call get_command_argument(i, argument) + select case(argument(scan(argument,'.',.true.)+1:)) + case('cac') + lmpcac = .true. + case default + continue + end select + end do + !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, argument) diff --git a/src/mode_create.f90 b/src/mode_create.f90 index d5995e8..a669f93 100644 --- a/src/mode_create.f90 +++ b/src/mode_create.f90 @@ -91,20 +91,6 @@ module mode_create end do else - if(lmpcac) then - do inod = 1, 8 - do i = 1,3 - if(is_equal(cubic_cell(i, inod),0.0_dp)) then - adjustVar(i,inod) = -0.5_dp - else - adjustVar(i, inod) = 0.5_dp - end if - end do - end do - else - adjustVar(:,:)=0.0_dp - end if - 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) @@ -333,6 +319,8 @@ module mode_create end if end do end do + + adjustVar(:,1:8) = matmul(orient,matmul(fcc_mat,adjustVar(:,1:8))) else adjustVar(:,:)=0.0_dp end if @@ -465,7 +453,7 @@ module mode_create end do if(all(node_in_bd)) then - lat_ele_num = lat_ele_num+1 + lat_ele_num = lat_ele_num+1 do inod = 1, 8 r_lat(:,inod,lat_ele_num) = temp_nodes(:,1,inod) + adjustVar(:,inod) end do diff --git a/src/parameters.f90 b/src/parameters.f90 index 0443622..9e9d9d8 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -5,4 +5,6 @@ module parameters integer, parameter :: dp= selected_real_kind(15,307) real(kind=dp), parameter :: lim_zero = epsilon(1.0_dp), & lim_large = huge(1.0_dp) + logical, save :: lmpcac + end module parameters \ No newline at end of file