Prevent case that ortho is not associated

cp2k · Oct 7, 2022 · f51da1b · f51da1b
1 parent 6df1cbb
commit f51da1b
Show file tree

Hide file tree

Showing 2 changed files with 26 additions and 5 deletions.
diff --git a/src/qs_initial_guess.F b/src/qs_initial_guess.F
@@ -147,10 +147,8 @@ SUBROUTINE calculate_first_density_matrix(scf_env, qs_env)
       INTEGER, DIMENSION(2)                              :: nelectron_spin
       INTEGER, DIMENSION(:), POINTER                     :: atom_list, elec_conf, nelec_kind, &
                                                             sort_kind
-      LOGICAL                                            :: did_guess, do_hfx_ri_mo, do_kpoints, &
-                                                            do_std_diag, exist, has_unit_metric, &
-                                                            natom_mismatch, need_mos, need_wm, &
-                                                            ofgpw
+      LOGICAL :: did_guess, do_hfx_ri_mo, do_kpoints, do_std_diag, exist, has_unit_metric, &
+         natom_mismatch, need_mos, need_wm, ofgpw, owns_ortho
       REAL(dp), ALLOCATABLE, DIMENSION(:, :)             :: buff, buff2
       REAL(dp), DIMENSION(:, :), POINTER                 :: pdata
       REAL(KIND=dp)                                      :: checksum, eps, length, maxocc, occ, &
@@ -534,13 +532,18 @@ SUBROUTINE calculate_first_density_matrix(scf_env, qs_env)
             CPABORT("calculate_first_density_matrix: core_guess not implemented for k-points")
          END IF
 
+         owns_ortho = .FALSE.
          IF (.NOT. ASSOCIATED(work1)) THEN
             need_wm = .TRUE.
             CPASSERT(.NOT. ASSOCIATED(work2))
             CPASSERT(.NOT. ASSOCIATED(ortho))
          ELSE
             need_wm = .FALSE.
             CPASSERT(ASSOCIATED(work2))
+            IF (.NOT. ASSOCIATED(ortho)) THEN
+               ALLOCATE (ortho)
+               owns_ortho = .TRUE.
+            END IF
          END IF
 
          IF (need_wm) THEN
@@ -610,6 +613,8 @@ SUBROUTINE calculate_first_density_matrix(scf_env, qs_env)
             DEALLOCATE (ortho, work2, work1(1)%matrix)
             DEALLOCATE (work1)
             NULLIFY (work1, work2, ortho)
+         ELSE IF (owns_ortho) THEN
+            DEALLOCATE (ortho)
          END IF
 
          did_guess = .TRUE.

diff --git a/src/qs_scf_diagonalization.F b/src/qs_scf_diagonalization.F
@@ -150,7 +150,7 @@ SUBROUTINE general_eigenproblem(scf_env, mos, matrix_ks, &
       LOGICAL, INTENT(INOUT)                             :: diis_step
 
       INTEGER                                            :: ispin, nspin
-      LOGICAL                                            :: do_level_shift, use_jacobi
+      LOGICAL                                            :: do_level_shift, owns_ortho, use_jacobi
       REAL(KIND=dp)                                      :: diis_error, eps_diis
       TYPE(cp_fm_type), POINTER                          :: ortho
       TYPE(dbcsr_type), POINTER                          :: ortho_dbcsr
@@ -229,6 +229,12 @@ SUBROUTINE general_eigenproblem(scf_env, mos, matrix_ks, &
             ortho => scf_env%ortho
          END IF
 
+         owns_ortho = .FALSE.
+         IF (.NOT. ASSOCIATED(ortho)) THEN
+            ALLOCATE (ortho)
+            owns_ortho = .TRUE.
+         END IF
+
          DO ispin = 1, nspin
             IF (do_level_shift) THEN
                CALL eigensolver(matrix_ks_fm=scf_env%scf_work1(ispin)%matrix, &
@@ -251,9 +257,17 @@ SUBROUTINE general_eigenproblem(scf_env, mos, matrix_ks, &
                                 use_jacobi=use_jacobi)
             END IF
          END DO
+
+         IF (owns_ortho) DEALLOCATE (ortho)
       ELSE
          ortho => scf_env%ortho
 
+         owns_ortho = .FALSE.
+         IF (.NOT. ASSOCIATED(ortho)) THEN
+            ALLOCATE (ortho)
+            owns_ortho = .TRUE.
+         END IF
+
          IF (do_level_shift) THEN
          DO ispin = 1, nspin
             CALL eigensolver_symm(matrix_ks_fm=scf_env%scf_work1(ispin)%matrix, &
@@ -278,6 +292,8 @@ SUBROUTINE general_eigenproblem(scf_env, mos, matrix_ks, &
                                   jacobi_threshold=scf_control%diagonalization%jacobi_threshold)
          END DO
          END IF
+
+         IF (owns_ortho) DEALLOCATE (ortho)
       END IF
 
    END SUBROUTINE general_eigenproblem