Working writing to lammpsCAC format

src/io.f90

@@ -6,8 +6,8 @@ module io
 
     implicit none
 
-    integer :: outfilenum = 0
+    integer :: outfilenum = 0, infilenum = 0
-    character(len=100) :: outfiles(10)
+    character(len=100) :: outfiles(10), infiles(10)
 
    public 
    contains
@@ -41,6 +41,7 @@ module io
                 if((scan(overwrite, "n") > 0).or.(scan(overwrite, "N") > 0)) then 
                     print *, "Please specify a new filename with extension:"
                     read(*,*) temp_outfile
+                    cycle
                 else if((scan(overwrite, "y") > 0).or.(scan(overwrite, "Y") > 0)) then 
                     continue
                 else
@@ -56,21 +57,13 @@ module io
                 cycle
             end if
             select case(temp_outfile(scan(temp_outfile,'.',.true.)+1:))
-            case('xyz')
+            case('xyz','lmp','vtk','cac')
-                outfilenum=outfilenum+1
-                outfiles(outfilenum) =  temp_outfile
-                exit
-            case('lmp')
                 outfilenum=outfilenum+1
                 outfiles(outfilenum) =  temp_outfile
                 exit
-            case('vtk')
-                outfilenum=outfilenum+1
-                outfiles(outfilenum)=temp_outfile
-                exit
             case default    
-                print *, "File type: ", trim(temp_outfile(scan(temp_outfile,'.',.true.):)), "not currently accepted. ", &
+                print *, "File type: ", trim(temp_outfile(scan(temp_outfile,'.',.true.):)), " not currently accepted. ", &
-                         "please input a filename with extension from following list: xyz, lmp, vtk."
+                         "please input a filename with extension from following list: xyz, lmp, vtk, cac."
                 read(*,*) temp_outfile
 
             end select
@@ -78,6 +71,52 @@ 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_outfile,'.',.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_outfile(scan(temp_outfile,'.',.true.)+1:))
+            case('cac')
+                infilenum=infilenum+1
+                infiles(infilenum) =  temp_infile
+                exit
+            case default    
+                print *, "File type: ", trim(temp_infile(scan(temp_outfile,'.',.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
@@ -96,6 +135,8 @@ module io
                 call write_lmp(outfiles(i))
             case('vtk')
                 call write_vtk(outfiles(i))
+            case('cac')
+                call write_lmpcac(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"
@@ -201,6 +242,71 @@ module io
         end do
     end subroutine write_lmp
 
+    subroutine write_lmpcac(file)
+        !This subroutine writes out a .lmp style dump file
+        character(len=100), intent(in) :: file
+        integer :: write_num, i, inod, ibasis
+        real(kind=dp) :: mass
+
+1       format(i16, '   Eight_Node', 4i16)
+2       format(i16, '   Atom', 4i16)
+3       format(3i16,3f23.15)
+
+        open(unit=11, file=trim(adjustl(file)), action='write', status='replace',position='rewind')
+
+        !Comment line
+        write(11, '(a)') '# CAC input file made with cacmb'
+        write(11, '(a)')
+        !Calculate total atom number
+        write_num = atom_num + ele_num
+
+        !Write total number of atoms + elements
+        write(11, '(i16, a)') write_num, ' cac elements'
+        !Write number of atom types 
+        write(11, '(i16, a)') atom_types, ' 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)') ' '
+        do i =1, atom_types
+            call atommass(type_to_name(i),mass)
+            write(11, '(i16, f23.15, 2a)') i, mass, ' # ', type_to_name(i)
+        end do
+        write(11, '(a)') ' '
+
+        write(11, '(a)') 'CAC Elements'
+        write(11, '(a)') ' '
+
+        !Write element nodal positions
+        do i = 1, ele_num
+            select case(trim(adjustl(type_ele(i))))
+            case('fcc')
+                !The first entry is the element specifier 
+                write(11,1) i, basisnum(lat_ele(i)), size_ele(i), size_ele(i), size_ele(i)
+                do ibasis = 1, basisnum(lat_ele(i))
+                    do inod = 1, 8
+                        !Nodal information for every node
+                        write(11,3) inod, ibasis, basis_type(ibasis,lat_ele(i)), r_node(:,ibasis,inod,i)
+                    end do
+                end do
+            end select
+        end do
+
+        do i = 1, atom_num
+            !Element specifier dictating that it is an atom
+            write(11,2) ele_num+i, 1, 1, 1, 1
+            !Write the atomic information
+            write(11,3) 1, 1, type_atom(i), r_atom(:,i)
+        end do
+    end subroutine write_lmpcac
+
     subroutine write_vtk(file)
         !This subroutine writes out a vtk style dump file
         integer :: i, j, inod, ibasis
@@ -257,7 +363,7 @@ module io
         do i = 1, ele_num
             do inod=1, ng_node(lat_ele(i))  
                 do ibasis = 1, basisnum(lat_ele(i))
-                    write(11, '(3f23.1)') sum(r_node(:,:,inod,i),2)/basisnum(lat_ele(i))
+                    write(11, '(3f23.15)') sum(r_node(:,:,inod,i),2)/basisnum(lat_ele(i))
                 end do 
             end do 
         end do
@@ -276,4 +382,29 @@ module io
         end do
         close(11)
     end subroutine
+
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! READ SUBROUTINES !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!     subroutine read_lmpcac(file, box_bd)
+!         !This subroutine reads in a lmpcac file which can be used with different options and modes
+
+!         !Arguments
+!         character(len=100), intent(in) :: file
+!         real(kind=wp), dimension(6), intent(out) :: box_bd
+
+!         !Internal variables
+!         character(len=1000) :: line
+!         integer :: read_num, atom_lim, ele_lim
+
+!         !Open the lmpcac file
+!         open(unit=11, file=file, action='read', position='rewind')
+
+!         !Skip header lines
+!         read(11,*) line
+!         read(11,*) line
+
+!         !Read total number of elements
+        
+
+!     end subroutine read_lmpcac
 end module io

src/mode_create.f90

@@ -432,7 +432,6 @@ module mode_create
             end do
 
             !Now figure out how many lattice points could not be contained in elements
-            print *, count(lat_points)
             allocate(r_atom_lat(3,count(lat_points)))
             lat_atom_num = 0
             do ix  = 1, bd_in_array(3)
@@ -453,7 +452,6 @@ module mode_create
                 end do
             end do
 
-            print *, lat_atom_num
         end if 
 
     end subroutine build_with_rhomb