adding a cif file for testing purposes

parent ee642f35
......@@ -60,9 +60,9 @@
!---- Parameters ----!
real(kind=cp), parameter :: R_ATOM=1.1_cp ! Average atomic radius
integer, public, parameter :: MAX_MOD=8 ! ??????
real(kind=cp), parameter :: R_ATOM=1.1_cp ! Average atomic radius
integer,public, parameter :: max_mod=8
!---- Types ----!
......
......@@ -167,6 +167,7 @@ SubModule (CFML_Atoms) Init_Allocating_Atoms
type(MAtm_Std_Type), dimension(n) :: MAtm_Std
type(Atm_Ref_Type) , dimension(n) :: Atm_Ref
type(MAtm_Ref_Type), dimension(n) :: MAtm_Ref
!> Init
if (n <= 0) then
A%natoms=0
......@@ -179,17 +180,21 @@ SubModule (CFML_Atoms) Init_Allocating_Atoms
!> Allocating variables
Select Case(trim(l_case(Type_Atm)))
Case("atm")
allocate (A%atom(n),source=Atm,stat=ier)
Case("atm_std")
allocate (A%atom(n),source=Atm_Std,stat=ier)
Case("matm_std")
allocate (A%atom(n),source=MAtm_Std,stat=ier)
Case("atm_ref")
allocate (A%atom(n),source=Atm_Ref,stat=ier)
Case("matm_ref")
allocate (A%atom(n),source=MAtm_Ref,stat=ier)
End Select
case("atm")
allocate(A%atom(n),source=Atm,stat=ier)
case("atm_std")
allocate(A%atom(n),source=Atm_Std,stat=ier)
case("matm_std")
allocate(A%atom(n),source=MAtm_Std,stat=ier)
case("atm_ref")
allocate(A%atom(n),source=Atm_Ref,stat=ier)
case("matm_ref")
allocate(A%atom(n),source=MAtm_Ref,stat=ier)
end select
allocate (A%active(n),stat=ier)
......
......@@ -112,27 +112,27 @@ SubModule (CFML_Atoms) Write_Atoms
end if
car2="ISO"
if(any(A%Atom(:)%Thtype == "ANI")) car2="ANI"
if (any(A%Atom(:)%Thtype == "ANI") .or. any(A%Atom(:)%Thtype == "ani") ) car2="ANI"
if (car2 == "ISO") then
line=" Atom Scatt/Chem Mult x/a y/b z/c B[iso] Occ"
if(car2 == "ISO") then
line=" Atom Scatt/Chem Mult x/a y/b z/c B[iso] Occ"
else
car2=trim(u_case(A%Atom(1)%Utype))
select case (car2)
case ("BETA")
line=" Atom Scatt/Chem Mult x/a y/b z/c B[iso] Occ "
line=line//" beta_11 beta_22 beta_33 beta_12 beta_13 beta_23"
case ("U")
line=" Atom Scatt/Chem Mult x/a y/b z/c U[iso/eq] Occ "
line=line//" U_11 U_22 U_33 U_12 U_13 U_23"
case ("B")
line=" Atom Scatt/Chem Mult x/a y/b z/c B[iso] Occ"
line=line//" B_11 B_22 B_33 B_12 B_13 B_23"
case default
line=" Atom Scatt/Chem Mult x/a y/b z/c B[iso] Occ"
end select
car2=trim(u_case(A%Atom(1)%Utype))
select case (trim(car2))
case ("BETA")
line=" Atom Scatt/Chem Mult x/a y/b z/c B[iso] Occ "
line=line//" beta_11 beta_22 beta_33 beta_12 beta_13 beta_23"
case ("U")
line=" Atom Scatt/Chem Mult x/a y/b z/c U[iso/eq] Occ "
line=line//" U_11 U_22 U_33 U_12 U_13 U_23"
case ("B")
line=" Atom Scatt/Chem Mult x/a y/b z/c B[iso] Occ"
line=line//" B_11 B_22 B_33 B_12 B_13 B_23"
case default
line=" Atom Scatt/Chem Mult x/a y/b z/c B[iso] Occ"
end select
end if
!1234567890123456781234567
write(unit=lun,fmt="(T3,a)") trim(line)
line=repeat("=", len_trim(line))
......
......@@ -39,7 +39,7 @@
!!
Module CFML_IOForm
!---- Use modules ----!
Use CFML_GlobalDeps, only: CP, PI, EPS, TAB, Err_CFML, Clear_Error
Use CFML_GlobalDeps, only: SP, CP, PI, EPS, TAB, Err_CFML, Clear_Error
Use CFML_Maths, only: Get_Eps_Math
Use CFML_Rational
Use CFML_Strings, only: l_case, u_case, get_num, cut_string, get_words, &
......@@ -75,6 +75,7 @@ Module CFML_IOForm
!---- PARAMETERS ----!
!--------------------!
character(len=*), parameter :: DIGCAR="0123456789+-" ! Digit character and signs
integer, parameter :: MAX_PHASES=30 ! Number of Maximum Phases
real(kind=cp), parameter :: EPSV=0.0001_cp ! Small real value to be used for decisions
......@@ -122,6 +123,12 @@ Module CFML_IOForm
!---- Interface zone ----!
Interface
Module Subroutine Get_Job_Info(cfl,Job_info, i_ini,i_end)
type(File_Type), intent(in) :: cfl
type(job_info_type), intent(out) :: Job_info
integer, intent(in) :: i_ini, i_end
End Subroutine Get_Job_Info
Module Subroutine Read_Atom(Str, Atm)
character(len=*), intent(in) :: Str
class (Atm_Type), intent(out) :: Atm
......@@ -174,28 +181,32 @@ Module CFML_IOForm
real(kind=cp), intent(out) :: ratio
End Subroutine Read_Wavelength
Module Subroutine Read_CFL_Atoms(cfl, AtmList, Type_Atm, d)
Module Subroutine Read_CFL_Atoms(cfl, AtmList, Type_Atm, d, i_ini, i_end)
type(File_Type), intent(in) :: cfl
Type(AtList_Type), intent(out) :: AtmList
character(len=*), intent(in) :: Type_Atm
integer, intent(in) :: d
integer, optional, intent(in) :: i_ini, i_end
End Subroutine Read_CFL_Atoms
Module Subroutine Read_CFL_Cell(cfl, Cell, CFrame)
Module Subroutine Read_CFL_Cell(cfl, Cell, CFrame, i_ini, i_end )
type(File_Type), intent(in) :: cfl
class(Cell_Type), intent(out) :: Cell
character(len=*), optional, intent( in) :: CFrame
integer, optional, intent(in) :: i_ini, i_end
End Subroutine Read_CFL_Cell
Module Subroutine Read_CFL_KVectors(cfl, Kvec)
Module Subroutine Read_CFL_KVectors(cfl, Kvec, i_ini, i_end)
type(File_Type), intent(in) :: cfl
type(kvect_info_Type), intent(out) :: Kvec
integer, optional, intent(in) :: i_ini, i_end
End Subroutine Read_CFL_KVectors
Module Subroutine Read_CFL_SpG(cfl, SpG, xyz_type)
Module Subroutine Read_CFL_SpG(cfl, SpG, xyz_type, i_ini, i_end)
Type(File_Type), intent(in) :: cfl
class(SpG_Type), intent(out) :: SpG
character(len=*), optional, intent(in) :: xyz_type
integer, optional, intent(in) :: i_ini, i_end
End Subroutine Read_CFL_SpG
Module Subroutine Write_CFL_Atoms(AtmList, Lun, Cell)
......@@ -372,6 +383,16 @@ Module CFML_IOForm
type(atlist_type), intent(in) :: atmList
End Subroutine Write_SHX_Template
Module Subroutine Read_XTal_CFL(cfl, Cell, SpG, AtmList, Nphase, CFrame, Job_Info)
type(File_Type), intent(in) :: cfl
class(Cell_Type), intent(out) :: Cell
class(SpG_Type), intent(out) :: SpG
Type(AtList_Type), intent(out) :: Atmlist
Integer, optional, intent(in) :: Nphase
character(len=*), optional, intent(in) :: CFrame
Type(Job_Info_type), optional, intent(out) :: Job_Info
End Subroutine Read_XTal_CFL
Module Subroutine Read_XTal_SHX(shx, Cell, SpG, Atm)
type(File_Type), intent(in) :: shx
class (Cell_G_Type), intent(out) :: Cell
......@@ -431,6 +452,7 @@ Module CFML_IOForm
select case (trim(u_case(ext)))
case ('CFL')
call Read_XTal_CFL(f, Cell, SpG, Atm)
case ('CIF')
case ('INS','RES')
call Read_XTal_SHX(f, Cell, SpG, Atm)
......
This diff is collapsed.
......@@ -11,16 +11,16 @@ SubModule (CFML_IOForm) IO_CIF
!!----
!!---- 26/06/2019
!!
Module Subroutine Read_CIF_Atom(lines,n_ini,n_end, AtmList)
Module Subroutine Read_CIF_Atom(cif, AtmList, n_ini, n_end)
!---- Arguments ----!
character(len=*), dimension(:), intent(in) :: lines
integer, intent(in out) :: n_ini
integer, intent(in) :: n_end
type (atList_type), intent(out) :: AtmList
type(File_Type), intent(in) :: cif
type (atList_type), intent(out) :: AtmList
integer, optional, intent(in) :: n_ini, n_end
!---- Local Variables ----!
character(len=132), allocatable :: line
character(len=20),dimension(15) :: label
integer :: j_ini, j_end
integer :: i, j, n, nc, nct, nline, iv, First, nline_big,num_ini,mm
integer, dimension( 8) :: lugar ! 1 -> label
! 2 -> Symbol
......@@ -41,6 +41,7 @@ SubModule (CFML_IOForm) IO_CIF
!> Init
call clear_error()
call allocate_atom_list(0,AtmList,'Atm_std',0)
call allocate_atom_list(n_end-n_ini+1,Atm,'Atm_std',0)
......@@ -414,25 +415,46 @@ SubModule (CFML_IOForm) IO_CIF
!!----
!!---- Update: February - 2005
!!
Module Subroutine Read_CIF_Cell(lines,N_Ini,N_End,Cell)
Module Subroutine Read_CIF_Cell(cif, Cell, i_Ini, i_End)
!---- Arguments ----!
character(len=*), dimension(:), intent(in) :: lines ! Containing information
integer, intent(in out) :: n_ini ! Index to start
integer, intent(in) :: n_end ! Index to Finish
class(Cell_Type), intent(out) :: Cell ! Cell object
type(File_Type), intent(in) :: cif
class(Cell_Type), intent(out) :: Cell ! Cell object
integer, optional, intent(in) :: i_ini, i_end ! Index to start
!---- Local Variables ----!
integer :: iv,initl
real(kind=cp), dimension(1) :: vet1,vet2
real(kind=cp), dimension(6) :: vcell, std
logical :: ierror
integer :: i,npos,iv
integer, :: j_ini, j_end
real(kind=cp), dimension(1) :: vet1,vet2
real(kind=cp), dimension(6) :: vcell, std
logical :: ierror
character(len=132) :: line
!> Init
call clear_error()
if (cif%nlines <=0) then
err_CFML%Ierr=1
err_CFML%Msg="Read_CIF_Cell: 0 lines "
return
end if
j_ini=1; j_end=cif%nlines
if (present(i_ini)) j_ini=i_ini
if (present(i_end)) j_end=i_end
vcell=0.0_cp; std=0.0_cp
ierror=.false.
!> Celda
do i=j_ini,j_end
line=adjustl(cif%line(i)%str)
!> eliminar tabs
do
iv=index(lines,TAB)
if (iv == 0) exit
line(iv:iv)=' '
end do
initl=n_ini ! Preserve initial line => some CIF files have random order for cell parameters
call read_key_valueSTD(lines,n_ini,n_end,"_cell_length_a",vet1,vet2,iv)
if (iv == 1) then
......@@ -2096,6 +2118,135 @@ SubModule (CFML_IOForm) IO_CIF
End Subroutine Write_CIF_Template
!!--++
!!--++ Read_XTal_CIF
!!--++
!!--++ Read a CIF File
!!--++
!!--++ 11/05/2020
!!
Module Subroutine Read_XTal_CIF(cif, Cell, Spg, AtmList, Nphase, CFrame)
!---- Arguments ----!
type(File_Type), intent(in) :: cif
class(Cell_Type), intent(out) :: Cell
class(SpG_Type), intent(out) :: SpG
Type(AtList_Type), intent(out) :: Atmlist
Integer, optional, intent(in) :: Nphase ! Select the Phase to read
character(len=*), optional, intent(in) :: CFrame
!---- Local Variables ----!
character(len=132) :: line
character(len= 20) :: Spp
character(len=60), dimension(192) :: symm_car
integer :: i, nauas, ndata, iph, n_ini,n_end,noper
integer, parameter :: maxph=250 !Maximum number of phases "maxph-1"
integer, dimension(maxph) :: ip
real(kind=cp),dimension(6):: vet,vet2
ip=nlines
ip(1)=1
!---- First determine if there is more than one structure ----!
do i=1,nlines
line=adjustl(file_dat(i))
if (l_case(line(1:5)) == "data_" .and. l_case(line(1:11)) /= "data_global" ) then
n_ini=i
ip(1)=i
exit
end if
end do
ndata=0
do i=n_ini,nlines
line=adjustl(file_dat(i))
if (l_case(line(1:5)) == "data_") then
ndata=ndata+1
if (ndata > maxph-1) then
err_form=.true.
ERR_Form_Mess=" => Too many phases in this file "
return
end if
ip(ndata)=i !Pointer to the number of the line starting a single phase
end if
end do
iph=1
if (present(nphase)) iph=nphase
!---- Read Cell Parameters ----!
n_ini=ip(iph) !Updated values to handle non-conventional order
n_end=ip(iph+1)
call Read_Cif_Cell(file_dat,n_ini,n_end,vet,vet2)
if (err_form) return
if(present(CFrame)) then
call Set_Crystal_Cell(vet(1:3),vet(4:6),Cell,CFrame,vet2(1:3),vet2(4:6))
else
call Set_Crystal_Cell(vet(1:3),vet(4:6),Cell,"A",vet2(1:3),vet2(4:6))
end if
!---- Read Atoms Information ----!
n_ini=ip(iph) !Updated values to handle non-conventional order
n_end=ip(iph+1)
call Read_Cif_Atom(file_dat,n_ini,n_end,nauas,A)
if (err_form) return
!---- SpaceGroup Information ----!
n_ini=ip(iph) !Updated values to handle non-conventional order
n_end=ip(iph+1)
call Read_Cif_Hm(file_dat,n_ini,n_end,Spp)
n_ini=ip(iph) !Updated values to handle non-conventional order
n_end=ip(iph+1)
if (len_trim(Spp) == 0) call Read_Cif_Hall(file_dat,n_ini,n_end,Spp)
if (len_trim(Spp) == 0) then
n_ini=ip(iph) !Updated values to handle non-conventional order
n_end=ip(iph+1)
call Read_Cif_Symm(file_dat,n_ini,n_end,noper,symm_car)
if (noper ==0) then
err_form=.true.
ERR_Form_Mess=" => No Space Group/No Symmetry information in this file "
return
else
call Set_SpaceGroup(" ",SpG,symm_car,noper,"GEN")
end if
else
call Set_SpaceGroup(Spp,SpG) !Construct the space group
end if
!---- Modify occupation factors and set multiplicity of atoms
!---- in order to be in agreement with the definitions of Sfac in CrysFML
!---- Convert Us to Betas and Uiso to Biso
do i=1,A%natoms
vet(1:3)=A%atom(i)%x
A%atom(i)%Mult=Get_Multip_Pos(vet(1:3),SpG)
A%atom(i)%Occ=A%atom(i)%Occ*real(A%atom(i)%Mult)/max(1.0,real(SpG%Multip))
if(A%atom(i)%occ < epsv) A%atom(i)%occ=real(A%atom(i)%Mult)/max(1.0,real(SpG%Multip))
select case (A%atom(i)%thtype)
case ("isotr")
A%atom(i)%biso= A%atom(i)%ueq*78.95683521
case ("aniso")
select case (A%atom(i)%Utype)
case ("u_ij")
A%atom(i)%u(1:6) = Convert_U_Betas(A%atom(i)%u(1:6),Cell)
case ("b_ij")
A%atom(i)%u(1:6) = Convert_B_Betas(A%atom(i)%u(1:6),Cell)
end select
A%atom(i)%Utype="beta"
case default
A%atom(i)%biso = A%atom(i)%ueq*78.95683521
A%atom(i)%thtype = "isotr"
end select
end do
return
End Subroutine Readn_Set_XTal_CIF
End SubModule IO_CIF
\ No newline at end of file
......@@ -69,14 +69,8 @@ SubModule (CFML_IOForm) IO_GEN
!> Atom Type (Chemical symbol & Scattering Factor)
call cut_string(line,nlong1,label)
if (len_trim(magmom) == 0) then
n=index(DIGCAR,label(2:2))
if (n /=0) then
atm%chemsymb=u_case(label(1:1))
else
atm%chemsymb=u_case(label(1:1))//l_case(label(2:2))
end if
else
if ((trim(label) == trim(u_case(label)) .and. len_trim(label) > 1) .or. len_trim(magmom) > 0) then
!> Magnetic atom
n=index(DIGCAR,label(4:4))
if (u_case(label(1:1)) /= "M" .and. u_case(label(1:1)) /= "J") then
Err_CFML%IErr=1 ! Error
......@@ -84,6 +78,14 @@ SubModule (CFML_IOForm) IO_GEN
return
end if
atm%chemsymb=u_case(label(2:2))//l_case(label(3:3))
else
n=index(DIGCAR,label(2:2))
if (n /=0) then
atm%chemsymb=u_case(label(1:1))
else
atm%chemsymb=u_case(label(1:1))//l_case(label(2:2))
end if
end if
atm%SfacSymb=label(1:4)
......
This diff is collapsed.
......@@ -7,7 +7,7 @@
use CFML_Globaldeps
use CFML_Strings, only: File_type, u_case, Get_extension
use CFML_Metrics, only: Cell_G_Type, Write_Crystal_Cell
use CFML_gSpaceGroups, only: Spg_Type, Write_SpaceGroup_Info
use CFML_gSpaceGroups, only: Spg_Type, SuperSpaceGroup_Type, Write_SpaceGroup_Info
use CFML_Atoms, only: AtList_Type, Write_Atom_List
use CFML_IOForm
......@@ -57,17 +57,7 @@
!> Type of Files
ext=get_extension(cmdline)
select case (trim(u_case(ext)))
case ('INS','RES') ! Shelx Format
call Read_Xtal_Structure(trim(cmdline), Cell, Spg, Atm)
case ('CIF') ! CIF Format
case ('CFL') ! CFL Format
case ('PCR') ! PCR Format
case default
write(unit=*,fmt="(/,a)") " => The program IO_Files should be invoked with SHELX(INS or RES) or CIF or CFL format! "
call CloseProgram()
end select
call Read_Xtal_Structure(trim(cmdline), Cell, Spg, Atm)
!> Print Information
if (Err_CFML%Ierr == 0) then
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment