Branch data Line data Source code
1 : : !!****m* ABINIT/m_specialmsg
2 : : !! NAME
3 : : !! m_specialmsg
4 : : !!
5 : : !! FUNCTION
6 : : !! This module contains tools to deal with special messages counters.
7 : : !! Special messages= WARNING, COMMENT, EXIT
8 : : !!
9 : : !! COPYRIGHT
10 : : !! Copyright (C) 2008-2026 ABINIT group (MT,XG)
11 : : !! This file is distributed under the terms of the
12 : : !! GNU General Public License, see ~abinit/COPYING
13 : : !! or http://www.gnu.org/copyleft/gpl.txt .
14 : : !!
15 : : !! SOURCE
16 : :
17 : : #if defined HAVE_CONFIG_H
18 : : #include "config.h"
19 : : #endif
20 : :
21 : : #include "abi_common.h"
22 : :
23 : : module m_specialmsg
24 : :
25 : : use defs_basis
26 : : use m_build_info
27 : : use m_xmpi
28 : :
29 : : use m_io_tools, only : flush_unit, write_lines, is_open
30 : :
31 : : implicit none
32 : :
33 : : private
34 : : !!***
35 : :
36 : : public :: herald ! Prints message to unit iout giving info about current
37 : : ! code, version of code, platform, and starting date.
38 : :
39 : : !Number of WARNINGS/COMMENTS printed in log file
40 : : integer,save :: COMMENT_COUNT = 0
41 : : integer,save :: WARNING_COUNT = 0
42 : : integer,save :: EXIT_FLAG = 0
43 : :
44 : : !Public procedures
45 : : public :: specialmsg_setcount ! Update number of special messages (WARNING/COMMENT) present in log file
46 : : public :: specialmsg_getcount ! Get number of special messages (WARNING/COMMENT) present in log file
47 : : public :: specialmsg_mpisum ! Reduce number of special messages (WARNING/COMMENT) over MPI comm
48 : :
49 : : public :: wrtout
50 : :
51 : : interface wrtout
52 : : module procedure wrtout_unit
53 : : module procedure wrtout_units
54 : : end interface wrtout
55 : :
56 : : CONTAINS !===========================================================
57 : : !!***
58 : :
59 : : !----------------------------------------------------------------------
60 : :
61 : : !!****f* m_specialmsg/specialmsg_setcount
62 : : !! NAME
63 : : !! specialmsg_setcount
64 : : !!
65 : : !! FUNCTION
66 : : !! Update the counters of special messages (WARNING, COMMENTS, EXIT) printed in log file
67 : : !!
68 : : !! INPUTS
69 : : !! [n_add_comment]= (optional) number of comments to add to the counter
70 : : !! [n_add_exit] = (optional) number of exit messages to add to the counter
71 : : !! [n_add_warning]= (optional) number of warnings to add to the counter
72 : : !!
73 : : !! OUTPUT
74 : : !! (only counters updated)
75 : : !!
76 : : !! SOURCE
77 : :
78 : 229741 : subroutine specialmsg_setcount(n_add_comment,n_add_warning,n_add_exit)
79 : :
80 : : !Arguments ------------------------------------
81 : : integer,optional,intent(in) :: n_add_comment,n_add_warning,n_add_exit
82 : :
83 : : ! *********************************************************************
84 : :
85 [ - - + - ]: 22262 : if (PRESENT(n_add_comment)) COMMENT_COUNT=COMMENT_COUNT+n_add_comment
86 [ - - + - ]: 207479 : if (PRESENT(n_add_warning)) WARNING_COUNT=WARNING_COUNT+n_add_warning
87 [ # # # # ]: 0 : if (PRESENT(n_add_exit)) then
88 : 0 : EXIT_FLAG=EXIT_FLAG+n_add_exit
89 [ # # # # ]: 0 : if (EXIT_FLAG>1) EXIT_FLAG=1
90 : : end if
91 : :
92 : 0 : end subroutine specialmsg_setcount
93 : : !!***
94 : :
95 : : !----------------------------------------------------------------------
96 : :
97 : : !!****f* m_specialmsg/specialmsg_getcount
98 : : !! NAME
99 : : !! specialmsg_getcount
100 : : !!
101 : : !! FUNCTION
102 : : !! Get the values of the counters of special messages (WARNING, COMMENT)
103 : : !!
104 : : !! INPUTS
105 : : !!
106 : : !! OUTPUT
107 : : !! ncomment= number of COMMENTs in log file
108 : : !! nwarning= number of WARNINGs in log file
109 : : !! nexit= 1 if exit requested
110 : : !!
111 : : !! SOURCE
112 : :
113 : 1444 : subroutine specialmsg_getcount(ncomment,nwarning,nexit)
114 : :
115 : : !Arguments ------------------------------------
116 : : integer,intent(out) :: ncomment,nexit,nwarning
117 : :
118 : : ! *********************************************************************
119 : :
120 : 1444 : ncomment=COMMENT_COUNT
121 : 1444 : nwarning=WARNING_COUNT
122 : 1444 : nexit =EXIT_FLAG
123 : :
124 : 1444 : end subroutine specialmsg_getcount
125 : : !!***
126 : :
127 : : !----------------------------------------------------------------------
128 : :
129 : : !!****f* m_specialmsg/specialmsg_mpisum
130 : : !! NAME
131 : : !! specialmsg_mpisum
132 : : !!
133 : : !! FUNCTION
134 : : !! Reduce the counters of special messages (WARNING, COMMENTS, EXIT) over a MPI communicator
135 : : !!
136 : : !! INPUTS
137 : : !! mpicomm= MPI communicator
138 : : !!
139 : : !! OUTPUT
140 : : !! (only counters updated)
141 : : !!
142 : : !! SOURCE
143 : :
144 : 0 : subroutine specialmsg_mpisum(mpicomm)
145 : :
146 : : !Arguments ------------------------------------
147 : : integer,intent(in) :: mpicomm
148 : :
149 : : !Local variables-------------------------------
150 : : integer :: ierr
151 : : integer :: buf(3)
152 : :
153 : : ! *********************************************************************
154 : :
155 : 0 : buf(1)=COMMENT_COUNT;buf(2)=WARNING_COUNT;buf(3)=EXIT_FLAG
156 : :
157 : 0 : call xmpi_sum(buf,mpicomm,ierr)
158 : :
159 : 0 : COMMENT_COUNT=buf(1)
160 : 0 : WARNING_COUNT=buf(2)
161 [ # # ]: 0 : EXIT_FLAG=buf(3) ; if (EXIT_FLAG/=0) EXIT_FLAG=1
162 : :
163 : 0 : end subroutine specialmsg_mpisum
164 : : !!***
165 : :
166 : : !----------------------------------------------------------------------
167 : :
168 : : !!****f* m_specialmsg/herald
169 : : !! NAME
170 : : !! herald
171 : : !!
172 : : !! FUNCTION
173 : : !! Prints out a message to unit iout giving info about current
174 : : !! code, version of code, platform, and starting date.
175 : : !!
176 : : !! INPUTS
177 : : !! code_name= code name
178 : : !! code_version= code version
179 : : !! iout=unit number for output
180 : : !!
181 : : !! OUTPUT
182 : : !! (only writing)
183 : : !!
184 : : !! SOURCE
185 : :
186 : 2699 : subroutine herald(code_name,code_version,iout)
187 : :
188 : : !Arguments ------------------------------------
189 : : integer,intent(in) :: iout
190 : : character(len=*),intent(in) :: code_name
191 : : character(len=*),intent(in) :: code_version
192 : :
193 : : !Local variables-------------------------------
194 : : integer :: day,dd,ja,jy,jm,jdn,mm,mm_rel,year,year_rel
195 : : integer :: values(8)
196 : : character(len=5) :: strzone
197 : : character(len=7) :: version_rel
198 : : character(len=8) :: strdat
199 : : character(len=10) :: strtime
200 : : character(len=500) :: msg
201 : : character(len=3),parameter :: day_names(7)=(/'Mon','Tue','Wed','Thu','Fri','Sat','Sun'/)
202 : : character(len=3),parameter :: month_names(12)=(/'Jan','Feb','Mar','Apr','May','Jun',&
203 : : 'Jul','Aug','Sep','Oct','Nov','Dec'/)
204 : :
205 : : ! *************************************************************************
206 : :
207 : : !RELEASE TIME FROM ABIRULES
208 : 2699 : year_rel=2026
209 : 2699 : mm_rel=8
210 : 2699 : version_rel='10.9.3 '
211 : : !END OF RELEASE TIME
212 : :
213 : : !The technique used hereafter is the only one that we have found to obtain
214 : : !perfect transferability across platforms and OS.
215 : : write(iout, '(/,9a,i4,a)' )&
216 : 2699 : & '.Version ',trim(code_version),' of ',trim(code_name),'. v',version_rel,'released ',month_names(mm_rel),' ',year_rel,'.'
217 : : #if defined HAVE_MPI
218 : 2699 : write(iout, '(a,a,a,/)' ) '.(MPI version, prepared for a ',build_target,' computer) '
219 : : #else
220 : : write(iout, '(a,a,a,/)' ) '.(sequential version, prepared for a ',build_target,' computer) '
221 : : #endif
222 : :
223 : : !GNU GPL license
224 : : write(iout, '(a,/,a,a,a,/,a,/,a,/,a,/)' ) &
225 : 2699 : '.Copyright (C) 1998-2026 ABINIT group . ',&
226 : 2699 : ' ',trim(code_name),' comes with ABSOLUTELY NO WARRANTY.',&
227 : 2699 : ' It is free software, and you are welcome to redistribute it',&
228 : 2699 : ' under certain conditions (GNU General Public License,',&
229 : 5398 : ' see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt).'
230 : :
231 [ + + ]: 2699 : if(trim(code_name)=='OPTIC')then
232 : : write(iout, '(a,a,a,/,a,/,a,/,a,/,a,/,a,/,a,/)' ) &
233 : 14 : ' ',trim(code_name),' has originally been developed by',&
234 : 14 : ' Sangeeta Sharma and incorporated in ABINIT with the help of M. Verstraete.',&
235 : 14 : ' Please refer to : ',&
236 : 14 : ' S. Sharma, J. K. Dewhurst and C. Ambrosch-Draxl, Phys. Rev. B 67, 165332 (2003), and',&
237 : 14 : ' S. Sharma and C. Ambrosch-Draxl, Physica Scripta T 109 (2004).',&
238 : 14 : '- URLs and DOI at https://docs.abinit.org/theory/bibliography/#sharma2003',&
239 : 28 : '- and https://docs.abinit.org/theory/bibliography/#sharma2004'
240 : : end if
241 : :
242 : : write(iout, '(a,/,a,/,a,/,a,/,a)' ) &
243 : 2699 : ' ABINIT is a project of the Universite Catholique de Louvain,',&
244 : 2699 : ' Corning Inc. and other collaborators, see ~abinit/doc/developers/contributors.txt .',&
245 : 2699 : ' Please read https://docs.abinit.org/theory/acknowledgments for suggested',&
246 : 2699 : ' acknowledgments of the ABINIT effort.',&
247 : 5398 : ' For more information, see https://www.abinit.org .'
248 : :
249 : : !Get year, month and day
250 : 2699 : call date_and_time(strdat,strtime,strzone,values)
251 : 2699 : year=values(1)
252 : 2699 : mm=values(2)
253 : 2699 : dd=values(3)
254 : :
255 : : !Get day of the week
256 [ + - ]: 2699 : if (mm.gt.2) then
257 : 2699 : jy=year
258 : 2699 : jm=mm+1
259 : : else
260 : 0 : jy=year-1
261 : 0 : jm=mm+13
262 : : end if
263 : 2699 : jdn=int(365.25d0*jy)+int(30.6001d0*jm)+dd+1720995
264 : 2699 : ja=int(0.01d0*jy)
265 : 2699 : jdn=jdn+2-ja+int(quarter*ja)
266 : 2699 : day=mod(jdn,7)+1
267 : :
268 : : ! Print date in nice format (* new format *)
269 : : write(iout, '(/,a,a,1x,i2,1x,a,1x,i4,a,/,a,i2.2,a,i2.2,a)' ) &
270 : 2699 : '.Starting date : ',day_names(day),dd,month_names(mm),year,'.','- ( at ',values(5),'h',values(6),' )'
271 : 2699 : write(iout,*)' '
272 : :
273 : : !Impose a maximal life cycle of 3 years
274 [ + - - + : 2699 : if(year>year_rel+3 .or. (year==year_rel+3 .and. mm>mm_rel) ) then
- - ]
275 : : write(msg, '(5a,i4,5a)' )&
276 : 0 : '- The starting date is more than 3 years after the initial release',ch10,&
277 : 0 : '- of this version of ABINIT, namely ',month_names(mm_rel),' ',year_rel,'.',ch10,&
278 : 0 : '- This version of ABINIT is not supported anymore.',ch10,&
279 : 0 : '- Action: please, switch to a more recent version of ABINIT.'
280 : 0 : call wrtout(iout,msg,'COLL')
281 : :
282 : : ! Gives a warning beyond 2 years
283 [ + - - + : 2699 : else if(year>year_rel+2 .or. (year==year_rel+2 .and. mm>mm_rel) ) then
- - ]
284 : : write(msg, '(5a,i4,6a)' )&
285 : 0 : '- The starting date is more than 2 years after the initial release',ch10,&
286 : 0 : '- of this version of ABINIT, namely ',month_names(mm_rel),' ',year_rel,'.',ch10,&
287 : 0 : '- Note that the use beyond 3 years after the release will not be supported.',ch10,&
288 : 0 : '- Action: please, switch to a more recent version of ABINIT.',ch10
289 : 0 : call wrtout(iout,msg,'COLL')
290 : : end if
291 : :
292 : 2699 : end subroutine herald
293 : : !!***
294 : :
295 : : !!****f* m_specialmsg/wrtout_unit
296 : : !! NAME
297 : : !! wrtout_unit
298 : : !!
299 : : !! FUNCTION
300 : : !! Organizes the sequential or parallel version of the write intrinsic
301 : : !! Also allows to treat correctly the write operations for Unix (+DOS) and MacOS.
302 : : !!
303 : : !! INPUTS
304 : : !! msg=(character(len=*)) message to be written
305 : : !! unit=unit number for writing. The named constant dev_null defined in defs_basis can be used to avoid any printing.
306 : : !! [mode_paral]= --optional argument--
307 : : !! 'COLL' if all procs are calling the routine with the same message to be written once only. Default.
308 : : !! 'PERS' if the procs are calling the routine with different messages each to be written,
309 : : !! or if one proc is calling the routine
310 : : !! "INIT" to change the rank of the master node that prints the message if "COLL" is used.
311 : : !! [do_flush]=True to flush the unit. Defaults to .False.
312 : : !! [newlines]: Number of new lines added after message. Default 0
313 : : !! [pre_newlines]: Number of new lines added vefore message. Default 0
314 : : !!
315 : : !! OUTPUT
316 : : !! (only writing)
317 : : !!
318 : : !! SOURCE
319 : :
320 : 8868145 : subroutine wrtout_unit(unit, msg, mode_paral, do_flush, newlines, pre_newlines)
321 : :
322 : : !Arguments ------------------------------------
323 : : integer,intent(in) :: unit
324 : : character(len=*),intent(in) :: msg
325 : : character(len=*),optional,intent(in) :: mode_paral
326 : : logical,optional,intent(in) :: do_flush
327 : : integer,optional,intent(in) :: newlines, pre_newlines
328 : :
329 : : !Local variables-------------------------------
330 : : integer,save :: master = 0
331 : : integer :: comm, me, nproc, my_newlines, ii, my_pre_newlines
332 : : integer,save :: cached_comm = -666777, cached_me=-1, cached_nproc=-1
333 : : logical :: my_flush
334 : 8868145 : character(len=len(msg)+50) :: string
335 : : character(len=500) :: my_mode_paral
336 : : !******************************************************************
337 : :
338 [ + + ]: 7284042 : if (unit == std_out .and. .not. do_write_log) return
339 [ + + ]: 7574927 : if (unit == dev_null) return
340 : : !if (.not. is_open(unit)) return
341 : :
342 [ + + + + ]: 7526608 : my_mode_paral = "COLL"; if (present(mode_paral)) my_mode_paral = trim(mode_paral)
343 [ + + ]: 7526608 : my_flush = .false.; if (present(do_flush)) my_flush = do_flush
344 [ + + ]: 7526608 : my_newlines = 0; if (present(newlines)) my_newlines = newlines
345 [ + + ]: 7526608 : my_pre_newlines = 0; if (present(pre_newlines)) my_pre_newlines = pre_newlines
346 : :
347 : : ! Communicator is xmpi_world by default, except for the parallelization over images
348 [ + - ]: 7526608 : if (abinit_comm_output /= -1) then
349 : 7526608 : comm = abinit_comm_output
350 : : else
351 : 0 : comm = xmpi_world
352 : : end if
353 : :
354 [ + + ]: 7526608 : if (comm /= cached_comm) then
355 : : ! Determine who I am in comm and cache results
356 : 1841 : me = xmpi_comm_rank(comm); nproc = xmpi_comm_size(comm)
357 : 1841 : cached_comm = comm; cached_me = me ; cached_nproc = nproc
358 : : else
359 : 7524767 : me = cached_me; nproc = cached_nproc
360 : : end if
361 : :
362 [ + + + + ]: 7526608 : if (my_mode_paral == 'COLL' .or. nproc == 1) then
363 [ + + ]: 7452308 : if (me == master) then
364 [ + + ]: 7264935 : if (my_pre_newlines /= 0) then
365 [ + + ]: 3416 : do ii=1,my_pre_newlines; write(unit, "(a)")""; end do
366 : : end if
367 : 7264935 : call wrtout_myproc(unit, msg, do_flush=my_flush)
368 [ + + ]: 7264935 : if (my_newlines /= 0) then
369 [ + + ]: 1218 : do ii=1,my_newlines; write(unit, "(a)")""; end do
370 : : end if
371 : : end if
372 : :
373 [ + - ]: 74300 : else if (my_mode_paral == 'PERS') then
374 [ - + ]: 74300 : if (my_pre_newlines /= 0) then
375 [ # # ]: 0 : do ii=1,my_pre_newlines; write(unit, "(a)")""; end do
376 : : end if
377 : 74300 : call write_lines(unit,msg)
378 [ - + ]: 74300 : if (my_newlines /= 0) then
379 [ # # ]: 0 : do ii=1,my_newlines; write(unit, "(a)")""; end do
380 : : end if
381 : : ! Flush unit
382 [ + + ]: 74300 : if (my_flush) call flush_unit(unit)
383 : :
384 [ # # ]: 0 : else if (my_mode_paral == 'INIT') then
385 : 0 : master = unit
386 : :
387 : : else
388 : : !print *, trim(my_mode_paral)
389 : 0 : write(string,'(7a)')ch10,&
390 : 0 : 'wrtout_unit: ERROR -',ch10,&
391 : 0 : ' Unknown write mode: ',trim(my_mode_paral),ch10,&
392 : 0 : ' Continuing anyway ...'
393 : 0 : write(unit, '(A)' ) trim(string)
394 : : end if
395 : :
396 [ + + ]: 8868145 : end subroutine wrtout_unit
397 : : !!***
398 : :
399 : : !!****f* m_specialmsg/wrtout_units
400 : : !! NAME
401 : : !! wrtout_units
402 : : !!
403 : : !! FUNCTION
404 : : !! Write string to multiple units. Wraps wrtout_unit
405 : : !!
406 : : !! INPUTS
407 : : !! msg=(character(len=*)) message to be written
408 : : !! units=unit number for writing. The named constant dev_null defined in defs_basis can be used to avoid any printing.
409 : : !! [mode_paral]= --optional argument--
410 : : !! 'COLL' if all procs are calling the routine with the same message to be written once only. Default.
411 : : !! 'PERS' if the procs are calling the routine with different messages each to be written,
412 : : !! or if one proc is calling the routine
413 : : !! "INIT" to change the rank of the master node that prints the message if "COLL" is used.
414 : : !! [do_flush]=True to flush the unit. Defaults to .False.
415 : : !! [newlines]: Number of new lines added after message. Default 0
416 : : !! [pre_newlines]: Number of new lines added vefore message. Default 0
417 : : !!
418 : : !! OUTPUT
419 : : !! (only writing)
420 : : !!
421 : : !! SOURCE
422 : :
423 : 978298 : subroutine wrtout_units(units, msg, mode_paral, do_flush, newlines, pre_newlines)
424 : :
425 : : !Arguments ------------------------------------
426 : : integer,intent(in) :: units(:)
427 : : character(len=*),intent(in) :: msg
428 : : character(len=*),optional,intent(in) :: mode_paral
429 : : logical,optional,intent(in) :: do_flush
430 : : integer,optional,intent(in) :: newlines, pre_newlines
431 : :
432 : : !Local variables-------------------------------
433 : : !scalars
434 : : integer :: ii, cnt, my_newlines, my_pre_newlines
435 : : logical :: my_flush
436 : : character(len=500) :: my_mode_paral
437 : : !arrays
438 : 978298 : integer :: my_units(size(units))
439 : :
440 : : !******************************************************************
441 : :
442 [ + + + - ]: 489149 : my_mode_paral = "COLL"; if (present(mode_paral)) my_mode_paral = mode_paral
443 [ + + ]: 489149 : my_flush = .false.; if (present(do_flush)) my_flush = do_flush
444 [ + + ]: 489149 : my_newlines = 0; if (present(newlines)) my_newlines = newlines
445 [ + + ]: 489149 : my_pre_newlines = 0; if (present(pre_newlines)) my_pre_newlines = pre_newlines
446 : :
447 : : ! Remove duplicated units (if any)
448 : 489149 : my_units(1) = units(1); cnt = 1
449 [ + + ]: 727614 : do ii=2,size(units)
450 [ + + + + : 470631 : if (any(units(ii) == my_units(1:cnt))) cycle
+ + ]
451 : 232073 : cnt = cnt + 1
452 : 727614 : my_units(cnt) = units(ii)
453 : : end do
454 : :
455 [ + + ]: 1210371 : do ii=1,cnt
456 : : call wrtout_unit(my_units(ii), msg, mode_paral=my_mode_paral, &
457 : 1210371 : do_flush=my_flush, newlines=my_newlines, pre_newlines=my_pre_newlines)
458 : : end do
459 : :
460 [ - + ]: 489149 : end subroutine wrtout_units
461 : : !!***
462 : :
463 : : !----------------------------------------------------------------------
464 : :
465 : : !!****f* m_specialmsg/wrtout_myproc
466 : : !! NAME
467 : : !! wrtout_myproc
468 : : !!
469 : : !! FUNCTION
470 : : !! Do the output for one proc. For parallel or sequential output use wrtout()
471 : : !! instead. Also allows to treat correctly the write operations for Unix (+DOS) and MacOS.
472 : : !!
473 : : !! INPUTS
474 : : !! unit=unit number for writing
475 : : !! msg=(character(len=*)) message to be written
476 : : !! [do_flush]=True to flush the unit. Defaults to .False.
477 : : !!
478 : : !! OUTPUT
479 : : !! (only writing)
480 : : !!
481 : : !! SOURCE
482 : :
483 : 7264935 : subroutine wrtout_myproc(unit, msg, do_flush) ! optional argument
484 : :
485 : : !Arguments ------------------------------------
486 : : !scalars
487 : : integer,intent(in) :: unit
488 : : character(len=*),intent(in) :: msg
489 : : logical,optional,intent(in) :: do_flush
490 : :
491 : : !Local variables-------------------------------
492 : : !scalars
493 : : logical :: print_std_err
494 : :
495 : : !******************************************************************
496 : :
497 : : print_std_err = (unit == std_out .and. std_out /= std_err .and. &
498 [ + + + - : 7264935 : (index(trim(msg), 'BUG') /= 0 .or. index(trim(msg), 'ERROR') /= 0))
+ + + + ]
499 : :
500 : : ! Print message
501 : 7264935 : call write_lines(unit, msg)
502 [ + + ]: 7264935 : if (print_std_err) call write_lines(std_err, msg)
503 : :
504 : : ! Append "Contact Abinit group" to BUG messages
505 [ + + ]: 7264935 : if (index(trim(msg), 'BUG') /= 0 )then
506 : 2 : write(unit, '(a)' ) ' Action: contact ABINIT group (please attach the output of `abinit -b`)'
507 : 2 : write(unit,*)
508 [ + + ]: 2 : if (print_std_err) then
509 : 1 : write(std_err, '(a)' ) ' Action: contact ABINIT group (please attach the output of `abinit -b`)'
510 : 1 : write(std_err,*)
511 : : end if
512 : : end if
513 : :
514 : : ! Count the number of warnings and comments. Only take into
515 : : ! account unit std_out, in order not to duplicate these numbers.
516 [ + + + + ]: 7264935 : if (index(trim(msg), 'WARNING') /= 0 .and. unit==std_out) call specialmsg_setcount(n_add_warning=1)
517 [ + + + + ]: 7264935 : if (index(trim(msg), 'COMMENT') /= 0 .and. unit==std_out) call specialmsg_setcount(n_add_comment=1)
518 [ - + ]: 7264935 : if (index(trim(msg), 'Exit') /= 0 ) call specialmsg_setcount(n_add_exit=1)
519 : :
520 : : ! Flush unit
521 [ + - ]: 7264935 : if (present(do_flush)) then
522 [ + + ]: 7264935 : if (do_flush) call flush_unit(unit)
523 : : end if
524 : : #ifdef DEBUG_MODE
525 : : call flush_unit(unit)
526 : : if (print_std_err) call flush_unit(std_err)
527 : : #endif
528 : :
529 : 7264935 : end subroutine wrtout_myproc
530 : : !!***
531 : :
532 : : end module m_specialmsg
533 : : !!***
|
