Commit 75f21341 authored by juan rodriguez-carvajal's avatar juan rodriguez-carvajal
Browse files

Modifications for working with Fortran Package Manager. Elimination of unused...

Modifications for working with Fortran Package Manager. Elimination of unused variables in many programs of the Program_Examples directory.
parent 8552ae77
Pipeline #12436 passed with stages
in 13 minutes and 21 seconds
......@@ -618,8 +618,7 @@ Program Bond_Str
end if
if (.not. cif .and. bvs_calc .and. .not. map_calc .and. .not. bvel_calc ) then
call system("type "//trim(filcod)//"_sum.bvs")
!call execute_command_line ("type "//trim(filcod)//"_sum.bvs")
call execute_command_line ("more "//trim(filcod)//"_sum.bvs")
end if
write(unit=*,fmt="(/,a)") " => Normal End of: PROGRAM BOND_STR "
write(unit=*,fmt="(a)") " => Global results in File: "//trim(filcod)//".bvs"
......
!!----
!!---- CRYSTALLOGRAPHIC CALCULATOR
!!---- Version:1.00
!!---- Oct-2002
!!----
!!---- Authors: Juan Rodriguez-Carvajal
!!---- Javier Gonzalez-Platas
!!----
!!
Program CrysCalc_con
!---- Use files ----!
use Menu_0
use Menu_1
use Menu_2
use Menu_3
use Menu_4
use Menu_5
use CFML_IO_Messages, only: Wait_Message
!---- Variables ----!
implicit none
character (len=2):: car
if(OPS == 1) clear_string="cls" !Change for Windows
!---- Menu Principal ----!
open(unit=i_out,file=fileout,status="unknown",action="write",position="append")
write(unit=i_out,fmt="(a)") " LOG-file of the program: CrysCalCon"
write(unit=i_out,fmt="(a)") " ==================================="
call Write_Date_Time(i_out)
write(unit=i_out,fmt="(a)") " "
do
call system(clear_string)
write(unit=*,fmt="(a)") " "
write(unit=*,fmt="(a)") " GENERAL CRYSTALLOGRAPHY CALCULATOR "
write(unit=*,fmt="(a)") " "
write(unit=*,fmt="(a)") " Principal Menu "
write(unit=*,fmt="(a)") " ======================"
write(unit=*,fmt="(a)") " "
write(unit=*,fmt="(a)") " "
write(unit=*,fmt="(a)") " [0] Exit"
write(unit=*,fmt="(a)") " "
write(unit=*,fmt="(a)") " [1] Space Groups"
write(unit=*,fmt="(a)") " [2] Reflections"
write(unit=*,fmt="(a)") " [3] Atomistics Calculations"
write(unit=*,fmt="(a)") " [4] Chemical Information"
write(unit=*,fmt="(a)") " [5] Geometry calculations"
write(unit=*,fmt="(a)") " "
write(unit=*,fmt="(a)",advance="no") " OPTION: "
read(unit=*,fmt="(a)") car
if (len_trim(car) == 0) exit
car=adjustl(car)
select case (car)
case ("0 ")
exit
case ("1 ")
call Menu_Princ1()
case ("2 ")
call Menu_Princ2()
case ("3 ")
call Menu_Princ3()
case ("4 ")
call Menu_Princ4()
case ("5 ")
call Menu_Princ5()
end select
end do
close(unit=i_out)
call Wait_Message(" => Press <enter> to close the program ...")
call system(clear_string)
End Program CrysCalc_con
!!----
!!---- CRYSTALLOGRAPHIC CALCULATOR
!!---- Version:1.00
!!---- Oct-2002
!!----
!!---- Authors: Juan Rodriguez-Carvajal
!!---- Javier Gonzalez-Platas
!!----
!!
Program CrysCalc_con
!---- Use files ----!
use Menu_0
use Menu_1
use Menu_2
use Menu_3
use Menu_4
use Menu_5
use CFML_IO_Messages, only: Wait_Message
!---- Variables ----!
implicit none
character (len=2):: car
if(OPS == 1) clear_string="cls" !Change for Windows
!---- Menu Principal ----!
open(unit=i_out,file=fileout,status="unknown",action="write",position="append")
write(unit=i_out,fmt="(a)") " LOG-file of the program: CrysCalCon"
write(unit=i_out,fmt="(a)") " ==================================="
call Write_Date_Time(i_out)
write(unit=i_out,fmt="(a)") " "
do
call execute_command_line(clear_string)
write(unit=*,fmt="(a)") " "
write(unit=*,fmt="(a)") " GENERAL CRYSTALLOGRAPHY CALCULATOR "
write(unit=*,fmt="(a)") " "
write(unit=*,fmt="(a)") " Principal Menu "
write(unit=*,fmt="(a)") " ======================"
write(unit=*,fmt="(a)") " "
write(unit=*,fmt="(a)") " "
write(unit=*,fmt="(a)") " [0] Exit"
write(unit=*,fmt="(a)") " "
write(unit=*,fmt="(a)") " [1] Space Groups"
write(unit=*,fmt="(a)") " [2] Reflections"
write(unit=*,fmt="(a)") " [3] Atomistics Calculations"
write(unit=*,fmt="(a)") " [4] Chemical Information"
write(unit=*,fmt="(a)") " [5] Geometry calculations"
write(unit=*,fmt="(a)") " "
write(unit=*,fmt="(a)",advance="no") " OPTION: "
read(unit=*,fmt="(a)") car
if (len_trim(car) == 0) exit
car=adjustl(car)
select case (car)
case ("0 ")
exit
case ("1 ")
call Menu_Princ1()
case ("2 ")
call Menu_Princ2()
case ("3 ")
call Menu_Princ3()
case ("4 ")
call Menu_Princ4()
case ("5 ")
call Menu_Princ5()
end select
end do
close(unit=i_out)
call Wait_Message(" => Press <enter> to close the program ...")
call execute_command_line(clear_string)
End Program CrysCalc_con
......@@ -97,16 +97,15 @@
End Subroutine Menu_Princ1
!!----
!!---- Subroutine Menu_SPGR_1
!!----
!!
Subroutine Menu_Spgr_1()
!---- Local Variables ----!
character(len=20) :: line, spgr
integer :: i, iv, ierr, npos
integer, dimension(1) :: ivet
real(kind=cp), dimension(1) :: vet
character(len=20) :: line
type (Space_Group_Type):: grp_espacial
do
......@@ -138,21 +137,19 @@
end do
End Subroutine Menu_Spgr_1
!!----
!!---- Subroutine Menu_SPGR_2
!!----
!!
Subroutine Menu_Spgr_2()
!---- Local Variables ----!
character(len=20) :: line, spgr
character(len=20) :: line !, spgr
character(len=40) :: str
character(len=80), dimension(96) :: texto
integer :: i, iv, ierr, lun, nlines, npos
integer, dimension(1) :: ivet
real(kind=cp), dimension(1) :: vet
integer :: i, lun, nlines
type (Space_Group_type) :: grp_espacial
do
......@@ -231,18 +228,15 @@
!!
Subroutine Menu_Spgr_3()
!---- Local Variables ----!
character (len=80) :: line
!character (len=80) :: line
character (len=1) :: ans
character (len=30) :: spgr, spg, str
character (len=30) :: spgr
character (len=30), dimension(10) :: gen
character (len=140) :: gener
integer, dimension(3,3,24) :: ss
integer :: ng,i,istart,nlines,ier
integer :: ng,i,istart
real(kind=cp), dimension(3,24) :: ts
type (Space_Group_type) :: grp_espacial
type (Space_Group_type) :: grp_espacial
do
......@@ -331,13 +325,13 @@
!!
Subroutine Menu_Spgr_4()
!---- Local Variables ----!
character (len=80) :: line
!character (len=80) :: line
character (len=1) :: ans
character (len=30) :: spgr, spg, str
character (len=30) :: spgr
character (len=16) :: hall
character (len=30), dimension(10) :: gen
character (len=140) :: gener
integer :: ng,i,istart,nlines,ier
integer :: ng,i,istart
type (Space_Group_type) :: grp_espacial
do
......@@ -426,13 +420,13 @@
!!
Subroutine Menu_Spgr_5()
!---- Local Variables ----!
character (len=80) :: line,spg
character (len=80) :: line
character (len=20) :: spgr
character (len= 1) :: car
character (len=30), dimension(10) :: gen
character (len=140) :: gener
integer :: i, ng, istart, npos, iv, ierr
integer :: i, ng, istart, npos, iv
integer, dimension(1) :: ivet
integer, dimension(3,3,24) :: ss
integer, parameter :: num_spgr_info=612
......@@ -737,14 +731,13 @@
!!
Subroutine Menu_Spgr_7()
!---- Local Variables ----!
character (len=80) :: line,simbolo,symb
character (len=12) :: spgr,spg
character (len=80) :: simbolo,symb
character (len=12) :: spgr
character (len= 1) :: ans
character (len=30), dimension(10) :: gen
character (len=140) :: gener
integer, dimension(3,3,24) :: ss
integer :: ng,i,istart,ier
integer :: ng,i,istart
real(kind=cp), dimension(3,24) :: ts
......@@ -829,7 +822,7 @@
!!
Subroutine Menu_Spgr_8()
!---- Local Variables ----!
character(len=20) :: spgr, cmd
character(len=20) :: spgr
character(len=35) :: Appl_trs, IAppl_trs
type (Space_Group_type) :: grp_espacial, grp_modified
......@@ -1033,9 +1026,8 @@
!!
Subroutine Menu_Spgr_10()
!---- Local Variables ----!
character(len=40) :: line, spgr
character(len=3) :: car
integer :: i
character(len=40) :: line !, spgr
!character(len=3) :: car
type (Space_Group_Type):: grp_espacial
call Set_Spgr_Info()
......@@ -1077,8 +1069,8 @@
Subroutine Menu_Spgr_11()
!---- Local Variables ----!
character(len=40) :: line, spgr
character(len=3) :: car
integer :: i,ier
!character(len=3) :: car
integer :: ier
type (Space_Group_Type):: grp_espacial
call Set_Spgr_Info()
......@@ -1141,7 +1133,7 @@
integer :: iunit, num_orbita, nvar, npos, num_old, nzeros
integer :: nx,ny,nz
integer,dimension(3) :: ix,ix1,ix2,ix11,ix22
integer,dimension(3,3) :: w,w1
integer,dimension(3,3) :: w
real(kind=cp),dimension(3) :: t,t1,ts,ts1,ts2,x,x1,x2
type(wyckoff_type) :: Wyck1
type(wyck_pos_type) :: wyckpos
......@@ -1516,7 +1508,7 @@
integer, dimension(3), intent(out) :: Ix
!---- Local Variables ----!
integer :: i,j,k
integer :: i,j
integer,dimension(3,3) :: w
t=0.0
......@@ -1541,13 +1533,11 @@
!!
Subroutine Menu_Spgr_12()
!---- Local Variables ----!
character(len=80) :: line,line2
character(len=20) :: spgr
integer :: i, j,iv, ierr, npos
character(len=80) :: line
integer :: i, iv
integer, dimension(3) :: ivet
integer, dimension(3,3) :: w
real(kind=cp), dimension(3) :: vet,orig,t1,t2,t3
real(kind=cp), dimension(3,3) :: p, p_inv,w1,w2
real(kind=cp), dimension(3) :: vet,orig
real(kind=cp), dimension(3,3) :: p
type (Space_Group_Type) :: grp1,grp3
type (NS_Space_Group_Type) :: grp2
......
......@@ -83,10 +83,8 @@
Subroutine Menu_Refl_1()
!---- Local Variables ----!
character(len=20) :: line, spgr
integer :: i, iv, ierr, npos
integer, dimension(1) :: ivet
integer :: ierr
integer, dimension(3) :: h,k
real(kind=cp), dimension(1) :: vet
type (Space_Group_type) :: grp_espacial
do
......@@ -131,12 +129,10 @@
Subroutine Menu_Refl_2()
!---- Local Variables ----!
logical :: info
character(len=20) :: spgr,line
character(len=20) :: line
integer, dimension(3) :: h,k,nulo
integer, dimension(1) :: ivet
integer :: i,j,num,iv,ierr,npos
real(kind=cp) :: fase,fase1,fase2
real(kind=cp), dimension(1) :: vet
integer :: i,j,num
real(kind=cp) :: fase,fase1
type (Space_Group_type) :: grp_espacial
type (Reflection_type),allocatable, dimension(:) :: reflexiones
......@@ -213,11 +209,8 @@
Subroutine Menu_Refl_3()
!---- Local Variables ----!
logical :: info
character(len=20) :: line, spgr
integer :: i, iv, ierr, npos
integer, dimension(1) :: ivet
integer, dimension(3) :: h,k,nulo
real(kind=cp), dimension(1):: vet
character(len=20) :: line
integer, dimension(3) :: h,nulo
type (Space_Group_type) :: grp_espacial
nulo=0
......@@ -272,12 +265,10 @@
subroutine Menu_REFL_4()
!---- Local Variables ----!
logical :: info
character(len=20) :: spgr,line
character(len=20) :: line
integer, dimension(3) :: h,k,l,nulo
integer, dimension(1) :: ivet
integer :: i,j,num,iv,ierr,npos
integer :: i,j,num
real(kind=cp) :: fase,fase1,fase2
real(kind=cp), dimension(1) :: vet
type (Space_Group_type) :: grp_espacial
type (Reflection_type),allocatable, dimension(:) :: reflexiones
......@@ -363,16 +354,14 @@
!!
Subroutine Menu_Refl_5()
!---- Local Variables ----!
logical :: info
character(len=20) :: spgr,line
character(len=80) :: name_file
integer, dimension(3) :: h,k,l,nulo
integer, dimension(1) :: ivet
integer :: i,j,num,iv,ierr,npos
real(kind=cp) :: fase,fase1,fase2,val1,val2
real(kind=cp), dimension(1) :: vet
real(kind=cp), dimension(3) :: celda, angulo
type (Space_Group_type) :: grp_espacial
logical :: info
character(len=20) :: line
character(len=80) :: name_file
integer, dimension(3) :: nulo
integer :: i,num
real(kind=cp) :: val1,val2
real(kind=cp), dimension(3) :: celda, angulo
type (Space_Group_type) :: grp_espacial
type (Reflect_type),allocatable, dimension(:) :: reflexiones
type (Crystal_Cell_type) :: celdilla
......@@ -442,12 +431,9 @@
subroutine Menu_REFL_6()
!---- Local Variables ----!
logical :: info
character(len=20) :: spgr,line
integer, dimension(3) :: h,k,l,nulo
integer, dimension(1) :: ivet
character(len=20) :: line
integer, dimension(3) :: h,nulo
integer :: mul
integer :: i,j,iv,ierr,npos
real(kind=cp), dimension(1) :: vet
type (Space_Group_type) :: grp_espacial
nulo=0
......
......@@ -87,13 +87,13 @@
!!----
!!
Subroutine Menu_Atom_1()
!---- Local Variables ----!
character(len=30) :: line
character(len=20) :: spgr
integer :: i, iv, ierr, mlt
integer :: iv, mlt
integer, dimension(3) :: ivet
real(kind=cp) :: occ
real(kind=cp), dimension(3):: vet,xp
real(kind=cp), dimension(3):: vet
type (Space_Group_type) :: grp_espacial
do
......@@ -232,8 +232,6 @@
!!----
!!
Subroutine Menu_Atom_3()
!---- Local Variables ----!
integer :: i
call execute_command_line(clear_string)
write(unit=*,fmt="(a)") " "
......@@ -281,7 +279,7 @@
Subroutine Menu_Atom_4()
!---- Local Variables ----!
integer :: i,j,Mult,m ,la,lb,lc,lam,lbm,lcm,np,nm
integer :: i,j,Mult,m,lam,lbm,lcm,np,nm
real(kind=cp) :: q, qp,pol,ang,ncell,dist,polc
real(kind=cp), dimension(3) :: pos,cpos,r_frac, r_pol,r_plus,r_minus,dir_pol
real(kind=cp), dimension(3,384):: orb !increased to take into account the surface atoms
......@@ -472,8 +470,7 @@
Subroutine Menu_Atom_5()
!---- Local Variables ----!
character(len=132) :: filnopol
integer :: i,j,Mult,m ,la,lb,lc,lam,lbm,lcm,np,nm
integer :: i,j,Mult,m,lam,lbm,lcm,np,nm
real(kind=cp) :: q, qp,pol,ang,ncell,dist,polc
real(kind=cp), dimension(3) :: pos,cpos,r_frac, r_pol,r_plus,r_minus,dir_pol
real(kind=cp), dimension(3,384):: orb !increased to take into account the surface atoms
......
......@@ -70,7 +70,7 @@
Subroutine Menu_Chem_1()
!---- Local Variables ----!
character(len=20) :: line
integer :: i, j, n, iv, ierr, npos
integer :: i, j, n, iv, npos
integer, dimension(1) :: ivet
real(kind=cp), dimension(1) :: vet
......
......@@ -827,8 +827,8 @@
integer, dimension(3,8):: hb
real(kind=cp),dimension(:),allocatable :: angles
integer, dimension(:),allocatable :: ii,jj,nang
integer, dimension(3) :: u,h,hi2,ho2,hi4,ho4
real(kind=cp) :: n_max,angle,mv1,mv2,mv3,mv4, tol, a13,a14,a23,a24, &
integer, dimension(3) :: h,hi2,ho2,hi4,ho4
real(kind=cp) :: n_max,angle,mv1,mv2,mv3,mv4, tol, a13,a23, &
a1,a2,a3,a4, mu,mv,rf, rmin
integer :: i,j,k,nedges,n,msol,nsol, nbest,neq
Type(Zone_Axis_Type) :: Zone_Axis
......@@ -1334,7 +1334,7 @@
real(kind=cp), dimension(:),allocatable :: angs,angles
integer, dimension(:),allocatable :: ii,jj,nn,nang,nl
integer, dimension(:,:),allocatable :: p
integer, dimension(3) :: u,h,h1,h2,h3,h4,hi,ho
integer, dimension(3) :: h,h1,h2,h3,h4,hi,ho
real(kind=cp) :: n_max,angle,mu,mv, tol
integer :: i,j,k,nedges,n,msol,nsol,k1,k2
Type(Zone_Axis_Type) :: Zone_Axis
......@@ -1595,7 +1595,6 @@
!---- Local variables ----!
integer :: i1,i2,n,i,j
real(kind=cp) :: smax,rm,rm1,rm2
real(kind=cp) :: cosgam,cos2,singam
integer, dimension(3) :: h
real(kind=cp),dimension(3,3):: mat,mg
integer, dimension(:,:), allocatable :: cp_ind
......@@ -1683,10 +1682,10 @@
Character(len=*), optional, intent(in) :: Mode
!---- Local variables ----!
integer :: i1,i2,nref,n,ii,jj,j,k,iv
real(kind=cp) :: d,rm,rm1,rm2,rm3,ri,rj,s,smax
integer :: i1,i2,j,iv
real(kind=cp) :: rm1,rm2,rm3,smax
real(kind=cp) :: deter,cosgam,cos2,singam,cosbet,cost,vrec,anglp
real(kind=cp), dimension(3) :: h,u3,r,r1,r2
real(kind=cp), dimension(3) :: u3,r1,r2
real(kind=cp), dimension(3,3) :: uc,b,tinv,mat
real(kind=cp), parameter, dimension(3,16) :: rmore=reshape( (/1.,0.,0., 0.,1.,0., 0.,0.,1., 1.,1.,0., 1.,0.,1., &
0.,1.,1., -1.,1.,0., -1.,0.,1., 0.,-1.,1., 1.,1.,1., &
......