output_tecplot.F90       coverage:  63.64 %func     46.14 %block


     1) module Output_Tecplot_module
     2) 
     3)   use Logging_module 
     4)   use Output_Aux_module
     5)   use Output_Common_module
     6)   
     7)   use PFLOTRAN_Constants_module
     8) 
     9)   implicit none
    10) 
    11)   private
    12) 
    13) #include "petsc/finclude/petscsys.h"
    14)   PetscInt, parameter, public :: TECPLOT_POINT_FORMAT = 1
    15)   PetscInt, parameter, public :: TECPLOT_BLOCK_FORMAT = 2
    16)   PetscInt, parameter, public :: TECPLOT_FEBRICK_FORMAT = 3
    17)   PetscInt, parameter, public :: TECPLOT_FEQUADRILATERAL_FORMAT = 4  
    18) 
    19) #include "petsc/finclude/petscvec.h"
    20) #include "petsc/finclude/petscvec.h90"
    21) #include "petsc/finclude/petscdm.h"
    22) #include "petsc/finclude/petscdm.h90"
    23) #include "petsc/finclude/petsclog.h"
    24) 
    25)   public :: OutputTecplotBlock, & 
    26)             OutputTecplotPoint, &
    27)             OutputVelocitiesTecplotBlock, &
    28)             OutputFluxVelocitiesTecplotBlk, &
    29)             OutputVelocitiesTecplotPoint, &
    30)             OutputVectorTecplot, &
    31)             GetCellConnectionsTecplot, &
    32)             WriteTecplotDatasetFromVec, &
    33)             WriteTecplotDatasetNumPerLine, &
    34)             WriteTecplotDataset, &
    35)             OutputPrintExplicitFlowrates, &
    36)             OutputSecondaryContinuumTecplot 
    37) 
    38) contains
    39) 
    40) ! ************************************************************************** !
    41) 
    42) subroutine OutputTecplotHeader(fid,realization_base,icolumn)
    43)   ! 
    44)   ! Print header to Tecplot file
    45)   ! 
    46)   ! Author: Glenn Hammond
    47)   ! Date: 01/13/12
    48)   ! 
    49) 
    50)   use Realization_Base_class, only : realization_base_type
    51)   use Grid_module
    52)   use Option_module
    53)   use Patch_module
    54)   
    55)   implicit none
    56) 
    57)   PetscInt :: fid
    58)   class(realization_base_type) :: realization_base
    59)   PetscInt :: icolumn
    60)   
    61)   character(len=MAXSTRINGLENGTH) :: string, string2
    62)   character(len=MAXWORDLENGTH) :: word
    63)   type(grid_type), pointer :: grid
    64)   type(option_type), pointer :: option
    65)   type(patch_type), pointer :: patch 
    66)   type(output_option_type), pointer :: output_option
    67)   PetscInt :: variable_count
    68)   PetscInt :: i
    69)   
    70)   patch => realization_base%patch
    71)   grid => patch%grid
    72)   option => realization_base%option
    73)   output_option => realization_base%output_option
    74) 
    75)   ! write header
    76)   ! write title
    77)   write(fid,'(''TITLE = "'',1es13.5," [",a1,'']"'')') &
    78)                 option%time/output_option%tconv,output_option%tunit
    79) 
    80)   ! initial portion of header
    81)   string = 'VARIABLES=' // &
    82)            '"X [m]",' // &
    83)            '"Y [m]",' // &
    84)            '"Z [m]"'
    85)   write(fid,'(a)',advance="no") trim(string)
    86) 
    87)   call OutputWriteVariableListToHeader(fid, &
    88)                                       output_option%output_snap_variable_list, &
    89)                                        '',icolumn,PETSC_TRUE,variable_count)
    90)   ! need to terminate line
    91)   write(fid,'(a)') ''
    92)   ! add x, y, z variables to count
    93)   variable_count = variable_count + 3
    94) 
    95)   !geh: due to pgi bug, cannot embed functions with calls to write() within
    96)   !     write statement
    97)   call OutputWriteTecplotZoneHeader(fid,realization_base,variable_count, &
    98)                                     output_option%tecplot_format)
    99) 
   100) end subroutine OutputTecplotHeader
   101) 
   102) ! ************************************************************************** !
   103) 
   104) subroutine OutputWriteTecplotZoneHeader(fid,realization_base,variable_count, &
   105)                                         tecplot_format)
   106)   ! 
   107)   ! Print zone header to Tecplot file
   108)   ! 
   109)   ! Author: Glenn Hammond
   110)   ! Date: 01/13/12
   111)   ! 
   112) 
   113)   use Realization_Base_class, only : realization_base_type
   114)   use Grid_module
   115)   use Grid_Unstructured_Aux_module
   116)   use Option_module
   117)   use String_module
   118)   
   119)   implicit none
   120) 
   121)   PetscInt :: fid
   122)   class(realization_base_type) :: realization_base
   123)   PetscInt :: variable_count
   124)   PetscInt :: tecplot_format
   125)   
   126)   character(len=MAXSTRINGLENGTH) :: string, string2, string3
   127)   type(grid_type), pointer :: grid
   128)   type(option_type), pointer :: option
   129)   type(output_option_type), pointer :: output_option
   130)   
   131)   grid => realization_base%patch%grid
   132)   option => realization_base%option
   133)   output_option => realization_base%output_option
   134) 
   135)   string = 'ZONE T="' // &
   136)            trim(StringFormatDouble(option%time/output_option%tconv)) // &
   137)            '"'
   138)   string2 = ''
   139)   select case(tecplot_format)
   140)     case (TECPLOT_POINT_FORMAT)
   141)       if (realization_base%discretization%itype == STRUCTURED_GRID) then
   142)         string2 = ', I=' // &
   143)                   trim(StringFormatInt(grid%structured_grid%nx)) // &
   144)                   ', J=' // &
   145)                   trim(StringFormatInt(grid%structured_grid%ny)) // &
   146)                   ', K=' // &
   147)                   trim(StringFormatInt(grid%structured_grid%nz))
   148)       else
   149)         string2 = 'POINT format currently not supported for unstructured'
   150)       endif  
   151)       string2 = trim(string2) // &
   152)               ', DATAPACKING=POINT'
   153)     case default !(TECPLOT_BLOCK_FORMAT,TECPLOT_FEBRICK_FORMAT)
   154)       select case (grid%itype)
   155)         case (STRUCTURED_GRID)
   156)           string2 = ', I=' // &
   157)                     trim(StringFormatInt(grid%structured_grid%nx+1)) // &
   158)                     ', J=' // &
   159)                     trim(StringFormatInt(grid%structured_grid%ny+1)) // &
   160)                     ', K=' // &
   161)                     trim(StringFormatInt(grid%structured_grid%nz+1))
   162)         case (IMPLICIT_UNSTRUCTURED_GRID)
   163)           string2 = ', N=' // &
   164)                     trim(StringFormatInt(grid%unstructured_grid% &
   165)                                            num_vertices_global)) // &
   166)                     ', E=' // &
   167)                     trim(StringFormatInt(grid%unstructured_grid%nmax))
   168)           string2 = trim(string2) // ', ZONETYPE=FEBRICK'
   169)         case (EXPLICIT_UNSTRUCTURED_GRID)
   170)           string2 = ', N=' // &
   171)                     trim(StringFormatInt(grid%unstructured_grid%nmax)) // &
   172)                     ', E=' // &
   173)                     trim(StringFormatInt(grid%unstructured_grid% &
   174)                                            explicit_grid%num_elems))
   175)           string2 = trim(string2) // ', ZONETYPE=FEBRICK'
   176)         case (POLYHEDRA_UNSTRUCTURED_GRID)
   177)           string2 = ', NODES=' // &
   178)                     trim(StringFormatInt(grid%unstructured_grid% &
   179)                                            num_vertices_global)) // &
   180)                     ', FACES=' // &
   181)                     trim(StringFormatInt(grid%unstructured_grid% &
   182)                                          polyhedra_grid%num_ufaces_global)) // &
   183)                     ', E=' // &
   184)                     trim(StringFormatInt(grid%unstructured_grid%nmax)) // &
   185)                     ', TotalNumFaceNodes=' // &
   186)                     trim(StringFormatInt(grid%unstructured_grid% &
   187)                                 polyhedra_grid%num_verts_of_ufaces_global)) // &
   188)                     ', NumConnectedBoundaryFaces=0' // &
   189)                     ', TotalNumBoundaryConnections=0'
   190)           string2 = trim(string2) // ', ZONETYPE=FEPOLYHEDRON'
   191)         case default
   192)           option%io_buffer = 'Extend OutputTecplotZoneHeader() for ' // &
   193)             'grid%ctype ' // trim(grid%ctype)
   194)           call printErrMsg(option)
   195)       end select
   196)       
   197)       if (grid%itype == EXPLICIT_UNSTRUCTURED_GRID) then
   198)         string3 = ', VARLOCATION=(NODAL)'
   199)       else
   200)         if (variable_count > 4) then
   201)           string3 = ', VARLOCATION=([4-' // &
   202)                     trim(StringFormatInt(variable_count)) // &
   203)                     ']=CELLCENTERED)'
   204)         else
   205)           string3 = ', VARLOCATION=([4]=CELLCENTERED)'
   206)         endif
   207)       endif
   208)       string2 = trim(string2) // trim(string3) // ', DATAPACKING=BLOCK'
   209)     
   210)     end select
   211)   
   212)   write(fid,'(a)') trim(string) // trim(string2)
   213) 
   214) end subroutine OutputWriteTecplotZoneHeader
   215) 
   216) ! ************************************************************************** !
   217) 
   218) subroutine OutputTecplotBlock(realization_base)
   219)   ! 
   220)   ! Print to Tecplot file in BLOCK format
   221)   ! 
   222)   ! Author: Glenn Hammond
   223)   ! Date: 10/25/07
   224)   ! 
   225) 
   226)   use Realization_Base_class, only : realization_base_type
   227)   use Discretization_module
   228)   use Grid_module
   229)   use Grid_Structured_module
   230)   use Grid_Unstructured_Aux_module
   231)   use Option_module
   232)   use Field_module
   233)   use Patch_module
   234)   
   235)   use Reaction_Aux_module
   236)  
   237)   implicit none
   238) 
   239)   class(realization_base_type) :: realization_base
   240)   
   241)   PetscInt :: i, comma_count, quote_count
   242)   PetscInt, parameter :: icolumn = -1
   243)   character(len=MAXSTRINGLENGTH) :: filename, string, string2
   244)   character(len=MAXWORDLENGTH) :: word
   245)   type(grid_type), pointer :: grid
   246)   type(option_type), pointer :: option
   247)   type(discretization_type), pointer :: discretization
   248)   type(field_type), pointer :: field
   249)   type(patch_type), pointer :: patch 
   250)   type(output_option_type), pointer :: output_option
   251)   type(output_variable_type), pointer :: cur_variable
   252)   PetscReal, pointer :: vec_ptr(:)
   253)   Vec :: global_vec
   254)   Vec :: natural_vec
   255)   PetscInt :: ivar, isubvar, var_type
   256)   PetscErrorCode :: ierr
   257)   
   258)   discretization => realization_base%discretization
   259)   patch => realization_base%patch
   260)   grid => patch%grid
   261)   option => realization_base%option
   262)   field => realization_base%field
   263)   output_option => realization_base%output_option
   264)   
   265)   filename = OutputFilename(output_option,option,'tec','')
   266)   
   267)   if (option%myrank == option%io_rank) then
   268)     option%io_buffer = '--> write tecplot output file: ' // trim(filename)
   269)     call printMsg(option)
   270)     open(unit=OUTPUT_UNIT,file=filename,action="write")
   271)     call OutputTecplotHeader(OUTPUT_UNIT,realization_base,icolumn)
   272)   endif
   273)     
   274)   ! write blocks
   275)   ! write out data sets  
   276)   call DiscretizationCreateVector(discretization,ONEDOF,global_vec,GLOBAL, &
   277)                                   option)  
   278)   call DiscretizationCreateVector(discretization,ONEDOF,natural_vec,NATURAL, &
   279)                                   option)
   280) 
   281)   ! write out coordinates
   282)   if (realization_base%discretization%itype == STRUCTURED_GRID) then
   283)     call WriteTecplotStructuredGrid(OUTPUT_UNIT,realization_base)
   284)   else
   285)     call WriteTecplotUGridVertices(OUTPUT_UNIT,realization_base)
   286)   endif
   287) 
   288)   ! loop over snapshot variables and write to file
   289)   cur_variable => output_option%output_snap_variable_list%first
   290)   do
   291)     if (.not.associated(cur_variable)) exit
   292)     call OutputGetVarFromArray(realization_base,global_vec,cur_variable%ivar, &
   293)                                 cur_variable%isubvar)
   294)     call DiscretizationGlobalToNatural(discretization,global_vec, &
   295)                                         natural_vec,ONEDOF)
   296)     if (cur_variable%iformat == 0) then
   297)       call WriteTecplotDataSetFromVec(OUTPUT_UNIT,realization_base,natural_vec, &
   298)                                       TECPLOT_REAL)
   299)     else
   300)       call WriteTecplotDataSetFromVec(OUTPUT_UNIT,realization_base,natural_vec, &
   301)                                       TECPLOT_INTEGER)
   302)     endif
   303)     cur_variable => cur_variable%next
   304)   enddo
   305) 
   306)   call VecDestroy(natural_vec,ierr);CHKERRQ(ierr)
   307)   call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
   308) 
   309)   if (realization_base%discretization%itype == UNSTRUCTURED_GRID .and. &
   310)       realization_base%discretization%grid%itype == &
   311)       IMPLICIT_UNSTRUCTURED_GRID)  then
   312)     call WriteTecplotUGridElements(OUTPUT_UNIT,realization_base)
   313)   endif
   314)   
   315)   if (realization_base%discretization%grid%itype ==  &
   316)         EXPLICIT_UNSTRUCTURED_GRID) then
   317)     call WriteTecplotExpGridElements(OUTPUT_UNIT,realization_base)
   318)   endif
   319) 
   320)   if (realization_base%discretization%grid%itype == POLYHEDRA_UNSTRUCTURED_GRID) then
   321)     call WriteTecplotPolyUGridElements(OUTPUT_UNIT,realization_base)
   322)   endif
   323) 
   324)   if (option%myrank == option%io_rank) close(OUTPUT_UNIT)
   325)   
   326)   if (output_option%print_tecplot_vel_cent) then
   327)     call OutputVelocitiesTecplotBlock(realization_base)
   328)   endif
   329)   
   330)   if (output_option%print_tecplot_vel_face .and. &
   331)       realization_base%discretization%itype == STRUCTURED_GRID) then
   332)     if (grid%structured_grid%nx > 1) then
   333)       call OutputFluxVelocitiesTecplotBlk(realization_base,LIQUID_PHASE, &
   334)                                           X_DIRECTION,PETSC_FALSE)
   335)       select case(option%iflowmode)
   336)         case(MPH_MODE,IMS_MODE,FLASH2_MODE,G_MODE)
   337)           call OutputFluxVelocitiesTecplotBlk(realization_base,GAS_PHASE, &
   338)                                               X_DIRECTION,PETSC_FALSE)
   339)       end select
   340)     endif
   341)     if (grid%structured_grid%ny > 1) then
   342)       call OutputFluxVelocitiesTecplotBlk(realization_base,LIQUID_PHASE, &
   343)                                           Y_DIRECTION,PETSC_FALSE)
   344)       select case(option%iflowmode)
   345)         case(MPH_MODE, IMS_MODE,FLASH2_MODE,G_MODE)
   346)           call OutputFluxVelocitiesTecplotBlk(realization_base,GAS_PHASE, &
   347)                                               Y_DIRECTION,PETSC_FALSE)
   348)       end select
   349)     endif
   350)     if (grid%structured_grid%nz > 1) then
   351)       call OutputFluxVelocitiesTecplotBlk(realization_base,LIQUID_PHASE, &
   352)                                           Z_DIRECTION,PETSC_FALSE)
   353)       select case(option%iflowmode)
   354)         case(MPH_MODE, IMS_MODE,FLASH2_MODE,G_MODE)
   355)           call OutputFluxVelocitiesTecplotBlk(realization_base,GAS_PHASE, &
   356)                                               Z_DIRECTION,PETSC_FALSE)
   357)       end select
   358)     endif
   359)   endif
   360)   if (output_option%print_fluxes .and. &
   361)       realization_base%discretization%itype == STRUCTURED_GRID) then
   362)     if (grid%structured_grid%nx > 1) then
   363)       select case(option%iflowmode)
   364)         case(G_MODE)
   365)           call OutputFluxVelocitiesTecplotBlk(realization_base,ONE_INTEGER, &
   366)                                               X_DIRECTION,PETSC_TRUE)
   367)           call OutputFluxVelocitiesTecplotBlk(realization_base,TWO_INTEGER, &
   368)                                               X_DIRECTION,PETSC_TRUE)
   369)           call OutputFluxVelocitiesTecplotBlk(realization_base,THREE_INTEGER, &
   370)                                               X_DIRECTION,PETSC_TRUE)
   371)       end select
   372)     endif
   373)     if (grid%structured_grid%ny > 1) then
   374)       select case(option%iflowmode)
   375)         case(G_MODE)
   376)           call OutputFluxVelocitiesTecplotBlk(realization_base,ONE_INTEGER, &
   377)                                               Y_DIRECTION,PETSC_TRUE)
   378)           call OutputFluxVelocitiesTecplotBlk(realization_base,TWO_INTEGER, &
   379)                                               Y_DIRECTION,PETSC_TRUE)
   380)           call OutputFluxVelocitiesTecplotBlk(realization_base,THREE_INTEGER, &
   381)                                               Y_DIRECTION,PETSC_TRUE)
   382)       end select
   383)     endif
   384)     if (grid%structured_grid%nz > 1) then
   385)       select case(option%iflowmode)
   386)         case(G_MODE)
   387)           call OutputFluxVelocitiesTecplotBlk(realization_base,ONE_INTEGER, &
   388)                                               Z_DIRECTION,PETSC_TRUE)
   389)           call OutputFluxVelocitiesTecplotBlk(realization_base,TWO_INTEGER, &
   390)                                               Z_DIRECTION,PETSC_TRUE)
   391)           call OutputFluxVelocitiesTecplotBlk(realization_base,THREE_INTEGER, &
   392)                                               Z_DIRECTION,PETSC_TRUE)
   393)       end select
   394)     endif
   395)   endif
   396)       
   397) end subroutine OutputTecplotBlock
   398) 
   399) ! ************************************************************************** !
   400) 
   401) subroutine OutputVelocitiesTecplotBlock(realization_base)
   402)   ! 
   403)   ! Print velocities to Tecplot file in BLOCK format
   404)   ! 
   405)   ! Author: Glenn Hammond
   406)   ! Date: 10/25/07
   407)   ! 
   408)  
   409)   use Realization_Base_class, only : realization_base_type
   410)   use Discretization_module
   411)   use Grid_module
   412)   use Grid_Unstructured_Aux_module
   413)   use Option_module
   414)   use Field_module
   415)   use Patch_module
   416)   use Variables_module
   417)   
   418)   implicit none
   419) 
   420)   class(realization_base_type) :: realization_base
   421)   
   422)   type(grid_type), pointer :: grid
   423)   type(option_type), pointer :: option
   424)   type(field_type), pointer :: field
   425)   type(discretization_type), pointer :: discretization
   426)   type(patch_type), pointer :: patch  
   427)   type(output_option_type), pointer :: output_option
   428)   character(len=MAXSTRINGLENGTH) :: filename
   429)   character(len=MAXSTRINGLENGTH) :: string
   430)   Vec :: global_vec
   431)   Vec :: global_vec_vx, global_vec_vy, global_vec_vz
   432)   Vec :: natural_vec
   433)   PetscInt :: variable_count
   434)   PetscErrorCode :: ierr
   435) 
   436)   PetscReal, pointer :: vec_ptr(:)
   437)   
   438)   patch => realization_base%patch
   439)   grid => patch%grid
   440)   field => realization_base%field
   441)   option => realization_base%option
   442)   output_option => realization_base%output_option
   443)   discretization => realization_base%discretization
   444) 
   445)   filename = OutputFilename(output_option,option,'tec','vel')
   446)   
   447)   if (option%myrank == option%io_rank) then
   448)     option%io_buffer = '--> write tecplot velocity output file: ' // &
   449)                        trim(filename)
   450)     call printMsg(option)
   451)     open(unit=OUTPUT_UNIT,file=filename,action="write")
   452)   
   453)     ! write header
   454)     ! write title
   455)     write(OUTPUT_UNIT,'(''TITLE = "'',1es13.5," [",a1,'']"'')') &
   456)                  option%time/output_option%tconv,output_option%tunit
   457)     ! write variables
   458)     string = 'VARIABLES=' // &
   459)              '"X [m]",' // &
   460)              '"Y [m]",' // &
   461)              '"Z [m]",' // &
   462)              '"qlx [m/' // trim(output_option%tunit) // ']",' // &
   463)              '"qly [m/' // trim(output_option%tunit) // ']",' // &
   464)              '"qlz [m/' // trim(output_option%tunit) // ']"'
   465)     if (option%nphase > 1) then
   466)       string = trim(string) // &
   467)                ',"qgx [m/' // trim(output_option%tunit) // ']",' // &
   468)                '"qgy [m/' // trim(output_option%tunit) // ']",' // &
   469)                '"qgz [m/' // trim(output_option%tunit) // ']"'
   470)     endif
   471) 
   472)     string = trim(string) // ',"Material_ID"'
   473)     write(OUTPUT_UNIT,'(a)') trim(string)
   474)   
   475)     variable_count = SEVEN_INTEGER
   476)     if (option%nphase > 1) variable_count = TEN_INTEGER
   477)     call OutputWriteTecplotZoneHeader(OUTPUT_UNIT,realization_base, &
   478)                                       variable_count,TECPLOT_BLOCK_FORMAT)
   479)   endif
   480)   
   481)   ! write blocks
   482)   ! write out data sets  
   483)   call DiscretizationCreateVector(discretization,ONEDOF,global_vec,GLOBAL, &
   484)                                   option)  
   485)   call DiscretizationCreateVector(discretization,ONEDOF,natural_vec,NATURAL, &
   486)                                   option)    
   487)   call DiscretizationDuplicateVector(discretization,global_vec,global_vec_vx)
   488)   call DiscretizationDuplicateVector(discretization,global_vec,global_vec_vy)
   489)   call DiscretizationDuplicateVector(discretization,global_vec,global_vec_vz)
   490) 
   491)   ! write out coorindates
   492)   if (realization_base%discretization%itype == STRUCTURED_GRID)  then
   493)     call WriteTecplotStructuredGrid(OUTPUT_UNIT,realization_base)
   494)   else
   495)     call WriteTecplotUGridVertices(OUTPUT_UNIT,realization_base)
   496)   endif
   497)   
   498)   call OutputGetCellCenteredVelocities(realization_base,global_vec_vx, &
   499)                                        global_vec_vy,global_vec_vz,LIQUID_PHASE)
   500) 
   501)   call DiscretizationGlobalToNatural(discretization,global_vec_vx,natural_vec,ONEDOF)
   502)   call WriteTecplotDataSetFromVec(OUTPUT_UNIT,realization_base,natural_vec,TECPLOT_REAL)
   503) 
   504)   call DiscretizationGlobalToNatural(discretization,global_vec_vy,natural_vec,ONEDOF)
   505)   call WriteTecplotDataSetFromVec(OUTPUT_UNIT,realization_base,natural_vec,TECPLOT_REAL)
   506) 
   507)   call DiscretizationGlobalToNatural(discretization,global_vec_vz,natural_vec,ONEDOF)
   508)   call WriteTecplotDataSetFromVec(OUTPUT_UNIT,realization_base,natural_vec,TECPLOT_REAL)
   509) 
   510)   if (option%nphase > 1) then
   511)     call OutputGetCellCenteredVelocities(realization_base,global_vec_vx, &
   512)                                          global_vec_vy,global_vec_vz,GAS_PHASE)
   513) 
   514)     call DiscretizationGlobalToNatural(discretization,global_vec_vx,natural_vec,ONEDOF)
   515)     call WriteTecplotDataSetFromVec(OUTPUT_UNIT,realization_base,natural_vec,TECPLOT_REAL)
   516) 
   517)     call DiscretizationGlobalToNatural(discretization,global_vec_vy,natural_vec,ONEDOF)
   518)     call WriteTecplotDataSetFromVec(OUTPUT_UNIT,realization_base,natural_vec,TECPLOT_REAL)
   519) 
   520)     call DiscretizationGlobalToNatural(discretization,global_vec_vz,natural_vec,ONEDOF)
   521)     call WriteTecplotDataSetFromVec(OUTPUT_UNIT,realization_base,natural_vec,TECPLOT_REAL)
   522)   endif
   523) 
   524)   ! material id
   525)   call OutputGetVarFromArray(realization_base,global_vec,MATERIAL_ID,ZERO_INTEGER)
   526)   call DiscretizationGlobalToNatural(discretization,global_vec,natural_vec,ONEDOF)
   527)   call WriteTecplotDataSetFromVec(OUTPUT_UNIT,realization_base,natural_vec,TECPLOT_INTEGER)
   528)   
   529)   call VecDestroy(natural_vec,ierr);CHKERRQ(ierr)
   530)   call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
   531)   call VecDestroy(global_vec_vx,ierr);CHKERRQ(ierr)
   532)   call VecDestroy(global_vec_vy,ierr);CHKERRQ(ierr)
   533)   call VecDestroy(global_vec_vz,ierr);CHKERRQ(ierr)
   534) 
   535)   if (realization_base%discretization%itype == UNSTRUCTURED_GRID .and. &
   536)       realization_base%discretization%grid%itype == &
   537)       IMPLICIT_UNSTRUCTURED_GRID)  then
   538)     call WriteTecplotUGridElements(OUTPUT_UNIT,realization_base)
   539)   endif
   540)   
   541)   if (realization_base%discretization%itype == UNSTRUCTURED_GRID .and. &
   542)       realization_base%discretization%grid%itype ==  &
   543)       EXPLICIT_UNSTRUCTURED_GRID) then
   544)     call WriteTecplotExpGridElements(OUTPUT_UNIT,realization_base)
   545)   endif
   546)   
   547)   if (option%myrank == option%io_rank) close(OUTPUT_UNIT)
   548)   
   549) end subroutine OutputVelocitiesTecplotBlock
   550) 
   551) ! ************************************************************************** !
   552) 
   553) subroutine OutputFluxVelocitiesTecplotBlk(realization_base,iphase, &
   554)                                           direction,output_flux)
   555)   ! 
   556)   ! Print intercellular fluxes to Tecplot file
   557)   ! in BLOCK format
   558)   ! 
   559)   ! Author: Glenn Hammond
   560)   ! Date: 10/25/07
   561)   ! 
   562) !geh - specifically, the flow velocities at the interfaces between cells
   563)  
   564)   use Realization_Base_class, only : realization_base_type
   565)   use Discretization_module
   566)   use Grid_module
   567)   use Option_module
   568)   use Field_module
   569)   use Connection_module
   570)   use Patch_module
   571)   
   572)   implicit none
   573) 
   574)   class(realization_base_type) :: realization_base
   575)   PetscInt :: iphase
   576)   PetscInt :: direction
   577)   PetscBool :: output_flux
   578)   
   579)   type(grid_type), pointer :: grid
   580)   type(option_type), pointer :: option
   581)   type(field_type), pointer :: field
   582)   type(patch_type), pointer :: patch
   583)   type(discretization_type), pointer :: discretization  
   584)   type(output_option_type), pointer :: output_option
   585)   
   586)   character(len=MAXSTRINGLENGTH) :: filename
   587)   character(len=MAXSTRINGLENGTH) :: string
   588)   
   589)   PetscInt :: local_size, global_size
   590)   PetscInt :: nx_local, ny_local, nz_local
   591)   PetscInt :: nx_global, ny_global, nz_global
   592)   PetscInt :: i, j, k
   593)   PetscInt :: local_id, ghosted_id
   594)   PetscInt :: adjusted_size
   595)   PetscInt :: count, iconn, sum_connection
   596)   PetscReal, pointer :: vec_ptr(:)
   597)   PetscReal, pointer :: array(:)
   598)   PetscInt, allocatable :: indices(:)
   599)   Vec :: global_vec, global_vec2
   600)   PetscReal :: sum, average, max, min , std_dev
   601)   PetscInt :: max_loc, min_loc
   602)   PetscErrorCode :: ierr
   603) 
   604)   type(connection_set_list_type), pointer :: connection_set_list
   605)   type(connection_set_type), pointer :: cur_connection_set
   606)     
   607)   nullify(array)
   608) 
   609)   call PetscLogEventBegin(logging%event_output_write_flux_tecplot, &
   610)                           ierr);CHKERRQ(ierr)
   611)                           
   612)   discretization => realization_base%discretization
   613)   patch => realization_base%patch
   614)   grid => patch%grid
   615)   option => realization_base%option
   616)   field => realization_base%field
   617)   output_option => realization_base%output_option
   618)   
   619)   ! open file
   620)   if (len_trim(output_option%plot_name) > 2) then
   621)     filename = trim(output_option%plot_name) // '-'
   622)   else  
   623)     filename = trim(option%global_prefix) // trim(option%group_prefix) // '-'
   624)   endif
   625)   
   626)   if (output_flux) then
   627)     select case(iphase)
   628)       case(ONE_INTEGER)
   629)         filename = trim(filename) // 'qw'
   630)       case(TWO_INTEGER)
   631)         filename = trim(filename) // 'qa'
   632)       case(THREE_INTEGER)
   633)         filename = trim(filename) // 'qh'
   634)     end select
   635)   else
   636)     select case(iphase)
   637)       case(LIQUID_PHASE)
   638)         filename = trim(filename) // 'ql'
   639)       case(GAS_PHASE)
   640)         filename = trim(filename) // 'qg'
   641)     end select
   642)   endif
   643)   
   644)   select case(direction)
   645)     case(X_DIRECTION)
   646)       filename = trim(filename) // 'x'
   647)     case(Y_DIRECTION)
   648)       filename = trim(filename) // 'y'
   649)     case(Z_DIRECTION)
   650)       filename = trim(filename) // 'z'
   651)   end select 
   652)   
   653)   string = trim(OutputFilenameID(output_option,option))
   654)   
   655)   filename = trim(filename) // '-' // trim(string) // '.tec'
   656)   
   657)   if (option%myrank == option%io_rank) then
   658)     option%io_buffer = '--> write tecplot velocity flux output file: ' // &
   659)                        trim(filename)
   660)     call printMsg(option)
   661)     open(unit=OUTPUT_UNIT,file=filename,action="write")
   662)   
   663)     ! write header
   664)     ! write title
   665)     write(OUTPUT_UNIT,'(''TITLE = "'',1es13.5," [",a1,'']"'')') &
   666)                  option%time/output_option%tconv,output_option%tunit
   667)     ! write variables
   668)     string = 'VARIABLES=' // &
   669)              '"X [m]",' // &
   670)              '"Y [m]",' // &
   671)              '"Z [m]",'
   672)              
   673)     if (output_flux) then
   674)       select case(iphase)
   675)         case(ONE_INTEGER)
   676)           filename = trim(filename) // 'Water'
   677)         case(TWO_INTEGER)
   678)           filename = trim(filename) // 'Air'
   679)         case(THREE_INTEGER)
   680)           filename = trim(filename) // 'Energy'
   681)       end select
   682)     else
   683)       select case(iphase)
   684)         case(LIQUID_PHASE)
   685)           string = trim(string) // '"Liquid'
   686)         case(GAS_PHASE)
   687)           string = trim(string) // '"Gas'
   688)       end select
   689)     endif
   690)   
   691)     select case(direction)
   692)       case(X_DIRECTION)
   693)         string = trim(string) // ' qx ['
   694)       case(Y_DIRECTION)
   695)         string = trim(string) // ' qy ['
   696)       case(Z_DIRECTION)
   697)         string = trim(string) // ' qz ['
   698)     end select 
   699)     
   700)     ! mass units
   701)     if (output_flux) then
   702)       string = trim(string) // 'kmol/'
   703)     else
   704)       string = trim(string) // 'm/'
   705)     endif
   706)     string = trim(string) // trim(output_option%tunit) // ']"'
   707)     
   708)     write(OUTPUT_UNIT,'(a)') trim(string)
   709)   
   710)     ! write zone header
   711)     select case(direction)
   712)       case(X_DIRECTION)
   713)         write(string,'(''ZONE T= "'',1es13.5,''",'','' I='',i4,'', J='',i4, &
   714)                      &'', K='',i4)') &
   715)                      option%time/output_option%tconv,grid%structured_grid%nx-1,grid%structured_grid%ny,grid%structured_grid%nz 
   716)       case(Y_DIRECTION)
   717)         write(string,'(''ZONE T= "'',1es13.5,''",'','' I='',i4,'', J='',i4, &
   718)                      &'', K='',i4)') &
   719)                      option%time/output_option%tconv,grid%structured_grid%nx,grid%structured_grid%ny-1,grid%structured_grid%nz 
   720)       case(Z_DIRECTION)
   721)         write(string,'(''ZONE T= "'',1es13.5,''",'','' I='',i4,'', J='',i4, &
   722)                      &'', K='',i4)') &
   723)                      option%time/output_option%tconv,grid%structured_grid%nx,grid%structured_grid%ny,grid%structured_grid%nz-1
   724)     end select 
   725)     string = trim(string) // ', DATAPACKING=BLOCK'
   726)     write(OUTPUT_UNIT,'(a)') trim(string)
   727) 
   728)   endif
   729)   
   730)   ! write blocks'
   731)   
   732)   ! face coordinates
   733)   local_size = grid%nlmax
   734)   global_size = grid%nmax
   735) !GEH - Structured Grid Dependence - Begin
   736)   nx_local = grid%structured_grid%nlx
   737)   ny_local = grid%structured_grid%nly
   738)   nz_local = grid%structured_grid%nlz
   739)   nx_global = grid%structured_grid%nx
   740)   ny_global = grid%structured_grid%ny
   741)   nz_global = grid%structured_grid%nz
   742)   select case(direction)
   743)     case(X_DIRECTION)
   744)       global_size = grid%nmax-grid%structured_grid%ny*grid%structured_grid%nz
   745)       nx_global = grid%structured_grid%nx-1
   746)       if (grid%structured_grid%gxe-grid%structured_grid%lxe == 0) then
   747)         local_size = grid%nlmax-grid%structured_grid%nlyz
   748)         nx_local = grid%structured_grid%nlx-1
   749)       endif
   750)     case(Y_DIRECTION)
   751)       global_size = grid%nmax-grid%structured_grid%nx*grid%structured_grid%nz
   752)       ny_global = grid%structured_grid%ny-1
   753)       if (grid%structured_grid%gye-grid%structured_grid%lye == 0) then
   754)         local_size = grid%nlmax-grid%structured_grid%nlxz
   755)         ny_local = grid%structured_grid%nly-1
   756)       endif
   757)     case(Z_DIRECTION)
   758)       global_size = grid%nmax-grid%structured_grid%nxy
   759)       nz_global = grid%structured_grid%nz-1
   760)       if (grid%structured_grid%gze-grid%structured_grid%lze == 0) then
   761)         local_size = grid%nlmax-grid%structured_grid%nlxy
   762)         nz_local = grid%structured_grid%nlz-1
   763)       endif
   764)   end select  
   765)   allocate(indices(local_size))
   766) 
   767)   ! fill indices array with natural ids in newly sized array
   768)   count = 0
   769)   do k=1,nz_local
   770)     do j=1,ny_local
   771)       do i=1,nx_local
   772)         count = count + 1
   773)         indices(count) = i+grid%structured_grid%lxs+ &
   774)                          (j-1+grid%structured_grid%lys)*nx_global+ &
   775)                          (k-1+grid%structured_grid%lzs)*nx_global*ny_global
   776)       enddo
   777)     enddo
   778)   enddo
   779)   
   780)   ! X-coordinates
   781)   count = 0
   782)   allocate(array(local_size))
   783)   do k=1,nz_local
   784)     do j=1,ny_local
   785)       do i=1,nx_local
   786)         count = count + 1
   787)         local_id = i+(j-1)*grid%structured_grid%nlx+ &
   788)                    (k-1)*grid%structured_grid%nlxy
   789)         ghosted_id = grid%nL2G(local_id)
   790)         array(count) = grid%x(ghosted_id)
   791)         if (direction == X_DIRECTION) &
   792)           array(count) = array(count) + &
   793)                          0.5d0*grid%structured_grid%dx(ghosted_id)
   794)       enddo
   795)     enddo
   796)   enddo
   797)   ! warning: adjusted size will be changed in ConvertArrayToNatural
   798)   ! thus, you cannot pass in local_size, since it is needed later
   799)   adjusted_size = local_size
   800)   call ConvertArrayToNatural(indices,array,adjusted_size,global_size,option)
   801)   call WriteTecplotDataSet(OUTPUT_UNIT,realization_base,array,TECPLOT_REAL, &
   802)                            adjusted_size)
   803)   ! since the array has potentially been resized, must reallocate
   804)   deallocate(array)
   805)   nullify(array)
   806) 
   807)   ! Y-coordinates
   808)   count = 0
   809)   allocate(array(local_size))
   810)   do k=1,nz_local
   811)     do j=1,ny_local
   812)       do i=1,nx_local
   813)         count = count + 1
   814)         local_id = i+(j-1)*grid%structured_grid%nlx+ &
   815)                    (k-1)*grid%structured_grid%nlxy
   816)         ghosted_id = grid%nL2G(local_id)        
   817)         array(count) = grid%y(ghosted_id)
   818)         if (direction == Y_DIRECTION) &
   819)           array(count) = array(count) + &
   820)                          0.5d0*grid%structured_grid%dy(ghosted_id)
   821)       enddo
   822)     enddo
   823)   enddo
   824)   adjusted_size = local_size
   825)   call ConvertArrayToNatural(indices,array,adjusted_size,global_size,option)
   826)   call WriteTecplotDataSet(OUTPUT_UNIT,realization_base,array,TECPLOT_REAL, &
   827)                            adjusted_size)
   828)   deallocate(array)
   829)   nullify(array)
   830) 
   831)   ! Z-coordinates
   832)   count = 0
   833)   allocate(array(local_size))
   834)   do k=1,nz_local
   835)     do j=1,ny_local
   836)       do i=1,nx_local
   837)         count = count + 1
   838)         local_id = i+(j-1)*grid%structured_grid%nlx+ &
   839)                    (k-1)*grid%structured_grid%nlxy
   840)         ghosted_id = grid%nL2G(local_id)        
   841)         array(count) = grid%z(ghosted_id)
   842)         if (direction == Z_DIRECTION) &
   843)           array(count) = array(count) + &
   844)                          0.5d0*grid%structured_grid%dz(ghosted_id)
   845)       enddo
   846)     enddo
   847)   enddo
   848)   adjusted_size = local_size
   849)   call ConvertArrayToNatural(indices,array,adjusted_size,global_size,option)
   850)   call WriteTecplotDataSet(OUTPUT_UNIT,realization_base,array,TECPLOT_REAL, &
   851)                            adjusted_size)
   852)   deallocate(array)
   853)   nullify(array)
   854) 
   855)   call DiscretizationCreateVector(discretization,ONEDOF,global_vec,GLOBAL, &
   856)                                   option) 
   857)   call VecZeroEntries(global_vec,ierr);CHKERRQ(ierr)
   858)   call VecGetArrayF90(global_vec,vec_ptr,ierr);CHKERRQ(ierr)
   859)   
   860)   ! place interior velocities in a vector
   861)   connection_set_list => grid%internal_connection_set_list
   862)   cur_connection_set => connection_set_list%first
   863)   sum_connection = 0
   864)   do 
   865)     if (.not.associated(cur_connection_set)) exit
   866)     do iconn = 1, cur_connection_set%num_connections
   867)       sum_connection = sum_connection + 1
   868)       ghosted_id = cur_connection_set%id_up(iconn)
   869)       local_id = grid%nG2L(ghosted_id) ! = zero for ghost nodes
   870)       ! velocities are stored as the downwind face of the upwind cell
   871)       if (local_id <= 0 .or. &
   872)           dabs(cur_connection_set%dist(direction,iconn)) < 0.99d0) cycle
   873)       if (output_flux) then
   874)         ! iphase here is really teh dof
   875)         vec_ptr(local_id) = patch%internal_flow_fluxes(iphase,sum_connection)
   876)       else
   877)         vec_ptr(local_id) = patch%internal_velocities(iphase,sum_connection)
   878)       endif
   879)     enddo
   880)     cur_connection_set => cur_connection_set%next
   881)   enddo
   882) 
   883)   ! write out data set 
   884)   count = 0 
   885)   allocate(array(local_size)) 
   886)   do k=1,nz_local 
   887)     do j=1,ny_local 
   888)       do i=1,nx_local 
   889)         count = count + 1 
   890)         local_id = i+(j-1)*grid%structured_grid%nlx+ &
   891)                    (k-1)*grid%structured_grid%nlxy 
   892)         array(count) = vec_ptr(local_id) 
   893)       enddo 
   894)     enddo 
   895)   enddo 
   896)   call VecRestoreArrayF90(global_vec,vec_ptr,ierr);CHKERRQ(ierr)
   897)    
   898)   call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
   899) 
   900) !GEH - Structured Grid Dependence - End
   901)   
   902)   ! convert time units
   903)   array(1:local_size) = array(1:local_size)*output_option%tconv 
   904)   
   905)   adjusted_size = local_size
   906)   call ConvertArrayToNatural(indices,array,adjusted_size,global_size,option)
   907)   call WriteTecplotDataSet(OUTPUT_UNIT,realization_base,array,TECPLOT_REAL, &
   908)                            adjusted_size)
   909)   deallocate(array)
   910)   nullify(array)
   911)   
   912)   deallocate(indices)
   913) 
   914)   if (option%myrank == option%io_rank) close(OUTPUT_UNIT)
   915) 
   916)   call PetscLogEventEnd(logging%event_output_write_flux_tecplot, &
   917)                         ierr);CHKERRQ(ierr)
   918)   
   919) end subroutine OutputFluxVelocitiesTecplotBlk
   920) 
   921) ! ************************************************************************** !
   922) 
   923) subroutine OutputTecplotPoint(realization_base)
   924)   ! 
   925)   ! Print to Tecplot file in POINT format
   926)   ! 
   927)   ! Author: Glenn Hammond
   928)   ! Date: 11/03/08
   929)   ! 
   930) 
   931)   use Realization_Base_class, only : realization_base_type, &
   932)                                      RealizGetVariableValueAtCell
   933)   use Discretization_module
   934)   use Grid_module
   935)   use Grid_Structured_module
   936)   use Option_module
   937)   use Field_module
   938)   use Patch_module
   939) 
   940)   use Reaction_Aux_module
   941)  
   942)   implicit none
   943) 
   944)   class(realization_base_type) :: realization_base
   945)   
   946)   PetscInt :: i, comma_count, quote_count
   947)   PetscInt :: icolumn
   948)   character(len=MAXSTRINGLENGTH) :: filename, string
   949)   character(len=MAXWORDLENGTH) :: word
   950)   type(grid_type), pointer :: grid
   951)   type(option_type), pointer :: option
   952)   type(discretization_type), pointer :: discretization
   953)   type(field_type), pointer :: field
   954)   type(patch_type), pointer :: patch 
   955)   type(output_option_type), pointer :: output_option
   956)   type(output_variable_type), pointer :: cur_variable
   957)   PetscReal, pointer :: vec_ptr(:)
   958)   PetscInt :: local_id
   959)   PetscInt :: ghosted_id
   960)   PetscReal :: value
   961)   Vec :: global_vec
   962)   Vec :: natural_vec
   963)   PetscInt :: ivar, isubvar, var_type
   964)   PetscErrorCode :: ierr  
   965)   
   966)   discretization => realization_base%discretization
   967)   patch => realization_base%patch
   968)   grid => patch%grid
   969)   option => realization_base%option
   970)   field => realization_base%field
   971)   output_option => realization_base%output_option
   972) 
   973)   filename = OutputFilename(output_option,option,'tec','')
   974)   
   975)   if (option%myrank == option%io_rank) then
   976)     option%io_buffer = '--> write tecplot output file: ' // &
   977)                        trim(filename)
   978)     call printMsg(option)                       
   979)     open(unit=OUTPUT_UNIT,file=filename,action="write")
   980)   
   981)     if (output_option%print_column_ids) then
   982)       icolumn = 3
   983)     else
   984)       icolumn = -1
   985)     endif
   986)     call OutputTecplotHeader(OUTPUT_UNIT,realization_base,icolumn)
   987)   endif
   988)   
   989) 1000 format(es13.6,1x)
   990) 1001 format(i4,1x)
   991) 1009 format('')
   992) 
   993)   do local_id = 1, grid%nlmax
   994)     ghosted_id = grid%nL2G(local_id)
   995)     write(OUTPUT_UNIT,1000,advance='no') grid%x(ghosted_id)
   996)     write(OUTPUT_UNIT,1000,advance='no') grid%y(ghosted_id)
   997)     write(OUTPUT_UNIT,1000,advance='no') grid%z(ghosted_id)
   998) 
   999)     ! loop over snapshot variables and write to file
  1000)     cur_variable => output_option%output_snap_variable_list%first
  1001)     do
  1002)       if (.not.associated(cur_variable)) exit
  1003)       value = RealizGetVariableValueAtCell(realization_base,cur_variable%ivar, &
  1004)                                           cur_variable%isubvar,ghosted_id)
  1005)       if (cur_variable%iformat == 0) then
  1006)         write(OUTPUT_UNIT,1000,advance='no') value
  1007)       else
  1008)         write(OUTPUT_UNIT,1001,advance='no') int(value)
  1009)       endif
  1010)       cur_variable => cur_variable%next
  1011)     enddo
  1012) 
  1013)     write(OUTPUT_UNIT,1009) 
  1014) 
  1015)   enddo
  1016)   
  1017)   if (option%myrank == option%io_rank) close(OUTPUT_UNIT)
  1018)   
  1019)   if (output_option%print_tecplot_vel_cent) then
  1020)     call OutputVelocitiesTecplotPoint(realization_base)
  1021)   endif
  1022)   
  1023) end subroutine OutputTecplotPoint
  1024) 
  1025) ! ************************************************************************** !
  1026) 
  1027) subroutine OutputVelocitiesTecplotPoint(realization_base)
  1028)   ! 
  1029)   ! Print velocities to Tecplot file in POINT format
  1030)   ! 
  1031)   ! Author: Glenn Hammond
  1032)   ! Date: 10/25/07
  1033)   ! 
  1034)  
  1035)   use Realization_Base_class, only : realization_base_type, &
  1036)                                      RealizGetVariableValueAtCell
  1037)   use Discretization_module
  1038)   use Grid_module
  1039)   use Option_module
  1040)   use Field_module
  1041)   use Patch_module
  1042)   use Variables_module
  1043)   
  1044)   implicit none
  1045) 
  1046)   class(realization_base_type) :: realization_base
  1047)   
  1048)   type(grid_type), pointer :: grid
  1049)   type(option_type), pointer :: option
  1050)   type(field_type), pointer :: field
  1051)   type(discretization_type), pointer :: discretization
  1052)   type(patch_type), pointer :: patch  
  1053)   type(output_option_type), pointer :: output_option
  1054)   character(len=MAXSTRINGLENGTH) :: filename
  1055)   character(len=MAXSTRINGLENGTH) :: string
  1056)   PetscInt :: local_id
  1057)   PetscInt :: ghosted_id
  1058)   PetscReal :: value  
  1059)   Vec :: global_vec_vlx, global_vec_vly, global_vec_vlz
  1060)   Vec :: global_vec_vgx, global_vec_vgy, global_vec_vgz
  1061)   PetscErrorCode :: ierr
  1062) 
  1063)   PetscReal, pointer :: vec_ptr_vlx(:), vec_ptr_vly(:), vec_ptr_vlz(:)
  1064)   PetscReal, pointer :: vec_ptr_vgx(:), vec_ptr_vgy(:), vec_ptr_vgz(:)
  1065) 
  1066)   patch => realization_base%patch
  1067)   grid => patch%grid
  1068)   field => realization_base%field
  1069)   option => realization_base%option
  1070)   output_option => realization_base%output_option
  1071)   discretization => realization_base%discretization
  1072)   
  1073)   filename = OutputFilename(output_option,option,'tec','vel')
  1074)   
  1075)   if (option%myrank == option%io_rank) then
  1076)     option%io_buffer = '--> write tecplot velocity output file: ' // &
  1077)                        trim(filename)
  1078)     call printMsg(option)                       
  1079)     open(unit=OUTPUT_UNIT,file=filename,action="write")
  1080)   
  1081)     ! write header
  1082)     ! write title
  1083)     write(OUTPUT_UNIT,'(''TITLE = "'',1es13.4," [",a1,'']"'')') &
  1084)                  option%time/output_option%tconv,output_option%tunit
  1085)     ! write variables
  1086)     string = 'VARIABLES=' // &
  1087)              '"X [m]",' // &
  1088)              '"Y [m]",' // &
  1089)              '"Z [m]",' // &
  1090)              '"qlx [m/' // trim(output_option%tunit) // ']",' // &
  1091)              '"qly [m/' // trim(output_option%tunit) // ']",' // &
  1092)              '"qlz [m/' // trim(output_option%tunit) // ']"'
  1093)     if (option%nphase > 1) then
  1094)       string = trim(string) // &
  1095)                ',"qgx [m/' // trim(output_option%tunit) // ']",' // &
  1096)                '"qgy [m/' // trim(output_option%tunit) // ']",' // &
  1097)                '"qgz [m/' // trim(output_option%tunit) // ']"'
  1098)     endif
  1099)     
  1100)     string = trim(string) // ',"Material_ID"'
  1101)     write(OUTPUT_UNIT,'(a)') trim(string)
  1102)   
  1103)     ! write zone header
  1104)     write(string,'(''ZONE T= "'',1es13.5,''",'','' I='',i5,'', J='',i5, &
  1105)                  &'', K='',i5)') &
  1106)                  option%time/output_option%tconv, &
  1107)                  grid%structured_grid%nx,grid%structured_grid%ny,grid%structured_grid%nz 
  1108)     string = trim(string) // ', DATAPACKING=POINT'
  1109)     write(OUTPUT_UNIT,'(a)') trim(string)
  1110) 
  1111)   endif
  1112)   
  1113)   ! currently supported for only liquid phase'
  1114)   call DiscretizationCreateVector(discretization,ONEDOF,global_vec_vlx,GLOBAL, &
  1115)                                   option)  
  1116)   call DiscretizationCreateVector(discretization,ONEDOF,global_vec_vly,GLOBAL, &
  1117)                                   option)  
  1118)   call DiscretizationCreateVector(discretization,ONEDOF,global_vec_vlz,GLOBAL, &
  1119)                                   option)  
  1120)   
  1121)   call OutputGetCellCenteredVelocities(realization_base,global_vec_vlx, &
  1122)                                        global_vec_vly,global_vec_vlz,LIQUID_PHASE)
  1123) 
  1124)   call VecGetArrayF90(global_vec_vlx,vec_ptr_vlx,ierr);CHKERRQ(ierr)
  1125)   call VecGetArrayF90(global_vec_vly,vec_ptr_vly,ierr);CHKERRQ(ierr)
  1126)   call VecGetArrayF90(global_vec_vlz,vec_ptr_vlz,ierr);CHKERRQ(ierr)
  1127) 
  1128)   ! write points
  1129) 1000 format(es13.6,1x)
  1130) 1001 format(i4,1x)
  1131) 1002 format(3(es13.6,1x))
  1132) 1009 format('')
  1133) 
  1134)   if (option%nphase > 1) then
  1135)     call DiscretizationCreateVector(discretization,ONEDOF,global_vec_vgx,GLOBAL, &
  1136)                                   option)  
  1137)     call DiscretizationCreateVector(discretization,ONEDOF,global_vec_vgy,GLOBAL, &
  1138)                                   option)  
  1139)     call DiscretizationCreateVector(discretization,ONEDOF,global_vec_vgz,GLOBAL, &
  1140)                                   option)  
  1141)   
  1142)     call OutputGetCellCenteredVelocities(realization_base,global_vec_vgx, &
  1143)                                          global_vec_vgy,global_vec_vgz,GAS_PHASE)
  1144) 
  1145)     call VecGetArrayF90(global_vec_vgx,vec_ptr_vgx,ierr);CHKERRQ(ierr)
  1146)     call VecGetArrayF90(global_vec_vgy,vec_ptr_vgy,ierr);CHKERRQ(ierr)
  1147)     call VecGetArrayF90(global_vec_vgz,vec_ptr_vgz,ierr);CHKERRQ(ierr)
  1148)   endif
  1149) 
  1150)   do local_id = 1, grid%nlmax
  1151)     ghosted_id = grid%nL2G(local_id)  ! local and ghosted are same for non-parallel
  1152)     write(OUTPUT_UNIT,1000,advance='no') grid%x(ghosted_id)
  1153)     write(OUTPUT_UNIT,1000,advance='no') grid%y(ghosted_id)
  1154)     write(OUTPUT_UNIT,1000,advance='no') grid%z(ghosted_id)
  1155)     
  1156)     write(OUTPUT_UNIT,1000,advance='no') vec_ptr_vlx(ghosted_id)
  1157)     write(OUTPUT_UNIT,1000,advance='no') vec_ptr_vly(ghosted_id)
  1158)     write(OUTPUT_UNIT,1000,advance='no') vec_ptr_vlz(ghosted_id)
  1159) 
  1160)     if (option%nphase > 1) then
  1161)       write(OUTPUT_UNIT,1000,advance='no') vec_ptr_vgx(ghosted_id)
  1162)       write(OUTPUT_UNIT,1000,advance='no') vec_ptr_vgy(ghosted_id)
  1163)       write(OUTPUT_UNIT,1000,advance='no') vec_ptr_vgz(ghosted_id)
  1164)     endif
  1165) 
  1166)     ! material id
  1167)     value = RealizGetVariableValueAtCell(realization_base,MATERIAL_ID, &
  1168)                                         ZERO_INTEGER,ghosted_id)
  1169)     write(OUTPUT_UNIT,1001,advance='no') int(value)
  1170)   
  1171)     write(OUTPUT_UNIT,1009)
  1172)   enddo
  1173)   
  1174)   call VecRestoreArrayF90(global_vec_vlx,vec_ptr_vlx,ierr);CHKERRQ(ierr)
  1175)   call VecRestoreArrayF90(global_vec_vly,vec_ptr_vly,ierr);CHKERRQ(ierr)
  1176)   call VecRestoreArrayF90(global_vec_vlz,vec_ptr_vlz,ierr);CHKERRQ(ierr)
  1177)   
  1178)   call VecDestroy(global_vec_vlx,ierr);CHKERRQ(ierr)
  1179)   call VecDestroy(global_vec_vly,ierr);CHKERRQ(ierr)
  1180)   call VecDestroy(global_vec_vlz,ierr);CHKERRQ(ierr)
  1181) 
  1182)   if (option%nphase > 1) then
  1183)     call VecRestoreArrayF90(global_vec_vgx,vec_ptr_vgx,ierr);CHKERRQ(ierr)
  1184)     call VecRestoreArrayF90(global_vec_vgy,vec_ptr_vgy,ierr);CHKERRQ(ierr)
  1185)     call VecRestoreArrayF90(global_vec_vgz,vec_ptr_vgz,ierr);CHKERRQ(ierr)
  1186)   
  1187)     call VecDestroy(global_vec_vgx,ierr);CHKERRQ(ierr)
  1188)     call VecDestroy(global_vec_vgy,ierr);CHKERRQ(ierr)
  1189)     call VecDestroy(global_vec_vgz,ierr);CHKERRQ(ierr)
  1190)   endif
  1191) 
  1192)   if (option%myrank == option%io_rank) close(OUTPUT_UNIT)
  1193)   
  1194) end subroutine OutputVelocitiesTecplotPoint
  1195) 
  1196) ! ************************************************************************** !
  1197) 
  1198) subroutine OutputVectorTecplot(filename,dataset_name,realization_base,vector)
  1199)   ! 
  1200)   ! Print a vector to a Tecplot file in BLOCK format
  1201)   ! 
  1202)   ! Author: Glenn Hammond
  1203)   ! Date: 10/25/07
  1204)   ! 
  1205)  
  1206)   use Realization_Base_class, only : realization_base_type
  1207)   use Discretization_module
  1208)   use Option_module
  1209)   use Field_module
  1210)   use Grid_module
  1211)   use Grid_Unstructured_Aux_module
  1212)   use Patch_module
  1213)   use Variables_module
  1214)   
  1215)   implicit none
  1216) 
  1217)   character(len=MAXSTRINGLENGTH) :: filename
  1218)   character(len=MAXWORDLENGTH) :: dataset_name
  1219)   class(realization_base_type) :: realization_base
  1220)   Vec :: vector
  1221) 
  1222)   character(len=MAXSTRINGLENGTH) :: string
  1223)   type(option_type), pointer :: option
  1224)   type(grid_type), pointer :: grid
  1225)   type(field_type), pointer :: field
  1226)   type(discretization_type), pointer :: discretization
  1227)   type(patch_type), pointer :: patch  
  1228)   Vec :: natural_vec
  1229)   Vec :: global_vec
  1230)   PetscErrorCode :: ierr
  1231) 
  1232)   call PetscLogEventBegin(logging%event_output_vec_tecplot,ierr);CHKERRQ(ierr)
  1233) 
  1234)   option => realization_base%option
  1235)   patch => realization_base%patch
  1236)   grid => patch%grid
  1237)   field => realization_base%field
  1238)   discretization => realization_base%discretization
  1239)   
  1240)   ! open file
  1241)   if (option%myrank == option%io_rank) then
  1242)     option%io_buffer = '--> write tecplot output file: ' // trim(filename)
  1243)     call printMsg(option)
  1244)     open(unit=OUTPUT_UNIT,file=filename,action="write")
  1245)   
  1246)     ! write header
  1247)     ! write title
  1248)     write(OUTPUT_UNIT,'(''TITLE = "PFLOTRAN Vector"'')')
  1249)     ! write variables
  1250)     string = 'VARIABLES=' // &
  1251)              '"X [m]",' // &
  1252)              '"Y [m]",' // &
  1253)              '"Z [m]",'
  1254)     string = trim(string) // '"' // trim(dataset_name) // '"'
  1255)     string = trim(string) // ',"Material_ID"'
  1256)     write(OUTPUT_UNIT,'(a)') trim(string)
  1257)   
  1258)     !geh: due to pgi bug, cannot embed functions with calls to write() within
  1259)     !     write statement
  1260)     call OutputWriteTecplotZoneHeader(OUTPUT_UNIT,realization_base, &
  1261)                                       FIVE_INTEGER,TECPLOT_BLOCK_FORMAT)
  1262)   endif
  1263)   
  1264)   ! write blocks
  1265)   ! write out data sets  
  1266)   call DiscretizationCreateVector(discretization,ONEDOF, &
  1267)                                   global_vec,GLOBAL,option)  
  1268)   call DiscretizationCreateVector(discretization,ONEDOF, &
  1269)                                   natural_vec,NATURAL,option)    
  1270) 
  1271)   ! write out coorindates
  1272) 
  1273)   if (realization_base%discretization%itype == STRUCTURED_GRID)  then
  1274)     call WriteTecplotStructuredGrid(OUTPUT_UNIT,realization_base)
  1275)   else  
  1276)     call WriteTecplotUGridVertices(OUTPUT_UNIT,realization_base)
  1277)   endif    
  1278) 
  1279)   call DiscretizationGlobalToNatural(discretization,vector,natural_vec,ONEDOF)
  1280)   call WriteTecplotDataSetFromVec(OUTPUT_UNIT,realization_base,natural_vec,TECPLOT_REAL)
  1281) 
  1282)   call OutputGetVarFromArray(realization_base,global_vec,MATERIAL_ID,ZERO_INTEGER)
  1283)   call DiscretizationGlobalToNatural(discretization,global_vec,natural_vec,ONEDOF)
  1284)   call WriteTecplotDataSetFromVec(OUTPUT_UNIT,realization_base,natural_vec,TECPLOT_INTEGER)
  1285)   
  1286)   call VecDestroy(natural_vec,ierr);CHKERRQ(ierr)
  1287)   call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
  1288) 
  1289)   if (realization_base%discretization%itype == UNSTRUCTURED_GRID .and. &
  1290)       realization_base%discretization%grid%itype == &
  1291)       IMPLICIT_UNSTRUCTURED_GRID)  then
  1292)     call WriteTecplotUGridElements(OUTPUT_UNIT,realization_base)
  1293)   endif    
  1294) 
  1295)   close(OUTPUT_UNIT)
  1296) 
  1297)   call PetscLogEventEnd(logging%event_output_vec_tecplot,ierr);CHKERRQ(ierr)
  1298)                             
  1299) end subroutine OutputVectorTecplot
  1300) 
  1301) ! ************************************************************************** !
  1302) 
  1303) subroutine WriteTecplotStructuredGrid(fid,realization_base)
  1304)   ! 
  1305)   ! Writes structured grid face coordinates
  1306)   ! 
  1307)   ! Author: Glenn Hammond
  1308)   ! Date: 02/26/08
  1309)   ! 
  1310) 
  1311)   use Realization_Base_class, only : realization_base_type
  1312)   use Grid_module
  1313)   use Option_module
  1314)   use Patch_module
  1315) 
  1316)   implicit none
  1317)   
  1318)   PetscInt :: fid
  1319)   class(realization_base_type) :: realization_base
  1320)   
  1321)   type(grid_type), pointer :: grid
  1322)   type(option_type), pointer :: option
  1323)   type(patch_type), pointer :: patch  
  1324)   PetscInt :: i, j, k, count, nx, ny, nz
  1325)   PetscReal :: temp_real
  1326)   PetscErrorCode :: ierr  
  1327) 
  1328) 1000 format(es13.6,1x)
  1329) 1001 format(10(es13.6,1x))
  1330)   
  1331)   call PetscLogEventBegin(logging%event_output_str_grid_tecplot, &
  1332)                           ierr);CHKERRQ(ierr)
  1333)                               
  1334)   patch => realization_base%patch
  1335)   grid => patch%grid
  1336)   option => realization_base%option
  1337)   
  1338)   nx = grid%structured_grid%nx
  1339)   ny = grid%structured_grid%ny
  1340)   nz = grid%structured_grid%nz
  1341)   
  1342)   if (option%myrank == option%io_rank) then
  1343)     ! x-dir
  1344)     count = 0
  1345)     do k=1,nz+1
  1346)       do j=1,ny+1
  1347)         temp_real = realization_base%discretization%origin_global(X_DIRECTION)
  1348)         write(fid,1000,advance='no') temp_real
  1349)         count = count + 1
  1350)         if (mod(count,10) == 0) then
  1351)           write(fid,'(a)') ""
  1352)           count = 0
  1353)         endif
  1354)         do i=1,nx
  1355)           temp_real = temp_real + grid%structured_grid%dx_global(i)
  1356)           write(fid,1000,advance='no') temp_real
  1357)           count = count + 1
  1358)           if (mod(count,10) == 0) then
  1359)             write(fid,'(a)') ""
  1360)             count = 0
  1361)           endif
  1362)         enddo
  1363)       enddo
  1364)     enddo
  1365)     if (count /= 0) write(fid,'(a)') ""
  1366)     ! y-dir
  1367)     count = 0
  1368)     do k=1,nz+1
  1369)       temp_real = realization_base%discretization%origin_global(Y_DIRECTION)
  1370)       do i=1,nx+1
  1371)         write(fid,1000,advance='no') temp_real
  1372)         count = count + 1
  1373)         if (mod(count,10) == 0) then
  1374)           write(fid,'(a)') ""
  1375)           count = 0
  1376)         endif
  1377)       enddo
  1378)       do j=1,ny
  1379)         temp_real = temp_real + grid%structured_grid%dy_global(j)
  1380)         do i=1,nx+1
  1381)           write(fid,1000,advance='no') temp_real
  1382)           count = count + 1
  1383)           if (mod(count,10) == 0) then
  1384)             write(fid,'(a)') ""
  1385)             count = 0
  1386)           endif
  1387)         enddo
  1388)       enddo
  1389)     enddo
  1390)     if (count /= 0) write(fid,'(a)') ""
  1391)     ! z-dir
  1392)     count = 0
  1393)     temp_real = realization_base%discretization%origin_global(Z_DIRECTION)
  1394)     do i=1,(nx+1)*(ny+1)
  1395)       write(fid,1000,advance='no') temp_real
  1396)       count = count + 1
  1397)       if (mod(count,10) == 0) then
  1398)         write(fid,'(a)') ""
  1399)         count = 0
  1400)       endif
  1401)     enddo
  1402)     do k=1,nz
  1403)       temp_real = temp_real + grid%structured_grid%dz_global(k)
  1404)       do j=1,ny+1
  1405)         do i=1,nx+1
  1406)           write(fid,1000,advance='no') temp_real
  1407)           count = count + 1
  1408)           if (mod(count,10) == 0) then
  1409)             write(fid,'(a)') ""
  1410)             count = 0
  1411)           endif
  1412)         enddo
  1413)       enddo
  1414)     enddo
  1415)     if (count /= 0) write(fid,'(a)') ""
  1416) 
  1417)   endif
  1418) 
  1419)   call PetscLogEventEnd(logging%event_output_str_grid_tecplot, &
  1420)                         ierr);CHKERRQ(ierr)
  1421)                             
  1422) end subroutine WriteTecplotStructuredGrid
  1423) 
  1424) ! ************************************************************************** !
  1425) 
  1426) subroutine WriteTecplotUGridVertices(fid,realization_base)
  1427)   ! 
  1428)   ! Writes unstructured grid vertices
  1429)   ! 
  1430)   ! Author: Glenn Hammond
  1431)   ! Date: 01/12/12
  1432)   ! 
  1433) 
  1434)   use Realization_Base_class, only : realization_base_type
  1435)   use Grid_module
  1436)   use Grid_Unstructured_Aux_module
  1437)   use Option_module
  1438)   use Patch_module
  1439)   use Variables_module
  1440) 
  1441)   implicit none
  1442) 
  1443)   PetscInt :: fid
  1444)   class(realization_base_type) :: realization_base
  1445)   
  1446)   type(grid_type), pointer :: grid
  1447)   type(option_type), pointer :: option
  1448)   type(patch_type), pointer :: patch 
  1449)   PetscReal, pointer :: vec_ptr(:)
  1450)   Vec :: global_vertex_vec
  1451)   PetscInt :: local_size
  1452)   PetscErrorCode :: ierr
  1453)   PetscInt :: num_cells, icell
  1454)   PetscInt :: count
  1455)     
  1456)   patch => realization_base%patch
  1457)   grid => patch%grid
  1458)   option => realization_base%option
  1459) 
  1460) 1000 format(es13.6,1x)
  1461) 
  1462)   select case (grid%itype)
  1463)     case (IMPLICIT_UNSTRUCTURED_GRID, POLYHEDRA_UNSTRUCTURED_GRID)
  1464)       call VecCreateMPI(option%mycomm,PETSC_DECIDE, &
  1465)       grid%unstructured_grid%num_vertices_global, &
  1466)       global_vertex_vec,ierr);CHKERRQ(ierr)
  1467)       call VecGetLocalSize(global_vertex_vec,local_size,ierr);CHKERRQ(ierr)
  1468)       call GetVertexCoordinates(grid, global_vertex_vec,X_COORDINATE,option)
  1469)       call VecGetArrayF90(global_vertex_vec,vec_ptr,ierr);CHKERRQ(ierr)
  1470)       if (option%myrank == option%io_rank) &
  1471)         write(fid,'(a)') '# vertex x-coordinate'
  1472)       call WriteTecplotDataSet(fid,realization_base,vec_ptr,TECPLOT_REAL, &
  1473)       local_size)
  1474)       call VecRestoreArrayF90(global_vertex_vec,vec_ptr,ierr);CHKERRQ(ierr)
  1475) 
  1476)       call GetVertexCoordinates(grid,global_vertex_vec,Y_COORDINATE,option)
  1477)       call VecGetArrayF90(global_vertex_vec,vec_ptr,ierr);CHKERRQ(ierr)
  1478)       if (option%myrank == option%io_rank) &
  1479)         write(fid,'(a)') '# vertex y-coordinate'
  1480)       call WriteTecplotDataSet(fid,realization_base,vec_ptr,TECPLOT_REAL, &
  1481)       local_size)
  1482)       call VecRestoreArrayF90(global_vertex_vec,vec_ptr,ierr);CHKERRQ(ierr)
  1483) 
  1484)       call GetVertexCoordinates(grid,global_vertex_vec, Z_COORDINATE,option)
  1485)       call VecGetArrayF90(global_vertex_vec,vec_ptr,ierr);CHKERRQ(ierr)
  1486)       if (option%myrank == option%io_rank) &
  1487)         write(fid,'(a)') '# vertex z-coordinate'
  1488)       call WriteTecplotDataSet(fid,realization_base,vec_ptr,TECPLOT_REAL, &
  1489)       local_size)
  1490)       call VecRestoreArrayF90(global_vertex_vec,vec_ptr,ierr);CHKERRQ(ierr)
  1491) 
  1492)       call VecDestroy(global_vertex_vec, ierr);CHKERRQ(ierr)
  1493)     case (EXPLICIT_UNSTRUCTURED_GRID)
  1494)       if (option%myrank == option%io_rank) then
  1495)         if (option%print_explicit_primal_grid) then
  1496)         num_cells = grid%unstructured_grid%explicit_grid%num_cells_global
  1497)         count = 0
  1498)         do icell = 1, num_cells
  1499)           write(fid,1000,advance='no') grid%unstructured_grid%explicit_grid% &
  1500)                                        vertex_coordinates(icell)%x
  1501)           count = count + 1
  1502)           if (mod(count,10) == 0) then
  1503)             write(fid,'(a)') ""
  1504)             count = 0
  1505)           endif
  1506)         enddo
  1507)         if (count /= 0) write(fid,'(a)') ""
  1508)         count = 0
  1509)         do icell = 1, num_cells
  1510)           write(fid,1000,advance='no') grid%unstructured_grid%explicit_grid% &
  1511)                                        vertex_coordinates(icell)%y
  1512)           count = count + 1
  1513)           if (mod(count,10) == 0) then
  1514)             write(fid,'(a)') ""
  1515)             count = 0
  1516)           endif
  1517)         enddo
  1518)         if (count /= 0) write(fid,'(a)') ""
  1519)         count = 0
  1520)         do icell = 1, num_cells
  1521)           write(fid,1000,advance='no') grid%unstructured_grid%explicit_grid% &
  1522)                                        vertex_coordinates(icell)%z
  1523)           count = count + 1
  1524)           if (mod(count,10) == 0) then
  1525)             write(fid,'(a)') ""
  1526)             count = 0
  1527)           endif
  1528)         enddo
  1529)         if (count /= 0) write(fid,'(a)') ""
  1530)         elseif (option%print_explicit_dual_grid) then
  1531)           write(fid,'(">",/,"Add explicit mesh vertex information here",/,">")')
  1532)         else 
  1533)           write(fid,'(">",/,"Add explicit mesh vertex information here",/,">")')
  1534)         endif
  1535)       endif
  1536)   end select
  1537) 
  1538) end subroutine WriteTecplotUGridVertices
  1539) 
  1540) ! ************************************************************************** !
  1541) 
  1542) subroutine WriteTecplotExpGridElements(fid,realization_base)
  1543)   ! 
  1544)   ! Writes unstructured explicit grid elements
  1545)   ! 
  1546)   ! Author: Satish Karra, LANL
  1547)   ! Date: 04/11/13
  1548)   ! 
  1549) 
  1550)   use Realization_Base_class, only : realization_base_type
  1551)   use Grid_module
  1552)   use Grid_Unstructured_Aux_module
  1553)   use Option_module
  1554)   use Patch_module
  1555)   
  1556)   implicit none
  1557) 
  1558)   PetscInt :: fid
  1559)   class(realization_base_type) :: realization_base
  1560) 
  1561)   type(grid_type), pointer :: grid
  1562)   type(option_type), pointer :: option
  1563)   type(patch_type), pointer :: patch 
  1564)   PetscInt, pointer :: temp_int(:)
  1565)   PetscInt :: iconn, num_elems, i, num_vertices
  1566)   PetscErrorCode :: ierr
  1567)   
  1568)   patch => realization_base%patch
  1569)   grid => patch%grid
  1570)   option => realization_base%option
  1571)   
  1572)   num_elems = grid%unstructured_grid%explicit_grid%num_elems
  1573)  
  1574)   allocate(temp_int(grid%unstructured_grid%max_nvert_per_cell))
  1575)   
  1576)   if (.not.associated(grid%unstructured_grid%explicit_grid%cell_connectivity)) return
  1577) 
  1578)   if (option%myrank == option%io_rank) then
  1579)     do iconn = 1, num_elems
  1580)       num_vertices = grid%unstructured_grid%explicit_grid% &
  1581)                        cell_connectivity(0,iconn)
  1582)       select case(num_vertices)
  1583)         case(EIGHT_INTEGER) ! Hex mesh
  1584)           temp_int = grid%unstructured_grid%explicit_grid% &
  1585)                        cell_connectivity(1:num_vertices,iconn)
  1586)         case(SIX_INTEGER)   ! Wedge 
  1587)           temp_int(1) = grid%unstructured_grid%explicit_grid% &
  1588)                           cell_connectivity(1,iconn)         
  1589)           temp_int(2) = grid%unstructured_grid%explicit_grid% &
  1590)                           cell_connectivity(1,iconn)  
  1591)           temp_int(3) = grid%unstructured_grid%explicit_grid% &
  1592)                           cell_connectivity(4,iconn) 
  1593)           temp_int(4) = grid%unstructured_grid%explicit_grid% &
  1594)                           cell_connectivity(4,iconn)
  1595)           temp_int(5) = grid%unstructured_grid%explicit_grid% &
  1596)                           cell_connectivity(3,iconn) 
  1597)           temp_int(6) = grid%unstructured_grid%explicit_grid% &
  1598)                           cell_connectivity(2,iconn) 
  1599)           temp_int(7) = grid%unstructured_grid%explicit_grid% &
  1600)                           cell_connectivity(5,iconn) 
  1601)           temp_int(8) = grid%unstructured_grid%explicit_grid% &
  1602)                           cell_connectivity(6,iconn) 
  1603)         case(FIVE_INTEGER)  ! Pyramid
  1604)           do i = 1, 4
  1605)             temp_int(i) = grid%unstructured_grid%explicit_grid% &
  1606)                             cell_connectivity(i,iconn) 
  1607)           enddo
  1608)           do i = 5, 8
  1609)             temp_int(i) = grid%unstructured_grid%explicit_grid% &
  1610)                             cell_connectivity(5,iconn) 
  1611)           enddo
  1612)         case(FOUR_INTEGER)
  1613)           if (grid%unstructured_grid%grid_type == TWO_DIM_GRID) then ! Quad
  1614)             do i = 1, 4
  1615)               temp_int(i) = grid%unstructured_grid%explicit_grid% &
  1616)                               cell_connectivity(i,iconn) 
  1617)             enddo
  1618)             do i = 5, 8
  1619)               temp_int(i) = temp_int(i-4)
  1620)             enddo
  1621)           else ! Tet
  1622)             do i = 1, 3
  1623)               temp_int(i) = grid%unstructured_grid%explicit_grid% &
  1624)                              cell_connectivity(i,iconn) 
  1625)             enddo
  1626)             temp_int(4) = temp_int(3)
  1627)             do i = 5, 8
  1628)               temp_int(i) = grid%unstructured_grid%explicit_grid% &
  1629)                               cell_connectivity(4,iconn) 
  1630)             enddo
  1631)           endif
  1632)         case(3) ! Tri
  1633)           do i = 1, 3
  1634)             temp_int(i) = grid%unstructured_grid%explicit_grid% &
  1635)                             cell_connectivity(i,iconn) 
  1636)           enddo
  1637)           temp_int(4) = temp_int(3)
  1638)           do i = 5, 8
  1639)             temp_int(i) = temp_int(i-4) 
  1640)           enddo
  1641)       end select
  1642)       write(fid,*) temp_int
  1643)     enddo 
  1644)   endif
  1645)   
  1646)   deallocate(temp_int)
  1647)    
  1648) end subroutine WriteTecplotExpGridElements
  1649) 
  1650) ! ************************************************************************** !
  1651) 
  1652) subroutine WriteTecplotUGridElements(fid,realization_base)
  1653)   ! 
  1654)   ! Writes unstructured grid elements
  1655)   ! 
  1656)   ! Author: Glenn Hammond
  1657)   ! Date: 01/12/12
  1658)   ! 
  1659) 
  1660)   use Realization_Base_class, only : realization_base_type
  1661)   use Grid_module
  1662)   use Grid_Unstructured_Aux_module
  1663)   use Option_module
  1664)   use Patch_module
  1665)   
  1666)   implicit none
  1667) 
  1668)   PetscInt :: fid
  1669)   class(realization_base_type) :: realization_base
  1670) 
  1671)   type(grid_type), pointer :: grid
  1672)   type(option_type), pointer :: option
  1673)   type(patch_type), pointer :: patch 
  1674)   Vec :: global_cconn_vec
  1675)   type(ugdm_type), pointer :: ugdm_element
  1676)   PetscReal, pointer :: vec_ptr(:)
  1677)   PetscErrorCode :: ierr  
  1678)   
  1679)   Vec :: global_vec
  1680)   Vec :: natural_vec
  1681) 
  1682)   patch => realization_base%patch
  1683)   grid => patch%grid
  1684)   option => realization_base%option
  1685)   
  1686)   call UGridCreateUGDM(grid%unstructured_grid,ugdm_element,EIGHT_INTEGER,option)
  1687)   call UGridDMCreateVector(grid%unstructured_grid,ugdm_element,global_vec, &
  1688)                            GLOBAL,option) 
  1689)   call UGridDMCreateVector(grid%unstructured_grid,ugdm_element,natural_vec, &
  1690)                            NATURAL,option) 
  1691)   call GetCellConnectionsTecplot(grid,global_vec)
  1692)   call VecScatterBegin(ugdm_element%scatter_gton,global_vec,natural_vec, &
  1693)                         INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
  1694)   call VecScatterEnd(ugdm_element%scatter_gton,global_vec,natural_vec, &
  1695)                       INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
  1696)   call VecGetArrayF90(natural_vec,vec_ptr,ierr);CHKERRQ(ierr)
  1697)   call WriteTecplotDataSetNumPerLine(fid,realization_base,vec_ptr, &
  1698)                                      TECPLOT_INTEGER, &
  1699)                                      grid%unstructured_grid%nlmax*8, &
  1700)                                      EIGHT_INTEGER)
  1701)   call VecRestoreArrayF90(natural_vec,vec_ptr,ierr);CHKERRQ(ierr)
  1702)   call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
  1703)   call VecDestroy(natural_vec,ierr);CHKERRQ(ierr)
  1704)   call UGridDMDestroy(ugdm_element)
  1705) 
  1706) end subroutine WriteTecplotUGridElements
  1707) 
  1708) ! ************************************************************************** !
  1709) 
  1710) subroutine GetCellConnectionsTecplot(grid, vec)
  1711)   ! 
  1712)   ! GetCellConnections: This routine returns a vector containing vertex ids
  1713)   ! in natural order of local cells.
  1714)   ! 
  1715)   ! Author: Gautam Bisht
  1716)   ! Date: 11/01/2011
  1717)   ! 
  1718) 
  1719)   use Grid_module
  1720)   use Grid_Unstructured_Aux_module
  1721)   use Grid_Unstructured_Cell_module
  1722)   
  1723)   implicit none
  1724)   
  1725)   type(grid_type) :: grid
  1726)   type(grid_unstructured_type),pointer :: ugrid
  1727)   Vec :: vec
  1728)   PetscInt :: local_id
  1729)   PetscInt :: ghosted_id
  1730)   PetscInt :: offset
  1731)   PetscInt :: ivertex
  1732)   PetscReal, pointer :: vec_ptr(:)
  1733)   PetscErrorCode :: ierr  
  1734)   
  1735)   ugrid => grid%unstructured_grid
  1736)   
  1737)   call VecGetArrayF90( vec, vec_ptr, ierr);CHKERRQ(ierr)
  1738) 
  1739)   ! initialize
  1740)   vec_ptr = UNINITIALIZED_DOUBLE
  1741)   do local_id=1, ugrid%nlmax
  1742)     ghosted_id = local_id
  1743)     select case(ugrid%cell_type(ghosted_id))
  1744)       case(HEX_TYPE)
  1745)         offset = (local_id-1)*8
  1746)         do ivertex = 1, 8
  1747)           vec_ptr(offset + ivertex) = &
  1748)             ugrid%vertex_ids_natural(ugrid%cell_vertices(ivertex,local_id))
  1749)         enddo
  1750)       case(WEDGE_TYPE)
  1751)         offset = (local_id-1)*8
  1752)         vec_ptr(offset + 1) = &
  1753)           ugrid%vertex_ids_natural(ugrid%cell_vertices(1,local_id))
  1754)         vec_ptr(offset + 2) = &
  1755)           ugrid%vertex_ids_natural(ugrid%cell_vertices(1,local_id))
  1756)         vec_ptr(offset + 3) = &
  1757)           ugrid%vertex_ids_natural(ugrid%cell_vertices(4,local_id))
  1758)         vec_ptr(offset + 4) = &
  1759)           ugrid%vertex_ids_natural(ugrid%cell_vertices(4,local_id))
  1760)         vec_ptr(offset + 5) = &
  1761)           ugrid%vertex_ids_natural(ugrid%cell_vertices(3,local_id))
  1762)         vec_ptr(offset + 6) = &
  1763)           ugrid%vertex_ids_natural(ugrid%cell_vertices(2,local_id))
  1764)         vec_ptr(offset + 7) = &
  1765)           ugrid%vertex_ids_natural(ugrid%cell_vertices(5,local_id))
  1766)         vec_ptr(offset + 8) = &
  1767)           ugrid%vertex_ids_natural(ugrid%cell_vertices(6,local_id))
  1768)       case (PYR_TYPE)
  1769)         offset = (local_id-1)*8
  1770)         ! from Tecplot 360 Data Format Guide
  1771)         ! n1=vert1,n2=vert2,n3=vert3,n4=vert4,n5=n6=n7=n8=vert5
  1772)         do ivertex = 1, 4
  1773)           vec_ptr(offset + ivertex) = &
  1774)             ugrid%vertex_ids_natural(ugrid%cell_vertices(ivertex,local_id))
  1775)         enddo
  1776)         do ivertex = 5, 8
  1777)           vec_ptr(offset + ivertex) = &
  1778)             ugrid%vertex_ids_natural(ugrid%cell_vertices(5,local_id))
  1779)         enddo
  1780)       case (TET_TYPE)
  1781)         offset = (local_id-1)*8
  1782)         ! from Tecplot 360 Data Format Guide
  1783)         ! n1=vert1,n2=vert2,n3=n4=vert3,n5=vert5=n6=n7=n8=vert4
  1784)         do ivertex = 1, 3
  1785)           vec_ptr(offset + ivertex) = &
  1786)             ugrid%vertex_ids_natural(ugrid%cell_vertices(ivertex,local_id))
  1787)         enddo
  1788)         vec_ptr(offset + 4) = &
  1789)             ugrid%vertex_ids_natural(ugrid%cell_vertices(3,local_id))
  1790)         do ivertex = 5, 8
  1791)           vec_ptr(offset + ivertex) = &
  1792)             ugrid%vertex_ids_natural(ugrid%cell_vertices(4,local_id))
  1793)         enddo
  1794)       case (QUAD_TYPE)
  1795)         offset = (local_id-1)*4
  1796)         do ivertex = 1, 4
  1797)           vec_ptr(offset + ivertex) = &
  1798)             ugrid%vertex_ids_natural(ugrid%cell_vertices(ivertex,local_id))
  1799)         enddo
  1800)       case (TRI_TYPE)
  1801)         ! from Tecplot 360 Data Format Guide
  1802)         ! n1=vert1,n2=vert2,n3=n4=vert3
  1803)         offset = (local_id-1)*4
  1804)         do ivertex = 1, 3
  1805)           vec_ptr(offset + ivertex) = &
  1806)             ugrid%vertex_ids_natural(ugrid%cell_vertices(ivertex,local_id))
  1807)         enddo
  1808)         ivertex = 4
  1809)         vec_ptr(offset + ivertex) = &
  1810)           ugrid%vertex_ids_natural(ugrid%cell_vertices(3,local_id))
  1811)     end select
  1812)   enddo
  1813) 
  1814)   call VecRestoreArrayF90( vec, vec_ptr, ierr);CHKERRQ(ierr)
  1815) 
  1816) end subroutine GetCellConnectionsTecplot
  1817) 
  1818) ! ************************************************************************** !
  1819) 
  1820) subroutine WriteTecplotDataSetFromVec(fid,realization_base,vec,datatype)
  1821)   ! 
  1822)   ! Writes data from a Petsc Vec within a block
  1823)   ! of a Tecplot file
  1824)   ! 
  1825)   ! Author: Glenn Hammond
  1826)   ! Date: 10/25/07
  1827)   ! 
  1828) 
  1829)   use Realization_Base_class, only : realization_base_type
  1830)   
  1831)   implicit none
  1832) 
  1833)   PetscInt :: fid
  1834)   class(realization_base_type) :: realization_base
  1835)   Vec :: vec
  1836)   PetscInt :: datatype
  1837)   PetscErrorCode :: ierr  
  1838)   
  1839)   PetscReal, pointer :: vec_ptr(:)
  1840)   
  1841)   call VecGetArrayF90(vec,vec_ptr,ierr);CHKERRQ(ierr)
  1842)   call WriteTecplotDataSet(fid,realization_base,vec_ptr,datatype,ZERO_INTEGER) 
  1843)   call VecRestoreArrayF90(vec,vec_ptr,ierr);CHKERRQ(ierr)
  1844)   
  1845) end subroutine WriteTecplotDataSetFromVec
  1846) 
  1847) ! ************************************************************************** !
  1848) 
  1849) subroutine WriteTecplotDataSet(fid,realization_base,array,datatype,size_flag)
  1850)   ! 
  1851)   ! Writes data from an array within a block
  1852)   ! of a Tecplot file
  1853)   ! 
  1854)   ! Author: Glenn Hammond
  1855)   ! Date: 10/25/07
  1856)   ! 
  1857) 
  1858)   use Realization_Base_class, only : realization_base_type
  1859)   use Grid_module
  1860)   use Option_module
  1861)   use Patch_module
  1862) 
  1863)   implicit none
  1864) 
  1865)   PetscInt :: fid
  1866)   class(realization_base_type) :: realization_base
  1867)   PetscReal :: array(:)
  1868)   PetscInt :: datatype
  1869)   PetscInt :: size_flag ! if size_flag /= 0, use size_flag as the local size
  1870) 
  1871)   PetscInt, parameter :: num_per_line = 10
  1872) 
  1873)   call WriteTecplotDataSetNumPerLine(fid,realization_base,array,datatype, &
  1874)                                      size_flag,num_per_line) 
  1875)   
  1876) end subroutine WriteTecplotDataSet
  1877) 
  1878) ! ************************************************************************** !
  1879) 
  1880) subroutine WriteTecplotDataSetNumPerLine(fid,realization_base,array,datatype, &
  1881)                                          size_flag,num_per_line)
  1882)   ! 
  1883)   ! Writes data from an array within a block
  1884)   ! of a Tecplot file with a specified number
  1885)   ! of values per line
  1886)   ! 
  1887)   ! Author: Glenn Hammond
  1888)   ! Date: 10/25/07, 12/02/11
  1889)   ! 
  1890) 
  1891)   use Realization_Base_class, only : realization_base_type
  1892)   use Grid_module
  1893)   use Option_module
  1894)   use Patch_module
  1895) 
  1896)   implicit none
  1897)   
  1898)   PetscInt :: fid
  1899)   class(realization_base_type) :: realization_base
  1900)   PetscReal :: array(:)
  1901)   PetscInt :: datatype
  1902)   PetscInt :: size_flag ! if size_flag /= 0, use size_flag as the local size
  1903)   PetscInt :: num_per_line
  1904)   
  1905)   type(grid_type), pointer :: grid
  1906)   type(option_type), pointer :: option
  1907)   type(patch_type), pointer :: patch  
  1908)   PetscInt :: i
  1909)   PetscInt :: max_proc, max_proc_prefetch
  1910)   PetscMPIInt :: iproc_mpi, recv_size_mpi
  1911)   PetscInt :: max_local_size
  1912)   PetscMPIInt :: local_size_mpi
  1913)   PetscInt :: istart, iend, num_in_array
  1914)   PetscMPIInt :: status_mpi(MPI_STATUS_SIZE)
  1915)   PetscInt, allocatable :: integer_data(:), integer_data_recv(:)
  1916)   PetscReal, allocatable :: real_data(:), real_data_recv(:)
  1917)   PetscErrorCode :: ierr  
  1918)   
  1919) 1000 format(100(i2,1x))
  1920) 1001 format(100(i4,1x))
  1921) 1002 format(100(i6,1x))
  1922) 1003 format(100(i8,1x))
  1923) 1004 format(100(i10,1x))
  1924) 1010 format(100(es13.6,1x))
  1925) 
  1926)   patch => realization_base%patch
  1927)   grid => patch%grid
  1928)   option => realization_base%option
  1929) 
  1930)   call PetscLogEventBegin(logging%event_output_write_tecplot, &
  1931)                           ierr);CHKERRQ(ierr)
  1932) 
  1933)   ! if num_per_line exceeds 100, need to change the format statement below
  1934)   if (num_per_line > 100) then
  1935)     option%io_buffer = 'Number of values to be written to line in ' // &
  1936)       'WriteTecplotDataSetNumPerLine() exceeds 100.  ' // &
  1937)       'Must fix format statements.'
  1938)     call printErrMsg(option)
  1939)   endif
  1940) 
  1941)   ! maximum number of initial messages  
  1942) #define HANDSHAKE  
  1943)   max_proc = option%io_handshake_buffer_size
  1944)   max_proc_prefetch = option%io_handshake_buffer_size / 10
  1945) 
  1946)   if (size_flag /= 0) then
  1947)     call MPI_Allreduce(size_flag,max_local_size,ONE_INTEGER_MPI,MPIU_INTEGER, &
  1948)                        MPI_MAX,option%mycomm,ierr)
  1949)     local_size_mpi = size_flag
  1950)   else 
  1951)   ! if first time, determine the maximum size of any local array across 
  1952)   ! all procs
  1953)     if (max_local_size_saved < 0) then
  1954)       call MPI_Allreduce(grid%nlmax,max_local_size,ONE_INTEGER_MPI, &
  1955)                          MPIU_INTEGER,MPI_MAX,option%mycomm,ierr)
  1956)       max_local_size_saved = max_local_size
  1957)       write(option%io_buffer,'("max_local_size_saved: ",i9)') max_local_size
  1958)       call printMsg(option)
  1959)     endif
  1960)     max_local_size = max_local_size_saved
  1961)     local_size_mpi = grid%nlmax
  1962)   endif
  1963)   
  1964)   ! transfer the data to an integer or real array
  1965)   if (datatype == TECPLOT_INTEGER) then
  1966)     allocate(integer_data(max_local_size+10))
  1967)     allocate(integer_data_recv(max_local_size))
  1968)     do i=1,local_size_mpi
  1969)       integer_data(i) = int(array(i))
  1970)     enddo
  1971)   else
  1972)     allocate(real_data(max_local_size+10))
  1973)     allocate(real_data_recv(max_local_size))
  1974)     do i=1,local_size_mpi
  1975)       real_data(i) = array(i)
  1976)     enddo
  1977)   endif
  1978)   
  1979)   ! communicate data to processor 0, round robin style
  1980)   if (option%myrank == option%io_rank) then
  1981)     if (datatype == TECPLOT_INTEGER) then
  1982)       ! This approach makes output files identical, regardless of processor
  1983)       ! distribution.  It is necessary when diffing files.
  1984)       iend = 0
  1985)       do
  1986)         istart = iend+1
  1987)         if (iend+num_per_line > local_size_mpi) exit
  1988)         iend = istart+(num_per_line-1)
  1989)         i = abs(maxval(integer_data(istart:iend)))
  1990)         if (i < 10) then
  1991)           write(fid,1000) integer_data(istart:iend)
  1992)         else if (i < 1000) then
  1993)           write(fid,1001) integer_data(istart:iend)
  1994)         else if (i < 100000) then
  1995)           write(fid,1002) integer_data(istart:iend)
  1996)         else if (i < 10000000) then
  1997)           write(fid,1003) integer_data(istart:iend)
  1998)         else
  1999)           write(fid,1004) integer_data(istart:iend)
  2000)         endif
  2001)       enddo
  2002)       ! shift remaining data to front of array
  2003)       integer_data(1:local_size_mpi-iend) = integer_data(iend+1:local_size_mpi)
  2004)       num_in_array = local_size_mpi-iend
  2005)     else
  2006)       iend = 0
  2007)       do
  2008)         istart = iend+1
  2009)         if (iend+num_per_line > local_size_mpi) exit
  2010)         iend = istart+(num_per_line-1)
  2011)         ! if num_per_line exceeds 100, need to change the format statement below
  2012)         write(fid,1010) real_data(istart:iend)
  2013)       enddo
  2014)       ! shift remaining data to front of array
  2015)       real_data(1:local_size_mpi-iend) = real_data(iend+1:local_size_mpi)
  2016)       num_in_array = local_size_mpi-iend
  2017)     endif
  2018)     do iproc_mpi=1,option%mycommsize-1
  2019) #ifdef HANDSHAKE    
  2020)       if (option%io_handshake_buffer_size > 0 .and. &
  2021)           iproc_mpi+max_proc_prefetch >= max_proc) then
  2022)         max_proc = max_proc + option%io_handshake_buffer_size
  2023)         call MPI_Bcast(max_proc,ONE_INTEGER_MPI,MPIU_INTEGER,option%io_rank, &
  2024)                        option%mycomm,ierr)
  2025)       endif
  2026) #endif      
  2027)       call MPI_Probe(iproc_mpi,MPI_ANY_TAG,option%mycomm,status_mpi,ierr)
  2028)       recv_size_mpi = status_mpi(MPI_TAG)
  2029)       if (datatype == TECPLOT_INTEGER) then
  2030)         call MPI_Recv(integer_data_recv,recv_size_mpi,MPIU_INTEGER,iproc_mpi, &
  2031)                       MPI_ANY_TAG,option%mycomm,status_mpi,ierr)
  2032)         if (recv_size_mpi > 0) then
  2033)           integer_data(num_in_array+1:num_in_array+recv_size_mpi) = &
  2034)                                              integer_data_recv(1:recv_size_mpi)
  2035)           num_in_array = num_in_array+recv_size_mpi
  2036)         endif
  2037)         iend = 0
  2038)         do
  2039)           istart = iend+1
  2040)           if (iend+num_per_line > num_in_array) exit
  2041)           iend = istart+(num_per_line-1)
  2042)           i = abs(maxval(integer_data(istart:iend)))
  2043)           if (i < 10) then
  2044)             write(fid,1000) integer_data(istart:iend)
  2045)           else if (i < 1000) then
  2046)             write(fid,1001) integer_data(istart:iend)
  2047)           else if (i < 100000) then
  2048)             write(fid,1002) integer_data(istart:iend)
  2049)           else if (i < 10000000) then
  2050)             write(fid,1003) integer_data(istart:iend)
  2051)           else
  2052)             write(fid,1004) integer_data(istart:iend)
  2053)           endif
  2054)         enddo
  2055)         if (iend > 0) then
  2056)           integer_data(1:num_in_array-iend) = integer_data(iend+1:num_in_array)
  2057)           num_in_array = num_in_array-iend
  2058)         endif
  2059)       else
  2060)         call MPI_Recv(real_data_recv,recv_size_mpi,MPI_DOUBLE_PRECISION,iproc_mpi, &
  2061)                       MPI_ANY_TAG,option%mycomm,status_mpi,ierr)
  2062)         if (recv_size_mpi > 0) then
  2063)           real_data(num_in_array+1:num_in_array+recv_size_mpi) = &
  2064)                                              real_data_recv(1:recv_size_mpi)
  2065)           num_in_array = num_in_array+recv_size_mpi
  2066)         endif
  2067)         iend = 0
  2068)         do
  2069)           istart = iend+1
  2070)           if (iend+num_per_line > num_in_array) exit
  2071)           iend = istart+(num_per_line-1)
  2072)           ! if num_per_line exceeds 100, need to change the format statement below
  2073)           write(fid,1010) real_data(istart:iend)
  2074)         enddo
  2075)         if (iend > 0) then
  2076)           real_data(1:num_in_array-iend) = real_data(iend+1:num_in_array)
  2077)           num_in_array = num_in_array-iend
  2078)         endif
  2079)       endif
  2080)     enddo
  2081) #ifdef HANDSHAKE    
  2082)     if (option%io_handshake_buffer_size > 0) then
  2083)       max_proc = -1
  2084)       call MPI_Bcast(max_proc,ONE_INTEGER_MPI,MPIU_INTEGER,option%io_rank, &
  2085)                      option%mycomm,ierr)
  2086)     endif
  2087) #endif      
  2088)     ! Print the remaining values, if they exist
  2089)     if (datatype == TECPLOT_INTEGER) then
  2090)       if (num_in_array > 0) then
  2091)         i = abs(maxval(integer_data(1:num_in_array)))
  2092)         if (i < 10) then
  2093)           write(fid,1000) integer_data(1:num_in_array)
  2094)         else if (i < 1000) then
  2095)           write(fid,1001) integer_data(1:num_in_array)
  2096)         else if (i < 100000) then
  2097)           write(fid,1002) integer_data(1:num_in_array)
  2098)         else if (i < 10000000) then
  2099)           write(fid,1003) integer_data(1:num_in_array)
  2100)         else
  2101)           write(fid,1004) integer_data(1:num_in_array)
  2102)         endif
  2103)       endif
  2104)     else
  2105)       if (num_in_array > 0) &
  2106)         write(fid,1010) real_data(1:num_in_array)
  2107)     endif
  2108)   else
  2109) #ifdef HANDSHAKE    
  2110)     if (option%io_handshake_buffer_size > 0) then
  2111)       do
  2112)         if (option%myrank < max_proc) exit
  2113)         call MPI_Bcast(max_proc,1,MPIU_INTEGER,option%io_rank,option%mycomm, &
  2114)                        ierr)
  2115)       enddo
  2116)     endif
  2117) #endif    
  2118)     if (datatype == TECPLOT_INTEGER) then
  2119)       call MPI_Send(integer_data,local_size_mpi,MPIU_INTEGER,option%io_rank, &
  2120)                     local_size_mpi,option%mycomm,ierr)
  2121)     else
  2122)       call MPI_Send(real_data,local_size_mpi,MPI_DOUBLE_PRECISION,option%io_rank, &
  2123)                     local_size_mpi,option%mycomm,ierr)
  2124)     endif
  2125) #ifdef HANDSHAKE    
  2126)     if (option%io_handshake_buffer_size > 0) then
  2127)       do
  2128)         call MPI_Bcast(max_proc,1,MPIU_INTEGER,option%io_rank,option%mycomm, &
  2129)                        ierr)
  2130)         if (max_proc < 0) exit
  2131)       enddo
  2132)     endif
  2133) #endif
  2134) #undef HANDSHAKE
  2135)   endif
  2136)       
  2137)   if (datatype == TECPLOT_INTEGER) then
  2138)     deallocate(integer_data)
  2139)   else
  2140)     deallocate(real_data)
  2141)   endif
  2142) 
  2143)   call PetscLogEventEnd(logging%event_output_write_tecplot,ierr);CHKERRQ(ierr)
  2144) 
  2145) end subroutine WriteTecplotDataSetNumPerLine
  2146) 
  2147) ! ************************************************************************** !
  2148) 
  2149) subroutine OutputPrintExplicitFlowrates(realization_base)
  2150)   ! 
  2151)   ! Prints out the flow rate through a voronoi face
  2152)   ! for explicit grid. This will be used for particle tracking.
  2153)   ! Prints out natural id of the two nodes and the value of the flow rate
  2154)   ! 
  2155)   ! Author: Satish Karra, LANL
  2156)   ! Date: 04/24/13, 08/21/13 (Updated to Walkabout format)
  2157)   ! 
  2158) 
  2159)   use Realization_Base_class, only : realization_base_type
  2160)   use Grid_module
  2161)   use Grid_Unstructured_Aux_module
  2162)   use Option_module
  2163)   use Field_module
  2164)   use Patch_module
  2165)   use Output_Common_module  
  2166)  
  2167)   implicit none
  2168) 
  2169)   class(realization_base_type) :: realization_base
  2170)   type(grid_type), pointer :: grid
  2171)   type(option_type), pointer :: option
  2172)   type(field_type), pointer :: field
  2173)   type(patch_type), pointer :: patch
  2174)   type(output_option_type), pointer :: output_option
  2175)   character(len=MAXSTRINGLENGTH) :: filename,string,filename2
  2176) 
  2177)   PetscErrorCode :: ierr  
  2178)   PetscInt :: iconn
  2179)   PetscInt :: count
  2180)   PetscReal, pointer :: flowrates(:,:)
  2181)   PetscReal, pointer :: darcy(:), area(:)
  2182)   PetscInt, pointer :: nat_ids_up(:),nat_ids_dn(:)
  2183)   PetscReal, pointer :: density(:)
  2184)   Vec :: vec_proc
  2185)   PetscInt :: i, idof, icell, num_cells
  2186)   PetscInt, pointer :: ids(:)
  2187)   PetscReal, pointer :: sat(:), por(:), pressure(:)
  2188)   
  2189)   patch => realization_base%patch
  2190)   grid => patch%grid
  2191)   option => realization_base%option
  2192)   field => realization_base%field
  2193)   output_option => realization_base%output_option
  2194)   
  2195)   filename = trim(option%global_prefix) // &
  2196)              trim(option%group_prefix) // &
  2197)              '-' // 'darcyvel' // '-' // &
  2198)              trim(OutputFilenameID(output_option,option)) 
  2199)              
  2200)   filename2 = trim(option%global_prefix) // &
  2201)               trim(option%group_prefix) // &
  2202)               '-' // 'cellinfo' // '-' // &
  2203)               trim(OutputFilenameID(output_option,option)) 
  2204)   
  2205)   call OutputGetExplicitIDsFlowrates(realization_base,count,vec_proc, &
  2206)                                      nat_ids_up,nat_ids_dn)
  2207)   call OutputGetExplicitFlowrates(realization_base,count,vec_proc,flowrates, &
  2208)                                   darcy,area)
  2209)   call OutputGetExplicitAuxVars(realization_base,count,vec_proc, &
  2210)                                 density)
  2211)     
  2212)   if (option%myrank == option%io_rank) then
  2213)     option%io_buffer = '--> write rate output file: ' // &
  2214)                        trim(filename)
  2215)     call printMsg(option)                       
  2216)   endif
  2217)   
  2218)   
  2219) 1000 format(es13.6,1x)
  2220) 1001 format(i10,1x)
  2221) 1009 format('')
  2222)  
  2223)  ! Order of printing for the 1st file
  2224)  ! id1 id2 darcy_vel[m/s] density[kg/m3]
  2225)  
  2226)   write(string,*) option%myrank
  2227)   string = trim(filename) // '-rank' // trim(adjustl(string)) // '.dat'
  2228)   open(unit=OUTPUT_UNIT,file=trim(string),action="write")
  2229)   do i = 1, count
  2230)     density(i) = density(i)*FMWH2O
  2231)     write(OUTPUT_UNIT,1001,advance='no') nat_ids_up(i)
  2232)     write(OUTPUT_UNIT,1001,advance='no') nat_ids_dn(i)
  2233)     write(OUTPUT_UNIT,1000,advance='no') darcy(i)
  2234)     write(OUTPUT_UNIT,1000,advance='no') density(i)
  2235)     write(OUTPUT_UNIT,1000,advance='no') area(i)
  2236)     write(OUTPUT_UNIT,'(a)')
  2237)   enddo                     
  2238)   close(OUTPUT_UNIT)
  2239)                                     
  2240)   deallocate(flowrates)
  2241)   deallocate(darcy)
  2242)   deallocate(nat_ids_up)
  2243)   deallocate(nat_ids_dn)
  2244)   deallocate(density)
  2245)   deallocate(area)
  2246)   
  2247)  ! Order of printing for the 2nd file
  2248)  ! cellid saturation porosity density[kg/m3] pressure[Pa]
  2249)   
  2250)   call OutputGetExplicitCellInfo(realization_base,num_cells,ids,sat,por, &
  2251)                                  density,pressure) 
  2252)  
  2253)   write(string,*) option%myrank
  2254)   string = trim(filename2) // '-rank' // trim(adjustl(string)) // '.dat'
  2255)   open(unit=OUTPUT_UNIT,file=trim(string),action="write")
  2256)   do icell = 1, num_cells
  2257)     density(icell) = density(icell)*FMWH2O
  2258)     write(OUTPUT_UNIT,1001,advance='no') ids(icell)
  2259)     write(OUTPUT_UNIT,1000,advance='no') sat(icell)
  2260)     write(OUTPUT_UNIT,1000,advance='no') por(icell)
  2261)     write(OUTPUT_UNIT,1000,advance='no') density(icell)
  2262)     write(OUTPUT_UNIT,1000,advance='no') pressure(icell)
  2263)     write(OUTPUT_UNIT,'(a)')
  2264)   enddo                     
  2265)   close(OUTPUT_UNIT)
  2266)   
  2267)   deallocate(ids)
  2268)   deallocate(sat)
  2269)   deallocate(por)
  2270)   deallocate(density)
  2271)   deallocate(pressure)
  2272) 
  2273) end subroutine OutputPrintExplicitFlowrates
  2274) 
  2275) ! ************************************************************************** !
  2276) 
  2277) subroutine OutputSecondaryContinuumTecplot(realization_base)
  2278)   ! 
  2279)   ! Print secondary continuum variables
  2280)   ! in tecplot format. The output is at a given primary continuum node,
  2281)   ! and the coordinates in the output are the secondary continuum spatial
  2282)   ! coordinates
  2283)   ! 
  2284)   ! Author: Satish Karra, LANL
  2285)   ! Date: 04/30/2013
  2286)   ! 
  2287) 
  2288)   use Realization_Base_class, only : realization_base_type, &
  2289)                                      RealizGetVariableValueAtCell
  2290)   use Option_module
  2291)   use Field_module
  2292)   use Patch_module
  2293)   use Grid_module
  2294)   use Reaction_Aux_module
  2295)   use Observation_module
  2296)   use Variables_module
  2297)   use Secondary_Continuum_Aux_module, only : sec_transport_type, &
  2298)                                              sec_heat_type, sec_continuum_type
  2299) 
  2300)  
  2301)   implicit none
  2302) 
  2303)   class(realization_base_type) :: realization_base
  2304)   
  2305)   PetscInt :: i, comma_count, quote_count
  2306)   PetscInt :: icolumn
  2307)   character(len=MAXSTRINGLENGTH) :: filename, string, string2
  2308)   character(len=MAXSTRINGLENGTH) :: string3
  2309)   type(option_type), pointer :: option
  2310)   type(field_type), pointer :: field
  2311)   type(patch_type), pointer :: patch 
  2312)   type(output_option_type), pointer :: output_option
  2313)   type(observation_type), pointer :: observation
  2314)   type(grid_type), pointer :: grid
  2315)   type(sec_transport_type), pointer :: rt_sec_tranport_vars(:)
  2316)   type(sec_heat_type), pointer :: sec_heat_vars(:)
  2317)   type(reaction_type), pointer :: reaction   
  2318)   PetscReal :: value
  2319)   PetscInt :: ivar, isubvar, var_type
  2320)   PetscErrorCode :: ierr  
  2321)   PetscInt :: count, icell, sec_id
  2322)   PetscInt :: ghosted_id, local_id
  2323)   PetscInt :: naqcomp, nkinmnrl
  2324)   PetscReal, pointer :: dist(:)
  2325)   
  2326)   patch => realization_base%patch
  2327)   option => realization_base%option
  2328)   field => realization_base%field
  2329)   grid => patch%grid
  2330)   output_option => realization_base%output_option
  2331) 
  2332)   if (option%use_mc) then
  2333)     if (option%ntrandof > 0) then
  2334)       rt_sec_tranport_vars => patch%aux%SC_RT%sec_transport_vars
  2335)       reaction => realization_base%reaction
  2336)     endif
  2337)     if (option%iflowmode == TH_MODE &
  2338)         .or. option%iflowmode == MPH_MODE) then
  2339)       sec_heat_vars => patch%aux%SC_heat%sec_heat_vars
  2340)     endif
  2341)   endif
  2342) 
  2343)   ! Here we are assuming that if there are secondary continua for both
  2344)   ! heat and reactive transport, then the shape and type of secondary
  2345)   ! continua are the same - SK
  2346)   if (associated(sec_heat_vars)) then
  2347)     dist => sec_heat_vars(1)%sec_continuum%distance
  2348)   elseif (associated(rt_sec_tranport_vars)) then
  2349)     dist => rt_sec_tranport_vars(1)%sec_continuum%distance
  2350)   endif
  2351) 
  2352) 
  2353)   ! write points
  2354) 1000 format(es13.6,1x)
  2355) 1009 format('')
  2356) 
  2357)   count = 0
  2358)   observation => patch%observation_list%first
  2359)   do 
  2360)     if (.not.associated(observation)) exit
  2361)     write(string,'(i6)') option%myrank
  2362)     write(string2,'(i6)') count
  2363)     string3 = OutputFilenameID(output_option,option)
  2364)     filename = trim(option%global_prefix) // trim(option%group_prefix) // &
  2365)                '-sec-rank' // trim(adjustl(string)) // '-obs' &
  2366)                // trim(adjustl(string2)) // '-' // trim(string3) // '.tec'    
  2367)     
  2368)     if (option%myrank == option%io_rank) then
  2369)       option%io_buffer = '--> write tecplot output file: ' // trim(filename)
  2370)       call printMsg(option)
  2371)     endif
  2372)     
  2373)     ! open file
  2374)     open(unit=OUTPUT_UNIT,file=filename,action="write")
  2375) 
  2376)     ! must initialize icolumn here so that icolumn does not restart with
  2377)     ! each observation point
  2378)     if (output_option%print_column_ids) then
  2379)       icolumn = 1
  2380)     else
  2381)       icolumn = -1
  2382)     endif    
  2383)     
  2384)     ! write header
  2385)     ! write title
  2386)     write(OUTPUT_UNIT,'(''TITLE = "'',1es13.5," [",a1,'']"'')') &
  2387)               option%time/output_option%tconv,output_option%tunit
  2388) 
  2389)     ! initial portion of header
  2390)     string = 'VARIABLES=' // &
  2391)              '"dist [m]"'
  2392)                
  2393)     write(OUTPUT_UNIT,'(a)',advance='no') trim(string)
  2394)                       
  2395)     if (associated(observation%region%coordinates) .and. &
  2396)             .not.observation%at_cell_center) then
  2397)       option%io_buffer = 'Writing of data at coordinates not ' // &
  2398)               'functioning properly for minerals.  Perhaps due to ' // &
  2399)               'non-ghosting of vol frac....>? - geh'
  2400)       call printErrMsg(option)
  2401)       call WriteTecplotHeaderForCoordSec(OUTPUT_UNIT,realization_base, &
  2402)                                          observation%region, &
  2403)                                          observation% &
  2404)                                          print_secondary_data, &
  2405)                                          icolumn)
  2406)     else
  2407)       do icell = 1,observation%region%num_cells
  2408)         call WriteTecplotHeaderForCellSec(OUTPUT_UNIT,realization_base, &
  2409)                                           observation%region,icell, &
  2410)                                           observation% &
  2411)                                           print_secondary_data, &
  2412)                                           icolumn)
  2413)       enddo
  2414)     endif
  2415) 
  2416)     write(OUTPUT_UNIT,'(a)',advance='yes') ""
  2417)     ! write zone header
  2418)     write(string,'(''ZONE T="'',1es13.5,''",'','' I='',i5)') &
  2419)                   option%time/output_option%tconv, &
  2420)                   option%nsec_cells
  2421)     string = trim(string) // ',J=1, K=1, DATAPACKING=POINT'
  2422)     write(OUTPUT_UNIT,'(a)',advance='no') trim(string)
  2423)     write(OUTPUT_UNIT,1009)
  2424)    
  2425)     do sec_id = 1,option%nsec_cells
  2426)       write(OUTPUT_UNIT,1000,advance='no') dist(sec_id)
  2427)       do icell = 1,observation%region%num_cells
  2428)         local_id = observation%region%cell_ids(icell)
  2429)         ghosted_id = grid%nL2G(local_id)
  2430)         if (observation%print_secondary_data(1)) then
  2431)           write(OUTPUT_UNIT,1000,advance='no') &
  2432)           RealizGetVariableValueAtCell(realization_base,SECONDARY_TEMPERATURE, &
  2433)                                       sec_id,ghosted_id)        
  2434)         endif
  2435)         if (observation%print_secondary_data(2)) then
  2436)           if (associated(reaction)) then
  2437)             if (reaction%naqcomp > 0) then
  2438)               do naqcomp = 1, reaction%naqcomp
  2439)                 write(OUTPUT_UNIT,1000,advance='no') &
  2440)                 RealizGetVariableValueAtCell(realization_base, &
  2441)                                              SECONDARY_CONCENTRATION, &
  2442)                                              sec_id,ghosted_id,naqcomp)
  2443)                enddo
  2444)             endif
  2445)           endif
  2446)         endif
  2447)         if (observation%print_secondary_data(3)) then
  2448)           if (associated(reaction)) then
  2449)             if (associated(reaction%mineral)) then
  2450)               if (reaction%mineral%nkinmnrl > 0) then
  2451)                 do nkinmnrl = 1, reaction%mineral%nkinmnrl
  2452)                   write(OUTPUT_UNIT,1000,advance='no') &
  2453)                   RealizGetVariableValueAtCell(realization_base,SEC_MIN_VOLFRAC, &
  2454)                                                sec_id,ghosted_id,nkinmnrl) 
  2455)                 enddo
  2456)               endif
  2457)             endif
  2458)           endif
  2459)         endif     
  2460)         if (observation%print_secondary_data(4)) then
  2461)           if (associated(reaction)) then
  2462)             if (associated(reaction%mineral)) then
  2463)               if (reaction%mineral%nkinmnrl > 0) then
  2464)                 do nkinmnrl = 1, reaction%mineral%nkinmnrl
  2465)                   write(OUTPUT_UNIT,1000,advance='no') &
  2466)                   RealizGetVariableValueAtCell(realization_base,SEC_MIN_RATE, &
  2467)                                                sec_id,ghosted_id,nkinmnrl) 
  2468)                 enddo
  2469)               endif
  2470)             endif
  2471)           endif
  2472)         endif      
  2473)         if (observation%print_secondary_data(5)) then
  2474)           if (associated(reaction)) then
  2475)             if (associated(reaction%mineral)) then
  2476)               if (reaction%mineral%nkinmnrl > 0) then
  2477)                 do nkinmnrl = 1, reaction%mineral%nkinmnrl
  2478)                   write(OUTPUT_UNIT,1000,advance='no') &
  2479)                   RealizGetVariableValueAtCell(realization_base,SEC_MIN_SI, &
  2480)                                                sec_id,ghosted_id,nkinmnrl) 
  2481)                 enddo
  2482)               endif
  2483)             endif
  2484)           endif
  2485)         endif                         
  2486)       enddo
  2487)       write(OUTPUT_UNIT,1009)
  2488)     enddo         
  2489)        
  2490)     close(OUTPUT_UNIT)
  2491)     observation => observation%next
  2492)     count = count + 1    
  2493)   enddo
  2494)    
  2495) end subroutine OutputSecondaryContinuumTecplot
  2496) 
  2497) ! ************************************************************************** !
  2498) 
  2499) subroutine WriteTecplotHeaderForCellSec(fid,realization_base,region,icell, &
  2500)                                         print_secondary_data, &
  2501)                                         icolumn)
  2502)   ! 
  2503)   ! Print tecplot header for data at a cell for
  2504)   ! secondary continuum
  2505)   ! 
  2506)   ! Author: Satish Karra, LANL
  2507)   ! Date: 04/30/2013
  2508)   ! 
  2509) 
  2510)   use Realization_Base_class, only : realization_base_type
  2511)   use Grid_module
  2512)   use Option_module
  2513)   use Output_Aux_module
  2514)   use Patch_module
  2515)   use Region_module
  2516)   use Utility_module, only : BestFloat
  2517)   
  2518)   implicit none
  2519)   
  2520)   PetscInt :: fid
  2521)   class(realization_base_type) :: realization_base
  2522)   type(region_type) :: region
  2523)   PetscInt :: icell
  2524)   PetscBool :: print_secondary_data(5)
  2525)   PetscInt :: icolumn
  2526)   
  2527)   PetscInt :: local_id
  2528)   character(len=MAXSTRINGLENGTH) :: cell_string
  2529)   character(len=MAXWORDLENGTH) :: x_string, y_string, z_string
  2530)   type(grid_type), pointer :: grid
  2531) 
  2532)   grid => realization_base%patch%grid
  2533)   
  2534)   local_id = region%cell_ids(icell)
  2535)   write(cell_string,*) grid%nG2A(grid%nL2G(region%cell_ids(icell)))
  2536)   cell_string = trim(region%name) // ' (' // trim(adjustl(cell_string)) // ')'
  2537) 
  2538)   ! add coordinate of cell center
  2539)   x_string = BestFloat(grid%x(grid%nL2G(local_id)),1.d4,1.d-2)
  2540)   y_string = BestFloat(grid%y(grid%nL2G(local_id)),1.d4,1.d-2)
  2541)   z_string = BestFloat(grid%z(grid%nL2G(local_id)),1.d4,1.d-2)
  2542)   cell_string = trim(cell_string) // ' (' // trim(adjustl(x_string)) // &
  2543)                 ' ' // trim(adjustl(y_string)) // &
  2544)                 ' ' // trim(adjustl(z_string)) // ')'
  2545)   
  2546)   call WriteTecplotHeaderSec(fid,realization_base,cell_string, &
  2547)                                  print_secondary_data,icolumn)
  2548) 
  2549) end subroutine WriteTecplotHeaderForCellSec
  2550) 
  2551) ! ************************************************************************** !
  2552) 
  2553) subroutine WriteTecplotHeaderForCoordSec(fid,realization_base,region, &
  2554)                                          print_secondary_data, &
  2555)                                          icolumn)
  2556)   ! 
  2557)   ! Print a header for data at a coordinate
  2558)   ! for secondary continuum
  2559)   ! 
  2560)   ! Author: Satish Karra, LANL
  2561)   ! Date: 04/30/2013
  2562)   ! 
  2563) 
  2564)   use Realization_Base_class, only : realization_base_type
  2565)   use Option_module
  2566)   use Patch_module
  2567)   use Region_module
  2568)   use Utility_module, only : BestFloat
  2569)   
  2570)   implicit none
  2571)   
  2572)   PetscInt :: fid
  2573)   class(realization_base_type) :: realization_base
  2574)   type(region_type) :: region
  2575)   PetscBool :: print_secondary_data(5)
  2576)   PetscInt :: icolumn
  2577)   
  2578)   character(len=MAXSTRINGLENGTH) :: cell_string
  2579)   character(len=MAXWORDLENGTH) :: x_string, y_string, z_string
  2580)   
  2581)   cell_string = trim(region%name)
  2582)   
  2583)   x_string = BestFloat(region%coordinates(ONE_INTEGER)%x,1.d4,1.d-2)
  2584)   y_string = BestFloat(region%coordinates(ONE_INTEGER)%y,1.d4,1.d-2)
  2585)   z_string = BestFloat(region%coordinates(ONE_INTEGER)%z,1.d4,1.d-2)
  2586)   cell_string = trim(cell_string) // ' (' // trim(adjustl(x_string)) // ' ' // &
  2587)                 trim(adjustl(y_string)) // ' ' // &
  2588)                 trim(adjustl(z_string)) // ')'
  2589) 
  2590)   call WriteTecplotHeaderSec(fid,realization_base,cell_string, &
  2591)                              print_secondary_data,icolumn)
  2592) 
  2593) end subroutine WriteTecplotHeaderForCoordSec
  2594) 
  2595) ! ************************************************************************** !
  2596) 
  2597) subroutine WriteTecplotHeaderSec(fid,realization_base,cell_string, &
  2598)                                  print_secondary_data,icolumn)
  2599)   ! 
  2600)   ! Print a header for secondary continuum data
  2601)   ! 
  2602)   ! Author: Satish Karra, LANL
  2603)   ! Date: 04/30/2013
  2604)   ! 
  2605)                                      
  2606)   use Realization_Base_class, only : realization_base_type
  2607)   use Option_module
  2608)   use Reaction_Aux_module
  2609) 
  2610)   implicit none
  2611)   
  2612)   PetscInt :: fid
  2613)   class(realization_base_type) :: realization_base
  2614)   type(reaction_type), pointer :: reaction 
  2615)   PetscBool :: print_secondary_data(5)
  2616)   character(len=MAXSTRINGLENGTH) :: cell_string
  2617)   PetscInt :: icolumn
  2618)   
  2619)   PetscInt :: i,j
  2620)   character(len=MAXSTRINGLENGTH) :: string
  2621)   type(option_type), pointer :: option
  2622)   type(output_option_type), pointer :: output_option  
  2623)   
  2624)   option => realization_base%option
  2625)   output_option => realization_base%output_option
  2626)   
  2627)   ! add secondary temperature to header
  2628)   if (print_secondary_data(1)) then
  2629)     select case (option%iflowmode) 
  2630)       case (TH_MODE, MPH_MODE)
  2631)         string = 'T'
  2632)         call OutputWriteToHeader(fid,string,'C',cell_string,icolumn)
  2633)       case default
  2634)     end select
  2635)   endif
  2636)   
  2637)   ! add secondary concentrations to header
  2638)   if (option%ntrandof > 0) then 
  2639)     reaction => realization_base%reaction
  2640)     if (print_secondary_data(2)) then
  2641)       do j = 1, reaction%naqcomp
  2642)         string = 'Free ion ' // trim(reaction%primary_species_names(j))
  2643)         call OutputWriteToHeader(fid,string,'molal',cell_string,icolumn)
  2644)       enddo
  2645)     endif
  2646)   
  2647)   
  2648)     ! add secondary mineral volume fractions to header
  2649)     if (print_secondary_data(3)) then
  2650)       if (reaction%mineral%nkinmnrl > 0) then
  2651)         do j = 1, reaction%mineral%nkinmnrl
  2652)           string = trim(reaction%mineral%mineral_names(j)) // ' VF'
  2653)           call OutputWriteToHeader(fid,string,'',cell_string,icolumn)
  2654)         enddo
  2655)       endif
  2656)     endif
  2657)     
  2658)      ! add secondary mineral rates to header
  2659)     if (print_secondary_data(4)) then
  2660)       if (reaction%mineral%nkinmnrl > 0) then
  2661)         do j = 1, reaction%mineral%nkinmnrl
  2662)           string = trim(reaction%mineral%mineral_names(j)) // ' Rate'
  2663)           call OutputWriteToHeader(fid,string,'',cell_string,icolumn)
  2664)         enddo
  2665)       endif
  2666)     endif
  2667) 
  2668)     ! add secondary mineral SI to header
  2669)     if (print_secondary_data(5)) then
  2670)       if (reaction%mineral%nkinmnrl > 0) then
  2671)         do j = 1, reaction%mineral%nkinmnrl
  2672)           string = trim(reaction%mineral%mineral_names(j)) // ' SI'
  2673)           call OutputWriteToHeader(fid,string,'',cell_string,icolumn)
  2674)         enddo
  2675)       endif
  2676)     endif
  2677)    
  2678)     
  2679)   endif 
  2680)   
  2681) end subroutine WriteTecplotHeaderSec
  2682) 
  2683) ! ************************************************************************** !
  2684) !> This routine writes polyhedra unstructured grid elements.
  2685) !!
  2686) !> @author
  2687) !! Gautam Bisht, LBL
  2688) !!
  2689) !! date: 12/29/13
  2690) ! ************************************************************************** !
  2691) subroutine WriteTecplotPolyUGridElements(fid,realization_base)
  2692) 
  2693)   use Realization_Base_class, only : realization_base_type
  2694)   use Grid_module
  2695)   use Grid_Unstructured_Aux_module
  2696)   use Option_module
  2697)   use Patch_module
  2698) 
  2699)   implicit none
  2700) 
  2701)   PetscInt :: fid
  2702)   class(realization_base_type) :: realization_base
  2703) 
  2704)   type(grid_type), pointer :: grid
  2705)   type(option_type), pointer :: option
  2706)   type(patch_type), pointer :: patch
  2707)   Vec :: global_cconn_vec
  2708)   type(ugdm_type), pointer :: ugdm_element
  2709)   PetscReal, pointer :: vec_ptr(:)
  2710)   PetscErrorCode :: ierr
  2711) 
  2712)   patch => realization_base%patch
  2713)   grid => patch%grid
  2714)   option => realization_base%option
  2715) 
  2716)   write(fid,'(a)') '# number of vertices/nodes per face'
  2717)   call WriteTecplotDataSetNumPerLine(fid, realization_base, &
  2718)                       grid%unstructured_grid%polyhedra_grid%uface_nverts*1.d0, &
  2719)                       TECPLOT_INTEGER, &
  2720)                       grid%unstructured_grid%polyhedra_grid%num_ufaces_local, &
  2721)                       TEN_INTEGER)
  2722) 
  2723)   write(fid,'(a)') '# id of vertices/nodes forming a face'
  2724)   call WriteTecplotDataSetNumPerLine(fid, realization_base, &
  2725)                   grid%unstructured_grid%polyhedra_grid%uface_natvertids*1.d0, &
  2726)                   TECPLOT_INTEGER, &
  2727)                   grid%unstructured_grid%polyhedra_grid%num_verts_of_ufaces_local, &
  2728)                   FOUR_INTEGER)
  2729) 
  2730)   write(fid,'(a)') '# id of control-volume/element left of a face'
  2731)   call WriteTecplotDataSetNumPerLine(fid, realization_base, &
  2732)              grid%unstructured_grid%polyhedra_grid%uface_left_natcellids*1.d0, &
  2733)              TECPLOT_INTEGER, &
  2734)              grid%unstructured_grid%polyhedra_grid%num_ufaces_local, &
  2735)              TEN_INTEGER)
  2736) 
  2737)   write(fid,'(a)') '# id of control-volume/element right of a face'
  2738)   call WriteTecplotDataSetNumPerLine(fid, realization_base, &
  2739)             grid%unstructured_grid%polyhedra_grid%uface_right_natcellids*1.d0, &
  2740)             TECPLOT_INTEGER, &
  2741)             grid%unstructured_grid%polyhedra_grid%num_ufaces_local, &
  2742)             TEN_INTEGER)
  2743) 
  2744) end subroutine WriteTecplotPolyUGridElements
  2745) 
  2746) end module Output_Tecplot_module

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