Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Routines for writing PAO restart files from MAO.
10 : ! **************************************************************************************************
11 : MODULE mao_io
12 : USE atomic_kind_types, ONLY: atomic_kind_type,&
13 : get_atomic_kind
14 : USE basis_set_types, ONLY: gto_basis_set_type
15 : USE cell_types, ONLY: cell_type
16 : USE cp_dbcsr_api, ONLY: dbcsr_get_block_p,&
17 : dbcsr_get_info,&
18 : dbcsr_p_type,&
19 : dbcsr_type
20 : USE cp_log_handling, ONLY: cp_get_default_logger,&
21 : cp_logger_type
22 : USE cp_output_handling, ONLY: cp_print_key_finished_output,&
23 : cp_print_key_unit_nr
24 : USE input_section_types, ONLY: section_vals_type
25 : USE kinds, ONLY: default_string_length,&
26 : dp
27 : USE message_passing, ONLY: mp_para_env_type
28 : USE particle_types, ONLY: particle_type
29 : USE physcon, ONLY: angstrom
30 : USE qs_environment_types, ONLY: get_qs_env,&
31 : qs_environment_type
32 : USE qs_kind_types, ONLY: get_qs_kind,&
33 : qs_kind_type
34 : #include "./base/base_uses.f90"
35 :
36 : IMPLICIT NONE
37 :
38 : PRIVATE
39 :
40 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'mao_io'
41 :
42 : PUBLIC :: mao_write_pao_restart
43 :
44 : INTEGER, PARAMETER, PRIVATE :: file_format_version = 4
45 :
46 : CONTAINS
47 :
48 : ! **************************************************************************************************
49 : !> \brief Writes restart file
50 : !> \param mao_coef ...
51 : !> \param qs_env ...
52 : ! **************************************************************************************************
53 4 : SUBROUTINE mao_write_pao_restart(mao_coef, qs_env)
54 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: mao_coef
55 : TYPE(qs_environment_type), POINTER :: qs_env
56 :
57 : CHARACTER(len=*), PARAMETER :: printkey_section = 'DFT%PRINT%MAO_ANALYSIS', &
58 : routineN = 'mao_write_pao_restart'
59 :
60 : INTEGER :: handle, unit_nr
61 : TYPE(cp_logger_type), POINTER :: logger
62 : TYPE(mp_para_env_type), POINTER :: para_env
63 : TYPE(section_vals_type), POINTER :: input
64 :
65 4 : CALL timeset(routineN, handle)
66 4 : logger => cp_get_default_logger()
67 :
68 4 : CALL get_qs_env(qs_env, input=input, para_env=para_env)
69 :
70 4 : IF (SIZE(mao_coef) == 1) THEN
71 : ! open file
72 : unit_nr = cp_print_key_unit_nr(logger, &
73 : input, &
74 : printkey_section, &
75 : extension=".pao", &
76 : file_action="WRITE", &
77 : file_position="REWIND", &
78 : file_status="UNKNOWN", &
79 4 : on_file=.TRUE.)
80 :
81 4 : IF (unit_nr > 0) CALL write_restart_header(qs_env, unit_nr)
82 :
83 4 : CALL write_diagonal_blocks(para_env, mao_coef(1)%matrix, "Xblock", unit_nr)
84 4 : IF (unit_nr > 0) WRITE (unit_nr, '(A)') "THE_END"
85 :
86 4 : CALL cp_print_key_finished_output(unit_nr, logger, input, printkey_section)
87 : ELSE
88 0 : CPWARN("MAO/PAO restart only for restricted case available.")
89 : END IF
90 :
91 4 : CALL timestop(handle)
92 :
93 4 : END SUBROUTINE mao_write_pao_restart
94 :
95 : ! **************************************************************************************************
96 : !> \brief Write the digonal blocks of given DBCSR matrix into the provided unit_nr
97 : !> \param para_env ...
98 : !> \param matrix ...
99 : !> \param label ...
100 : !> \param unit_nr ...
101 : ! **************************************************************************************************
102 4 : SUBROUTINE write_diagonal_blocks(para_env, matrix, label, unit_nr)
103 : TYPE(mp_para_env_type), POINTER :: para_env
104 : TYPE(dbcsr_type) :: matrix
105 : CHARACTER(LEN=*), INTENT(IN) :: label
106 : INTEGER, INTENT(IN) :: unit_nr
107 :
108 : INTEGER :: i, iatom, m, n, natoms
109 4 : INTEGER, DIMENSION(:), POINTER :: col_blk_sizes, row_blk_sizes
110 : LOGICAL :: found
111 4 : REAL(dp), DIMENSION(:, :), POINTER :: local_block, mpi_buffer
112 :
113 : !TODO: this is a serial algorithm
114 4 : CALL dbcsr_get_info(matrix, row_blk_size=row_blk_sizes, col_blk_size=col_blk_sizes)
115 4 : CPASSERT(SIZE(row_blk_sizes) == SIZE(col_blk_sizes))
116 4 : natoms = SIZE(row_blk_sizes)
117 :
118 22 : DO iatom = 1, natoms
119 18 : n = row_blk_sizes(iatom)
120 18 : m = col_blk_sizes(iatom)
121 72 : ALLOCATE (mpi_buffer(n, m))
122 18 : NULLIFY (local_block)
123 18 : CALL dbcsr_get_block_p(matrix=matrix, row=iatom, col=iatom, block=local_block, found=found)
124 18 : IF (ASSOCIATED(local_block)) THEN
125 27 : IF (SIZE(local_block) > 0) & ! catch corner-case
126 645 : mpi_buffer(:, :) = local_block(:, :)
127 : ELSE
128 327 : mpi_buffer(:, :) = 0.0_dp
129 : END IF
130 :
131 1290 : CALL para_env%sum(mpi_buffer)
132 18 : IF (unit_nr > 0) THEN
133 : ! normalize vectors
134 27 : DO i = 1, m
135 627 : mpi_buffer(:, i) = mpi_buffer(:, i)/NORM2(mpi_buffer(:, i))
136 : END DO
137 :
138 9 : WRITE (unit_nr, fmt="(A,1X,I10,1X)", advance='no') label, iatom
139 327 : WRITE (unit_nr, *) mpi_buffer
140 : END IF
141 40 : DEALLOCATE (mpi_buffer)
142 : END DO
143 :
144 : ! flush
145 4 : IF (unit_nr > 0) FLUSH (unit_nr)
146 :
147 4 : END SUBROUTINE write_diagonal_blocks
148 :
149 : ! **************************************************************************************************
150 : !> \brief Writes header of restart file
151 : !> \param qs_env ...
152 : !> \param unit_nr ...
153 : ! **************************************************************************************************
154 2 : SUBROUTINE write_restart_header(qs_env, unit_nr)
155 : TYPE(qs_environment_type), POINTER :: qs_env
156 : INTEGER, INTENT(IN) :: unit_nr
157 :
158 : CHARACTER(LEN=default_string_length) :: kindname
159 : INTEGER :: iatom, ikind, ipot, istep, nmao, &
160 : nparams, nsgf, z
161 : REAL(KIND=dp) :: energy
162 2 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
163 : TYPE(cell_type), POINTER :: cell
164 : TYPE(gto_basis_set_type), POINTER :: basis_set
165 2 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
166 2 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
167 :
168 : CALL get_qs_env(qs_env, &
169 : cell=cell, &
170 : particle_set=particle_set, &
171 : atomic_kind_set=atomic_kind_set, &
172 2 : qs_kind_set=qs_kind_set)
173 :
174 2 : WRITE (unit_nr, "(A,5X,I0)") "Version", file_format_version
175 2 : energy = 0.0_dp
176 2 : WRITE (unit_nr, "(A,5X,F20.10)") "Energy", energy
177 2 : istep = 1
178 2 : WRITE (unit_nr, "(A,5X,I0)") "Step", istep
179 2 : WRITE (unit_nr, "(A,5X,A)") "Parametrization", "EQUIVARIANT"
180 :
181 : ! write kinds
182 2 : WRITE (unit_nr, "(A,5X,I0)") "Nkinds", SIZE(atomic_kind_set)
183 6 : DO ikind = 1, SIZE(atomic_kind_set)
184 4 : CALL get_atomic_kind(atomic_kind_set(ikind), name=kindname, z=z)
185 4 : CALL get_qs_kind(qs_kind_set(ikind), mao=nmao, nsgf=nsgf, basis_set=basis_set)
186 4 : nparams = nmao*nsgf
187 4 : WRITE (unit_nr, "(A,5X,I10,1X,A,1X,I3)") "Kind", ikind, TRIM(kindname), z
188 4 : WRITE (unit_nr, "(A,5X,I10,1X,I3)") "NParams", ikind, nparams
189 4 : WRITE (unit_nr, "(A,5X,I10,1X,I10,1X,A)") "PrimBasis", ikind, nsgf, TRIM(basis_set%name)
190 4 : WRITE (unit_nr, "(A,5X,I10,1X,I3)") "PaoBasis", ikind, nmao
191 4 : ipot = 0
192 10 : WRITE (unit_nr, "(A,5X,I10,1X,I3)") "NPaoPotentials", ikind, ipot
193 : END DO
194 :
195 : ! write cell
196 2 : WRITE (unit_nr, fmt="(A,5X)", advance='no') "Cell"
197 26 : WRITE (unit_nr, *) cell%hmat*angstrom
198 :
199 : ! write atoms
200 2 : WRITE (unit_nr, "(A,5X,I0)") "Natoms", SIZE(particle_set)
201 11 : DO iatom = 1, SIZE(particle_set)
202 9 : kindname = particle_set(iatom)%atomic_kind%name
203 9 : WRITE (unit_nr, fmt="(A,5X,I10,5X,A,1X)", advance='no') "Atom ", iatom, TRIM(kindname)
204 38 : WRITE (unit_nr, *) particle_set(iatom)%r*angstrom
205 : END DO
206 :
207 2 : END SUBROUTINE write_restart_header
208 :
209 : END MODULE mao_io
|
