TABLE OF CONTENTS
- ABINIT/m_libpaw_tools
- m_libpaw_tool/libpaw_netcdf_check
- m_libpaw_tools/libpaw_basename
- m_libpaw_tools/libpaw_die
- m_libpaw_tools/libpaw_flush
- m_libpaw_tools/libpaw_get_free_unit
- m_libpaw_tools/libpaw_indent
- m_libpaw_tools/libpaw_leave
- m_libpaw_tools/libpaw_lock_and_write
- m_libpaw_tools/libpaw_log_flag_set
- m_libpaw_tools/libpaw_lstrip
- m_libpaw_tools/libpaw_msg_hndl
- m_libpaw_tools/libpaw_spmsg_getcount
- m_libpaw_tools/libpaw_spmsg_mpisum
- m_libpaw_tools/libpaw_write_comm_set
- m_libpaw_tools/libpaw_write_lines
- m_libpaw_tools/libpaw_wrtout
- m_libpaw_tools/libpaw_wrtout_myproc
- m_libpaw_tools/to_upper
ABINIT/m_libpaw_tools [ 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 ]
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