Commit 90e96df8 authored by juan rodriguez-carvajal's avatar juan rodriguez-carvajal
Browse files

Merge branch 'testing-fpm' into 'master'

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

See merge request !21
parents b852b9be 75f21341
Pipeline #12437 passed with stages
in 12 minutes and 5 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"
......
......@@ -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., &
......
......@@ -1756,7 +1756,7 @@
read(unit=txt,fmt=*, iostat=ier) alow(j),ahigh(j)
if(ier /= 0 ) then
Err_crys=.true.
write(unit=Err_crys_mess,fmt="(a,i3)"),"ERROR reading the excluded region number ",j
write(unit=Err_crys_mess,fmt="(a,i3)") "ERROR reading the excluded region number ",j
logi=.false.
return
end if
......
This diff is collapsed.
......@@ -40,8 +40,7 @@
Type(file_list_type), intent( in) :: file_cfl
!---- Local variables ----!
character(len=132) :: line
real :: w,tol
integer :: i,ier,j,nrel,i1,i2,i3,i4
integer :: i,ier,j,i1,i2,i3,i4
ier=0
Icost=0; wcost=0.0
......@@ -110,9 +109,7 @@
!---- Arguments ----!
integer, intent( in) :: lun
!---- Local variables ----!
character(len=132) :: line
real :: w,tol
integer :: i,ier
integer :: i
Write(unit=lun,fmt="(/,a)") "=================================="
......@@ -157,8 +154,6 @@
!---- Arguments ----!
integer, intent( in) :: lun
!---- Local variables ----!
character(len=132) :: line
real :: w,tol
integer :: i,iset
......@@ -225,7 +220,7 @@
!---- Arguments ----!
!---- Local variables ----!
integer :: i,ic, nop, numv, iset
integer :: i,ic, numv, iset
integer, dimension(1) :: List
if(allocated(Pcost)) deallocate(Pcost)
......@@ -479,12 +474,12 @@ Subroutine Write_SOL_mCFL(lun,file_cfl,mA,Mag_dom,comment)
character(len=*),optional,intent(in) :: comment
!----- Local variables -----!
integer :: j,i,n,ier
integer :: i,n,ier
integer :: num_matom,num_skp,num_dom,ik,im,ip
real,dimension(3) :: Rsk,Isk
real(kind=cp),dimension(12) :: coef
real(kind=cp) :: Ph
character(len=132) :: lowline,line
character(len=132) :: lowline
character(len=30) :: forma
logical :: skp_begin, bfcoef_begin, magdom_begin=.true.
......
......@@ -30,15 +30,15 @@ Program Optimizing_MagStructure
! type (Atom_list_Type) :: A
character(len=256) :: filcod !Name of the input file
character(len=256) :: filhkl !Name of the hkl-file
character(len=256) :: filrest !Name of restraints file
!character(len=256) :: filhkl !Name of the hkl-file
!character(len=256) :: filrest !Name of restraints file
character(len=256) :: line !Text line
character(len=256) :: fst_cmd !Commands for FP_Studio
integer :: Num, ier,i,j,k,n, i_cfl, nln
!character(len=256) :: fst_cmd !Commands for FP_Studio
integer :: i,n, i_cfl
real :: start,fin
integer :: narg,iargc, n_ini,n_end
Logical :: esta, arggiven=.false.,sthlgiven=.false., &
fst_out=.false., local_opt=.false., rest_file=.false.
integer :: narg,n_ini,n_end
Logical :: esta, arggiven=.false. !fst_out=.false.,sthlgiven=.false.
! local_opt=.false. , rest_file=.false.
!---- Arguments on the command line ----!
narg=COMMAND_ARGUMENT_COUNT()
......@@ -218,10 +218,10 @@ End Program Optimizing_MagStructure
Subroutine Write_FST(fst_file,v,cost) ! Is not used here, needed for CFML_optimization_san from libcrysfml
!---- Arguments ----!
use CFML_String_Utilities, only: get_logunit
use CFML_Keywords_Code_Parser, only: VState_to_AtomsPar
use CFML_Atom_TypeDef, only: atom_type, atom_list_type
use CFML_crystal_Metrics, only: Crystal_Cell_Type
use CFML_String_Utilities, only: get_logunit
use CFML_Keywords_Code_Parser, only: VState_to_AtomsPar
use CFML_Atom_TypeDef, only: atom_type, atom_list_type
use CFML_crystal_Metrics, only: Crystal_Cell_Type
use CFML_crystallographic_symmetry, only: space_group_type
character(len=*), intent(in):: fst_file
......@@ -229,7 +229,7 @@ Subroutine Write_FST(fst_file,v,cost) ! Is not used here, needed for CFML_optimi
real, intent(in):: cost
!----- Local variables -----!
type(Atom_Type) :: atom
!type(Atom_Type) :: atom
type (Atom_list_Type) :: A
type (Crystal_Cell_Type) :: Cell
type (space_group_type) :: SpG
......@@ -238,6 +238,8 @@ Subroutine Write_FST(fst_file,v,cost) ! Is not used here, needed for CFML_optimi
character(len=132) :: file_fst,fst_cmd
character(len=30), dimension(10) :: cmds
if(v(1) == 1.23456 .or. cost == v(2)) write(unit=*,fmt="(a)") " => This is nothing else that to avoid warnings!"
i=index(fst_file,".fst")
file_fst=fst_file(1:i+3)
fst_cmd=adjustl(fst_file(i+4:))
......
......@@ -150,11 +150,11 @@ contains
character(len=256) :: title,formt
character(len=256) :: lowline
character(len=1) :: sig
integer :: ier,ic,num_k,m,ih,ik,il,ncont,iv,i,j,ityp,ipow,ip,iset,&
integer :: ier,ic,num_k,m,ih,ik,il,ncont,iv,i,j,ityp,ipow,iset,&
iobs,ind,nd
integer :: n_ini, n_end
real,allocatable,dimension(:,:):: vk
real :: Gobs,SGobs,lambda,k11,k22,k12,kdif,k0(3)
real :: lambda,k11,k22,k12,kdif,k0(3)
logical :: kvect_begin=.true.
Nset=0; MNset=0; Npol=0
......@@ -673,7 +673,7 @@ contains
!---- Local variables ----!
integer :: ih,ik,il,m,ier
logical :: pesta, argtaken=.false.
logical :: pesta
real :: vpl, pol
inquire(file=trim(datfile),exist=pesta)
......@@ -707,11 +707,10 @@ contains
!---- Local variables ----!
character(len=256) :: title,formt,lambda
character(len=1) :: sig
integer :: ier,num_k,m,ih,ik,il,ncont,i,ityp,ipow
real, dimension(3) :: vk
real :: Gobs,SGobs
logical :: pesta, argtaken=.false.
logical :: pesta
inquire(file=trim(datfile),exist=pesta)
if( .not. pesta) then
......@@ -756,10 +755,9 @@ contains
!---- Local variables ----!
character(len=256) :: title,formt,lambda
character(len=1) :: sig
integer :: ier,num_k,m,ih,ik,il,ncont,i,ityp,ipow
integer :: ier,ih,ik,il,ncont,ityp,ipow
real :: Gobs,SGobs
logical :: pesta, argtaken=.false.