12 procedure,
nopass:: mkdir
13 procedure,
nopass:: mkdir_no
15 type(
os_t),
public:: os
16 real,
parameter:: ms=100.
19 SUBROUTINE mkdir (dir)
20 character(len=*):: dir
28 do while (wallclock()-start < 10.0)
29 #ifdef __INTEL_COMPILER 30 inquire (directory=dir, exist=exists)
32 inquire (file=dir, exist=exists)
35 call mpi%delay (ms=ms)
38 write (io_unit%output,*)
'WARNING: rank',mpi%rank,
' cannot see',dir
46 SUBROUTINE mkdir_real (dir)
47 #ifdef __INTEL_COMPILER 52 function fmkdir(path,mode) bind(c,name="mkdir")
54 integer(c_int) :: fmkdir
55 character(kind=c_char,len=1) :: path(*)
56 integer(c_int16_t),
value :: mode
61 character(len=*):: dir
64 #ifdef __INTEL_COMPILER 65 inquire (directory=dir, exist=exists)
67 if (.not.io_unit%do_validate)
then 68 exists = makedirqq(dir)
70 write(stderr,*)
' Intel created directory '//dir
72 write(stderr,
'(2(a,i5,2x),a)')
'rank:', mpi%rank,
'thread:', omp%thread, &
73 ' WARNING: Intel failed to create directory '//dir
78 inquire (file=dir, exist=exists)
81 i = fmkdir(dir, int(o
'772',c_int16_t))
82 call mpi%delay (ms=ms)
83 inquire (file=dir, exist=exists)
85 if (.not.io_unit%do_validate) &
86 write(stderr,*)
' C-binding call created directory '//dir
89 if (.not.io_unit%do_validate) &
90 write(stderr,
'(2(a,i5,2x),a)')
'rank:', mpi%rank,
'thread:', omp%thread, &
91 ' WARNING: C-binding call failed to create directory '//dir
93 call system (
'mkdir -p '//dir)
94 call mpi%delay (ms=ms)
95 inquire (file=dir, exist=exists)
97 if (.not.io_unit%do_validate) &
98 write(stderr,*)
' system call created directory '//dir
101 if (.not.io_unit%do_validate) &
102 write(stderr,
'(2(a,i5,2x),a)')
'rank:', mpi%rank,
'thread:', omp%thread, &
103 ' WARNING: system call failed to create directory '//dir
109 END SUBROUTINE mkdir_real
114 SUBROUTINE mkdir_no (iout)
116 character(len=120):: filename
117 integer,
save:: checked=-1
120 if (iout > checked)
then 121 write (filename,
'(a,i5.5,"/")') trim(io_unit%outputname), iout
122 if (io_unit%iodir/=iout)
call os%mkdir (trim(filename))
127 END SUBROUTINE mkdir_no
Support tic/toc timing, as in MATLAB, and accurate wallclock() function. The timing is generally much...