mirror of https://gitlab.com/QEF/q-e.git
Some cleanup of xml code
On Cray it is unsafe to rely on null pointers to set derived-type variables to "not present" if optional. Seems to work more or less for input xml, but still crashes for mysterious reasons when writing output xml
This commit is contained in:
parent
362f429441
commit
ca1cdc5ea3
|
@ -392,7 +392,8 @@ MODULE qexsd_input
|
|||
!
|
||||
TYPE (cell_control_type) :: obj
|
||||
CHARACTER(LEN=*),INTENT(IN) :: cell_dynamics, cell_dofree
|
||||
REAL(DP),INTENT(IN) :: pressure, wmass, cell_factor
|
||||
REAL(DP),INTENT(IN) :: pressure, wmass
|
||||
REAL(DP),INTENT(IN), OPTIONAL :: cell_factor
|
||||
INTEGER,DIMENSION(3,3),INTENT(IN) :: iforceh
|
||||
!
|
||||
CHARACTER(LEN=*),PARAMETER :: TAGNAME="cell_control"
|
||||
|
|
|
@ -45,10 +45,9 @@ SUBROUTINE addusdens_g( rho )
|
|||
USE fft_interfaces, ONLY : invfft
|
||||
USE gvect, ONLY : ngm, gg, g, &
|
||||
eigts1, eigts2, eigts3, mill
|
||||
USE noncollin_module, ONLY : noncolin, nspin_mag
|
||||
USE noncollin_module, ONLY : nspin_mag
|
||||
USE uspp, ONLY : becsum, okvan
|
||||
USE uspp_param, ONLY : upf, lmaxq, nh
|
||||
USE control_flags, ONLY : gamma_only
|
||||
USE mp_pools, ONLY : inter_pool_comm
|
||||
USE mp_bands, ONLY : inter_bgrp_comm
|
||||
USE mp, ONLY : mp_sum
|
||||
|
@ -111,6 +110,7 @@ SUBROUTINE addusdens_g( rho )
|
|||
DO na = 1, nat
|
||||
IF ( ityp(na) == nt ) nab = nab + 1
|
||||
ENDDO
|
||||
IF ( nab == 0 ) CYCLE
|
||||
!
|
||||
ALLOCATE( skk(ngm_l,nab), tbecsum(nij,nab,nspin_mag), aux2(ngm_l,nij) )
|
||||
!
|
||||
|
|
|
@ -1690,7 +1690,7 @@ SUBROUTINE iosys()
|
|||
!
|
||||
! ... End of reading input parameters
|
||||
!
|
||||
#if ( ! defined (__INTEL_COMPILER) || (__INTEL_COMPILER >= 1300) ) && ! defined (__CRAY)
|
||||
#if ! defined (__INTEL_COMPILER) || __INTEL_COMPILER >= 1300
|
||||
CALL pw_init_qexsd_input(qexsd_input_obj, obj_tagname="input")
|
||||
#endif
|
||||
CALL deallocate_input_parameters ()
|
||||
|
|
|
@ -106,9 +106,9 @@
|
|||
LOGICAL,POINTER :: gate_ptr, block_ptr, relaxz_ptr
|
||||
REAL(DP),TARGET :: block_1_tgt, block_2_tgt, block_height_tgt, zgate_tgt
|
||||
REAL(DP),POINTER :: block_1_ptr, block_2_ptr, block_height_ptr, zgate_ptr
|
||||
TYPE(hybrid_type),POINTER :: hybrid_
|
||||
TYPE(dftU_type),POINTER :: dftU_
|
||||
TYPE(vdW_type),POINTER :: vdW_
|
||||
TYPE(hybrid_type) :: hybrid_
|
||||
TYPE(dftU_type) :: dftU_
|
||||
TYPE(vdW_type) :: vdW_
|
||||
REAL(DP),TARGET :: xdm_a1_, xdm_a2_, lond_s6_, lond_rcut_, ts_vdw_econv_thr_,&
|
||||
scr_par_, exx_frc_, ecutvcut_, ecut_fock_, loc_thr_, cell_factor_tg
|
||||
REAL(DP),POINTER :: xdm_a1_pt=>NULL(), xdm_a2_pt=>NULL(), lond_s6_pt=>NULL(), &
|
||||
|
@ -133,7 +133,7 @@
|
|||
INTEGER :: i
|
||||
!
|
||||
!
|
||||
NULLIFY (gate_ptr, block_ptr, relaxz_ptr, block_1_ptr, block_2_ptr, block_height_ptr, zgate_ptr, dftU_, vdW_, hybrid_)
|
||||
NULLIFY (gate_ptr, block_ptr, relaxz_ptr, block_1_ptr, block_2_ptr, block_height_ptr, zgate_ptr)
|
||||
NULLIFY (nr_1,nr_2,nr_3, nrs_1, nrs_2, nrs_3, nrb_1, nrb_2, nrb_3)
|
||||
|
||||
obj%tagname=TRIM(obj_tagname)
|
||||
|
@ -195,9 +195,7 @@
|
|||
|
||||
!dft_is_hybrid=get_dft_is_hybrid()
|
||||
dft_is_hybrid = xclib_dft_is('hybrid')
|
||||
|
||||
IF ( dft_is_hybrid) THEN
|
||||
ALLOCATE(hybrid_)
|
||||
IF (screening_parameter > 0.0_DP) THEN
|
||||
scr_par_ = screening_parameter
|
||||
scr_par_opt => scr_par_
|
||||
|
@ -231,13 +229,14 @@
|
|||
SCREENING_PARAMETER = scr_par_opt, EXXDIV_TREATMENT = exxdiv_treatment,&
|
||||
X_GAMMA_EXTRAPOLATION = x_gamma_extrapolation, ECUTVCUT = ecutvcut_opt, &
|
||||
LOCAL_THR = loc_thr_p )
|
||||
ELSE
|
||||
hybrid_%lwrite=.false.
|
||||
END IF
|
||||
dft_is_nonlocc=get_dft_is_nonlocc()
|
||||
vdw_corr_ = vdw_corr
|
||||
IF (london) vdw_corr_ = 'grimme-d2'
|
||||
empirical_vdw = .NOT. ( TRIM(vdw_corr_) == 'none')
|
||||
IF (empirical_vdw .OR. dft_is_nonlocc) THEN
|
||||
ALLOCATE (vdW_)
|
||||
IF ( empirical_vdw ) THEN
|
||||
vdw_corr_pointer => vdw_corr_
|
||||
SELECT CASE ( TRIM(vdw_corr_))
|
||||
|
@ -282,10 +281,11 @@
|
|||
LONDON_S6 = lond_s6_pt, LONDON_RCUT = lond_rcut_pt, SPECIES = species_, &
|
||||
XDM_A1 = xdm_a1_pt, XDM_A2 = xdm_a2_pt, DFTD3_VERSION = dftd3_version_pt, &
|
||||
DFTD3_THREEBODY = dftd3_threebody_pt)
|
||||
ELSE
|
||||
vdw_%lwrite=.false.
|
||||
END IF
|
||||
!
|
||||
IF (ip_lda_plus_u) THEN
|
||||
ALLOCATE (dftU_)
|
||||
!
|
||||
DO nt = 1, ntyp
|
||||
!
|
||||
|
@ -380,21 +380,13 @@
|
|||
n=hubbard_n_, l=hubbard_l_, &
|
||||
ALPHA = hubbard_alpha_, BETA = hubbard_beta_, ALPHA_BACK = hubbard_alpha_back_, &
|
||||
STARTING_NS = starting_ns_, BACKALL = backall_ )
|
||||
ELSE
|
||||
dftU_%lwrite = .false.
|
||||
END IF
|
||||
CALL qexsd_init_dft(obj%dft, TRIM(dft_name), hybrid_, vdW_, dftU_)
|
||||
IF (ASSOCIATED(hybrid_)) THEN
|
||||
CALL qes_reset(hybrid_)
|
||||
DEALLOCATE(hybrid_)
|
||||
END IF
|
||||
IF (ASSOCIATED(vdW_)) THEN
|
||||
CALL qes_reset(vdW_)
|
||||
DEALLOCATE(vdW_)
|
||||
END IF
|
||||
IF (ASSOCIATED(dftU_)) THEN
|
||||
CALL qes_reset(dftU_)
|
||||
DEALLOCATE(dftU_)
|
||||
END IF
|
||||
|
||||
!
|
||||
!------------------------------------------------------------------------------------------------------------------------
|
||||
! SPIN ELEMENT
|
||||
|
|
|
@ -165,14 +165,12 @@ MODULE pw_restart_new
|
|||
LOGICAL :: opt_conv_ispresent, dft_is_vdw, empirical_vdw
|
||||
INTEGER :: n_opt_steps, n_scf_steps_, h_band
|
||||
REAL(DP),TARGET :: h_energy
|
||||
TYPE(gateInfo_type),TARGET :: gate_info_temp
|
||||
TYPE(gateInfo_type),POINTER :: gate_info_ptr
|
||||
TYPE(dipoleOutput_type),TARGET :: dipol_obj
|
||||
TYPE(dipoleOutput_type),POINTER :: dipol_ptr
|
||||
TYPE(BerryPhaseOutput_type), POINTER :: bp_obj_ptr
|
||||
TYPE(hybrid_type), POINTER :: hybrid_obj
|
||||
TYPE(vdW_type), POINTER :: vdw_obj
|
||||
TYPE(dftU_type), POINTER :: dftU_obj
|
||||
TYPE(gateInfo_type) :: gate_info_opt
|
||||
TYPE(dipoleOutput_type) :: dipol_opt
|
||||
TYPE(BerryPhaseOutput_type) :: bp_obj_opt
|
||||
TYPE(hybrid_type) :: hybrid_obj_opt
|
||||
TYPE(vdW_type) :: vdw_obj_opt
|
||||
TYPE(dftU_type) :: dftU_obj_opt
|
||||
REAL(DP), TARGET :: lumo_tmp, ef_targ, dispersion_energy_term
|
||||
REAL(DP), POINTER :: lumo_energy, ef_point
|
||||
REAL(DP), ALLOCATABLE :: ef_updw(:)
|
||||
|
@ -201,16 +199,15 @@ MODULE pw_restart_new
|
|||
LOGICAL,TARGET :: dftd3_threebody_, ts_vdw_isolated_, domag_
|
||||
LOGICAL,POINTER :: ts_isol_pt, dftd3_threebody_pt, ts_vdw_isolated_pt, domag_opt
|
||||
INTEGER,POINTER :: dftd3_version_pt
|
||||
TYPE(smearing_type),TARGET :: smear_obj
|
||||
TYPE(smearing_type),POINTER:: smear_obj_ptr
|
||||
TYPE(smearing_type) :: smear_obj
|
||||
|
||||
NULLIFY( degauss_, demet_, efield_corr, potstat_corr, gatefield_corr)
|
||||
NULLIFY( gate_info_ptr, dipol_ptr, bp_obj_ptr, hybrid_obj, vdw_obj, dftU_obj, lumo_energy, ef_point)
|
||||
NULLIFY( lumo_energy, ef_point)
|
||||
NULLIFY ( optimization_has_converged, non_local_term_pt, &
|
||||
vdw_corr_pt, vdw_term_pt, ts_thr_pt, london_s6_pt, london_rcut_pt, &
|
||||
xdm_a1_pt, xdm_a2_pt, ts_vdw_econv_thr_pt, ts_isol_pt, &
|
||||
dftd3_threebody_pt, ts_vdw_isolated_pt, dftd3_version_pt )
|
||||
NULLIFY ( ectuvcut_opt, scr_par_opt, loc_thr_p, h_energy_ptr, smear_obj_ptr, domag_opt)
|
||||
NULLIFY ( ectuvcut_opt, scr_par_opt, loc_thr_p, h_energy_ptr, domag_opt)
|
||||
|
||||
!
|
||||
! Global PW dimensions need to be properly computed, reducing across MPI tasks
|
||||
|
@ -272,7 +269,7 @@ MODULE pw_restart_new
|
|||
END SELECT
|
||||
!
|
||||
call qexsd_init_convergence_info(output_obj%convergence_info, &
|
||||
SCf_HAS_CONVERGED = scf_has_converged, &
|
||||
SCF_HAS_CONVERGED = scf_has_converged, &
|
||||
OPTIMIZATION_HAS_CONVERGED = optimization_has_converged,&
|
||||
N_SCF_STEPS = n_scf_steps_, SCF_ERROR=scf_error/e2,&
|
||||
N_OPT_STEPS = n_opt_steps, GRAD_NORM = sumfor)
|
||||
|
@ -364,7 +361,6 @@ MODULE pw_restart_new
|
|||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
IF (xclib_dft_is('hybrid') ) THEN
|
||||
ALLOCATE ( hybrid_obj)
|
||||
IF (get_screening_parameter() > 0.0_DP) THEN
|
||||
scr_par_ = get_screening_parameter()
|
||||
scr_par_opt=> scr_par_
|
||||
|
@ -377,16 +373,18 @@ MODULE pw_restart_new
|
|||
loc_thr_ = local_thr
|
||||
loc_thr_p => loc_thr_
|
||||
END IF
|
||||
CALL qexsd_init_hybrid(hybrid_obj, DFT_IS_HYBRID = .TRUE., NQ1 = nq1 , NQ2 = nq2, NQ3 =nq3, ECUTFOCK = ecutfock/e2, &
|
||||
CALL qexsd_init_hybrid(hybrid_obj_opt, DFT_IS_HYBRID = .TRUE., NQ1 = nq1 , NQ2 = nq2, NQ3 =nq3, &
|
||||
ECUTFOCK = ecutfock/e2, &
|
||||
EXX_FRACTION = xclib_get_exx_fraction(), SCREENING_PARAMETER = scr_par_opt, &
|
||||
EXXDIV_TREATMENT = exxdiv_treatment, X_GAMMA_EXTRAPOLATION = x_gamma_extrapolation,&
|
||||
ECUTVCUT = ectuvcut_opt, LOCAL_THR = loc_thr_p )
|
||||
ELSE
|
||||
hybrid_obj_opt%lwrite=.false.
|
||||
END IF
|
||||
|
||||
empirical_vdw = (llondon .OR. ldftd3 .OR. lxdm .OR. ts_vdw .OR. mbd_vdw )
|
||||
dft_is_vdw = dft_is_nonlocc()
|
||||
IF ( dft_is_vdw .OR. empirical_vdw ) THEN
|
||||
ALLOCATE (vdw_obj)
|
||||
IF ( empirical_vdw) THEN
|
||||
vdw_term_pt => dispersion_energy_term
|
||||
vdw_corr_ = TRIM(vdw_corr)
|
||||
|
@ -433,13 +431,14 @@ MODULE pw_restart_new
|
|||
dft_nonlocc_ = TRIM(get_nonlocc_name())
|
||||
non_local_term_pt => dft_nonlocc_
|
||||
END IF
|
||||
CALL qexsd_init_vdw(vdw_obj, non_local_term_pt, vdw_corr_pt, vdw_term_pt, &
|
||||
CALL qexsd_init_vdw(vdw_obj_opt, non_local_term_pt, vdw_corr_pt, vdw_term_pt, &
|
||||
ts_thr_pt, ts_isol_pt, london_s6_pt, LONDON_C6 = london_c6_, &
|
||||
LONDON_RCUT = london_rcut_pt, XDM_A1 = xdm_a1_pt, XDM_A2 = xdm_a2_pt,&
|
||||
DFTD3_VERSION = dftd3_version_pt, DFTD3_THREEBODY = dftd3_threebody_pt)
|
||||
ELSE
|
||||
vdw_obj_opt%lwrite=.false.
|
||||
END IF
|
||||
IF ( lda_plus_u ) THEN
|
||||
ALLOCATE (dftU_obj)
|
||||
CALL check_and_allocate_real(U_opt, Hubbard_U)
|
||||
CALL check_and_allocate_real(J0_opt, Hubbard_J0)
|
||||
CALL check_and_allocate_real(alpha_opt, Hubbard_alpha)
|
||||
|
@ -458,29 +457,22 @@ MODULE pw_restart_new
|
|||
!
|
||||
! Currently Hubbard_V, rho%nsb, and nsg are not written (read) to (from) XML
|
||||
!
|
||||
CALL qexsd_init_dftU (dftU_obj, NSP = nsp, PSD = upf(1:nsp)%psd, SPECIES = atm(1:nsp), ITYP = ityp(1:nat), &
|
||||
CALL qexsd_init_dftU (dftU_obj_opt, NSP = nsp, PSD = upf(1:nsp)%psd, SPECIES = atm(1:nsp), ITYP = ityp(1:nat), &
|
||||
IS_HUBBARD = is_hubbard, IS_HUBBARD_BACK = is_hubbard_back, &
|
||||
BACKALL = backall, HUBB_L2 = l2_opt, HUBB_L3 = l3_opt, &
|
||||
NONCOLIN = noncolin, LDA_PLUS_U_KIND = lda_plus_u_kind, U_PROJECTION_TYPE = Hubbard_projectors, &
|
||||
U =U_opt, U2 = U2_opt, J0 = J0_opt, J = J_opt, n = n_opt, l = l_opt, &
|
||||
alpha = alpha_opt, beta = beta_opt, alpha_back = alpha_back_opt, &
|
||||
starting_ns = starting_ns_eigenvalue, Hub_ns = rho%ns, Hub_ns_nc = rho%ns_nc)
|
||||
ELSE
|
||||
dftU_obj_opt%lwrite=.false.
|
||||
END IF
|
||||
dft_name = get_dft_short()
|
||||
!
|
||||
CALL qexsd_init_dft (output_obj%dft, dft_name, hybrid_obj, vdw_obj, dftU_obj)
|
||||
IF (ASSOCIATED (hybrid_obj)) THEN
|
||||
CALL qes_reset(hybrid_obj)
|
||||
DEALLOCATE (hybrid_obj)
|
||||
END IF
|
||||
IF (ASSOCIATED (vdw_obj)) THEN
|
||||
CALL qes_reset(vdw_obj)
|
||||
DEALLOCATE (vdw_obj)
|
||||
END IF
|
||||
IF (ASSOCIATED (dftU_obj)) THEN
|
||||
CALL qes_reset( dftU_obj)
|
||||
DEALLOCATE (dftU_obj)
|
||||
END IF
|
||||
CALL qexsd_init_dft (output_obj%dft, dft_name, hybrid_obj_opt, vdw_obj_opt, dftU_obj_opt)
|
||||
CALL qes_reset(hybrid_obj_opt)
|
||||
CALL qes_reset(vdw_obj_opt)
|
||||
CALL qes_reset( dftU_obj_opt)
|
||||
!
|
||||
!-------------------------------------------------------------------------------
|
||||
! ... PERIODIC BOUNDARY CONDITIONS
|
||||
|
@ -578,12 +570,13 @@ MODULE pw_restart_new
|
|||
smearing_loc = schema_smearing( smearing )
|
||||
CALL qexsd_init_smearing(smear_obj, smearing_loc, degauss/e2)
|
||||
END IF
|
||||
smear_obj_ptr => smear_obj
|
||||
ELSE
|
||||
smear_obj%lwrite=.false.
|
||||
END IF
|
||||
!
|
||||
|
||||
CALL qexsd_init_band_structure( output_obj%band_structure,lsda,noncolin,lspinorb, nelec, natomwfc, &
|
||||
et, wg, nkstot, xk, ngk_g, wk, SMEARING = smear_obj_ptr, &
|
||||
et, wg, nkstot, xk, ngk_g, wk, SMEARING = smear_obj, &
|
||||
STARTING_KPOINTS = qexsd_start_k_obj, OCCUPATIONS_KIND = qexsd_occ_obj, &
|
||||
WF_COLLECTED = wf_collect, NBND = nbnd, FERMI_ENERGY = ef_point, EF_UPDW = ef_updw,&
|
||||
HOMO = h_energy_ptr, LUMO = lumo_energy )
|
||||
|
@ -661,9 +654,10 @@ MODULE pw_restart_new
|
|||
output_obj%electric_field_ispresent = ( gate .OR. lelfield .OR. lberry .OR. tefield )
|
||||
|
||||
IF ( gate ) THEN
|
||||
CALL qexsd_init_gate_info(gate_info_temp,"gateInfo", etotgatefield/e2, zgate, nelec, &
|
||||
CALL qexsd_init_gate_info(gate_info_opt,"gateInfo", etotgatefield/e2, zgate, nelec, &
|
||||
alat, at, bg, zv, ityp)
|
||||
gate_info_ptr => gate_info_temp
|
||||
ELSE
|
||||
gate_info_opt%lwrite=.false.
|
||||
END IF
|
||||
IF ( lelfield ) THEN
|
||||
ALLOCATE (bp_el_pol(2), bp_ion_pol(3) )
|
||||
|
@ -671,25 +665,19 @@ MODULE pw_restart_new
|
|||
bp_ion_pol(1:3) = ion_pol(1:3)
|
||||
END IF
|
||||
IF ( tefield .AND. dipfield) THEN
|
||||
CALL qexsd_init_dipole_info(dipol_obj, el_dipole, ion_dipole, edir, eamp, &
|
||||
CALL qexsd_init_dipole_info(dipol_opt, el_dipole, ion_dipole, edir, eamp, &
|
||||
emaxpos, eopreg )
|
||||
dipol_ptr => dipol_obj
|
||||
ELSE
|
||||
dipol_opt%lwrite=.false.
|
||||
END IF
|
||||
IF ( lberry ) bp_obj_ptr => qexsd_bp_obj
|
||||
qexsd_bp_obj%lwrite= lberry
|
||||
IF (output_obj%electric_field_ispresent) &
|
||||
CALL qexsd_init_outputElectricField(output_obj%electric_field, lelfield, tefield, dipfield, &
|
||||
lberry, BP_OBJ = bp_obj_ptr, EL_POL = bp_el_pol, ION_POL = bp_ion_pol, &
|
||||
GATEINFO = gate_info_ptr, DIPOLE_OBJ = dipol_ptr)
|
||||
lberry, BP_OBJ = qexsd_bp_obj, EL_POL = bp_el_pol, ION_POL = bp_ion_pol, &
|
||||
GATEINFO = gate_info_opt, DIPOLE_OBJ = dipol_opt)
|
||||
!
|
||||
IF (ASSOCIATED(gate_info_ptr)) THEN
|
||||
CALL qes_reset (gate_info_ptr)
|
||||
NULLIFY(gate_info_ptr)
|
||||
ENDIF
|
||||
IF (ASSOCIATED (dipol_ptr) ) THEN
|
||||
CALL qes_reset (dipol_ptr)
|
||||
NULLIFY(dipol_ptr)
|
||||
ENDIF
|
||||
NULLIFY ( bp_obj_ptr)
|
||||
CALL qes_reset (gate_info_opt)
|
||||
CALL qes_reset (dipol_opt)
|
||||
!-------------------------------------------------------------------------------
|
||||
! ... CLOCKS
|
||||
CALL qexsd_add_all_clocks()
|
||||
|
|
Loading…
Reference in New Issue