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()