mpi_amr_checkpoint_mpiio.f90

做网格的好程序

         
      user_attr_4_value = 0.
      if (present(user_attr_4)) then
         user_attr_4_value = user_attr_4
      end if
         
      user_attr_5_value = 0.
      if (present(user_attr_5)) then
         user_attr_5_value = user_attr_5
      end if

      do i = 1,4
         iorder(i) = size(ordering,dim=i)
      end do

#ifdef REAL8

      call write_blocks_mpiio_r8(filename, & 
     &                          tot_blocks, & 
     &                          tot_blocks_wr, & 
     &                          max_lnblocks, & 
     &                          lnblocks_wr, & 
     &                          n_to_left(mype), & 
     &                          mdim, & 
     &                          ndim, & 
     &                          ngid, & 
     &                          mflags, & 
     &                          lrefine, & 
     &                          nodetype, & 
     &                          which_child, & 
     &                          gid, & 
     &                          bflags, & 
     &                          coord, & 
     &                          bnd_box, & 
     &                          work_block, & 
     &                          unk, & 
     &                          nvar, & 
     &                          nvar_chk_cc, & 
     &                          icheckp_on_cc, & 
     &                          facevarx, facevary, facevarz, & 
     &                          nbndvar, & 
     &                          nvar_chk_fc, & 
     &                          icheckp_on_fc, & 
     &                          unk_e_x, unk_e_y, unk_e_z, & 
     &                          nbndvare, & 
     &                          nvar_chk_ec, & 
     &                          icheckp_on_ec, & 
     &                          unk_n, & 
     &                          nbndvarc, & 
     &                          nvar_chk_nc, & 
     &                          icheckp_on_nc, & 
     &                          iu_bnd, ju_bnd, ku_bnd, & 
     &                          il0, iu0, & 
     &                          jl0, ju0, & 
     &                          kl0, ku0, & 
     &                          user_attr_1_value, & 
     &                          user_attr_2_value, & 
     &                          user_attr_3_value, & 
     &                          user_attr_4_value, & 
     &                          user_attr_5_value, &
     &                          iorder)

#else

      call write_blocks_mpiio_r4(filename, & 
     &                          tot_blocks, & 
     &                          tot_blocks_wr, & 
     &                          max_lnblocks, & 
     &                          lnblocks_wr, & 
     &                          n_to_left(mype), & 
     &                          mdim, & 
     &                          ndim, & 
     &                          ngid, & 
     &                          mflags, & 
     &                          lrefine, & 
     &                          nodetype, & 
     &                          which_child, & 
     &                          gid, & 
     &                          bflags, & 
     &                          coord, & 
     &                          bnd_box, & 
     &                          work_block, & 
     &                          unk, & 
     &                          nvar, & 
     &                          nvar_chk_cc, & 
     &                          icheckp_on_cc, & 
     &                          facevarx, facevary, facevarz, & 
     &                          nbndvar, & 
     &                          nvar_chk_fc, & 
     &                          icheckp_on_fc, & 
     &                          unk_e_x, unk_e_y, unk_e_z, & 
     &                          nbndvare, & 
     &                          nvar_chk_ec, & 
     &                          icheckp_on_ec, & 
     &                          unk_n, & 
     &                          nbndvarc, & 
     &                          nvar_chk_nc, & 
     &                          icheckp_on_nc, & 
     &                          iu_bnd, ju_bnd, ku_bnd, & 
     &                          il0, iu0, & 
     &                          jl0, ju0, & 
     &                          kl0, ku0, & 
     &                          user_attr_1_value, & 
     &                          user_attr_2_value, & 
     &                          user_attr_3_value, & 
     &                          user_attr_4_value, & 
     &                          user_attr_5_value, &
     &                          iorder)

#endif
      
      deallocate(icheckp_on_cc)
      deallocate(icheckp_on_fc)
      deallocate(icheckp_on_ec)
      deallocate(icheckp_on_nc)

      return
      end subroutine amr_checkpoint_wr_mpiio

!----------------------------------------------------------------------

!!****f* utilities/io/checkpoint/mpiio/amr_checkpoint_re_mpiio
!! NAME
!!
!!   amr_checkpoint_re_mpiio
!!
!! SYNOPSIS
!!
!!   call amr_checkpoint_re_mpiio(file_num)
!!   call amr_checkpoint_re_mpiio(file_num, l_with_guardcells,  
!!                               user_attr1, user_attr2, user_attr3, 
!!                               user_attr4, user_attr5)
!!
!!   call amr_checkpoint_re_mpiio(integer, optional logical, optional char*80,
!!                               optional real, optional real, optional real, 
!!                               optional real, optional real)
!!
!! ARGUMENTS
!!
!!   integer, intent(in) :: file_num
!!     An integer number which will be appended to the end of the file name.
!!
!!   optional, logical, intent(in) :: l_with_guardcells
!!     If true, then guardcells are included in the checkpoint file.  Otherwise 
!!     (the default) they are not included.
!!   
!!   optional, real, intent(in) :: user_attr1(2,3,4,5)
!!     Arguments which allow the user to add some extra information to the file.  
!!     Currently only 5 real numbers can be added.
!!
!! INCLUDES
!!
!!   paramesh_preprocessor.fh
!!   mpif.h
!!
!! USES
!!
!!   paramesh_dimensions
!!   physicaldata
!!   tree
!!   timings
!!   io
!!   mpi_morton
!!
!! CALLS
!!
!!   read_blocks_mpiio_r8 or read_blocks_mpiio_r4
!!
!! RETURNS
!!
!!   Does not return anything.  Upon exit a checkpoint file has been read in.
!!
!! DESCRIPTION
!! 
!!  Subroutine to read PARAMESH checkpoint files in parallel which have been 
!!  produced using the routine amr_checkpoint_wr_mpiio.  It reads in the tree data 
!!  structure and data stored in PARAMESH blocks.
!!
!!  The files read in must have names of the form 
!!  'paramesh_chk_######.mpiio'. where '######' is the file_num argument passed into
!!  this routine.
!!
!!  The routine gets called directly by the driver routine 'amr_checkpoint_re' if
!!  the user selects MPIIO format as the data formet for the file.
!!
!!  The routine is not, by default, included in the PARAMESH default setup.  In order to
!!  use it an install script in utilities/io/checkpoint/mpiio must first be run and
!!  PARAMESH must be recompiled.
!!
!! AUTHORS
!!
!!   Kevin Olson (2004)
!!
!!***

      subroutine amr_checkpoint_re_mpiio (file_num, & 
     &                                   l_with_guardcells, & 
     &                                   user_attr_1, & 
     &                                   user_attr_2, & 
     &                                   user_attr_3, & 
     &                                   user_attr_4, & 
     &                                   user_attr_5)

      use paramesh_dimensions
      use physicaldata
      use tree
      use timings
      use io
#ifdef SAVE_MORTS
      use mpi_morton
#endif /*  SAVE_MORTS */

      use paramesh_interfaces, only : amr_morton_order, & 
     &                                amr_guardcell
      use paramesh_mpi_interfaces, only : mpi_amr_global_domain_limits, & 
     &                                    mpi_amr_boundary_block_info

!---------------------------------------------------------------------------

      implicit none

      include 'mpif.h'

      integer, intent(in) :: file_num
      logical, optional, intent(in)  :: l_with_guardcells
      real, optional, intent(out) :: user_attr_1, & 
     &                               user_attr_2, & 
     &                               user_attr_3, & 
     &                               user_attr_4, & 
     &                               user_attr_5

      integer,dimension (:), allocatable :: n_to_left
      integer :: gid(nfaces+1+nchild,maxblocks_tr)
      integer :: proc, icount
      integer :: nvar_chk_cc,nvar_chk_fc,nvar_chk_ec,nvar_chk_nc
      integer :: tot_blocks
      integer :: mype, nprocs
      integer :: il0, iu0, jl0, ju0, kl0, ku0
      integer :: ierr, nguard0, i, j, block_no, lb
      integer :: ngid, lnblocks_old
      integer, allocatable :: icheckp_on_cc(:)
      integer, allocatable :: icheckp_on_fc(:,:)
      integer, allocatable :: icheckp_on_ec(:,:)
      integer, allocatable :: icheckp_on_nc(:)
      logical :: l_with_guardcells2, l_move_solution
      double precision :: time1
      real :: user_attr_1_value, & 
     &        user_attr_2_value, & 
     &        user_attr_3_value, & 
     &        user_attr_4_value, & 
     &        user_attr_5_value
#ifdef SAVE_MORTS
      integer :: lb
      integer :: mort_neigh(6,3,3,3)
      real    :: xmin,ymin,zmin,xmax,ymax,zmax
#endif /* SAVE_MORTS */

      character (len=80) :: filename
      character (len=6)  :: fnum_string

      integer :: iorder(4)
      integer :: ordering(1,2,3,4)

!---------------------------------------------------------------------------

      allocate(icheckp_on_cc(nvar))
      allocate(icheckp_on_fc(3,nfacevar))
      allocate(icheckp_on_ec(3,nvaredge))
      allocate(icheckp_on_nc(nvarcorn))

      call MPI_COMM_RANK(MPI_COMM_WORLD,mype,ierr)
      call MPI_COMM_SIZE(MPI_COMM_WORLD,nprocs,ierr)

      if (present(l_with_guardcells)) then
         l_with_guardcells2 = l_with_guardcells
      else
         l_with_guardcells2 = .false.
      end if

      nguard0 = nguard*npgs

      write (fnum_string, '(i6.6)') file_num
      filename = trim(output_dir) //  & 
     &           'paramesh_chk_' //  & 
     &           fnum_string //  & 
     &           '.mpiio'

! set limits on data arrays
      il0 = nguard0
      iu0 = nxb+nguard0
      jl0 = nguard0*k2d
      ju0 = nyb+nguard0*k2d
      kl0 = nguard0*k3d
      ku0 = nzb+nguard0*k3d
      if (.not.no_permanent_guardcells) then
         if(l_with_guardcells2) then
            il0 = 0
            iu0 = nxb+2*nguard0
            jl0 = k2d-k2d
            ju0 = nyb+(2*nguard0*k2d)
            kl0 = k3d-k3d
            ku0 = nzb+(2*nguard0*k3d)
         endif
      end if                    ! no_permanent_guardcells

      nvar_chk_cc =  0
      do i=1,nvar
        icheckp_on_cc(i) = 0
        if(checkp_on_cc(i)) then
           nvar_chk_cc = nvar_chk_cc + 1
           icheckp_on_cc(i) = 1
        end if
      enddo
      nvar_chk_fc =  0
      do i=1,nfacevar
         icheckp_on_fc(:,i) = 0
         if(checkp_on_fc(1,i)) then
           nvar_chk_fc = nvar_chk_fc + 1
           icheckp_on_fc(:,i) = 1
        end if
      enddo
      nvar_chk_ec =  0
      do i=1,nvaredge