TABLE OF CONTENTS


ABINIT/m_libpaw_tools [ Modules ]

[ Top ] [ Modules ]

NAME

  m_libpaw_tools

FUNCTION

  Several libPAW tools: message printing, error handling, string handling...

COPYRIGHT

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

NOTES

  Parts of this module come directly from hide_write & hide_leave src files delivered with ABINIT.

  FOR DEVELOPPERS: in order to preserve the portability of libPAW library,
  please consult ~abinit/src/??_libpaw/libpaw-coding-rules.txt

SOURCE

23 #include "libpaw.h"
24 
25 module m_libpaw_tools
26     
27  USE_DEFS
28  USE_MPI_WRAPPERS
29 
30 #if defined HAVE_YAML
31   use yaml_output
32 #endif
33 #ifdef LIBPAW_HAVE_NETCDF
34   use netcdf
35 #endif
36 
37  implicit none
38 
39  private
40 
41 !PUBLIC FUNCTIONS - MESSAGE HANDLING
42  public  :: libpaw_wrtout         ! Parallel output of messages
43  public  :: libpaw_msg_hndl       ! Basic error handler
44  public  :: libpaw_flush          ! Wrapper for the standard flush routine
45  public  :: libpaw_spmsg_getcount ! Get number of special messages (WARNING/COMMENT) already printed
46  public  :: libpaw_spmsg_mpisum   ! Reduce number of special messages (WARNING/COMMENT) over MPI comm
47  public  :: libpaw_write_comm_set ! Set the MPI communicator used for parallel write
48  public  :: libpaw_log_flag_set   ! Set the flag controlling the filling of the LOG file
49  public  :: libpaw_netcdf_check   ! Stop execution after a NetCDF I/O error
50 
51 !PUBLIC FUNCTIONS - STRING HANDLING
52  public  :: libpaw_basename       ! String, base name extraction from path
53  public  :: libpaw_to_upper       ! String conversion to uppercase
54  public  :: libpaw_lstrip         ! String right blanks removal
55  public  :: libpaw_indent         ! String indentation
56 
57 !PUBLIC FUNCTIONS - IO TOOLS
58  public :: libpaw_get_free_unit  ! Get a free I/O unit
59 
60 !PRIVATE FUNCTIONS
61  private :: libpaw_wrtout_myproc  ! Sequential output of messages
62  private :: libpaw_write_lines    ! OS-compatible string output
63  private :: libpaw_leave          ! Clean exit of F90 routines
64  private :: libpaw_die            ! Clean exit
65  private :: libpaw_lock_and_write ! Write a string to a file with locking mechanism 
66 
67 !PRIVATE VARIABLES
68  integer,save :: LIBPAW_WRITE_COMM=xmpi_world ! Communicator used for the parallel write
69  integer,save :: LIBPAW_COMMENT_COUNT=0           ! Number of COMMENTs printed in log file
70  integer,save :: LIBPAW_WARNING_COUNT=0           ! Number of WARNINGs printed in log file
71  integer,save :: LIBPAW_EXIT_FLAG=0               ! Flag set to 1 if an exit is requested
72  logical,save :: LIBPAW_HAS_LOG_FILE=.TRUE.       ! Flag: True if std output exists
73 
74 !PRIVATE PARAMETERS
75  integer,parameter :: LIBPAW_NULL_UNIT=-1     ! Fake null unit
76  character(len=25),parameter :: LIBPAW_MPIABORTFILE="__LIBPAW_MPIABORTFILE__"
77 #if defined HAVE_OS_WINDOWS
78  character(len=3),parameter :: LIBPAW_NULL_FILE="NUL"
79 #else
80  character(len=9),parameter :: LIBPAW_NULL_FILE="/dev/null"
81 #endif

m_libpaw_tool/libpaw_netcdf_check [ Functions ]

[ Top ] [ Functions ]

NAME

  libpaw_netcdf_check

FUNCTION

  Error handler for Netcdf calls.

INPUTS

  ncerr=Status error returned by the Netcdf library.
  msg=User-defined string with info on the action that was performed
  file= name of the file.
  line= line number.

NOTES

  This routine is usually interfaced with the macros defined in libpaw.h

PARENTS

CHILDREN

      flush,flush_

SOURCE

660 subroutine libpaw_netcdf_check(ncerr,msg,file,line)
661 
662 
663 !This section has been created automatically by the script Abilint (TD).
664 !Do not modify the following lines by hand.
665 #undef ABI_FUNC
666 #define ABI_FUNC 'libpaw_netcdf_check'
667 !End of the abilint section
668 
669  implicit none
670 
671 !Arguments ------------------------------------
672  integer,intent(in) :: ncerr
673  character(len=*),intent(in) :: msg
674  character(len=*),optional,intent(in) :: file
675  integer,optional,intent(in) :: line
676 
677 !Local variables-------------------------------
678  integer :: f90line
679  character(len=500) :: f90name
680  character(len=1024) :: nc_msg 
681  character(len=2048) :: my_msg
682 
683 ! *************************************************************************
684 
685 #ifdef LIBPAW_HAVE_NETCDF
686  if (ncerr /= NF90_NOERR) then
687    if (PRESENT(line)) then
688      f90line=line
689    else 
690      f90line=0
691    end if
692    if (PRESENT(file)) then 
693      f90name = libpaw_basename(file)
694    else
695      f90name='Subroutine Unknown'
696    end if
697    !
698    ! Append Netcdf string to user-defined message.
699    write(nc_msg,'(a,3x,a)')' - NetCDF library returned:',TRIM(nf90_strerror(ncerr))
700    my_msg = TRIM(msg) // TRIM(nc_msg)
701 
702    call libpaw_msg_hndl(my_msg,"ERROR","PERS",f90name,f90line)
703  end if
704 #else
705  call libpaw_die("LIBPAW_HAVE_NETCDF is not defined!")
706 #endif
707 
708 end subroutine libpaw_netcdf_check

m_libpaw_tools/libpaw_basename [ Functions ]

[ Top ] [ m_libpaw_tools ] [ Functions ]

NAME

 libpaw_basename

FUNCTION

  Returns the final component of a pathname (function version).

INPUTS

  string=The input string

NOTES

  This routine comes directly from the BASENAME routine delivered with ABINIT.
  If the input string in not a valid path to a file, a blank strink is returned

SOURCE

1038 pure function libpaw_basename(istr) result(ostr)
1039 
1040 
1041 !This section has been created automatically by the script Abilint (TD).
1042 !Do not modify the following lines by hand.
1043 #undef ABI_FUNC
1044 #define ABI_FUNC 'libpaw_basename'
1045 !End of the abilint section
1046 
1047  implicit none
1048 
1049 !Arguments ------------------------------------
1050  character(len=*),intent(in) :: istr
1051  character(len=LEN_TRIM(istr)) :: ostr
1052 
1053 !Local variables ------------------------------
1054  integer :: ic,nch_trim,nch
1055  character(len=1),parameter :: BLANK=' '
1056  character(len=1),parameter :: DIR_SEPARATOR = '/'
1057 
1058 !************************************************************************
1059 
1060  nch     =LEN     (istr)
1061  nch_trim=LEN_TRIM(istr)
1062 
1063  ic = INDEX (TRIM(istr), DIR_SEPARATOR, back=.TRUE.)
1064  if (ic >= 1 .and. ic <= nch_trim-1) then ! there is stuff after the separator.
1065    ostr = istr(ic+1:nch_trim)
1066  else if (ic==0 .or. ic == nch_trim+1) then ! no separator in string or zero length string,
1067    ostr = TRIM(istr)     ! return trimmed string.
1068  else                    ! (ic == nch_trim) separator is the last char.
1069    ostr = BLANK ! This is not a valid path to a file, return blank.
1070  end if
1071  return
1072 
1073 end function libpaw_basename

m_libpaw_tools/libpaw_die [ Functions ]

[ Top ] [ m_libpaw_tools ] [ Functions ]

NAME

  libpaw_die

FUNCTION

  Stop smoothly the execution in case of unexpected events reporting the
  line number and the file name where the error occurred as well as the 
  MPI rank of the processor.

INPUTS

  msg=String containing additional information on the nature of the problem
  [file]=Name of the f90 file containing the caller
  [line]=Line number of the file where problem occurred

NOTES

  This routine comes directly from the DIE routine delivered with ABINIT.

PARENTS

      m_libpaw_tools

CHILDREN

      flush,flush_

SOURCE

804 subroutine libpaw_die(message,file,line)
805 
806 
807 !This section has been created automatically by the script Abilint (TD).
808 !Do not modify the following lines by hand.
809 #undef ABI_FUNC
810 #define ABI_FUNC 'libpaw_die'
811 !End of the abilint section
812 
813  implicit none
814 
815 !Arguments ------------------------------------
816  integer,optional,intent(in) :: line
817  character(len=*),intent(in) :: message
818  character(len=*),optional,intent(in) :: file
819 
820 !Local variables ------------------------------
821  integer :: rank 
822  integer :: f90line=0
823  character(len=10) :: lnum,strank
824  character(len=500) :: f90name='Subroutine Unknown'
825  character(len=500) :: msg
826 
827 ! *********************************************************************
828 
829  if (PRESENT(line)) f90line=line
830  if (PRESENT(file)) f90name= libpaw_basename(file)
831 
832  rank=xmpi_comm_rank(xmpi_world) !Determine my rank inside world communicator
833 
834  write(lnum,"(i0)") f90line
835  write(strank,"(i0)") rank
836  msg=TRIM(f90name)//':'//TRIM(lnum)//' P'//TRIM(strank)
837  write(msg,'(a,2x,2a,2x,a)') ch10,TRIM(msg),ch10,TRIM(message)
838 
839  call libpaw_wrtout(std_out,msg,'PERS') 
840  call libpaw_leave('PERS')
841 
842 end subroutine libpaw_die

m_libpaw_tools/libpaw_flush [ Functions ]

[ Top ] [ m_libpaw_tools ] [ Functions ]

NAME

  libpaw_flush

FUNCTION

  Wrapper for the standard flush routine
  Available only if the compiler implements this intrinsic procedure.

INPUTS

  unit=Fortran logical Unit number

NOTES

  This routine comes directly from the FLUSH_UNIT routine delivered with ABINIT.

PARENTS

      m_pawrhoij

CHILDREN

      flush,flush_

SOURCE

 982 subroutine libpaw_flush(unit)
 983 
 984 
 985 !This section has been created automatically by the script Abilint (TD).
 986 !Do not modify the following lines by hand.
 987 #undef ABI_FUNC
 988 #define ABI_FUNC 'libpaw_flush'
 989 !End of the abilint section
 990 
 991  implicit none
 992 
 993 !Arguments ------------------------------------
 994  integer,intent(in) :: unit
 995 
 996 !Local variables ------------------------------
 997  integer, parameter :: dev_null=-1
 998  logical :: isopen
 999 
1000 !************************************************************************
1001 
1002  if (unit==dev_null) return
1003 
1004 !FLUSH on unconnected unit is illegal: F95 std., 9.3.5.
1005  inquire(unit=unit,opened=isopen)
1006 
1007 #if defined HAVE_FC_FLUSH
1008  if (isopen) then
1009    call flush(unit)
1010  endif
1011 #elif defined HAVE_FC_FLUSH_
1012  if (isopen) then
1013    call flush_(unit)
1014   end if
1015 #endif
1016 
1017 end subroutine libpaw_flush

m_libpaw_tools/libpaw_get_free_unit [ Functions ]

[ Top ] [ m_libpaw_tools ] [ Functions ]

NAME

  libpaw_get_free_unit

FUNCTION

  Obtain a free logical Fortran unit.

OUTPUT

  The unit number (free unit)
  Raises:
   -1 if no logical unit is free (!)

PARENTS

CHILDREN

SOURCE

923 integer function libpaw_get_free_unit()
924 
925 
926 !This section has been created automatically by the script Abilint (TD).
927 !Do not modify the following lines by hand.
928 #undef ABI_FUNC
929 #define ABI_FUNC 'libpaw_get_free_unit'
930 !End of the abilint section
931 
932  implicit none
933 
934 !Local variables-------------------------------
935  integer,parameter :: MIN_UNIT_NUMBER=10
936 #ifdef FC_NAG
937   integer,parameter :: MAX_UNIT_NUMBER=64    ! There's a serious problem in Nag6.0. In principle
938                                              ! Maximum unit number: 2147483647
939 #else
940  integer,parameter :: MAX_UNIT_NUMBER=1024 
941 #endif
942  integer :: iunt
943  logical :: isopen
944 
945 ! *********************************************************************
946 
947  do iunt=MAX_UNIT_NUMBER,MIN_UNIT_NUMBER,-1
948    inquire(unit=iunt,opened=isopen)
949    if (.not.isopen) then
950       libpaw_get_free_unit=iunt; return
951    end if
952  end do
953  libpaw_get_free_unit=-1
954 
955 end function libpaw_get_free_unit

m_libpaw_tools/libpaw_indent [ Functions ]

[ Top ] [ m_libpaw_tools ] [ Functions ]

NAME

  libpaw_indent

FUNCTION

  Indent text (function version).

INPUTS

   istr=Input string

NOTES

  This routine comes directly from the INDENT routine delivered with ABINIT.

SOURCE

1194 pure function libpaw_indent(istr) result(ostr)
1195 
1196 
1197 !This section has been created automatically by the script Abilint (TD).
1198 !Do not modify the following lines by hand.
1199 #undef ABI_FUNC
1200 #define ABI_FUNC 'libpaw_indent'
1201 !End of the abilint section
1202 
1203  implicit none
1204 
1205 !Arguments ------------------------------------
1206  character(len=*),intent(in) :: istr
1207  character(len=len(istr)*4+4) :: ostr
1208 
1209 !Local variables-------------------------------
1210  character(len=1),parameter :: NCHAR = char(10)
1211  integer,parameter :: n=4
1212  integer :: ii,jj,kk
1213  character(len=1) :: ch
1214 
1215 ! *********************************************************************
1216 
1217  ostr=" "
1218  jj=n
1219  do ii=1,LEN_TRIM(istr)
1220    ch=istr(ii:ii)
1221    jj=jj+1
1222    if (ch==NCHAR) then
1223       ostr(jj:jj)=NCHAR
1224       do kk=jj+1,jj+n
1225         ostr(kk:kk)=" "
1226       end do
1227       jj=jj+n
1228    else
1229      ostr(jj:jj)=ch
1230    end if
1231  end do
1232 
1233 end function libpaw_indent

m_libpaw_tools/libpaw_leave [ Functions ]

[ Top ] [ m_libpaw_tools ] [ Functions ]

NAME

  libpaw_leave

FUNCTION

  Routine for clean exit of f90 code, taking into account possible parallelization.

INPUTS

  mode_paral=
   'COLL' if all procs are calling the routine with the same msg to be written once only
   'PERS' if the procs are calling the routine with different msgs each to be written,
          or if one proc is calling the routine
  [exit_status]=(optional, default=1 or -1, see below) the return code of the routine

OUTPUT

  (only writing)

NOTES

  This routine comes directly from the LEAVE_NEW routine delivered with ABINIT.
  By default, it uses "call exit(1)", that is not completely portable.

PARENTS

      m_libpaw_tools

CHILDREN

      flush,flush_

SOURCE

742 subroutine libpaw_leave(mode_paral,exit_status)
743 
744 
745 !This section has been created automatically by the script Abilint (TD).
746 !Do not modify the following lines by hand.
747 #undef ABI_FUNC
748 #define ABI_FUNC 'libpaw_leave'
749 !End of the abilint section
750 
751  implicit none
752 
753 !Arguments ------------------------------------
754  integer,intent(in),optional :: exit_status
755  character(len=4),intent(in) :: mode_paral
756 
757 !Local variables ------------------------------
758 
759 ! **********************************************************************
760 
761  call libpaw_wrtout(std_out,ch10//' leave_new : decision taken to exit ...','PERS')
762 
763 !Caveat: Do not use MPI collective calls!
764  if (mode_paral=="COLL") then
765    call libpaw_wrtout(std_out,"Why COLL? Are you sure that ALL the processors are calling leave_new?")
766  end if
767 
768  if (present(exit_status)) then
769    call xmpi_abort(exit_status=exit_status)
770  else
771    call xmpi_abort()
772  end if
773 
774 end subroutine libpaw_leave

m_libpaw_tools/libpaw_lock_and_write [ Functions ]

[ Top ] [ m_libpaw_tools ] [ Functions ]

NAME

  libpaw_lock_and_write

FUNCTION

  Writes a string to filename with locking mechanism.

INPUTS

  filename= Name of the file.
  string= Input string.

PARENTS

      m_libpaw_tools

CHILDREN

      flush,flush_

SOURCE

866 subroutine libpaw_lock_and_write(filename,string)
867 
868 
869 !This section has been created automatically by the script Abilint (TD).
870 !Do not modify the following lines by hand.
871 #undef ABI_FUNC
872 #define ABI_FUNC 'libpaw_lock_and_write'
873 !End of the abilint section
874 
875  implicit none
876 
877 !Arguments ------------------------------------
878  character(len=*),intent(in) :: filename,string
879 
880 !Local variables-------------------------------
881  integer :: lock_unit,file_unit
882  character(len=len(filename)+5) :: lock
883 
884 ! *********************************************************************
885 
886  !Try to acquire the lock.
887  lock=trim(filename)//".lock"
888  lock_unit=libpaw_get_free_unit()
889  open(unit=lock_unit,file=trim(lock),status='new',err=99)
890 
891  file_unit=libpaw_get_free_unit()
892  open(unit=file_unit,file=trim(filename),form="formatted")
893  call libpaw_write_lines(file_unit,string)
894  close(lock_unit,status="delete")
895  close(file_unit)
896  return 
897 
898 99 continue
899 
900 end subroutine libpaw_lock_and_write

m_libpaw_tools/libpaw_log_flag_set [ Functions ]

[ Top ] [ m_libpaw_tools ] [ Functions ]

NAME

  libpaw_log_flag_set

FUNCTION

  Set the flag controlling the filling of the LOG file

INPUTS

  log_flag= new value for LOG file flag
            True: the log file is filled; False: no the log file

OUTPUT

PARENTS

      iofn1,m_argparse

CHILDREN

      flush,flush_

SOURCE

612 subroutine libpaw_log_flag_set(log_flag)
613 
614 
615 !This section has been created automatically by the script Abilint (TD).
616 !Do not modify the following lines by hand.
617 #undef ABI_FUNC
618 #define ABI_FUNC 'libpaw_log_flag_set'
619 !End of the abilint section
620 
621  implicit none
622 
623 !Arguments ------------------------------------
624  logical,intent(in) :: log_flag
625  
626 !Local variables ------------------------------
627 
628 ! **********************************************************************
629 
630  LIBPAW_HAS_LOG_FILE=log_flag
631 
632 end subroutine libpaw_log_flag_set

m_libpaw_tools/libpaw_lstrip [ Functions ]

[ Top ] [ m_libpaw_tools ] [ Functions ]

NAME

  libpaw_lstrip

FUNCTION

  Removes leading spaces from the input string.

NOTES

  This routine comes directly from the LSTRIP routine delivered with ABINIT.

SOURCE

1142 pure function libpaw_lstrip(istr) result(ostr)
1143 
1144 
1145 !This section has been created automatically by the script Abilint (TD).
1146 !Do not modify the following lines by hand.
1147 #undef ABI_FUNC
1148 #define ABI_FUNC 'libpaw_lstrip'
1149 !End of the abilint section
1150 
1151  implicit none
1152 
1153 !Arguments ------------------------------------
1154  character(len=*),intent(in) :: istr
1155  character(len=len(istr)) :: ostr
1156 
1157 !Local variables ------------------------------
1158  integer :: ii,jj,lg
1159  character(len=1),parameter :: BLANK=' '
1160 
1161 ! *********************************************************************
1162 
1163  lg=LEN(istr)
1164  do ii=1,lg
1165    if (istr(ii:ii)/=BLANK) EXIT
1166  end do
1167 
1168  ostr = " "
1169  do jj=1,lg-ii+1
1170    ostr(jj:jj) = istr(ii:ii)
1171    ii=ii+1
1172  end do
1173 
1174 end function libpaw_lstrip

m_libpaw_tools/libpaw_msg_hndl [ Functions ]

[ Top ] [ m_libpaw_tools ] [ Functions ]

NAME

  libpaw_msg_hndl

FUNCTION

  Basic error handler.

INPUTS

  msg=string containing additional information on the nature of the problem
  level=string defining the type of problem. Possible values are:
   COMMENT, WARNING, ERROR,BUG
  mode_paral=Either "COLL" or "PERS".
  [line]=line number of the file where problem occurred (optional)
  [file]=name of the f90 file containing the caller (optional)

OUTPUT

  (only writing)

NOTES

  This routine comes directly from the MSG_HNDL routine delivered with ABINIT.

PARENTS

      m_libpaw_tools

CHILDREN

      flush,flush_

SOURCE

378 subroutine libpaw_msg_hndl(msg,level,mode_paral,file,line)
379 
380 
381 !This section has been created automatically by the script Abilint (TD).
382 !Do not modify the following lines by hand.
383 #undef ABI_FUNC
384 #define ABI_FUNC 'libpaw_msg_hndl'
385 !End of the abilint section
386 
387  implicit none
388 
389 !Arguments ------------------------------------
390  integer,optional,intent(in) :: line
391  character(len=*),intent(in) :: level,msg,mode_paral
392  character(len=*),optional,intent(in) :: file
393 
394 !Local variables ------------------------------
395  logical :: file_exists
396  character(len=500) :: f90name='Unknown'
397  character(len=LEN(msg)) :: my_msg 
398  character(len=MAX(4*LEN(msg),2000)) :: sbuf
399 
400 ! *********************************************************************
401 
402  my_msg=libpaw_lstrip(msg)
403 
404  write(sbuf,'(3a)') ch10,"--- !",TRIM(level)
405  if (PRESENT(file)) then
406    f90name=libpaw_basename(file)
407    write(sbuf,'(4a)') trim(sbuf),ch10,"src_file: ",TRIM(f90name)
408  end if
409  if (PRESENT(line)) then
410    write(sbuf,'(3a,i0)') trim(sbuf),ch10,"src_line: ",line
411  end if
412  write(sbuf,'(8a)') trim(sbuf),ch10,&
413 &  "message: |",ch10,trim(libpaw_indent(my_msg)),ch10,&
414 &  "...",ch10
415 
416  select case (libpaw_to_upper(level))
417  case ('COMMENT','WARNING')
418    call libpaw_wrtout(std_out,sbuf,mode_paral) 
419  case ('ERROR','BUG')
420    call libpaw_wrtout(std_out,sbuf,mode_paral) 
421    inquire(file=LIBPAW_MPIABORTFILE,exist=file_exists)
422    if ((.not.file_exists).and.xmpi_comm_size(xmpi_world)>1) then
423      call libpaw_lock_and_write(LIBPAW_MPIABORTFILE,sbuf)
424    end if
425    call libpaw_leave(mode_paral)
426  case default 
427    write(sbuf,'(4a)') ch10,' libpaw_msg_hndl: BUG**2 - ',ch10,' Wrong value for level!'
428    call libpaw_die(sbuf)
429  end select
430 
431 end subroutine libpaw_msg_hndl

m_libpaw_tools/libpaw_spmsg_getcount [ Functions ]

[ Top ] [ m_libpaw_tools ] [ Functions ]

NAME

  libpaw_spmsg_getcount

FUNCTION

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

INPUTS

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

OUTPUT

  (only counters updated)

NOTES

  This routine comes directly from the SPECIALMSG_GETCOUNT routine delivered with ABINIT.

PARENTS

      abinit

CHILDREN

      flush,flush_

SOURCE

462 subroutine libpaw_spmsg_getcount(ncomment,nwarning,nexit)
463 
464 
465 !This section has been created automatically by the script Abilint (TD).
466 !Do not modify the following lines by hand.
467 #undef ABI_FUNC
468 #define ABI_FUNC 'libpaw_spmsg_getcount'
469 !End of the abilint section
470 
471  implicit none
472 
473 !Arguments ------------------------------------
474  integer,intent(out) :: ncomment,nexit,nwarning
475 
476 !Local variables ------------------------------
477 
478 ! **********************************************************************
479 
480  ncomment=LIBPAW_COMMENT_COUNT
481  nwarning=LIBPAW_WARNING_COUNT
482  nexit   =LIBPAW_EXIT_FLAG
483 
484 end subroutine libpaw_spmsg_getcount

m_libpaw_tools/libpaw_spmsg_mpisum [ Functions ]

[ Top ] [ m_libpaw_tools ] [ Functions ]

NAME

  libpaw_spmsg_mpisum

FUNCTION

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

INPUTS

  mpicomm= MPI communicator

OUTPUT

  (only counters updated)

NOTES

  This routine comes directly from the SPECIALMSG_MPISUM routine delivered with ABINIT.

PARENTS

      gstateimg

CHILDREN

      flush,flush_

SOURCE

513 subroutine libpaw_spmsg_mpisum(mpicomm)
514 
515 
516 !This section has been created automatically by the script Abilint (TD).
517 !Do not modify the following lines by hand.
518 #undef ABI_FUNC
519 #define ABI_FUNC 'libpaw_spmsg_mpisum'
520 !End of the abilint section
521 
522  implicit none
523 
524 !Arguments ------------------------------------
525  integer,intent(in) :: mpicomm
526 
527 !Local variables ------------------------------
528  integer :: ierr
529  integer :: buf(3)
530 
531 ! **********************************************************************
532 
533   buf(1)=LIBPAW_COMMENT_COUNT;buf(2)=LIBPAW_WARNING_COUNT;buf(3)=LIBPAW_EXIT_FLAG
534 
535   call xmpi_sum(buf,mpicomm,ierr)
536 
537   LIBPAW_COMMENT_COUNT=buf(1)
538   LIBPAW_WARNING_COUNT=buf(2)
539   LIBPAW_EXIT_FLAG=buf(3) ; if (LIBPAW_EXIT_FLAG/=0) LIBPAW_EXIT_FLAG=1
540 
541 end subroutine libpaw_spmsg_mpisum

m_libpaw_tools/libpaw_write_comm_set [ Functions ]

[ Top ] [ m_libpaw_tools ] [ Functions ]

NAME

  libpaw_write_comm_set

FUNCTION

  Set the MPI communicator used for parallel write

INPUTS

  new_write_comm= new value for the parallel write MPI communicator

OUTPUT

PARENTS

      driver,initmpi_world,m_io_redirect,memory_eval,mpi_setup

CHILDREN

      flush,flush_

SOURCE

566 subroutine libpaw_write_comm_set(new_write_comm)
567 
568 
569 !This section has been created automatically by the script Abilint (TD).
570 !Do not modify the following lines by hand.
571 #undef ABI_FUNC
572 #define ABI_FUNC 'libpaw_write_comm_set'
573 !End of the abilint section
574 
575  implicit none
576 
577 !Arguments ------------------------------------
578  integer,intent(in) :: new_write_comm
579  
580 !Local variables ------------------------------
581 
582 ! **********************************************************************
583 
584  LIBPAW_WRITE_COMM=new_write_comm
585 
586 end subroutine libpaw_write_comm_set

m_libpaw_tools/libpaw_write_lines [ Functions ]

[ Top ] [ m_libpaw_tools ] [ Functions ]

NAME

  libpaw_write_lines

FUNCTION

  This routine receives a string, split the message in lines according to the 
  ch10 character and output the text to the specified unit. 
  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

OUTPUT

  (only writing)

NOTES

  This routine comes directly from the WRITE_LINES routine delivered with ABINIT.

PARENTS

      m_libpaw_tools

CHILDREN

      flush,flush_

SOURCE

273 subroutine libpaw_write_lines(unit,msg)
274 
275 
276 !This section has been created automatically by the script Abilint (TD).
277 !Do not modify the following lines by hand.
278 #undef ABI_FUNC
279 #define ABI_FUNC 'libpaw_write_lines'
280 !End of the abilint section
281 
282  implicit none
283 
284 !Arguments ------------------------------------
285 !scalars
286  integer,intent(in) :: unit
287  character(len=*),intent(in) :: msg
288 
289 !Local variables ------------------------------
290 !scalars
291  integer :: msg_size,ii,jj,rtnpos
292 #if defined HAVE_YAML
293  character(len = len_trim(msg)) :: msg_out
294 #endif
295 
296 !******************************************************************
297 
298  msg_size=len_trim(msg)
299 
300 #if defined HAVE_YAML
301  if (msg_size>0 .and. unit==std_out) then
302     ! Change any carriage return into space.
303     do ii = 1, msg_size
304        if (msg(ii:ii) /= char(10)) then
305           msg_out(ii:ii) = msg(ii:ii)
306        else
307           msg_out(ii:ii) = " "
308        end if
309     end do
310     call yaml_comment(msg_out)
311  end if
312  return
313 #endif
314 
315  if (msg_size==0) then
316    write(unit,*) ; return 
317  end if
318 
319 !Here, split the message, according to the char(10) characters (carriage return). 
320 !This technique is portable accross different OS.
321  rtnpos=index(msg,ch10)
322  if (rtnpos==0) then
323    write(unit,"(a)") msg(1:msg_size) ; return
324  end if 
325 
326  ii=1; jj=rtnpos
327  do 
328    if (ii==jj) then
329      write(unit,*)
330    else
331      write(unit,'(a)') msg(ii:jj-1)
332    end if
333    ii=jj+1 ; if (ii>msg_size) exit
334    jj=index(msg(ii:msg_size),ch10) 
335    if (jj==0) then 
336      jj=msg_size+1
337    else
338      jj=jj+ii-1
339    end if
340  end do
341 
342  if (msg(msg_size:msg_size)==ch10) write(unit,*)
343 
344 end subroutine libpaw_write_lines

m_libpaw_tools/libpaw_wrtout [ Functions ]

[ Top ] [ m_libpaw_tools ] [ Functions ]

NAME

 libpaw_wrtout

FUNCTION

  Organizes the sequential or parallel version of the write intrinsic

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.

OUTPUT

  (only writing)

NOTES

  This routine comes directly from the WRTOUT routine delivered with ABINIT.

PARENTS

      m_libpaw_tools

CHILDREN

      flush,flush_

SOURCE

117 subroutine libpaw_wrtout(unit,msg,mode_paral)
118 
119 
120 !This section has been created automatically by the script Abilint (TD).
121 !Do not modify the following lines by hand.
122 #undef ABI_FUNC
123 #define ABI_FUNC 'libpaw_wrtout'
124 !End of the abilint section
125 
126  implicit none
127 
128 !Arguments ------------------------------------
129  integer,intent(in) :: unit
130  character(len=*),intent(in) :: msg
131  character(len=*),optional,intent(in) :: mode_paral
132 
133 !Local variables ------------------------------
134  integer :: comm,me,nproc
135  integer,save :: master=0
136  character(len=len(msg)+50) :: string
137  character(len=500) :: my_mode_paral
138 
139 !******************************************************************
140 
141  if ((unit==std_out).and.(.not.LIBPAW_HAS_LOG_FILE)) RETURN
142  if (unit==LIBPAW_NULL_UNIT) RETURN
143 
144  my_mode_paral = "COLL"; if (PRESENT(mode_paral)) my_mode_paral = mode_paral
145 
146 !Communicator used for the parallel write
147  comm=LIBPAW_WRITE_COMM
148  nproc = xmpi_comm_size(comm)
149  me    = xmpi_comm_rank(comm)
150 
151  if ((my_mode_paral=='COLL').or.(nproc==1)) then
152    if (me==master) then
153      call libpaw_wrtout_myproc(unit,msg)
154    end if
155  else if (my_mode_paral=='PERS') then
156    call libpaw_write_lines(unit,msg)
157  else if (my_mode_paral=='INIT') then
158    master=unit
159  else
160    write(string,'(7a)')ch10,&
161 &   'libpaw_wrtout: ERROR -',ch10,&
162 &   '  Unknown write mode: ',my_mode_paral,ch10,&
163 &   '  Continuing anyway ...'
164    write(unit,'(A)') trim(string)
165  end if
166 
167 end subroutine libpaw_wrtout

m_libpaw_tools/libpaw_wrtout_myproc [ Functions ]

[ Top ] [ m_libpaw_tools ] [ Functions ]

NAME

  libpaw_wrtout_myproc

FUNCTION

  Do the output for one proc.

INPUTS

  unit=unit number for writing
  msg=(character(len=*)) message to be written

OUTPUT

  (only writing)

NOTES

  This routine comes directly from the WRTOUT_MYPROC routine delivered with ABINIT.

PARENTS

      m_libpaw_tools

CHILDREN

      flush,flush_

SOURCE

197 subroutine libpaw_wrtout_myproc(unit,msg)
198 
199 
200 !This section has been created automatically by the script Abilint (TD).
201 !Do not modify the following lines by hand.
202 #undef ABI_FUNC
203 #define ABI_FUNC 'libpaw_wrtout_myproc'
204 !End of the abilint section
205 
206  implicit none
207 
208 !Arguments ------------------------------------
209 !scalars
210  integer,intent(in) :: unit
211  character(len=*),intent(in) :: msg
212 
213 !Local variables ------------------------------
214 !scalars
215  logical :: print_std_err
216 !arrays
217 
218 !******************************************************************
219 
220  print_std_err=(unit==std_out.and.(index(trim(msg),'BUG')/=0.or.index(trim(msg),'ERROR')/=0))
221 
222 !Print message
223  call libpaw_write_lines(unit,msg)
224  if (print_std_err) then
225    call libpaw_write_lines(std_err,msg)
226  end if
227 
228 !Append "Contact Abinit group" to BUG messages
229  if (index(trim(msg),'BUG')/=0) then
230    write(unit,'(a)') '  Action: contact libPAW developers.'
231    if (print_std_err) write(std_err, '(a)' ) '  Action: contact libPAW developers.'
232    write(unit,*); if (print_std_err) write(std_err,*)
233  end if
234 
235 !Count the number of warnings and comments. Only take into
236 !account unit std_out, in order not to duplicate these numbers.
237  if (index(trim(msg),'WARNING')/=0 .and. unit==std_out) LIBPAW_WARNING_COUNT=LIBPAW_WARNING_COUNT+1
238  if (index(trim(msg),'COMMENT')/=0 .and. unit==std_out) LIBPAW_COMMENT_COUNT=LIBPAW_COMMENT_COUNT+1
239  if (index(trim(msg),'Exit'   )/=0) LIBPAW_EXIT_FLAG=1
240 
241 end subroutine libpaw_wrtout_myproc

m_libpaw_tools/to_upper [ Functions ]

[ Top ] [ m_libpaw_tools ] [ Functions ]

NAME

  libpaw_to_upper

FUNCTION

  Convert a string to UPPER CASE (function version).

INPUTS

   istr=Input string

NOTES

  This routine comes directly from the TOUPPER routine delivered with ABINIT.

SOURCE

1093 pure function libpaw_to_upper(istr) result(ostr)
1094 
1095 
1096 !This section has been created automatically by the script Abilint (TD).
1097 !Do not modify the following lines by hand.
1098 #undef ABI_FUNC
1099 #define ABI_FUNC 'libpaw_to_upper'
1100 !End of the abilint section
1101 
1102  implicit none
1103 
1104 !Arguments ------------------------------------
1105  character(len=*),intent(in) :: istr
1106  character(len=LEN_TRIM(istr)) :: ostr
1107 
1108 !Local variables ------------------------------
1109  integer,parameter :: ASCII_aa=ICHAR('a')
1110  integer,parameter :: ASCII_zz=ICHAR('z')
1111  integer,parameter :: SHIFT=ICHAR('a')-ICHAR('A')
1112  integer :: ic,iasc
1113 
1114 ! *********************************************************************
1115 
1116  do ic=1,LEN_TRIM(istr)
1117    iasc=IACHAR(istr(ic:ic))
1118    if (iasc>=ASCII_aa.and.iasc<=ASCII_zz) then
1119      ostr(ic:ic)=ACHAR(iasc-SHIFT)
1120    else
1121      ostr(ic:ic)=istr(ic:ic)
1122    end if
1123  end do
1124 
1125 end function libpaw_to_upper