use_only_3.inc

用于进行gcc测试

              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