-
Notifications
You must be signed in to change notification settings - Fork 38
Expand file tree
/
Copy pathinput.f90
More file actions
262 lines (223 loc) · 7.01 KB
/
Copy pathinput.f90
File metadata and controls
262 lines (223 loc) · 7.01 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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
submodule (io) input
implicit none
interface ! path_exists*.f90
module subroutine assert_directory_exists(path)
character(*), intent(in) :: path
end subroutine assert_directory_exists
end interface
contains
module procedure read_configfile
!! READS THE INPUT CONFIGURAITON FILE ANDE ASSIGNS VARIABLES FOR FILENAMES, SIZES, ETC.
character(256) :: buf, indat_size, indat_grid, indat_file, source_dir, prec_dir, E0_dir
integer :: i
real(wp) :: NaN
logical :: is_nml
namelist /base/ ymd, UTsec0, tdur, dtout, activ, tcfl, Teinf, &
potsolve, flagperiodic, flagoutput, flagcap, indat_size, indat_grid, indat_file, &
flagdneu, flagprecfile, flagE0file, flagglow
namelist /neutral_perturb/ interptype, sourcemlat, sourcemlon, dxn, drhon, dzn, source_dir
namelist /precip/ dtprec, prec_dir
namelist /efield/ dtE0, E0_dir
namelist /glow/ dtglow, dtglowout
NaN = ieee_value(0._wp, ieee_quiet_nan)
is_nml = infile(len(infile)-3:len(infile)) == '.nml'
!> READ CONFIG.DAT FILE FOR THIS SIMULATION
rawconfig : block
integer :: u
open(newunit=u, file=infile, status='old', action='read')
if (is_nml) then
read(u,nml=base, iostat=i)
call check_nml_io(i, infile)
indatsize = expanduser(indat_size)
indatgrid = expanduser(indat_grid)
indatfile = expanduser(indat_file)
else
read(u,*) ymd(3),ymd(2),ymd(1)
read(u,*) UTsec0
read(u,*) tdur
read(u,*) dtout
read(u,*) activ(1),activ(2),activ(3)
read(u,*) tcfl
read(u,*) Teinf
read(u,*) potsolve
read(u,*) flagperiodic
read(u,*) flagoutput
read(u,*) flagcap ! line 11 config.ini
read(u,'(a256)') buf !! format specifier needed, else it reads just one character
indatsize = expanduser(buf)
read(u,'(a256)') buf
indatgrid = expanduser(buf)
read(u,'(a256)') buf
indatfile = expanduser(buf) ! line 14
endif
call assert_file_exists(indatsize)
call assert_file_exists(indatgrid)
call assert_file_exists(indatfile)
!> PRINT SOME DIAGNOSIC INFO FROM ROOT
if (myid==0) then
print '(A,I6,A1,I0.2,A1,I0.2)', infile // ' simulation year-month-day is: ',ymd(1),'-',ymd(2),'-',ymd(3)
print '(A51,F10.3)', 'start time is: ',UTsec0
print '(A51,F10.3)', 'duration is: ',tdur
print '(A51,F10.3)', 'output every: ',dtout
print '(A,/,A,/,A,/,A)', 'using input data files:', indatsize, indatgrid, indatfile
end if
!> NEUTRAL PERTURBATION INPUT INFORMATION
!> defaults
interptype=0
sourcemlat=0
sourcemlon=0
dtneu=0
drhon=0
dzn=0
dxn=0
if(is_nml) then
if (flagdneu == 1) then
read(u, nml=neutral_perturb, iostat=i)
call check_nml_io(i, infile)
sourcedir = expanduser(source_dir)
call assert_directory_exists(sourcedir)
endif
else
read(u,*, iostat=i) flagdneu ! line 15
call check_ini_io(i, infile)
if( flagdneu==1) then
read(u,*) interptype
read(u,*) sourcemlat,sourcemlon
read(u,*) dtneu
if (interptype==3) then !read in extra dxn if 3D
read(u,*) dxn,drhon,dzn
else
read(u,*) drhon,dzn
end if
read(u,'(A256)') buf
sourcedir = expanduser(buf)
call assert_directory_exists(sourcedir)
endif
end if
!> have to allocate, even when not used, to avoid runtime errors with pickier compilers
if (flagdneu/=1) sourcedir = ""
if(flagdneu==1 .and. myid ==0) then
print *, 'Neutral disturbance mlat,mlon: ',sourcemlat,sourcemlon
print *, 'Neutral disturbance cadence (s): ',dtneu
print *, 'Neutral grid resolution (m): ',drhon,dzn
print *, 'Neutral disturbance data files located in directory: ',sourcedir
end if
!> PRECIPITATION FILE INPUT INFORMATION
!> defaults
dtprec=0
if(is_nml) then
if (flagprecfile == 1) then
read(u, nml=precip, iostat=i)
call check_nml_io(i, infile)
precdir = expanduser(prec_dir)
call assert_directory_exists(precdir)
endif
else
read(u,*, iostat=i) flagprecfile
call check_ini_io(i, infile)
if (flagprecfile==1) then
!! get the location of the precipitation input files
read(u,*, iostat=i) dtprec
read(u,'(A256)', iostat=i) buf
call check_nml_io(i, infile)
precdir = expanduser(buf)
call assert_directory_exists(precdir)
end if
end if
!> have to allocate, even when not used, to avoid runtime errors with pickier compilers
if (flagprecfile/=1) precdir = ""
if (flagprecfile==1 .and. myid==0) then
print '(A,F10.3)', 'Precipitation file input cadence (s): ',dtprec
print *, 'Precipitation file input source directory: ' // precdir
end if
!> ELECTRIC FIELD FILE INPUT INFORMATION
!> defaults
dtE0=0
if(is_nml) then
if (flagE0file == 1) then
read(u, nml=efield, iostat=i)
call check_nml_io(i, infile)
E0dir = expanduser(E0_dir)
call assert_directory_exists(E0dir)
endif
else
read(u,*, iostat=i) flagE0file
call check_ini_io(i, infile)
if (flagE0file==1) then
!! get the location of the precipitation input files
read(u,*, iostat=i) dtE0
read(u,'(a256)', iostat=i) buf
call check_nml_io(i, infile)
E0dir = expanduser(buf)
call assert_directory_exists(E0dir)
end if
end if
!> have to allocate, even when not used, to avoid runtime errors with pickier compilers
if (flagE0file/=1) E0dir = ""
if(flagE0file==1 .and. myid==0) then
print *, 'Electric field file input cadence (s): ',dtE0
print *, 'Electric field file input source directory: ' // E0dir
end if
!> GLOW ELECTRON TRANSPORT INFORMATION
!> defaults
dtglow=NaN
dtglowout=NaN
if(is_nml) then
if (flagglow == 1) then
read(u, nml=glow, iostat=i)
call check_nml_io(i, infile)
endif
else
read(u,*, iostat=i) flagglow
call check_ini_io(i, infile)
if (flagglow==1) then
read(u,*, iostat=i) dtglow
read(u,*, iostat=i) dtglowout
call check_nml_io(i, infile)
end if
end if
if (flagglow==1 .and. myid == 0) then
print *, 'GLOW enabled for auroral emission calculations.'
print *, 'GLOW electron transport calculation cadence (s): ', dtglow
print *, 'GLOW auroral emission output cadence (s): ', dtglowout
end if
close(u)
end block rawconfig
end procedure read_configfile
subroutine check_nml_io(i, filename)
!! checks for EOF and gives helpful error
!! this accomodates non-Fortran 2018 error stop with variable character
integer, intent(in) :: i
character(*), intent(in) :: filename
if (is_iostat_end(i)) then
write(stderr,*) 'ERROR: ensure there is a trailing blank line in ' // filename
error stop
endif
if (i /= 0) then
write(stderr,*) 'ERROR: problem reading ' // filename
error stop
endif
end subroutine check_nml_io
subroutine check_ini_io(i, filename)
!! checks for EOF and gives helpful error
!! this accomodates non-Fortran 2018 error stop with variable character
integer, intent(in) :: i
character(*), intent(in) :: filename
if (is_iostat_end(i)) return
if (i /= 0) then
write(stderr,*) 'ERROR: problem reading ' // filename
error stop
endif
end subroutine check_ini_io
subroutine assert_file_exists(path)
!! throw error if file does not exist
!! this accomodates non-Fortran 2018 error stop with variable character
character(*), intent(in) :: path
logical :: exists
inquire(file=path, exist=exists)
if (.not.exists) then
write(stderr,*) 'ERROR: file does not exist' // path
error stop
endif
end subroutine assert_file_exists
end submodule input