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