Line data Source code
1 :
2 : #if defined HAVE_CONFIG_H
3 : #include "config.h"
4 : #endif
5 : !!****m* ABINIT/m_global
6 : !! NAME
7 : !! m_global
8 : !!
9 : !! FUNCTION
10 : !! Manage error and warnings for the ctqmc
11 : !!
12 : !! COPYRIGHT
13 : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
14 : !! This file is distributed under the terms of the
15 : !! GNU General Public License, see ~abinit/COPYING
16 : !! or http://www.gnu.org/copyleft/gpl.txt .
17 : !!
18 : !! NOTES
19 : !!
20 : !! SOURCE
21 :
22 : #include "defs.h"
23 :
24 : MODULE m_Global
25 :
26 : #if defined HAVE_CONFIG_H
27 : ! we are in abinit
28 : USE defs_basis
29 : USE m_profiling_abi
30 : USE m_errors
31 : USE m_xmpi
32 : USE m_xomp
33 : #endif
34 :
35 : USE_MPI
36 :
37 : IMPLICIT NONE
38 :
39 : PUBLIC
40 :
41 : PUBLIC :: ERROR
42 : PUBLIC :: WARN
43 : PUBLIC :: WARNALL
44 :
45 : CONTAINS
46 : !!***
47 :
48 : !!****f* ABINIT/m_global/ERROR
49 : !! NAME
50 : !! ERROR
51 : !!
52 : !! FUNCTION
53 : !! error dectected => leave
54 : !!
55 : !! COPYRIGHT
56 : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
57 : !! This file is distributed under the terms of the
58 : !! GNU General Public License, see ~abinit/COPYING
59 : !! or http://www.gnu.org/copyleft/gpl.txt .
60 : !!
61 : !! INPUTS
62 : !! message=error message to display
63 : !!
64 : !! OUTPUT
65 : !!
66 : !! SIDE EFFECTS
67 : !!
68 : !! NOTES
69 : !!
70 : !! SOURCE
71 :
72 0 : SUBROUTINE ERROR(message)
73 :
74 : !Arguments ------------------------------------
75 : #ifdef HAVE_MPI1
76 : include 'mpif.h'
77 : #endif
78 : CHARACTER(LEN=*), INTENT(IN) :: message
79 : !Local variables ------------------------------
80 : CHARACTER(LEN=500) :: messend
81 : #ifdef HAVE_MPI
82 : INTEGER :: ierr
83 : INTEGER :: rank
84 0 : CALL MPI_Comm_rank(MY_WORLD, rank, ierr)
85 0 : WRITE(messend,'(A,i5,A,A)') "ERROR in QMC rank ", rank, " : ",TRIM(message)
86 0 : myERROR(TRIM(messend))
87 0 : CALL MPI_Finalize(ierr) ! IF in abinit, does nothing since killed in _myERROR_
88 : #else
89 : WRITE(messend,'(A,A)') "ERROR in QMC : ", TRIM(message)
90 : myERROR(TRIM(messend))
91 : #endif
92 : !CALL FLUSH(0)
93 0 : STOP
94 : END SUBROUTINE ERROR
95 : !!***
96 :
97 : !!****f* ABINIT/m_global/WARN
98 : !! NAME
99 : !! WARN
100 : !!
101 : !! FUNCTION
102 : !! on cpu wants to tell something
103 : !!
104 : !! COPYRIGHT
105 : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
106 : !! This file is distributed under the terms of the
107 : !! GNU General Public License, see ~abinit/COPYING
108 : !! or http://www.gnu.org/copyleft/gpl.txt .
109 : !!
110 : !! INPUTS
111 : !! message=warning message
112 : !!
113 : !! OUTPUT
114 : !!
115 : !! SIDE EFFECTS
116 : !!
117 : !! NOTES
118 : !!
119 : !! SOURCE
120 :
121 0 : SUBROUTINE WARN(message)
122 :
123 : !Arguments ------------------------------------
124 : #ifdef HAVE_MPI1
125 : include 'mpif.h'
126 : #endif
127 : CHARACTER(LEN=*), INTENT(IN) :: message
128 : !Local variables ------------------------------
129 : CHARACTER(LEN=500) :: messend
130 : #ifdef HAVE_MPI
131 : INTEGER :: ierr
132 : INTEGER :: rank
133 0 : CALL MPI_Comm_rank(MY_WORLD, rank, ierr)
134 0 : WRITE(messend,'(A,I6,A,A)') "WARNING in QMC rank ", rank, " : ", TRIM(message)
135 : #else
136 : WRITE(messend,'(A,A)') "WARNING in QMC : ", TRIM(message)
137 : #endif
138 0 : myWARN(TRIM(messend))
139 : !CALL FLUSH(0)
140 :
141 0 : END SUBROUTINE WARN
142 : !!***
143 :
144 : !!****f* ABINIT/m_global/WARNALL
145 : !! NAME
146 : !! WARNALL
147 : !!
148 : !! FUNCTION
149 : !! collective warning function
150 : !!
151 : !! COPYRIGHT
152 : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
153 : !! This file is distributed under the terms of the
154 : !! GNU General Public License, see ~abinit/COPYING
155 : !! or http://www.gnu.org/copyleft/gpl.txt .
156 : !!
157 : !! INPUTS
158 : !! message=message to display
159 : !!
160 : !! OUTPUT
161 : !!
162 : !! SIDE EFFECTS
163 : !!
164 : !! NOTES
165 : !!
166 : !! SOURCE
167 :
168 37 : SUBROUTINE WARNALL(message)
169 :
170 : !Arguments ------------------------------------
171 : #ifdef HAVE_MPI1
172 : include 'mpif.h'
173 : #endif
174 : CHARACTER(LEN=*), INTENT(IN) :: message
175 : !Local variables ------------------------------------
176 : CHARACTER(LEN=500) :: messend
177 : #ifdef HAVE_MPI
178 : INTEGER :: ierr
179 : INTEGER :: rank
180 37 : CALL MPI_Comm_rank(MY_WORLD, rank, ierr)
181 37 : IF ( rank .EQ. 0) THEN
182 : #endif
183 19 : WRITE(messend,'(A,A)') "WARNING in QMC : ", TRIM(message)
184 19 : myWARNALL(TRIM(messend))
185 : #ifdef HAVE_MPI
186 : END IF
187 : #endif
188 : !CALL FLUSH(0)
189 :
190 37 : END SUBROUTINE WARNALL
191 : !!***
192 :
193 : END MODULE m_global
194 : !!***
|
