-
Notifications
You must be signed in to change notification settings - Fork 37
Expand file tree
/
Copy pathio.f90
More file actions
218 lines (167 loc) · 7.33 KB
/
Copy pathio.f90
File metadata and controls
218 lines (167 loc) · 7.33 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
module io
!! HANDLES INPUT AND OUTPUT OF PLASMA STATE PARAMETERS (NOT GRID INPUTS)
use, intrinsic :: iso_fortran_env, only: stderr=>error_unit, real32, real64
use, intrinsic :: ieee_arithmetic, only: ieee_is_nan, ieee_value, ieee_quiet_nan
use, intrinsic :: iso_c_binding, only: c_int
use phys_consts, only : kB,ms,pi,lsp,wp,lwave
use fsutils, only: expanduser
use std_mkdir, only: mkdir, copyfile
use mpimod, only: bcast_recv, bcast_send, gather_send, gather_recv, myid, &
tagns, tagvs1, tagv2, tagv3, tagAur, tagTs, tagJ1, tagJ2, tagJ3
use grid, only : gridflag,flagswap,lx1,lx2,lx3,lx2all, lx3all
! use logging, only: logger
implicit none
private
public :: read_configfile, create_outdir, &
input_plasma, output_plasma, input_plasma_currents, &
create_outdir_mag, output_magfields, &
create_outdir_aur, output_aur, check_nan_array
!> NONE OF THESE VARIABLES SHOULD BE ACCESSED BY PROCEDURES OUTSIDE THIS MODULE
character(:), allocatable, private :: indatfile
!! initial condition data files from input configuration file
interface check_nan_array
procedure check_nan_array_1d, check_nan_array_2d, check_nan_array_3d, check_nan_array_4d
end interface check_nan_array
real, parameter :: nan_threshold = 0.
!! nan_threshold = 0. means not a single NaN is allowed in an array
interface ! aurora.f90
module subroutine create_outdir_aur(outdir)
character(*), intent(in) :: outdir
end subroutine create_outdir_aur
module subroutine output_aur(outdir,flagglow,ymd,UTsec,iver)
character(*), intent(in) :: outdir
integer, intent(in) :: flagglow
integer, dimension(3), intent(in) :: ymd
real(wp), intent(in) :: UTsec
real(wp), dimension(:,:,:), intent(in) :: iver
end subroutine output_aur
module subroutine output_aur_workers(iver)
real(wp), dimension(:,:,:), intent(in) :: iver
end subroutine output_aur_workers
end interface
interface ! mag.f90
module subroutine create_outdir_mag(outdir,fieldpointfile)
character(*), intent(in) :: outdir
character(*), intent(in) :: fieldpointfile
end subroutine create_outdir_mag
module subroutine output_magfields(outdir,ymd,UTsec,Br,Btheta,Bphi)
character(*), intent(in) :: outdir
integer, intent(in) :: ymd(3)
real(wp), intent(in) :: UTsec
real(wp), dimension(:), intent(in) :: Br,Btheta,Bphi
end subroutine output_magfields
end interface
interface ! plasma.f90
module subroutine input_plasma(x1,x2,x3all,indatsize,ns,vs1,Ts)
real(wp), dimension(-1:), intent(in) :: x1, x2, x3all
character(*), intent(in) :: indatsize
real(wp), dimension(-1:,-1:,-1:,:), intent(out) :: ns,vs1,Ts
end subroutine input_plasma
module subroutine input_plasma_currents(outdir,flagoutput,ymd,UTsec,J1,J2,J3)
character(*), intent(in) :: outdir
integer, intent(in) :: flagoutput
integer, dimension(3), intent(in) :: ymd
real(wp), intent(in) :: UTsec
real(wp), dimension(:,:,:), intent(out) :: J1,J2,J3
end subroutine input_plasma_currents
module subroutine output_plasma(outdir,flagoutput,ymd,UTsec,vs2,vs3,ns,vs1,Ts,Phiall,J1,J2,J3)
character(*), intent(in) :: outdir
integer, intent(in) :: flagoutput
integer, dimension(3), intent(in) :: ymd
real(wp), intent(in) :: UTsec
real(wp), dimension(-1:,-1:,-1:,:), intent(in) :: vs2,vs3,ns,vs1,Ts
real(wp), dimension(:,:,:), allocatable, intent(inout) :: Phiall !these jokers may not be allocated, but this is allowed as of f2003
real(wp), dimension(:,:,:), intent(in) :: J1,J2,J3
end subroutine output_plasma
end interface
interface ! output.f90
module subroutine create_outdir(outdir,infile,indatsize,indatgrid,flagdneu,sourcedir,flagprecfile,precdir,flagE0file,E0dir)
character(*), intent(in) :: outdir, & !command line argument output directory
infile, & !command line argument input file
indatsize,indatgrid,sourcedir, precdir,E0dir
integer, intent(in) :: flagdneu, flagprecfile, flagE0file
end subroutine create_outdir
end interface
interface ! input.f90
module subroutine read_configfile(infile,ymd,UTsec0,tdur,dtout,activ,tcfl,Teinf, &
potsolve,flagperiodic, flagoutput,flagcap,&
indatsize,indatgrid,flagdneu,interptype, &
sourcemlat,sourcemlon,dtneu,dxn,drhon,dzn,sourcedir,flagprecfile,&
dtprec,precdir,flagE0file,dtE0,E0dir,flagglow,dtglow,dtglowout)
character(*), intent(in) :: infile
integer, dimension(3), intent(out):: ymd
real(wp), intent(out) :: UTsec0
real(wp), intent(out) :: tdur
real(wp), intent(out) :: dtout
real(wp), dimension(3), intent(out) :: activ
real(wp), intent(out) :: tcfl
real(wp), intent(out) :: Teinf
integer, intent(out) :: potsolve, flagperiodic, flagoutput, flagcap
integer, intent(out) :: flagdneu
integer, intent(out) :: interptype
real(wp), intent(out) :: sourcemlat,sourcemlon
real(wp), intent(out) :: dtneu
real(wp), intent(out) :: dxn,drhon,dzn
integer, intent(out) :: flagprecfile
real(wp), intent(out) :: dtprec
character(:), allocatable, intent(out) :: indatsize,indatgrid, sourcedir, precdir, E0dir
integer, intent(out) :: flagE0file
real(wp), intent(out) :: dtE0
integer, intent(out) :: flagglow
real(wp), intent(out) :: dtglow, dtglowout
end subroutine read_configfile
end interface
contains
subroutine check_nan_array_1d(A, vname)
!! check if more than nan_threshold fraction (arbitrary) of array is NaN and fail sim.
!! otherwise, warn if any element, but less than nan_threshold fraction of array is NaN
real(wp), intent(in) :: A(:)
character(*), intent(in) :: vname
integer :: Asize, Abad
Abad = count(ieee_is_nan(A))
if (Abad > 0) write(stderr,'(/,A,I10,A,/)') 'WARNING: ', Abad, ' NaN in 1d ' // vname
if (Abad/size(A) > nan_threshold) then
write(stderr, '(/,A,/)') 'ERROR: excessive NaNs in ' // vname
error stop
endif
end subroutine check_nan_array_1d
subroutine check_nan_array_2d(A, vname)
!! check if more than nan_threshold fraction (arbitrary) of array is NaN and fail sim.
!! otherwise, warn if any element, but less than nan_threshold fraction of array is NaN
real(wp), intent(in) :: A(:, :)
character(*), intent(in) :: vname
integer :: Asize, Abad
Abad = count(ieee_is_nan(A))
if (Abad > 0) write(stderr,'(/,A,I10,A,/)') 'WARNING: ', Abad, ' NaN in 2d ' // vname
if (Abad/size(A) > nan_threshold) then
write(stderr, '(/,A,/)') 'ERROR: excessive NaNs in ' // vname
error stop
endif
end subroutine check_nan_array_2d
subroutine check_nan_array_3d(A, vname)
!! check if more than nan_threshold fraction (arbitrary) of array is NaN and fail sim.
!! otherwise, warn if any element, but less than nan_threshold fraction of array is NaN
real(wp), intent(in) :: A(:, :, :)
character(*), intent(in) :: vname
integer :: Asize, Abad
Abad = count(ieee_is_nan(A))
if (Abad > 0) write(stderr,'(/,A,I10,A,/)') 'WARNING: ', Abad, ' NaN in 3d ' // vname
if (Abad/size(A) > nan_threshold) then
write(stderr, '(/,A,/)') 'ERROR: excessive NaNs in ' // vname
error stop
endif
end subroutine check_nan_array_3d
subroutine check_nan_array_4d(A, vname)
!! check if more than nan_threshold fraction (arbitrary) of array is NaN and fail sim.
!! otherwise, warn if any element, but less than nan_threshold fraction of array is NaN
real(wp), intent(in) :: A(:, :, :, :)
character(*), intent(in) :: vname
integer :: Asize, Abad
Abad = count(ieee_is_nan(A))
if (Abad > 0) write(stderr,'(/,A,I10,A,/)') 'WARNING: ', Abad, ' NaN in 4d ' // vname
if (Abad/size(A) > nan_threshold) then
write(stderr, '(/,A,/)') 'ERROR: excessive NaNs in ' // vname
error stop
endif
end subroutine check_nan_array_4d
end module io