use_only_3.inc

用于进行gcc测试

  ! ... 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