-
Notifications
You must be signed in to change notification settings - Fork 38
Expand file tree
/
Copy pathoutput.f90
More file actions
118 lines (80 loc) · 3.16 KB
/
Copy pathoutput.f90
File metadata and controls
118 lines (80 loc) · 3.16 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
submodule (io) output
use, intrinsic :: iso_fortran_env, only: compiler_version, compiler_options
implicit none
contains
module procedure create_outdir
! subroutine create_outdir(outdir,infile,indatsize,indatgrid,flagdneu,sourcedir,flagprecfile,precdir,flagE0file,E0dir)
!! CREATES OUTPUT DIRECTORY, MOVES CONFIG FILES THERE AND GENERATES A GRID OUTPUT FILE
integer(c_int) :: ierr
!> MAKE A COPY OF THE INPUT DATA IN THE OUTPUT DIRECTORY
if ( mkdir(outdir//'/inputs') /= 0 ) error stop 'error creating output directory'
if ( copyfile(infile, outdir//'/inputs/') /= 0) error stop 'error copying configuration file to output directory'
if ( copyfile(indatsize, outdir//'/inputs/') /= 0) error stop 'error copying input data size file to output directory'
if ( copyfile(indatgrid, outdir//'/inputs/') /= 0) error stop 'error copying input grid to output directory'
if ( copyfile(indatfile, outdir//'/inputs/') /= 0) error stop 'error copying input data to output directory'
!MAKE COPIES OF THE INPUT DATA, AS APPROPRIATE
if (.false.) then
if (flagdneu/=0) then
ierr = mkdir(outdir//'/inputs/neutral_inputs')
if ( copyfile(sourcedir//'/*', outdir//'/inputs/neutral_inputs/') /= 0) error stop 'copy: neutral input => output dir'
end if
if (flagprecfile/=0) then
ierr = mkdir(outdir//'/inputs/prec_inputs')
if ( copyfile(precdir//'/*', outdir//'/inputs/prec_inputs/') /= 0) error stop 'copy: input precipitation => output dir'
end if
if (flagE0file/=0) then
ierr = mkdir(outdir//'/inputs/Efield_inputs')
if ( copyfile(E0dir//'/*', outdir//'/inputs/Efield_inputs/') /= 0) error stop 'copy input energy => output dir'
end if
endif
call gitlog(outdir // '/gitrev.log')
call compiler_log(outdir // '/compiler.log')
call realbits_log(outdir // '/realbits.log')
end procedure create_outdir
subroutine gitlog(logpath)
!! logs git branch, hash to file
character(*), intent(in) :: logpath
integer :: ierr
!> write branch
call execute_command_line('git rev-parse --abbrev-ref HEAD > '// logpath, cmdstat=ierr)
if(ierr /= 0) then
write(stderr, *) 'ERROR: failed to log Git branch'
return
endif
!> write hash
call execute_command_line('git rev-parse --short HEAD >> '// logpath, cmdstat=ierr)
if(ierr /= 0) then
write(stderr, *) 'ERROR: failed to log Git hash'
return
endif
!> write changed filenames
call execute_command_line('git status --porcelain >> '// logpath, cmdstat=ierr)
if(ierr /= 0) then
write(stderr, *) 'ERROR: failed to log Git filenames'
return
endif
end subroutine gitlog
subroutine compiler_log(logpath)
character(*), intent(in) :: logpath
integer :: u, ierr
open(newunit=u, file=logpath, status='unknown', action='write', iostat=ierr)
if(ierr /= 0) return
write(u,'(A,/,A)') compiler_version(), compiler_options()
close(u)
end subroutine compiler_log
subroutine realbits_log(logpath)
character(*), intent(in) :: logpath
integer :: u, ierr
open(newunit=u, file=logpath, status='unknown', action='write', iostat=ierr)
if(ierr /= 0) return
select case (wp)
case (real64)
write(u,'(A)') '64'
case (real32)
write(u,'(A)') '32'
case default
write(u,'(A)') 'unknown'
end select
close(u)
end subroutine realbits_log
end submodule output