Updating files for I/O formats in src08

parent 2be22c2f
Pipeline #7344 failed with stages
in 7 minutes and 4 seconds
......@@ -244,11 +244,11 @@
!!--..
!!
Type, Public :: AtList_Type
integer :: natoms=0 ! Number of atoms in the list
integer :: natoms=0 ! Number of atoms in the list
character(len=9) :: mcomp="Crystal" ! For magnetic moments and modulation functions Mcs and Dcs It may be also "Cartesian" or "Spherical"
logical :: symm_checked=.false.
logical, dimension(:), allocatable :: Active ! Flag for active or not
class(Atm_Type), dimension(:), allocatable :: Atom ! Atoms
logical, dimension(:), allocatable :: Active ! Flag for active or not
class(Atm_Type), dimension(:), allocatable :: Atom ! Atoms
End type AtList_Type
!Overload
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -279,7 +279,7 @@ Submodule (CFML_Strings) StrTools
extension=" "
else
!> Handle the optional dotted argument.
dot=.true.
dot=.false.
if (present(dotted)) dot=dotted
if (.not. dot) idx = idx + 1
......
This diff is collapsed.
This diff is collapsed.
!!----
!!----
!!----
!!----
Program Test_CIF_CFL
!---- Use Modules ----!
use CFML_Globaldeps
!use CFML_Symmetry_Tables
use CFML_Metrics
use CFML_Maths
use CFML_gSpaceGroups
use CFML_Rational
use CFML_IOForm
use CFML_Atoms
use CFML_Strings,only: File_type,Set_Symb_From_Mat !pack_string
!use Test_CIF
implicit none
character(len=256) :: fname,filename
character(len=256) :: setting,ctr_code
character(len=256),dimension(26) :: tctr_code
character(len=:),allocatable :: forma,formb,cmdline
type(Cell_G_Type) :: Cell,Celln
!type(Spg_Type) :: Grp
type(AtList_Type) :: Atm
type(File_type) :: flist
type(SuperSpaceGroup_Type) :: Grp
!type(rational), dimension(:,:),allocatable :: Mat
!character(len=40),dimension(:,:),allocatable :: matrix
integer :: i, j, L,k, d,Dd,nsg, ind, indexg, num_group, ier,mult,codini,narg,len_cmdline
real(kind=cp) :: start, fin
real(kind=cp), dimension(:,:),allocatable :: orb,morb
real(kind=cp), dimension(3) :: codes=1.0
real(kind=cp), dimension(:,:),allocatable :: codeT
integer, dimension(:), allocatable :: ptr
narg=COMMAND_ARGUMENT_COUNT()
cmdline=" "
len_cmdline=0
if(narg > 0) then
call GET_COMMAND_ARGUMENT(1,cmdline)
len_cmdline=len_trim(cmdline)
else
write(unit=*,fmt="(a)") " => The program Test_CIF_CFL should be invoked as: cif xxx.cfl ! "
call CloseProgram()
end if
call Set_Eps_Math(0.0002_cp)
if(len_cmdline == 0) then
write(*,'(/,a)',advance='no') " => Introduce the name of the CFL file: "
read(*,"(a)") fname
else
fname=cmdline
len_cmdline=0
end if
if(len_trim(fname) == 0) call CloseProgram()
call CPU_TIME(start)
call Readn_Set_Xtal_Structure(fname,Cell,Grp,Atm,"MAtm_std","CFL")!,file_list=flist) !,Iphase,Job_Info,file_list,CFrame)
if(Err_CFML%Ierr == 0) then
!write(*,"(/,a,/)") " => Content of the CFL-file: "//flist%Fname
!do i=1,flist%nlines
! write(*,"(i6,a)") i," "//flist%line(i)%Str
!end do
call Write_Crystal_Cell(Cell)
if(len_trim(Grp%setting) /= 0) then
write(*,"(/,a)") " => Transformed Cell"
if(Grp%D > 4) then
i=index(Grp%setting,"d")
setting=Grp%setting(1:d-2)//";0,0,0"
else
setting=Grp%setting
end if
call Change_Setting_Cell(Cell,setting,Celln)
call Write_Crystal_Cell(Celln)
end if
call Write_SpaceGroup_Info(Grp)
i=index(fname,".")
filename=fname(1:i)//"cif"
call Write_Cif_Template(filename, Cell, Grp, Atm, 2, "Testing WriteCIF")
if(Atm%natoms > 0) then
!First Check symmetry constraints in magnetic moments and Fourier coefficients
!call Check_Symmetry_Constraints(Grp,Atm)
write(*,"(//a,i5)") " Number of atoms:",Atm%natoms
call Write_Atom_List(Atm,SpG=Grp)
!Calculate all atoms in the unit cell
forma="(i5, f10.5,tr8, f10.5,i8)"
formb="(a, i3,a,6f10.5,a)"
write(unit=formb(4:4),fmt="(i1)") Grp%nk
write(forma(5:5),"(i1)") Grp%d-1
write(forma(16:16),"(i1)") Grp%d-1
write(*,"(//a)") " Orbits of atoms after applying constraints on moments:"
write(*,"( a)") " ======================================================"
do i=1,Atm%natoms
!codini=1; codes=1.0
call Get_moment_ctr(Atm%Atom(i)%x,Atm%Atom(i)%moment,Grp,codini,codes,ctr_code=ctr_code)!,Ipr=6)
write(*,"(a,3f10.5,a)") " => Moment of atom "//trim(Atm%Atom(i)%Lab)//": ",Atm%Atom(i)%moment," CtrCode: "//trim(ctr_code)
call Get_Orbit(Atm%Atom(i)%x,Grp,Mult,orb,Atm%Atom(i)%moment,morb,ptr)
write(*,"(a)") " => Orbit of atom: "//trim(Atm%Atom(i)%Lab)
Select Case(Grp%d-1)
Case(3)
write(*,"(a)") " N X Y Z Mx My Mz PointoOP"
Case(4)
write(*,"(a)") " N X1 X2 X3 X4 M1 M2 M3 M4 PointoOP"
Case(5)
write(*,"(a)") " N X1 X2 X3 X4 X5 M1 M2 M3 M4 M5 PointoOP"
Case(6)
write(*,"(a)") " N X1 X2 X3 X4 X5 X6 M1 M2 M3 M4 M5 M6 PointoOP"
End Select
do j=1,Mult
write(*,forma) j,orb(:,j),morb(:,j),ptr(j)
end do
Select Type(at => Atm%Atom(i))
class is (MAtm_Std_Type)
write(*,"(a)") " => Modulation amplitudes of atom: "//trim(Atm%Atom(i)%Lab)
if(allocated(CodeT)) deallocate(CodeT)
allocate(CodeT(6,at%n_mc))
CodeT=1.0
call Get_TFourier_Ctr(At%x,At%Mcs(:,1:at%n_mc),codeT,Grp,codini,"M",ctr_code=tctr_code)
do j=1,At%n_mc
write(*,formb) " Mcs: [",Grp%Q_coeff(:,j),"]",At%Mcs(:,j)," CtrCode: "//trim(tctr_code(j))
end do
if(allocated(CodeT)) deallocate(CodeT)
allocate(CodeT(6,at%n_dc))
CodeT=1.0
call Get_TFourier_Ctr(At%x,At%Dcs(:,1:at%n_dc),codeT,Grp,codini,"D",ctr_code=tctr_code)
do j=1,At%n_dc
write(*,formb) " Dcs: [",Grp%Q_coeff(:,j),"]",At%Dcs(:,j)," CtrCode: "//trim(tctr_code(j))
end do
end select
end do
end if
else
write(*,'(/,a)') " => ERROR: "//trim(Err_CFML%Msg)
end if
call CPU_TIME(fin)
write(*,"(/,a,f12.3,a)") "CPU_TIME for this calculation: ",fin-start," seconds"
contains
Subroutine CloseProgram()
character(len=1) :: ans
write(unit=*,fmt="(a)") " "
write(unit=*,fmt="(a)") " => Press <cr> to finish ...."
read(unit=*,fmt="(a)") ans
stop
End Subroutine CloseProgram
End Program Test_CIF_CFL
\ No newline at end of file
This diff is collapsed.
......@@ -431,16 +431,17 @@ rem Submodules CFML_Reflections
cd ..
rem
echo .... Propagation vectors procedures
ifort /c CFML_Propagk.f90 /nologo %OPT1% %OPT2% /module:.\mod
ifort /c CFML_Propagk.f90 /nologo %OPT1% %OPT2% /module:.\mod
rem
echo .... I/O Formats procedures
ifort /c CFML_IOForm.f90 /nologo %OPT1% %OPT2% /module:.\mod
ifort /c CFML_IOForm.f90 /nologo %OPT1% %OPT2% /module:.\mod
rem
rem Submodules CFML_IOForm
cd .\CFML_IOForm
ifort /c Format_GEN.f90 /nologo %OPT1% %OPT2% /module:..\mod
ifort /c Format_SHX.f90 /nologo %OPT1% %OPT2% /module:..\mod
ifort /c Format_CIF.f90 /nologo %OPT1% %OPT2% /module:..\mod
ifort /c Format_CFL.f90 /nologo %OPT1% %OPT2% /module:..\mod
rem ifort /c Format_CIF.f90 /nologo %OPT1% %OPT2% /module:..\mod
rem ifort /c Format_SHX.f90 /nologo %OPT1% %OPT2% /module:..\mod
move /y *.obj .. > nul
cd ..
goto END
......@@ -506,8 +507,8 @@ rem
copy .\mod\*.smod ..\%DIRECTORY%\LibW08\. > nul
move *.lib ..\%DIRECTORY%\LibW08\. > nul
) else (
rem if exist ..\%DIRECTORY%\LibC08\ rmdir ..\%DIRECTORY%\LibC08\ /S /Q
rem mkdir ..\%DIRECTORY%\LibC08\
if exist ..\%DIRECTORY%\LibC08\ rmdir ..\%DIRECTORY%\LibC08\ /S /Q
mkdir ..\%DIRECTORY%\LibC08\
copy .\mod\*.mod ..\%DIRECTORY%\LibC08\. > nul
copy .\mod\*.smod ..\%DIRECTORY%\LibC08\. > nul
move *.lib ..\%DIRECTORY%\LibC08\. > nul
......
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