fix data backup and recovery bugs

Author: fangjian

Makefile.pastr

@@ -24,11 +24,11 @@ TARGET = $(BINDIR)/$(EXE)
 
 VPATH = $(SRCDIR):$(OBJDIR)
 
-srs=  pastr_commvar.F90 pastr_constdef.F90 pastr_utility.F90 pastr_h5io.F90 \
-      pastr_io.F90 pastr_tecio.F90 pastr_xdmf.F90 pastr_gradients.F90       \
-      pastr_thermo_phys.F90 pastr_flowvis.F90 pastr_input.F90               \
-      pastr_data_convert.F90 pastr_field_view.F90 pastr_udf.F90             \
-      pastr_process.F90 pastr_main.F90
+srs=  pastr_constdef.F90 pastr_commtype.F90 pastr_commvar.F90 pastr_multiblock_type.F90        \
+      pastr_utility.F90 pastr_h5io.F90 pastr_io.F90 pastr_tecio.F90 pastr_xdmf.F90             \
+      pastr_gradients.F90 pastr_thermo_phys.F90 pastr_flowvis.F90 pastr_input.F90              \
+      pastr_data_convert.F90 pastr_field_view.F90 pastr_udf.F90 pastr_process.F90              \
+      pastr_main.F90
 
 OBJS=$(srs:.F90=.o)
 

pastr/src/pastr_commtype.F90

@@ -0,0 +1,51 @@
+module pastr_commtype
+
+    use iso_fortran_env, only: wp => real64
+    use pastr_constdef
+
+    implicit none
+
+    type :: montype
+      integer :: npoints,nvariables
+      character(len=16),allocatable :: varname(:)
+      integer,allocatable :: nstep(:)
+      real(wp),allocatable :: time(:),data(:,:)
+      contains
+      procedure :: init => alloc_monitor
+    end type montype
+
+    type :: tblock
+      integer :: im,jm,nvar
+      integer :: ilo,ihi,jlo,jhi
+      character(len=16),allocatable :: varname(:)
+      real(wp), allocatable, dimension(:,:) :: x,y
+      real(wp), allocatable, dimension(:,:,:) :: var
+      contains
+      procedure :: init_data => alloc_block_data
+    end type tblock
+
+contains
+
+    subroutine alloc_monitor(amonitor)
+
+      class(montype),target :: amonitor
+
+      allocate(amonitor%varname(amonitor%nvariables))
+      allocate(amonitor%time(amonitor%npoints))
+      allocate(amonitor%nstep(amonitor%npoints))
+      allocate(amonitor%data(amonitor%nvariables,amonitor%npoints))
+
+    end subroutine alloc_monitor
+
+    subroutine alloc_block_data(ablock)
+
+      class(tblock),target :: ablock
+
+      allocate(ablock%varname(ablock%nvar))
+      allocate(ablock%x(0:ablock%im,0:ablock%jm))
+      allocate(ablock%y(0:ablock%im,0:ablock%jm))
+      allocate(ablock%var(0:ablock%im,0:ablock%jm,1:ablock%nvar))
+
+    end subroutine alloc_block_data
+
+end module pastr_commtype

pastr/src/pastr_commvar.F90

@@ -2,6 +2,7 @@ module pastr_commvar
 
     use iso_fortran_env, only: wp => real64
     use pastr_constdef
+    use pastr_commtype
 
     implicit none
 
@@ -25,37 +26,11 @@ module pastr_commvar
     real(wp), allocatable, dimension(:, :, :) :: x, y, z, ro, u1, u2, u3, p, t
     real(wp), allocatable, dimension(:, :, :) :: ro_m, u1_m, u2_m, u3_m, p_m, t_m
     real(wp), allocatable, dimension(:, :)   :: ro_zm, u1_zm, u2_zm, u3_zm, &
-                                               p_zm, t_zm
+                                                p_zm, t_zm
     real(wp), allocatable, dimension(:)     :: ro_xzm, u1_xzm, u2_xzm, u3_xzm, &
-                                              p_xzm, t_xzm
+                                               p_xzm, t_xzm
     real(wp), allocatable, dimension(:, :, :, :) :: du1_m, du2_m, du3_m, dt_m
     real(wp), allocatable, dimension(:, :, :) :: du1_zm, du2_zm, du3_zm, dt_zm
     real(wp), allocatable, dimension(:, :) :: du1_xzm, du2_xzm, du3_xzm, dt_xzm
 
-    type :: montype
-      integer :: npoints,nvariables
-      character(len=16),allocatable :: varname(:)
-      integer,allocatable :: nstep(:)
-      real(wp),allocatable :: time(:),data(:,:)
-      contains
-      procedure :: init => alloc_monitor
-    end type montype
-
-    
-
-
-contains
-
-    subroutine alloc_monitor(amonitor)
-    !
-    class(montype),target :: amonitor
-
-    allocate(amonitor%varname(amonitor%nvariables))
-    allocate(amonitor%time(amonitor%npoints))
-    allocate(amonitor%nstep(amonitor%npoints))
-    allocate(amonitor%data(amonitor%nvariables,amonitor%npoints))
-
-  end subroutine alloc_monitor
-
-  
 end module pastr_commvar

pastr/src/pastr_field_view.F90

@@ -19,6 +19,7 @@ subroutine write_xy_slice(filein,fileout,nfirst,nlast,slice,format)
       use pastr_tecio
       use pastr_xdmf
       use pastr_data_convert
+      use pastr_commtype
 
       character(len=*),intent(in), optional :: filein,fileout
       integer,intent(in), optional :: nfirst,nlast
@@ -33,6 +34,10 @@ subroutine write_xy_slice(filein,fileout,nfirst,nlast,slice,format)
       character(len=6) :: src_of_data
       real(wp),allocatable :: r8dat(:,:)
       real(wp),allocatable,dimension(:,:,:) :: dat_var_in,dat_var_out
+      type(tblock),allocatable,target :: pblocks(:)
+      type(tblock),pointer :: b
+      integer :: nblocks
+      logical :: multi_block
 
       call parse_command_line( string=src_of_data )
 
@@ -90,13 +95,29 @@ subroutine write_xy_slice(filein,fileout,nfirst,nlast,slice,format)
 
         dat_var_out=dat_out_cal(dat_var_in,nam_var_in,nam_var_out,x,y)
 
-        if(trim(format)=='plt') then
-          call writetecbin2dlist_xy('snapshot/'//trim(file2write),x(is:ie,js:je), &
-                                                                  y(is:ie,js:je), &
-                                                                  dat_var_out(is:ie,js:je,:),nam_var_out)
-        elseif(trim(format)=='xdmf') then
-          call xdmfwriter(dir='snapshot/',filename=trim(file2write),x=x(is:ie,0),y=y(0,js:je), &
-                                             var=dat_var_out(is:ie,js:je,:),varname=nam_var_out )
+        call block_define(multi_block,nblocks,pblocks)
+
+        do i=1,nblocks
+          b=>pblocks(i)
+          b%nvar=num_var_out
+          call b%init_data()
+          b%x(0:b%im,0:b%jm)=x(b%ilo:b%ihi,b%jlo:b%jhi)
+          b%y(0:b%im,0:b%jm)=y(b%ilo:b%ihi,b%jlo:b%jhi)
+          b%var(0:b%im,0:b%jm,1:num_var_out)=dat_var_out(b%ilo:b%ihi,b%jlo:b%jhi,1:num_var_out )
+          b%varname=nam_var_out
+        enddo
+
+        if(multi_block) then
+            call xdmfwriter(dir='snapshot/',filename=trim(file2write),blocks=pblocks )
+        else
+          if(trim(format)=='plt') then
+            call writetecbin2dlist_xy('snapshot/'//trim(file2write),x(is:ie,js:je), &
+                                                                    y(is:ie,js:je), &
+                                                                    dat_var_out(is:ie,js:je,:),nam_var_out)
+          elseif(trim(format)=='xdmf') then
+            call xdmfwriter(dir='snapshot/',filename=trim(file2write),x=x(is:ie,0),y=y(0,js:je), &
+                                               var=dat_var_out(is:ie,js:je,:),varname=nam_var_out )
+          endif
         endif
 
       enddo
@@ -263,7 +284,7 @@ subroutine write_3d_field(filein,fileout,nfirst,nlast,format)
         enddo
 
         dat_var_out=dat_out_cal(dat_var_in,nam_var_in,nam_var_out,x,y,z)
-
+        
         if(trim(format)=='plt') then
           call writetecbin3dlist('snapshot/'//trim(file2write),x(is:ie,js:je,ks:ke), &
                                                                y(is:ie,js:je,ks:ke), &
@@ -366,4 +387,40 @@ subroutine var_define(num_var_in,nam_var_in,num_var_out,nam_var_out)
 
     end subroutine var_define
 
+    subroutine block_define(multi_block,nblocks,pblocks)
+
+      use pastr_commtype
+
+      logical,intent(out) :: multi_block
+      integer,intent(out) :: nblocks
+      type(tblock),intent(out),allocatable :: pblocks(:)
+
+      integer :: i
+      logical :: lfex
+
+      inquire(file='blockdef.txt',exist=lfex)
+      if(lfex) then
+        multi_block=.true.
+      else
+        multi_block=.false.
+        return
+      endif
+
+      open(12,file='blockdef.txt')
+      read(12,*)nblocks
+      allocate(pblocks(nblocks))
+      do i=1,nblocks
+        read(12,*)pblocks(i)%ilo,pblocks(i)%ihi,pblocks(i)%jlo,pblocks(i)%jhi
+        pblocks(i)%im=pblocks(i)%ihi-pblocks(i)%ilo
+        pblocks(i)%jm=pblocks(i)%jhi-pblocks(i)%jlo
+      enddo
+      close(12)
+      print*,' >> blockdef.txt'
+
+      print*,' ** nblocks: ',nblocks
+
+      return
+
+    end subroutine block_define
+
 end module pastr_field_view

pastr/src/pastr_multiblock_type.F90

@@ -6,6 +6,22 @@ module pastr_multiblock_type
 
     implicit none
 
+    type :: stencil_type
+      real(wp),pointer :: a(:)
+    end type stencil_type
+    
+    type :: fdm_type
+      integer :: first_node,last_node,dim
+      type(stencil_type),allocatable :: s(:)
+
+      contains
+
+      procedure :: init =>fdm_solver_init
+      procedure :: cal=>fdm_solver_operator
+      procedure :: info=>fdm_solver_print
+
+    end type fdm_type
+
   type :: link_type
 
       logical :: active=.false.
@@ -83,21 +99,7 @@ module pastr_multiblock_type
 
     end type block_type
 
-    type :: stencil_type
-      real(wp),pointer :: a(:)
-    end type stencil_type
-
-    type :: fdm_type
-      integer :: first_node,last_node,dim
-      type(stencil_type),allocatable :: s(:)
 
-      contains
-
-      procedure :: init =>fdm_solver_init
-      procedure :: cal=>fdm_solver_operator
-      procedure :: info=>fdm_solver_print
-
-    end type fdm_type
 contains
 subroutine alloc_block(ablock)
 

pastr/src/pastr_xdmf.F90

@@ -7,6 +7,7 @@ module pastr_xdmf
   Interface xdmfwriter
     module procedure xdmfwriter_2d
     module procedure xdmfwriter_2drec
+    module procedure xdmfwriter_2drec_block
     module procedure xdmfwriter_2drec_list_xy
     module procedure xdmfwriter_3d
     module procedure xdmfwriter_3drec
@@ -1012,4 +1013,100 @@ subroutine xdmfwriter_2drec_list_xy(dir,filename,x,y,var,varname)
     !
   end subroutine xdmfwriter_2drec_list_xy
 
+  subroutine xdmfwriter_2drec_block(dir,filename,blocks)
+    
+    use pastr_utility, only : make_dir
+    use pastr_commtype,only : tblock
+
+    ! arguments
+    character(len=*),intent(in) :: dir,filename
+    type(tblock),intent(in),dimension(:) :: blocks
+
+    real(4),allocatable :: bufr4(:,:)
+    character(len=3) :: bname
+    character(len=64) :: gridnamex,gridnamey,filavarname
+    !
+    ! local data
+    integer :: fh,i,m,nvar
+    integer :: im,jm
+    logical :: lfex
+    
+    call make_dir(dir)
+
+    fh=18
+    open(fh,file=dir//filename//'.xdmf',form='formatted')
+    write(fh,'(A)')'<?xml version="1.0" ?>'
+    write(fh,'(A)')'<!DOCTYPE Xdmf SYSTEM "Xdmf.dtd" []>'
+    write(fh,'(A)')'<Xdmf xmlns:xi="http://www.w3.org/2001/XInclude" Version="2.0">'
+    write(fh,'(A)')'  <Domain>'
+
+    do i=1,size(blocks)
+
+      im=blocks(i)%im
+      jm=blocks(i)%jm
+      
+      write(bname,'(i3.3)') i
+      gridnamex='block'//bname//'-grid-x.bin'
+      gridnamey='block'//bname//'-grid-y.bin'
+
+      inquire(file=dir//trim(gridnamex),exist=lfex)
+      if(.not. lfex) then
+        open(17,file=dir//trim(gridnamex),access="stream")
+        write(17)sngl(blocks(i)%x(0:im,0))
+        close(17)
+        print*,' << ',dir//trim(gridnamex)
+      endif
+      inquire(file=dir//trim(gridnamey),exist=lfex)
+      if(.not. lfex) then
+        open(17,file=dir//trim(gridnamey),access="stream")
+        write(17)sngl(blocks(i)%y(0,0:jm))
+        close(17)
+        print*,' << ',dir//trim(gridnamey)
+      endif
+
+      write(fh,'(3(A))')'    <Grid Name=" block-',bname,'" GridType="Uniform">'
+
+      write(fh,'(A,2(1X,I0),A)')'    <Topology name="topo" TopologyType="3DRectMesh" Dimensions=" 1',  &
+                                jm+1,im+1,'"> </Topology>'
+      write(fh,'(A)')'    <Geometry name="geo" Type="VXVYVZ">'
+      write(fh,'(A)')'      <DataItem Format="Binary" DataType="Float" Precision="4" Endian="little" Seek="0" '
+      write(fh,'(A,1X,I0,3(A))') '                Dimensions=" ',im+1,'"> ',gridnamex,'  </DataItem>'
+      write(fh,'(A)')'      <DataItem Format="Binary" DataType="Float" Precision="4" Endian="little" Seek="0" '
+      write(fh,'(A,1X,I0,3(A))') '                Dimensions=" ',jm+1,'"> ',gridnamey,' </DataItem>'
+      write(fh,'(A)')'      <DataItem Dimensions=" 1 " Numbewp="Float" Precision="4" Format="XML" > 0.0 </DataItem>'
+      write(fh,'(A)')'    </Geometry>'
+      write(fh,*)    
+
+      allocate(bufr4(0:im,0:jm))
+
+      do m=1,blocks(i)%nvar
+
+        filavarname=filename//'-'//'block'//bname//'-'//trim(blocks(i)%varname(m))
+
+        write(fh,'(3(A))')'      <Attribute Name="',trim(blocks(i)%varname(m)),'" Center="Node">'
+        write(fh,'(A)')'        <DataItem Format="Binary" DataType="Float" Precision="4" Endian="little" Seek="0"'
+        write(fh,'(A,2(1X,I0),3(A))')'                   Dimensions=" 1 ',jm+1,im+1,'"> ',trim(filavarname),'</DataItem>'
+
+        write(fh,'(A)')'      </Attribute>'
+        
+        bufr4=sngl(blocks(i)%var(0:im,0:jm,m))
+        open(fh+1,file=dir//trim(filavarname),access="stream")
+        write(fh+1)bufr4
+        close(fh+1)
+        print*,' << ',dir//filename//'-'//trim(blocks(i)%varname(m))
+
+        deallocate(bufr4)
+      enddo
+
+      write(fh,'(A)')'     </Grid>'
+    enddo
+    !
+    write(fh,'(A)')'  </Domain>'
+    write(fh,'(A)')'</Xdmf>'
+    !
+    close(fh)
+    print*,' <<',dir//filename//'.xdmf done.'
+
+  end subroutine xdmfwriter_2drec_block
+
 end module pastr_xdmf