output_aux.F90 coverage: 95.45 %func 83.70 %block
1) module Output_Aux_module
2)
3) use PFLOTRAN_Constants_module
4)
5) implicit none
6)
7) private
8)
9) #include "petsc/finclude/petscsys.h"
10) !#include "petsc/finclude/petscviewer.h"
11)
12) PetscInt, parameter, public :: INSTANTANEOUS_VARS = 1
13) PetscInt, parameter, public :: AVERAGED_VARS = 2
14)
15) PetscInt, parameter, public :: CHECKPOINT_BINARY = 1
16) PetscInt, parameter, public :: CHECKPOINT_HDF5 = 2
17) PetscInt, parameter, public :: CHECKPOINT_BOTH = 3
18)
19) type, public :: checkpoint_option_type
20) character(len=MAXWORDLENGTH) :: tunit
21) PetscReal :: tconv
22) PetscReal :: periodic_time_incr
23) PetscInt :: periodic_ts_incr
24) PetscInt :: format
25) end type checkpoint_option_type
26)
27) type, public :: output_option_type
28)
29) character(len=MAXWORDLENGTH) :: tunit
30) PetscReal :: tconv
31)
32) PetscBool :: print_initial_obs
33) PetscBool :: print_final_obs
34) PetscBool :: print_initial_snap
35) PetscBool :: print_final_snap
36) PetscBool :: print_initial_massbal
37) PetscBool :: print_final_massbal
38)
39) PetscBool :: print_hdf5
40) PetscBool :: print_hdf5_vel_cent
41) PetscBool :: print_hdf5_vel_face
42) PetscBool :: print_single_h5_file
43) PetscInt :: times_per_h5_file
44) PetscBool :: print_hdf5_mass_flowrate
45) PetscBool :: print_hdf5_energy_flowrate
46) PetscBool :: print_hdf5_aveg_mass_flowrate
47) PetscBool :: print_hdf5_aveg_energy_flowrate
48) PetscBool :: print_explicit_flowrate
49)
50) PetscBool :: print_tecplot
51) PetscInt :: tecplot_format
52) PetscBool :: print_tecplot_vel_cent
53) PetscBool :: print_tecplot_vel_face
54) PetscBool :: print_fluxes
55)
56) PetscBool :: print_vtk
57) PetscBool :: print_vtk_vel_cent
58)
59) PetscBool :: print_observation
60) PetscBool :: print_column_ids
61)
62) PetscBool :: print_mad
63)
64) PetscInt :: screen_imod
65) PetscInt :: output_file_imod
66)
67) PetscInt :: periodic_snap_output_ts_imod
68) PetscInt :: periodic_obs_output_ts_imod
69) PetscInt :: periodic_msbl_output_ts_imod
70)
71) PetscReal :: periodic_snap_output_time_incr
72) PetscReal :: periodic_obs_output_time_incr
73) PetscReal :: periodic_msbl_output_time_incr
74)
75) PetscBool :: filter_non_state_variables
76)
77) PetscInt :: xmf_vert_len
78)
79) type(output_variable_list_type), pointer :: output_variable_list ! (master)
80) type(output_variable_list_type), pointer :: output_snap_variable_list
81) type(output_variable_list_type), pointer :: output_obs_variable_list
82) type(output_variable_list_type), pointer :: aveg_output_variable_list
83)
84) type(mass_balance_region_type), pointer :: mass_balance_region_list
85) PetscBool :: mass_balance_region_flag
86)
87) PetscReal :: aveg_var_time
88) PetscReal :: aveg_var_dtime
89)
90) PetscInt :: plot_number
91) character(len=MAXWORDLENGTH) :: plot_name
92)
93) PetscBool :: print_hydrograph
94) PetscInt :: surf_xmf_vert_len
95)
96) end type output_option_type
97)
98) type, public :: output_variable_list_type
99) type(output_variable_type), pointer :: first
100) type(output_variable_type), pointer :: last
101) PetscInt :: nvars
102) end type output_variable_list_type
103)
104) type, public :: output_variable_type
105) character(len=MAXWORDLENGTH) :: name ! string that appears in hdf5 file
106) character(len=MAXWORDLENGTH) :: units
107) ! jmf: change to snapshot_plot_only?
108) PetscBool :: plot_only
109) PetscInt :: iformat ! 0 = for REAL values; 1 = for INTEGER values
110) PetscInt :: icategory ! category for variable-specific regression testing
111) PetscInt :: ivar
112) PetscInt :: isubvar
113) PetscInt :: isubsubvar
114) type(output_variable_type), pointer :: next
115) end type output_variable_type
116)
117) type, public :: mass_balance_region_type
118) character(len=MAXWORDLENGTH) :: region_name
119) PetscInt :: num_cells
120) PetscInt, pointer :: region_cell_ids(:)
121) PetscReal :: total_mass
122) type(mass_balance_region_type), pointer :: next
123) end type mass_balance_region_type
124)
125) ! type, public, EXTENDS (output_variable_type) :: aveg_output_variable_type
126) ! PetscReal :: time_interval
127) ! end type aveg_output_variable_type
128)
129) interface OutputVariableCreate
130) module procedure OutputVariableCreate1
131) module procedure OutputVariableCreate2
132) module procedure OutputVariableCreate3
133) end interface OutputVariableCreate
134)
135) interface OutputVariableAddToList
136) module procedure OutputVariableAddToList1
137) module procedure OutputVariableAddToList2
138) end interface OutputVariableAddToList
139)
140) ! Output categories
141) PetscInt, parameter, public :: OUTPUT_GENERIC = 0
142) PetscInt, parameter, public :: OUTPUT_PRESSURE = 1
143) PetscInt, parameter, public :: OUTPUT_SATURATION = 2
144) PetscInt, parameter, public :: OUTPUT_CONCENTRATION = 3
145) PetscInt, parameter, public :: OUTPUT_RATE = 4
146) PetscInt, parameter, public :: OUTPUT_VOLUME_FRACTION = 5
147) PetscInt, parameter, public :: OUTPUT_DISCRETE = 6
148)
149) public :: OutputOptionCreate, &
150) OutputOptionDuplicate, &
151) OutputVariableCreate, &
152) OutputMassBalRegionCreate, &
153) OutputVariableListCreate, &
154) OutputVariableListDuplicate, &
155) OutputMassBalRegListDuplicate, &
156) OutputVariableAddToList, &
157) OutputWriteToHeader, &
158) OutputWriteVariableListToHeader, &
159) OutputVariableToCategoryString, &
160) OutputVariableAppendDefaults, &
161) OpenAndWriteInputRecord, &
162) OutputOptionDestroy, &
163) OutputVariableListDestroy, &
164) CheckpointOptionCreate, &
165) CheckpointOptionDestroy
166)
167) contains
168)
169) ! ************************************************************************** !
170)
171) function OutputOptionCreate()
172) !
173) ! Creates output options object
174) !
175) ! Author: Glenn Hammond
176) ! Date: 11/07/07
177) !
178)
179) implicit none
180)
181) type(output_option_type), pointer :: OutputOptionCreate
182)
183) type(output_option_type), pointer :: output_option
184)
185) allocate(output_option)
186) output_option%print_hdf5 = PETSC_FALSE
187) output_option%print_hdf5_vel_cent = PETSC_FALSE
188) output_option%print_hdf5_vel_face = PETSC_FALSE
189) output_option%print_single_h5_file = PETSC_TRUE
190) output_option%times_per_h5_file = 0
191) output_option%print_hdf5_mass_flowrate = PETSC_FALSE
192) output_option%print_hdf5_energy_flowrate = PETSC_FALSE
193) output_option%print_hdf5_aveg_mass_flowrate = PETSC_FALSE
194) output_option%print_hdf5_aveg_energy_flowrate = PETSC_FALSE
195) output_option%print_explicit_flowrate = PETSC_FALSE
196) output_option%print_tecplot = PETSC_FALSE
197) output_option%tecplot_format = 0
198) output_option%print_tecplot_vel_cent = PETSC_FALSE
199) output_option%print_fluxes = PETSC_FALSE
200) output_option%print_tecplot_vel_face = PETSC_FALSE
201) output_option%print_vtk = PETSC_FALSE
202) output_option%print_vtk_vel_cent = PETSC_FALSE
203) output_option%print_observation = PETSC_FALSE
204) output_option%print_column_ids = PETSC_FALSE
205) output_option%print_mad = PETSC_FALSE
206) output_option%print_initial_obs = PETSC_TRUE
207) output_option%print_final_obs = PETSC_TRUE
208) output_option%print_initial_snap = PETSC_TRUE
209) output_option%print_final_snap = PETSC_TRUE
210) output_option%print_initial_massbal = PETSC_FALSE
211) output_option%print_final_massbal = PETSC_TRUE
212) output_option%plot_number = 0
213) output_option%screen_imod = 1
214) output_option%output_file_imod = 1
215) output_option%periodic_snap_output_ts_imod = 100000000
216) output_option%periodic_obs_output_ts_imod = 100000000
217) output_option%periodic_msbl_output_ts_imod = 100000000
218) output_option%periodic_snap_output_time_incr = 0
219) output_option%periodic_obs_output_time_incr = 0
220) output_option%periodic_msbl_output_time_incr = 0
221) output_option%plot_name = ""
222) output_option%aveg_var_time = 0.d0
223) output_option%aveg_var_dtime = 0.d0
224) output_option%xmf_vert_len = UNINITIALIZED_INTEGER
225) output_option%filter_non_state_variables = PETSC_TRUE
226)
227) nullify(output_option%output_variable_list) ! master
228) output_option%output_variable_list => OutputVariableListCreate() ! master
229) nullify(output_option%output_snap_variable_list)
230) output_option%output_snap_variable_list => OutputVariableListCreate()
231) nullify(output_option%output_obs_variable_list)
232) output_option%output_obs_variable_list => OutputVariableListCreate()
233) nullify(output_option%aveg_output_variable_list)
234) output_option%aveg_output_variable_list => OutputVariableListCreate()
235)
236) nullify(output_option%mass_balance_region_list)
237) output_option%mass_balance_region_flag = PETSC_FALSE
238)
239) output_option%tconv = 1.d0
240) output_option%tunit = ''
241)
242) output_option%print_hydrograph = PETSC_FALSE
243)
244) OutputOptionCreate => output_option
245)
246) end function OutputOptionCreate
247)
248) ! ************************************************************************** !
249)
250) function OutputOptionDuplicate(output_option)
251) !
252) ! Creates a copy of output options object
253) !
254) ! Author: Gautam Bisht, LBNL
255) ! Date: 04/22/2016
256) !
257)
258) implicit none
259)
260) type(output_option_type), pointer :: output_option
261)
262) type(output_option_type), pointer :: OutputOptionDuplicate
263)
264) type(output_option_type), pointer :: output_option2
265)
266) allocate(output_option2)
267)
268) output_option2%print_hdf5 = output_option%print_hdf5
269) output_option2%print_hdf5_vel_cent = output_option%print_hdf5_vel_cent
270) output_option2%print_hdf5_vel_face = output_option%print_hdf5_vel_face
271) output_option2%print_single_h5_file = output_option%print_single_h5_file
272) output_option2%times_per_h5_file = output_option%times_per_h5_file
273) output_option2%print_hdf5_mass_flowrate = output_option%print_hdf5_mass_flowrate
274) output_option2%print_hdf5_energy_flowrate = output_option%print_hdf5_energy_flowrate
275) output_option2%print_hdf5_aveg_mass_flowrate = output_option%print_hdf5_aveg_mass_flowrate
276) output_option2%print_hdf5_aveg_energy_flowrate = output_option%print_hdf5_aveg_energy_flowrate
277) output_option2%print_explicit_flowrate = output_option%print_explicit_flowrate
278) output_option2%print_tecplot = output_option%print_tecplot
279) output_option2%tecplot_format = output_option%tecplot_format
280) output_option2%print_tecplot_vel_cent = output_option%print_tecplot_vel_cent
281) output_option2%print_fluxes = output_option%print_fluxes
282) output_option2%print_tecplot_vel_face = output_option%print_tecplot_vel_face
283) output_option2%print_vtk = output_option%print_vtk
284) output_option2%print_vtk_vel_cent = output_option%print_vtk_vel_cent
285) output_option2%print_observation = output_option%print_observation
286) output_option2%print_column_ids = output_option%print_column_ids
287) output_option2%print_mad = output_option%print_mad
288) output_option2%print_initial_obs = output_option%print_initial_obs
289) output_option2%print_final_obs = output_option%print_final_obs
290) output_option2%print_initial_snap = output_option%print_initial_snap
291) output_option2%print_final_snap = output_option%print_final_snap
292) output_option2%print_initial_massbal = output_option%print_initial_massbal
293) output_option2%print_final_massbal = output_option%print_final_massbal
294) output_option2%plot_number = output_option%plot_number
295) output_option2%screen_imod = output_option%screen_imod
296) output_option2%output_file_imod = output_option%output_file_imod
297) output_option2%periodic_snap_output_ts_imod = output_option%periodic_snap_output_ts_imod
298) output_option2%periodic_obs_output_ts_imod = output_option%periodic_obs_output_ts_imod
299) output_option2%periodic_msbl_output_ts_imod = output_option%periodic_msbl_output_ts_imod
300) output_option2%periodic_snap_output_time_incr = output_option%periodic_snap_output_time_incr
301) output_option2%periodic_obs_output_time_incr = output_option%periodic_obs_output_time_incr
302) output_option2%periodic_msbl_output_time_incr = output_option%periodic_msbl_output_time_incr
303) output_option2%plot_name = output_option%plot_name
304) output_option2%aveg_var_time = output_option%aveg_var_time
305) output_option2%aveg_var_dtime = output_option%aveg_var_dtime
306) output_option2%xmf_vert_len = output_option%xmf_vert_len
307) output_option2%filter_non_state_variables = output_option%filter_non_state_variables
308)
309) nullify(output_option2%output_variable_list)
310) nullify(output_option2%output_snap_variable_list)
311) nullify(output_option2%output_obs_variable_list)
312) nullify(output_option2%aveg_output_variable_list)
313)
314) output_option2%output_variable_list => &
315) OutputVariableListDuplicate(output_option%output_variable_list)
316) output_option2%output_snap_variable_list => &
317) OutputVariableListDuplicate(output_option%output_snap_variable_list)
318) output_option2%output_obs_variable_list => &
319) OutputVariableListDuplicate(output_option%output_obs_variable_list)
320) output_option2%aveg_output_variable_list => &
321) OutputVariableListDuplicate(output_option%aveg_output_variable_list)
322)
323) nullify(output_option2%mass_balance_region_list)
324) if (associated(output_option%mass_balance_region_list)) then
325) output_option2%mass_balance_region_list => &
326) OutputMassBalRegListDuplicate(output_option%mass_balance_region_list)
327) endif
328) output_option2%mass_balance_region_flag = &
329) output_option%mass_balance_region_flag
330)
331) output_option2%tconv = output_option%tconv
332) output_option2%tunit = output_option%tunit
333)
334) output_option2%print_hydrograph = output_option%print_hydrograph
335)
336) OutputOptionDuplicate => output_option2
337)
338) end function OutputOptionDuplicate
339)
340) ! ************************************************************************** !
341)
342) function CheckpointOptionCreate()
343) !
344) ! Creates output options object
345) !
346) ! Author: Glenn Hammond
347) ! Date: 11/07/07
348) !
349)
350) implicit none
351)
352) type(checkpoint_option_type), pointer :: CheckpointOptionCreate
353)
354) type(checkpoint_option_type), pointer :: checkpoint_option
355)
356) allocate(checkpoint_option)
357) checkpoint_option%tunit = ''
358) checkpoint_option%tconv = 0.d0
359) checkpoint_option%periodic_time_incr = UNINITIALIZED_DOUBLE
360) checkpoint_option%periodic_ts_incr = 0
361) !checkpoint_option%periodic_ts_incr = huge(checkpoint_option%periodic_ts_incr)
362) checkpoint_option%format = CHECKPOINT_BINARY
363)
364) CheckpointOptionCreate => checkpoint_option
365)
366) end function CheckpointOptionCreate
367)
368) ! ************************************************************************** !
369)
370) function OutputVariableCreate1()
371) !
372) ! initializes output variable object
373) !
374) ! Author: Glenn Hammond
375) ! Date: 10/15/12
376) !
377)
378) implicit none
379)
380) type(output_variable_type), pointer :: OutputVariableCreate1
381)
382) type(output_variable_type), pointer :: output_variable
383)
384) allocate(output_variable)
385) output_variable%name = ''
386) output_variable%units = ''
387) output_variable%plot_only = PETSC_FALSE
388) output_variable%iformat = 0
389) output_variable%icategory = OUTPUT_GENERIC
390) output_variable%ivar = 0
391) output_variable%isubvar = 0
392) output_variable%isubsubvar = 0
393) nullify(output_variable%next)
394)
395) OutputVariableCreate1 => output_variable
396)
397) end function OutputVariableCreate1
398)
399) ! ************************************************************************** !
400)
401) function OutputVariableCreate2(name,icategory,units,ivar,isubvar,isubsubvar)
402) !
403) ! initializes output variable object
404) !
405) ! Author: Glenn Hammond
406) ! Date: 10/15/12
407) !
408)
409) implicit none
410)
411) character(len=*) :: name
412) PetscInt :: icategory ! note that I tuck it inbetween the strings to avoid
413) ! errors
414) character(len=*) :: units
415) PetscInt :: ivar
416) PetscInt, intent(in), optional :: isubvar
417) PetscInt, intent(in), optional :: isubsubvar
418)
419) type(output_variable_type), pointer :: OutputVariableCreate2
420)
421) type(output_variable_type), pointer :: output_variable
422)
423) output_variable => OutputVariableCreate()
424) output_variable%name = trim(adjustl(name))
425) output_variable%icategory = icategory
426) output_variable%units = trim(adjustl(units))
427) output_variable%ivar = ivar
428) if (present(isubvar)) then
429) output_variable%isubvar = isubvar
430) endif
431) if (present(isubsubvar)) then
432) output_variable%isubsubvar = isubsubvar
433) endif
434) nullify(output_variable%next)
435)
436) OutputVariableCreate2 => output_variable
437)
438) end function OutputVariableCreate2
439)
440) ! ************************************************************************** !
441)
442) function OutputVariableCreate3(output_variable)
443) !
444) ! initializes output variable object from an existing
445) ! output variabl object
446) !
447) ! Author: Glenn Hammond
448) ! Date: 10/15/12
449) !
450)
451) implicit none
452)
453) type(output_variable_type), pointer :: output_variable
454)
455) type(output_variable_type), pointer :: OutputVariableCreate3
456)
457) type(output_variable_type), pointer :: new_output_variable
458)
459) allocate(new_output_variable)
460) new_output_variable%name = output_variable%name
461) new_output_variable%units = output_variable%units
462) new_output_variable%plot_only = output_variable%plot_only
463) new_output_variable%iformat = output_variable%iformat
464) new_output_variable%icategory = output_variable%icategory
465) new_output_variable%ivar = output_variable%ivar
466) new_output_variable%isubvar = output_variable%isubvar
467) new_output_variable%isubsubvar = output_variable%isubsubvar
468) nullify(new_output_variable%next)
469)
470) OutputVariableCreate3 => new_output_variable
471)
472) end function OutputVariableCreate3
473)
474) ! ************************************************************************** !
475)
476) function OutputVariableListCreate()
477) !
478) ! initializes output variable list object
479) !
480) ! Author: Glenn Hammond
481) ! Date: 10/15/12
482) !
483)
484) implicit none
485)
486) type(output_variable_list_type), pointer :: OutputVariableListCreate
487)
488) type(output_variable_list_type), pointer :: output_variable_list
489)
490) allocate(output_variable_list)
491) nullify(output_variable_list%first)
492) nullify(output_variable_list%last)
493) output_variable_list%nvars = 0
494)
495) OutputVariableListCreate => output_variable_list
496)
497) end function OutputVariableListCreate
498)
499) ! ************************************************************************** !
500)
501) function OutputMassBalRegionCreate()
502) !
503) ! Creates and initializes a mass balance region list object
504) !
505) ! Author: Jenn Frederick
506) ! Date: 04/26/2016
507) !
508)
509) implicit none
510)
511) type(mass_balance_region_type), pointer :: OutputMassBalRegionCreate
512)
513) allocate(OutputMassBalRegionCreate)
514) OutputMassBalRegionCreate%region_name =''
515) nullify(OutputMassBalRegionCreate%region_cell_ids)
516) OutputMassBalRegionCreate%num_cells = 0
517) OutputMassBalRegionCreate%total_mass = 0.d0
518) nullify(OutputMassBalRegionCreate%next)
519)
520) end function OutputMassBalRegionCreate
521)
522) ! ************************************************************************** !
523)
524) function OutputVariableListDuplicate(old_list)
525) !
526) ! initializes output variable list object
527) !
528) ! Author: Glenn Hammond
529) ! Date: 10/15/12
530) !
531)
532) implicit none
533)
534) type(output_variable_list_type) :: old_list
535)
536) type(output_variable_list_type), pointer :: OutputVariableListDuplicate
537)
538) type(output_variable_list_type), pointer :: new_list
539) type(output_variable_type), pointer :: cur_variable
540)
541) allocate(new_list)
542) nullify(new_list%first)
543) nullify(new_list%last)
544) new_list%nvars = old_list%nvars
545)
546) cur_variable => old_list%first
547) do
548) if (.not.associated(cur_variable)) exit
549) call OutputVariableAddToList(new_list,OutputVariableCreate(cur_variable))
550) cur_variable => cur_variable%next
551) enddo
552)
553) OutputVariableListDuplicate => new_list
554)
555) end function OutputVariableListDuplicate
556)
557) ! ************************************************************************** !
558)
559) function OutputMassBalRegListDuplicate(old_list)
560) !
561) ! Duplicates a mass balance region list object
562) !
563) ! Author: Jenn Frederick
564) ! Date: 04/27/2016
565) !
566)
567) implicit none
568)
569) type(mass_balance_region_type), pointer :: old_list
570)
571) type(mass_balance_region_type), pointer :: new_list
572) type(mass_balance_region_type), pointer :: new_mbr
573) type(mass_balance_region_type), pointer :: cur_mbr
574) type(mass_balance_region_type), pointer :: OutputMassBalRegListDuplicate
575) PetscBool :: added
576)
577) nullify(new_list)
578)
579) do
580) if (.not.associated(old_list)) exit
581) new_mbr => OutputMassBalRegionCreate()
582) new_mbr%region_name = old_list%region_name
583) new_mbr%num_cells = old_list%num_cells
584) new_mbr%region_cell_ids => old_list%region_cell_ids
585) new_mbr%total_mass = old_list%total_mass
586) ! Add new mass balance region to new list
587) if (.not.associated(new_list)) then
588) new_list => new_mbr
589) else
590) cur_mbr => new_list
591) do
592) if (.not.associated(cur_mbr)) exit
593) if (.not.associated(cur_mbr%next)) then
594) cur_mbr%next => new_mbr
595) added = PETSC_TRUE
596) endif
597) if (added) exit
598) cur_mbr => cur_mbr%next
599) enddo
600) endif
601) old_list => old_list%next
602) nullify(new_mbr)
603) enddo
604)
605) OutputMassBalRegListDuplicate => new_list
606)
607) end function OutputMassBalRegListDuplicate
608)
609) ! ************************************************************************** !
610)
611) subroutine OutputVariableAddToList1(list,variable)
612) !
613) ! adds variable to list object
614) !
615) ! Author: Glenn Hammond
616) ! Date: 10/15/12
617) !
618)
619) implicit none
620)
621) type(output_variable_list_type) :: list
622) type(output_variable_type), pointer :: variable
623)
624) if (.not. associated(list%first)) then
625) list%first => variable
626) else
627) list%last%next => variable
628) endif
629) list%last => variable
630)
631) list%nvars = list%nvars+1
632)
633) end subroutine OutputVariableAddToList1
634)
635) ! ************************************************************************** !
636)
637) subroutine OutputVariableAddToList2(list,name,icategory,units,ivar, &
638) isubvar,isubsubvar)
639) !
640) ! creates variable and adds to list object
641) !
642) ! Author: Glenn Hammond
643) ! Date: 10/15/12
644) !
645)
646) implicit none
647)
648) type(output_variable_list_type) :: list
649) character(len=*) :: name
650) character(len=*) :: units
651) PetscInt :: icategory
652) PetscInt :: ivar
653) PetscInt, intent(in), optional :: isubvar
654) PetscInt, intent(in), optional :: isubsubvar
655)
656) type(output_variable_type), pointer :: variable
657)
658) if (present(isubvar)) then
659) if (present(isubsubvar)) then
660) variable => OutputVariableCreate(name,icategory,units, &
661) ivar,isubvar,isubsubvar)
662) else
663) variable => OutputVariableCreate(name,icategory,units, &
664) ivar,isubvar)
665) endif
666) else
667) variable => OutputVariableCreate(name,icategory,units,ivar)
668) endif
669) call OutputVariableAddToList1(list,variable)
670)
671) end subroutine OutputVariableAddToList2
672)
673) ! ************************************************************************** !
674)
675) subroutine OutputWriteVariableListToHeader(fid,variable_list,cell_string, &
676) icolumn,plot_file,variable_count)
677) !
678) ! Converts a variable list to a header string
679) !
680) ! Author: Glenn Hammond
681) ! Date: 10/15/12
682) !
683)
684) use Option_module
685)
686) implicit none
687)
688) PetscInt :: fid
689) type(output_variable_list_type) :: variable_list
690) character(len=*) :: cell_string
691) PetscInt :: icolumn
692) PetscBool :: plot_file
693) PetscInt :: variable_count
694)
695) type(output_variable_type), pointer :: cur_variable
696) character(len=MAXWORDLENGTH) :: variable_name, units
697)
698) variable_count = 0
699) cur_variable => variable_list%first
700) do
701) if (.not.associated(cur_variable)) exit
702) if (.not. plot_file .and. cur_variable%plot_only) then
703) cur_variable => cur_variable%next
704) cycle
705) endif
706) variable_name = cur_variable%name
707) units = cur_variable%units
708) call OutputWriteToHeader(fid,variable_name,units,cell_string,icolumn)
709) variable_count = variable_count + 1
710) cur_variable => cur_variable%next
711) enddo
712)
713) end subroutine OutputWriteVariableListToHeader
714)
715) ! ************************************************************************** !
716)
717) subroutine OutputWriteToHeader(fid,variable_string,units_string, &
718) cell_string, icolumn)
719) !
720) ! Appends formatted strings to header string
721) !
722) ! Author: Glenn Hammond
723) ! Date: 10/27/11
724) !
725)
726) implicit none
727)
728) PetscInt :: fid
729) character(len=*) :: variable_string, units_string, cell_string
730) character(len=MAXWORDLENGTH) :: column_string
731) character(len=MAXWORDLENGTH) :: variable_string_adj, units_string_adj
732) character(len=MAXSTRINGLENGTH) :: cell_string_adj
733) PetscInt :: icolumn, len_cell_string, len_units
734)
735) character(len=MAXSTRINGLENGTH) :: string
736)
737) variable_string_adj = variable_string
738) units_string_adj = units_string
739) cell_string_adj = cell_string
740)
741) !geh: Shift to left. Cannot perform on same string since len=*
742) variable_string_adj = adjustl(variable_string_adj)
743) units_string_adj = adjustl(units_string_adj)
744) cell_string_adj = adjustl(cell_string_adj)
745)
746) if (icolumn > 0) then
747) icolumn = icolumn + 1
748) write(column_string,'(i4,''-'')') icolumn
749) column_string = trim(adjustl(column_string))
750) else
751) column_string = ''
752) endif
753)
754) !geh: this is all to remove the lousy spaces
755) len_units = len_trim(units_string)
756) len_cell_string = len_trim(cell_string)
757) if (len_units > 0 .and. len_cell_string > 0) then
758) write(string,'('',"'',a,a,'' ['',a,''] '',a,''"'')') trim(column_string), &
759) trim(variable_string_adj), trim(units_string_adj), &
760) trim(cell_string_adj)
761) else if (len_units > 0 .or. len_cell_string > 0) then
762) if (len_units > 0) then
763) write(string,'('',"'',a,a,'' ['',a,'']"'')') trim(column_string), &
764) trim(variable_string_adj), trim(units_string_adj)
765) else
766) write(string,'('',"'',a,a,'' '',a,''"'')') trim(column_string), &
767) trim(variable_string_adj), trim(cell_string_adj)
768) endif
769) else
770) write(string,'('',"'',a,a,''"'')') trim(column_string), &
771) trim(variable_string_adj)
772) endif
773) write(fid,'(a)',advance="no") trim(string)
774)
775) end subroutine OutputWriteToHeader
776)
777) ! ************************************************************************** !
778)
779) function OutputVariableToCategoryString(icategory)
780) !
781) ! returns a string associated with an
782) ! output variable category
783) !
784) ! Author: Glenn Hammond
785) ! Date: 10/15/12
786) !
787)
788) implicit none
789)
790) PetscInt :: icategory
791)
792) character(len=MAXWORDLENGTH) :: OutputVariableToCategoryString
793)
794) character(len=MAXWORDLENGTH) :: string
795)
796) select case(icategory)
797) case(OUTPUT_GENERIC)
798) string = 'GENERIC'
799) case(OUTPUT_PRESSURE)
800) string = 'PRESSURE'
801) case(OUTPUT_SATURATION)
802) string = 'SATURATION'
803) case(OUTPUT_CONCENTRATION)
804) string = 'CONCENTRATION'
805) case(OUTPUT_RATE)
806) string = 'RATE'
807) case(OUTPUT_VOLUME_FRACTION)
808) string = 'VOLUME_FRACTION'
809) case(OUTPUT_DISCRETE)
810) string = 'DISCRETE'
811) case default
812) string = 'GENERIC'
813) end select
814)
815) OutputVariableToCategoryString = string
816)
817) end function OutputVariableToCategoryString
818)
819) ! ************************************************************************** !
820)
821) subroutine OutputVariableAppendDefaults(output_variable_list,option)
822) !
823) ! Adds default output variables to list
824) !
825) ! Author: Gautam Bisht, LBNL
826) ! Date: 12/21/12
827) !
828)
829) use Option_module
830) use Variables_module
831)
832) implicit none
833)
834) type(output_variable_list_type), pointer :: output_variable_list
835) type(option_type), pointer :: option
836)
837) character(len=MAXWORDLENGTH) :: word
838) character(len=MAXWORDLENGTH) :: name, units
839) type(output_variable_type), pointer :: output_variable
840)
841) ! Material IDs
842) units = ''
843) name = 'Material ID'
844) output_variable => OutputVariableCreate(name,OUTPUT_DISCRETE, &
845) units,MATERIAL_ID)
846) output_variable%plot_only = PETSC_TRUE ! toggle output off for observation
847) output_variable%iformat = 1 ! integer
848) call OutputVariableAddToList(output_variable_list,output_variable)
849)
850) end subroutine OutputVariableAppendDefaults
851)
852) ! ************************************************************************** !
853)
854) subroutine OpenAndWriteInputRecord(option)
855) !
856) ! Opens the input record file and begins to write to it.
857) !
858) ! Author: Jenn Frederick, SNL
859) ! Date: 03/17/2016
860) !
861)
862) use Option_module
863)
864) implicit none
865)
866) type(option_type), pointer :: option
867)
868) character(len=MAXWORDLENGTH) :: word
869) character(len=MAXWORDLENGTH) :: filename
870) PetscInt :: id
871)
872) id = option%fid_inputrecord
873) filename = trim(option%global_prefix) // trim(option%group_prefix) // &
874) '-input-record.tec'
875) open(unit=id,file=filename,action="write",status="replace")
876) call fdate(word)
877) if (OptionPrintToFile(option)) then
878) write(id,'(a)') '---------------------------------------------------------&
879) &-----------------------'
880) write(id,'(a)') '---------------------------------------------------------&
881) &-----------------------'
882) write(id,'(a)') ' PFLOTRAN INPUT RECORD ' // trim(word)
883) write(id,'(a)') '---------------------------------------------------------&
884) &-----------------------'
885) write(id,'(a)') '---------------------------------------------------------&
886) &-----------------------'
887)
888) write(id,'(a18)',advance='no') 'input file: '
889) write(id,*) trim(option%global_prefix) // '.in'
890)
891) write(id,'(a18)',advance='no') 'group: '
892) write(id,*) trim(option%group_prefix)
893)
894) write(word,*) option%global_commsize
895) write(id,'(a18)',advance='no') 'n processors: '
896) write(id,*) trim(adjustl(word))
897) endif
898)
899) end subroutine OpenAndWriteInputRecord
900)
901) ! ************************************************************************** !
902)
903) subroutine OutputVariableListDestroy(output_variable_list)
904) !
905) ! Deallocates an output variable list object
906) !
907) ! Author: Glenn Hammond
908) ! Date: 10/15/12
909) !
910)
911) implicit none
912)
913) type(output_variable_list_type), pointer :: output_variable_list
914)
915) if (.not.associated(output_variable_list)) return
916)
917) nullify(output_variable_list%last)
918) call OutputVariableDestroy(output_variable_list%first)
919)
920) deallocate(output_variable_list)
921) nullify(output_variable_list)
922)
923) end subroutine OutputVariableListDestroy
924)
925) ! ************************************************************************** !
926)
927) recursive subroutine OutputVariableDestroy(output_variable)
928) !
929) ! Deallocates an output variable object
930) !
931) ! Author: Glenn Hammond
932) ! Date: 10/15/12
933) !
934)
935) implicit none
936)
937) type(output_variable_type), pointer :: output_variable
938)
939) if (.not.associated(output_variable)) return
940)
941) call OutputVariableDestroy(output_variable%next)
942)
943) deallocate(output_variable)
944) nullify(output_variable)
945)
946) end subroutine OutputVariableDestroy
947)
948) ! ************************************************************************** !
949)
950) subroutine CheckpointOptionDestroy(checkpoint_option)
951) !
952) ! Deallocates an output option
953) !
954) ! Author: Glenn Hammond
955) ! Date: 11/07/07
956) !
957)
958) implicit none
959)
960) type(checkpoint_option_type), pointer :: checkpoint_option
961)
962) if (.not.associated(checkpoint_option)) return
963)
964) deallocate(checkpoint_option)
965) nullify(checkpoint_option)
966)
967) end subroutine CheckpointOptionDestroy
968)
969) ! ************************************************************************** !
970)
971) recursive subroutine OutputMassBalRegDestroy(mass_balance_region)
972) !
973) ! Nullifies and deallocates a mass balance region object
974) !
975) ! Author: Jenn Frederick
976) ! Date: 04/27/2016
977) !
978)
979) implicit none
980)
981) type(mass_balance_region_type), pointer :: mass_balance_region
982)
983) if (associated(mass_balance_region)) then
984) ! do not deallocate because the region owns the cell_ids array,
985) ! not the mass_balance_region, so just nullify it
986) nullify(mass_balance_region%region_cell_ids)
987) if (associated(mass_balance_region%next)) then
988) call OutputMassBalRegDestroy(mass_balance_region%next)
989) endif
990) deallocate(mass_balance_region)
991) endif
992)
993) end subroutine OutputMassBalRegDestroy
994)
995) ! ************************************************************************** !
996)
997) subroutine OutputOptionDestroy(output_option)
998) !
999) ! Deallocates an output option
1000) !
1001) ! Author: Glenn Hammond
1002) ! Date: 11/07/07
1003) !
1004)
1005) implicit none
1006)
1007) type(output_option_type), pointer :: output_option
1008)
1009) if (.not.associated(output_option)) return
1010)
1011) if (associated(output_option%output_variable_list, &
1012) output_option%output_snap_variable_list)) then
1013) nullify(output_option%output_snap_variable_list)
1014) endif
1015)
1016) if (associated(output_option%output_variable_list, &
1017) output_option%output_obs_variable_list)) then
1018) nullify(output_option%output_obs_variable_list)
1019) endif
1020)
1021) call OutputVariableListDestroy(output_option%output_variable_list)
1022) call OutputVariableListDestroy(output_option%output_snap_variable_list)
1023) call OutputVariableListDestroy(output_option%output_obs_variable_list)
1024) call OutputVariableListDestroy(output_option%aveg_output_variable_list)
1025)
1026) call OutputMassBalRegDestroy(output_option%mass_balance_region_list)
1027)
1028) deallocate(output_option)
1029) nullify(output_option)
1030)
1031) end subroutine OutputOptionDestroy
1032)
1033) end module Output_Aux_module