22 integer(I4B),
pointer :: itrkout => null()
23 integer(I4B),
pointer :: itrkhdr => null()
24 integer(I4B),
pointer :: itrkcsv => null()
25 integer(I4B),
pointer :: itrktls => null()
26 logical(LGP),
pointer :: trackrelease => null()
27 logical(LGP),
pointer :: tracktransit => null()
28 logical(LGP),
pointer :: tracktimestep => null()
29 logical(LGP),
pointer :: trackterminate => null()
30 logical(LGP),
pointer :: trackweaksink => null()
31 logical(LGP),
pointer :: trackusertime => null()
45 subroutine oc_cr(ocobj, name_model, inunit, iout)
47 character(len=*),
intent(in) :: name_model
48 integer(I4B),
intent(in) :: inunit
49 integer(I4B),
intent(in) :: iout
55 call ocobj%allocate_scalars(name_model)
62 call ocobj%parser%Initialize(inunit, iout)
67 character(len=*),
intent(in) :: name_model
71 allocate (this%name_model)
72 call mem_allocate(this%inunit,
'INUNIT', this%memoryPath)
74 call mem_allocate(this%ibudcsv,
'IBUDCSV', this%memoryPath)
75 call mem_allocate(this%iperoc,
'IPEROC', this%memoryPath)
76 call mem_allocate(this%iocrep,
'IOCREP', this%memoryPath)
77 call mem_allocate(this%itrkout,
'ITRKOUT', this%memoryPath)
78 call mem_allocate(this%itrkhdr,
'ITRKHDR', this%memoryPath)
79 call mem_allocate(this%itrkcsv,
'ITRKCSV', this%memoryPath)
80 call mem_allocate(this%itrktls,
'ITRKTLS', this%memoryPath)
81 call mem_allocate(this%trackrelease,
'ITRACKRLS', this%memoryPath)
82 call mem_allocate(this%tracktransit,
'ITRACKTRS', this%memoryPath)
83 call mem_allocate(this%tracktimestep,
'ITRACKTST', this%memoryPath)
84 call mem_allocate(this%trackterminate,
'ITRACKTER', this%memoryPath)
85 call mem_allocate(this%trackweaksink,
'ITRACKWSK', this%memoryPath)
86 call mem_allocate(this%trackusertime,
'ITRACKTLS', this%memoryPath)
88 this%name_model = name_model
98 this%trackrelease = .false.
99 this%tracktransit = .false.
100 this%tracktimestep = .false.
101 this%trackterminate = .false.
102 this%trackweaksink = .false.
103 this%trackusertime = .false.
108 subroutine oc_ar(this, mass, dis, dnodata)
111 real(DP),
dimension(:),
pointer,
contiguous,
intent(in) :: mass
113 real(DP),
intent(in) :: dnodata
115 integer(I4B) :: i, nocdobj, inodata
117 real(DP),
dimension(:),
pointer,
contiguous :: nullvec => null()
120 allocate (this%tracktimes)
121 call this%tracktimes%init()
124 allocate (this%ocdobj(nocdobj))
129 call ocdobjptr%init_dbl(
'BUDGET', nullvec, dis,
'PRINT LAST ', &
130 'COLUMNS 10 WIDTH 11 DIGITS 4 GENERAL ', &
133 call ocdobjptr%init_dbl(
'MASS', mass, dis,
'PRINT LAST ', &
134 'COLUMNS 10 WIDTH 11 DIGITS 4 GENERAL ', &
137 this%ocdobj(i) = ocdobjptr
138 deallocate (ocdobjptr)
142 if (this%inunit > 0)
then
143 call this%read_options()
153 call this%tracktimes%destroy()
155 do i = 1,
size(this%ocdobj)
156 call this%ocdobj(i)%ocd_da()
158 deallocate (this%ocdobj)
160 deallocate (this%name_model)
190 character(len=LINELENGTH) :: keyword
191 character(len=LINELENGTH) :: keyword2
192 character(len=LINELENGTH) :: fname
193 character(len=:),
allocatable :: line
194 integer(I4B) :: i, ierr, ipos, ios, nlines
196 logical(LGP) :: isfound, found, endOfBlock, eventFound, success
199 character(len=*),
parameter :: fmttrkbin = &
200 "(4x, 'PARTICLE TRACKS WILL BE SAVED TO BINARY FILE: ', a, /4x, &
201 &'OPENED ON UNIT: ', I0)"
202 character(len=*),
parameter :: fmttrkcsv = &
203 "(4x, 'PARTICLE TRACKS WILL BE SAVED TO CSV FILE: ', a, /4x, &
204 &'OPENED ON UNIT: ', I0)"
207 call this%parser%GetBlock(
'OPTIONS', isfound, ierr, &
208 supportopenclose=.true., blockrequired=.false.)
212 write (this%iout,
'(/,1x,a,/)')
'PROCESSING OC OPTIONS'
215 call this%parser%GetNextLine(endofblock)
217 call this%parser%GetStringCaps(keyword)
219 select case (keyword)
221 call this%parser%GetStringCaps(keyword2)
222 if (keyword2 /=
'FILEOUT')
then
223 errmsg =
"BUDGETCSV must be followed by FILEOUT and then budget &
224 &csv file name. Found '"//trim(keyword2)//
"'."
226 call this%parser%StoreErrorUnit()
228 call this%parser%GetString(fname)
230 call openfile(this%ibudcsv, this%iout, fname,
'CSV', &
231 filstat_opt=
'REPLACE')
234 call this%parser%GetStringCaps(keyword)
235 if (keyword ==
'FILEOUT')
then
237 call this%parser%GetString(fname)
240 call openfile(this%itrkout, this%iout, fname,
'DATA(BINARY)', &
243 write (this%iout, fmttrkbin) trim(adjustl(fname)), this%itrkout
246 fname = trim(fname)//
'.hdr'
247 call openfile(this%itrkhdr, this%iout, fname,
'CSV', &
248 filstat_opt=
'REPLACE', mode_opt=mnormal)
251 call store_error(
'OPTIONAL TRACK KEYWORD MUST BE '// &
252 'FOLLOWED BY FILEOUT')
256 call this%parser%GetStringCaps(keyword)
257 if (keyword ==
'FILEOUT')
then
259 call this%parser%GetString(fname)
262 call openfile(this%itrkcsv, this%iout, fname,
'CSV', &
263 filstat_opt=
'REPLACE')
264 write (this%iout, fmttrkcsv) trim(adjustl(fname)), this%itrkcsv
267 call store_error(
'OPTIONAL TRACKCSV KEYWORD MUST BE &
268 &FOLLOWED BY FILEOUT')
274 case (
'TRACK_RELEASE')
275 this%trackrelease = .true.
278 case (
'TRACK_TRANSIT')
279 this%tracktransit = .true.
282 case (
'TRACK_TIMESTEP')
283 this%tracktimestep = .true.
286 case (
'TRACK_TERMINATE')
287 this%trackterminate = .true.
290 case (
'TRACK_WEAKSINK')
291 this%trackweaksink = .true.
294 case (
'TRACK_USERTIME')
295 this%trackusertime = .true.
301 call this%parser%TryGetDouble(dval, success)
302 if (.not. success)
exit ttloop
303 call this%tracktimes%expand()
304 this%tracktimes%times(
size(this%tracktimes%times)) = dval
306 if (.not. this%tracktimes%increasing())
then
307 errmsg =
"TRACK TIMES MUST STRICTLY INCREASE"
309 call this%parser%StoreErrorUnit(terminate=.true.)
311 this%trackusertime = .true.
313 case (
'TRACK_TIMESFILE')
314 call this%parser%GetString(fname)
315 call openfile(this%itrktls, this%iout, fname,
'TLS')
318 read (this%itrktls,
'(A)', iostat=ios) line
319 if (ios /= 0)
exit ttfloop
322 call this%tracktimes%expand(nlines)
324 allocate (
character(len=LINELENGTH) :: line)
326 read (this%itrktls,
'(A)') line
327 read (line,
'(f30.0)') dval
328 this%tracktimes%times(i) = dval
330 if (.not. this%tracktimes%increasing())
then
331 errmsg =
"TRACK TIMES MUST STRICTLY INCREASE"
333 call this%parser%StoreErrorUnit(terminate=.true.)
335 this%trackusertime = .true.
342 if (.not. found)
then
343 do ipos = 1,
size(this%ocdobj)
344 ocdobjptr => this%ocdobj(ipos)
345 if (keyword == trim(ocdobjptr%cname))
then
350 if (.not. found)
then
351 errmsg =
"UNKNOWN OC OPTION '"//trim(keyword)//
"'."
353 call this%parser%StoreErrorUnit()
355 call this%parser%GetRemainingLine(line)
356 call ocdobjptr%set_option(line, this%parser%iuactive, this%iout)
361 if (.not. eventfound)
then
362 this%trackrelease = .true.
363 this%tracktransit = .true.
364 this%tracktimestep = .true.
365 this%trackterminate = .true.
366 this%trackweaksink = .true.
367 this%trackusertime = .true.
371 write (this%iout,
'(1x,a)')
'END OF OC OPTIONS'
This module contains block parser methods.
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
@ mnormal
normal output mode
integer(i4b), parameter lenmodelname
maximum length of the model name
This module defines variable data types.
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
This module contains the OutputControlDataModule.
subroutine, public ocd_cr(ocdobj)
@ brief Create OutputControlDataType
This module contains the OutputControlModule.
subroutine oc_ar(this, mass, dis, dnodata)
@ brief Setup output control variables.
subroutine prt_oc_allocate_scalars(this, name_model)
subroutine prt_oc_da(this)
subroutine prt_oc_read_options(this)
subroutine, public oc_cr(ocobj, name_model, inunit, iout)
@ brief Create an output control object
This module contains simulation methods.
subroutine, public store_error(msg, terminate)
Store an error message.
subroutine, public store_error_unit(iunit, terminate)
Store the file unit number.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
character(len=maxcharlen) warnmsg
warning message string
Specify times for some event(s) to occur.
character(len= *), parameter, public trackheader
character(len= *), parameter, public trackdtypes
@ brief OutputControlDataType
@ brief OutputControlType
@ brief Output control for particle tracking models
Represents a series of instants at which some event should occur.