From ca1cdc5ea30a4847db9c22301a53186bc390fc05 Mon Sep 17 00:00:00 2001
From: Paolo Giannozzi
Date: Tue, 12 Apr 2022 15:21:59 +0200
Subject: [PATCH] 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
---
Modules/qexsd_input.f90 | 3 +-
PW/src/addusdens.f90 | 4 +-
PW/src/input.f90 | 2 +-
PW/src/pw_init_qexsd_input.f90 | 36 +++++--------
PW/src/pw_restart_new.f90 | 96 +++++++++++++++-------------------
5 files changed, 61 insertions(+), 80 deletions(-)
diff --git a/Modules/qexsd_input.f90 b/Modules/qexsd_input.f90
index e42a0cf44..68f62a65f 100644
--- a/Modules/qexsd_input.f90
+++ b/Modules/qexsd_input.f90
@@ -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"
diff --git a/PW/src/addusdens.f90 b/PW/src/addusdens.f90
index ae259b2c3..383520229 100644
--- a/PW/src/addusdens.f90
+++ b/PW/src/addusdens.f90
@@ -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) )
!
diff --git a/PW/src/input.f90 b/PW/src/input.f90
index a7d911980..80c387eaf 100644
--- a/PW/src/input.f90
+++ b/PW/src/input.f90
@@ -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 ()
diff --git a/PW/src/pw_init_qexsd_input.f90 b/PW/src/pw_init_qexsd_input.f90
index 0fedfe1f7..523df2377 100644
--- a/PW/src/pw_init_qexsd_input.f90
+++ b/PW/src/pw_init_qexsd_input.f90
@@ -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)
@@ -194,10 +194,8 @@
END IF
!dft_is_hybrid=get_dft_is_hybrid()
- dft_is_hybrid = xclib_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
-
+ CALL qes_reset(hybrid_)
+ CALL qes_reset(vdW_)
+ CALL qes_reset(dftU_)
!
!------------------------------------------------------------------------------------------------------------------------
! SPIN ELEMENT
diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90
index e2c0bd297..8b18241f0 100644
--- a/PW/src/pw_restart_new.f90
+++ b/PW/src/pw_restart_new.f90
@@ -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)
+ IF ( lda_plus_u ) THEN
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,35 +654,30 @@ 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, &
- alat, at, bg, zv, ityp)
- gate_info_ptr => gate_info_temp
- END IF
+ CALL qexsd_init_gate_info(gate_info_opt,"gateInfo", etotgatefield/e2, zgate, nelec, &
+ alat, at, bg, zv, ityp)
+ ELSE
+ gate_info_opt%lwrite=.false.
+ END IF
IF ( lelfield ) THEN
ALLOCATE (bp_el_pol(2), bp_ion_pol(3) )
bp_el_pol = el_pol
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)
- !
- 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)
+ lberry, BP_OBJ = qexsd_bp_obj, EL_POL = bp_el_pol, ION_POL = bp_ion_pol, &
+ GATEINFO = gate_info_opt, DIPOLE_OBJ = dipol_opt)
+ !
+ CALL qes_reset (gate_info_opt)
+ CALL qes_reset (dipol_opt)
!-------------------------------------------------------------------------------
! ... CLOCKS
CALL qexsd_add_all_clocks()