TABLE OF CONTENTS
ABINIT/iofn1 [ Functions ]
NAME
iofn1
FUNCTION
Begin by eventual redefinition of unit std_in and std_out Then, print greetings for interactive user. Next, Read filenames from unit std_in, AND check that new output file does not already exist.
COPYRIGHT
Copyright (C) 1998-2018 ABINIT group (DCA, XG, GMR) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt . For the initials of contributors, see ~abinit/doc/developers/contributors.txt.
INPUTS
comm=MPI communicator.
OUTPUT
character(len=fnlen) :: filnam(5)=character strings giving file names character(len=fnlen) :: filstat=character strings giving name of status file
NOTES
If it does exist, isfile will create a new name to avoid overwriting the output file. Also create name of status file File names refer to following files, in order: (1) Formatted input file (std_in) (2) Formatted output file (std_out) (3) Root name for generic input files (wavefunctions, potential, density ...) (4) Root name for generic output files (wavefunctions, potential, density, DOS, hessian ...) (5) Root name for generic temporary files (wftmp1,wftmp2,kgunit,status ...)
PARENTS
abinit
CHILDREN
abi_log_status_state,int2char4,isfile,libpaw_log_flag_set,xmpi_barrier xmpi_bcast
SOURCE
47 #if defined HAVE_CONFIG_H 48 #include "config.h" 49 #endif 50 51 #include "abi_common.h" 52 53 subroutine iofn1(filnam,filstat,comm) 54 55 use defs_basis 56 use m_profiling_abi 57 use m_xmpi 58 use m_errors 59 use m_build_info 60 61 use m_fstrings, only : int2char4 62 use m_io_tools, only : open_file 63 use m_libpaw_tools, only : libpaw_log_flag_set 64 65 !This section has been created automatically by the script Abilint (TD). 66 !Do not modify the following lines by hand. 67 #undef ABI_FUNC 68 #define ABI_FUNC 'iofn1' 69 use interfaces_32_util 70 !End of the abilint section 71 72 implicit none 73 74 !Arguments ------------------------------------ 75 integer,intent(in) :: comm 76 character(len=fnlen), intent(out) :: filstat 77 character(len=fnlen), intent(out) :: filnam(5) 78 79 !Local variables------------------------------- 80 character(len=1) :: blank 81 integer,parameter :: master=0 82 integer :: me,ios,nproc,ierr 83 logical :: ex 84 character(len=fnlen) :: fillog,tmpfil 85 character(len=10) :: tag 86 character(len=500) :: message,errmsg 87 88 !************************************************************************* 89 90 ! NOTE: In this routine it's very important to perform tests 91 ! on possible IO errors (err=10, iomsg) because we are initializing the IO stuff 92 ! It there's some problem with the hardware or some misconfiguration, 93 ! it's very likely that the code will crash here and we should try to give useful error messages. 94 95 blank = ' '; tmpfil = '' 96 97 !Determine who I am in comm 98 me = xmpi_comm_rank(comm) 99 nproc = xmpi_comm_size(comm) 100 101 !Define values of do_write_log and do_write_status parameters 102 !if a _NOLOG file exists no LOG file and no STATUS file are created for each cpu core 103 !if a _LOG file exists, a LOG file and a STATUS file are created for each cpu core 104 !if the #_of_cpu_core>NPROC_NO_EXTRA_LOG OR presence of ABI_MAIN_LOG_FILE, LOG file is only created for master proc 105 !if the #_of_cpu_core>NPROC_NO_EXTRA_STATUS OR presence of ABI_MAIN_LOG_FILE, STATUS file is only created for master proc 106 inquire(file=ABI_NO_LOG_FILE,iostat=ios,exist=ex) 107 if (ios/=0) ex=.false. 108 if (ex) then 109 do_write_log=.false. ; do_write_status=.false. 110 call abi_log_status_state(new_do_write_log=.false.,new_do_write_status=.false.) 111 call libpaw_log_flag_set(.false.) 112 else 113 inquire(file=ABI_ENFORCE_LOG_FILE,iostat=ios,exist=ex) 114 if (ios/=0) ex=.false. 115 if (ex) then 116 do_write_log=.true. ; do_write_status=.true. 117 call abi_log_status_state(new_do_write_log=.true.,new_do_write_status=.true.) 118 call libpaw_log_flag_set(.true.) 119 else 120 inquire(file=ABI_MAIN_LOG_FILE,iostat=ios,exist=ex) 121 if (ios/=0) ex=.false. 122 if (ex.and.me/=0) then 123 do_write_log=.false. ; do_write_status=.false. 124 call abi_log_status_state(new_do_write_log=.false.,new_do_write_status=.false.) 125 call libpaw_log_flag_set(.false.) 126 else 127 if (me/=0) then 128 do_write_log= (nproc<NPROC_NO_EXTRA_LOG) 129 call abi_log_status_state(new_do_write_log=(nproc<NPROC_NO_EXTRA_LOG)) 130 call libpaw_log_flag_set((nproc<NPROC_NO_EXTRA_LOG)) 131 do_write_status= (nproc<NPROC_NO_EXTRA_STATUS) 132 call abi_log_status_state(new_do_write_status=(nproc<NPROC_NO_EXTRA_STATUS)) 133 end if 134 end if 135 end if 136 end if 137 138 if (me==master) then 139 140 ! Eventually redefine standard input and standard output 141 142 if (do_write_log) then 143 #if defined READ_FROM_FILE 144 ! Take care of the output file 145 tmpfil(1:fnlen)=blank 146 tmpfil(1:3)='log' 147 call isfile(tmpfil,'new') 148 close(std_out, err=10, iomsg=errmsg) 149 if (open_file(tmpfil,message,unit=std_out,form='formatted',status='new',action="write") /= 0) then 150 MSG_ERROR(message) 151 end if 152 #endif 153 else 154 ! Redirect standard output to null 155 close(std_out, err=10, iomsg=errmsg) 156 if (open_file(NULL_FILE,message,unit=std_out,action="write") /= 0) then 157 MSG_ERROR(message) 158 end if 159 end if 160 161 #if defined READ_FROM_FILE 162 ! Now take care of the "files" file 163 tmpfil(1:fnlen)=blank 164 tmpfil(1:9)='ab.files' 165 write(message, '(4a)' )& 166 & 'Because of cpp option READ_FROM_FILE,',ch10,& 167 & 'read file "ab.files" instead of standard input ' ,ch10 168 MSG_COMMENT(message) 169 call isfile(tmpfil,'old') 170 close(std_in, err=10, iomsg=errmsg) 171 if (open_file(tmpfil,message,unit=std_in,form='formatted',status='old',action="read") /= 0) then 172 MSG_ERROR(message) 173 end if 174 #endif 175 176 ! Print greetings for interactive user 177 write(std_out,*,err=10,iomsg=errmsg)' ABINIT ',trim(abinit_version) 178 write(std_out,*,err=10,iomsg=errmsg)' ' 179 180 ! Read name of input file (std_in): 181 write(std_out,*,err=10,iomsg=errmsg)' Give name for formatted input file: ' 182 read(std_in, '(a)',err=10,iomsg=errmsg ) filnam(1) 183 write(std_out, '(a)',err=10,iomsg=errmsg ) trim(filnam(1)) 184 write(std_out,*)' Give name for formatted output file:' 185 read (std_in, '(a)',err=10,iomsg=errmsg ) filnam(2) 186 write (std_out, '(a)',err=10,iomsg=errmsg ) trim(filnam(2)) 187 write(std_out,*)' Give root name for generic input files:' 188 read (std_in, '(a)',err=10,iomsg=errmsg ) filnam(3) 189 write (std_out, '(a)',err=10,iomsg=errmsg ) trim(filnam(3)) 190 write(std_out,*, err=10, iomsg=errmsg )' Give root name for generic output files:' 191 read (std_in, '(a)', err=10, iomsg=errmsg ) filnam(4) 192 write (std_out, '(a)', err=10, iomsg=errmsg ) trim(filnam(4)) 193 write(std_out,*, err=10, iomsg=errmsg)' Give root name for generic temporary files:' 194 read (std_in, '(a)', err=10, iomsg=errmsg ) filnam(5) 195 write (std_out, '(a)', err=10, iomsg=errmsg ) trim(filnam(5)) 196 197 ! Check that old input file exists 198 call isfile(filnam(1),'old') 199 200 ! Check that new output file does NOT exist 201 call isfile(filnam(2),'new') 202 203 ! Check that root name for generic input and output differ 204 if ( trim(filnam(3))==trim(filnam(4)) ) then 205 write(message, '(a,a,a)' )& 206 & 'Root name for generic input and output files must differ ',ch10,& 207 & 'Action: correct your "file" file.' 208 MSG_ERROR(message) 209 end if 210 211 ! Check that root names are at least 20 characters less than fnlen 212 if ( len_trim(filnam(3)) >= (fnlen-20) ) then 213 write(message, '(a,a,a,a,a,i4,a,i4,a,a)' )& 214 & 'Root name for generic input files is too long. ',ch10,& 215 & 'It must be 20 characters less than the maximal allowed ',ch10,& 216 & 'length of names, that is ',fnlen,', while it is ',len_trim(filnam(3)),ch10,& 217 & 'Action : correct your "file" file.' 218 MSG_ERROR(message) 219 end if 220 if ( len_trim(filnam(4)) >= (fnlen-20) ) then 221 write(message, '(a,a,a,a,a,i4,a,i4,a,a)' )& 222 & 'Root name for generic output files is too long. ',ch10,& 223 & 'It must be 20 characters less than the maximal allowed ',ch10,& 224 & 'length of names, that is ',fnlen,', while it is ',len_trim(filnam(4)),ch10,& 225 & 'Action: correct your "file" file.' 226 MSG_ERROR(message) 227 end if 228 if ( len_trim(filnam(5)) >= (fnlen-20) ) then 229 write(message, '(a,a,a,a,a,i4,a,i4,a,a)' )& 230 & 'Root name for generic temporary files is too long. ',ch10,& 231 & 'It must be 20 characters less than the maximal allowed ',ch10,& 232 & 'length of names, that is ',fnlen,', while it is ',len_trim(filnam(5)),ch10,& 233 & 'Action: correct your "file" file.' 234 MSG_ERROR(message) 235 end if 236 237 end if ! master only 238 239 !Communicate filenames to all processors 240 call xmpi_bcast(filnam,master,comm,ierr) 241 242 !Check 243 !Create a name for the status file, based on filnam(5) 244 filstat=trim(filnam(5))//'_STATUS' 245 246 !Redefine the log unit if not the master 247 if (me/=master) then 248 call int2char4(me,tag) 249 ABI_CHECK((tag(1:1)/='#'),'Bug: string length too short!') 250 filstat=trim(filstat)//'_P-'//trim(tag) 251 if (do_write_log) then 252 fillog=trim(filnam(5))//'_LOG_'//trim(tag) 253 close(std_out, err=10, iomsg=errmsg) 254 if (open_file(fillog,message,unit=std_out,status='unknown',action="write") /= 0) then 255 MSG_ERROR(message) 256 end if 257 else 258 close(std_out, err=10, iomsg=errmsg) 259 if (open_file(NULL_FILE,message,unit=std_out,action="write") /= 0) then 260 MSG_ERROR(message) 261 end if 262 end if 263 end if 264 265 call xmpi_barrier(comm) 266 return 267 268 ! Handle possibe IO errors 269 10 continue 270 MSG_ERROR(errmsg) 271 272 end subroutine iofn1