TABLE OF CONTENTS


ABINIT/m_specialmsg [ Modules ]

[ Top ] [ Modules ]

NAME

  m_specialmsg

FUNCTION

  This module contains tools to deal with special messages counters.
  Special messages= WARNING, COMMENT, EXIT

COPYRIGHT

 Copyright (C) 2008-2024 ABINIT group (MT,XG)
 This file is distributed under the terms of the
 GNU General Public License, see ~abinit/COPYING
 or http://www.gnu.org/copyleft/gpl.txt .

SOURCE

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

m_specialmsg/herald [ Functions ]

[ Top ] [ m_specialmsg ] [ Functions ]

NAME

  herald

FUNCTION

  Prints out a message to unit iout giving info about current
  code, version of code, platform, and starting date.

INPUTS

  code_name= code name
  code_version= code version
  iout=unit number for output

OUTPUT

  (only writing)

SOURCE

186 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=8) :: strdat
198  character(len=10) :: strtime
199  character(len=500) :: msg
200  character(len=3),parameter :: day_names(7)=(/'Mon','Tue','Wed','Thu','Fri','Sat','Sun'/)
201  character(len=3),parameter :: month_names(12)=(/'Jan','Feb','Mar','Apr','May','Jun',&
202                                                  'Jul','Aug','Sep','Oct','Nov','Dec'/)
203 
204 ! *************************************************************************
205 
206 !RELEASE TIME FROM ABIRULES
207  year_rel=2024
208  mm_rel=02
209 !END OF RELEASE TIME
210 
211 !The technique used hereafter is the only one that we have found to obtain
212 !perfect transferability across platforms and OS.
213  write(iout, '(/,a,a,a,a,a)' ) '.Version ',trim(code_version),' of ',trim(code_name),' '
214 #if defined HAVE_MPI
215  write(iout, '(a,a,a,/)' ) '.(MPI version, prepared for a ',build_target,' computer) '
216 #else
217  write(iout, '(a,a,a,/)' ) '.(sequential version, prepared for a ',build_target,' computer) '
218 #endif
219 
220 !GNU GPL license
221  write(iout, '(a,/,a,a,a,/,a,/,a,/,a,/)' ) &
222  '.Copyright (C) 1998-2022 ABINIT group . ',&
223  ' ',trim(code_name),' comes with ABSOLUTELY NO WARRANTY.',&
224  ' It is free software, and you are welcome to redistribute it',&
225  ' under certain conditions (GNU General Public License,',&
226  ' see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt).'
227 
228  if(trim(code_name)=='OPTIC')then
229    write(iout, '(a,a,a,/,a,/,a,/,a,/,a,/,a,/,a,/)' ) &
230    ' ',trim(code_name),' has originally been developed by',&
231    ' Sangeeta Sharma and incorporated in ABINIT with the help of M. Verstraete.',&
232    ' Please refer to : ',&
233    ' S. Sharma, J. K. Dewhurst and C. Ambrosch-Draxl, Phys. Rev. B 67, 165332 (2003), and',&
234    ' S. Sharma and C. Ambrosch-Draxl, Physica Scripta T 109 (2004).',&
235    '- URLs and DOI at https://docs.abinit.org/theory/bibliography/#sharma2003',&
236    '- and https://docs.abinit.org/theory/bibliography/#sharma2004'
237  end if
238 
239  write(iout, '(a,/,a,/,a,/,a,/,a)' ) &
240  ' ABINIT is a project of the Universite Catholique de Louvain,',&
241  ' Corning Inc. and other collaborators, see ~abinit/doc/developers/contributors.txt .',&
242  ' Please read https://docs.abinit.org/theory/acknowledgments for suggested',&
243  ' acknowledgments of the ABINIT effort.',&
244  ' For more information, see https://www.abinit.org .'
245 
246 !Get year, month and day
247  call date_and_time(strdat,strtime,strzone,values)
248  year=values(1)
249  mm=values(2)
250  dd=values(3)
251 
252 !Get day of the week
253  if (mm.gt.2) then
254    jy=year
255    jm=mm+1
256  else
257    jy=year-1
258    jm=mm+13
259  end if
260  jdn=int(365.25d0*jy)+int(30.6001d0*jm)+dd+1720995
261  ja=int(0.01d0*jy)
262  jdn=jdn+2-ja+int(quarter*ja)
263  day=mod(jdn,7)+1
264 
265 !Print date in nice format (* new format *)
266  write(iout, '(/,a,a,1x,i2,1x,a,1x,i4,a,/,a,i2.2,a,i2.2,a)' ) &
267  '.Starting date : ',day_names(day),dd,month_names(mm),year,'.','- ( at ',values(5),'h',values(6),' )'
268  write(iout,*)' '
269 
270 !Impose a maximal life cycle of 3 years
271  if(year>year_rel+3 .or. (year==year_rel+3 .and. mm>mm_rel) ) then
272    write(msg, '(5a,i4,5a)' )&
273    '- The starting date is more than 3 years after the initial release',ch10,&
274    '- of this version of ABINIT, namely ',month_names(mm_rel),' ',year_rel,'.',ch10,&
275    '- This version of ABINIT is not supported anymore.',ch10,&
276    '- Action: please, switch to a more recent version of ABINIT.'
277    call wrtout(iout,msg,'COLL')
278 
279 !  Gives a warning beyond 2 years
280  else if(year>year_rel+2 .or. (year==year_rel+2 .and. mm>mm_rel) ) then
281    write(msg, '(5a,i4,6a)' )&
282    '- The starting date is more than 2 years after the initial release',ch10,&
283    '- of this version of ABINIT, namely ',month_names(mm_rel),' ',year_rel,'.',ch10,&
284    '- Note that the use beyond 3 years after the release will not be supported.',ch10,&
285    '- Action: please, switch to a more recent version of ABINIT.',ch10
286    call wrtout(iout,msg,'COLL')
287  end if
288 
289 end subroutine herald

m_specialmsg/specialmsg_getcount [ Functions ]

[ Top ] [ m_specialmsg ] [ Functions ]

NAME

  specialmsg_getcount

FUNCTION

  Get the values of the counters of special messages (WARNING, COMMENT)

INPUTS

OUTPUT

  ncomment= number of COMMENTs in log file
  nwarning= number of WARNINGs in log file
  nexit= 1 if exit requested

SOURCE

113 subroutine specialmsg_getcount(ncomment,nwarning,nexit)
114 
115 !Arguments ------------------------------------
116  integer,intent(out) :: ncomment,nexit,nwarning
117 
118 ! *********************************************************************
119 
120  ncomment=COMMENT_COUNT
121  nwarning=WARNING_COUNT
122  nexit   =EXIT_FLAG
123 
124 end subroutine specialmsg_getcount

m_specialmsg/specialmsg_mpisum [ Functions ]

[ Top ] [ m_specialmsg ] [ Functions ]

NAME

  specialmsg_mpisum

FUNCTION

  Reduce the counters of special messages (WARNING, COMMENTS, EXIT) over a MPI communicator

INPUTS

  mpicomm= MPI communicator

OUTPUT

  (only counters updated)

SOURCE

144 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   buf(1)=COMMENT_COUNT;buf(2)=WARNING_COUNT;buf(3)=EXIT_FLAG
156 
157   call xmpi_sum(buf,mpicomm,ierr)
158 
159   COMMENT_COUNT=buf(1)
160   WARNING_COUNT=buf(2)
161   EXIT_FLAG=buf(3) ; if (EXIT_FLAG/=0) EXIT_FLAG=1
162 
163 end subroutine specialmsg_mpisum

m_specialmsg/specialmsg_setcount [ Functions ]

[ Top ] [ m_specialmsg ] [ Functions ]

NAME

  specialmsg_setcount

FUNCTION

  Update the counters of special messages (WARNING, COMMENTS, EXIT) printed in log file

INPUTS

  [n_add_comment]= (optional) number of comments to add to the counter
  [n_add_exit]   = (optional) number of exit messages to add to the counter
  [n_add_warning]= (optional) number of warnings to add to the counter

OUTPUT

  (only counters updated)

SOURCE

78 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  if (PRESENT(n_add_comment)) COMMENT_COUNT=COMMENT_COUNT+n_add_comment
86  if (PRESENT(n_add_warning)) WARNING_COUNT=WARNING_COUNT+n_add_warning
87  if (PRESENT(n_add_exit)) then
88    EXIT_FLAG=EXIT_FLAG+n_add_exit
89    if (EXIT_FLAG>1) EXIT_FLAG=1
90  end if
91 
92 end subroutine specialmsg_setcount

m_specialmsg/wrtout_myproc [ Functions ]

[ Top ] [ m_specialmsg ] [ Functions ]

NAME

  wrtout_myproc

FUNCTION

  Do the output for one proc. For parallel or sequential output use wrtout()
  instead. Also allows to treat correctly the write operations for Unix (+DOS) and MacOS.

INPUTS

  unit=unit number for writing
  msg=(character(len=*)) message to be written
  [do_flush]=True to flush the unit. Defaults to .False.

OUTPUT

  (only writing)

SOURCE

474 subroutine wrtout_myproc(unit, msg, do_flush) ! optional argument
475 
476 !Arguments ------------------------------------
477 !scalars
478  integer,intent(in) :: unit
479  character(len=*),intent(in) :: msg
480  logical,optional,intent(in) :: do_flush
481 
482 !Local variables-------------------------------
483 !scalars
484  logical :: print_std_err
485 
486 !******************************************************************
487 
488  print_std_err = (unit == std_out .and. std_out /= std_err .and. &
489    (index(trim(msg), 'BUG') /= 0 .or. index(trim(msg), 'ERROR') /= 0))
490 
491  ! Print message
492  call write_lines(unit, msg)
493  if (print_std_err) call write_lines(std_err, msg)
494 
495  ! Append "Contact Abinit group" to BUG messages
496  if (index(trim(msg), 'BUG') /= 0 )then
497    write(unit, '(a)' ) '  Action: contact ABINIT group (please attach the output of `abinit -b`)'
498    write(unit,*)
499    if (print_std_err) then
500      write(std_err, '(a)' ) '  Action: contact ABINIT group (please attach the output of `abinit -b`)'
501      write(std_err,*)
502    end if
503  end if
504 
505  ! Count the number of warnings and comments. Only take into
506  ! account unit std_out, in order not to duplicate these numbers.
507  if (index(trim(msg), 'WARNING') /= 0 .and. unit==std_out) call specialmsg_setcount(n_add_warning=1)
508  if (index(trim(msg), 'COMMENT') /= 0 .and. unit==std_out) call specialmsg_setcount(n_add_comment=1)
509  if (index(trim(msg), 'Exit') /= 0 ) call specialmsg_setcount(n_add_exit=1)
510 
511  ! Flush unit
512  if (present(do_flush)) then
513    if (do_flush) call flush_unit(unit)
514  end if
515 #ifdef DEBUG_MODE
516  call flush_unit(unit)
517  if (print_std_err) call flush_unit(std_err)
518 #endif
519 
520 end subroutine wrtout_myproc

m_specialmsg/wrtout_unit [ Functions ]

[ Top ] [ m_specialmsg ] [ Functions ]

NAME

  wrtout_unit

FUNCTION

  Organizes the sequential or parallel version of the write intrinsic
  Also allows to treat correctly the write operations for Unix (+DOS) and MacOS.

INPUTS

  msg=(character(len=*)) message to be written
  unit=unit number for writing. The named constant dev_null defined in defs_basis can be used to avoid any printing.
  [mode_paral]= --optional argument--
   'COLL' if all procs are calling the routine with the same message to be written once only. Default.
   'PERS' if the procs are calling the routine with different messages each to be written,
          or if one proc is calling the routine
   "INIT" to change the rank of the master node that prints the message if "COLL" is used.
  [do_flush]=True to flush the unit. Defaults to .False.
  [newlines]: Number of new lines added after message. Default 0
  [pre_newlines]: Number of new lines added vefore message. Default 0

OUTPUT

  (only writing)

SOURCE

317 subroutine wrtout_unit(unit, msg, mode_paral, do_flush, newlines, pre_newlines)
318 
319 !Arguments ------------------------------------
320  integer,intent(in) :: unit
321  character(len=*),intent(in) :: msg
322  character(len=*),optional,intent(in) :: mode_paral
323  logical,optional,intent(in) :: do_flush
324  integer,optional,intent(in) :: newlines, pre_newlines
325 
326 !Local variables-------------------------------
327  integer,save :: master=0
328  integer :: comm, me, nproc, my_newlines, ii,  my_pre_newlines
329  logical :: my_flush
330  character(len=len(msg)+50) :: string
331  character(len=500) :: my_mode_paral
332 
333 !******************************************************************
334 
335  if (unit == std_out .and. .not. do_write_log) return
336  if (unit == dev_null) return
337  !if (.not. is_open(unit)) return
338 
339  my_mode_paral = "COLL"; if (present(mode_paral)) my_mode_paral = mode_paral
340  my_flush = .false.; if (present(do_flush)) my_flush = do_flush
341  my_newlines = 0; if (present(newlines)) my_newlines = newlines
342  my_pre_newlines = 0; if (present(pre_newlines)) my_pre_newlines = pre_newlines
343 
344  ! Communicator is xmpi_world by default, except for the parallelization over images
345  if (abinit_comm_output /= -1) then
346    comm = abinit_comm_output
347  else
348    comm = xmpi_world
349  end if
350 
351  ! Determine who I am in COMM_WORLD
352  me = xmpi_comm_rank(comm); nproc = xmpi_comm_size(comm)
353 
354  if (my_mode_paral == 'COLL' .or. nproc == 1) then
355    if (me == master) then
356      if (my_pre_newlines /= 0) then
357        do ii=1,my_pre_newlines; write(unit, "(a)")""; end do
358      end if
359      call wrtout_myproc(unit, msg, do_flush=my_flush)
360      if (my_newlines /= 0) then
361        do ii=1,my_newlines; write(unit, "(a)")""; end do
362      end if
363    end if
364 
365  else if (my_mode_paral == 'PERS') then
366    if (my_pre_newlines /= 0) then
367      do ii=1,my_pre_newlines; write(unit, "(a)")""; end do
368    end if
369    call write_lines(unit,msg)
370    if (my_newlines /= 0) then
371      do ii=1,my_newlines; write(unit, "(a)")""; end do
372    end if
373    ! Flush unit
374    if (my_flush) call flush_unit(unit)
375 
376  else if (my_mode_paral == 'INIT') then
377    master = unit
378 
379  else
380    write(string,'(7a)')ch10,&
381    'wrtout_unit: ERROR -',ch10,&
382    '  Unknown write mode: ',trim(my_mode_paral),ch10,&
383    '  Continuing anyway ...'
384    write(unit, '(A)' ) trim(string)
385  end if
386 
387 end subroutine wrtout_unit

m_specialmsg/wrtout_units [ Functions ]

[ Top ] [ m_specialmsg ] [ Functions ]

NAME

  wrtout_units

FUNCTION

  Write string to multiple units. Wraps wrtout_unit

INPUTS

  msg=(character(len=*)) message to be written
  units=unit number for writing. The named constant dev_null defined in defs_basis can be used to avoid any printing.
  [mode_paral]= --optional argument--
   'COLL' if all procs are calling the routine with the same message to be written once only. Default.
   'PERS' if the procs are calling the routine with different messages each to be written,
          or if one proc is calling the routine
   "INIT" to change the rank of the master node that prints the message if "COLL" is used.
  [do_flush]=True to flush the unit. Defaults to .False.
  [newlines]: Number of new lines added after message. Default 0
  [pre_newlines]: Number of new lines added vefore message. Default 0

OUTPUT

  (only writing)

SOURCE

414 subroutine wrtout_units(units, msg, mode_paral, do_flush, newlines, pre_newlines)
415 
416 !Arguments ------------------------------------
417  integer,intent(in) :: units(:)
418  character(len=*),intent(in) :: msg
419  character(len=*),optional,intent(in) :: mode_paral
420  logical,optional,intent(in) :: do_flush
421  integer,optional,intent(in) :: newlines, pre_newlines
422 
423 !Local variables-------------------------------
424 !scalars
425  integer :: ii, cnt, my_newlines, my_pre_newlines
426  logical :: my_flush
427  character(len=500) :: my_mode_paral
428 !arrays
429  integer :: my_units(size(units))
430 
431 !******************************************************************
432 
433  my_mode_paral = "COLL"; if (present(mode_paral)) my_mode_paral = mode_paral
434  my_flush = .false.; if (present(do_flush)) my_flush = do_flush
435  my_newlines = 0; if (present(newlines)) my_newlines = newlines
436  my_pre_newlines = 0; if (present(pre_newlines)) my_pre_newlines = pre_newlines
437 
438  ! Remove duplicated units (if any)
439  my_units(1) = units(1); cnt = 1
440  do ii=2,size(units)
441    if (any(units(ii) == my_units(1:cnt))) cycle
442    cnt = cnt + 1
443    my_units(cnt) = units(ii)
444  end do
445 
446  do ii=1,cnt
447    call wrtout_unit(my_units(ii), msg, mode_paral=my_mode_paral, &
448                     do_flush=my_flush, newlines=my_newlines, pre_newlines=my_pre_newlines)
449  end do
450 
451 end subroutine wrtout_units