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

generated by
Intel(R) C++/Fortran Compiler code-coverage tool
Web-Page Owner: Nobody