read_snapshot_old Subroutine

public subroutine read_snapshot_old()

Uses

  • proc~~read_snapshot_old~~UsesGraph proc~read_snapshot_old read_snapshot_old mod_amr_solution_node mod_amr_solution_node proc~read_snapshot_old->mod_amr_solution_node module~mod_forest mod_forest proc~read_snapshot_old->module~mod_forest module~mod_functions_forest mod_functions_forest proc~read_snapshot_old->module~mod_functions_forest module~mod_global_parameters mod_global_parameters proc~read_snapshot_old->module~mod_global_parameters module~mod_mpi_wrapper mod_mpi_wrapper module~mod_functions_forest->module~mod_mpi_wrapper module~mod_basic_types mod_basic_types module~mod_global_parameters->module~mod_basic_types module~mod_connectivity mod_connectivity module~mod_global_parameters->module~mod_connectivity module~mod_constants mod_constants module~mod_global_parameters->module~mod_constants module~mod_physicaldata mod_physicaldata module~mod_global_parameters->module~mod_physicaldata module~mod_variables mod_variables module~mod_global_parameters->module~mod_variables mpi mpi module~mod_global_parameters->mpi module~mod_mpi_wrapper->mpi module~mod_variables->module~mod_basic_types

Arguments

None

Calls

proc~~read_snapshot_old~~CallsGraph proc~read_snapshot_old read_snapshot_old alloc_node alloc_node proc~read_snapshot_old->alloc_node mpi_barrier mpi_barrier proc~read_snapshot_old->mpi_barrier mpi_bcast mpi_bcast proc~read_snapshot_old->mpi_bcast mpi_file_close mpi_file_close proc~read_snapshot_old->mpi_file_close mpi_file_open mpi_file_open proc~read_snapshot_old->mpi_file_open mpi_file_seek mpi_file_seek proc~read_snapshot_old->mpi_file_seek proc~mpi_file_read_at_wrapper mpi_file_read_at_wrapper proc~read_snapshot_old->proc~mpi_file_read_at_wrapper proc~mpi_file_read_wrapper mpi_file_read_wrapper proc~read_snapshot_old->proc~mpi_file_read_wrapper proc~mpi_recv_wrapper mpi_recv_wrapper proc~read_snapshot_old->proc~mpi_recv_wrapper proc~mpi_send_wrapper mpi_send_wrapper proc~read_snapshot_old->proc~mpi_send_wrapper proc~mpistop mpistop proc~read_snapshot_old->proc~mpistop proc~read_forest read_forest proc~read_snapshot_old->proc~read_forest mpi_file_read mpi_file_read proc~mpi_file_read_at_wrapper->mpi_file_read proc~mpi_file_read_wrapper->mpi_file_read mpi_recv mpi_recv proc~mpi_recv_wrapper->mpi_recv mpi_send mpi_send proc~mpi_send_wrapper->mpi_send mpi_abort mpi_abort proc~mpistop->mpi_abort proc~read_forest->mpi_bcast proc~read_forest->mpi_file_seek proc~read_forest->proc~mpi_file_read_wrapper getnode getnode proc~read_forest->getnode mpi_get_count mpi_get_count proc~read_forest->mpi_get_count proc~add_to_linked_list add_to_linked_list proc~read_forest->proc~add_to_linked_list proc~amr_morton_order amr_Morton_order proc~read_forest->proc~amr_morton_order proc~asign_tree_neighbor asign_tree_neighbor proc~read_forest->proc~asign_tree_neighbor proc~build_connectivity build_connectivity proc~read_forest->proc~build_connectivity proc~get_level_range get_level_range proc~read_forest->proc~get_level_range proc~get_morton_range get_Morton_range proc~read_forest->proc~get_morton_range proc~getigrids getigrids proc~read_forest->proc~getigrids proc~level1_morton_order level1_Morton_order proc~read_forest->proc~level1_morton_order proc~amr_morton_order->proc~mpistop proc~find_neighbor find_neighbor proc~asign_tree_neighbor->proc~find_neighbor proc~add_to_c nbprocs_info_t%add_to_c proc~build_connectivity->proc~add_to_c proc~add_to_f nbprocs_info_t%add_to_f proc~build_connectivity->proc~add_to_f proc~add_to_srl nbprocs_info_t%add_to_srl proc~build_connectivity->proc~add_to_srl proc~alloc_buffers_c nbprocs_info_t%alloc_buffers_c proc~build_connectivity->proc~alloc_buffers_c proc~alloc_buffers_f nbprocs_info_t%alloc_buffers_f proc~build_connectivity->proc~alloc_buffers_f proc~alloc_buffers_srl nbprocs_info_t%alloc_buffers_srl proc~build_connectivity->proc~alloc_buffers_srl proc~build_connectivity->proc~find_neighbor proc~identifyphysbound_connectivity identifyphysbound_connectivity proc~build_connectivity->proc~identifyphysbound_connectivity proc~reset nbprocs_info_t%reset proc~build_connectivity->proc~reset proc~mortonencode mortonEncode proc~level1_morton_order->proc~mortonencode proc~add_igrid_to_c nbprocs_info_t%add_igrid_to_c proc~add_to_c->proc~add_igrid_to_c proc~add_igrid_to_f nbprocs_info_t%add_igrid_to_f proc~add_to_f->proc~add_igrid_to_f proc~add_igrid_to_srl nbprocs_info_t%add_igrid_to_srl proc~add_to_srl->proc~add_igrid_to_srl proc~idecode nbprocs_info_t%idecode proc~alloc_buffers_srl->proc~idecode proc~find_root_neighbor find_root_neighbor proc~find_neighbor->proc~find_root_neighbor proc~init_cf_info nbinfo_cf_t%init_cf_info proc~add_igrid_to_c->proc~init_cf_info proc~add_igrid_to_f->proc~init_cf_info proc~iencode nbprocs_info_t%iencode proc~add_igrid_to_srl->proc~iencode proc~init_srl_info init_srl_info proc~add_igrid_to_srl->proc~init_srl_info

Called by

proc~~read_snapshot_old~~CalledByGraph proc~read_snapshot_old read_snapshot_old proc~read_snapshot read_snapshot proc~read_snapshot->proc~read_snapshot_old proc~main main proc~main->proc~read_snapshot program~agile agile program~agile->proc~main

Source Code

  subroutine read_snapshot_old()
    use mod_forest
    use mod_global_parameters
    use mod_amr_solution_node, only: alloc_node
    use mod_functions_forest, only: read_forest

    double precision              :: wio(ixGlo1:ixGhi1,ixGlo2:ixGhi2,&
       ixGlo3:ixGhi3,1:nw)
    integer                       :: fh, igrid, Morton_no, iread
    integer                       :: levmaxini, ndimini, ndirini
    integer                       :: nwini, neqparini, nxini1,nxini2,nxini3
    integer(kind=MPI_OFFSET_KIND) :: offset
    integer                       :: istatus(MPI_STATUS_SIZE)
    integer, allocatable          :: iorecvstatus(:,:)
    integer                       :: ipe,inrecv,nrecv
    integer                       :: sendini(7+3)
    character(len=80)             :: filename
    logical                       :: fexist
    double precision              :: eqpar_dummy(100)

    if (mype==0) then
      call MPI_FILE_OPEN(MPI_COMM_SELF,trim(restart_from_file),&
          MPI_MODE_RDONLY,MPI_INFO_NULL,fh,ierrmpi)

      offset=-int(7*size_int+size_double,kind=MPI_OFFSET_KIND)
      call MPI_FILE_SEEK(fh,offset,MPI_SEEK_END,ierrmpi)

      call mpi_file_read_wrapper(fh,nleafs,1,MPI_INTEGER,istatus,ierrmpi)
      nleafs_active = nleafs
      call mpi_file_read_wrapper(fh,levmaxini,1,MPI_INTEGER,istatus,ierrmpi)
      call mpi_file_read_wrapper(fh,ndimini,1,MPI_INTEGER,istatus,ierrmpi)
      call mpi_file_read_wrapper(fh,ndirini,1,MPI_INTEGER,istatus,ierrmpi)
      call mpi_file_read_wrapper(fh,nwini,1,MPI_INTEGER,istatus,ierrmpi)
      call mpi_file_read_wrapper(fh,neqparini,1,MPI_INTEGER,istatus,ierrmpi)
      call mpi_file_read_wrapper(fh,it,1,MPI_INTEGER,istatus,ierrmpi)
      call mpi_file_read_wrapper(fh,global_time,1,MPI_DOUBLE_PRECISION,istatus,&
         ierrmpi)

      ! check if settings are suitable for restart
      if (levmaxini>refine_max_level) then
        write(*,*) "number of levels in restart file = ",levmaxini
        write(*,*) "refine_max_level = ",refine_max_level
        call mpistop("refine_max_level < number of levels in restart file")
      end if
      if (ndimini/=ndim) then
        write(*,*) "ndim in restart file = ",ndimini
        write(*,*) "ndim = ",ndim
        call mpistop("reset ndim to ndim in restart file")
      end if
      if (ndirini/=ndir) then
        write(*,*) "ndir in restart file = ",ndirini
        write(*,*) "ndir = ",ndir
        call mpistop("reset ndir to ndir in restart file")
      end if
      if (nw/=nwini) then
        write(*,*) "nw=",nw," and nw in restart file=",nwini
        call mpistop("currently, changing nw at restart is not allowed")
      end if

      offset=offset-int(ndimini*size_int+neqparini*size_double,&
         kind=MPI_OFFSET_KIND)
      call MPI_FILE_SEEK(fh,offset,MPI_SEEK_END,ierrmpi)

      call mpi_file_read_wrapper(fh,nxini1,1,MPI_INTEGER,istatus,ierrmpi)
      call mpi_file_read_wrapper(fh,nxini2,1,MPI_INTEGER,istatus,ierrmpi)
      call mpi_file_read_wrapper(fh,nxini3,1,MPI_INTEGER,istatus,ierrmpi)
      if (ixGhi1/=nxini1+2*nghostcells.or.ixGhi2/=&
         nxini2+2*nghostcells.or.ixGhi3/=nxini3+2*nghostcells) then
        write(*,*) "Error: reset resolution to ",nxini1+2*nghostcells,&
           nxini2+2*nghostcells,nxini3+2*nghostcells
        call mpistop("change with setamrvac")
      end if

      call mpi_file_read_wrapper(fh,eqpar_dummy,neqparini, MPI_DOUBLE_PRECISION,&
         istatus,ierrmpi)
    end if

    ! broadcast the global parameters first
    if (npe>1) then
      if (mype==0) then
        sendini=(/nleafs,levmaxini,ndimini,ndirini,nwini,neqparini,it ,nxini1,&
           nxini2,nxini3 /)
      end if
      call MPI_BCAST(sendini,7+3,MPI_INTEGER,0,icomm,ierrmpi)
      nleafs=sendini(1);levmaxini=sendini(2);ndimini=sendini(3);
      ndirini=sendini(4);nwini=sendini(5);
      neqparini=sendini(6);it=sendini(7);
      nxini1=sendini(7+1);nxini2=sendini(7+2);nxini3=sendini(7+3);
      nleafs_active = nleafs
      call MPI_BCAST(global_time,1,MPI_DOUBLE_PRECISION,0,icomm,ierrmpi)
    end if

    if (mype == 0) then
      offset = int(size_block_io,kind=MPI_OFFSET_KIND) * int(nleafs,&
         kind=MPI_OFFSET_KIND)
      call MPI_FILE_SEEK(fh,offset,MPI_SEEK_SET,ierrmpi)
    end if

    call read_forest(fh)

    do Morton_no=Morton_start(mype),Morton_stop(mype)
      igrid=sfc_to_igrid(Morton_no)
      call alloc_node(igrid)
    end do

    if (mype==0)then
      iread=0

      do Morton_no=Morton_start(0),Morton_stop(0)
        igrid=sfc_to_igrid(Morton_no)
        iread=iread+1
        offset=int(size_block_io,kind=MPI_OFFSET_KIND) *int(Morton_no-1,&
           kind=MPI_OFFSET_KIND)
        call mpi_file_read_at_wrapper(fh,offset,ps(igrid)%w,1,type_block_io, istatus,&
           ierrmpi)
      end do
      if (npe>1) then
        do ipe=1,npe-1
          do Morton_no=Morton_start(ipe),Morton_stop(ipe)
            iread=iread+1
            itag=Morton_no
            offset=int(size_block_io,kind=MPI_OFFSET_KIND)*int(Morton_no-1,&
               kind=MPI_OFFSET_KIND)
            call mpi_file_read_at_wrapper(fh,offset,wio,1,type_block_io,istatus,&
               ierrmpi)
            call mpi_send_wrapper(wio,1,type_block_io,ipe,itag,icomm,ierrmpi)
          end do
        end do
      end if
      call MPI_FILE_CLOSE(fh,ierrmpi)
    else
      nrecv=(Morton_stop(mype)-Morton_start(mype)+1)
      allocate(iorecvstatus(MPI_STATUS_SIZE,nrecv))
      inrecv=0
      do Morton_no=Morton_start(mype),Morton_stop(mype)
        igrid=sfc_to_igrid(Morton_no)
        itag=Morton_no
        inrecv=inrecv+1
        call mpi_recv_wrapper(ps(igrid)%w,1,type_block_io,0,itag,icomm,iorecvstatus(:,&
           inrecv),ierrmpi)
      end do
      deallocate(iorecvstatus)
    end if

    call MPI_BARRIER(icomm,ierrmpi)

  end subroutine read_snapshot_old