DISPATCH
os_mod.f90
1 !===============================================================================
2 !===============================================================================
3 MODULE os_mod
4  USE io_unit_mod
5  USE omp_mod
6  USE mpi_mod
7  USE omp_timer_mod
8  implicit none
9  private
10  type, public:: os_t
11  contains
12  procedure, nopass:: mkdir
13  procedure, nopass:: mkdir_no
14  end type
15  type(os_t), public:: os
16  real, parameter:: ms=100.
17 CONTAINS
18 
19 SUBROUTINE mkdir (dir)
20  character(len=*):: dir
21  real(8):: start
22  logical:: exists
23  !.............................................................................
24  if (mpi%rank==0) then
25  call mkdir_real (dir)
26  else
27  start = wallclock()
28  do while (wallclock()-start < 10.0)
29 #ifdef __INTEL_COMPILER
30  inquire (directory=dir, exist=exists)
31 #else
32  inquire (file=dir, exist=exists)
33 #endif
34  if (exists) exit
35  call mpi%delay (ms=ms)
36  end do
37  if (.not.exists) then
38  write (io_unit%output,*) 'WARNING: rank',mpi%rank,' cannot see',dir
39  end if
40  end if
41 END SUBROUTINE mkdir
42 
43 !===============================================================================
44 !> Utility to create a new directory
45 !===============================================================================
46 SUBROUTINE mkdir_real (dir)
47 #ifdef __INTEL_COMPILER
48  USE ifport
49 #else
50  use iso_c_binding
51  interface
52  function fmkdir(path,mode) bind(c,name="mkdir")
53  use iso_c_binding
54  integer(c_int) :: fmkdir
55  character(kind=c_char,len=1) :: path(*)
56  integer(c_int16_t), value :: mode
57  end function fmkdir
58  end interface
59  integer :: i, iter
60 #endif
61  character(len=*):: dir
62  logical:: exists
63  !.............................................................................
64 #ifdef __INTEL_COMPILER
65  inquire (directory=dir, exist=exists)
66  if (exists) return
67  if (.not.io_unit%do_validate) then
68  exists = makedirqq(dir)
69  if (exists) then
70  write(stderr,*) ' Intel created directory '//dir
71  else
72  write(stderr,'(2(a,i5,2x),a)') 'rank:', mpi%rank, 'thread:', omp%thread, &
73  ' WARNING: Intel failed to create directory '//dir
74  end if
75  end if
76 #else
77  !$omp critical (system_cr)
78  inquire (file=dir, exist=exists)
79  if (.not.exists) then
80  do iter=1,10
81  i = fmkdir(dir, int(o'772',c_int16_t))
82  call mpi%delay (ms=ms)
83  inquire (file=dir, exist=exists)
84  if (exists) then
85  if (.not.io_unit%do_validate) &
86  write(stderr,*) ' C-binding call created directory '//dir
87  exit
88  else
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
92  end if
93  call system ('mkdir -p '//dir)
94  call mpi%delay (ms=ms)
95  inquire (file=dir, exist=exists)
96  if (exists) then
97  if (.not.io_unit%do_validate) &
98  write(stderr,*) ' system call created directory '//dir
99  exit
100  else
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
104  end if
105  end do
106  end if
107  !$omp end critical (system_cr)
108 #endif
109 END SUBROUTINE mkdir_real
110 
111 !===============================================================================
112 !> Make sure the next directory is created ahead of time
113 !===============================================================================
114 SUBROUTINE mkdir_no (iout)
115  integer:: iout
116  character(len=120):: filename
117  integer, save:: checked=-1
118  !-----------------------------------------------------------------------------
119  !$omp critical (mkdir_no_cr)
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))
123  io_unit%iodir = iout
124  checked = iout
125  end if
126  !$omp end critical (mkdir_no_cr)
127 END SUBROUTINE mkdir_no
128 END MODULE os_mod
Support tic/toc timing, as in MATLAB, and accurate wallclock() function. The timing is generally much...