diff --git a/.gitignore b/.gitignore index da51fad..d8acdc7 100644 --- a/.gitignore +++ b/.gitignore @@ -110,6 +110,9 @@ auto-save-list tramp .\#* +### VS Code ### +.vscode + # Org-mode .org-id-locations *_archive diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..f139553 --- /dev/null +++ b/Makefile @@ -0,0 +1,150 @@ +.SUFFIXES: .dep .o .cu .c +SHELL = /bin/sh + +CP2KHOME := $(PWD)/.. +ARCH := $(shell $(CP2KHOME)/tools/get_arch_code) +LIB1 = cp2k_base_lib +LIB2 = cp2k_fft_lib +LIBCP2K = cp2k_lib +export VERSION=sopt +export WHAT =_progr + +### Dependent variables ### + +ARCHDIR = $(CP2KHOME)/arch +DOCDIR = $(CP2KHOME)/doc +MAINEXEDIR = $(CP2KHOME)/exe +MAINLIBDIR = $(CP2KHOME)/lib +MAINOBJDIR = $(CP2KHOME)/obj +PRETTYOBJDIR = $(CP2KHOME)/obj/prettified +TOOLDIR = $(OBJDIR)/tools +TOOLSRC = $(CP2KHOME)/tools +SRCDIR = $(CP2KHOME)/src +SRCDIRS = $(SRCDIR):$(SRCDIR)/lib:$(TOOLSRC)/metadyn:$(CP2KHOME)/cuda_tools +MAKEFILE = $(CP2KHOME)/makefiles/Makefile +MACHINEDEFS = $(ARCHDIR)/$(ARCH).$(VERSION) +PROG = $(EXEDIR)/cp2k.$(VERSION) +CP2KSHELL = $(EXEDIR)/cp2k_shell.$(VERSION) +FES = $(EXEDIR)/fes.$(VERSION) +EXEDIR = $(MAINEXEDIR)/$(ARCH) +LIBDIR = $(MAINLIBDIR)/$(ARCH) +OBJDIR = $(MAINOBJDIR)/$(ARCH) +OBJECTDEFS = $(SRCDIR)/OBJECTDEFS +LIBOBJECTDEFS= $(SRCDIR)/lib/OBJECTDEFS +LIBNVOBJECTDEFS= $(CP2KHOME)/cuda_tools/NVOBJECTDEFS +LIB1_ARCHIVE = $(LIBDIR)/$(VERSION)/lib$(LIB1).a +LIB2_ARCHIVE = $(LIBDIR)/$(VERSION)/lib$(LIB2).a +LIB_CP2K_ARCHIVE = $(LIBDIR)/$(VERSION)/lib$(LIBCP2K).a +SRCENTRY = $(wildcard $(SRCDIR)/CVS/Entr*) +FESOBJECTDEFS = $(TOOLSRC)/metadyn/OBJECTDEFS +DOXYGENDIR = $(DOCDIR)/doxygen + +### Definition of the multiple targets ### +# +VERSION_TARGETS = sopt sdbg popt pdbg ssmp psmp +# +# uses an ugly trick, these are disguised as file names, the directory (@D) part +# is used as a version, the file (@F) part is used as the target. +# +LIB_TARGETS = $(addsuffix /lib ,$(VERSION_TARGETS)) +ALL_TARGETS = $(addsuffix /all ,$(VERSION_TARGETS)) +CLEAN_TARGETS = $(addsuffix /clean ,$(VERSION_TARGETS)) $(addsuffix /realclean +,$(VERSION_TARGETS)) + +.PHONY : _all libs _progr _lib build clean realclean distclean $(CLEAN_TARGETS)\ + $(ALL_TARGETS) $(LIB_TARGETS) $(VERSION_TARGETS) fes dirs deptool + +### Master rules ### +build: dirs deptool + $(MAKE) -C $(SRCDIR) -f $(MAKEFILE) all.dep + $(MAKE) -C $(SRCDIR)/lib -f $(MAKEFILE) lib.dep + $(MAKE) -C $(OBJDIR)/$(VERSION) -f $(MAKEFILE) $(WHAT) + +fes: dirs deptool + $(MAKE) -C $(TOOLSRC)/metadyn/ -f $(MAKEFILE) fes.dep + $(MAKE) -C $(OBJDIR)/$(VERSION) -f $(MAKEFILE) VERSION=$(VERSION) $(FES) + +dirs: + @mkdir -p $(EXEDIR) + @mkdir -p $(LIBDIR)/$(VERSION) + @mkdir -p $(TOOLDIR) + @mkdir -p $(OBJDIR)/$(VERSION) + @mkdir -p $(PRETTYOBJDIR) + +realpretty: prettyclean pretty + +pretty: dirs + $(MAKE) -C $(SRCDIR) -f $(MAKEFILE) _pretty + +deptool: dirs + $(MAKE) -C $(TOOLDIR) -f $(MAKEFILE) makedepf90 + +libs: + $(MAKE) -f $(MAKEFILE) VERSION=$(VERSION) WHAT=_lib build +all: + $(MAKE) -f $(MAKEFILE) VERSION=$(VERSION) WHAT=_all build +progr: + $(MAKE) -f $(MAKEFILE) VERSION=$(VERSION) WHAT=_progr build +cpshell: + $(MAKE) -f $(MAKEFILE) VERSION=$(VERSION) WHAT=_cpshell build + +# +# on a parallel build only one task should go a build the deptool +# +$(VERSION_TARGETS): dirs deptool + $(MAKE) -f $(MAKEFILE) VERSION=$@ build + +$(CLEAN_TARGETS): + $(MAKE) -f $(MAKEFILE) VERSION=$(@D) $(@F) + +$(ALL_TARGETS) $(LIB_TARGETS): + $(MAKE) -f $(MAKEFILE) VERSION=$(@D) WHAT=_$(@F) build +# +# here we try to include all the objects that might need considering +# + +include $(OBJECTDEFS) +include $(LIBOBJECTDEFS) +include $(FESOBJECTDEFS) +include $(MACHINEDEFS) +include $(LIBNVOBJECTDEFS) + +OBJECTS = $(OBJECTS_GENERIC) $(OBJECTS_ARCHITECTURE) +FESOBJS = $(FESOBJ) $(OBJECTS_ARCHITECTURE) + +# Cuda specific instructions +ifneq ($(NVCC),) + LIBNV_ARCHIVE= $(LIBDIR)/$(VERSION)/libcp2k_cuda.a +endif + +# Define the whole bunch of libraries needed +ALL_LIB = $(LIB_CP2K_ARCHIVE) $(LIB2_ARCHIVE) $(LIB1_ARCHIVE) $(LIBNV_ARCHIVE) + +# +# some practical variables for the build. +# note that the last cvs entry is not necessarily the most recent +# +ifeq ($(CPPSHELL),) +CPPSHELL := -D__COMPILE_ARCH="\"$(ARCH)\""\ + -D__COMPILE_DATE="\"$(shell date)\""\ + -D__COMPILE_HOST="\"$(shell hostname)\""\ + -D__COMPILE_LASTCVS="\"$(shell tail -n1 $(SRCDIR)/CVS/Entries)\"" +endif + +ifneq ($(CPP),) +# +# always add the SRCDIR to the include path (-I here might not be portable) +# +CPPFLAGS += $(CPPSHELL) -I$(SRCDIR) +else +FCFLAGS += $(CPPSHELL) +endif + + +### Slave rules ### +vpath %.h $(SRCDIRS) +vpath %.c $(SRCDIRS) +vpath %.cpp $(SRCDIRS) +vpath %.dep $(OBJDIR)/$(VERSION) +vpath %.pretty $(PRETTYOBJDIR) +vpath %.cu $(SRCDIRS) diff --git a/src/admm_dm_methods.cpp b/src/admm_dm_methods.cpp new file mode 100644 index 0000000..c90f367 --- /dev/null +++ b/src/admm_dm_methods.cpp @@ -0,0 +1,533 @@ +/*-------------------------------------------------------------------------------------------------- + CP2K: A general program to perform molecular dynamics simulations + Copyright 2000-2023 CP2K developers group + + SPDX-License-Identifier: GPL-2.0-or-later +--------------------------------------------------------------------------------------------------*/ + +/*************************************************************************************************** + \brief Contains ADMM methods which only require the density matrix + \par History + 11.2014 created [Ole Schuett] + \author Ole Schuett +***************************************************************************************************/ + +#include "./base/base_uses.h" + +class admm_dm_methods { + +public: + void admm_dm_calc_rho_aux(struct qs_environment_type); + void admm_dm_merge_ks_matrix(struct qs_environment_type); + +private: + char *moduleN = "admm_dm_methods"; + +}; + +/*************************************************************************************************** + \brief Entry methods: Calculates auxiliary density matrix from primary one. + \param qs_env ... + \author Ole Schuett +***************************************************************************************************/ +void admm_dm_methods::admm_dm_calc_rho_aux(struct qs_environment_type *qs_env) +{ + + char *routineN = "admm_dm_calc_rho_aux"; + + int handle; + struct admm_dm_type *admm_dm; + + NULLIFY (admm_dm); + timeset(routineN, handle); + get_admm_env(qs_env.admm_env, admm_dm=admm_dm); + + SELECT CASE (admm_dm.method) + CASE (do_admm_basis_projection) + CALL map_dm_projection(qs_env) + + CASE (do_admm_blocked_projection) + CALL map_dm_blocked(qs_env) + + CASE DEFAULT + CPABORT("admm_dm_calc_rho_aux: unknown method") + END SELECT + + if (admm_dm.purify) purify_mcweeny(qs_env); + + update_rho_aux(qs_env); + + timestop(handle); +} + +/*************************************************************************************************** + \brief Entry methods: Merges auxiliary Kohn-Sham matrix into primary one. + \param qs_env ... + \author Ole Schuett +***************************************************************************************************/ +void admm_dm_methods::admm_dm_merge_ks_matrix(struct qs_environment_type *qs_env) +{ + char *routineN = "admm_dm_merge_ks_matrix"; + + int handle; + struct admm_dm_type *admm_dm; + struct dbcsr_p_type *matrix_ks_merge; + + timeset(routineN, handle); + NULLIFY (admm_dm, matrix_ks_merge); + + get_admm_env(qs_env.dmm_env, admm_dm=admm_dm); + + IF (admm_dm.purify) THEN + CALL revert_purify_mcweeny(qs_env, matrix_ks_merge) + ELSE + CALL get_admm_env(qs_env.admm_env, matrix_ks_aux_fit=matrix_ks_merge) + END IF + + SELECT CASE (admm_dm.method) + CASE (do_admm_basis_projection) + CALL merge_dm_projection(qs_env, matrix_ks_merge) + + CASE (do_admm_blocked_projection) + CALL merge_dm_blocked(qs_env, matrix_ks_merge) + + CASE DEFAULT + CPABORT("admm_dm_merge_ks_matrix: unknown method") + END SELECT + + IF (admm_dm.purify) & + CALL dbcsr_deallocate_matrix_set(matrix_ks_merge) + + CALL timestop(handle) + +} + +/*************************************************************************************************** + \brief Calculates auxiliary density matrix via basis projection. + \param qs_env ... + \author Ole Schuett +***************************************************************************************************/ +void admm_dm_methods::map_dm_projection(qs_env) +{ + TYPE(qs_environment_type), POINTER :: qs_env + + INTEGER :: ispin + LOGICAL :: s_mstruct_changed + REAL(KIND=dp) :: threshold + TYPE(admm_dm_type), POINTER :: admm_dm + TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s_aux, matrix_s_mixed, rho_ao, & + rho_ao_aux + TYPE(dbcsr_type) :: matrix_s_aux_inv, matrix_tmp + TYPE(dft_control_type), POINTER :: dft_control + TYPE(qs_rho_type), POINTER :: rho, rho_aux + + NULLIFY (dft_control, admm_dm, matrix_s_aux, matrix_s_mixed, rho, rho_aux) + NULLIFY (rho_ao, rho_ao_aux) + + CALL get_qs_env(qs_env, dft_control=dft_control, s_mstruct_changed=s_mstruct_changed, +rho=rho) + CALL get_admm_env(qs_env.admm_env, matrix_s_aux_fit=matrix_s_aux, rho_aux_fit=rho_aux, & + matrix_s_aux_fit_vs_orb=matrix_s_mixed, admm_dm=admm_dm) + + CALL qs_rho_get(rho, rho_ao=rho_ao) + CALL qs_rho_get(rho_aux, rho_ao=rho_ao_aux) + + IF (s_mstruct_changed) THEN + ! Calculate A = S_aux^(-1) * S_mixed + CALL dbcsr_create(matrix_s_aux_inv, template=matrix_s_aux[0].matrix, matrix_type="N") + threshold = MAX(admm_dm.eps_filter, 1.0e-12_dp) + CALL invert_Hotelling(matrix_s_aux_inv, matrix_s_aux[0].matrix, threshold) + + IF (.NOT. ASSOCIATED(admm_dm.matrix_A)) THEN + ALLOCATE (admm_dm.matrix_A) + CALL dbcsr_create(admm_dm.matrix_A, template=matrix_s_mixed[0].matrix, matrix_type="N") + END IF + CALL dbcsr_multiply("N", "N", 1.0_dp, matrix_s_aux_inv, matrix_s_mixed[0].matrix, & + 0.0_dp, admm_dm.matrix_A) + CALL dbcsr_release(matrix_s_aux_inv) + END IF + + ! Calculate P_aux = A * P * A^T + CALL dbcsr_create(matrix_tmp, template=admm_dm.matrix_A) + DO ispin = 1, dft_control.nspins + CALL dbcsr_multiply("N", "N", 1.0_dp, admm_dm.matrix_A, rho_ao(ispin).matrix, & + 0.0_dp, matrix_tmp) + CALL dbcsr_multiply("N", "T", 1.0_dp, matrix_tmp, admm_dm.matrix_A, & + 0.0_dp, rho_ao_aux(ispin).matrix) + END DO + CALL dbcsr_release(matrix_tmp); + +} + +/*************************************************************************************************** + \brief Calculates auxiliary density matrix via blocking. + \param qs_env ... + \author Ole Schuett +***************************************************************************************************/ +void admm_dm_methods::map_dm_blocked(qs_env) +{ + TYPE(qs_environment_type), POINTER :: qs_env + + INTEGER :: blk, iatom, ispin, jatom + LOGICAL :: found + REAL(dp), DIMENSION(:, :), POINTER :: sparse_block, sparse_block_aux + TYPE(admm_dm_type), POINTER :: admm_dm + TYPE(dbcsr_iterator_type) :: iter + TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao, rho_ao_aux + TYPE(dft_control_type), POINTER :: dft_control + TYPE(qs_rho_type), POINTER :: rho, rho_aux + + NULLIFY (dft_control, admm_dm, rho, rho_aux, rho_ao, rho_ao_aux) + + CALL get_qs_env(qs_env, dft_control=dft_control, rho=rho) + CALL get_admm_env(qs_env.admm_env, rho_aux_fit=rho_aux, admm_dm=admm_dm) + + CALL qs_rho_get(rho, rho_ao=rho_ao) + CALL qs_rho_get(rho_aux, rho_ao=rho_ao_aux) + + ! ** set blocked density matrix to 0 + DO ispin = 1, dft_control.nspins + CALL dbcsr_set(rho_ao_aux(ispin).matrix, 0.0_dp) + ! ** now loop through the list and copy corresponding blocks + CALL dbcsr_iterator_start(iter, rho_ao(ispin).matrix) + DO WHILE (dbcsr_iterator_blocks_left(iter)) + CALL dbcsr_iterator_next_block(iter, iatom, jatom, sparse_block, blk) + IF (admm_dm.block_map(iatom, jatom) == 1) THEN + CALL dbcsr_get_block_p(rho_ao_aux(ispin).matrix, & + row=iatom, col=jatom, BLOCK=sparse_block_aux, found=found) + IF (found) & + sparse_block_aux = sparse_block + END IF + END DO + CALL dbcsr_iterator_stop(iter) + END DO + +} + +/*************************************************************************************************** + \brief Call calculate_rho_elec() for auxiliary density + \param qs_env ... +***************************************************************************************************/ +void admm_dm_methods::update_rho_aux(qs_env) +{ + TYPE(qs_environment_type), POINTER :: qs_env + + INTEGER :: ispin + REAL(KIND=dp), DIMENSION(:), POINTER :: tot_rho_r_aux + TYPE(admm_dm_type), POINTER :: admm_dm + TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao_aux + TYPE(dft_control_type), POINTER :: dft_control + TYPE(pw_type), DIMENSION(:), POINTER :: rho_g_aux, rho_r_aux + TYPE(qs_ks_env_type), POINTER :: ks_env + TYPE(qs_rho_type), POINTER :: rho_aux + TYPE(task_list_type), POINTER :: task_list_aux_fit + + NULLIFY (dft_control, admm_dm, rho_aux, rho_ao_aux, rho_r_aux, rho_g_aux, tot_rho_r_aux, & + task_list_aux_fit, ks_env) + + CALL get_qs_env(qs_env, ks_env=ks_env, dft_control=dft_control) + CALL get_admm_env(qs_env.admm_env, task_list_aux_fit=task_list_aux_fit, rho_aux_fit=rho_aux, +& + admm_dm=admm_dm) + + CALL qs_rho_get(rho_aux, & + rho_ao=rho_ao_aux, & + rho_r=rho_r_aux, & + rho_g=rho_g_aux, & + tot_rho_r=tot_rho_r_aux) + + DO ispin = 1, dft_control.nspins + CALL calculate_rho_elec(ks_env=ks_env, & + matrix_p=rho_ao_aux(ispin).matrix, & + rho=rho_r_aux(ispin), & + rho_gspace=rho_g_aux(ispin), & + total_rho=tot_rho_r_aux(ispin), & + soft_valid=.FALSE., & + basis_type="AUX_FIT", & + task_list_external=task_list_aux_fit) + END DO + + CALL qs_rho_set(rho_aux, rho_r_valid=.TRUE., rho_g_valid=.TRUE.) + +} + +/*************************************************************************************************** + \brief Merges auxiliary Kohn-Sham matrix via basis projection. + \param qs_env ... + \param matrix_ks_merge Input: The KS matrix to be merged + \author Ole Schuett +***************************************************************************************************/ +void admm_dm_methods::merge_dm_projection(qs_env, matrix_ks_merge) +{ + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks_merge + + INTEGER :: ispin + TYPE(admm_dm_type), POINTER :: admm_dm + TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks + TYPE(dbcsr_type) :: matrix_tmp + TYPE(dft_control_type), POINTER :: dft_control + + NULLIFY (admm_dm, dft_control, matrix_ks) + + CALL get_qs_env(qs_env, dft_control=dft_control, matrix_ks=matrix_ks) + CALL get_admm_env(qs_env.admm_env, admm_dm=admm_dm) + + ! Calculate K += A^T * K_aux * A + CALL dbcsr_create(matrix_tmp, template=admm_dm.matrix_A, matrix_type="N") + + DO ispin = 1, dft_control.nspins + CALL dbcsr_multiply("N", "N", 1.0_dp, matrix_ks_merge(ispin).matrix, admm_dm.matrix_A, & + 0.0_dp, matrix_tmp) + CALL dbcsr_multiply("T", "N", 1.0_dp, admm_dm.matrix_A, matrix_tmp, & + 1.0_dp, matrix_ks(ispin).matrix) + END DO + + CALL dbcsr_release(matrix_tmp) + +} + +/*************************************************************************************************** + \brief Merges auxiliary Kohn-Sham matrix via blocking. + \param qs_env ... + \param matrix_ks_merge Input: The KS matrix to be merged + \author Ole Schuett +***************************************************************************************************/ +void admm_dm_methods::merge_dm_blocked(qs_env, matrix_ks_merge) +{ + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks_merge + + INTEGER :: blk, iatom, ispin, jatom + REAL(dp), DIMENSION(:, :), POINTER :: sparse_block + TYPE(admm_dm_type), POINTER :: admm_dm + TYPE(dbcsr_iterator_type) :: iter + TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks + TYPE(dft_control_type), POINTER :: dft_control + + NULLIFY (admm_dm, dft_control, matrix_ks) + + CALL get_qs_env(qs_env, dft_control=dft_control, matrix_ks=matrix_ks) + CALL get_admm_env(qs_env.admm_env, admm_dm=admm_dm) + + DO ispin = 1, dft_control.nspins + CALL dbcsr_iterator_start(iter, matrix_ks_merge(ispin).matrix) + DO WHILE (dbcsr_iterator_blocks_left(iter)) + CALL dbcsr_iterator_next_block(iter, iatom, jatom, sparse_block, blk) + IF (admm_dm.block_map(iatom, jatom) == 0) & + sparse_block = 0.0_dp + END DO + CALL dbcsr_iterator_stop(iter) + CALL dbcsr_add(matrix_ks(ispin).matrix, matrix_ks_merge(ispin).matrix, 1.0_dp, 1.0_dp) + END DO + +} + +/*************************************************************************************************** + \brief Apply McWeeny purification to auxiliary density matrix + \param qs_env ... + \author Ole Schuett +***************************************************************************************************/ +void admm_dm_methods::purify_mcweeny(qs_env) +{ + TYPE(qs_environment_type), POINTER :: qs_env + + CHARACTER(LEN=*), PARAMETER :: routineN = 'purify_mcweeny' + + INTEGER :: handle, ispin, istep, nspins, unit_nr + REAL(KIND=dp) :: frob_norm + TYPE(admm_dm_type), POINTER :: admm_dm + TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s_aux_fit, rho_ao_aux + TYPE(dbcsr_type) :: matrix_ps, matrix_psp, matrix_test + TYPE(dbcsr_type), POINTER :: matrix_p, matrix_s + TYPE(dft_control_type), POINTER :: dft_control + TYPE(mcweeny_history_type), POINTER :: history, new_hist_entry + TYPE(qs_rho_type), POINTER :: rho_aux_fit + + CALL timeset(routineN, handle) + NULLIFY (dft_control, admm_dm, matrix_s_aux_fit, rho_aux_fit, new_hist_entry, & + matrix_p, matrix_s, rho_ao_aux) + + unit_nr = cp_logger_get_default_unit_nr() + CALL get_qs_env(qs_env, dft_control=dft_control) + CALL get_admm_env(qs_env.admm_env, matrix_s_aux_fit=matrix_s_aux_fit, & + rho_aux_fit=rho_aux_fit, admm_dm=admm_dm) + + CALL qs_rho_get(rho_aux_fit, rho_ao=rho_ao_aux) + + matrix_p => rho_ao_aux[0].matrix + CALL dbcsr_create(matrix_PS, template=matrix_p, matrix_type="N") + CALL dbcsr_create(matrix_PSP, template=matrix_p, matrix_type="S") + CALL dbcsr_create(matrix_test, template=matrix_p, matrix_type="S") + + nspins = dft_control.nspins + DO ispin = 1, nspins + matrix_p => rho_ao_aux(ispin).matrix + matrix_s => matrix_s_aux_fit[0].matrix + history => admm_dm.mcweeny_history(ispin).p + IF (ASSOCIATED(history)) CPABORT("purify_dm_mcweeny: history already associated") + IF (nspins == 1) CALL dbcsr_scale(matrix_p, 0.5_dp) + + DO istep = 1, admm_dm.mcweeny_max_steps + ! allocate new element in linked list + ALLOCATE (new_hist_entry) + new_hist_entry.next => history + history => new_hist_entry + history.count = istep + NULLIFY (new_hist_entry) + CALL dbcsr_create(history.m, template=matrix_p, matrix_type="N") + CALL dbcsr_copy(history.m, matrix_p, name="P from McWeeny") + + ! calc PS and PSP + CALL dbcsr_multiply("N", "N", 1.0_dp, matrix_p, matrix_s, & + 0.0_dp, matrix_ps) + + CALL dbcsr_multiply("N", "N", 1.0_dp, matrix_ps, matrix_p, & + 0.0_dp, matrix_psp) + + !test convergence + CALL dbcsr_copy(matrix_test, matrix_psp) + CALL dbcsr_add(matrix_test, matrix_p, 1.0_dp, -1.0_dp) + frob_norm = dbcsr_frobenius_norm(matrix_test) + IF (unit_nr > 0) WRITE (unit_nr, '(t3,a,i5,a,f16.8)') "McWeeny-Step", istep, & + ": Deviation of idempotency", frob_norm + IF (frob_norm < 1000_dp*admm_dm.eps_filter .AND. istep > 1) EXIT + + ! build next P matrix + CALL dbcsr_copy(matrix_p, matrix_PSP, name="P from McWeeny") + CALL dbcsr_multiply("N", "N", -2.0_dp, matrix_PS, matrix_PSP, & + 3.0_dp, matrix_p) + END DO + admm_dm.mcweeny_history(ispin).p => history + IF (nspins == 1) CALL dbcsr_scale(matrix_p, 2.0_dp) + END DO + + ! clean up + CALL dbcsr_release(matrix_PS) + CALL dbcsr_release(matrix_PSP) + CALL dbcsr_release(matrix_test) + CALL timestop(handle) +} + +/*************************************************************************************************** + \brief Prepare auxiliary KS-matrix for merge using reverse McWeeny + \param qs_env ... + \param matrix_ks_merge Output: The KS matrix for the merge + \author Ole Schuett +***************************************************************************************************/ +void admm_dm_methods::revert_purify_mcweeny(qs_env, matrix_ks_merge) +{ + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks_merge + + CHARACTER(LEN=*), PARAMETER :: routineN = 'revert_purify_mcweeny' + + INTEGER :: handle, ispin, nspins, unit_nr + TYPE(admm_dm_type), POINTER :: admm_dm + TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks, matrix_ks_aux_fit, & + matrix_s_aux_fit, & + matrix_s_aux_fit_vs_orb + TYPE(dbcsr_type), POINTER :: matrix_k + TYPE(dft_control_type), POINTER :: dft_control + TYPE(mcweeny_history_type), POINTER :: history_curr, history_next + + CALL timeset(routineN, handle) + unit_nr = cp_logger_get_default_unit_nr() + NULLIFY (admm_dm, dft_control, matrix_ks, matrix_ks_aux_fit, & + matrix_s_aux_fit, matrix_s_aux_fit_vs_orb, & + history_next, history_curr, matrix_k) + + CALL get_qs_env(qs_env, dft_control=dft_control, matrix_ks=matrix_ks) + CALL get_admm_env(qs_env.admm_env, matrix_s_aux_fit=matrix_s_aux_fit, admm_dm=admm_dm, & + matrix_s_aux_fit_vs_orb=matrix_s_aux_fit_vs_orb, +matrix_ks_aux_fit=matrix_ks_aux_fit) + + nspins = dft_control.nspins + ALLOCATE (matrix_ks_merge(nspins)) + + DO ispin = 1, nspins + ALLOCATE (matrix_ks_merge(ispin).matrix) + matrix_k => matrix_ks_merge(ispin).matrix + CALL dbcsr_copy(matrix_k, matrix_ks_aux_fit(ispin).matrix, name="K") + history_curr => admm_dm.mcweeny_history(ispin).p + NULLIFY (admm_dm.mcweeny_history(ispin).p) + + ! reverse McWeeny iteration + DO WHILE (ASSOCIATED(history_curr)) + IF (unit_nr > 0) WRITE (unit_nr, '(t3,a,i5)') "Reverse McWeeny-Step ", history_curr.count + CALL reverse_mcweeny_step(matrix_k=matrix_k, & + matrix_s=matrix_s_aux_fit[0].matrix, & + matrix_p=history_curr.m) + CALL dbcsr_release(history_curr.m) + history_next => history_curr.next + DEALLOCATE (history_curr) + history_curr => history_next + NULLIFY (history_next) + END DO + + END DO + + ! clean up + timestop(handle); + +} + +/*************************************************************************************************** + \brief Multiply matrix_k with partial derivative of McWeeny by reversing it. + \param matrix_k ... + \param matrix_s ... + \param matrix_p ... + \author Ole Schuett +***************************************************************************************************/ +void admm_dm_methods::reverse_mcweeny_step(matrix_k, matrix_s, matrix_p) +{ + TYPE(dbcsr_type) :: matrix_k, matrix_s, matrix_p + + char *routineN = "reverse_mcweeny_step"; + + int handle; + TYPE(dbcsr_type) :: matrix_ps, matrix_sp, matrix_sum, & + matrix_tmp + + timeset(routineN, handle); + dbcsr_create(matrix_ps, template=matrix_p, matrix_type="N"); + dbcsr_create(matrix_sp, template=matrix_p, matrix_type="N"); + dbcsr_create(matrix_tmp, template=matrix_p, matrix_type="N"); + dbcsr_create(matrix_sum, template=matrix_p, matrix_type="N"); + + dbcsr_multiply("N", "N", 1.0_dp, matrix_p, matrix_s, + 0.0_dp, matrix_ps); + dbcsr_multiply("N", "N", 1.0_dp, matrix_s, matrix_p, + 0.0_dp, matrix_sp); + + // TODO: can we exploid more symmetry? + dbcsr_multiply("N", "N", 3.0_dp, matrix_k, matrix_ps, + 0.0_dp, matrix_sum); + dbcsr_multiply("N", "N", 3.0_dp, matrix_sp, matrix_k, + 1.0_dp, matrix_sum); + + // matrix_tmp = KPS + dbcsr_multiply("N", "N", 1.0_dp, matrix_k, matrix_ps, + 0.0_dp, matrix_tmp); + dbcsr_multiply("N", "N", -2.0_dp, matrix_tmp, matrix_ps, + 1.0_dp, matrix_sum); + dbcsr_multiply("N", "N", -2.0_dp, matrix_sp, matrix_tmp, + 1.0_dp, matrix_sum); + + // matrix_tmp = SPK + dbcsr_multiply("N", "N", 1.0_dp, matrix_sp, matrix_k, + 0.0_dp, matrix_tmp); + dbcsr_multiply("N", "N", -2.0_dp, matrix_sp, matrix_tmp, + 1.0_dp, matrix_sum); + + // overwrite matrix_k + dbcsr_copy(matrix_k, matrix_sum, name="K from reverse McWeeny"); + + // clean up + dbcsr_release(matrix_sum); + dbcsr_release(matrix_tmp); + dbcsr_release(matrix_ps); + dbcsr_release(matrix_sp); + timestop(handle); + +} diff --git a/src/base/base.h b/src/base/base.h new file mode 100644 index 0000000..dedff48 --- /dev/null +++ b/src/base/base.h @@ -0,0 +1,8 @@ +#ifndef _BASE_H +#define _BASE_H + + #define default_string_length 80 + #define default_path_length 1024 + const int max_line_length = 2*default_path_length; + +#endif diff --git a/src/base/base_hooks.cpp b/src/base/base_hooks.cpp new file mode 100644 index 0000000..602befe --- /dev/null +++ b/src/base/base_hooks.cpp @@ -0,0 +1,256 @@ +/*-------------------------------------------------------------------------------------------------- + CP2K: A general program to perform molecular dynamics simulations + Copyright 2000-2023 CP2K developers group + + SPDX-License-Identifier: GPL-2.0-or-later +--------------------------------------------------------------------------------------------------*/ + +/*************************************************************************************************** + \brief Central dispatch for basic hooks + \author Ole Schuett +***************************************************************************************************/ +class base_hooks { + +private: + +public: + // API + void cp_abort(); + void cp_warn(); + void cp_hint(); + void timeset(); + void timestop(); + void cp_abort_hook(); + void cp_warn_hook(); + void cp_hint_hook(); + void timeset_hook(); + void timestop_hook(); + void cp__a(); + void cp__b(); + void cp__w(); + void cp__h(); + void cp__l(); + + // this interface (with subroutines in it) must to be defined right before + // the regular subroutines/functions - otherwise prettify.py will screw up. + INTERFACE + SUBROUTINE cp_abort_interface(location, message) + CHARACTER(len=*), INTENT(in) :: location, message + + END SUBROUTINE cp_abort_interface + + SUBROUTINE cp_warn_interface(location, message) + CHARACTER(len=*), INTENT(in) :: location, message + + END SUBROUTINE cp_warn_interface + + SUBROUTINE cp_hint_interface(location, message) + CHARACTER(len=*), INTENT(in) :: location, message + + END SUBROUTINE cp_hint_interface + + SUBROUTINE timeset_interface(routineN, handle) + CHARACTER(LEN=*), INTENT(IN) :: routineN + INTEGER, INTENT(OUT) :: handle + + END SUBROUTINE timeset_interface + + SUBROUTINE timestop_interface(handle) + INTEGER, INTENT(IN) :: handle + + END SUBROUTINE timestop_interface + END INTERFACE + + PROCEDURE(cp_abort_interface), POINTER :: cp_abort_hook => Null() + PROCEDURE(cp_warn_interface), POINTER :: cp_warn_hook => Null() + PROCEDURE(cp_hint_interface), POINTER :: cp_hint_hook => Null() + PROCEDURE(timeset_interface), POINTER :: timeset_hook => Null() + PROCEDURE(timestop_interface), POINTER :: timestop_hook => Null() + +} + +! +************************************************************************************************** +!> \brief Terminate the program +!> \param location ... +!> \param message ... +!> \author Ole Schuett +! +************************************************************************************************** + SUBROUTINE cp_abort(location, message) + CHARACTER(len=*), INTENT(in) :: location, message + + IF (ASSOCIATED(cp_abort_hook)) THEN + CALL cp_abort_hook(location, message) + ELSE + WRITE (default_output_unit, *) "ABORT in "//TRIM(location)//" "//TRIM(message) + CALL m_flush(default_output_unit) + CALL m_abort() + END IF + ! compiler hint + STOP "Never return from here" + END SUBROUTINE cp_abort + +! +************************************************************************************************** +!> \brief Issue a warning +!> \param location ... +!> \param message ... +!> \author Ole Schuett +! +************************************************************************************************** + SUBROUTINE cp_warn(location, message) + CHARACTER(len=*), INTENT(in) :: location, message + + IF (ASSOCIATED(cp_warn_hook)) THEN + CALL cp_warn_hook(location, message) + ELSE + WRITE (default_output_unit, *) "WARNING in "//TRIM(location)//" "//TRIM(message) + CALL m_flush(default_output_unit) + END IF + END SUBROUTINE cp_warn + +! +************************************************************************************************** +!> \brief Issue a hint +!> \param location ... +!> \param message ... +!> \author Hans Pabst +! +************************************************************************************************** + SUBROUTINE cp_hint(location, message) + CHARACTER(len=*), INTENT(in) :: location, message + + IF (ASSOCIATED(cp_hint_hook)) THEN + CALL cp_hint_hook(location, message) + ELSE + WRITE (default_output_unit, *) "HINT in "//TRIM(location)//" "//TRIM(message) + CALL m_flush(default_output_unit) + END IF + END SUBROUTINE cp_hint + +! +************************************************************************************************** +!> \brief Start timer +!> \param routineN ... +!> \param handle ... +!> \author Ole Schuett +! +************************************************************************************************** + SUBROUTINE timeset(routineN, handle) + CHARACTER(LEN=*), INTENT(IN) :: routineN + INTEGER, INTENT(OUT) :: handle + + IF (ASSOCIATED(timeset_hook)) THEN + CALL timeset_hook(routineN, handle) + ELSE + handle = -1 + END IF + END SUBROUTINE timeset + +! +************************************************************************************************** +!> \brief Stop timer +!> \param handle ... +!> \author Ole Schuett +! +************************************************************************************************** + SUBROUTINE timestop(handle) + INTEGER, INTENT(IN) :: handle + + IF (ASSOCIATED(timestop_hook)) THEN + CALL timestop_hook(handle) + ELSE + IF (handle /= -1) & + CALL cp_abort(cp__l("base_hooks.F", __LINE__), "Got wrong handle") + END IF + END SUBROUTINE timestop + +! +************************************************************************************************** +!> \brief CPASSERT handler +!> \param filename ... +!> \param lineNr ... +!> \author Ole Schuett +! +************************************************************************************************** + SUBROUTINE cp__a(filename, lineNr) + CHARACTER(len=*), INTENT(in) :: filename + INTEGER, INTENT(in) :: lineNr + + CALL cp_abort(location=cp__l(filename, lineNr), message="CPASSERT failed") + ! compiler hint + STOP "Never return from here" + END SUBROUTINE cp__a + +! +************************************************************************************************** +!> \brief CPABORT handler +!> \param filename ... +!> \param lineNr ... +!> \param message ... +!> \author Ole Schuett +! +************************************************************************************************** + SUBROUTINE cp__b(filename, lineNr, message) + CHARACTER(len=*), INTENT(in) :: filename + INTEGER, INTENT(in) :: lineNr + CHARACTER(len=*), INTENT(in) :: message + + CALL cp_abort(location=cp__l(filename, lineNr), message=message) + ! compiler hint + STOP "Never return from here" + END SUBROUTINE cp__b + +! +************************************************************************************************** +!> \brief CPWARN handler +!> \param filename ... +!> \param lineNr ... +!> \param message ... +!> \author Ole Schuett +! +************************************************************************************************** + SUBROUTINE cp__w(filename, lineNr, message) + CHARACTER(len=*), INTENT(in) :: filename + INTEGER, INTENT(in) :: lineNr + CHARACTER(len=*), INTENT(in) :: message + + CALL cp_warn(location=cp__l(filename, lineNr), message=message) + END SUBROUTINE cp__w + +! +************************************************************************************************** +!> \brief CPHINT handler +!> \param filename ... +!> \param lineNr ... +!> \param message ... +!> \author Hans Pabst +! +************************************************************************************************** + SUBROUTINE cp__h(filename, lineNr, message) + CHARACTER(len=*), INTENT(in) :: filename + INTEGER, INTENT(in) :: lineNr + CHARACTER(len=*), INTENT(in) :: message + + CALL cp_hint(location=cp__l(filename, lineNr), message=message) + END SUBROUTINE cp__h + +/*************************************************************************************************** + \brief Helper routine to assemble __LOCATION__ + \param filename ... + \param lineNr ... + \return ... + \author Ole Schuett +***************************************************************************************************/ +char* cp__l(char *filename, int lineNr) +{ + char *location; + + char lineNr_str[15]; + + WRITE (lineNr_str, FMT='(I10)') lineNr + location = TRIM(filename)//":"//TRIM(ADJUSTL(lineNr_str)) + + return location; +} diff --git a/src/base/base_uses.cpp b/src/base/base_uses.cpp new file mode 100644 index 0000000..8f02b98 --- /dev/null +++ b/src/base/base_uses.cpp @@ -0,0 +1,60 @@ +#ifndef _BASE_USES_H +#define _BASE_USES_H + +// Basic use statements and preprocessor macros +// should be included in the use statements + +int cp__a, cp__b, cp__w, cp__h, cp__l, cp_abort, cp_warn, cp_hint, timeset, timestop; + +#if defined(__OFFLOAD_CUDA) || defined(__OFFLOAD_HIP) +#define __OFFLOAD +#endif + +// Check for OpenMP early on - ideally before the compiler fails with a cryptic message. +#if !defined(_OPENMP) + "OpenMP is required. Please add the corresponding flag (eg. -fopenmp for GFortran) to your +Fortran compiler flags." +#endif + +// Dangerous: Full path can be arbitrarily long and might overflow Fortran line. +#if !defined(__SHORT_FILE__) +#define __SHORT_FILE__ __FILE__ +#endif + +#define __LOCATION__ cp__l(__SHORT_FILE__,__LINE__) +#define CPWARN(msg) CALL cp__w(__SHORT_FILE__,__LINE__,msg) +#define CPABORT(msg) CALL cp__b(__SHORT_FILE__,__LINE__,msg) +// In contrast to CPWARN, the warning counter is not increased +#define CPHINT(msg) CALL cp__h(__SHORT_FILE__,__LINE__,msg) + +// CPASSERT can be elided if NDEBUG is defined. +#if defined(NDEBUG) +# define CPASSERT(cond) +#else +# define CPASSERT(cond) IF(.NOT.(cond))CALL cp__a(__SHORT_FILE__,__LINE__) +#endif + +// The MARK_USED macro can be used to mark an argument/variable as used. It is intended to make +// it possible to switch on -Werror=unused-dummy-argument, but deal elegantly with, e.g., +// library wrapper routines that take arguments only used if the library is linked in. +// This code should be valid for any Fortran variable, is always standard conforming, +// and will be optimized away completely by the compiler +#define MARK_USED(foo) IF(.FALSE.)THEN; DO ; IF(SIZE(SHAPE(foo))==-1) EXIT ; END DO ; ENDIF + +// Calculate version number from 2 or 3 components. Can be used for comparison, e.g., +// CPVERSION3(4, 9, 0) <= CPVERSION3(__GNUC__, __GNUC_MINOR__, __GNUC_PATCHLEVEL__) +// CPVERSION(8, 0) <= CPVERSION(__GNUC__, __GNUC_MINOR__) +#define CPVERSION2(MAJOR, MINOR) ((MAJOR) * 10000 + (MINOR) * 100) +#define CPVERSION3(MAJOR, MINOR, UPDATE) (CPVERSION2(MAJOR, MINOR) + (UPDATE)) +#define CPVERSION CPVERSION2 + +// gfortran before 8.3 complains about internal symbols not being specified in +// any data clause when using DEFAULT(NONE) and OOP procedures are called from +// within the parallel region. +#if __GNUC__ < 8 || (__GNUC__ == 8 && (__GNUC_MINOR__ < 3)) +#define OMP_DEFAULT_NONE_WITH_OOP SHARED +#else +#define OMP_DEFAULT_NONE_WITH_OOP NONE +#endif + +#endif diff --git a/src/base/kinds.cpp b/src/base/kinds.cpp new file mode 100644 index 0000000..8dbbd49 --- /dev/null +++ b/src/base/kinds.cpp @@ -0,0 +1,52 @@ +/*------------------------------------------------------------------------------------------------ + CP2K: A general program to perform molecular dynamics simulations + Copyright 2000-2023 CP2K developers group + + SPDX-License-Identifier: GPL-2.0-or-later +-------------------------------------------------------------------------------------------------*/ + +class kinds { + +public: +/*************************************************************************************************** + \brief Print informations about the used data types. + \param iw ... + \par History + Adapted by JGH for Cp2k + \author Matthias Krack +***************************************************************************************************/ +void print_kind_info(int iw) +{ + + WRITE (iw, '( /, T2, A )') 'DATA TYPE INFORMATION:' + + WRITE (iw, '( /,T2,A,T79,A,2(/,T2,A,T75,I6),3(/,T2,A,T67,E14.8) )') & + 'REAL: Data type name:', 'dp', ' Kind value:', KIND(0.0_dp), & + ' Precision:', PRECISION(0.0_dp), & + ' Smallest non-negligible quantity relative to 1:', & + EPSILON(0.0_dp), & + ' Smallest positive number:', TINY(0.0_dp), & + ' Largest representable number:', HUGE(0.0_dp) + WRITE (iw, '( /,T2,A,T79,A,2(/,T2,A,T75,I6),3(/,T2,A,T67,E14.8) )') & + ' Data type name:', 'sp', ' Kind value:', KIND(0.0_sp), & + ' Precision:', PRECISION(0.0_sp), & + ' Smallest non-negligible quantity relative to 1:', & + EPSILON(0.0_sp), & + ' Smallest positive number:', TINY(0.0_sp), & + ' Largest representable number:', HUGE(0.0_sp) + WRITE (iw, '( /,T2,A,T72,A,4(/,T2,A,T61,I20) )') & + 'INTEGER: Data type name:', '(default)', ' Kind value:', & + KIND(0), & + ' Bit size:', BIT_SIZE(0), & + ' Largest representable number:', HUGE(0) + WRITE (iw, '( /,T2,A,T72,A,/,T2,A,T75,I6,/ )') & + 'LOGICAL: Data type name:', '(default)', & + ' Kind value:', KIND(.TRUE.) + WRITE (iw, '( /,T2,A,T72,A,/,T2,A,T75,I6,/ )') & + 'CHARACTER: Data type name:', '(default)', & + ' Kind value:', KIND('C') + +} + + +} diff --git a/src/cp2k_info.cpp b/src/cp2k_info.cpp new file mode 100644 index 0000000..9173900 --- /dev/null +++ b/src/cp2k_info.cpp @@ -0,0 +1,341 @@ +/*-------------------------------------------------------------------------------------------------- + CP2K: A general program to perform molecular dynamics simulations + Copyright 2000-2023 CP2K developers group + + SPDX-License-Identifier: GPL-2.0-or-later +--------------------------------------------------------------------------------------------------*/ + +/*************************************************************************************************** + \brief some minimal info about CP2K, including its version and license + \par History + - created (2007-09, Joost VandeVondele) + - moved into this module information related to runtime:pid, user_name, + host_name, cwd, datx (2009-06, Teodoro Laino) + \author Joost VandeVondele +***************************************************************************************************/ + +#include + +#include "./base/base.h" + +class cp2k_info { + +private: + char *moduleN = "cp2k_info"; + +public: + void cp2k_flags(); + void print_cp2k_license(); + void get_runtime_info(); + void write_restart_header(); + int cp2k_version, cp2k_year, cp2k_home; + int compile_arch, compile_date, compile_host, compile_revision; + +#if defined(__COMPILE_REVISION) + char *compile_revision = __COMPILE_REVISION; +#else + char *compile_revision = "unknown"; +#endif + + char *cp2k_version = "CP2K version 2023.2 (Development Version)"; + char *cp2k_year = "2023"; + char *cp2k_home = "https://www.cp2k.org/"; + + // compile time information +#if defined(__COMPILE_ARCH) + char *compile_arch = __COMPILE_ARCH; +#else + char *compile_arch = "unknown: -D__COMPILE_ARCH=?"; +#endif + +#if defined(__COMPILE_DATE) + char *compile_date = __COMPILE_DATE; +#else + char *compile_date = "unknown: -D__COMPILE_DATE=?"; +#endif + +#if defined(__COMPILE_HOST) + char *compile_host = __COMPILE_HOST; +#else + char *compile_host = "unknown: -D__COMPILE_HOST=?"; +#endif + + // Local runtime informations + char r_datx[26]; + char r_cwd[default_path_length]; + char r_host_name[default_string_length], r_user_name[default_string_length]; + int r_pid; + + +}; + +/*************************************************************************************************** + \brief list all compile time options that influence the capabilities of cp2k. + All new flags should be added here (and be unique grep-able) + \return ... +***************************************************************************************************/ +char* cp2k_info::cp2k_flags() +{ + char flags[10*default_string_length]; + + char tmp_str[default_string_length]; + + std::strncpy(flags,"cp2kflags:", sizeof(flags)); + + // Ensure that tmp_str is used to silence compiler warnings + std::strncpy(tmp_str, "", sizeof(tmp_str); + flags = TRIM(flags)//TRIM(tmp_str) + +#if defined(NDEBUG); + flags = TRIM(flags)//" ndebug" +#endif + flags = TRIM(flags)//" omp" +#if defined(__LIBINT) + flags = TRIM(flags)//" libint" +#endif +#if defined(__FFTW3) + flags = TRIM(flags)//" fftw3" +#endif +#if defined(__FFTW3_MKL) + flags = TRIM(flags)//" fftw3_mkl" +#endif +#if defined(__LIBXC) + flags = TRIM(flags)//" libxc" +#endif +#if defined(__LIBPEXSI) + flags = TRIM(flags)//" pexsi" +#endif +#if defined(__ELPA) + flags = TRIM(flags)//" elpa" +#endif +#if defined(__ELPA_NVIDIA_GPU) + flags = TRIM(flags)//" elpa_nvidia_gpu" +#endif +#if defined(__ELPA_AMD_GPU) + flags = TRIM(flags)//" elpa_amd_gpu" +#endif +#if defined(__ELPA_INTEL_GPU) + flags = TRIM(flags)//" elpa_intel_gpu" +#endif +#if defined(__parallel) + flags = TRIM(flags)//" parallel" +#endif +#if defined(__MPI_F08) + flags = TRIM(flags)//" mpi_f08" +#endif +#if defined(__SCALAPACK) + flags = TRIM(flags)//" scalapack" +#endif +#if defined(__COSMA) + flags = TRIM(flags)//" cosma" +#endif + +#if defined(__QUIP) + flags = TRIM(flags)//" quip" +#endif + +#if defined(__HAS_PATCHED_CUFFT_70) + flags = TRIM(flags)//" patched_cufft_70" +#endif + +#if defined(__PW_FPGA) + flags = TRIM(flags)//" pw_fpga" +#endif +#if defined(__PW_FPGA_SP) + flags = TRIM(flags)//" pw_fpga_sp" +#endif + +#if defined(__LIBXSMM) + flags = TRIM(flags)//" xsmm" +#endif + +#if defined(__CRAY_PM_ACCEL_ENERGY) + flags = TRIM(flags)//" cray_pm_accel_energy" +#endif +#if defined(__CRAY_PM_ENERGY) + flags = TRIM(flags)//" cray_pm_energy" +#endif +#if defined(__CRAY_PM_FAKE_ENERGY) + flags = TRIM(flags)//" cray_pm_fake_energy" +#endif +#if defined(__DBCSR_ACC) + flags = TRIM(flags)//" dbcsr_acc" +#endif +#if defined(__MAX_CONTR) + CALL integer_to_string(__MAX_CONTR, tmp_str) + flags = TRIM(flags)//" max_contr="//TRIM(tmp_str) +#endif +#if defined(__NO_SOCKETS) + flags = TRIM(flags)//" no_sockets" +#endif +#if defined(__NO_MPI_THREAD_SUPPORT_CHECK) + flags = TRIM(flags)//" no_mpi_thread_support_check" +#endif +#if defined(__NO_STATM_ACCESS) + flags = TRIM(flags)//" no_statm_access" +#endif +#if defined(__MINGW) + flags = TRIM(flags)//" mingw" +#endif +#if defined(__PW_CUDA_NO_HOSTALLOC) + flags = TRIM(flags)//" pw_cuda_no_hostalloc" +#endif +#if defined(__STATM_RESIDENT) + flags = TRIM(flags)//" statm_resident" +#endif +#if defined(__STATM_TOTAL) + flags = TRIM(flags)//" statm_total" +#endif +#if defined(__PLUMED2) + flags = TRIM(flags)//" plumed2" +#endif +#if defined(__HAS_IEEE_EXCEPTIONS) + flags = TRIM(flags)//" has_ieee_exceptions" +#endif +#if defined(__NO_ABORT) + flags = TRIM(flags)//" no_abort" +#endif +#if defined(__SPGLIB) + flags = TRIM(flags)//" spglib" +#endif +#if defined(__ACCELERATE) + flags = TRIM(flags)//" accelerate" +#endif +#if defined(__MKL) + flags = TRIM(flags)//" mkl" +#endif +#if defined(__SIRIUS) + flags = TRIM(flags)//" sirius" +#endif +#if defined(__CHECK_DIAG) + flags = TRIM(flags)//" check_diag" +#endif +#if defined(__LIBVORI) + flags = TRIM(flags)//" libvori" + flags = TRIM(flags)//" libbqb" +#endif +#if defined(__LIBMAXWELL) + flags = TRIM(flags)//" libmaxwell" +#endif +#if defined(__LIBTORCH) + flags = TRIM(flags)//" libtorch" +#endif +#if defined(__OFFLOAD_CUDA) + flags = TRIM(flags)//" offload_cuda" +#endif +#if defined(__OFFLOAD_HIP) + flags = TRIM(flags)//" offload_hip" +#endif +#if defined(__NO_OFFLOAD_GRID) + flags = TRIM(flags)//" no_offload_grid" +#endif +#if defined(__NO_OFFLOAD_DBM) + flags = TRIM(flags)//" no_offload_dbm" +#endif +#if defined(__NO_OFFLOAD_PW) + flags = TRIM(flags)//" no_offload_pw" +#endif +#if defined(__OFFLOAD_PROFILING) + flags = TRIM(flags)//" offload_profiling" +#endif + +#if defined(__SPLA) && defined(__OFFLOAD_GEMM) + flags = TRIM(flags)//" spla_gemm_offloading" +#endif + +#if defined(__CUSOLVERMP) + flags = TRIM(flags)//" cusolvermp" +#endif + +#if defined(__LIBVDWXC) + flags = TRIM(flags)//" libvdwxc" +#endif + +#if defined(__HDF5) + flags = TRIM(flags)//" hdf5" +#endif + + return flags; +} + +/*************************************************************************************************** + \brief ... + \param iunit ... +***************************************************************************************************/ +void cp2k_info::print_cp2k_license(int iunit) +{ + + WRITE (UNIT=iunit, FMT="(T2,A)") & + "******************************************************************************", & + "* *", & + "* CP2K: A general program to perform molecular dynamics simulations *", & + "* Copyright (C) 2000-2023 CP2K developer group *", & + "* *", & + "* This program is free software: you can redistribute it and/or modify *", & + "* it under the terms of the GNU General Public License as published by *", & + "* the Free Software Foundation, either version 2 of the License, or *", & + "* (at your option) any later version. *", & + "* *", & + "* This program is distributed in the hope that it will be useful, *", & + "* but WITHOUT ANY WARRANTY; without even the implied warranty of *", & + "* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *", & + "* GNU General Public License for more details. *", & + "* *", & + "* You should have received a copy of the GNU General Public License *", & + "* along with this program. If not, see . *", & + "* *", & + "******************************************************************************"; + +} + +/*************************************************************************************************** + \brief ... +***************************************************************************************************/ +void cp2k_info::get_runtime_info() +{ + r_datx = ""; + r_cwd = ""; + r_host_name = ""; + r_user_name = ""; + r_pid = -1; + + m_getpid(r_pid) + CALL m_getlog(r_user_name) + CALL m_hostnm(r_host_name) + CALL m_datum(r_datx) + CALL m_getcwd(r_cwd) + +} + +/*************************************************************************************************** + \brief Writes the header for the restart file + \param iunit ... + \par History + 01.2008 [created] - Split from write_restart + \author Teodoro Laino - University of Zurich - 01.2008 +***************************************************************************************************/ +void cp2k_info::write_restart_header(int iunit) +{ + char cwd[256], datx[256]; + + m_datum(datx); + m_getcwd(cwd); + + WRITE (UNIT=iunit, FMT="(T2,A)") "# Version information for this restart file " + WRITE (UNIT=iunit, FMT="(T2,A)") "# current date "//TRIM(datx) + WRITE (UNIT=iunit, FMT="(T2,A)") "# current working dir "//TRIM(cwd) + + WRITE (UNIT=iunit, FMT="(T2,A,T31,A50)") & + "# Program compiled at", & + ADJUSTR(compile_date(1:MIN(50, LEN(compile_date)))) + WRITE (UNIT=iunit, FMT="(T2,A,T31,A50)") & + "# Program compiled on", & + ADJUSTR(compile_host(1:MIN(50, LEN(compile_host)))) + WRITE (UNIT=iunit, FMT="(T2,A,T31,A50)") & + "# Program compiled for", & + ADJUSTR(compile_arch(1:MIN(50, LEN(compile_arch)))) + WRITE (UNIT=iunit, FMT="(T2,A,T31,A50)") & + "# Source code revision number", & + ADJUSTR(compile_revision) + +} diff --git a/src/qs_environment_types.cpp b/src/qs_environment_types.cpp new file mode 100644 index 0000000..deaad7a --- /dev/null +++ b/src/qs_environment_types.cpp @@ -0,0 +1,1675 @@ +/*-------------------------------------------------------------------------------------------------- + CP2K: A general program to perform molecular dynamics simulations + Copyright 2000-2023 CP2K developers group + + SPDX-License-Identifier: GPL-2.0-or-later +--------------------------------------------------------------------------------------------------*/ + +/*************************************************************************************************** + \par History + - mo_set_p_type added to qs_env (23.04.02,MK) + - qs_force_type added to qs_env (05.06.02,MK) + \author MK (23.01.2002) +***************************************************************************************************/ + +#include "./base/base_uses.h" + +class qs_environment_types { + +private: + char *moduleN = "qs_environment_types"; + +public: +// *** Public data types *** + + struct qs_environment_type; + +// *** Public subroutines *** + void get_qs_env(); + void qs_env_create(); + void qs_env_release(); + void qs_env_part_release(); + void set_qs_env(); + +/*************************************************************************************************** + \param local_rho_set contains the atomic, compensations and core densities + and the local parts of the xc terms + \param hartree_local contains the 1, 2 and 3 centers coulomb terms + \param requires_mo_derivs logical, true if dE/dC is required (e.g. OT) + \param has_unit_metric logical, true if the S matrix is considered unity for the SCF + \param mo_derivs the actual derivatives of the total energy wrt to MO coeffs (divided by +2*f_i) + \param xas_env temporary information for xas calculation + \param dftb_potential pair potentials for use with DFTB + \param dispersion_env environment for use with QS dispersion + + compatibility get (things that you should get from the subsys): + \param atomic_kind_set array with infos about the species (atomic_kinds) + present in the system + \param particle_set info on the atoms you simulate, pos,... + \param local_particles which particles ar local to this processor + new: + \param local_molecules which molecules are local to this processor + \param molecule_kind_set description of the molecule kinds + \param molecule_set all the molecule description + \param rtp all data needed for real time propagation + \param x contains data used in Hartree-Fock-Exchange calculations + \param task_list the list of tasks used in collocate and integrate + \param task_list_soft the list of tasks used in collocate and integrate in case of soft basis +functions + \param mo_loc_history if a history of localized wfn is kept, they are stored here. + \param molecular_scf_guess_env contains inforamation about and results of claculations + on separate molecules + \par History + 11.2002 added doc and attribute description [fawzi] + 08.2004 renamed some of the very short names (s,c,k,h) for easier grepping + 06.2018 polar_env added (MK) + \author Matthias Krack & fawzi +***************************************************************************************************/ + + struct qs_environment_type { + bool qmmm, qmmm_periodic; + bool requires_mo_derivs; + bool requires_matrix_vxc; + bool has_unit_metric; + bool run_rtp; + bool linres_run; + bool calc_image_preconditioner; + bool do_transport; + bool single_point_run; + bool given_embed_pot; + bool energy_correction; + double sim_time; + double start_time, target_time; + double *image_matrix; + double *image_coeff; + int *ipiv; + int sim_step; + TYPE(ls_scf_env_type), POINTER :: ls_scf_env + TYPE(almo_scf_env_type), POINTER :: almo_scf_env + TYPE(transport_env_type), POINTER :: transport_env + TYPE(cell_type), POINTER :: super_cell + TYPE(mo_set_type), DIMENSION(:), POINTER :: mos + TYPE(cp_fm_type), DIMENSION(:), POINTER :: mo_loc_history + TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: mo_derivs + TYPE(scf_control_type), POINTER :: scf_control + TYPE(rel_control_type), POINTER :: rel_control + // ZMP adding variables + TYPE(qs_rho_type), POINTER :: rho_external + TYPE(pw_type), POINTER :: external_vxc + TYPE(pw_type), POINTER :: mask + TYPE(qs_charges_type), POINTER :: qs_charges + TYPE(qs_ks_env_type), POINTER :: ks_env + TYPE(qs_ks_qmmm_env_type), POINTER :: ks_qmmm_env + TYPE(qmmm_env_qm_type), POINTER :: qmmm_env_qm + TYPE(qs_wf_history_type), POINTER :: wf_history + TYPE(qs_scf_env_type), POINTER :: scf_env + TYPE(qs_matrix_pools_type), POINTER :: mpools + TYPE(oce_matrix_type), POINTER :: oce + TYPE(local_rho_type), POINTER :: local_rho_set + TYPE(hartree_local_type), POINTER :: hartree_local + TYPE(section_vals_type), POINTER :: input + TYPE(linres_control_type), POINTER :: linres_control + TYPE(xas_environment_type), POINTER :: xas_env + TYPE(cp_ddapc_type), POINTER :: cp_ddapc_env + TYPE(cp_ddapc_ewald_type), POINTER :: cp_ddapc_ewald + REAL(KIND=dp), DIMENSION(:, :), POINTER :: outer_scf_history + INTEGER :: outer_scf_ihistory + REAL(KIND=dp), DIMENSION(:, :), POINTER :: gradient_history, & + variable_history + TYPE(hfx_type), DIMENSION(:, :), POINTER :: x_data + TYPE(et_coupling_type), POINTER :: et_coupling + TYPE(qs_dftb_pairpot_type), DIMENSION(:, :), POINTER :: dftb_potential + TYPE(admm_type), POINTER :: admm_env + TYPE(active_space_type), POINTER :: active_space + // LRI + TYPE(lri_environment_type), POINTER :: lri_env + TYPE(lri_density_type), POINTER :: lri_density + // Energy correction + TYPE(energy_correction_type), POINTER :: ec_env + // Excited States + bool excited_state; + TYPE(excited_energy_type), POINTER :: exstate_env + // Empirical dispersion + TYPE(qs_dispersion_type), POINTER :: dispersion_env + // Empirical geometrical BSSE correction + TYPE(qs_gcp_type), POINTER :: gcp_env + // Semi-empirical and DFTB types + TYPE(ewald_environment_type), POINTER :: ewald_env + TYPE(ewald_pw_type), POINTER :: ewald_pw + // Semi-empirical types + TYPE(se_taper_type), POINTER :: se_taper + TYPE(semi_empirical_si_type), POINTER :: se_store_int_env + TYPE(nddo_mpole_type), POINTER :: se_nddo_mpole + TYPE(fist_nonbond_env_type), POINTER :: se_nonbond_env + TYPE(rt_prop_type), POINTER :: rtp + TYPE(efield_berry_type), POINTER :: efield + // a history for the broyden ot + double broyden_adaptive_sigma + TYPE(mp2_type), POINTER :: mp2_env => NULL() + TYPE(post_scf_bandstructure_type), POINTER :: bs_env => +NULL() + TYPE(kg_environment_type), POINTER :: kg_env + TYPE(wannier_centres_type), POINTER, DIMENSION(:) :: WannierCentres => NULL() + TYPE(molecular_scf_guess_env_type), POINTER :: molecular_scf_guess_env => NULL() + // Subsystem densities + TYPE(qs_rho_p_type), DIMENSION(:), POINTER :: subsys_dens + // Embedding potential + TYPE(pw_type), POINTER :: embed_pot + TYPE(pw_type), POINTER :: spin_embed_pot + // Polarizability tensor + TYPE(polar_env_type), POINTER :: polar_env + // Resp charges + REAL(KIND=dp), DIMENSION(:), POINTER :: rhs => NULL() + double total_zeff_corr, surface_dipole_moment + bool surface_dipole_switch_off; + TYPE(mo_set_type), DIMENSION(:), POINTER :: mos_last_converged + } + +} + +/*************************************************************************************************** + \brief Get the QUICKSTEP environment. + \param qs_env ... + \param atomic_kind_set ... + \param qs_kind_set ... + \param cell ... + \param super_cell ... + \param cell_ref ... + \param use_ref_cell ... + \param kpoints ... + \param dft_control ... + \param mos ... + \param sab_orb ... + \param sab_all ... + \param qmmm ... + \param qmmm_periodic ... + \param sac_ae ... + \param sac_ppl ... + \param sac_lri ... + \param sap_ppnl ... + \param sab_vdw ... + \param sab_scp ... + \param sap_oce ... + \param sab_lrc ... + \param sab_se ... + \param sab_xtbe ... + \param sab_tbe ... + \param sab_core ... + \param sab_xb ... + \param sab_xtb_nonbond ... + \param sab_almo ... + \param sab_kp ... + \param sab_kp_nosym ... + \param particle_set ... + \param energy ... + \param force ... + \param matrix_h ... + \param matrix_h_im ... + \param matrix_ks ... + \param matrix_ks_im ... + \param matrix_vxc ... + \param run_rtp ... + \param rtp ... + \param matrix_h_kp ... + \param matrix_h_im_kp ... + \param matrix_ks_kp ... + \param matrix_ks_im_kp ... + \param matrix_vxc_kp ... + \param kinetic_kp ... + \param matrix_s_kp ... + \param matrix_w_kp ... + \param matrix_s_RI_aux_kp ... + \param matrix_s ... + \param matrix_s_RI_aux ... + \param matrix_w ... + \param matrix_p_mp2 ... + \param matrix_p_mp2_admm ... + \param rho ... + \param rho_xc ... + \param pw_env ... + \param ewald_env ... + \param ewald_pw ... + \param active_space ... + \param mpools ... + \param input ... + \param para_env ... + \param blacs_env ... + \param scf_control ... + \param rel_control ... + \param kinetic ... + \param qs_charges ... + \param vppl ... + \param rho_core ... + \param rho_nlcc ... + \param rho_nlcc_g ... + \param ks_env ... + \param ks_qmmm_env ... + \param wf_history ... + \param scf_env ... + \param local_particles ... + \param local_molecules ... + \param distribution_2d ... + \param dbcsr_dist ... + \param molecule_kind_set ... + \param molecule_set ... + \param subsys ... + \param cp_subsys ... + \param oce ... + \param local_rho_set ... + \param rho_atom_set ... + \param task_list ... + \param task_list_soft ... + \param rho0_atom_set ... + \param rho0_mpole ... + \param rhoz_set ... + \param ecoul_1c ... + \param rho0_s_rs ... + \param rho0_s_gs ... + \param do_kpoints ... + \param has_unit_metric ... + \param requires_mo_derivs ... + \param mo_derivs ... + \param mo_loc_history ... + \param nkind ... + \param natom ... + \param nelectron_total ... + \param nelectron_spin ... + \param efield ... + \param neighbor_list_id ... + \param linres_control ... + \param xas_env ... + \param virial ... + \param cp_ddapc_env ... + \param cp_ddapc_ewald ... + \param outer_scf_history ... + \param outer_scf_ihistory ... + \param x_data ... + \param et_coupling ... + \param dftb_potential ... + \param results ... + \param se_taper ... + \param se_store_int_env ... + \param se_nddo_mpole ... + \param se_nonbond_env ... + \param admm_env ... + \param lri_env ... + \param lri_density ... + \param exstate_env ... + \param ec_env ... + \param dispersion_env ... + \param gcp_env ... + \param vee ... + \param rho_external ... + \param external_vxc ... + \param mask ... + \param mp2_env ... + \param bs_env ... + \param kg_env ... + \param WannierCentres ... + \param atprop ... + \param ls_scf_env ... + \param do_transport ... + \param transport_env ... + \param v_hartree_rspace ... + \param s_mstruct_changed ... + \param rho_changed ... + \param potential_changed ... + \param forces_up_to_date ... + \param mscfg_env ... + \param almo_scf_env ... + \param gradient_history ... + \param variable_history ... + \param embed_pot ... + \param spin_embed_pot ... + \param polar_env ... + \param mos_last_converged ... [SGh] + \param rhs ... + \date 23.01.2002 + \author MK + \version 1.0 +***************************************************************************************************/ +void qs_environment_types::get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, +cell_ref, use_ref_cell, kpoints, & + dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, sac_ae, +sac_ppl, sac_lri, & + sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, +sab_core, & + sab_xb, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, particle_set, +energy, force, & + matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, +rtp, & + matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, +matrix_vxc_kp, kinetic_kp, matrix_s_kp, & + matrix_w_kp, matrix_s_RI_aux_kp, matrix_s, matrix_s_RI_aux, matrix_w, & + matrix_p_mp2, matrix_p_mp2_admm, rho, & + rho_xc, pw_env, ewald_env, ewald_pw, active_space, & + mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, +qs_charges, & + vppl, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, +scf_env, local_particles, & + local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, & + molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, & + task_list, & + task_list_soft, & + rho0_atom_set, rho0_mpole, rhoz_set, ecoul_1c, & + rho0_s_rs, rho0_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, +mo_derivs, & + mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, & + neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, +cp_ddapc_ewald, & + outer_scf_history, outer_scf_ihistory, x_data, et_coupling, +dftb_potential, results, & + se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, & + lri_env, lri_density, exstate_env, ec_env, dispersion_env, gcp_env, vee, +& + rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, & + WannierCentres, atprop, ls_scf_env, do_transport, transport_env, +v_hartree_rspace, & + s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, +mscfg_env, almo_scf_env, & + gradient_history, variable_history, embed_pot, spin_embed_pot, +polar_env, mos_last_converged, rhs) + TYPE(qs_environment_type), INTENT(IN) :: qs_env + TYPE(atomic_kind_type), DIMENSION(:), OPTIONAL, & + POINTER :: atomic_kind_set + TYPE(qs_kind_type), DIMENSION(:), OPTIONAL, & + POINTER :: qs_kind_set + TYPE(cell_type), OPTIONAL, POINTER :: cell, super_cell, cell_ref + LOGICAL, OPTIONAL :: use_ref_cell + TYPE(kpoint_type), OPTIONAL, POINTER :: kpoints + TYPE(dft_control_type), OPTIONAL, POINTER :: dft_control + TYPE(mo_set_type), DIMENSION(:), OPTIONAL, POINTER :: mos + TYPE(neighbor_list_set_p_type), DIMENSION(:), & + OPTIONAL, POINTER :: sab_orb, sab_all + LOGICAL, OPTIONAL :: qmmm, qmmm_periodic + TYPE(neighbor_list_set_p_type), DIMENSION(:), OPTIONAL, POINTER :: sac_ae, sac_ppl, +sac_lri, & + sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, & + sab_xb, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym + TYPE(particle_type), DIMENSION(:), OPTIONAL, & + POINTER :: particle_set + TYPE(qs_energy_type), OPTIONAL, POINTER :: energy + TYPE(qs_force_type), DIMENSION(:), OPTIONAL, & + POINTER :: force + TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, & + POINTER :: matrix_h, matrix_h_im, matrix_ks, & + matrix_ks_im, matrix_vxc + LOGICAL, OPTIONAL :: run_rtp + TYPE(rt_prop_type), OPTIONAL, POINTER :: rtp + TYPE(dbcsr_p_type), DIMENSION(:, :), OPTIONAL, POINTER :: matrix_h_kp, matrix_h_im_kp, & + matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, & + matrix_s_RI_aux_kp + TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, & + POINTER :: matrix_s, matrix_s_RI_aux, matrix_w, +& + matrix_p_mp2, matrix_p_mp2_admm + TYPE(qs_rho_type), OPTIONAL, POINTER :: rho, rho_xc + TYPE(pw_env_type), OPTIONAL, POINTER :: pw_env + TYPE(ewald_environment_type), OPTIONAL, POINTER :: ewald_env + TYPE(ewald_pw_type), OPTIONAL, POINTER :: ewald_pw + TYPE(active_space_type), OPTIONAL, POINTER :: active_space + TYPE(qs_matrix_pools_type), OPTIONAL, POINTER :: mpools + TYPE(section_vals_type), OPTIONAL, POINTER :: input + TYPE(mp_para_env_type), OPTIONAL, POINTER :: para_env + TYPE(cp_blacs_env_type), OPTIONAL, POINTER :: blacs_env + TYPE(scf_control_type), OPTIONAL, POINTER :: scf_control + TYPE(rel_control_type), OPTIONAL, POINTER :: rel_control + TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, & + POINTER :: kinetic + TYPE(qs_charges_type), OPTIONAL, POINTER :: qs_charges + TYPE(pw_type), OPTIONAL, POINTER :: vppl, rho_core, rho_nlcc, rho_nlcc_g + TYPE(qs_ks_env_type), OPTIONAL, POINTER :: ks_env + TYPE(qs_ks_qmmm_env_type), OPTIONAL, POINTER :: ks_qmmm_env + TYPE(qs_wf_history_type), OPTIONAL, POINTER :: wf_history + TYPE(qs_scf_env_type), OPTIONAL, POINTER :: scf_env + TYPE(distribution_1d_type), OPTIONAL, POINTER :: local_particles, local_molecules + TYPE(distribution_2d_type), OPTIONAL, POINTER :: distribution_2d + TYPE(dbcsr_distribution_type), OPTIONAL, POINTER :: dbcsr_dist + TYPE(molecule_kind_type), DIMENSION(:), OPTIONAL, & + POINTER :: molecule_kind_set + TYPE(molecule_type), DIMENSION(:), OPTIONAL, & + POINTER :: molecule_set + TYPE(qs_subsys_type), OPTIONAL, POINTER :: subsys + TYPE(cp_subsys_type), OPTIONAL, POINTER :: cp_subsys + TYPE(oce_matrix_type), OPTIONAL, POINTER :: oce + TYPE(local_rho_type), OPTIONAL, POINTER :: local_rho_set + TYPE(rho_atom_type), DIMENSION(:), OPTIONAL, & + POINTER :: rho_atom_set + TYPE(task_list_type), OPTIONAL, POINTER :: task_list, task_list_soft + TYPE(rho0_atom_type), DIMENSION(:), OPTIONAL, & + POINTER :: rho0_atom_set + TYPE(rho0_mpole_type), OPTIONAL, POINTER :: rho0_mpole + TYPE(rhoz_type), DIMENSION(:), OPTIONAL, POINTER :: rhoz_set + TYPE(ecoul_1center_type), DIMENSION(:), OPTIONAL, & + POINTER :: ecoul_1c + TYPE(pw_type), OPTIONAL, POINTER :: rho0_s_rs, rho0_s_gs + LOGICAL, OPTIONAL :: do_kpoints, has_unit_metric, & + requires_mo_derivs + TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, & + POINTER :: mo_derivs + TYPE(cp_fm_type), DIMENSION(:), OPTIONAL, POINTER :: mo_loc_history + INTEGER, OPTIONAL :: nkind, natom, nelectron_total + INTEGER, DIMENSION(2), OPTIONAL :: nelectron_spin + TYPE(efield_berry_type), OPTIONAL, POINTER :: efield + INTEGER, OPTIONAL :: neighbor_list_id + TYPE(linres_control_type), OPTIONAL, POINTER :: linres_control + TYPE(xas_environment_type), OPTIONAL, POINTER :: xas_env + TYPE(virial_type), OPTIONAL, POINTER :: virial + TYPE(cp_ddapc_type), OPTIONAL, POINTER :: cp_ddapc_env + TYPE(cp_ddapc_ewald_type), OPTIONAL, POINTER :: cp_ddapc_ewald + REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: outer_scf_history + INTEGER, INTENT(out), OPTIONAL :: outer_scf_ihistory + TYPE(hfx_type), DIMENSION(:, :), OPTIONAL, POINTER :: x_data + TYPE(et_coupling_type), OPTIONAL, POINTER :: et_coupling + TYPE(qs_dftb_pairpot_type), DIMENSION(:, :), & + OPTIONAL, POINTER :: dftb_potential + TYPE(cp_result_type), OPTIONAL, POINTER :: results + TYPE(se_taper_type), OPTIONAL, POINTER :: se_taper + TYPE(semi_empirical_si_type), OPTIONAL, POINTER :: se_store_int_env + TYPE(nddo_mpole_type), OPTIONAL, POINTER :: se_nddo_mpole + TYPE(fist_nonbond_env_type), OPTIONAL, POINTER :: se_nonbond_env + TYPE(admm_type), OPTIONAL, POINTER :: admm_env + TYPE(lri_environment_type), OPTIONAL, POINTER :: lri_env + TYPE(lri_density_type), OPTIONAL, POINTER :: lri_density + TYPE(excited_energy_type), OPTIONAL, POINTER :: exstate_env + TYPE(energy_correction_type), OPTIONAL, POINTER :: ec_env + TYPE(qs_dispersion_type), OPTIONAL, POINTER :: dispersion_env + TYPE(qs_gcp_type), OPTIONAL, POINTER :: gcp_env + TYPE(pw_type), OPTIONAL, POINTER :: vee + TYPE(qs_rho_type), OPTIONAL, POINTER :: rho_external + TYPE(pw_type), OPTIONAL, POINTER :: external_vxc, mask + TYPE(mp2_type), OPTIONAL, POINTER :: mp2_env + TYPE(post_scf_bandstructure_type), OPTIONAL, & + POINTER :: bs_env + TYPE(kg_environment_type), OPTIONAL, POINTER :: kg_env + TYPE(wannier_centres_type), DIMENSION(:), & + OPTIONAL, POINTER :: WannierCentres + TYPE(atprop_type), OPTIONAL, POINTER :: atprop + TYPE(ls_scf_env_type), OPTIONAL, POINTER :: ls_scf_env + LOGICAL, OPTIONAL :: do_transport + TYPE(transport_env_type), OPTIONAL, POINTER :: transport_env + TYPE(pw_type), OPTIONAL, POINTER :: v_hartree_rspace + LOGICAL, OPTIONAL :: s_mstruct_changed, rho_changed, & + potential_changed, forces_up_to_date + TYPE(molecular_scf_guess_env_type), OPTIONAL, & + POINTER :: mscfg_env + TYPE(almo_scf_env_type), OPTIONAL, POINTER :: almo_scf_env + REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: gradient_history, variable_history + TYPE(pw_type), OPTIONAL, POINTER :: embed_pot, spin_embed_pot + TYPE(polar_env_type), OPTIONAL, POINTER :: polar_env + TYPE(mo_set_type), DIMENSION(:), OPTIONAL, POINTER :: mos_last_converged + REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: rhs + + TYPE(rho0_mpole_type), POINTER :: rho0_m + + NULLIFY (rho0_m) + CPASSERT(ASSOCIATED(qs_env%ks_env)) + + IF (PRESENT(outer_scf_history)) outer_scf_history => qs_env%outer_scf_history + IF (PRESENT(outer_scf_ihistory)) outer_scf_ihistory = qs_env%outer_scf_ihistory + IF (PRESENT(gradient_history)) gradient_history => qs_env%gradient_history + IF (PRESENT(variable_history)) variable_history => qs_env%variable_history + IF (PRESENT(mp2_env)) mp2_env => qs_env%mp2_env + IF (PRESENT(bs_env)) bs_env => qs_env%bs_env + IF (PRESENT(kg_env)) kg_env => qs_env%kg_env + IF (PRESENT(super_cell)) super_cell => qs_env%super_cell + IF (PRESENT(qmmm)) qmmm = qs_env%qmmm + IF (PRESENT(qmmm_periodic)) qmmm_periodic = qs_env%qmmm_periodic + IF (PRESENT(mos)) mos => qs_env%mos + IF (PRESENT(mos_last_converged)) mos_last_converged => qs_env%mos_last_converged + IF (PRESENT(ewald_env)) ewald_env => qs_env%ewald_env + IF (PRESENT(ewald_pw)) ewald_pw => qs_env%ewald_pw + IF (PRESENT(mpools)) mpools => qs_env%mpools + IF (PRESENT(scf_control)) scf_control => qs_env%scf_control + IF (PRESENT(rel_control)) rel_control => qs_env%rel_control + // ZMP pointing vectors + IF (PRESENT(rho_external)) rho_external => qs_env%rho_external + IF (PRESENT(external_vxc)) external_vxc => qs_env%external_vxc + IF (PRESENT(mask)) mask => qs_env%mask + IF (PRESENT(qs_charges)) qs_charges => qs_env%qs_charges + IF (PRESENT(ks_env)) ks_env => qs_env%ks_env + IF (PRESENT(ks_qmmm_env)) ks_qmmm_env => qs_env%ks_qmmm_env + IF (PRESENT(wf_history)) wf_history => qs_env%wf_history + IF (PRESENT(scf_env)) scf_env => qs_env%scf_env + IF (PRESENT(oce)) oce => qs_env%oce + IF (PRESENT(requires_mo_derivs)) requires_mo_derivs = qs_env%requires_mo_derivs + IF (PRESENT(has_unit_metric)) has_unit_metric = qs_env%has_unit_metric + IF (PRESENT(mo_derivs)) mo_derivs => qs_env%mo_derivs + IF (PRESENT(mo_loc_history)) mo_loc_history => qs_env%mo_loc_history + IF (PRESENT(linres_control)) linres_control => qs_env%linres_control + IF (PRESENT(se_taper)) se_taper => qs_env%se_taper + IF (PRESENT(se_store_int_env)) se_store_int_env => qs_env%se_store_int_env + IF (PRESENT(se_nddo_mpole)) se_nddo_mpole => qs_env%se_nddo_mpole + IF (PRESENT(se_nonbond_env)) se_nonbond_env => qs_env%se_nonbond_env + IF (PRESENT(lri_env)) lri_env => qs_env%lri_env + IF (PRESENT(lri_density)) lri_density => qs_env%lri_density + IF (PRESENT(ec_env)) ec_env => qs_env%ec_env + IF (PRESENT(exstate_env)) exstate_env => qs_env%exstate_env + IF (PRESENT(dispersion_env)) dispersion_env => qs_env%dispersion_env + IF (PRESENT(gcp_env)) gcp_env => qs_env%gcp_env + IF (PRESENT(run_rtp)) run_rtp = qs_env%run_rtp + IF (PRESENT(rtp)) rtp => qs_env%rtp + IF (PRESENT(ls_scf_env)) ls_scf_env => qs_env%ls_scf_env + IF (PRESENT(almo_scf_env)) almo_scf_env => qs_env%almo_scf_env + IF (PRESENT(do_transport)) do_transport = qs_env%do_transport + IF (PRESENT(transport_env)) transport_env => qs_env%transport_env + IF (PRESENT(mscfg_env)) mscfg_env => qs_env%molecular_scf_guess_env + IF (PRESENT(active_space)) active_space => qs_env%active_space + IF (PRESENT(admm_env)) admm_env => qs_env%admm_env + + // Embedding potential + IF (PRESENT(embed_pot)) embed_pot => qs_env%embed_pot + IF (PRESENT(spin_embed_pot)) spin_embed_pot => qs_env%spin_embed_pot + + // Polarisability tensor + IF (PRESENT(polar_env)) polar_env => qs_env%polar_env + + // Resp charges + IF (PRESENT(rhs)) rhs => qs_env%rhs + + IF (PRESENT(local_rho_set)) & + local_rho_set => qs_env%local_rho_set + IF (PRESENT(rho_atom_set)) & + CALL get_local_rho(qs_env%local_rho_set, rho_atom_set=rho_atom_set) + IF (PRESENT(rho0_atom_set)) & + CALL get_local_rho(qs_env%local_rho_set, rho0_atom_set=rho0_atom_set) + IF (PRESENT(rho0_mpole)) & + CALL get_local_rho(qs_env%local_rho_set, rho0_mpole=rho0_mpole) + IF (PRESENT(rhoz_set)) & + CALL get_local_rho(qs_env%local_rho_set, rhoz_set=rhoz_set) + IF (PRESENT(ecoul_1c)) & + CALL get_hartree_local(qs_env%hartree_local, ecoul_1c=ecoul_1c) + IF (PRESENT(rho0_s_rs)) THEN + CALL get_local_rho(qs_env%local_rho_set, rho0_mpole=rho0_m) + IF (ASSOCIATED(rho0_m)) THEN + rho0_s_rs => rho0_m%rho0_s_rs + END IF + END IF + IF (PRESENT(rho0_s_gs)) THEN + CALL get_local_rho(qs_env%local_rho_set, rho0_mpole=rho0_m) + IF (ASSOCIATED(rho0_m)) THEN + rho0_s_gs => rho0_m%rho0_s_gs + END IF + END IF + + IF (PRESENT(xas_env)) xas_env => qs_env%xas_env + IF (PRESENT(input)) input => qs_env%input + IF (PRESENT(cp_ddapc_env)) cp_ddapc_env => qs_env%cp_ddapc_env + IF (PRESENT(cp_ddapc_ewald)) cp_ddapc_ewald => qs_env%cp_ddapc_ewald + IF (PRESENT(x_data)) x_data => qs_env%x_data + IF (PRESENT(et_coupling)) et_coupling => qs_env%et_coupling + IF (PRESENT(dftb_potential)) dftb_potential => qs_env%dftb_potential + IF (PRESENT(efield)) efield => qs_env%efield + IF (PRESENT(WannierCentres)) WannierCentres => qs_env%WannierCentres + + CALL get_ks_env(qs_env%ks_env, & + v_hartree_rspace=v_hartree_rspace, & + s_mstruct_changed=s_mstruct_changed, & + rho_changed=rho_changed, & + potential_changed=potential_changed, & + forces_up_to_date=forces_up_to_date, & + matrix_h=matrix_h, & + matrix_h_im=matrix_h_im, & + matrix_ks=matrix_ks, & + matrix_ks_im=matrix_ks_im, & + matrix_vxc=matrix_vxc, & + kinetic=kinetic, & + matrix_s=matrix_s, & + matrix_s_RI_aux=matrix_s_RI_aux, & + matrix_ks_im_kp=matrix_ks_im_kp, & + matrix_w=matrix_w, & + matrix_p_mp2=matrix_p_mp2, & + matrix_p_mp2_admm=matrix_p_mp2_admm, & + matrix_h_kp=matrix_h_kp, & + matrix_h_im_kp=matrix_h_im_kp, & + matrix_ks_kp=matrix_ks_kp, & + matrix_vxc_kp=matrix_vxc_kp, & + kinetic_kp=kinetic_kp, & + matrix_s_kp=matrix_s_kp, & + matrix_w_kp=matrix_w_kp, & + matrix_s_RI_aux_kp=matrix_s_RI_aux_kp, & + rho=rho, & + rho_xc=rho_xc, & + rho_core=rho_core, & + rho_nlcc=rho_nlcc, & + rho_nlcc_g=rho_nlcc_g, & + vppl=vppl, & + vee=vee, & + neighbor_list_id=neighbor_list_id, & + sab_orb=sab_orb, & + sab_all=sab_all, & + sab_scp=sab_scp, & + sab_vdw=sab_vdw, & + sac_ae=sac_ae, & + sac_ppl=sac_ppl, & + sac_lri=sac_lri, & + sap_ppnl=sap_ppnl, & + sap_oce=sap_oce, & + sab_se=sab_se, & + sab_lrc=sab_lrc, & + sab_tbe=sab_tbe, & + sab_xtbe=sab_xtbe, & + sab_core=sab_core, & + sab_xb=sab_xb, & + sab_xtb_nonbond=sab_xtb_nonbond, & + sab_almo=sab_almo, & + sab_kp=sab_kp, & + sab_kp_nosym=sab_kp_nosym, & + task_list=task_list, & + task_list_soft=task_list_soft, & + kpoints=kpoints, & + do_kpoints=do_kpoints, & + local_molecules=local_molecules, & + local_particles=local_particles, & + atprop=atprop, & + virial=virial, & + results=results, & + cell=cell, & + cell_ref=cell_ref, & + use_ref_cell=use_ref_cell, & + energy=energy, & + force=force, & + qs_kind_set=qs_kind_set, & + subsys=subsys, & + cp_subsys=cp_subsys, & + atomic_kind_set=atomic_kind_set, & + particle_set=particle_set, & + molecule_kind_set=molecule_kind_set, & + molecule_set=molecule_set, & + natom=natom, & + nkind=nkind, & + dft_control=dft_control, & + dbcsr_dist=dbcsr_dist, & + distribution_2d=distribution_2d, & + pw_env=pw_env, & + para_env=para_env, & + blacs_env=blacs_env, & + nelectron_total=nelectron_total, & + nelectron_spin=nelectron_spin) + + END SUBROUTINE get_qs_env + +/*************************************************************************************************** + \brief Initialise the QUICKSTEP environment. + \param qs_env ... + \param globenv ... + \date 25.01.2002 + \author MK + \version 1.0 +***************************************************************************************************/ +void init_qs_env(qs_env, globenv) + + TYPE(qs_environment_type), INTENT(INOUT) :: qs_env + TYPE(global_environment_type), OPTIONAL, POINTER :: globenv + + NULLIFY (qs_env%ls_scf_env) + NULLIFY (qs_env%almo_scf_env) + NULLIFY (qs_env%transport_env) + NULLIFY (qs_env%image_matrix) + NULLIFY (qs_env%ipiv) + NULLIFY (qs_env%image_coeff) + NULLIFY (qs_env%super_cell) + NULLIFY (qs_env%mos) + NULLIFY (qs_env%mos_last_converged) + NULLIFY (qs_env%mpools) + NULLIFY (qs_env%ewald_env) + NULLIFY (qs_env%ewald_pw) + NULLIFY (qs_env%scf_control) + NULLIFY (qs_env%rel_control) + NULLIFY (qs_env%qs_charges) + // ZMP initializing arrays + NULLIFY (qs_env%rho_external) + NULLIFY (qs_env%external_vxc) + NULLIFY (qs_env%mask) + // Embedding potential + NULLIFY (qs_env%embed_pot) + NULLIFY (qs_env%spin_embed_pot) + + // Polarisability tensor + NULLIFY (qs_env%polar_env) + + NULLIFY (qs_env%ks_env) + NULLIFY (qs_env%ks_qmmm_env) + NULLIFY (qs_env%wf_history) + NULLIFY (qs_env%scf_env) + NULLIFY (qs_env%oce) + NULLIFY (qs_env%local_rho_set) + NULLIFY (qs_env%hartree_local) + NULLIFY (qs_env%input) + NULLIFY (qs_env%linres_control) + NULLIFY (qs_env%xas_env) + NULLIFY (qs_env%cp_ddapc_env) + NULLIFY (qs_env%cp_ddapc_ewald) + NULLIFY (qs_env%outer_scf_history) + NULLIFY (qs_env%gradient_history) + NULLIFY (qs_env%variable_history) + NULLIFY (qs_env%x_data) + NULLIFY (qs_env%et_coupling) + NULLIFY (qs_env%dftb_potential) + NULLIFY (qs_env%active_space) + + NULLIFY (qs_env%se_taper) + NULLIFY (qs_env%se_store_int_env) + NULLIFY (qs_env%se_nddo_mpole) + NULLIFY (qs_env%se_nonbond_env) + NULLIFY (qs_env%admm_env) + NULLIFY (qs_env%efield) + NULLIFY (qs_env%lri_env) + NULLIFY (qs_env%ec_env) + NULLIFY (qs_env%exstate_env) + NULLIFY (qs_env%lri_density) + NULLIFY (qs_env%gcp_env) + NULLIFY (qs_env%rtp) + NULLIFY (qs_env%mp2_env) + NULLIFY (qs_env%bs_env) + NULLIFY (qs_env%kg_env) + NULLIFY (qs_env%ec_env) + NULLIFY (qs_env%WannierCentres) + + qs_env%outer_scf_ihistory = 0 + qs_env%broyden_adaptive_sigma = -1.0_dp + + CALL local_rho_set_create(qs_env%local_rho_set) + CALL hartree_local_create(qs_env%hartree_local) + qs_env%run_rtp = .FALSE. + qs_env%linres_run = .FALSE. + qs_env%single_point_run = .FALSE. + qs_env%qmmm = .FALSE. + qs_env%qmmm_periodic = .FALSE. + qs_env%requires_mo_derivs = .FALSE. + qs_env%requires_matrix_vxc = .FALSE. + qs_env%has_unit_metric = .FALSE. + qs_env%calc_image_preconditioner = .TRUE. + qs_env%do_transport = .FALSE. + qs_env%given_embed_pot = .FALSE. + IF (PRESENT(globenv)) THEN + qs_env%target_time = globenv%cp2k_target_time + qs_env%start_time = globenv%cp2k_start_time + qs_env%single_point_run = (globenv%run_type_id == energy_run .OR. & + globenv%run_type_id == energy_force_run) + ELSE + qs_env%target_time = 0.0_dp + qs_env%start_time = 0.0_dp + END IF + + qs_env%sim_time = 0._dp + qs_env%sim_step = 0 + + qs_env%total_zeff_corr = 0.0_dp + qs_env%surface_dipole_moment = 0.0_dp + qs_env%surface_dipole_switch_off = .FALSE. + + // Zero all variables containing results + NULLIFY (qs_env%mo_derivs) + NULLIFY (qs_env%mo_loc_history) + + IF (.NOT. ASSOCIATED(qs_env%molecular_scf_guess_env)) ALLOCATE +(qs_env%molecular_scf_guess_env) + + END SUBROUTINE init_qs_env + +/*************************************************************************************************** + \brief Set the QUICKSTEP environment. + \param qs_env ... + \param super_cell ... + \param mos ... + \param qmmm ... + \param qmmm_periodic ... + \param ewald_env ... + \param ewald_pw ... + \param mpools ... + \param rho_external ... + \param external_vxc ... + \param mask ... + \param scf_control ... + \param rel_control ... + \param qs_charges ... + \param ks_env ... + \param ks_qmmm_env ... + \param wf_history ... + \param scf_env ... + \param active_space ... + \param input ... + \param oce ... + \param rho_atom_set ... + \param rho0_atom_set ... + \param rho0_mpole ... + \param run_rtp ... + \param rtp ... + \param rhoz_set ... + \param rhoz_tot ... + \param ecoul_1c ... + \param has_unit_metric ... + \param requires_mo_derivs ... + \param mo_derivs ... + \param mo_loc_history ... + \param efield ... + \param linres_control ... + \param xas_env ... + \param cp_ddapc_env ... + \param cp_ddapc_ewald ... + \param outer_scf_history ... + \param outer_scf_ihistory ... + \param x_data ... + \param et_coupling ... + \param dftb_potential ... + \param se_taper ... + \param se_store_int_env ... + \param se_nddo_mpole ... + \param se_nonbond_env ... + \param admm_env ... + \param ls_scf_env ... + \param do_transport ... + \param transport_env ... + \param lri_env ... + \param lri_density ... + \param exstate_env ... + \param ec_env ... + \param dispersion_env ... + \param gcp_env ... + \param mp2_env ... + \param bs_env ... + \param kg_env ... + \param force ... + \param kpoints ... + \param WannierCentres ... + \param almo_scf_env ... + \param gradient_history ... + \param variable_history ... + \param embed_pot ... + \param spin_embed_pot ... + \param polar_env ... + \param mos_last_converged ... [SGh] + \param rhs ... + \date 23.01.2002 + \author MK + \version 1.0 +***************************************************************************************************/ +void set_qs_env(qs_env, super_cell, & + mos, qmmm, qmmm_periodic, & + ewald_env, ewald_pw, mpools, & + rho_external, external_vxc, mask, & + scf_control, rel_control, qs_charges, ks_env, & + ks_qmmm_env, wf_history, scf_env, active_space, & + input, oce, rho_atom_set, rho0_atom_set, rho0_mpole, run_rtp, rtp, & + rhoz_set, rhoz_tot, ecoul_1c, has_unit_metric, requires_mo_derivs, +mo_derivs, & + mo_loc_history, efield, & + linres_control, xas_env, cp_ddapc_env, cp_ddapc_ewald, & + outer_scf_history, outer_scf_ihistory, x_data, et_coupling, +dftb_potential, & + se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, +ls_scf_env, & + do_transport, transport_env, lri_env, lri_density, exstate_env, ec_env, +dispersion_env, & + gcp_env, mp2_env, bs_env, kg_env, force, & + kpoints, WannierCentres, almo_scf_env, gradient_history, +variable_history, embed_pot, & + spin_embed_pot, polar_env, mos_last_converged, rhs) + + TYPE(qs_environment_type), INTENT(INOUT) :: qs_env + TYPE(cell_type), OPTIONAL, POINTER :: super_cell + TYPE(mo_set_type), DIMENSION(:), OPTIONAL, POINTER :: mos + LOGICAL, OPTIONAL :: qmmm, qmmm_periodic + TYPE(ewald_environment_type), OPTIONAL, POINTER :: ewald_env + TYPE(ewald_pw_type), OPTIONAL, POINTER :: ewald_pw + TYPE(qs_matrix_pools_type), OPTIONAL, POINTER :: mpools + TYPE(qs_rho_type), OPTIONAL, POINTER :: rho_external + TYPE(pw_type), OPTIONAL, POINTER :: external_vxc, mask + TYPE(scf_control_type), OPTIONAL, POINTER :: scf_control + TYPE(rel_control_type), OPTIONAL, POINTER :: rel_control + TYPE(qs_charges_type), OPTIONAL, POINTER :: qs_charges + TYPE(qs_ks_env_type), OPTIONAL, POINTER :: ks_env + TYPE(qs_ks_qmmm_env_type), OPTIONAL, POINTER :: ks_qmmm_env + TYPE(qs_wf_history_type), OPTIONAL, POINTER :: wf_history + TYPE(qs_scf_env_type), OPTIONAL, POINTER :: scf_env + TYPE(active_space_type), OPTIONAL, POINTER :: active_space + TYPE(section_vals_type), OPTIONAL, POINTER :: input + TYPE(oce_matrix_type), OPTIONAL, POINTER :: oce + TYPE(rho_atom_type), DIMENSION(:), OPTIONAL, & + POINTER :: rho_atom_set + TYPE(rho0_atom_type), DIMENSION(:), OPTIONAL, & + POINTER :: rho0_atom_set + TYPE(rho0_mpole_type), OPTIONAL, POINTER :: rho0_mpole + LOGICAL, OPTIONAL :: run_rtp + TYPE(rt_prop_type), OPTIONAL, POINTER :: rtp + TYPE(rhoz_type), DIMENSION(:), OPTIONAL, POINTER :: rhoz_set + REAL(dp), OPTIONAL :: rhoz_tot + TYPE(ecoul_1center_type), DIMENSION(:), OPTIONAL, & + POINTER :: ecoul_1c + LOGICAL, OPTIONAL :: has_unit_metric, requires_mo_derivs + TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, & + POINTER :: mo_derivs + TYPE(cp_fm_type), DIMENSION(:), OPTIONAL, POINTER :: mo_loc_history + TYPE(efield_berry_type), OPTIONAL, POINTER :: efield + TYPE(linres_control_type), OPTIONAL, POINTER :: linres_control + TYPE(xas_environment_type), OPTIONAL, POINTER :: xas_env + TYPE(cp_ddapc_type), OPTIONAL, POINTER :: cp_ddapc_env + TYPE(cp_ddapc_ewald_type), OPTIONAL, POINTER :: cp_ddapc_ewald + REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: outer_scf_history + INTEGER, INTENT(IN), OPTIONAL :: outer_scf_ihistory + TYPE(hfx_type), DIMENSION(:, :), OPTIONAL, POINTER :: x_data + TYPE(et_coupling_type), OPTIONAL, POINTER :: et_coupling + TYPE(qs_dftb_pairpot_type), DIMENSION(:, :), & + OPTIONAL, POINTER :: dftb_potential + TYPE(se_taper_type), OPTIONAL, POINTER :: se_taper + TYPE(semi_empirical_si_type), OPTIONAL, POINTER :: se_store_int_env + TYPE(nddo_mpole_type), OPTIONAL, POINTER :: se_nddo_mpole + TYPE(fist_nonbond_env_type), OPTIONAL, POINTER :: se_nonbond_env + TYPE(admm_type), OPTIONAL, POINTER :: admm_env + TYPE(ls_scf_env_type), OPTIONAL, POINTER :: ls_scf_env + LOGICAL, OPTIONAL :: do_transport + TYPE(transport_env_type), OPTIONAL, POINTER :: transport_env + TYPE(lri_environment_type), OPTIONAL, POINTER :: lri_env + TYPE(lri_density_type), OPTIONAL, POINTER :: lri_density + TYPE(excited_energy_type), OPTIONAL, POINTER :: exstate_env + TYPE(energy_correction_type), OPTIONAL, POINTER :: ec_env + TYPE(qs_dispersion_type), OPTIONAL, POINTER :: dispersion_env + TYPE(qs_gcp_type), OPTIONAL, POINTER :: gcp_env + TYPE(mp2_type), OPTIONAL, POINTER :: mp2_env + TYPE(post_scf_bandstructure_type), OPTIONAL, & + POINTER :: bs_env + TYPE(kg_environment_type), OPTIONAL, POINTER :: kg_env + TYPE(qs_force_type), DIMENSION(:), OPTIONAL, & + POINTER :: force + TYPE(kpoint_type), OPTIONAL, POINTER :: kpoints + TYPE(wannier_centres_type), DIMENSION(:), & + OPTIONAL, POINTER :: WannierCentres + TYPE(almo_scf_env_type), OPTIONAL, POINTER :: almo_scf_env + REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: gradient_history, variable_history + TYPE(pw_type), OPTIONAL, POINTER :: embed_pot, spin_embed_pot + TYPE(polar_env_type), OPTIONAL, POINTER :: polar_env + TYPE(mo_set_type), DIMENSION(:), OPTIONAL, POINTER :: mos_last_converged + REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: rhs + + TYPE(qs_subsys_type), POINTER :: subsys + + IF (PRESENT(mp2_env)) qs_env%mp2_env => mp2_env + IF (PRESENT(bs_env)) qs_env%bs_env => bs_env + IF (PRESENT(kg_env)) qs_env%kg_env => kg_env + IF (PRESENT(super_cell)) THEN + CALL cell_retain(super_cell) + CALL cell_release(qs_env%super_cell) + qs_env%super_cell => super_cell + END IF + ! + IF (PRESENT(qmmm)) qs_env%qmmm = qmmm + IF (PRESENT(qmmm_periodic)) qs_env%qmmm_periodic = qmmm_periodic + IF (PRESENT(mos)) qs_env%mos => mos + IF (PRESENT(mos_last_converged)) qs_env%mos_last_converged => mos_last_converged + IF (PRESENT(ls_scf_env)) qs_env%ls_scf_env => ls_scf_env + IF (PRESENT(almo_scf_env)) qs_env%almo_scf_env => almo_scf_env + IF (PRESENT(do_transport)) qs_env%do_transport = do_transport + IF (PRESENT(transport_env)) qs_env%transport_env => transport_env + // if intels checking (-C) complains here, you have rediscovered a bug in the intel + // compiler (present in at least 10.0.025). A testcase has been submitted to intel. + IF (PRESENT(oce)) qs_env%oce => oce + IF (PRESENT(outer_scf_history)) qs_env%outer_scf_history => outer_scf_history + IF (PRESENT(gradient_history)) qs_env%gradient_history => gradient_history + IF (PRESENT(variable_history)) qs_env%variable_history => variable_history + IF (PRESENT(outer_scf_ihistory)) qs_env%outer_scf_ihistory = outer_scf_ihistory + IF (PRESENT(requires_mo_derivs)) qs_env%requires_mo_derivs = requires_mo_derivs + IF (PRESENT(has_unit_metric)) qs_env%has_unit_metric = has_unit_metric + IF (PRESENT(mo_derivs)) qs_env%mo_derivs => mo_derivs + IF (PRESENT(mo_loc_history)) qs_env%mo_loc_history => mo_loc_history + IF (PRESENT(run_rtp)) qs_env%run_rtp = run_rtp + IF (PRESENT(rtp)) qs_env%rtp => rtp + IF (PRESENT(efield)) qs_env%efield => efield + IF (PRESENT(active_space)) qs_env%active_space => active_space + + IF (PRESENT(ewald_env)) THEN // accept also null pointers? + IF (ASSOCIATED(qs_env%ewald_env)) THEN + IF (.NOT. ASSOCIATED(qs_env%ewald_env, ewald_env)) THEN + CALL ewald_env_release(qs_env%ewald_env) + DEALLOCATE (qs_env%ewald_env) + END IF + END IF + qs_env%ewald_env => ewald_env + END IF + IF (PRESENT(ewald_pw)) THEN // accept also null pointers? + IF (ASSOCIATED(qs_env%ewald_pw)) THEN + IF (.NOT. ASSOCIATED(ewald_pw, qs_env%ewald_pw)) THEN + CALL ewald_pw_release(qs_env%ewald_pw) + DEALLOCATE (qs_env%ewald_pw) + END IF + END IF + qs_env%ewald_pw => ewald_pw + END IF + IF (PRESENT(scf_control)) THEN // accept also null pointers? + IF (ASSOCIATED(qs_env%scf_control)) THEN + IF (.NOT. ASSOCIATED(qs_env%scf_control, scf_control)) THEN + CALL scf_c_release(qs_env%scf_control) + DEALLOCATE (qs_env%scf_control) + END IF + END IF + qs_env%scf_control => scf_control + END IF + IF (PRESENT(rel_control)) THEN // accept also null pointers? + IF (ASSOCIATED(qs_env%rel_control)) THEN + IF (.NOT. ASSOCIATED(qs_env%rel_control, rel_control)) THEN + CALL rel_c_release(qs_env%rel_control) + DEALLOCATE (qs_env%rel_control) + END IF + END IF + qs_env%rel_control => rel_control + END IF + IF (PRESENT(linres_control)) THEN // accept also null pointers? + IF (ASSOCIATED(qs_env%linres_control)) THEN + IF (.NOT. ASSOCIATED(qs_env%linres_control, linres_control)) THEN + CALL linres_control_release(qs_env%linres_control) + DEALLOCATE (qs_env%linres_control) + END IF + END IF + qs_env%linres_control => linres_control + END IF + // ZMP associating variables + IF (PRESENT(rho_external)) THEN + IF (ASSOCIATED(qs_env%rho_external)) THEN + IF (.NOT. ASSOCIATED(qs_env%rho_external, rho_external)) THEN + CALL qs_rho_release(qs_env%rho_external) + DEALLOCATE (qs_env%rho_external) + END IF + END IF + qs_env%rho_external => rho_external + END IF + IF (PRESENT(external_vxc)) qs_env%external_vxc => external_vxc + IF (PRESENT(mask)) qs_env%mask => mask + // Embedding potential + IF (PRESENT(embed_pot)) qs_env%embed_pot => embed_pot + IF (PRESENT(spin_embed_pot)) qs_env%spin_embed_pot => spin_embed_pot + + // Polarisability tensor + IF (PRESENT(polar_env)) qs_env%polar_env => polar_env + + IF (PRESENT(qs_charges)) THEN + IF (ASSOCIATED(qs_env%qs_charges)) THEN + IF (.NOT. ASSOCIATED(qs_env%qs_charges, qs_charges)) THEN + CALL qs_charges_release(qs_env%qs_charges) + DEALLOCATE (qs_env%qs_charges) + END IF + END IF + qs_env%qs_charges => qs_charges + END IF + IF (PRESENT(ks_qmmm_env)) THEN + IF (ASSOCIATED(qs_env%ks_qmmm_env)) THEN + IF (.NOT. ASSOCIATED(qs_env%ks_qmmm_env, ks_qmmm_env)) THEN + CALL qs_ks_qmmm_release(qs_env%ks_qmmm_env) + DEALLOCATE (qs_env%ks_qmmm_env) + END IF + END IF + qs_env%ks_qmmm_env => ks_qmmm_env + END IF + IF (PRESENT(ks_env)) THEN // accept also null pointers? + IF (ASSOCIATED(qs_env%ks_env)) THEN + IF (.NOT. ASSOCIATED(qs_env%ks_env, ks_env)) THEN + CALL qs_ks_release(qs_env%ks_env) + DEALLOCATE (qs_env%ks_env) + END IF + END IF + qs_env%ks_env => ks_env + END IF + IF (PRESENT(wf_history)) THEN // accept also null pointers ? + CALL wfi_retain(wf_history) + CALL wfi_release(qs_env%wf_history) + qs_env%wf_history => wf_history + END IF + IF (PRESENT(scf_env)) THEN // accept also null pointers ? + IF (ASSOCIATED(qs_env%scf_env)) THEN + IF (.NOT. ASSOCIATED(qs_env%scf_env, scf_env)) THEN + CALL scf_env_release(qs_env%scf_env) + DEALLOCATE (qs_env%scf_env) + END IF + END IF + qs_env%scf_env => scf_env + END IF + IF (PRESENT(xas_env)) THEN // accept also null pointers? + IF (ASSOCIATED(qs_env%xas_env)) THEN + IF (.NOT. ASSOCIATED(qs_env%xas_env, xas_env)) THEN + CALL xas_env_release(qs_env%xas_env) + DEALLOCATE (qs_env%xas_env) + END IF + END IF + qs_env%xas_env => xas_env + END IF + IF (PRESENT(mpools)) THEN + CALL mpools_retain(mpools) + CALL mpools_release(qs_env%mpools) + qs_env%mpools => mpools + END IF + IF (PRESENT(rho_atom_set)) THEN + CALL set_local_rho(qs_env%local_rho_set, rho_atom_set=rho_atom_set) + END IF + IF (PRESENT(rho0_atom_set)) THEN + CALL set_local_rho(qs_env%local_rho_set, rho0_atom_set=rho0_atom_set) + END IF + IF (PRESENT(rho0_mpole)) THEN + CALL set_local_rho(qs_env%local_rho_set, rho0_mpole=rho0_mpole) + END IF + IF (PRESENT(rhoz_set)) THEN + CALL set_local_rho(qs_env%local_rho_set, rhoz_set=rhoz_set) + END IF + IF (PRESENT(rhoz_tot)) qs_env%local_rho_set%rhoz_tot = rhoz_tot + IF (PRESENT(ecoul_1c)) THEN + CALL set_hartree_local(qs_env%hartree_local, ecoul_1c=ecoul_1c) + END IF + IF (PRESENT(input)) THEN + CALL section_vals_retain(input) + CALL section_vals_release(qs_env%input) + qs_env%input => input + END IF + IF (PRESENT(cp_ddapc_env)) THEN + IF (ASSOCIATED(qs_env%cp_ddapc_env)) THEN + IF (.NOT. ASSOCIATED(qs_env%cp_ddapc_env, cp_ddapc_env)) THEN + CALL cp_ddapc_release(qs_env%cp_ddapc_env) + DEALLOCATE (qs_env%cp_ddapc_env) + END IF + END IF + qs_env%cp_ddapc_env => cp_ddapc_env + END IF + IF (PRESENT(cp_ddapc_ewald)) THEN + qs_env%cp_ddapc_ewald => cp_ddapc_ewald + END IF + IF (PRESENT(x_data)) qs_env%x_data => x_data + IF (PRESENT(et_coupling)) qs_env%et_coupling => et_coupling + IF (PRESENT(dftb_potential)) qs_env%dftb_potential => dftb_potential + IF (PRESENT(se_taper)) THEN + CALL se_taper_release(qs_env%se_taper) + qs_env%se_taper => se_taper + END IF + IF (PRESENT(se_store_int_env)) THEN + CALL semi_empirical_si_release(qs_env%se_store_int_env) + qs_env%se_store_int_env => se_store_int_env + END IF + IF (PRESENT(se_nddo_mpole)) THEN + CALL nddo_mpole_release(qs_env%se_nddo_mpole) + qs_env%se_nddo_mpole => se_nddo_mpole + END IF + IF (PRESENT(se_nonbond_env)) THEN + IF (ASSOCIATED(qs_env%se_nonbond_env)) THEN + IF (.NOT. ASSOCIATED(qs_env%se_nonbond_env, se_nonbond_env)) THEN + CALL fist_nonbond_env_release(qs_env%se_nonbond_env) + DEALLOCATE (qs_env%se_nonbond_env) + END IF + END IF + qs_env%se_nonbond_env => se_nonbond_env + END IF + IF (PRESENT(admm_env)) qs_env%admm_env => admm_env + IF (PRESENT(lri_env)) qs_env%lri_env => lri_env + IF (PRESENT(lri_density)) qs_env%lri_density => lri_density + IF (PRESENT(ec_env)) qs_env%ec_env => ec_env + IF (PRESENT(exstate_env)) qs_env%exstate_env => exstate_env + IF (PRESENT(dispersion_env)) qs_env%dispersion_env => dispersion_env + IF (PRESENT(gcp_env)) qs_env%gcp_env => gcp_env + IF (PRESENT(WannierCentres)) qs_env%WannierCentres => WannierCentres + IF (PRESENT(kpoints)) CALL set_ks_env(qs_env%ks_env, kpoints=kpoints) + + // Resp charges + IF (PRESENT(rhs)) qs_env%rhs => rhs + + IF (PRESENT(force)) THEN + CALL get_qs_env(qs_env, subsys=subsys) + CALL qs_subsys_set(subsys, force=force) + END IF + + END SUBROUTINE set_qs_env + +/*************************************************************************************************** + \brief allocates and intitializes a qs_env + \param qs_env the object to create + \param globenv ... + \par History + 12.2002 created [fawzi] + \author Fawzi Mohamed +***************************************************************************************************/ +void qs_env_create(qs_env, globenv) + TYPE(qs_environment_type), INTENT(OUT) :: qs_env + TYPE(global_environment_type), OPTIONAL, POINTER :: globenv + + CALL init_qs_env(qs_env, globenv=globenv) + END SUBROUTINE qs_env_create + +/*************************************************************************************************** + \brief releases the given qs_env (see doc/ReferenceCounting.html) + \param qs_env the object to release + \par History + 12.2002 created [fawzi] + 06.2018 polar_env added (MK) + \author Fawzi Mohamed +***************************************************************************************************/ +void qs_env_release(qs_env) + TYPE(qs_environment_type), INTENT(INOUT) :: qs_env + + INTEGER :: i + + CALL cell_release(qs_env%super_cell) + IF (ASSOCIATED(qs_env%mos)) THEN + DO i = 1, SIZE(qs_env%mos) + CALL deallocate_mo_set(qs_env%mos(i)) + END DO + DEALLOCATE (qs_env%mos) + END IF + IF (ASSOCIATED(qs_env%mos_last_converged)) THEN + DO i = 1, SIZE(qs_env%mos_last_converged) + CALL deallocate_mo_set(qs_env%mos_last_converged(i)) + END DO + DEALLOCATE (qs_env%mos_last_converged) + END IF + + IF (ASSOCIATED(qs_env%mo_derivs)) THEN + DO I = 1, SIZE(qs_env%mo_derivs) + CALL dbcsr_release_p(qs_env%mo_derivs(I)%matrix) + END DO + DEALLOCATE (qs_env%mo_derivs) + END IF + + CALL cp_fm_release(qs_env%mo_loc_history) + + IF (ASSOCIATED(qs_env%rtp)) THEN + CALL rt_prop_release(qs_env%rtp) + DEALLOCATE (qs_env%rtp) + END IF + IF (ASSOCIATED(qs_env%outer_scf_history)) THEN + DEALLOCATE (qs_env%outer_scf_history) + qs_env%outer_scf_ihistory = 0 + END IF + IF (ASSOCIATED(qs_env%gradient_history)) & + DEALLOCATE (qs_env%gradient_history) + IF (ASSOCIATED(qs_env%variable_history)) & + DEALLOCATE (qs_env%variable_history) + IF (ASSOCIATED(qs_env%oce)) CALL deallocate_oce_set(qs_env%oce) + IF (ASSOCIATED(qs_env%local_rho_set)) THEN + CALL local_rho_set_release(qs_env%local_rho_set) + END IF + IF (ASSOCIATED(qs_env%hartree_local)) THEN + CALL hartree_local_release(qs_env%hartree_local) + END IF + IF (ASSOCIATED(qs_env%scf_control)) THEN + CALL scf_c_release(qs_env%scf_control) + DEALLOCATE (qs_env%scf_control) + END IF + IF (ASSOCIATED(qs_env%rel_control)) THEN + CALL rel_c_release(qs_env%rel_control) + DEALLOCATE (qs_env%rel_control) + END IF + + IF (ASSOCIATED(qs_env%linres_control)) THEN + CALL linres_control_release(qs_env%linres_control) + DEALLOCATE (qs_env%linres_control) + END IF + + IF (ASSOCIATED(qs_env%almo_scf_env)) THEN + CALL almo_scf_env_release(qs_env%almo_scf_env) + END IF + + IF (ASSOCIATED(qs_env%ls_scf_env)) THEN + CALL ls_scf_release(qs_env%ls_scf_env) + END IF + IF (ASSOCIATED(qs_env%molecular_scf_guess_env)) THEN + CALL molecular_scf_guess_env_destroy(qs_env%molecular_scf_guess_env) + DEALLOCATE (qs_env%molecular_scf_guess_env) + END IF + + IF (ASSOCIATED(qs_env%transport_env)) THEN + CALL transport_env_release(qs_env%transport_env) + END IF + + !Only if do_xas_calculation + IF (ASSOCIATED(qs_env%xas_env)) THEN + CALL xas_env_release(qs_env%xas_env) + DEALLOCATE (qs_env%xas_env) + END IF + IF (ASSOCIATED(qs_env%ewald_env)) THEN + CALL ewald_env_release(qs_env%ewald_env) + DEALLOCATE (qs_env%ewald_env) + END IF + IF (ASSOCIATED(qs_env%ewald_pw)) THEN + CALL ewald_pw_release(qs_env%ewald_pw) + DEALLOCATE (qs_env%ewald_pw) + END IF + IF (ASSOCIATED(qs_env%image_matrix)) THEN + DEALLOCATE (qs_env%image_matrix) + END IF + IF (ASSOCIATED(qs_env%ipiv)) THEN + DEALLOCATE (qs_env%ipiv) + END IF + IF (ASSOCIATED(qs_env%image_coeff)) THEN + DEALLOCATE (qs_env%image_coeff) + END IF + // ZMP + IF (ASSOCIATED(qs_env%rho_external)) THEN + CALL qs_rho_release(qs_env%rho_external) + DEALLOCATE (qs_env%rho_external) + END IF + IF (ASSOCIATED(qs_env%external_vxc)) THEN + CALL qs_env%external_vxc%release() + DEALLOCATE (qs_env%external_vxc) + END IF + IF (ASSOCIATED(qs_env%mask)) THEN + CALL qs_env%mask%release() + DEALLOCATE (qs_env%mask) + END IF + IF (ASSOCIATED(qs_env%active_space)) THEN + CALL release_active_space_type(qs_env%active_space) + END IF + // Embedding potentials if provided as input + IF (qs_env%given_embed_pot) THEN + CALL qs_env%embed_pot%release() + DEALLOCATE (qs_env%embed_pot) + IF (ASSOCIATED(qs_env%spin_embed_pot)) THEN + CALL qs_env%spin_embed_pot%release() + DEALLOCATE (qs_env%spin_embed_pot) + END IF + END IF + + // Polarisability tensor + CALL polar_env_release(qs_env%polar_env) + + IF (ASSOCIATED(qs_env%qs_charges)) THEN + CALL qs_charges_release(qs_env%qs_charges) + DEALLOCATE (qs_env%qs_charges) + END IF + IF (ASSOCIATED(qs_env%ks_env)) THEN + CALL qs_ks_release(qs_env%ks_env) + DEALLOCATE (qs_env%ks_env) + END IF + IF (ASSOCIATED(qs_env%ks_qmmm_env)) THEN + CALL qs_ks_qmmm_release(qs_env%ks_qmmm_env) + DEALLOCATE (qs_env%ks_qmmm_env) + END IF + CALL wfi_release(qs_env%wf_history) + IF (ASSOCIATED(qs_env%scf_env)) THEN + CALL scf_env_release(qs_env%scf_env) + DEALLOCATE (qs_env%scf_env) + END IF + CALL mpools_release(qs_env%mpools) + CALL section_vals_release(qs_env%input) + IF (ASSOCIATED(qs_env%cp_ddapc_env)) THEN + CALL cp_ddapc_release(qs_env%cp_ddapc_env) + DEALLOCATE (qs_env%cp_ddapc_env) + END IF + CALL cp_ddapc_ewald_release(qs_env%cp_ddapc_ewald) + CALL efield_berry_release(qs_env%efield) + IF (ASSOCIATED(qs_env%x_data)) THEN + CALL hfx_release(qs_env%x_data) + END IF + IF (ASSOCIATED(qs_env%et_coupling)) THEN + CALL et_coupling_release(qs_env%et_coupling) + END IF + IF (ASSOCIATED(qs_env%dftb_potential)) THEN + CALL qs_dftb_pairpot_release(qs_env%dftb_potential) + END IF + IF (ASSOCIATED(qs_env%se_taper)) THEN + CALL se_taper_release(qs_env%se_taper) + END IF + IF (ASSOCIATED(qs_env%se_store_int_env)) THEN + CALL semi_empirical_si_release(qs_env%se_store_int_env) + END IF + IF (ASSOCIATED(qs_env%se_nddo_mpole)) THEN + CALL nddo_mpole_release(qs_env%se_nddo_mpole) + END IF + IF (ASSOCIATED(qs_env%se_nonbond_env)) THEN + CALL fist_nonbond_env_release(qs_env%se_nonbond_env) + DEALLOCATE (qs_env%se_nonbond_env) + END IF + IF (ASSOCIATED(qs_env%admm_env)) THEN + CALL admm_env_release(qs_env%admm_env) + END IF + IF (ASSOCIATED(qs_env%lri_env)) THEN + CALL lri_env_release(qs_env%lri_env) + DEALLOCATE (qs_env%lri_env) + END IF + IF (ASSOCIATED(qs_env%lri_density)) THEN + CALL lri_density_release(qs_env%lri_density) + DEALLOCATE (qs_env%lri_density) + END IF + IF (ASSOCIATED(qs_env%ec_env)) THEN + CALL ec_env_release(qs_env%ec_env) + END IF + IF (ASSOCIATED(qs_env%exstate_env)) THEN + CALL exstate_release(qs_env%exstate_env) + END IF + IF (ASSOCIATED(qs_env%mp2_env)) THEN + CALL mp2_env_release(qs_env%mp2_env) + DEALLOCATE (qs_env%mp2_env) + NULLIFY (qs_env%mp2_env) + END IF + IF (ASSOCIATED(qs_env%bs_env)) THEN + CALL bs_env_release(qs_env%bs_env) + END IF + IF (ASSOCIATED(qs_env%kg_env)) THEN + CALL kg_env_release(qs_env%kg_env) + END IF + + // dispersion + CALL qs_dispersion_release(qs_env%dispersion_env) + // gCP + IF (ASSOCIATED(qs_env%gcp_env)) THEN + CALL qs_gcp_release(qs_env%gcp_env) + END IF + + IF (ASSOCIATED(qs_env%WannierCentres)) THEN + DO i = 1, SIZE(qs_env%WannierCentres) + DEALLOCATE (qs_env%WannierCentres(i)%WannierHamDiag) + DEALLOCATE (qs_env%WannierCentres(i)%centres) + END DO + DEALLOCATE (qs_env%WannierCentres) + END IF + // Resp charges + IF (ASSOCIATED(qs_env%rhs)) DEALLOCATE (qs_env%rhs) + + END SUBROUTINE qs_env_release + +/*************************************************************************************************** + \brief releases part of the given qs_env in order to save memory + \param qs_env the object to release + \par History + 04.2022 created [JGH] +***************************************************************************************************/ +void qs_env_part_release(qs_env) + TYPE(qs_environment_type), INTENT(INOUT) :: qs_env + + INTEGER :: i + + IF (ASSOCIATED(qs_env%mos_last_converged)) THEN + DO i = 1, SIZE(qs_env%mos_last_converged) + CALL deallocate_mo_set(qs_env%mos_last_converged(i)) + END DO + DEALLOCATE (qs_env%mos_last_converged) + END IF + + IF (ASSOCIATED(qs_env%mo_derivs)) THEN + DO I = 1, SIZE(qs_env%mo_derivs) + CALL dbcsr_release_p(qs_env%mo_derivs(I)%matrix) + END DO + DEALLOCATE (qs_env%mo_derivs) + END IF + + CALL cp_fm_release(qs_env%mo_loc_history) + + IF (ASSOCIATED(qs_env%rtp)) THEN + CALL rt_prop_release(qs_env%rtp) + DEALLOCATE (qs_env%rtp) + END IF + IF (ASSOCIATED(qs_env%outer_scf_history)) THEN + DEALLOCATE (qs_env%outer_scf_history) + qs_env%outer_scf_ihistory = 0 + END IF + IF (ASSOCIATED(qs_env%gradient_history)) & + DEALLOCATE (qs_env%gradient_history) + IF (ASSOCIATED(qs_env%variable_history)) & + DEALLOCATE (qs_env%variable_history) + IF (ASSOCIATED(qs_env%oce)) CALL deallocate_oce_set(qs_env%oce) + IF (ASSOCIATED(qs_env%local_rho_set)) THEN + CALL local_rho_set_release(qs_env%local_rho_set) + END IF + IF (ASSOCIATED(qs_env%hartree_local)) THEN + CALL hartree_local_release(qs_env%hartree_local) + END IF + IF (ASSOCIATED(qs_env%scf_control)) THEN + CALL scf_c_release(qs_env%scf_control) + DEALLOCATE (qs_env%scf_control) + END IF + IF (ASSOCIATED(qs_env%rel_control)) THEN + CALL rel_c_release(qs_env%rel_control) + DEALLOCATE (qs_env%rel_control) + END IF + + IF (ASSOCIATED(qs_env%linres_control)) THEN + CALL linres_control_release(qs_env%linres_control) + DEALLOCATE (qs_env%linres_control) + END IF + + IF (ASSOCIATED(qs_env%almo_scf_env)) THEN + CALL almo_scf_env_release(qs_env%almo_scf_env) + END IF + + IF (ASSOCIATED(qs_env%ls_scf_env)) THEN + CALL ls_scf_release(qs_env%ls_scf_env) + END IF + IF (ASSOCIATED(qs_env%molecular_scf_guess_env)) THEN + CALL molecular_scf_guess_env_destroy(qs_env%molecular_scf_guess_env) + DEALLOCATE (qs_env%molecular_scf_guess_env) + END IF + + IF (ASSOCIATED(qs_env%transport_env)) THEN + CALL transport_env_release(qs_env%transport_env) + END IF + + !Only if do_xas_calculation + IF (ASSOCIATED(qs_env%xas_env)) THEN + CALL xas_env_release(qs_env%xas_env) + DEALLOCATE (qs_env%xas_env) + END IF + IF (ASSOCIATED(qs_env%ewald_env)) THEN + CALL ewald_env_release(qs_env%ewald_env) + DEALLOCATE (qs_env%ewald_env) + END IF + IF (ASSOCIATED(qs_env%ewald_pw)) THEN + CALL ewald_pw_release(qs_env%ewald_pw) + DEALLOCATE (qs_env%ewald_pw) + END IF + IF (ASSOCIATED(qs_env%image_matrix)) THEN + DEALLOCATE (qs_env%image_matrix) + END IF + IF (ASSOCIATED(qs_env%ipiv)) THEN + DEALLOCATE (qs_env%ipiv) + END IF + IF (ASSOCIATED(qs_env%image_coeff)) THEN + DEALLOCATE (qs_env%image_coeff) + END IF + // ZMP + IF (ASSOCIATED(qs_env%rho_external)) THEN + CALL qs_rho_release(qs_env%rho_external) + DEALLOCATE (qs_env%rho_external) + END IF + IF (ASSOCIATED(qs_env%external_vxc)) THEN + CALL qs_env%external_vxc%release() + DEALLOCATE (qs_env%external_vxc) + END IF + IF (ASSOCIATED(qs_env%mask)) THEN + CALL qs_env%mask%release() + DEALLOCATE (qs_env%mask) + END IF + IF (ASSOCIATED(qs_env%active_space)) THEN + CALL release_active_space_type(qs_env%active_space) + END IF + // Embedding potentials if provided as input + IF (qs_env%given_embed_pot) THEN + CALL qs_env%embed_pot%release() + DEALLOCATE (qs_env%embed_pot) + IF (ASSOCIATED(qs_env%spin_embed_pot)) THEN + CALL qs_env%spin_embed_pot%release() + DEALLOCATE (qs_env%spin_embed_pot) + END IF + END IF + + // Polarisability tensor + CALL polar_env_release(qs_env%polar_env) + + IF (ASSOCIATED(qs_env%qs_charges)) THEN + CALL qs_charges_release(qs_env%qs_charges) + DEALLOCATE (qs_env%qs_charges) + END IF + CALL qs_ks_part_release(qs_env%ks_env) + IF (ASSOCIATED(qs_env%ks_qmmm_env)) THEN + CALL qs_ks_qmmm_release(qs_env%ks_qmmm_env) + DEALLOCATE (qs_env%ks_qmmm_env) + END IF + CALL wfi_release(qs_env%wf_history) + IF (ASSOCIATED(qs_env%scf_env)) THEN + CALL scf_env_release(qs_env%scf_env) + DEALLOCATE (qs_env%scf_env) + END IF + IF (ASSOCIATED(qs_env%cp_ddapc_env)) THEN + CALL cp_ddapc_release(qs_env%cp_ddapc_env) + DEALLOCATE (qs_env%cp_ddapc_env) + END IF + CALL cp_ddapc_ewald_release(qs_env%cp_ddapc_ewald) + CALL efield_berry_release(qs_env%efield) + IF (ASSOCIATED(qs_env%x_data)) THEN + CALL hfx_release(qs_env%x_data) + END IF + IF (ASSOCIATED(qs_env%et_coupling)) THEN + CALL et_coupling_release(qs_env%et_coupling) + END IF + IF (ASSOCIATED(qs_env%dftb_potential)) THEN + CALL qs_dftb_pairpot_release(qs_env%dftb_potential) + END IF + IF (ASSOCIATED(qs_env%se_taper)) THEN + CALL se_taper_release(qs_env%se_taper) + END IF + IF (ASSOCIATED(qs_env%se_store_int_env)) THEN + CALL semi_empirical_si_release(qs_env%se_store_int_env) + END IF + IF (ASSOCIATED(qs_env%se_nddo_mpole)) THEN + CALL nddo_mpole_release(qs_env%se_nddo_mpole) + END IF + IF (ASSOCIATED(qs_env%se_nonbond_env)) THEN + CALL fist_nonbond_env_release(qs_env%se_nonbond_env) + DEALLOCATE (qs_env%se_nonbond_env) + END IF + IF (ASSOCIATED(qs_env%admm_env)) THEN + CALL admm_env_release(qs_env%admm_env) + END IF + IF (ASSOCIATED(qs_env%lri_env)) THEN + CALL lri_env_release(qs_env%lri_env) + DEALLOCATE (qs_env%lri_env) + END IF + IF (ASSOCIATED(qs_env%lri_density)) THEN + CALL lri_density_release(qs_env%lri_density) + DEALLOCATE (qs_env%lri_density) + END IF + IF (ASSOCIATED(qs_env%ec_env)) THEN + CALL ec_env_release(qs_env%ec_env) + END IF + IF (ASSOCIATED(qs_env%exstate_env)) THEN + CALL exstate_release(qs_env%exstate_env) + END IF + IF (ASSOCIATED(qs_env%mp2_env)) THEN + CALL mp2_env_release(qs_env%mp2_env) + DEALLOCATE (qs_env%mp2_env) + NULLIFY (qs_env%mp2_env) + END IF + IF (ASSOCIATED(qs_env%kg_env)) THEN + CALL kg_env_release(qs_env%kg_env) + END IF + + // dispersion + CALL qs_dispersion_release(qs_env%dispersion_env) + // gCP + IF (ASSOCIATED(qs_env%gcp_env)) THEN + CALL qs_gcp_release(qs_env%gcp_env) + END IF + + IF (ASSOCIATED(qs_env%WannierCentres)) THEN + DO i = 1, SIZE(qs_env%WannierCentres) + DEALLOCATE (qs_env%WannierCentres(i)%WannierHamDiag) + DEALLOCATE (qs_env%WannierCentres(i)%centres) + END DO + DEALLOCATE (qs_env%WannierCentres) + END IF + // Resp charges + IF (ASSOCIATED(qs_env%rhs)) DEALLOCATE (qs_env%rhs) + + END SUBROUTINE qs_env_part_release