1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2020  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5
6! **************************************************************************************************
7!> \brief some minimal info about CP2K, including its version and license
8!> \par History
9!>      - created (2007-09, Joost VandeVondele)
10!>      - moved into this module information related to runtime:pid, user_name,
11!>        host_name, cwd, datx  (2009-06, Teodoro Laino)
12!> \author Joost VandeVondele
13! **************************************************************************************************
14MODULE cp2k_info
15
16   USE input_constants,                 ONLY: id_development_version,&
17                                              id_release_version
18   USE kinds,                           ONLY: default_path_length,&
19                                              default_string_length
20   USE machine,                         ONLY: m_datum,&
21                                              m_getcwd,&
22                                              m_getlog,&
23                                              m_getpid,&
24                                              m_hostnm
25   USE string_utilities,                ONLY: integer_to_string
26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC :: cp2k_year, cp2k_version, cp2k_home, id_cp2k_version, cp2k_flags
31   PUBLIC :: compile_arch, compile_date, compile_host, compile_revision
32   PUBLIC :: print_cp2k_license, get_runtime_info, write_restart_header
33
34   ! the version string of CP2K intended to be adjust after releases and branches
35#if defined(__RELEASE_VERSION)
36   INTEGER, PARAMETER          :: id_cp2k_version = id_release_version ! (Uncomment for release     version)
37#else
38   INTEGER, PARAMETER          :: id_cp2k_version = id_development_version ! (Uncomment for development version)
39!  INTEGER, PARAMETER          :: id_cp2k_version = 2                      ! (Uncomment for branch      version)
40#endif
41
42#if defined(__COMPILE_REVISION)
43   CHARACTER(LEN=*), PARAMETER :: compile_revision = __COMPILE_REVISION
44#else
45   CHARACTER(LEN=*), PARAMETER :: compile_revision = "unknown"
46#endif
47
48   CHARACTER(LEN=*), PARAMETER :: version_nr = "8.0"
49   CHARACTER(LEN=*), PARAMETER :: cp2k_year = "2019"
50   CHARACTER(LEN=*), PARAMETER :: cp2k_version = "CP2K version "//TRIM(version_nr)
51   CHARACTER(LEN=*), PARAMETER :: cp2k_home = "https://www.cp2k.org/"
52
53   ! compile time information
54#if defined(__COMPILE_ARCH)
55   CHARACTER(LEN=*), PARAMETER :: compile_arch = __COMPILE_ARCH
56#else
57   CHARACTER(LEN=*), PARAMETER :: compile_arch = "unknown: -D__COMPILE_ARCH=?"
58#endif
59
60#if defined(__COMPILE_DATE)
61   CHARACTER(LEN=*), PARAMETER :: compile_date = __COMPILE_DATE
62#else
63   CHARACTER(LEN=*), PARAMETER :: compile_date = "unknown: -D__COMPILE_DATE=?"
64#endif
65
66#if defined(__COMPILE_HOST)
67   CHARACTER(LEN=*), PARAMETER :: compile_host = __COMPILE_HOST
68#else
69   CHARACTER(LEN=*), PARAMETER :: compile_host = "unknown: -D__COMPILE_HOST=?"
70#endif
71
72   ! Local runtime informations
73   CHARACTER(LEN=26), PUBLIC                        :: r_datx
74   CHARACTER(LEN=default_path_length), PUBLIC       :: r_cwd
75   CHARACTER(LEN=default_string_length), PUBLIC     :: r_host_name, r_user_name
76   INTEGER, PUBLIC                                  :: r_pid
77
78   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp2k_info'
79CONTAINS
80
81! **************************************************************************************************
82!> \brief list all compile time options that influence the capabilities of cp2k.
83!>        All new flags should be added here (and be unique grep-able)
84!> \return ...
85! **************************************************************************************************
86   FUNCTION cp2k_flags() RESULT(flags)
87      CHARACTER(len=10*default_string_length)            :: flags
88
89      CHARACTER(len=default_string_length)               :: tmp_str
90
91      flags = "cp2kflags:"
92
93      ! Ensure that tmp_str is used to silence compiler warnings
94      tmp_str = ""
95      flags = TRIM(flags)//TRIM(tmp_str)
96
97#if defined(NDEBUG)
98      flags = TRIM(flags)//" ndebug"
99#endif
100!$    flags = TRIM(flags)//" omp"
101#if defined(__LIBINT)
102      flags = TRIM(flags)//" libint"
103#endif
104#if defined(__FFTW3)
105      flags = TRIM(flags)//" fftw3"
106#endif
107#if defined(__LIBXC)
108      flags = TRIM(flags)//" libxc"
109#endif
110#if defined(__LIBPEXSI)
111      flags = TRIM(flags)//" pexsi"
112#endif
113#if defined(__ELPA)
114      flags = TRIM(flags)//" elpa"
115#endif
116#if defined(__parallel)
117      flags = TRIM(flags)//" parallel"
118#if !defined(__MPI_VERSION) || (__MPI_VERSION > 2)
119      flags = TRIM(flags)//" mpi3"
120#else
121      flags = TRIM(flags)//" mpi2"
122#endif
123#endif
124#if defined(__SCALAPACK)
125      flags = TRIM(flags)//" scalapack"
126#endif
127
128#if defined(__QUIP)
129      flags = TRIM(flags)//" quip"
130#endif
131
132#if defined(__ACC)
133      flags = TRIM(flags)//" acc"
134#endif
135#if defined(__PW_CUDA)
136      flags = TRIM(flags)//" pw_cuda"
137#endif
138#if defined(__PW_FPGA)
139      flags = TRIM(flags)//" pw_fpga"
140#endif
141#if defined(__PW_FPGA_SP)
142      flags = TRIM(flags)//" pw_fpga_sp"
143#endif
144#if defined(__HAS_PATCHED_CUFFT_70)
145      flags = TRIM(flags)//" patched_cufft_70"
146#endif
147
148#if defined __HAS_smm_vec
149      flags = TRIM(flags)//" smm_vec"
150#endif
151#if defined __HAS_smm_snn
152      flags = TRIM(flags)//" smm_snn"
153#endif
154#if defined __HAS_smm_snt
155      flags = TRIM(flags)//" smm_snt"
156#endif
157#if defined __HAS_smm_stn
158      flags = TRIM(flags)//" smm_stn"
159#endif
160#if defined __HAS_smm_stt
161      flags = TRIM(flags)//" smm_stt"
162#endif
163#if defined __HAS_smm_znn
164      flags = TRIM(flags)//" smm_znn"
165#endif
166#if defined __HAS_smm_znt
167      flags = TRIM(flags)//" smm_znt"
168#endif
169#if defined __HAS_smm_ztn
170      flags = TRIM(flags)//" smm_ztn"
171#endif
172#if defined __HAS_smm_ztt
173      flags = TRIM(flags)//" smm_ztt"
174#endif
175#if defined __HAS_smm_cnn
176      flags = TRIM(flags)//" smm_cnn"
177#endif
178#if defined __HAS_smm_cnt
179      flags = TRIM(flags)//" smm_cnt"
180#endif
181#if defined __HAS_smm_ctn
182      flags = TRIM(flags)//" smm_ctn"
183#endif
184#if defined __HAS_smm_ctt
185      flags = TRIM(flags)//" smm_ctt"
186#endif
187#if defined __HAS_smm_dnn
188      flags = TRIM(flags)//" smm_dnn"
189#endif
190#if defined __HAS_smm_dnt
191      flags = TRIM(flags)//" smm_dnt"
192#endif
193#if defined __HAS_smm_dtn
194      flags = TRIM(flags)//" smm_dtn"
195#endif
196#if defined __HAS_smm_dtt
197      flags = TRIM(flags)//" smm_dtt"
198#endif
199      IF (INDEX(flags, " smm_") > 0) THEN
200         flags = TRIM(flags)//" smm"
201      ENDIF
202
203#if defined __LIBXSMM
204      flags = TRIM(flags)//" xsmm"
205#endif
206
207#if defined __CRAY_PM_ACCEL_ENERGY
208      flags = TRIM(flags)//" cray_pm_accel_energy"
209#endif
210#if defined __CRAY_PM_ENERGY
211      flags = TRIM(flags)//" cray_pm_energy"
212#endif
213#if defined __CRAY_PM_FAKE_ENERGY
214      flags = TRIM(flags)//" cray_pm_fake_energy"
215#endif
216#if defined __CUDA_PROFILING
217      flags = TRIM(flags)//" cuda_profiling"
218#endif
219#if defined __DBCSR_ACC
220      flags = TRIM(flags)//" dbcsr_acc"
221#endif
222#if defined __HAS_LIBGRID
223      flags = TRIM(flags)//" libgrid"
224#endif
225#if defined __MAX_CONTR
226      CALL integer_to_string(__MAX_CONTR, tmp_str)
227      flags = TRIM(flags)//" max_contr="//TRIM(tmp_str)
228#endif
229#if defined __NO_IPI_DRIVER
230      flags = TRIM(flags)//" no_ipi_driver"
231#endif
232#if defined __NO_MPI_THREAD_SUPPORT_CHECK
233      flags = TRIM(flags)//" no_mpi_thread_support_check"
234#endif
235#if defined __NO_STATM_ACCESS
236      flags = TRIM(flags)//" no_statm_access"
237#endif
238#if defined __MINGW
239      flags = TRIM(flags)//" mingw"
240#endif
241#if defined __PW_CUDA_NO_HOSTALLOC
242      flags = TRIM(flags)//" pw_cuda_no_hostalloc"
243#endif
244#if defined __STATM_RESIDENT
245      flags = TRIM(flags)//" statm_resident"
246#endif
247#if defined __STATM_TOTAL
248      flags = TRIM(flags)//" statm_total"
249#endif
250#if defined __PLUMED2
251      flags = TRIM(flags)//" plumed2"
252#endif
253#if defined __HAS_IEEE_EXCEPTIONS
254      flags = TRIM(flags)//" has_ieee_exceptions"
255#endif
256#if defined __NO_ABORT
257      flags = TRIM(flags)//" no_abort"
258#endif
259#if defined __SPGLIB
260      flags = TRIM(flags)//" spglib"
261#endif
262#if defined __ACCELERATE
263      flags = TRIM(flags)//" accelerate"
264#endif
265#if defined __MKL
266      flags = TRIM(flags)//" mkl"
267#endif
268#if defined __SIRIUS
269      flags = TRIM(flags)//" sirius"
270#endif
271#if defined __CHECK_DIAG
272      flags = TRIM(flags)//" check_diag"
273#endif
274
275   END FUNCTION cp2k_flags
276
277! **************************************************************************************************
278!> \brief ...
279!> \param iunit ...
280! **************************************************************************************************
281   SUBROUTINE print_cp2k_license(iunit)
282      INTEGER                                            :: iunit
283
284      WRITE (iunit, '(T2,A)') '!-----------------------------------------------------------------------------!'
285      WRITE (iunit, '(T2,A)') '!                                                                             !'
286      WRITE (iunit, '(T2,A)') '!   CP2K: A general program to perform molecular dynamics simulations         !'
287      WRITE (iunit, '(T2,A)') '!   Copyright (C) 2000, 2001, 2002, 2003  CP2K developers group               !'
288      WRITE (iunit, '(T2,A)') '!   Copyright (C) 2004, 2005, 2006, 2007  CP2K developers group               !'
289      WRITE (iunit, '(T2,A)') '!   Copyright (C) 2008, 2009, 2010, 2011  CP2K developers group               !'
290      WRITE (iunit, '(T2,A)') '!   Copyright (C) 2012, 2013, 2014, 2015  CP2K developers group               !'
291      WRITE (iunit, '(T2,A)') '!   Copyright (C) 2016, 2017, 2018, 2019  CP2K developers group               !'
292      WRITE (iunit, '(T2,A)') '!   Copyright (C) 2020                    CP2K developers group               !'
293      WRITE (iunit, '(T2,A)') '!                                                                             !'
294      WRITE (iunit, '(T2,A)') '!   This program is free software; you can redistribute it and/or modify      !'
295      WRITE (iunit, '(T2,A)') '!   it under the terms of the GNU General Public License as published by      !'
296      WRITE (iunit, '(T2,A)') '!   the Free Software Foundation; either version 2 of the License, or         !'
297      WRITE (iunit, '(T2,A)') '!   (at your option) any later version.                                       !'
298      WRITE (iunit, '(T2,A)') '!                                                                             !'
299      WRITE (iunit, '(T2,A)') '!   This program is distributed in the hope that it will be useful,           !'
300      WRITE (iunit, '(T2,A)') '!   but WITHOUT ANY WARRANTY; without even the implied warranty of            !'
301      WRITE (iunit, '(T2,A)') '!   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the             !'
302      WRITE (iunit, '(T2,A)') '!   GNU General Public License for more details.                              !'
303      WRITE (iunit, '(T2,A)') '!                                                                             !'
304      WRITE (iunit, '(T2,A)') '!   You should have received a copy of the GNU General Public License         !'
305      WRITE (iunit, '(T2,A)') '!   along with this program; if not, write to the Free Software               !'
306      WRITE (iunit, '(T2,A)') '!   Foundation, Inc., 51 Franklin Street, Fifth Floor,                        !'
307      WRITE (iunit, '(T2,A)') '!   Boston, MA  02110-1301, USA.                                              !'
308      WRITE (iunit, '(T2,A)') '!                                                                             !'
309      WRITE (iunit, '(T2,A)') '!   See also https://www.fsf.org/licensing/licenses/gpl.html                  !'
310      WRITE (iunit, '(T2,A)') '!                                                                             !'
311      WRITE (iunit, '(T2,A)') '!-----------------------------------------------------------------------------!'
312      WRITE (iunit, '(T2,A)') '!   CP2K, including its sources and pointers to the authors                   !'
313      WRITE (iunit, '(T2,A)') '!   can be found at  https://www.cp2k.org/                                    !'
314      WRITE (iunit, '(T2,A)') '!-----------------------------------------------------------------------------!'
315
316   END SUBROUTINE print_cp2k_license
317
318! **************************************************************************************************
319!> \brief ...
320! **************************************************************************************************
321   SUBROUTINE get_runtime_info()
322
323      r_datx = ""
324      r_cwd = ""
325      r_host_name = ""
326      r_user_name = ""
327      r_pid = -1
328
329      CALL m_getpid(r_pid)
330      CALL m_getlog(r_user_name)
331      CALL m_hostnm(r_host_name)
332      CALL m_datum(r_datx)
333      CALL m_getcwd(r_cwd)
334
335   END SUBROUTINE
336
337! **************************************************************************************************
338!> \brief Writes the header for the restart file
339!> \param iunit ...
340!> \par History
341!>      01.2008 [created] - Split from write_restart
342!> \author Teodoro Laino - University of Zurich - 01.2008
343! **************************************************************************************************
344   SUBROUTINE write_restart_header(iunit)
345      INTEGER, INTENT(IN)                                :: iunit
346
347      CHARACTER(LEN=*), PARAMETER :: routineN = 'write_restart_header', &
348         routineP = moduleN//':'//routineN
349
350      CHARACTER(LEN=256)                                 :: cwd, datx
351
352      CALL m_datum(datx)
353      CALL m_getcwd(cwd)
354
355      WRITE (UNIT=iunit, FMT="(T2,A)") "# Version information for this restart file "
356      WRITE (UNIT=iunit, FMT="(T2,A)") "# current date "//TRIM(datx)
357      WRITE (UNIT=iunit, FMT="(T2,A)") "# current working dir "//TRIM(cwd)
358
359      WRITE (UNIT=iunit, FMT="(T2,A,T31,A50)") &
360         "# Program compiled at", &
361         ADJUSTR(compile_date(1:MIN(50, LEN(compile_date))))
362      WRITE (UNIT=iunit, FMT="(T2,A,T31,A50)") &
363         "# Program compiled on", &
364         ADJUSTR(compile_host(1:MIN(50, LEN(compile_host))))
365      WRITE (UNIT=iunit, FMT="(T2,A,T31,A50)") &
366         "# Program compiled for", &
367         ADJUSTR(compile_arch(1:MIN(50, LEN(compile_arch))))
368      WRITE (UNIT=iunit, FMT="(T2,A,T31,A50)") &
369         "# Source code revision number", &
370         ADJUSTR(compile_revision)
371
372   END SUBROUTINE write_restart_header
373
374END MODULE cp2k_info
375