OSDN Git Service

2008-01-30 Paul Thomas <pault@gcc.gnu.org>
authorpault <pault@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 30 Jan 2008 06:56:10 +0000 (06:56 +0000)
committerpault <pault@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 30 Jan 2008 06:56:10 +0000 (06:56 +0000)
PR fortran/34975
* symbol.c (gfc_delete_symtree, gfc_undo_symbols): Rename
delete_symtree to gfc_delete_symtree.
* gfortran.h : Add prototype for gfc_delete_symtree.
* module.c (load_generic_interfaces): Transfer symbol to a
unique symtree and delete old symtree, instead of renaming.
(read_module): The rsym and the found symbol are the same, so
the found symtree can be deleted.

PR fortran/34429
* decl.c (match_char_spec): Remove the constraint on deferred
matching of functions and free the length expression.
delete_symtree to gfc_delete_symtree.
(gfc_match_type_spec): Whitespace.
(gfc_match_function_decl): Defer characteristic association for
all types except BT_UNKNOWN.
* parse.c (decode_specification_statement): Only derived type
function matching is delayed to the end of specification.

2008-01-30  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/34975
* gfortran.dg/use_only_3.f90: New test.
* gfortran.dg/use_only_3.inc: Modules for new test.

PR fortran/34429
* gfortran.dg/function_charlen_2.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@131956 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/decl.c
gcc/fortran/gfortran.h
gcc/fortran/module.c
gcc/fortran/parse.c
gcc/fortran/symbol.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/function_charlen_2.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/use_only_3.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/use_only_3.inc [new file with mode: 0644]

index 0923a77..640681b 100644 (file)
@@ -1,3 +1,24 @@
+2008-01-30  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/34975
+       * symbol.c (gfc_delete_symtree, gfc_undo_symbols): Rename
+       delete_symtree to gfc_delete_symtree.
+       * gfortran.h : Add prototype for gfc_delete_symtree.
+       * module.c (load_generic_interfaces): Transfer symbol to a
+       unique symtree and delete old symtree, instead of renaming.
+       (read_module): The rsym and the found symbol are the same, so
+       the found symtree can be deleted.
+
+       PR fortran/34429
+       * decl.c (match_char_spec): Remove the constraint on deferred
+       matching of functions and free the length expression.
+       delete_symtree to gfc_delete_symtree.
+       (gfc_match_type_spec): Whitespace.
+       (gfc_match_function_decl): Defer characteristic association for
+       all types except BT_UNKNOWN.
+       * parse.c (decode_specification_statement): Only derived type
+       function matching is delayed to the end of specification.
+
 2008-01-28  Tobias Burnus  <burnus@net-b.de>
 
        PR libfortran/34980
index 115b30e..06c1df3 100644 (file)
@@ -2151,13 +2151,10 @@ syntax:
   return m;
 
 done:
-  /* Except in the case of the length being a function, where symbol
-     association looks after itself, deal with character functions
-     after the specification statements.  */
-  if (gfc_matching_function
-       && !(len && len->expr_type != EXPR_VARIABLE
-                && len->expr_type != EXPR_OP))
+  /* Deal with character functions after USE and IMPORT statements.  */
+  if (gfc_matching_function)
     {
+      gfc_free_expr (len);
       gfc_undo_symbols ();
       return MATCH_YES;
     }
@@ -2222,8 +2219,8 @@ gfc_match_type_spec (gfc_typespec *ts, int implicit_flag)
   /* A belt and braces check that the typespec is correctly being treated
      as a deferred characteristic association.  */
   seen_deferred_kind = (gfc_current_state () == COMP_FUNCTION)
-                                       && (gfc_current_block ()->result->ts.kind == -1)
-                                       && (ts->kind == -1);
+                         && (gfc_current_block ()->result->ts.kind == -1)
+                         && (ts->kind == -1);
   gfc_clear_ts (ts);
   if (seen_deferred_kind)
     ts->kind = -1;
@@ -4358,21 +4355,13 @@ gfc_match_function_decl (void)
          goto cleanup;
        }
 
-      /* Except in the case of a function valued character length,
-        delay matching the function characteristics until after the
+      /* Delay matching the function characteristics until after the
         specification block by signalling kind=-1.  */
-      if (!(current_ts.type == BT_CHARACTER
-             && current_ts.cl
-             && current_ts.cl->length
-             && current_ts.cl->length->expr_type != EXPR_OP
-             && current_ts.cl->length->expr_type != EXPR_VARIABLE))
-       {
-         sym->declared_at = old_loc;
-         if (current_ts.type != BT_UNKNOWN)
-           current_ts.kind = -1;
-         else
-           current_ts.kind = 0;
-       }
+      sym->declared_at = old_loc;
+      if (current_ts.type != BT_UNKNOWN)
+       current_ts.kind = -1;
+      else
+       current_ts.kind = 0;
 
       if (result == NULL)
        {
index aac1f82..5cd99c4 100644 (file)
@@ -2113,6 +2113,7 @@ gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
 gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
 gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
 gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
+void gfc_delete_symtree (gfc_symtree **, const char *);
 gfc_symtree *gfc_get_unique_symtree (gfc_namespace *);
 gfc_user_op *gfc_get_uop (const char *);
 gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
index c2dc27a..b478d3e 100644 (file)
@@ -3308,13 +3308,19 @@ load_generic_interfaces (void)
 
          if (!sym)
            {
-             /* Make symtree inaccessible by renaming if the symbol has
-                been added by a USE statement without an ONLY(11.3.2).  */
+             /* Make the symbol inaccessible if it has been added by a USE
+                statement without an ONLY(11.3.2).  */
              if (st && only_flag
                     && !st->n.sym->attr.use_only
                     && !st->n.sym->attr.use_rename
                     && strcmp (st->n.sym->module, module_name) == 0)
-               st->name = gfc_get_string ("hidden.%s", name);
+               {
+                 sym = st->n.sym;
+                 gfc_delete_symtree (&gfc_current_ns->sym_root, name);
+                 st = gfc_get_unique_symtree (gfc_current_ns);
+                 st->n.sym = sym;
+                 sym = NULL;
+               }
              else if (st)
                {
                  sym = st->n.sym;
@@ -3733,21 +3739,21 @@ read_module (void)
            {
              st = gfc_find_symtree (gfc_current_ns->sym_root, name);
 
-             /* Make symtree inaccessible by renaming if the symbol has
-                been added by a USE statement without an ONLY(11.3.2).  */
+             /* Delete the symtree if the symbol has been added by a USE
+                statement without an ONLY(11.3.2). Remember that the rsym
+                will be the same as the symbol found in the symtree, for
+                this case.*/
              if (st && (only_flag || info->u.rsym.renamed)
                     && !st->n.sym->attr.use_only
                     && !st->n.sym->attr.use_rename
-                    && st->n.sym->module
-                    && strcmp (st->n.sym->module, module_name) == 0)
-               st->name = gfc_get_string ("hidden.%s", name);
+                    && info->u.rsym.sym == st->n.sym)
+               gfc_delete_symtree (&gfc_current_ns->sym_root, name);
 
              /* Create a symtree node in the current namespace for this
                 symbol.  */
              st = check_unique_name (p)
                   ? gfc_get_unique_symtree (gfc_current_ns)
                   : gfc_new_symtree (&gfc_current_ns->sym_root, p);
-
              st->ambiguous = ambiguous;
 
              sym = info->u.rsym.sym;
index 20777fd..8d30bee 100644 (file)
@@ -110,7 +110,7 @@ decode_specification_statement (void)
   match ("import", gfc_match_import, ST_IMPORT);
   match ("use", gfc_match_use, ST_USE);
 
-  if (gfc_numeric_ts (&gfc_current_block ()->ts))
+  if (gfc_current_block ()->ts.type != BT_DERIVED)
     goto end_of_block;
 
   match (NULL, gfc_match_st_function, ST_STATEMENT_FUNCTION);
index a802fa1..e97684f 100644 (file)
@@ -2153,8 +2153,8 @@ gfc_new_symtree (gfc_symtree **root, const char *name)
 
 /* Delete a symbol from the tree.  Does not free the symbol itself!  */
 
-static void
-delete_symtree (gfc_symtree **root, const char *name)
+void
+gfc_delete_symtree (gfc_symtree **root, const char *name)
 {
   gfc_symtree st, *st0;
 
@@ -2609,7 +2609,7 @@ gfc_undo_symbols (void)
                }
            }
 
-         delete_symtree (&p->ns->sym_root, p->name);
+         gfc_delete_symtree (&p->ns->sym_root, p->name);
 
          p->refs--;
          if (p->refs < 0)
index 5369f58..9c21887 100644 (file)
@@ -1,3 +1,12 @@
+2008-01-30  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/34975
+       * gfortran.dg/use_only_3.f90: New test.
+       * gfortran.dg/use_only_3.inc: Modules for new test.
+
+       PR fortran/34429
+       * gfortran.dg/function_charlen_2.f90: New test.
+
 2008-01-30  Jakub Jelinek  <jakub@redhat.com>
 
        PR middle-end/34969
diff --git a/gcc/testsuite/gfortran.dg/function_charlen_2.f90 b/gcc/testsuite/gfortran.dg/function_charlen_2.f90
new file mode 100644 (file)
index 0000000..84d3d7e
--- /dev/null
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! Tests the fix for PR34429 in which function charlens that were
+! USE associated would cause an error.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module m
+  integer, parameter :: l = 2
+  character(2) :: cl
+end module m
+
+program test
+  implicit none
+  integer, parameter :: l = 5
+  character(len = 10) :: c
+  character(4) :: cl
+  c = f ()
+  if (g () /= "2") call abort
+contains
+  character(len = l) function f ()
+    use m
+    if (len (f) /= 2) call abort
+    f = "a"
+  end function f
+  character(len = len (cl)) function g ()
+    use m
+    g = "4"
+    if (len (g) == 2) g= "2"
+  end function g
+end program test
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/use_only_3.f90 b/gcc/testsuite/gfortran.dg/use_only_3.f90
new file mode 100644 (file)
index 0000000..509752a
--- /dev/null
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! This tests the patch for PR34975, in which 'n', 'ipol', and 'i' would be
+! determined to have 'no IMPLICIT type'.  It turned out to be fiendishly
+! difficult to write a testcase for this PR because even the smallest changes
+! would make the bug disappear.  This is the testcase provided in the PR, except
+! that all the modules are put in 'use_only_3.inc' in the same order as the
+! makefile.  Even this has an effect; only 'n' is now determined to be
+! improperly typed.  All this is due to the richness of the symtree and the
+! way in which the renaming inserted new symtree entries.  Unless somenody can
+! come up with a reduced version, this relatively large file will have to be added
+! to the testsuite.  Fortunately, it only has to be comiled once:)
+!  
+! Reported by Tobias Burnus <burnus@gcc.gnu.org>
+!
+include 'use_only_3.inc'
+subroutine dforceb(c0, i, betae, ipol, bec0, ctabin, gqq, gqqm, qmat, dq2, df)
+  use gvecs
+  use gvecw, only: ngw
+  use parameters
+  use electrons_base, only: nx => nbspx, n => nbsp, nspin, f
+  use constants
+  use cvan
+  use ions_base
+  use ions_base, only : nas => nax
+  implicit none
+
+  integer ipol, i, ctabin
+  complex c0(n), betae, df,&
+       &   gqq,gqqm,&
+       &   qmat
+  real bec0,&
+       &   dq2,  gmes
+
+ end subroutine dforceb
+! { dg-final { cleanup-modules "cell_base cvan gvecs kinds" } }
+! { dg-final { cleanup-modules "constants electrons_base gvecw parameters" } }
+! { dg-final { cleanup-modules "control_flags electrons_nose ions_base" } }
+
diff --git a/gcc/testsuite/gfortran.dg/use_only_3.inc b/gcc/testsuite/gfortran.dg/use_only_3.inc
new file mode 100644 (file)
index 0000000..7b86009
--- /dev/null
@@ -0,0 +1,998 @@
+    MODULE kinds
+      INTEGER, PARAMETER :: DP = selected_real_kind(14,200)
+      PRIVATE
+      PUBLIC :: DP
+    END MODULE kinds
+
+MODULE constants
+  USE kinds, ONLY : DP
+  IMPLICIT NONE
+  SAVE
+  REAL(DP), PARAMETER :: pi = 3.14159265358979323846_DP
+  REAL(DP), PARAMETER :: tpi= 2.0_DP * pi
+  REAL(DP), PARAMETER :: fpi= 4.0_DP * pi
+  REAL(DP), PARAMETER :: sqrtpi = 1.77245385090551602729_DP 
+  REAL(DP), PARAMETER :: sqrtpm1= 1.0_DP / sqrtpi
+  REAL(DP), PARAMETER :: sqrt2  = 1.41421356237309504880_DP
+  REAL(DP), PARAMETER :: H_PLANCK_SI      = 6.6260693D-34    ! J s
+  REAL(DP), PARAMETER :: K_BOLTZMANN_SI   = 1.3806505D-23    ! J K^-1 
+  REAL(DP), PARAMETER :: ELECTRON_SI      = 1.60217653D-19   ! C
+  REAL(DP), PARAMETER :: ELECTRONVOLT_SI  = 1.60217653D-19   ! J  
+  REAL(DP), PARAMETER :: ELECTRONMASS_SI  = 9.1093826D-31    ! Kg
+  REAL(DP), PARAMETER :: HARTREE_SI       = 4.35974417D-18   ! J
+  REAL(DP), PARAMETER :: RYDBERG_SI       = HARTREE_SI/2.0_DP! J
+  REAL(DP), PARAMETER :: BOHR_RADIUS_SI   = 0.5291772108D-10 ! m
+  REAL(DP), PARAMETER :: AMU_SI           = 1.66053886D-27   ! Kg
+  REAL(DP), PARAMETER :: K_BOLTZMANN_AU   = K_BOLTZMANN_SI / HARTREE_SI
+  REAL(DP), PARAMETER :: K_BOLTZMANN_RY   = K_BOLTZMANN_SI / RYDBERG_SI
+  REAL(DP), PARAMETER :: AUTOEV           = HARTREE_SI / ELECTRONVOLT_SI
+  REAL(DP), PARAMETER :: RYTOEV           = AUTOEV / 2.0_DP
+  REAL(DP), PARAMETER :: AMU_AU           = AMU_SI / ELECTRONMASS_SI
+  REAL(DP), PARAMETER :: AMU_RY           = AMU_AU / 2.0_DP
+  REAL(DP), PARAMETER :: AU_SEC           = H_PLANCK_SI/tpi/HARTREE_SI
+  REAL(DP), PARAMETER :: AU_PS            = AU_SEC * 1.0D+12
+  REAL(DP), PARAMETER :: AU_GPA           = HARTREE_SI / BOHR_RADIUS_SI ** 3 &
+                                            / 1.0D+9 
+  REAL(DP), PARAMETER :: RY_KBAR          = 10.0_dp * AU_GPA / 2.0_dp
+  !
+  REAL(DP), PARAMETER :: DEBYE_SI         = 3.3356409519 * 1.0D-30 ! C*m 
+  REAL(DP), PARAMETER :: AU_DEBYE         = ELECTRON_SI * BOHR_RADIUS_SI / &
+                                            DEBYE_SI
+  REAL(DP), PARAMETER :: eV_to_kelvin = ELECTRONVOLT_SI / K_BOLTZMANN_SI
+  REAL(DP), PARAMETER :: ry_to_kelvin = RYDBERG_SI / K_BOLTZMANN_SI
+  REAL(DP), PARAMETER :: eps4  = 1.0D-4
+  REAL(DP), PARAMETER :: eps6  = 1.0D-6
+  REAL(DP), PARAMETER :: eps8  = 1.0D-8
+  REAL(DP), PARAMETER :: eps14 = 1.0D-14
+  REAL(DP), PARAMETER :: eps16 = 1.0D-16
+  REAL(DP), PARAMETER :: eps32 = 1.0D-32
+  REAL(DP), PARAMETER :: gsmall = 1.0d-12
+  REAL(DP), PARAMETER :: e2 = 2.D0      ! the square of the electron charge
+  REAL(DP), PARAMETER :: degspin = 2.D0 ! the number of spins per level
+  REAL(DP), PARAMETER :: amconv = AMU_RY
+  REAL(DP), PARAMETER :: uakbar = RY_KBAR
+  REAL(DP), PARAMETER :: bohr_radius_cm = bohr_radius_si * 100.0
+  REAL(DP), PARAMETER :: BOHR_RADIUS_ANGS = bohr_radius_cm * 1.0D8
+  REAL(DP), PARAMETER :: ANGSTROM_AU = 1.0/BOHR_RADIUS_ANGS
+  REAL(DP), PARAMETER :: DIP_DEBYE = AU_DEBYE
+  REAL(DP), PARAMETER :: AU_TERAHERTZ  = AU_PS
+  REAL(DP), PARAMETER :: AU_TO_OHMCMM1 = 46000.0D0 ! (ohm cm)^-1
+  !
+
+END MODULE constants
+
+!
+! Copyright (C) 2001-2005 Quantum-ESPRESSO 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 parameters
+  !---------------------------------------------------------------------------
+  !
+  IMPLICIT NONE
+  SAVE
+  !
+  INTEGER, PARAMETER :: &
+       ntypx  = 10,     &! max number of different types of atom
+       npsx   = ntypx,  &! max number of different PPs (obsolete)
+       npk    = 40000,  &! max number of k-points               
+       lmaxx  = 3,      &! max non local angular momentum (l=0 to lmaxx)      
+       nchix  = 6,      &! max number of atomic wavefunctions per atom
+       ndmx   = 2000     ! max number of points in the atomic radial mesh
+  !
+  INTEGER, PARAMETER :: &
+       nbrx = 14,          &! max number of beta functions
+       lqmax= 2*lmaxx+1,   &! max number of angular momenta of Q
+       nqfx = 8             ! max number of coefficients in Q smoothing
+  !
+  INTEGER, PARAMETER :: nacx    = 10         ! max number of averaged 
+                                             ! quantities saved to the restart
+  INTEGER, PARAMETER :: nsx     = ntypx      ! max number of species
+  INTEGER, PARAMETER :: natx    = 5000       ! max number of atoms
+  INTEGER, PARAMETER :: npkx    = npk        ! max number of K points
+  INTEGER, PARAMETER :: ncnsx   = 101        ! max number of constraints
+  INTEGER, PARAMETER :: nspinx  = 2          ! max number of spinors
+  !
+  INTEGER, PARAMETER :: nhclm   = 4  ! max number NH chain length, nhclm can be
+                                     ! easily increased since the restart file 
+                                     ! should be able to handle it, perhaps
+                                     ! better to align nhclm by 4
+  !
+  INTEGER, PARAMETER :: max_nconstr = 100
+  !
+  INTEGER, PARAMETER  ::  maxcpu = 2**17  ! Maximum number of CPU
+  INTEGER, PARAMETER  ::  maxgrp = 128    ! Maximum number of task-groups
+  !
+END MODULE parameters
+
+MODULE control_flags
+  USE kinds
+  USE parameters
+  IMPLICIT NONE
+  SAVE
+  TYPE convergence_criteria
+     !
+     LOGICAL  :: active
+     INTEGER  :: nstep
+     REAL(DP) :: ekin
+     REAL(DP) :: derho
+     REAL(DP) :: force
+     !
+  END TYPE convergence_criteria
+  !
+  TYPE ionic_conjugate_gradient
+     !
+     LOGICAL  :: active
+     INTEGER  :: nstepix
+     INTEGER  :: nstepex
+     REAL(DP) :: ionthr
+     REAL(DP) :: elethr
+     !
+  END TYPE ionic_conjugate_gradient
+  !
+  CHARACTER(LEN=4) :: program_name = ' '  !  used to control execution flow inside module
+  !
+  LOGICAL :: tvlocw    = .FALSE. ! write potential to unit 46 (only cp, seldom used)
+  LOGICAL :: trhor     = .FALSE. ! read rho from      unit 47 (only cp, seldom used)
+  LOGICAL :: trhow     = .FALSE. ! CP code, write rho to restart dir
+  !
+  LOGICAL :: tsde          = .FALSE. ! electronic steepest descent
+  LOGICAL :: tzeroe        = .FALSE. ! set to zero the electronic velocities
+  LOGICAL :: tfor          = .FALSE. ! move the ions ( calculate forces )
+  LOGICAL :: tsdp          = .FALSE. ! ionic steepest descent
+  LOGICAL :: tzerop        = .FALSE. ! set to zero the ionic velocities
+  LOGICAL :: tprnfor       = .FALSE. ! print forces to standard output
+  LOGICAL :: taurdr        = .FALSE. ! read ionic position from standard input
+  LOGICAL :: tv0rd         = .FALSE. ! read ionic velocities from standard input
+  LOGICAL :: tpre          = .FALSE. ! calculate stress, and (in fpmd) variable cell dynamic
+  LOGICAL :: thdyn         = .FALSE. ! variable-cell dynamics (only cp)
+  LOGICAL :: tsdc          = .FALSE. ! cell geometry steepest descent
+  LOGICAL :: tzeroc        = .FALSE. ! set to zero the cell geometry velocities
+  LOGICAL :: tstress       = .FALSE. ! print stress to standard output
+  LOGICAL :: tortho        = .FALSE. ! use iterative orthogonalization 
+  LOGICAL :: tconjgrad     = .FALSE. ! use conjugate gradient electronic minimization
+  LOGICAL :: timing        = .FALSE. ! print out timing information
+  LOGICAL :: memchk        = .FALSE. ! check for memory leakage
+  LOGICAL :: tprnsfac      = .FALSE. ! print out structure factor 
+  LOGICAL :: toptical      = .FALSE. ! print out optical properties
+  LOGICAL :: tcarpar       = .FALSE. ! tcarpar is set TRUE for a "pure" Car Parrinello simulation
+  LOGICAL :: tdamp         = .FALSE. ! Use damped dinamics for electrons
+  LOGICAL :: tdampions     = .FALSE. ! Use damped dinamics for electrons
+  LOGICAL :: tatomicwfc    = .FALSE. ! Use atomic wavefunctions as starting guess for ch. density
+  LOGICAL :: tscreen       = .FALSE. ! Use screened coulomb potentials for cluster calculations
+  LOGICAL :: twfcollect    = .FALSE. ! Collect wave function in the restart file at the end of run.
+  LOGICAL :: tuspp         = .FALSE. ! Ultra-soft pseudopotential are being used
+  INTEGER :: printwfc      = -1      ! Print wave functions, temporarely used only by ensemble-dft
+  LOGICAL :: force_pairing = .FALSE. ! ...   Force pairing
+  LOGICAL :: tchi2         = .FALSE. ! Compute Chi^2
+  !
+  TYPE (convergence_criteria) :: tconvthrs
+                              !  thresholds used to check GS convergence 
+  !
+  ! ... Ionic vs Electronic step frequency
+  ! ... When "ion_nstep > 1" and "electron_dynamics = 'md' | 'sd' ", ions are 
+  ! ... propagated every "ion_nstep" electronic step only if the electronic 
+  ! ... "ekin" is lower than "ekin_conv_thr"
+  !
+  LOGICAL :: tionstep = .FALSE.
+  INTEGER :: nstepe   = 1  
+                            !  parameters to control how many electronic steps 
+                            !  between ions move
+
+  LOGICAL :: tsteepdesc = .FALSE.
+                            !  parameters for electronic steepest desceent
+
+  TYPE (ionic_conjugate_gradient) :: tconjgrad_ion
+                            !  conjugate gradient for ionic minimization
+
+  INTEGER :: nbeg   = 0 ! internal code for initialization ( -1, 0, 1, 2, .. )
+  INTEGER :: ndw    = 0 !
+  INTEGER :: ndr    = 0 !
+  INTEGER :: nomore = 0 !
+  INTEGER :: iprint = 0 ! print output every iprint step
+  INTEGER :: isave  = 0 ! write restart to ndr unit every isave step
+  INTEGER :: nv0rd  = 0 !
+  INTEGER :: iprsta = 0 ! output verbosity (increasing from 0 to infinity)
+  !
+  ! ... .TRUE. if only gamma point is used
+  !
+  LOGICAL :: gamma_only = .TRUE.
+  !
+  LOGICAL :: tnewnfi = .FALSE.
+  INTEGER :: newnfi  = 0
+  !
+  ! This variable is used whenever a timestep change is requested
+  !
+  REAL(DP) :: dt_old = -1.0D0
+  !
+  ! ... Wave function randomization
+  !
+  LOGICAL  :: trane = .FALSE.
+  REAL(DP) :: ampre = 0.D0
+  !
+  ! ... Ionic position randomization
+  !
+  LOGICAL  :: tranp(nsx) = .FALSE.
+  REAL(DP) :: amprp(nsx) = 0.D0
+  !
+  ! ... Read the cell from standard input
+  !
+  LOGICAL :: tbeg = .FALSE.
+  !
+  ! ... This flags control the calculation of the Dipole Moments
+  !
+  LOGICAL :: tdipole = .FALSE.
+  !
+  ! ... Flags that controls DIIS electronic minimization
+  !
+  LOGICAL :: t_diis        = .FALSE.
+  LOGICAL :: t_diis_simple = .FALSE.
+  LOGICAL :: t_diis_rot    = .FALSE.
+  !
+  ! ... Flag controlling the Nose thermostat for electrons
+  !
+  LOGICAL :: tnosee = .FALSE.
+  !
+  ! ... Flag controlling the Nose thermostat for the cell
+  !
+  LOGICAL :: tnoseh = .FALSE.
+  !
+  ! ... Flag controlling the Nose thermostat for ions
+  !
+  LOGICAL  :: tnosep = .FALSE.
+  LOGICAL  :: tcap   = .FALSE.
+  LOGICAL  :: tcp    = .FALSE.
+  REAL(DP) :: tolp   = 0.D0   !  tolerance for temperature variation
+  !
+  REAL(DP), PUBLIC :: &
+       ekin_conv_thr = 0.D0, &!  conv. threshold for fictitious e. kinetic energy
+       etot_conv_thr = 0.D0, &!  conv. threshold for DFT energy
+       forc_conv_thr = 0.D0   !  conv. threshold for atomic forces
+  INTEGER, PUBLIC :: &
+       ekin_maxiter = 100,   &!  max number of iter. for ekin convergence
+       etot_maxiter = 100,   &!  max number of iter. for etot convergence
+       forc_maxiter = 100     !  max number of iter. for atomic forces conv.
+  !
+  ! ... Several variables controlling the run ( used mainly in PW calculations )
+  !
+  ! ... logical flags controlling the execution
+  !
+  LOGICAL, PUBLIC :: &
+    lfixatom,           &! if .TRUE. some atom is kept fixed
+    lscf,               &! if .TRUE. the calc. is selfconsistent
+    lbfgs,              &! if .TRUE. the calc. is a relaxation based on new BFGS scheme
+    lmd,                &! if .TRUE. the calc. is a dynamics
+    lmetadyn,           &! if .TRUE. the calc. is a meta-dynamics
+    lpath,              &! if .TRUE. the calc. is a path optimizations
+    lneb,               &! if .TRUE. the calc. is NEB dynamics
+    lsmd,               &! if .TRUE. the calc. is string dynamics
+    lwf,                &! if .TRUE. the calc. is with wannier functions
+    lphonon,            &! if .TRUE. the calc. is phonon
+    lbands,             &! if .TRUE. the calc. is band structure
+    lconstrain,         &! if .TRUE. the calc. is constraint
+    ldamped,            &! if .TRUE. the calc. is a damped dynamics
+    lrescale_t,         &! if .TRUE. the ionic temperature is rescaled
+    langevin_rescaling, &! if .TRUE. the ionic dynamics is overdamped Langevin
+    lcoarsegrained,     &! if .TRUE. a coarse-grained phase-space is used
+    restart              ! if .TRUE. restart from results of a preceding run
+  !
+  LOGICAL, PUBLIC :: &
+    remove_rigid_rot     ! if .TRUE. the total torque acting on the atoms is
+                         ! removed
+  !
+  ! ... pw self-consistency
+  !
+  INTEGER, PUBLIC :: &
+    ngm0,             &! used in mix_rho
+    niter,            &! the maximum number of iteration
+    nmix,             &! the number of iteration kept in the history
+    imix               ! the type of mixing (0=plain,1=TF,2=local-TF)
+  REAL(DP), PUBLIC  :: &
+    mixing_beta,      &! the mixing parameter
+    tr2                ! the convergence threshold for potential
+  LOGICAL, PUBLIC :: &
+    conv_elec          ! if .TRUE. electron convergence has been reached
+  !
+  ! ... pw diagonalization
+  !
+  REAL(DP), PUBLIC  :: &
+    ethr               ! the convergence threshold for eigenvalues  
+  INTEGER, PUBLIC :: &
+    david,            &! used on Davidson diagonalization
+    isolve,           &! Davidson or CG or DIIS diagonalization
+    max_cg_iter,      &! maximum number of iterations in a CG di
+    diis_buff,        &! dimension of the buffer in diis
+    diis_ndim          ! dimension of reduced basis in DIIS
+  LOGICAL, PUBLIC :: &
+    diago_full_acc     ! if true all the empty eigenvalues have the same
+                       ! accuracy of the occupied ones
+  !
+  ! ... wfc and rho extrapolation
+  !
+  REAL(DP), PUBLIC  :: &
+    alpha0,           &! the mixing parameters for the extrapolation
+    beta0              ! of the starting potential
+  INTEGER, PUBLIC :: &
+    history,          &! number of old steps available for potential updating
+    pot_order,        &! type of potential updating ( see update_pot )
+    wfc_order          ! type of wavefunctions updating ( see update_pot )
+  !
+  ! ... ionic dynamics
+  !
+  INTEGER, PUBLIC :: &
+    nstep,            &! number of ionic steps
+    istep = 0          ! current ionic step  
+  LOGICAL, PUBLIC :: &
+    conv_ions          ! if .TRUE. ionic convergence has been reached
+  REAL(DP), PUBLIC  :: &
+    upscale            ! maximum reduction of convergence threshold
+  !
+  ! ... system's symmetries
+  !
+  LOGICAL, PUBLIC :: &
+    nosym,            &! if .TRUE. no symmetry is used
+    noinv = .FALSE.    ! if .TRUE. eliminates inversion symmetry
+  !
+  ! ... phonon calculation
+  !
+  INTEGER, PUBLIC :: &
+    modenum            ! for single mode phonon calculation
+  !
+  ! ... printout control
+  !
+  LOGICAL, PUBLIC :: &
+    reduce_io          ! if .TRUE. reduce the I/O to the strict minimum
+  INTEGER, PUBLIC :: &
+    iverbosity         ! type of printing ( 0 few, 1 all )
+  LOGICAL, PUBLIC :: &
+    use_para_diago = .FALSE.  ! if .TRUE. a parallel Householder algorithm 
+  INTEGER, PUBLIC :: &
+    para_diago_dim = 0        ! minimum matrix dimension above which a parallel
+  INTEGER  :: ortho_max = 0    ! maximum number of iterations in routine ortho
+  REAL(DP) :: ortho_eps = 0.D0 ! threshold for convergence in routine ortho
+  LOGICAL, PUBLIC :: &
+    use_task_groups = .FALSE.  ! if TRUE task groups parallelization is used
+  INTEGER, PUBLIC :: iesr = 1
+  LOGICAL,          PUBLIC :: tvhmean = .FALSE.  
+  REAL(DP),         PUBLIC :: vhrmin = 0.0d0
+  REAL(DP),         PUBLIC :: vhrmax = 1.0d0
+  CHARACTER(LEN=1), PUBLIC :: vhasse = 'Z'
+  LOGICAL,          PUBLIC :: tprojwfc = .FALSE.
+  CONTAINS
+    SUBROUTINE fix_dependencies()
+    END SUBROUTINE fix_dependencies
+    SUBROUTINE check_flags()
+    END SUBROUTINE check_flags
+END MODULE control_flags
+
+!
+! Copyright (C) 2002 FPMD 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 gvecw
+!=----------------------------------------------------------------------------=!
+     USE kinds, ONLY: DP
+
+     IMPLICIT NONE
+     SAVE
+
+     ! ...   G vectors less than the wave function cut-off ( ecutwfc )
+     INTEGER :: ngw  = 0  ! local number of G vectors
+     INTEGER :: ngwt = 0  ! in parallel execution global number of G vectors,
+                       ! in serial execution this is equal to ngw
+     INTEGER :: ngwl = 0  ! number of G-vector shells up to ngw
+     INTEGER :: ngwx = 0  ! maximum local number of G vectors
+     INTEGER :: ng0  = 0  ! first G-vector with nonzero modulus
+                       ! needed in the parallel case (G=0 is on one node only!)
+
+     REAL(DP) :: ecutw = 0.0d0
+     REAL(DP) :: gcutw = 0.0d0
+
+     !   values for costant cut-off computations
+
+     REAL(DP) :: ecfix = 0.0d0     ! value of the constant cut-off
+     REAL(DP) :: ecutz = 0.0d0     ! height of the penalty function (above ecfix)
+     REAL(DP) :: ecsig = 0.0d0     ! spread of the penalty function around ecfix
+     LOGICAL   :: tecfix = .FALSE.  ! .TRUE. if constant cut-off is in use
+
+     ! augmented cut-off for k-point calculation
+
+     REAL(DP) :: ekcut = 0.0d0  
+     REAL(DP) :: gkcut = 0.0d0
+    
+     ! array of G vectors module plus penalty function for constant cut-off 
+     ! simulation.
+     !
+     ! ggp = g + ( agg / tpiba**2 ) * ( 1 + erf( ( tpiba2 * g - e0gg ) / sgg ) )
+
+     REAL(DP), ALLOCATABLE, TARGET :: ggp(:)
+
+   CONTAINS
+
+     SUBROUTINE deallocate_gvecw
+       IF( ALLOCATED( ggp ) ) DEALLOCATE( ggp )
+     END SUBROUTINE deallocate_gvecw
+
+!=----------------------------------------------------------------------------=!
+   END MODULE gvecw
+!=----------------------------------------------------------------------------=!
+
+!=----------------------------------------------------------------------------=!
+   MODULE gvecs
+!=----------------------------------------------------------------------------=!
+     USE kinds, ONLY: DP
+
+     IMPLICIT NONE
+     SAVE
+
+     ! ...   G vectors less than the smooth grid cut-off ( ? )
+     INTEGER :: ngs  = 0  ! local number of G vectors
+     INTEGER :: ngst = 0  ! in parallel execution global number of G vectors,
+                       ! in serial execution this is equal to ngw
+     INTEGER :: ngsl = 0  ! number of G-vector shells up to ngw
+     INTEGER :: ngsx = 0  ! maximum local number of G vectors
+
+     INTEGER, ALLOCATABLE :: nps(:), nms(:)
+
+     REAL(DP) :: ecuts = 0.0d0
+     REAL(DP) :: gcuts = 0.0d0
+
+     REAL(DP) :: dual = 0.0d0
+     LOGICAL   :: doublegrid = .FALSE.
+
+   CONTAINS
+
+     SUBROUTINE deallocate_gvecs()
+       IF( ALLOCATED( nps ) ) DEALLOCATE( nps )
+       IF( ALLOCATED( nms ) ) DEALLOCATE( nms )
+     END SUBROUTINE deallocate_gvecs
+
+!=----------------------------------------------------------------------------=!
+   END MODULE gvecs
+!=----------------------------------------------------------------------------=!
+
+  MODULE electrons_base
+      USE kinds, ONLY: DP
+      IMPLICIT NONE
+      SAVE
+
+      INTEGER :: nbnd       = 0    !  number electronic bands, each band contains
+                                   !  two spin states
+      INTEGER :: nbndx      = 0    !  array dimension nbndx >= nbnd
+      INTEGER :: nspin      = 0    !  nspin = number of spins (1=no spin, 2=LSDA)
+      INTEGER :: nel(2)     = 0    !  number of electrons (up, down)
+      INTEGER :: nelt       = 0    !  total number of electrons ( up + down )
+      INTEGER :: nupdwn(2)  = 0    !  number of states with spin up (1) and down (2)
+      INTEGER :: iupdwn(2)  = 0    !  first state with spin (1) and down (2)
+      INTEGER :: nudx       = 0    !  max (nupdw(1),nupdw(2))
+      INTEGER :: nbsp       = 0    !  total number of electronic states 
+                                   !  (nupdwn(1)+nupdwn(2))
+      INTEGER :: nbspx      = 0    !  array dimension nbspx >= nbsp
+
+      LOGICAL :: telectrons_base_initval = .FALSE.
+      LOGICAL :: keep_occ = .FALSE.  ! if .true. when reading restart file keep 
+                                     ! the occupations calculated in initval
+
+      REAL(DP), ALLOCATABLE :: f(:)   ! occupation numbers ( at gamma )
+      REAL(DP) :: qbac = 0.0d0        ! background neutralizing charge
+      INTEGER, ALLOCATABLE :: ispin(:) ! spin of each state
+!
+!------------------------------------------------------------------------------!
+  CONTAINS
+!------------------------------------------------------------------------------!
+
+
+    SUBROUTINE electrons_base_initval( zv_ , na_ , nsp_ , nelec_ , nelup_ , neldw_ , nbnd_ , &
+               nspin_ , occupations_ , f_inp, tot_charge_, multiplicity_, tot_magnetization_ )
+      REAL(DP),         INTENT(IN) :: zv_ (:), tot_charge_
+      REAL(DP),         INTENT(IN) :: nelec_ , nelup_ , neldw_
+      REAL(DP),         INTENT(IN) :: f_inp(:,:)
+      INTEGER,          INTENT(IN) :: na_ (:) , nsp_, multiplicity_, tot_magnetization_
+      INTEGER,          INTENT(IN) :: nbnd_ , nspin_
+      CHARACTER(LEN=*), INTENT(IN) :: occupations_
+    END SUBROUTINE electrons_base_initval
+
+
+    subroutine set_nelup_neldw ( nelec_, nelup_, neldw_, tot_magnetization_, &
+         multiplicity_)
+      !
+      REAL (KIND=DP), intent(IN)    :: nelec_
+      REAL (KIND=DP), intent(INOUT) :: nelup_, neldw_
+      INTEGER,        intent(IN)    :: tot_magnetization_, multiplicity_
+    end subroutine set_nelup_neldw
+
+!----------------------------------------------------------------------------
+
+
+    SUBROUTINE deallocate_elct()
+      IF( ALLOCATED( f ) ) DEALLOCATE( f )
+      IF( ALLOCATED( ispin ) ) DEALLOCATE( ispin )
+      telectrons_base_initval = .FALSE.
+      RETURN
+    END SUBROUTINE deallocate_elct
+
+
+!------------------------------------------------------------------------------!
+  END MODULE electrons_base
+!------------------------------------------------------------------------------!
+
+
+
+!------------------------------------------------------------------------------!
+  MODULE electrons_nose
+!------------------------------------------------------------------------------!
+
+      USE kinds, ONLY: DP
+!
+      IMPLICIT NONE
+      SAVE
+
+      REAL(DP) :: fnosee   = 0.0d0   !  frequency of the thermostat ( in THz )
+      REAL(DP) :: qne      = 0.0d0   !  mass of teh termostat
+      REAL(DP) :: ekincw   = 0.0d0   !  kinetic energy to be kept constant
+
+      REAL(DP) :: xnhe0   = 0.0d0   
+      REAL(DP) :: xnhep   = 0.0d0   
+      REAL(DP) :: xnhem   = 0.0d0   
+      REAL(DP) :: vnhe    = 0.0d0
+  CONTAINS
+  subroutine electrons_nose_init( ekincw_ , fnosee_ )
+     REAL(DP), INTENT(IN) :: ekincw_, fnosee_
+  end subroutine electrons_nose_init
+
+
+  function electrons_nose_nrg( xnhe0, vnhe, qne, ekincw )
+    real(8) :: electrons_nose_nrg
+    real(8), intent(in) :: xnhe0, vnhe, qne, ekincw
+    electrons_nose_nrg = 0.0
+  end function electrons_nose_nrg
+
+  subroutine electrons_nose_shiftvar( xnhep, xnhe0, xnhem )
+    implicit none
+    real(8), intent(out) :: xnhem
+    real(8), intent(inout) :: xnhe0
+    real(8), intent(in) :: xnhep
+  end subroutine electrons_nose_shiftvar
+
+  subroutine electrons_nosevel( vnhe, xnhe0, xnhem, delt )
+    implicit none
+    real(8), intent(inout) :: vnhe
+    real(8), intent(in) :: xnhe0, xnhem, delt 
+  end subroutine electrons_nosevel
+
+  subroutine electrons_noseupd( xnhep, xnhe0, xnhem, delt, qne, ekinc, ekincw, vnhe )
+    implicit none
+    real(8), intent(out) :: xnhep, vnhe
+    real(8), intent(in) :: xnhe0, xnhem, delt, qne, ekinc, ekincw
+  end subroutine electrons_noseupd
+
+
+  SUBROUTINE electrons_nose_info()
+  END SUBROUTINE electrons_nose_info
+  END MODULE electrons_nose
+
+module cvan
+  use parameters, only: nsx
+  implicit none
+  save
+  integer nvb, ish(nsx)
+  integer, allocatable:: indlm(:,:)
+contains
+  subroutine allocate_cvan( nind, ns )
+    integer, intent(in) :: nind, ns
+  end subroutine allocate_cvan
+
+  subroutine deallocate_cvan( )
+  end subroutine deallocate_cvan
+
+end module cvan
+
+  MODULE cell_base
+      USE kinds, ONLY : DP
+      IMPLICIT NONE
+      SAVE
+        REAL(DP) :: alat = 0.0d0
+        REAL(DP) :: celldm(6) = (/ 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0 /)
+        REAL(DP) :: a1(3) = (/ 0.0d0, 0.0d0, 0.0d0 /)
+        REAL(DP) :: a2(3) = (/ 0.0d0, 0.0d0, 0.0d0 /)
+        REAL(DP) :: a3(3) = (/ 0.0d0, 0.0d0, 0.0d0 /)
+        REAL(DP) :: b1(3) = (/ 0.0d0, 0.0d0, 0.0d0 /)
+        REAL(DP) :: b2(3) = (/ 0.0d0, 0.0d0, 0.0d0 /)
+        REAL(DP) :: b3(3) = (/ 0.0d0, 0.0d0, 0.0d0 /)
+        REAL(DP) :: ainv(3,3) = 0.0d0
+        REAl(DP) :: omega = 0.0d0  !  volume of the simulation cell
+        REAL(DP) :: tpiba  = 0.0d0   !  = 2 PI / alat
+        REAL(DP) :: tpiba2 = 0.0d0   !  = ( 2 PI / alat ) ** 2
+        REAL(DP) :: at(3,3) = RESHAPE( (/ 0.0d0 /), (/ 3, 3 /), (/ 0.0d0 /) )
+        REAL(DP) :: bg(3,3) = RESHAPE( (/ 0.0d0 /), (/ 3, 3 /), (/ 0.0d0 /) )
+        INTEGER          :: ibrav      ! index of the bravais lattice
+        CHARACTER(len=9) :: symm_type  ! 'cubic' or 'hexagonal' when ibrav=0
+        REAL(DP) :: h(3,3)    = 0.0d0 ! simulation cell at time t 
+        REAL(DP) :: hold(3,3) = 0.0d0 ! simulation cell at time t-delt
+        REAL(DP) :: hnew(3,3) = 0.0d0 ! simulation cell at time t+delt
+        REAL(DP) :: velh(3,3) = 0.0d0 ! simulation cell velocity
+        REAL(DP) :: deth      = 0.0d0 ! determinant of h ( cell volume )
+        INTEGER   :: iforceh(3,3) = 1  ! if iforceh( i, j ) = 0 then h( i, j ) 
+        LOGICAL   :: thdiag = .FALSE.  ! True if only cell diagonal elements 
+        REAL(DP) :: wmass = 0.0d0     ! cell fictitious mass
+        REAL(DP) :: press = 0.0d0     ! external pressure 
+        REAL(DP) :: frich  = 0.0d0    ! firction parameter for cell damped dynamics
+        REAL(DP) :: greash = 1.0d0    ! greas parameter for damped dynamics
+        LOGICAL :: tcell_base_init = .FALSE.
+  CONTAINS
+        SUBROUTINE updatecell(box_tm1, box_t0, box_tp1)
+          integer :: box_tm1, box_t0, box_tp1
+        END SUBROUTINE updatecell
+        SUBROUTINE dgcell( gcdot, box_tm1, box_t0, delt )
+          REAL(DP), INTENT(OUT) :: GCDOT(3,3)
+          REAL(DP), INTENT(IN) :: delt
+          integer, intent(in) :: box_tm1, box_t0
+        END SUBROUTINE dgcell
+
+        SUBROUTINE cell_init_ht( box, ht )
+          integer :: box
+          REAL(DP) :: ht(3,3)
+        END SUBROUTINE cell_init_ht
+
+        SUBROUTINE cell_init_a( box, a1, a2, a3 )
+          integer :: box
+          REAL(DP) :: a1(3), a2(3), a3(3)
+        END SUBROUTINE cell_init_a
+
+        SUBROUTINE r_to_s1 (r,s,box)
+          REAL(DP), intent(out) ::  S(3)
+          REAL(DP), intent(in) :: R(3)
+          integer, intent(in) :: box
+        END SUBROUTINE r_to_s1
+
+        SUBROUTINE r_to_s3 ( r, s, na, nsp, hinv )
+          REAL(DP), intent(out) ::  S(:,:)
+          INTEGER, intent(in) ::  na(:), nsp
+          REAL(DP), intent(in) :: R(:,:)
+          REAL(DP), intent(in) :: hinv(:,:)    ! hinv = TRANSPOSE( box%m1 )
+          integer :: i, j, ia, is, isa
+          isa = 0
+          DO is = 1, nsp
+            DO ia = 1, na(is)
+              isa = isa + 1
+              DO I=1,3
+                S(I,isa) = 0.D0
+                DO J=1,3
+                  S(I,isa) = S(I,isa) + R(J,isa)*hinv(i,j)
+                END DO
+              END DO
+            END DO
+          END DO
+          RETURN
+        END SUBROUTINE r_to_s3
+
+!------------------------------------------------------------------------------!
+
+        SUBROUTINE r_to_s1b ( r, s, hinv )
+          REAL(DP), intent(out) ::  S(:)
+          REAL(DP), intent(in) :: R(:)
+          REAL(DP), intent(in) :: hinv(:,:)    ! hinv = TRANSPOSE( box%m1 )
+          integer :: i, j
+          DO I=1,3
+            S(I) = 0.D0
+            DO J=1,3
+              S(I) = S(I) + R(J)*hinv(i,j)
+            END DO
+          END DO
+          RETURN
+        END SUBROUTINE r_to_s1b
+
+
+        SUBROUTINE s_to_r1 (S,R,box)
+          REAL(DP), intent(in) ::  S(3)
+          REAL(DP), intent(out) :: R(3)
+          integer, intent(in) :: box
+        END SUBROUTINE s_to_r1
+
+        SUBROUTINE s_to_r1b (S,R,h)
+          REAL(DP), intent(in) ::  S(3)
+          REAL(DP), intent(out) :: R(3)
+          REAL(DP), intent(in) :: h(:,:)    ! h = TRANSPOSE( box%a )
+        END SUBROUTINE s_to_r1b
+
+        SUBROUTINE s_to_r3 ( S, R, na, nsp, h )
+          REAL(DP), intent(in) ::  S(:,:)
+          INTEGER, intent(in) ::  na(:), nsp
+          REAL(DP), intent(out) :: R(:,:)
+          REAL(DP), intent(in) :: h(:,:)    ! h = TRANSPOSE( box%a )
+        END SUBROUTINE s_to_r3
+
+      SUBROUTINE gethinv(box)
+        IMPLICIT NONE
+        integer, INTENT (INOUT) :: box
+      END SUBROUTINE gethinv
+
+
+      FUNCTION get_volume( hmat )
+         IMPLICIT NONE
+         REAL(DP) :: get_volume
+         REAL(DP) :: hmat( 3, 3 )
+          get_volume = 4.4
+      END FUNCTION get_volume
+
+      FUNCTION pbc(rin,box,nl) RESULT (rout)
+        IMPLICIT NONE
+        integer :: box
+        REAL (DP) :: rin(3)
+        REAL (DP) :: rout(3), s(3)
+        INTEGER, OPTIONAL :: nl(3)
+        rout = 4.4
+      END FUNCTION pbc
+
+          SUBROUTINE get_cell_param(box,cell,ang)
+          IMPLICIT NONE
+          integer, INTENT(in) :: box
+          REAL(DP), INTENT(out), DIMENSION(3) :: cell
+          REAL(DP), INTENT(out), DIMENSION(3), OPTIONAL :: ang
+          END SUBROUTINE get_cell_param
+
+      SUBROUTINE pbcs_components(x1, y1, z1, x2, y2, z2, m)
+        USE kinds
+        INTEGER, INTENT(IN)  :: M
+        REAL(DP),  INTENT(IN)  :: X1,Y1,Z1
+        REAL(DP),  INTENT(OUT) :: X2,Y2,Z2
+        REAL(DP) MIC
+      END SUBROUTINE pbcs_components
+
+      SUBROUTINE pbcs_vectors(v, w, m)
+        USE kinds
+        INTEGER, INTENT(IN)  :: m
+        REAL(DP),  INTENT(IN)  :: v(3)
+        REAL(DP),  INTENT(OUT) :: w(3)
+        REAL(DP) :: MIC
+      END SUBROUTINE pbcs_vectors
+
+  SUBROUTINE cell_base_init( ibrav_ , celldm_ , trd_ht, cell_symmetry, rd_ht, cell_units, &
+               a_ , b_ , c_ , cosab, cosac, cosbc, wc_ , total_ions_mass , press_ ,  &
+               frich_ , greash_ , cell_dofree )
+
+    IMPLICIT NONE
+    INTEGER, INTENT(IN) :: ibrav_
+    REAL(DP), INTENT(IN) :: celldm_ (6)
+    LOGICAL, INTENT(IN) :: trd_ht
+    CHARACTER(LEN=*), INTENT(IN) :: cell_symmetry
+    REAL(DP), INTENT(IN) :: rd_ht (3,3)
+    CHARACTER(LEN=*), INTENT(IN) :: cell_units
+    REAL(DP), INTENT(IN) :: a_ , b_ , c_ , cosab, cosac, cosbc
+    CHARACTER(LEN=*), INTENT(IN) :: cell_dofree
+    REAL(DP),  INTENT(IN) :: wc_ , frich_ , greash_ , total_ions_mass
+    REAL(DP),  INTENT(IN) :: press_  ! external pressure from imput ( GPa )
+  END SUBROUTINE cell_base_init
+
+
+  SUBROUTINE cell_base_reinit( ht )
+    REAL(DP), INTENT(IN) :: ht (3,3)
+  END SUBROUTINE cell_base_reinit
+
+  SUBROUTINE cell_steepest( hnew, h, delt, iforceh, fcell )
+    REAL(DP), INTENT(OUT) :: hnew(3,3)
+    REAL(DP), INTENT(IN) :: h(3,3), fcell(3,3)
+    INTEGER,      INTENT(IN) :: iforceh(3,3)
+    REAL(DP), INTENT(IN) :: delt
+  END SUBROUTINE cell_steepest
+
+  SUBROUTINE cell_verlet( hnew, h, hold, delt, iforceh, fcell, frich, tnoseh, hnos )
+    REAL(DP), INTENT(OUT) :: hnew(3,3)
+    REAL(DP), INTENT(IN) :: h(3,3), hold(3,3), hnos(3,3), fcell(3,3)
+    INTEGER,      INTENT(IN) :: iforceh(3,3)
+    REAL(DP), INTENT(IN) :: frich, delt
+    LOGICAL,      INTENT(IN) :: tnoseh
+  END SUBROUTINE cell_verlet
+
+  subroutine cell_hmove( h, hold, delt, iforceh, fcell )
+    REAL(DP), intent(out) :: h(3,3)
+    REAL(DP), intent(in) :: hold(3,3), fcell(3,3)
+    REAL(DP), intent(in) :: delt
+    integer, intent(in) :: iforceh(3,3)
+  end subroutine cell_hmove
+
+  subroutine cell_force( fcell, ainv, stress, omega, press, wmass )
+    REAL(DP), intent(out) :: fcell(3,3)
+    REAL(DP), intent(in) :: stress(3,3), ainv(3,3)
+    REAL(DP), intent(in) :: omega, press, wmass
+  end subroutine cell_force
+
+  subroutine cell_move( hnew, h, hold, delt, iforceh, fcell, frich, tnoseh, vnhh, velh, tsdc )
+    REAL(DP), intent(out) :: hnew(3,3)
+    REAL(DP), intent(in) :: h(3,3), hold(3,3), fcell(3,3)
+    REAL(DP), intent(in) :: vnhh(3,3), velh(3,3)
+    integer,      intent(in) :: iforceh(3,3)
+    REAL(DP), intent(in) :: frich, delt
+    logical,      intent(in) :: tnoseh, tsdc
+  end subroutine cell_move
+
+  subroutine cell_gamma( hgamma, ainv, h, velh )
+    REAL(DP) :: hgamma(3,3)
+    REAL(DP), intent(in) :: ainv(3,3), h(3,3), velh(3,3)
+  end subroutine cell_gamma
+
+  subroutine cell_kinene( ekinh, temphh, velh )
+    REAL(DP), intent(out) :: ekinh, temphh(3,3)
+    REAL(DP), intent(in)  :: velh(3,3)
+  end subroutine cell_kinene
+
+  function cell_alat( )
+    real(DP) :: cell_alat
+    cell_alat = 4.4
+  end function cell_alat
+   END MODULE cell_base
+
+
+  MODULE ions_base
+      USE kinds,      ONLY : DP
+      USE parameters, ONLY : ntypx
+      IMPLICIT NONE
+      SAVE
+      INTEGER :: nsp     = 0
+      INTEGER :: na(5) = 0    
+      INTEGER :: nax     = 0
+      INTEGER :: nat     = 0
+      REAL(DP) :: zv(5)    = 0.0d0
+      REAL(DP) :: pmass(5) = 0.0d0
+      REAL(DP) :: amass(5) = 0.0d0
+      REAL(DP) :: rcmax(5) = 0.0d0
+      INTEGER,  ALLOCATABLE :: ityp(:)
+      REAL(DP), ALLOCATABLE :: tau(:,:)     !  initial positions read from stdin (in bohr)
+      REAL(DP), ALLOCATABLE :: vel(:,:)     !  initial velocities read from stdin (in bohr)
+      REAL(DP), ALLOCATABLE :: tau_srt(:,:) !  tau sorted by specie in bohr
+      REAL(DP), ALLOCATABLE :: vel_srt(:,:) !  vel sorted by specie in bohr
+      INTEGER,  ALLOCATABLE :: ind_srt(:)   !  index of tau sorted by specie
+      INTEGER,  ALLOCATABLE :: ind_bck(:)   !  reverse of ind_srt
+      CHARACTER(LEN=3)      :: atm( 5 ) 
+      CHARACTER(LEN=80)     :: tau_units
+
+
+      INTEGER, ALLOCATABLE :: if_pos(:,:)  ! if if_pos( x, i ) = 0 then  x coordinate of 
+                                           ! the i-th atom will be kept fixed
+      INTEGER, ALLOCATABLE :: iforce(:,:)  ! if_pos sorted by specie 
+      INTEGER :: fixatom   = -1            ! to be removed
+      INTEGER :: ndofp     = -1            ! ionic degree of freedom
+      INTEGER :: ndfrz     = 0             ! frozen degrees of freedom
+
+      REAL(DP) :: fricp   ! friction parameter for damped dynamics
+      REAL(DP) :: greasp  ! friction parameter for damped dynamics
+      REAL(DP), ALLOCATABLE :: taui(:,:)
+      REAL(DP) :: cdmi(3), cdm(3)
+      REAL(DP) :: cdms(3)
+      LOGICAL :: tions_base_init = .FALSE.
+  CONTAINS
+    SUBROUTINE packtau( taup, tau, na, nsp )
+      REAL(DP), INTENT(OUT) :: taup( :, : )
+      REAL(DP), INTENT(IN) :: tau( :, :, : )
+      INTEGER, INTENT(IN) :: na( : ), nsp
+    END SUBROUTINE packtau
+
+    SUBROUTINE unpacktau( tau, taup, na, nsp )
+      REAL(DP), INTENT(IN) :: taup( :, : )
+      REAL(DP), INTENT(OUT) :: tau( :, :, : )
+      INTEGER, INTENT(IN) :: na( : ), nsp
+    END SUBROUTINE unpacktau
+
+    SUBROUTINE sort_tau( tausrt, isrt, tau, isp, nat, nsp )
+      REAL(DP), INTENT(OUT) :: tausrt( :, : )
+      INTEGER, INTENT(OUT) :: isrt( : )
+      REAL(DP), INTENT(IN) :: tau( :, : )
+      INTEGER, INTENT(IN) :: nat, nsp, isp( : )
+      INTEGER :: ina( nsp ), na( nsp )
+    END SUBROUTINE sort_tau
+
+    SUBROUTINE unsort_tau( tau, tausrt, isrt, nat )
+      REAL(DP), INTENT(IN) :: tausrt( :, : )
+      INTEGER, INTENT(IN) :: isrt( : )
+      REAL(DP), INTENT(OUT) :: tau( :, : )
+      INTEGER, INTENT(IN) :: nat
+    END SUBROUTINE unsort_tau
+
+    SUBROUTINE ions_base_init( nsp_, nat_, na_, ityp_, tau_, vel_, amass_, &
+                               atm_, if_pos_, tau_units_, alat_, a1_, a2_, &
+                               a3_, rcmax_ )
+      INTEGER,          INTENT(IN) :: nsp_, nat_, na_(:), ityp_(:)
+      REAL(DP),         INTENT(IN) :: tau_(:,:)
+      REAL(DP),         INTENT(IN) :: vel_(:,:)
+      REAL(DP),         INTENT(IN) :: amass_(:)
+      CHARACTER(LEN=*), INTENT(IN) :: atm_(:)
+      CHARACTER(LEN=*), INTENT(IN) :: tau_units_
+      INTEGER,          INTENT(IN) :: if_pos_(:,:)
+      REAL(DP),         INTENT(IN) :: alat_, a1_(3), a2_(3), a3_(3)
+      REAL(DP),         INTENT(IN) :: rcmax_(:)
+    END SUBROUTINE ions_base_init
+
+    SUBROUTINE deallocate_ions_base()
+    END SUBROUTINE deallocate_ions_base
+
+    SUBROUTINE ions_vel3( vel, taup, taum, na, nsp, dt )
+      REAL(DP) :: vel(:,:), taup(:,:), taum(:,:)
+      INTEGER :: na(:), nsp
+      REAL(DP) :: dt
+    END SUBROUTINE ions_vel3
+
+    SUBROUTINE ions_vel2( vel, taup, taum, nat, dt )
+      REAL(DP) :: vel(:,:), taup(:,:), taum(:,:)
+      INTEGER :: nat
+      REAL(DP) :: dt
+    END SUBROUTINE ions_vel2
+
+    SUBROUTINE cofmass1( tau, pmass, na, nsp, cdm )
+      REAL(DP), INTENT(IN) :: tau(:,:,:), pmass(:)
+      REAL(DP), INTENT(OUT) :: cdm(3)
+      INTEGER, INTENT(IN) :: na(:), nsp
+    END SUBROUTINE cofmass1
+
+    SUBROUTINE cofmass2( tau, pmass, na, nsp, cdm )
+      REAL(DP), INTENT(IN) :: tau(:,:), pmass(:)
+      REAL(DP), INTENT(OUT) :: cdm(3)
+      INTEGER, INTENT(IN) :: na(:), nsp
+    END SUBROUTINE cofmass2
+
+      SUBROUTINE randpos(tau, na, nsp, tranp, amprp, hinv, ifor )
+         REAL(DP) :: hinv(3,3)
+         REAL(DP) :: tau(:,:)
+         INTEGER, INTENT(IN) :: ifor(:,:), na(:), nsp
+         LOGICAL, INTENT(IN) :: tranp(:)
+         REAL(DP), INTENT(IN) :: amprp(:)
+         REAL(DP) :: oldp(3), rand_disp(3), rdisp(3)
+
+       END SUBROUTINE randpos
+
+  SUBROUTINE ions_kinene( ekinp, vels, na, nsp, h, pmass )
+    REAL(DP), intent(out) :: ekinp     !  ionic kinetic energy
+    REAL(DP), intent(in) :: vels(:,:)  !  scaled ionic velocities
+    REAL(DP), intent(in) :: pmass(:)   !  ionic masses
+    REAL(DP), intent(in) :: h(:,:)     !  simulation cell
+    integer, intent(in) :: na(:), nsp
+    integer :: i, j, is, ia, ii, isa
+  END SUBROUTINE ions_kinene
+
+  subroutine ions_temp( tempp, temps, ekinpr, vels, na, nsp, h, pmass, ndega, nhpdim, atm2nhp, ekin2nhp )
+    REAL(DP), intent(out) :: ekinpr, tempp
+    REAL(DP), intent(out) :: temps(:)
+    REAL(DP), intent(out) :: ekin2nhp(:)
+    REAL(DP), intent(in)  :: vels(:,:)
+    REAL(DP), intent(in)  :: pmass(:)
+    REAL(DP), intent(in)  :: h(:,:)
+    integer,        intent(in)  :: na(:), nsp, ndega, nhpdim, atm2nhp(:)
+  end subroutine ions_temp
+
+  subroutine ions_thermal_stress( stress, pmass, omega, h, vels, nsp, na )
+    REAL(DP), intent(inout) :: stress(3,3)
+    REAL(DP), intent(in)  :: pmass(:), omega, h(3,3), vels(:,:)
+    integer, intent(in) :: nsp, na(:)
+    integer :: i, j, is, ia, isa
+  end subroutine ions_thermal_stress
+
+  subroutine ions_vrescal( tcap, tempw, tempp, taup, tau0, taum, na, nsp, fion, iforce, &
+                           pmass, delt )
+    logical, intent(in) :: tcap
+    REAL(DP), intent(inout) :: taup(:,:)
+    REAL(DP), intent(in) :: tau0(:,:), taum(:,:), fion(:,:)
+    REAL(DP), intent(in) :: delt, pmass(:), tempw, tempp
+    integer, intent(in) :: na(:), nsp
+    integer, intent(in) :: iforce(:,:)
+  end subroutine ions_vrescal
+  subroutine ions_shiftvar( varp, var0, varm )
+    REAL(DP), intent(in) :: varp
+    REAL(DP), intent(out) :: varm, var0
+  end subroutine ions_shiftvar
+   SUBROUTINE cdm_displacement( dis, tau )
+      REAL(DP) :: dis
+      REAL(DP) :: tau
+   END SUBROUTINE cdm_displacement
+   SUBROUTINE ions_displacement( dis, tau )
+      REAL (DP), INTENT(OUT) :: dis
+      REAL (DP), INTENT(IN)  :: tau
+   END SUBROUTINE ions_displacement
+  END MODULE ions_base