scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Optional args of qexsd_init_* redefined as arrays 

the insertion of optional arguments in qexsd_init subroutines has been
modified. Instead of having a different call for each case with
differentdifferente arguments now a single call is done. Optional
arguments may be allocated according the case. To keep compatibility
with older gfortran versions allocatable scalars are treated as one
dimensional arrays.

PW/src/add_qexsd_step.f90 has been modified and now expects input
argumenarguments in Hartree units.
This commit is contained in:
Pietro Delugas 2018-04-10 17:59:34 +02:00
parent 516fcf6ed5
commit 680e1a7277
6 changed files with 391 additions and 158 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
CPV/src/cp_restart_new.f90
View File

@ -333,8 +333,8 @@ MODULE cp_restart_new
!-------------------------------------------------------------------------------
! ... BAND STRUCTURE
!-------------------------------------------------------------------------------
CALL qexsd_init_total_energy(output_obj%total_energy,enthal, 0.0_dp, eht,&
vave, exc, 0.0_dp, 0.0_dp, 0.0_dp)
CALL qexsd_init_total_energy(output_obj%total_energy, ETOT = enthal , &
EHART = eht, VTXC = vave, ETXC = exc )
!-------------------------------------------------------------------------------
! ... BAND STRUCTURE
!-------------------------------------------------------------------------------

236
Modules/qes_libs.f90
View File

@ -14,6 +14,7 @@ MODULE qes_libs_module
USE qes_types_module
USE FoX_wxml
IMPLICIT NONE
!
INTEGER, PARAMETER :: max_real_per_line=5
CHARACTER(32) :: fmtstr
@ -3819,6 +3820,88 @@ SUBROUTINE qes_reset_spin_constraints(obj)
END SUBROUTINE qes_reset_spin_constraints
SUBROUTINE qes_write_gate_settings(xp, obj)
IMPLICIT NONE
TYPE(xmlf_t) :: xp
TYPE(gate_settings_type) :: obj
!
IF ( .NOT. obj%lwrite ) RETURN
CALL xml_NewElement(xp,TRIM(obj%tagname))
CALL xml_NewElement(xp,"use_gate")
CALL xml_addCharacters(xp, obj%use_gate)
CALL xml_endElement(xp,"use_gate")
IF ( obj%zgate_ispresent ) THEN
CALL xml_NewElement(xp, "zgate")
CALL xml_addCharacters(xp, obj%zgate)
CALL xml_EndElement(xp,"zgate")
END IF
IF ( obj%relaxz_ispresent) THEN
CALL xml_NewElement(xp,"relaxz")
CALL xml_addCharacters(xp, obj%relaxz)
CALL xml_EndElement(xp, "relaxz")
ENDIF
IF ( obj%block_ispresent) THEN
CALL xml_NewElement(xp,"block")
CALL xml_addCharacters(xp, obj%block)
CALL xml_EndElement(xp, "block")
ENDIF
IF ( obj%block_1_ispresent) THEN
CALL xml_NewElement(xp,"block_1")
CALL xml_addCharacters(xp, obj%block_1)
CALL xml_EndElement(xp, "block_1")
ENDIF
IF ( obj%block_2_ispresent) THEN
CALL xml_NewElement(xp,"block_2")
CALL xml_addCharacters(xp, obj%block_2)
CALL xml_EndElement(xp, "block_2")
ENDIF
IF ( obj%block_height_ispresent) THEN
CALL xml_NewElement(xp,"block_height")
CALL xml_addCharacters(xp, obj%block_height)
CALL xml_EndElement(xp, "block_height")
ENDIF
CALL xml_endElement(xp, TRIM(obj%tagname))
END SUBROUTINE qes_write_gate_settings
SUBROUTINE qes_init_gate_settings( obj, tagname, use_gate, zgate, relaxz, block, block_1, block_2, block_height )
IMPLICIT NONE
TYPE(gate_settings_type) :: obj
CHARACTER(LEN=*) :: tagname
LOGICAL :: use_gate
REAL(DP),OPTIONAL :: zgate(1)
LOGICAL,OPTIONAL :: relaxz(1)
LOGICAL,OPTIONAL :: block(1)
REAL(DP),OPTIONAL :: block_1(1)
REAL(DP),OPTIONAL :: block_2(1)
REAL(DP),OPTIONAL :: block_height(1)
!
obj%tagname = TRIM(tagname)
obj%use_gate = use_gate
obj%relaxz_ispresent = PRESENT(relaxz)
IF( obj%relaxz_ispresent ) obj%relaxz = relaxz(1)
obj%zgate_ispresent = PRESENT(zgate)
IF (obj%zgate_ispresent) obj%zgate = zgate(1)
obj%block_ispresent = PRESENT(block)
IF( obj%block_ispresent) obj%block = block(1)
obj%block_1_ispresent = PRESENT(block_1)
IF (obj%block_1_ispresent) obj%block_1 = block_1(1)
obj%block_2_ispresent = PRESENT(block_2)
IF (obj%block_2_ispresent) obj%block_2 = block_2(1)
obj%block_height_ispresent = PRESENT(block_height)
IF (obj%block_height_ispresent) obj%block_height = block_height(1)
!
obj%lwrite = .TRUE.
obj%lread =.TRUE.
END SUBROUTINE qes_init_gate_settings
SUBROUTINE qes_reset_gate_settings(obj)
IMPLICIT NONE
TYPE(gate_settings_type) :: obj
obj%tagname = ""
obj%lwrite = .FALSE.
obj%lread = .FALSE.
END SUBROUTINE qes_reset_gate_settings
SUBROUTINE qes_write_electric_field(xp, obj)
IMPLICIT NONE
@ -3883,6 +3966,7 @@ SUBROUTINE qes_write_electric_field(xp, obj)
CALL xml_addCharacters(xp, obj%n_berry_cycles)
CALL xml_EndElement(xp, 'n_berry_cycles')
ENDIF
IF ( obj%gate_correction_ispresent) CALL qes_write_gate_settings(xp, obj%gate_correction)
!
CALL xml_EndElement(xp, TRIM(obj%tagname))
!
@ -3896,7 +3980,7 @@ SUBROUTINE qes_init_electric_field(obj, tagname, electric_potential, &
electric_field_amplitude_ispresent, electric_field_amplitude, &
electric_field_vector_ispresent, electric_field_vector, &
nk_per_string_ispresent, nk_per_string, &
n_berry_cycles_ispresent, n_berry_cycles)
n_berry_cycles_ispresent, n_berry_cycles, gate_settings)
IMPLICIT NONE
TYPE(electric_field_type) :: obj
@ -3919,6 +4003,7 @@ SUBROUTINE qes_init_electric_field(obj, tagname, electric_potential, &
INTEGER :: nk_per_string
LOGICAL :: n_berry_cycles_ispresent
INTEGER :: n_berry_cycles
TYPE(gate_settings_type), OPTIONAL :: gate_settings(1)
obj%tagname = TRIM(tagname)
obj%lwrite = .TRUE.
@ -3956,7 +4041,8 @@ SUBROUTINE qes_init_electric_field(obj, tagname, electric_potential, &
IF(obj%n_berry_cycles_ispresent) THEN
obj%n_berry_cycles = n_berry_cycles
ENDIF
obj%gate_correction_ispresent = PRESENT( gate_settings)
IF ( obj%gate_correction_ispresent ) obj%gate_correction = gate_settings(1)
END SUBROUTINE qes_init_electric_field
SUBROUTINE qes_reset_electric_field(obj)
@ -3991,7 +4077,10 @@ SUBROUTINE qes_reset_electric_field(obj)
IF(obj%n_berry_cycles_ispresent) THEN
obj%n_berry_cycles_ispresent = .FALSE.
ENDIF
IF (obj%gate_correction_ispresent) THEN
obj%gate_correction_ispresent = .FALSE.
CALL qes_reset_gate_settings(obj%gate_correction)
END IF
END SUBROUTINE qes_reset_electric_field
@ -4745,75 +4834,73 @@ SUBROUTINE qes_write_total_energy(xp, obj)
CALL xml_EndElement(xp, 'potentiostat_contr')
ENDIF
!
IF (obj%gatefield_contr_ispresent) THEN
CALL xml_NewElement(xp, 'gatefield_contr')
CALL xml_addCharacters(xp, obj%gatefield_contr, fmt = 's16')
CALL xml_EndElement(xp, 'gatefield_contr')
END IF
!
CALL xml_EndElement(xp, TRIM(obj%tagname))
!
END SUBROUTINE qes_write_total_energy
SUBROUTINE qes_init_total_energy(obj, tagname, etot, eband_ispresent, eband, &
ehart_ispresent, ehart, vtxc_ispresent, vtxc, etxc_ispresent, &
etxc, ewald_ispresent, ewald, demet_ispresent, demet, &
efieldcorr_ispresent, efieldcorr, &
potentiostat_contr_ispresent, potentiostat_contr)
SUBROUTINE qes_init_total_energy(obj, tagname, etot, eband, ehart, vtxc, etxc, ewald, demet, &
efieldcorr, potentiostat_contr, gate_contribution)
IMPLICIT NONE
TYPE(total_energy_type) :: obj
CHARACTER(len=*) :: tagname
INTEGER :: i
REAL(DP) :: etot
LOGICAL :: eband_ispresent
REAL(DP) :: eband
LOGICAL :: ehart_ispresent
REAL(DP) :: ehart
LOGICAL :: vtxc_ispresent
REAL(DP) :: vtxc
LOGICAL :: etxc_ispresent
REAL(DP) :: etxc
LOGICAL :: ewald_ispresent
REAL(DP) :: ewald
LOGICAL :: demet_ispresent
REAL(DP) :: demet
LOGICAL :: efieldcorr_ispresent
REAL(DP) :: efieldcorr
LOGICAL :: potentiostat_contr_ispresent
REAL(DP) :: potentiostat_contr
REAL(DP),OPTIONAL :: eband(1)
REAL(DP),OPTIONAL :: ehart(1)
REAL(DP),OPTIONAL :: vtxc(1)
REAL(DP),OPTIONAL :: etxc(1)
REAL(DP),OPTIONAL :: ewald(1)
REAL(DP),OPTIONAL :: demet(1)
REAL(DP),OPTIONAL :: efieldcorr(1)
REAL(DP),OPTIONAL :: potentiostat_contr(1)
REAL(DP),OPTIONAL :: gate_contribution(1)
!
!
obj%tagname = TRIM(tagname)
obj%lwrite = .TRUE.
obj%lread = .TRUE.
obj%etot = etot
obj%eband_ispresent = eband_ispresent
obj%eband_ispresent = PRESENT(eband)
IF(obj%eband_ispresent) THEN
obj%eband = eband
obj%eband = eband(1)
ENDIF
obj%ehart_ispresent = ehart_ispresent
obj%ehart_ispresent = PRESENT(ehart)
IF(obj%ehart_ispresent) THEN
obj%ehart = ehart
obj%ehart = ehart(1)
ENDIF
obj%vtxc_ispresent = vtxc_ispresent
obj%vtxc_ispresent = PRESENT(vtxc)
IF(obj%vtxc_ispresent) THEN
obj%vtxc = vtxc
obj%vtxc = vtxc(1)
ENDIF
obj%etxc_ispresent = etxc_ispresent
obj%etxc_ispresent = PRESENT(etxc)
IF(obj%etxc_ispresent) THEN
obj%etxc = etxc
obj%etxc = etxc(1)
ENDIF
obj%ewald_ispresent = ewald_ispresent
obj%ewald_ispresent = PRESENT(ewald)
IF(obj%ewald_ispresent) THEN
obj%ewald = ewald
obj%ewald = ewald(1)
ENDIF
obj%demet_ispresent = demet_ispresent
obj%demet_ispresent = PRESENT(demet)
IF(obj%demet_ispresent) THEN
obj%demet = demet
obj%demet = demet(1)
ENDIF
obj%efieldcorr_ispresent = efieldcorr_ispresent
obj%efieldcorr_ispresent = PRESENT(efieldcorr)
IF(obj%efieldcorr_ispresent) THEN
obj%efieldcorr = efieldcorr
obj%efieldcorr = efieldcorr(1)
ENDIF
obj%potentiostat_contr_ispresent = potentiostat_contr_ispresent
obj%potentiostat_contr_ispresent = PRESENT(potentiostat_contr)
IF(obj%potentiostat_contr_ispresent) THEN
obj%potentiostat_contr = potentiostat_contr
obj%potentiostat_contr = potentiostat_contr(1)
ENDIF
obj%gatefield_contr_ispresent = PRESENT(gate_contribution)
IF (obj%gatefield_contr_ispresent) obj%gatefield_contr=gate_contribution(1)
END SUBROUTINE qes_init_total_energy
SUBROUTINE qes_reset_total_energy(obj)
@ -6403,6 +6490,65 @@ SUBROUTINE qes_reset_step(obj)
END SUBROUTINE qes_reset_step
SUBROUTINE qes_write_gateInfo(xp, obj)
IMPLICIT NONE
TYPE(xmlf_t) :: xp
TYPE (gateInfo_type) :: obj
!
INTEGER :: i
!
IF ( .NOT. obj%lwrite ) RETURN
!
CALL xml_NewElement( xp, TRIM(obj%tagname) )
!
CALL xml_NewElement( xp, "pot_prefactor")
CALL xml_addCharacters( xp, obj%pot_prefactor, fmt='s16')
CALL xml_endElement(xp, TRIM(obj%tagname))
!
CALL xml_NewElement( xp, "gate_zpos")
CALL xml_addCharacters( xp, obj%gate_zpos, fmt = 's16')
CALL xml_EndElement(xp, "gate_zpos")
!
CALL xml_NewElement(xp, "gate_gate_term" )
CALL xml_AddCharacters(xp, obj%gate_gate_term, fmt = 's16')
CALL xml_endElement(xp, "gate_gate_term")
!
CALL xml_NewElement(xp, "gatefieldEnergy" )
CALL xml_AddCharacters(xp, obj%gatefieldEnergy, fmt = 's16')
CALL xml_endElement(xp, "gatefieldEnergy")
!
CALL xml_EndElement(xp, TRIM(obj%tagname))
END SUBROUTINE qes_write_gateInfo
SUBROUTINE qes_init_gateInfo(obj, tagname, pot_prefactor, gate_zpos, gate_gate_term, gatefieldEnergy)
IMPLICIT NONE
TYPE(gateInfo_type),INTENT(INOUT) :: obj
CHARACTER(LEN=*),INTENT(IN) :: tagname
REAL(DP),INTENT(IN) :: pot_prefactor
REAL(DP),INTENT(IN) :: gate_zpos
REAL(DP),INTENT(IN) :: gate_gate_term
REAL(DP),INTENT(IN) :: gatefieldEnergy
!
obj%tagname = TRIM(tagname)
obj%lwrite = .TRUE.
obj%lread = .TRUE.
obj%pot_prefactor = pot_prefactor
obj%gate_zpos = gate_zpos
obj%gate_gate_term = gate_gate_term
obj%gatefieldEnergy = gatefieldEnergy
END SUBROUTINE qes_init_gateInfo
SUBROUTINE qes_reset_gateInfo(obj)
IMPLICIT NONE
TYPE(gateInfo_type),INTENT(OUT) :: obj
obj%tagname= ""
obj%lwrite = .FALSE.
obj%lread = .FALSE.
END SUBROUTINE qes_reset_gateInfo
SUBROUTINE qes_write_outputElectricField(xp, obj)
IMPLICIT NONE
@ -6438,7 +6584,7 @@ END SUBROUTINE qes_write_outputElectricField
SUBROUTINE qes_init_outputElectricField(obj, tagname, BerryPhase_ispresent, BerryPhase, &
finiteElectricFieldInfo_ispresent, finiteElectricFieldInfo, &
dipoleInfo_ispresent, dipoleInfo)
dipoleInfo_ispresent, dipoleInfo, gateInfo)
IMPLICIT NONE
TYPE(outputElectricField_type) :: obj
@ -6450,6 +6596,7 @@ SUBROUTINE qes_init_outputElectricField(obj, tagname, BerryPhase_ispresent, Berr
TYPE(finiteFieldOut_type) :: finiteElectricFieldInfo
LOGICAL :: dipoleInfo_ispresent
TYPE(dipoleOutput_type) :: dipoleInfo
TYPE(gateInfo_type),OPTIONAL :: gateInfo(1)
obj%tagname = TRIM(tagname)
obj%lwrite = .TRUE.
@ -6466,7 +6613,8 @@ SUBROUTINE qes_init_outputElectricField(obj, tagname, BerryPhase_ispresent, Berr
IF(obj%dipoleInfo_ispresent) THEN
obj%dipoleInfo = dipoleInfo
ENDIF
obj%gateInfo_ispresent = PRESENT(gateInfo)
IF ( obj%gateInfo_ispresent) obj%gateInfo = gateInfo(1)
END SUBROUTINE qes_init_outputElectricField
SUBROUTINE qes_reset_outputElectricField(obj)

83
Modules/qes_types.f90
View File

@ -754,31 +754,27 @@ MODULE qes_types_module
!
END TYPE spin_constraints_type
!
TYPE :: electric_field_type
TYPE :: gate_settings_type
!
CHARACTER(len=100) :: tagname
LOGICAL :: lwrite = .FALSE.
LOGICAL :: lread = .FALSE.
!
CHARACTER(len=256) :: electric_potential
LOGICAL :: dipole_correction_ispresent = .FALSE.
LOGICAL :: dipole_correction
LOGICAL :: electric_field_direction_ispresent = .FALSE.
INTEGER :: electric_field_direction
LOGICAL :: potential_max_position_ispresent = .FALSE.
REAL(DP) :: potential_max_position
LOGICAL :: potential_decrease_width_ispresent = .FALSE.
REAL(DP) :: potential_decrease_width
LOGICAL :: electric_field_amplitude_ispresent = .FALSE.
REAL(DP) :: electric_field_amplitude
LOGICAL :: electric_field_vector_ispresent = .FALSE.
REAL(DP), DIMENSION(3) :: electric_field_vector
LOGICAL :: nk_per_string_ispresent = .FALSE.
INTEGER :: nk_per_string
LOGICAL :: n_berry_cycles_ispresent = .FALSE.
INTEGER :: n_berry_cycles
LOGICAL :: use_gate
LOGICAL :: zgate_ispresent = .FALSE.
REAL(DP) :: zgate
LOGICAL :: relaxz_ispresent = .FALSE.
LOGICAL :: relaxz
LOGICAL :: block_ispresent = .FALSE.
LOGICAL :: block
LOGICAL :: block_1_ispresent = .FALSE.
REAL(DP) :: block_1
LOGICAL :: block_2_ispresent = .FALSE.
REAL(DP) :: block_2
LOGICAL :: block_height_ispresent = .FALSE.
REAL(DP) :: block_height
!
END TYPE electric_field_type
END TYPE gate_settings_type
!
TYPE :: atomic_constraint_type
!
@ -856,6 +852,19 @@ MODULE qes_types_module
!
END TYPE electronicPolarization_type
!
TYPE :: gateInfo_type
!
CHARACTER(len=100) :: tagname
LOGICAL :: lwrite = .FALSE.
LOGICAL :: lread = .FALSE.
!
REAL(DP) :: pot_prefactor
REAL(DP) :: gate_zpos
REAL(DP) :: gate_gate_term
REAL(DP) :: gatefieldEnergy
!
END TYPE gateInfo_type
!
TYPE :: scf_conv_type
!
CHARACTER(len=100) :: tagname
@ -953,6 +962,8 @@ MODULE qes_types_module
REAL(DP) :: efieldcorr
LOGICAL :: potentiostat_contr_ispresent = .FALSE.
REAL(DP) :: potentiostat_contr
LOGICAL :: gatefield_contr_ispresent = .FALSE.
REAL(DP) :: gatefield_contr
!
END TYPE total_energy_type
!
@ -998,6 +1009,8 @@ MODULE qes_types_module
TYPE(atomic_positions_type) :: atomic_positions
LOGICAL :: wyckoff_positions_ispresent = .FALSE.
TYPE(wyckoff_positions_type) :: wyckoff_positions
LOGICAL :: crystal_positions_ispresent = .FALSE.
TYPE(atomic_positions_type) :: crystal_positions
TYPE(cell_type) :: cell
!
END TYPE atomic_structure_type
@ -1078,6 +1091,34 @@ MODULE qes_types_module
!
END TYPE boundary_conditions_type
!
TYPE :: electric_field_type
!
CHARACTER(len=100) :: tagname
LOGICAL :: lwrite = .FALSE.
LOGICAL :: lread = .FALSE.
!
CHARACTER(len=256) :: electric_potential
LOGICAL :: dipole_correction_ispresent = .FALSE.
LOGICAL :: dipole_correction
LOGICAL :: gate_correction_ispresent = .FALSE.
TYPE(gate_settings_type) :: gate_correction
LOGICAL :: electric_field_direction_ispresent = .FALSE.
INTEGER :: electric_field_direction
LOGICAL :: potential_max_position_ispresent = .FALSE.
REAL(DP) :: potential_max_position
LOGICAL :: potential_decrease_width_ispresent = .FALSE.
REAL(DP) :: potential_decrease_width
LOGICAL :: electric_field_amplitude_ispresent = .FALSE.
REAL(DP) :: electric_field_amplitude
LOGICAL :: electric_field_vector_ispresent = .FALSE.
REAL(DP), DIMENSION(3) :: electric_field_vector
LOGICAL :: nk_per_string_ispresent = .FALSE.
INTEGER :: nk_per_string
LOGICAL :: n_berry_cycles_ispresent = .FALSE.
INTEGER :: n_berry_cycles
!
END TYPE electric_field_type
!
TYPE :: atomic_constraints_type
!
CHARACTER(len=100) :: tagname
@ -1236,6 +1277,8 @@ MODULE qes_types_module
TYPE(finiteFieldOut_type) :: finiteElectricFieldInfo
LOGICAL :: dipoleInfo_ispresent = .FALSE.
TYPE(dipoleOutput_type) :: dipoleInfo
LOGICAL :: gateInfo_ispresent = .FALSE.
TYPE(gateInfo_type) :: gateInfo
!
END TYPE outputElectricField_type
!
@ -1272,4 +1315,4 @@ MODULE qes_types_module
END TYPE output_type
!
!
END MODULE qes_types_module
END MODULE qes_types_module

124
Modules/qexsd.f90
View File

@ -89,7 +89,7 @@ MODULE qexsd_module
qexsd_init_magnetization, qexsd_init_band_structure, &
qexsd_init_total_energy, qexsd_init_forces, qexsd_init_stress, &
qexsd_init_dipole_info, qexsd_init_outputElectricField, &
qexsd_init_outputPBC
qexsd_init_outputPBC, qexsd_init_gate_info
!
PUBLIC :: qexsd_step_addstep, qexsd_set_status
!
@ -1103,48 +1103,26 @@ CONTAINS
!
!---------------------------------------------------------------------------------------
SUBROUTINE qexsd_init_total_energy(obj, etot, eband, ehart, vtxc, etxc, &
ewald, degauss, demet, electric_field_corr, potentiostat_contr)
ewald, degauss, demet, electric_field_corr, potentiostat_contr, gate_contribution)
!----------------------------------------------------------------------------------------
!
!
IMPLICIT NONE
!
TYPE (total_energy_type) :: obj
REAL(DP),INTENT(IN) :: etot,eband,ehart,vtxc,etxc,ewald,demet
REAL(DP),INTENT(IN) :: degauss
REAL(DP),OPTIONAL,INTENT(IN) :: electric_field_corr
REAL(DP),OPTIONAL,INTENT(IN) :: potentiostat_contr
REAL(DP),INTENT(IN) :: etot, ehart,vtxc,etxc
REAL(DP),OPTIONAL,INTENT(IN) :: ewald(1),demet(1), eband(1), degauss(1)
REAL(DP),OPTIONAL :: electric_field_corr(1)
REAL(DP),OPTIONAL :: potentiostat_contr(1)
REAL(DP),OPTIONAL :: gate_contribution(1)
!
LOGICAL :: demet_ispresent
CHARACTER(LEN=*),PARAMETER :: TAGNAME="total_energy"
REAL(DP) :: demet_har, efield_corr_har, potentiostat_contr_har
IF (PRESENT(electric_field_corr)) THEN
efield_corr_har=electric_field_corr
ELSE
efield_corr_har=0.d0
END IF
IF (PRESENT ( potentiostat_contr )) THEN
potentiostat_contr_har = potentiostat_contr
ELSE
potentiostat_contr_har = 0.d0
END IF
IF (degauss .GT. 0.D0) THEN
demet_ispresent=.TRUE.
demet_har=demet
ELSE
demet_ispresent=.FALSE.
demet_har=0.d0
ENDIF
CALL qes_init_total_energy(obj,TAGNAME,etot,eband_ispresent=.TRUE.,eband=eband,&
ehart_ispresent=.TRUE., ehart=ehart, vtxc_ispresent=.TRUE.,&
vtxc=vtxc,etxc_ispresent=.TRUE., etxc=etxc, ewald_ispresent=.TRUE.,&
ewald=ewald, demet_ispresent=demet_ispresent,demet=demet_har, &
efieldcorr_ispresent=PRESENT(electric_field_corr), efieldcorr=efield_corr_har,&
POTENTIOSTAT_CONTR_ISPRESENT = PRESENT(potentiostat_contr), &
POTENTIOSTAT_CONTR = potentiostat_contr_har)
!
CALL qes_init_total_energy(obj,TAGNAME,etot, EBAND = eband , EHART = [ehart], VTXC = [vtxc],&
ETXC = [etxc] , EWALD = ewald, DEMET = demet, &
EFIELDCORR=electric_field_corr, POTENTIOSTAT_CONTR = potentiostat_contr, &
GATE_CONTRIBUTION = gate_contribution )
END SUBROUTINE qexsd_init_total_energy
!
@ -1247,7 +1225,7 @@ CONTAINS
END SUBROUTINE qexsd_init_dipole_info
!---------------------------------------------------------------------------------------------
SUBROUTINE qexsd_init_outputElectricField(obj, lelfield, tefield, ldipole, lberry, bp_obj, el_pol, &
ion_pol, dipole_obj )
ion_pol, dipole_obj , gateInfo)
!---------------------------------------------------------------------------------------------
!
IMPLICIT NONE
@ -1258,6 +1236,7 @@ CONTAINS
REAL(DP),OPTIONAL,DIMENSION(3),INTENT(IN) :: el_pol, ion_pol
TYPE(berryPhaseOutput_type),OPTIONAL,INTENT(IN) :: bp_obj
TYPE ( dipoleOutput_type ),OPTIONAL, INTENT(IN) :: dipole_obj
TYPE ( gateInfo_type),OPTIONAL,INTENT(IN) :: gateInfo(1)
!
CHARACTER(LEN=*),PARAMETER :: TAGNAME="electric_field"
TYPE ( berryPhaseOutput_type ) :: bp_loc_obj
@ -1284,31 +1263,37 @@ CONTAINS
BerryPhase = bp_loc_obj, &
finiteElectricFieldInfo_ispresent = finfield_is, &
finiteElectricFieldInfo = finiteField_obj, &
dipoleInfo_ispresent = dipo_is, dipoleInfo = dip_loc_obj)
dipoleInfo_ispresent = dipo_is, dipoleInfo = dip_loc_obj,&
GATEINFO = gateInfo)
IF (dipo_is) CALL qes_reset_dipoleOutput( dip_loc_obj )
IF ( bp_is ) CALL qes_reset_berryPhaseOutput( bp_loc_obj )
!
END SUBROUTINE qexsd_init_outputElectricField
!
!----------------------------------------------------------------------------------------
SUBROUTINE qexsd_step_addstep( i_step, max_steps, ntyp, atm, ityp, nat,&
tau, alat, a1, a2, a3, etot, eband, ehart, vtxc, etxc,&
ewald, degauss, demet, forces, stress, n_scf_steps, scf_error, potstat_contr, &
fcp_force, fcp_tot_charge )
SUBROUTINE qexsd_step_addstep(i_step, max_steps, ntyp, atm, ityp, nat, tau, alat, a1, a2, a3, &
etot, eband, ehart, vtxc, etxc, ewald, degauss, demet, forces, &
stress, n_scf_steps, scf_error, efieldcorr, potstat_contr, &
fcp_force, fcp_tot_charge, gatefield_en)
!-----------------------------------------------------------------------------------------
!! This routing initializes le steps array containing up to max_steps elements of the step_type
!! data structure. Each element contains structural and energetic info for m.d. trajectories and
!! structural minimization paths. All quantities must be provided directly in Hartree atomic units.
!! @Note updated on April 10th 2018 by Pietro Delugas
IMPLICIT NONE
!
INTEGER ,INTENT(IN) :: i_step, max_steps, ntyp, nat, n_scf_steps, ityp(:)
REAL(DP),INTENT(IN) :: tau(3,nat), alat, a1(3), a2(3), a3(3), etot, eband, ehart, vtxc, &
etxc, ewald, degauss, demet, scf_error, forces(3,nat), stress(3,3)
REAL(DP),OPTIONAL,INTENT (IN) :: potstat_contr, fcp_force, fcp_tot_charge
etxc, ewald, scf_error, forces(3,nat), stress(3,3)
REAL(DP),OPTIONAL,INTENT(IN) :: degauss(1), demet(1), gatefield_en(1), efieldcorr(1)
REAL(DP),OPTIONAL,INTENT (IN) :: potstat_contr(1), fcp_force(1), fcp_tot_charge(1)
CHARACTER(LEN=*),INTENT(IN) :: atm(:)
TYPE (step_type) :: step_obj
TYPE ( scf_conv_type ) :: scf_conv_obj
TYPE ( atomic_structure_type ) :: atomic_struct_obj
TYPE ( total_energy_type ) :: tot_en_obj
TYPE ( matrix_type ) :: mat_forces, mat_stress
!
!
IF ( i_step .EQ. 1 ) THEN
ALLOCATE (steps(max_steps))
step_counter = 0
@ -1328,12 +1313,8 @@ CONTAINS
step_obj%atomic_structure=atomic_struct_obj
CALL qes_reset_atomic_structure( atomic_struct_obj )
!
CALL qexsd_init_total_energy ( tot_en_obj, etot/e2, eband/e2, ehart/e2, &
vtxc/e2, etxc/e2, ewald/e2, degauss/e2, demet/e2 )
IF ( PRESENT ( potstat_contr )) THEN
tot_en_obj%potentiostat_contr_ispresent = .TRUE.
tot_en_obj%potentiostat_contr = potstat_contr/e2
END IF
CALL qexsd_init_total_energy (tot_en_obj, etot, [eband], ehart, &
vtxc, etxc, [ewald], degauss, demet, efieldcorr, potstat_contr, gatefield_en)
step_obj%total_energy=tot_en_obj
CALL qes_reset_total_energy( tot_en_obj )
!
@ -1345,9 +1326,11 @@ CONTAINS
step_obj%stress = mat_stress
CALL qes_reset_matrix ( mat_stress )
IF ( PRESENT ( fcp_force ) ) THEN
step_obj%FCP_force = fcp_force
step_obj%FCP_force = fcp_force(1)
step_obj%FCP_force_ispresent = .TRUE.
step_obj%FCP_tot_charge = fcp_tot_charge
END IF
IF (PRESENT( fcp_tot_charge)) THEN
step_obj%FCP_tot_charge = fcp_tot_charge(1)
step_obj%FCP_tot_charge_ispresent = .TRUE.
END IF
!
@ -1381,7 +1364,6 @@ CONTAINS
!
REAL(DP),INTENT(IN) :: wstring(nstring)
!
#if !defined (__OLDXLM)
CHARACTER(LEN=*),PARAMETER :: TAGNAME = "BerryPhase"
TYPE ( polarization_type) :: tot_pol_obj
!
@ -1446,7 +1428,6 @@ CONTAINS
CALL qes_reset_polarization(tot_pol_obj)
CALL qes_reset_scalarQuantity(pol_val)
CALL qes_reset_phase(tot_phase)
#endif
!
END SUBROUTINE qexsd_init_berryPhaseOutput
!
@ -1456,9 +1437,6 @@ CONTAINS
IMPLICIT NONE
!
INTEGER :: status_int
#if !defined(__OLDXML)
!CALL qes_init_status( exit_status, "status", status_int)
#endif
END SUBROUTINE qexsd_set_status
!
!--------------------------------------------------------------------------------------------------
@ -1473,19 +1451,33 @@ CONTAINS
CALL qes_init_closed (qexsd_closed_element, "closed", date_string, time_string,&
"")
END SUBROUTINE qexsd_set_closed
!-------------------------------------------------------------------------
!
!-------------------------------------------
! ... read subroutines
!-------------------------------------------
!
!-----------------------------------------------------------------------------------
SUBROUTINE qexsd_init_gate_info(obj, tagname, gatefield_en, zgate_, nelec_, alat_, at_, bg_, zv_, ityp_)
!--------------------------------------------------------------------------------
USE kinds, ONLY : DP
USE constants, ONLY : tpi
!
IMPLICIT NONE
TYPE (gateInfo_type),INTENT(INOUT) :: obj;
CHARACTER(LEN=*) :: tagname
REAL(DP), INTENT(IN) :: gatefield_en, zgate_, alat_, at_(3,3), bg_(3,3), zv_(:), nelec_
INTEGER,INTENT(IN) :: ityp_(:)
!
REAL(DP) :: bmod, area, ionic_charge, gateamp, gate_gate_term
!
bmod=SQRT(bg_(1,3)**2+bg_(2,3)**2+bg_(3,3)**2)
ionic_charge = SUM( zv_(ityp_(:)) )
area = ABS((at_(1,1)*at_(2,2)-at_(2,1)*at_(1,2))*alat_**2)
gateamp = (-(nelec_-ionic_charge)/area*tpi)
gate_gate_term = (- (nelec_-ionic_charge) * gateamp * (alat_/bmod) / 6.0)
obj = gateInfo_type( TAGNAME = TRIM(tagname), lwrite = .TRUE., lread = .FALSE., POT_PREFACTOR = gateamp, &
GATE_ZPOS = zgate_, GATE_GATE_TERM = gate_gate_term, GATEFIELDENERGY = gatefield_en)
!
END SUBROUTINE qexsd_init_gate_info
!
END MODULE qexsd_module
!

50
PW/src/add_qexsd_step.f90
View File

@ -20,6 +20,8 @@ CONTINUE
!------------------------------------------------------------------------
! START_GLOBAL_VARIABLES ( INTENT (IN) )
!--------------------------------------------------------------------------
USE kinds, ONLY: DP
USE constants, ONLY: e2
USE ions_base, ONLY: tau, nat, nsp, atm, ityp
USE cell_base, ONLY: alat, at
USE ener, ONLY: etot, eband, ehart, etxc, vtxc, ewld, demet, ef
@ -27,6 +29,7 @@ USE klist, ONLY: degauss, tot_charge
USE force_mod, ONLY: force, sigma
USE control_flags,ONLY: nstep, n_scf_steps, scf_error
USE fcp_variables,ONLY: fcp_mu, lfcpopt, lfcpdyn
USE extfield, ONLY: gate, etotgatefield, tefield, etotefield
!-----------------------------------------------------------------------------
! END_GLOBAL_VARIABLES
!-----------------------------------------------------------------------------
@ -47,16 +50,43 @@ INTEGER,INTENT(IN) :: i_step
! END_INPUT_VARIABLES
!--------------------------------------------------------------------------------
!
REAL(DP),ALLOCATABLE :: potstat_contr_(:), fcp_force_(:), fcp_tot_charge_(:),&
demet_(:), degauss_(:), gatefield_en_(:), efield_corr_(:)
!
IF ( degauss > 0.0d0 ) THEN
ALLOCATE ( degauss_(1), demet_(1))
degauss_ = degauss/e2
demet_ = demet/e2
END IF
IF ( lfcpopt .OR. lfcpdyn ) THEN
CALL qexsd_step_addstep ( i_step, nstep, nsp, atm, ityp, nat, alat*tau, alat, alat*at(:,1), &
alat*at(:,2), alat*at(:,3), etot, eband, ehart, vtxc, etxc, ewld, &
degauss, demet, force, sigma, n_scf_steps, scf_error, &
POTSTAT_CONTR = (ef * tot_charge), FCP_FORCE = (fcp_mu-ef) , FCP_TOT_CHARGE = tot_charge)
ELSE
CALL qexsd_step_addstep ( i_step, nstep, nsp, atm, ityp, nat, alat*tau, alat, &
alat*at(:,1), alat*at(:,2), alat*at(:,3), &
etot, eband, ehart, vtxc, etxc, ewld, degauss, demet, &
force, sigma, n_scf_steps, scf_error)
END IF
ALLOCATE ( potstat_contr_(1), fcp_force_(1), fcp_tot_charge_(1))
potstat_contr_ = ef * tot_charge / e2
!FIXME ( again shouldn't we use Hartree units for this ? )
fcp_force_ = fcp_mu - ef
!
fcp_tot_charge_ = tot_charge
END IF
IF ( gate ) THEN
ALLOCATE (gatefield_en_(1))
gatefield_en_ = etotgatefield/e2
END IF
IF (tefield) THEN
ALLOCATE ( efield_corr_(1))
efield_corr_(1) = etotefield/e2
END IF
CALL qexsd_step_addstep ( i_step, nstep, nsp, atm, ityp, nat, alat*tau, alat, alat*at(:,1), &
alat*at(:,2), alat*at(:,3), etot, eband/e2, ehart/e2, vtxc/e2, etxc/e2, &
ewld/e2, degauss_, demet_, force/e2, sigma/e2, n_scf_steps, scf_error, &
EFIELDCORR = efield_corr_, POTSTAT_CONTR = potstat_contr_, &
FCP_FORCE = fcp_force_ , FCP_TOT_CHARGE = fcp_tot_charge_, &
GATEFIELD_EN = gatefield_en_)
#endif
!
IF (ALLOCATED(potstat_contr_)) DEALLOCATE(potstat_contr_)
IF (ALLOCATED(fcp_force_)) DEALLOCATE(fcp_force_)
IF (ALLOCATED(fcp_tot_charge_)) DEALLOCATE ( fcp_tot_charge_)
IF (ALLOCATED(demet_)) DEALLOCATE (demet_)
IF (ALLOCATED(degauss_)) DEALLOCATE(degauss_)
IF (ALLOCATED(gatefield_en_)) DEALLOCATE(gatefield_en_)
IF (ALLOCATED(efield_corr_)) DEALLOCATE(efield_corr_)
END SUBROUTINE add_qexsd_step

52
PW/src/pw_restart_new.f90
View File

@ -25,7 +25,7 @@ MODULE pw_restart_new
qexsd_init_forces,qexsd_init_stress, qexsd_xf, &
qexsd_init_outputElectricField, &
qexsd_input_obj, qexsd_occ_obj, qexsd_smear_obj, &
qexsd_init_outputPBC
qexsd_init_outputPBC, qexsd_init_gate_info
USE io_global, ONLY : ionode, ionode_id
USE io_files, ONLY : iunpun, xmlpun_schema, prefix, tmp_dir
!
@ -55,7 +55,7 @@ MODULE pw_restart_new
USE global_version, ONLY : version_number
USE cell_base, ONLY : at, bg, alat, ibrav
USE gvect, ONLY : ig_l2g
USE ions_base, ONLY : nsp, ityp, atm, nat, tau
USE ions_base, ONLY : nsp, ityp, atm, nat, tau, zv
USE noncollin_module, ONLY : noncolin, npol
USE io_files, ONLY : nwordwfc, iunwfc, psfile
USE buffers, ONLY : get_buffer
@ -94,7 +94,7 @@ MODULE pw_restart_new
USE extfield, ONLY : tefield, dipfield, edir, etotefield, &
emaxpos, eopreg, eamp, el_dipole, ion_dipole,&
gate, zgate, relaxz, block, block_1,&
block_2, block_height ! TB
block_2, block_height, etotgatefield ! TB
USE mp, ONLY : mp_sum
USE mp_bands, ONLY : intra_bgrp_comm
USE funct, ONLY : get_exx_fraction, dft_is_hybrid, &
@ -133,9 +133,11 @@ MODULE pw_restart_new
LOGICAL :: opt_conv_ispresent
INTEGER :: n_opt_steps, n_scf_steps_, h_band
REAL(DP) :: h_energy
TYPE(gateInfo_type),ALLOCATABLE :: gate_info_obj(:)
!
TYPE(output_type) :: output
REAL(DP),ALLOCATABLE :: degauss_(:), demet_(:), efield_corr(:), potstat_corr(:), &
gatefield_corr(:)
!
! PW dimensions need to be properly computed
! reducing across MPI tasks
@ -371,22 +373,37 @@ MODULE pw_restart_new
! ... TOTAL ENERGY
!-------------------------------------------------------------------------------------------
!
IF (tefield) THEN
CALL qexsd_init_total_energy(output%total_energy,etot/e2, eband/e2,&
ehart/e2, vtxc/e2, etxc/e2, ewld/e2, degauss/e2, demet/e2, &
etotefield/e2 )
ELSE
CALL qexsd_init_total_energy(output%total_energy,etot/e2, eband/e2,&
ehart/e2, vtxc/e2, etxc/e2, ewld/e2, degauss/e2, demet/e2)
IF ( degauss > 0.0d0 ) THEN
ALLOCATE (degauss_(1), demet_(1))
degauss_ = degauss/e2
demet_ = demet/e2
END IF
IF ( tefield ) THEN
ALLOCATE(efield_corr(1) )
efield_corr = etotefield/e2
END IF
IF (lfcpopt .OR. lfcpdyn ) THEN
output%total_energy%potentiostat_contr_ispresent = .TRUE.
output%total_energy%potentiostat_contr = ef * tot_charge/e2
ALLOCATE ( potstat_corr(1))
potstat_corr = ef * tot_charge/e2
output%FCP_tot_charge_ispresent = .TRUE.
output%FCP_tot_charge = tot_charge
output%FCP_force_ispresent = .TRUE.
!FIXME ( decide what units to use here )
output%FCP_force = fcp_mu - ef
END IF
IF ( gate) THEN
ALLOCATE( gatefield_corr(1))
gatefield_corr = etotgatefield/e2
END IF
CALL qexsd_init_total_energy(output%total_energy, etot/e2, [eband/e2], ehart/e2, vtxc/e2, &
etxc/e2, [ewld/e2], degauss_, demet_, efield_corr, potstat_corr,&
gatefield_corr)
!
IF (ALLOCATED (degauss_)) DEALLOCATE(degauss_)
IF (ALLOCATED (demet_)) DEALLOCATE(demet_)
IF (ALLOCATED (efield_corr)) DEALLOCATE(efield_corr)
IF (ALLOCATED (potstat_corr)) DEALLOCATE(potstat_corr)
IF (ALLOCATED (gatefield_corr)) DEALLOCATE(gatefield_corr)
!
!---------------------------------------------------------------------------------------------
! ... FORCES
@ -416,11 +433,11 @@ MODULE pw_restart_new
IF ( lelfield ) THEN
output%electric_field_ispresent = .TRUE.
CALL qexsd_init_outputElectricField(output%electric_field, lelfield, tefield, dipfield, &
lberry, el_pol = bp_mod_el_pol, ion_pol = bp_mod_ion_pol)
lberry, el_pol = bp_mod_el_pol, ion_pol = bp_mod_ion_pol, GATEINFO = gate_info_obj)
ELSE IF ( lberry ) THEN
output%electric_field_ispresent = .TRUE.
CALL qexsd_init_outputElectricField(output%electric_field, lelfield, tefield, dipfield, &
lberry, bp_obj=qexsd_bp_obj)
lberry, bp_obj=qexsd_bp_obj, GATEINFO = gate_info_obj)
ELSE IF ( tefield .AND. dipfield ) THEN
output%electric_field_ispresent = .TRUE.
CALL qexsd_init_dipole_info(qexsd_dipol_obj, el_dipole, ion_dipole, edir, eamp, &
@ -428,10 +445,13 @@ MODULE pw_restart_new
qexsd_dipol_obj%tagname = "dipoleInfo"
CALL qexsd_init_outputElectricField(output%electric_field, lelfield, tefield, dipfield, &
lberry, dipole_obj = qexsd_dipol_obj )
lberry, dipole_obj = qexsd_dipol_obj , GATEINFO = gate_info_obj)
CALL qes_reset_dipoleOutput(qexsd_dipol_obj)
ELSE
output%electric_field_ispresent = .FALSE.
ENDIF
!------------------------------------------------------------------------------------------------
! ... ACTUAL WRITING
!-------------------------------------------------------------------------------