Commit d0706224 authored by giannozz's avatar giannozz

Version number centralized in Modules/version.f90, updated to 1.3.0

Auxiliary programs in pwtools/: equation of state (ev.x),
distances/angles (dist.x), k-point generation (kpoints.x).
D3 fixes (maybe). Misc cleanup.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@291 c92efa57-630b-4861-b058-cf58834340f0
parent a042e7a1
......@@ -577,11 +577,6 @@ CONTAINS
! --------------------------------------------------------
! print out heading
!
write(6,400)
write(6,410)
write(6,420)
write(6,410)
write(6,400)
write(6,500) nbeg_ , nomore_ , iprint_ , ndr_ , ndw_
write(6,505) delt_
write(6,510) emass_ , emaec_
......@@ -676,12 +671,6 @@ CONTAINS
write(6,700) iprsta_
!
400 format('************************************', &
& '************************************')
410 format('**** ', &
& ' ****')
420 format('**** ab-initio molecular dynamics: ', &
& ' car-parrinello vanderbilt bhs ****')
500 format(// &
& ' nbeg=',i3,' nomore=',i7,3x,' iprint=',i4,/ &
& ' reads from',i3,' writes on',i3)
......
......@@ -92,6 +92,7 @@ end module para_mod
!
use para_mod
use mp, only: mp_start, mp_env
use global_version
!
implicit none
......@@ -108,11 +109,11 @@ end module para_mod
if ( nproc > maxproc) &
& call errore('startup',' too many processors ',nproc)
!
if (me.lt.10) then
if (me < 10) then
write(node,'(i1,2x)') me
else if (me.lt.100) then
else if (me < 100) then
write(node,'(i2,1x)') me
else if (me.lt.1000) then
else if (me < 1000) then
write(node,'(i3)') me
else
call errore('startup','wow, >1000 nodes !!',nproc)
......@@ -121,6 +122,14 @@ end module para_mod
! only the first processor writes
!
if ( me == 1 ) then
write(6,'(72("*"))')
write(6,'(4("*"),64x,4("*"))')
write(6,'(4("*")," CPV: variable-cell Car-Parrinello ", &
& "molecular dynamics ",4("*"))')
write(6,'(4("*")," using ultrasoft Vanderbilt ", &
& "pseudopotentials - v.",a6,8x,4("*"))') version_number
write(6,'(4("*"),64x,4("*"))')
write(6,'(72("*"))')
write(6,'(/5x,''Parallel version (MPI)'')')
write(6,'(5x,''Number of processors in use: '',i4)') nproc
else
......
......@@ -53,6 +53,7 @@ subroutine bcast_d3_input
call mp_bcast (fildrho, root)
call mp_bcast (fild0rho, root)
call mp_bcast (tmp_dir, root)
call mp_bcast (prefix, root)
#endif
return
end subroutine bcast_d3_input
......@@ -27,7 +27,7 @@ subroutine d3_readin
! counters
character(len=256) :: outdir
namelist / inputph / ethr_ph, amass, iverbosity, outdir, filpun, &
namelist / inputph / ethr_ph, amass, iverbosity, outdir, prefix, &
fildyn, fildrho, fild0rho, q0mode_todo, wraux, recv, istop, &
testflag, testint, testreal
! convergence threshold
......@@ -58,7 +58,7 @@ subroutine d3_readin
ethr_ph = 1.d-5
iverbosity = 0
outdir = './'
filpun = ' '
prefix = 'pwscf'
fildyn = 'd3dyn'
fildrho = ' '
fild0rho = ' '
......@@ -91,15 +91,11 @@ subroutine d3_readin
!
! Check all namelist variables
!
if (ethr_ph.le.0.d0) call errore (' d3_readin', ' Wrong ethr_ph ', &
1)
if (iverbosity.ne.0.and.iverbosity.ne.1) call errore ('d3_readin', ' Wrong &
&iverbosity ', 1)
if (fildyn.eq.' ') call errore ('d3_readin', ' Wrong fildyn ', 1)
if (filpun.eq.' ') call errore ('d3_readin', ' Wrong filpun ', 1)
if (ethr_ph.le.0.d0) call errore (' d3_readin', ' Wrong ethr_ph ', 1)
if (iverbosity.ne.0.and.iverbosity.ne.1) &
call errore ('d3_readin', ' Wrong iverbosity ', 1)
if (fildrho.eq.' ') call errore ('d3_readin', ' Wrong fildrho ', 1)
if (fild0rho.eq.' ') call errore ('d3_readin', ' Wrong fild0rho ', &
1)
if (fild0rho.eq.' ') call errore ('d3_readin', ' Wrong fild0rho ', 1)
!
! reads the q point
!
......
......@@ -15,8 +15,9 @@ program d3toten
use phcom
use d3com
use io
use global_version
implicit none
character :: cdate * 9, ctime * 9, version * 12
character(len=9) :: cdate, ctime, code = 'D3TOTEN'
integer :: nu_i, nu_i0, irecv
real (kind=DP) :: t0, t1, get_clock
......@@ -28,10 +29,7 @@ program d3toten
call init_clocks (.true.)
call start_clock ('D3TOTEN')
version = 'D3TOTEN1.2.1'
call startup (nd_nmbr, version)
write (6, '(/5x,"UltraSoft (Vanderbilt) ", &
& "Pseudopotentials")')
call startup (nd_nmbr, code, version_number)
!
! Initialization routines
!
......
......@@ -10,12 +10,13 @@
program pwscf
!-----------------------------------------------------------------------
!
! Plane Wave Self-Consistent Field c
! Plane Wave Self-Consistent Field
!
use pwcom
use io
use global_version
implicit none
character :: version * 12
character(len=9) :: code = 'PWSCF'
external date_and_tim
! use ".false." to disable all clocks except the total cpu time clock
! use ".true." to enable clocks
......@@ -23,9 +24,8 @@ program pwscf
call init_clocks (.true.)
call start_clock ('PWSCF')
version = 'PWSCF 1.2.1'
gamma_only =.true.
call startup (nd_nmbr, version)
call startup (nd_nmbr, code, version_number)
call init_run
istep = 0
do while (istep.lt.nstep)
......
......@@ -15,28 +15,21 @@ program cg_raman
use io
use cgcom
use mp, only: mp_end
use global_version
#ifdef __PARA
use para
#endif
implicit none
real(kind=DP), allocatable :: deps_dtau(:,:,:,:), dynout(:,:)
real(kind=DP), allocatable :: w2(:)
!
character(len=9) :: cdate, ctime, code = 'RAMAN'
logical :: exst
integer :: i
character(len=9) cdate, ctime
character(len=12), parameter:: version='RAMAN V. -1'
external date_and_tim
!
call init_clocks(.true.)
call start_clock('raman')
#ifdef __PARA
call startup( nd_nmbr, version )
#else
nd_nmbr=' '
call date_and_tim(cdate,ctime)
write (6,9000) version,cdate,ctime
#endif
call startup( nd_nmbr, code, version_number )
!
gamma_only = .true.
call cg_readin
......
......@@ -55,7 +55,7 @@ cp: modules libs
links:
test -d bin || mkdir bin
( cd bin/ ; ln -fs ../PW/pw.x ../PW/memory.x ../PH/ph.x ../D3/d3.x ../Gamma/pwg.x ../Gamma/phcg.x ../CPV/cp.x ../FPMD/par2.x ../PP/average.x ../PP/bands.x ../PP/chdens.x ../PP/dos.x ../PP/plotrho.x ../PP/pp.x ../PP/projwfc.x ../PP/voronoy.x ../PP/plotband.x ../pwtools/band_plot.x ../pwtools/dynmat.x ../pwtools/fqha.x ../pwtools/matdyn.x ../pwtools/q2r.x ../pwtools/dist.x . )
( cd bin/ ; ln -fs ../PW/pw.x ../PW/memory.x ../PH/ph.x ../D3/d3.x ../Gamma/pwg.x ../Gamma/phcg.x ../CPV/cp.x ../FPMD/par2.x ../PP/average.x ../PP/bands.x ../PP/chdens.x ../PP/dos.x ../PP/plotrho.x ../PP/pp.x ../PP/projwfc.x ../PP/voronoy.x ../PP/plotband.x ../pwtools/band_plot.x ../pwtools/dynmat.x ../pwtools/fqha.x ../pwtools/matdyn.x ../pwtools/q2r.x ../pwtools/dist.x ../pwtools/ev.x ../pwtools/kpoints.x . )
clean:
( cd PW ; make clean_ ) ; \
......
......@@ -36,7 +36,8 @@ read_namelists.o \
read_cards.o \
berry_phase.o \
energies.o \
io_files.o
io_files.o \
version.o
#
include ../make.rules
#
......
!
! Copyright (C) 2003 PWSCF group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
MODULE global_version
character (len=6) :: version_number = '1.3.0'
END MODULE global_version
......@@ -21,9 +21,10 @@ program phonon
use parameters, only : DP
use phcom
use io
use global_version
implicit none
character :: cdate * 9, ctime * 9, version * 12
character (len=9) :: cdate, ctime, code = 'PHONON'
external date_and_tim
! call sigcatch( )
......@@ -33,8 +34,7 @@ program phonon
call init_clocks (.true.)
call start_clock ('PHONON')
version = 'PHONON 1.2.1'
call startup (nd_nmbr, version)
call startup (nd_nmbr, code, version_number)
write (6, '(/5x,"Ultrasoft (Vanderbilt) Pseudopotentials")')
!
! and begin with the initialization part
......
......@@ -885,8 +885,8 @@ subroutine plot_3d (alat, at, nat, tau, atm, ityp, ngm, g, rhog, &
do ipol=1,3
dipol(ipol)=dipol(ipol) / suma * omega * alat
enddo
print '(/5x,"Min, Max, Total, Abs charge: ",4f10.6)', rhomin, rhomax, &
rhotot, rhoabs
print '(/5x,"Min, Max, Total, Abs charge: ",2f10.6,2x,2f10.4)',&
rhomin, rhomax, rhotot, rhoabs
if (output_format == 4) then
!
......
......@@ -11,13 +11,12 @@ subroutine start_postproc (nodenumber)
!
! Wrapper routine for postprocessing initialization
!
#include "machine.h"
use global_version
implicit none
character(len=3) :: nodenumber
character(len=12):: version = 'POSTPROC-121'
character(len=9) :: code = 'POST-PROC'
!
nodenumber = ' '
call startup (nodenumber, version)
call startup (nodenumber, code, version_number)
#ifdef __PARA
call init_pool
#endif
......
......@@ -7,7 +7,8 @@
!
!
!-----------------------------------------------------------------------
subroutine hexsym (at, is, isname, nrot) !-----------------------------------------------------------------------
subroutine hexsym (at, is, isname, nrot)
!-----------------------------------------------------------------------
!
! Provides symmetry operations for Hexagonal and Trigonal lattices.
! The c axis is assumed to be along the z axis
......
......@@ -13,10 +13,12 @@ program pwmemory
use pwcom
use io
use mp, only : mp_end
use global_version
implicit none
logical :: lgamma
character(len=9) :: code = 'memory'
!
call startup (nd_nmbr, 'memory 1.2.1')
call startup (nd_nmbr, code, version_number)
!
call iosys
call setup
......
......@@ -10,12 +10,13 @@
program pwscf
!-----------------------------------------------------------------------
!
! Plane Wave Self-Consistent Field c
! Plane Wave Self-Consistent Field
!
use pwcom
use io
use global_version
implicit none
character :: version * 12
character(len=9) :: code = 'PWSCF'
external date_and_tim
! use ".false." to disable all clocks except the total cpu time clock
! use ".true." to enable clocks
......@@ -23,9 +24,8 @@ program pwscf
call init_clocks (.true.)
call start_clock ('PWSCF')
version = 'PWSCF 1.2.1'
gamma_only =.false.
call startup (nd_nmbr, version)
call startup (nd_nmbr, code, version_number)
call init_run
istep = 0
do while (istep.lt.nstep)
......
......@@ -8,7 +8,7 @@
!
#include "machine.h"
!-----------------------------------------------------------------------
subroutine startup (nd_nmbr, version)
subroutine startup (nd_nmbr, code, version)
!-----------------------------------------------------------------------
!
! This subroutine initializes MPI
......@@ -45,7 +45,7 @@ subroutine startup (nd_nmbr, version)
use mp, only: mp_start, mp_env, mp_barrier, mp_bcast
implicit none
character :: nd_nmbr * 3, version * 12
character :: nd_nmbr*3, code*9, version*6
integer :: gid
......@@ -149,7 +149,7 @@ subroutine startup (nd_nmbr, version)
# endif
if (me == 1) then
call date_and_tim (cdate, ctime)
write (6, 9000) version, cdate, ctime
write (6, 9000) code, version, cdate, ctime
write (6, '(/5x,"Parallel version (MPI)")')
write (6, '(5x,"Number of processors in use: ",i4)') nproc
if (npool /= 1) &
......@@ -162,11 +162,11 @@ subroutine startup (nd_nmbr, version)
nd_nmbr = ' '
call date_and_tim (cdate, ctime)
write (6, 9000) version, cdate, ctime
write (6, 9000) code, version, cdate, ctime
#endif
9000 format (/5x,'Program ',a12,' starts ...',/5x, &
9000 format (/5x,'Program ',a9,' v.',a6,' starts ...',/5x, &
& 'Today is ',a9,' at ',a9)
!
......
The current (development) version is available using anonymous CVS.
Define environmental variables:
setenv CVS_RSH ssh
setenv CVSROOT :pserver:cvsanon@democritos.sissa.it:/home/cvs
(tcsh/csh) or
export CVS_RSH=ssh
export CVSROOT=:pserver:cvsanon@democritos.sissa.it:/home/cvs
(sh/bash). Then:
cvs login
(password: cvsanon). For the first code download:
cvs co O-sesame
for the entire repository (the code appears in directory O-sesame/).
Alternatively, "cvs co pwscf", or "cp", or "fpmd" will download only
PWscf, CP, FPMD, respectively, in directories with the same name.
For updating the code to the current version:
cvs update -d
in the directory containing the distribution.
PLEASE NOTE: re-run "./configure" if files have been moved/added/removed
since the last checkout, otherwise "make" may not work properly due to
obsolete or missing dependencies. Do not blindly re-use a "make.sys" file
from a preceding version: it may no longer work.
PLEASE ALSO NOTE: the development version may not work properly, and
sometimes not even compile properly. Use at your own risk.
......@@ -113,8 +113,6 @@ FPMD:
- Documentation is nonexistent
- version number
CPV:
- Documentation needs serious improvements
......@@ -126,4 +124,3 @@ CPV:
- replace calls to zero, ssum, csum, blas copy, scal, with f90
- version number
......@@ -8,7 +8,7 @@
#include "../include/opt_param.h"
! OPTIMIZED DRIVER FOR MATRIX TRASPOSITIN
! OPTIMIZED DRIVER FOR MATRIX TRASPOSITION
!
! written by Carlo Cavazzoni
!
......
......@@ -17,7 +17,7 @@ MODULES = ../Modules/parameters.o ../Modules/kind.o ../Modules/fft_scalar.o
#
# Targets
#
all: band_plot.x q2r.x matdyn.x dynmat.x fqha.x dist.x
all: band_plot.x q2r.x matdyn.x dynmat.x fqha.x dist.x ev.x kpoints.x
band_plot.x: band_plot.o
$(LD) -o band_plot.x band_plot.o $(LDFLAGS)
......@@ -37,5 +37,11 @@ dynmat.x: dynmat.o rigid.o
fqha.x: fqha.o
$(LD) -o fqha.x fqha.o $(LDFLAGS)
ev.x: ev.o
$(LD) -o ev.x ev.o ../PW/random.o ../PW/error.o
kpoints.x: kpoints.o
$(LD) -o kpoints.x kpoints.o $(PWOBJS) $(MODULES) $(LDFLAGS)
clean_:
rm -f *.x *.o *~ *.F90 *.mod *.d *.i work.pc
This diff is collapsed.
This diff is collapsed.
!
! Copyright (C) 2003 PWSCF group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!
!-----------------------------------------------------------------------
program special_points
!-----======================--------------------------------------------
!
! calculates special points for any structure,
! the default definition for the mesh is a shift of 1/(2n_i)
! where the length of b_i is equal to 1
!_______________________________________________________________________
!
implicit real*8(a-h,o-z)
parameter (nptx=20000)
character*45 sname(48)
character*30 filout
character*1 answer
real*8 at(3,3),bg(3,3),celldm(6),xk(3,nptx),xkw(nptx)
integer k(3,nptx),kw(nptx),ieq(nptx)
integer is(3,3,48),ibrav,nmax(3),nshift(3),nstart(3)
logical aflag,sflag
!
write(*,1)
1 format(/,
+ 5x,'***************************************************',/,
+ 5x,'* *',/,
+ 5x,'* Welcome to the special points world! *',/,
+ 5x,'*_________________________________________________*',/,
+ 5x,'* 1 = cubic p (sc ) 8 = orthor p (so ) *',/,
+ 5x,'* 2 = cubic f (fcc) 9 = orthor 1-(fco) *',/,
+ 5x,'* 3 = cubic i (bcc) 10 = orthor f (fco) *',/,
+ 5x,'* 4 = hex & trig p 11 = orthor i (bco) *',/,
+ 5x,'* 5 = trigonal r 12 = monoclinic p *',/,
+ 5x,'* 6 = tetrag p (st ) 13 = monocl 1-(fcm) *',/,
+ 5x,'* 7 = tetrag i (bct) 14 = triclinic p *',/,
+ 5x,'***************************************************',/
+ )
!
!.....default values
!
celldm(1)=1.d0
do i=1,3
nshift(i)=0
enddo
!
write(*,'(5x,a,$)') 'bravais lattice >> '
read(*,*) ibrav
!
write(*,'(5x,a,$)') 'filout [mesh_k] >> '
read(*,'(a)') filout
if (filout.eq.' ') filout='mesh_k'
open(unit=1,file=filout,status='unknown')
open(unit=2,file='info',status='unknown')
!
if(ibrav.ge.4) then
write(*,'(5x,a,$)') 'enter celldm(3) >> '
read(*,*) celldm(3)
end if
if(ibrav.ge.8) then
write(*,'(5x,a,$)') 'enter celldm(2) >> '
read(*,*) celldm(2)
end if
if(ibrav.ge.12) then
write(*,'(5x,a,$)') 'enter celldm(4) >> '
read(*,*) celldm(4)
end if
if(ibrav.eq.14) then
write(*,'(5x,a)') 'enter celldm(5) >> cos(ac)'
write(*,'(5x,a,$)') 'enter celldm(5) >> '
read(*,*) celldm(5)
write(*,'(5x,a)') 'enter celldm(6) >> cos(ab)'
write(*,'(5x,a,$)') 'enter celldm(6) >> '
read(*,*) celldm(6)
end if
!
write(*,'(5x,a,$)') 'mesh: n1 n2 n3 >> '
read(*,*) nmax
nptot=nmax(1)*nmax(2)*nmax(3)
if(nptot.gt.nptx) then
write(*,'(/,5x,a)')
+ '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
write(*,'(5x,a,i6,a)')
+ '! nptx = ',nptx,' is too small for this mesh! !!'
write(*,'(5x,a/,)')
+ '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
stop
endif
write(*,'(5x,a,$)') 'mesh: k1 k2 k3 (0 no shift, 1 shifted) >> '
read(*,*) nshift(1), nshift(2), nshift(3)
!
write(*,'(5x,a,$)') 'write all k? [f] >> '
read(*,'(a1)') answer
aflag= answer.eq.'t'.or.answer.eq.'T' .or.
+ answer.eq.'y'.or.answer.eq.'Y' .or.
+ answer.eq.'1'
!
call latgen(ibrav,celldm,at(1,1),at(1,2),at(1,3),omega)
!
! normalize at to celldm(1) ( a0 for cubic lattices )
!
do i = 1, 3
at( i, 1 ) = at( i, 1 ) / celldm( 1 )
at( i, 2 ) = at( i, 2 ) / celldm( 1 )
at( i, 3 ) = at( i, 3 ) / celldm( 1 )
enddo
!
call recips(at(1,1),at(1,2),at(1,3),bg(1,1),bg(1,2),bg(1,3))
!
write(2,'(2x,''crystal axis: ''/
+ 3(2x,''('',3f7.4,'') ''/) )')
+ ((at(i,j), i=1,3), j=1,3)
write(2,'(2x,''reciprocal axis: ''/
+ 3(2x,''('',3f7.4,'') ''/) )')
+ ((bg(i,j), i=1,3), j=1,3)
write(2,*)' Omega (in a^3 units) = ',omega
!
!.......................................................................
!
if(ibrav.eq.4.or.ibrav.eq.5) then
call hexsym (at, is, sname, nrot)
else
call cubicsym(at, is, sname, nrot)
endif
write(2,'(//,1x,i3,2x,a19)') nrot,'symmetry operations'
do n6=0,(nrot-1)/6
nf=min(nrot-6*n6,6)
write(2,'(1x)')
do i=1,3
write(2,'(6(3i3,2x))')
+ ((is(i,j,n6*6+n), j=1,3), n=1,nf)
end do
end do
!
sflag=.false.
do i=1,3
! shifted grid
if(nshift(i).eq.1) then
nshift(i)=2
nmax(i)=nshift(i)*nmax(i)
nstart(i)=1
sflag=.true.
else
! unshifted grid
nstart(i)=0
nshift(i)=1
end if
enddo
!
n=0
do n3=nstart(3),nmax(3)-1,nshift(3)
do n2=nstart(2),nmax(2)-1,nshift(2)
do n1=nstart(1),nmax(1)-1,nshift(1)
n=n+1
k(1,n)=n1
k(2,n)=n2
k(3,n)=n3
kw(n)=1
ieq(n)=0
call check(n,k,kw,ieq,is,nrot,nmax)
enddo
enddo
enddo
!
nk=0
write(2,'(/)')
do j=1,n
if(kw(j).gt.0.or.aflag) then
nk=nk+1
xkw(nk)=kw(j)
do l=1,3
xk(l,nk)=0.d0
do i=1,3
xk(l,nk)=xk(l,nk)+k(i,j)*bg(l,i)/nmax(i)
enddo
end do
write(2,2) j,k(1,j),k(2,j),k(3,j),kw(j),ieq(j)
2 format(' k(',i3,')=( ',i2,' ',i2,' ',i2,' ) --- weight=',
+ i3,' |folds in point #',i3)
endif
enddo
!
write(*,'(/5x,a,$)') '# of k-points == '
write(*,'(i5,a5,i5)') nk,' of ',n
write(*,'(2x)')
!
write(1,'(i5)') nk
do j=1,nk
if(aflag.and.kw(j).eq.0) then
write(1,'(i5,1x,3f11.7,f7.2,i4)')
+ j,(xk(l,j),l=1,3),xkw(j),ieq(j)
else
write(1,'(i5,1x,3f11.7,f7.2)') j,(xk(l,j),l=1,3),xkw(j)
end if
end do
!
if(.not.sflag.and.kw(1).ne.1) then
write(*,'(5x,a)')
+ '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
write(*,'(5x,a)')
+ '!the considered mesh has not the correct symmetry!!'
write(*,'(5x,a/)')
+ '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
endif
!
close(unit=1)
close(unit=2)
!
end
!
!-----------------------------------------------------------------------
subroutine check(n,k,kw,ieq,is,nrot,nmax)
!-----------------------------------------------------------------------
!
integer k(3,n),kw(n),is(3,3,nrot),kr(3),ieq(n),nmax(3)
logical flag
!
irot=1
flag=.true.
do while(irot.le.nrot.and.flag)
kr(1)=0
kr(2)=0
kr(3)=0
call ruotaijk
+ (is(1,1,irot),k(1,n),k(2,n),k(3,n),kr(1),kr(2),kr(3))
do j=1,3
do while(kr(j).ge.nmax(j))
kr(j)=kr(j)-nmax(j)
enddo
do while(kr(j).le.-1)
kr(j)=kr(j)+nmax(j)
enddo
enddo
np=1
do while(flag.and.np.le.n-1)
if(kr(1).eq.k(1,np).and.kr(2).eq.k(2,np).and.kr(3).
+ eq.k(3,np)) then
kw(n)=0
naux =np
do while(kw(naux).eq.0)
naux=ieq(naux)
enddo
ieq(n)=naux
kw(naux)=kw(naux)+1
flag=.false.
endif
np=np+1
enddo
irot=irot+1
enddo