restrt_hdf.f

Go to the documentation of this file.

c
c ---------------------------------------------------------
c
      subroutine restrt(nsteps,time,nvar)
c
      use amr_module
      implicit double precision (a-h,o-z)

      logical   ee


      dimension intrtx(maxlv),intrty(maxlv),intrtt(maxlv)
      character*16  chkname
c
c     # HDF: Declare variables that describe datasets and HDF files.
c
      integer    sd_id
c
c     # HDF: Arrays which will hold output arrays.
c
      dimension  iqout(15), qout(4)
c
c     # HDF: Declare external HDF functions
c
      integer  sfstart, sfend
      external sfstart, sfend
c
c     # HDF: Set up HDF constants
c
      integer   DFACC_READ, DFACC_WRITE, DFACC_CREATE 
      parameter(dfacc_read = 1, dfacc_write = 2, dfacc_create = 4)

      integer   SUCCEED, FAIL
      parameter(succeed = 0, fail = -1)
c
c :::::::::::::::::::::::::::: RESTRT ::::::::::::::::::::::::::::::::
c read back in the check point files written by subr. check.
c
c some input variables might have changed, and also the
c alloc array could have been written with a smaller size at checkpoint
c ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
c
c     ###  make the file name showing the time step
c
      chkname = 'restart.data.hdf'
c     
c     # HDF: open hdf restart file.
c     
      sd_id = sfstart(chkname,dfacc_read)
      if (sd_id.eq.fail) THEN
         WRITE(*,*) 'Failed to open HDF file',
     &        ' (call to sfstart in restrt_hdf.f)'
         stop
      end if

      index = 0
      call read_integer_vector(sd_id,15,index,'iqout ',iqout)
      lenmax  = iqout(1)
      lendim  = iqout(2)
      isize   = iqout(3)
      lenf    = iqout(4)
      ibuf    = iqout(5)
      mstart  = iqout(6)
      ndfree  = iqout(7)
      lfine   = iqout(8)
      iorder  = iqout(9)
      mxnold  = iqout(10)
      kcheck1 = iqout(11)
      nsteps  = iqout(12)
      matlabu = iqout(13)
      lentot  = iqout(14)
      ndfree_bnd  = iqout(15)

      index = index + 1
      call read_integer_vector(sd_id,maxlv,index,'icheck',icheck)
      index = index + 1
      call read_integer_vector(sd_id,maxlv,index,'lstart',lstart)
      index = index + 1
      call read_integer_vector(sd_id,maxlv,index,'newstl',newstl)
      index = index + 1
      call read_integer_vector(sd_id,maxlv,index,'listsp',listsp)
      index = index + 1
      call read_integer_vector(sd_id,maxlv,index,'intratx',intrtx)
      index = index + 1
      call read_integer_vector(sd_id,maxlv,index,'intraty',intrty)
      index = index + 1
      call read_integer_vector(sd_id,maxlv,index,'kratio',intrtt)
      index = index + 1
      call read_integer_vector(sd_id,maxlv,index,'iregsz',iregsz)
      index = index + 1
      call read_integer_vector(sd_id,maxlv,index,'jregsz',jregsz)
      index = index + 1
      call read_integer_array(sd_id,lfdim,2,index,'lfree ',lfree)
      index = index + 1
      call read_integer_array(sd_id,rsize,maxgr,index,'node  ',node)

c     # HDF: DFNT_FLOAT64

      index = index + 1
      call read_double_vector(sd_id,4,index,'qout  ',qout)
      tl  = qout(1)
      time = qout(2)
      evol = qout(3)
      rvol = qout(4)

      index = index + 1
      call read_double_vector(sd_id,maxlv,index,'hxposs',hxposs)
      index = index + 1
      call read_double_vector(sd_id,maxlv,index,'hyposs',hyposs)
      index = index + 1
      call read_double_vector(sd_id,maxlv,index,'possk ',possk)
      index = index + 1
      call read_double_vector(sd_id,10,index,'rvoll ',rvoll)
      index = index + 1
      call read_double_vector(sd_id,lendim,index,'alloc ',alloc)
      
      index = index + 1
      call read_double_array(sd_id,rsize,maxgr,index,'rnode ',rnode)
c
c     # HDF: Close HDF file.
c
      istat = sfend(sd_id)
      if (istat.eq.fail) then
         WRITE(*,*) 'Failed to close SDS',
     &        ' (call to sfend in restrt_hdf.f)'
         stop
      end if

      write(outunit,100) nsteps,time
      write(6,100) nsteps,time
  100 format(/,' RESTARTING the calculation after ',i5,' steps',
     1      /,'  (time = ',e15.7,')')

      do i = 1, mxnold-1
        if ( (intratx(i) .ne. intrtx(i)) .or.
     .       (intraty(i) .ne. intrty(i)) .or.
     .       (kratio(i) .ne.  intrtt(i)) ) then
        write(outunit,*) 
     .  " not allowed to change existing refinement ratios on Restart"
        write(*,*)
     .  " not allowed to change existing refinement ratios on Restart"
        write(outunit,*)" Old ratios:"
        write(*,*)      " Old ratios:"
        write(outunit,903)(intrtx(j),j=1,mxnold-1)
        write(*,903)      (intrtx(j),j=1,mxnold-1)
        write(outunit,903)(intrty(j),j=1,mxnold-1)
        write(*,903)      (intrty(j),j=1,mxnold-1)
        write(outunit,903)(intrtt(j),j=1,mxnold-1)
        write(*,903)      (intrtt(j),j=1,mxnold-1)
 903    format(6i3)
        stop
       endif
      end do
c
c     adjust free list of storage in case size has changed.
c
      idif = memsize - isize
      if (idif .gt. 0) then
         lfree(lenf,1) = isize + 2
         call reclam(isize+1,idif)
      else if (idif .lt. 0) then
         write(outunit,900) isize, memsize
         write(*,900)       isize, memsize
  900    format(' size of alloc not allowed to shrink with restart ',/,
     .         ' old size ',i7,' current size  ',i7)
         stop
      endif
c
c     adjust storage in case mxnest has changed - only allow it to increase,
c     and only at non-multiples of error estimation on old mxnest.
c
      if (mxnest .eq. mxnold) go to 99

      if (mxnest .lt. mxnold) then
         if (lfine .lt. mxnest) then
            go to 99
         else
            write(outunit,901) mxnold, mxnest
            write(*,      901) mxnold, mxnest
  901       format(' only allow mxnest to increase: ',/,
     &            '  old mxnest ',i4, ' new mxnest ',i4)
            stop
         endif
      endif

c     see if simple enough situation to allow changing mxnest
      ee = .false.
      do 10 level = 1, mxnold
         if (icheck(level) .ge. kcheck) then
            ee = .true.
            kmust = icheck(level)
         endif
   10 continue
      if (ee) then
         write(outunit,902) mxnold, mxnest, kmust
         write(*      ,902) mxnold, mxnest, kmust
  902    format(/,' only allow changes in mxnest (from ',
     &         i4,' to ',i4,')',/,
     &         ' when not time to error estimate: ',/,
     &         ' please run a few more steps before changing ',/,
     &         ' so that # of steps not greater then kcheck',/,
     &         ' or make kcheck > ',i4 )
         stop
      else
c        #  add second storage location to previous mxnest level
         mptr = lstart(mxnold)
   15    if (mptr .eq. 0) go to 25
         mitot = node(ndihi,mptr)-node(ndilo,mptr)+1+2*nghost
         mjtot = node(ndjhi,mptr)-node(ndjlo,mptr)+1+2*nghost
         node(store2,mptr) = igetsp(mitot*mjtot*nvar)
         mptr = node(levelptr,mptr)
         go to 15
   25    continue
      endif
c
c     # add new info. to spatial and counting arrays
   99 level = lfine + 1
   35 if (level .gt. mxnest) go to 45
      hxposs(level) = hxposs(level-1) / dble(intratx(level-1))
      hyposs(level) = hyposs(level-1) / dble(intraty(level-1))
      possk(level) = possk(level-1) / dble(kratio(level-1))
      iregsz(level) = iregsz(level-1) * dble(intratx(level-1))
      jregsz(level) = jregsz(level-1) * dble(intraty(level-1))
      level         = level + 1
      go to 35
   45 continue
c
c
      return
      end
c=================================================================
c     # HDF: NOTE THAT ALL INTEGER HDF CHECKPOINTING ROUTINES FOR
c     #      BOTH WRITING AND READING ARE INCLUDED HERE, ALTHOUGH
c     #      THE INTEGER WRITING ROUTINES ARE CALLED IN check_hdf.f.
c     #      THIS IS DONE TO PREVENT COMPILER ERRORS SINCE THE SAME
c     #      HDF ROUTINES ARE USED TO READ BOTH INTEGER AND DOUBLE
c     #      PRECISION ARRAYS.
c=================================================================
      subroutine read_integer_vector(sd_id,idims,index,qname,iout)
      implicit double precision (a-h,o-z)
      character*6  qname
c
c     # HDF: Declare variables that describe datasets and HDF files.
c
      integer    sd_id, sds_id
      dimension  iout(idims), istart(1), istride(1), iedges(1)
c
c     # HDF: Declare external HDF functions
c
      integer  sfcreate, sfrdata, sfselect, sfendacc
      external sfcreate, sfrdata, sfselect, sfendacc
c
c     # HDF: Set up HDF constants
c
      integer   SUCCEED, FAIL
      parameter(succeed = 0, fail = -1)
c
c     # HDF: Select dataset in HDF file.
c
      sds_id = sfselect(sd_id,index)
      if (sds_id.eq.fail) THEN
         WRITE(*,*) 'Failed to select data set for  variable ', qname,
     &        ' in restart HDF file'
         WRITE(*,*) '(call to sfselect in restrt_hdf.f)'
         stop
      end if
c
c     # HDF: Set up dimensions for integer vector.
c
      istart(1) = 0
      iedges(1) = idims
      istride(1) = 1
c
c     # HDF: read integer vector from hdf file.
c
      istat = sfrdata(sds_id,istart,istride,iedges,iout)  
      if (istat.eq.fail) THEN
         WRITE(*,*) 'Failed to read variable ', qname,
     &        ' from restart HDF file'
         WRITE(*,*) '(call to sfrdata in restrt_hdf.f)'
         stop
      end if
c
c     # HDF: End access to integer vector in HDF file.
c
      istat = sfendacc(sds_id)  
      if (istat.eq.fail) THEN
         WRITE(*,*) 'Failed to end access to variable ', qname,
     &        ' in restart HDF file'
         WRITE(*,*) '(call to sfendacc in restrt_hdf.f)'
         stop
      end if

      return
      end

c==========================================================
      subroutine read_integer_array(sd_id,idim1,idim2,index,qname,iout)
      implicit double precision (a-h,o-z)
      character*6  qname
c
c     # HDF: Declare variables that describe datasets and HDF files.
c
      integer    sd_id, sds_id
      dimension  istart(2), istride(2), iedges(2)
      dimension  iout(idim1,idim2)
c
c     # HDF: Declare external HDF functions
c
      integer  sfcreate, sfrdata, sfselect, sfendacc
      external sfcreate, sfrdata, sfselect, sfendacc
c
c     # HDF: Set up HDF constants
c
      integer   SUCCEED, FAIL
      parameter(succeed = 0, fail = -1)
c
c     # HDF: Select dataset in HDF file.
c
      sds_id = sfselect(sd_id,index)
      if (sds_id.eq.fail) THEN
         WRITE(*,*) 'Failed to select data set for  variable ', qname,
     &        ' in restart HDF file'
         WRITE(*,*) '(call to sfselect in restrt_hdf.f)'
         stop
      end if
c
c     # HDF: Set up dimensions for integer array.
c
      istart(1) = 0
      istart(2) = 0
      iedges(1) = idim1
      iedges(2) = idim2
      istride(1) = 1
      istride(2) = 1
c
c     # HDF: read integer array from hdf file.
c
      istat = sfrdata(sds_id,istart,istride,iedges,iout)  
      if (istat.eq.fail) THEN
         WRITE(*,*) 'Failed to read variable ', qname,
     &        ' from restart HDF file'
         WRITE(*,*) '(call to sfrdata in restrt_hdf.f)'
         stop
      end if
c
c     # HDF: End access to integer array in HDF file.
c
      istat = sfendacc(sds_id)  
      if (istat.eq.fail) THEN
         WRITE(*,*) 'Failed to end access to variable ', qname,
     &        ' in restart HDF file'
         WRITE(*,*) '(call to sfendacc in restrt_hdf.f)'
         stop
      end if

      return
      end

c==========================================================
      subroutine dump_integer_vector(sd_id,idims,qname,iout)
      implicit double precision (a-h,o-z)
      character*6  qname
c
c     # HDF: Declare variables that describe datasets and HDF files.
c
      integer    sd_id, sds_id
      dimension  iout(idims), istart(1), istride(1), iedges(1), idim(1)
c
c     # HDF: Declare external HDF functions
c
      integer  sfcreate, sfwdata, sfscompress, sfendacc
      external sfcreate, sfwdata, sfscompress, sfendacc
c
c     # HDF: Set up HDF constants
c
      integer   DFNT_FLOAT64, DFNT_INT32
      parameter(dfnt_float64 = 6, dfnt_int32 = 24)

      integer   SUCCEED, FAIL
      parameter(succeed = 0, fail = -1)
c
c     # HDF: Set up compression constants for HDF file.
c
      integer   COMP_CODE_DEFLATE, DEFLATE_LEVEL
      parameter(comp_code_deflate = 4, deflate_level = 6)
c
c     # HDF: Create integer vector in HDF file.
c     #      NOTE THAT THE RANK MUST BE ONE.
c
      irank = 1 
      idim(1) = idims
      sds_id = sfcreate(sd_id,qname,dfnt_int32,irank,idim)
      if (sds_id.eq.fail) THEN
         WRITE(*,*) 'Failed to create variable ', qname,
     &        ' in restart HDF file'
         WRITE(*,*) '(call to sfcreate in check_hdf.f)'
         stop
      end if
c
c     # HDF: Set up dimensions for integer vector.
c
      istart(1) = 0
      iedges(1) = idims
      istride(1) = 1
c
c     # HDF: set compression mode and write data to hdf file.
c
      istat=sfscompress(sds_id,comp_code_deflate,deflate_level)
      istat = sfwdata(sds_id,istart,istride,iedges,iout)  
      if (istat.eq.fail) THEN
         WRITE(*,*) 'Failed to write variable ', qname,
     &        ' in restart HDF file'
         WRITE(*,*) '(call to sfwdata in check_hdf.f)'
         stop
      end if
c
c     # HDF: End access to integer vector in HDF file.
c
      istat = sfendacc(sds_id)  
      if (istat.eq.fail) THEN
         WRITE(*,*) 'Failed to end access to variable ', qname,
     &        ' in restart HDF file'
         WRITE(*,*) '(call to sfendacc in check_hdf.f)'
         stop
      end if

      return
      end

c==========================================================
      subroutine dump_integer_array(sd_id,idim1,idim2,qname,iout)
      implicit double precision (a-h,o-z)
      character*6  qname
c
c     # HDF: Declare variables that describe datasets and HDF files.
c
      integer    sd_id, sds_id
      dimension  idims(2), istart(2), istride(2), iedges(2)
      dimension  iout(idim1,idim2)
c
c     # HDF: Declare external HDF functions
c
      integer  sfcreate, sfwdata, sfscompress, sfendacc
      external sfcreate, sfwdata, sfscompress, sfendacc
c
c     # HDF: Set up HDF constants
c
      integer   DFNT_FLOAT64, DFNT_INT32
      parameter(dfnt_float64 = 6, dfnt_int32 = 24)

      integer   SUCCEED, FAIL
      parameter(succeed = 0, fail = -1)
c
c     # HDF: Set up compression constants for HDF file.
c
      integer   COMP_CODE_DEFLATE, DEFLATE_LEVEL
      parameter(comp_code_deflate = 4, deflate_level = 6)
c
c     # HDF: Create integer array in HDF file.
c     #      NOTE THAT THE RANK MUST BE TWO.
c
      irank = 2
      idims(1) = idim1
      idims(2) = idim2
      sds_id = sfcreate(sd_id,qname,dfnt_int32,irank,idims)
      if (sds_id.eq.fail) THEN
         WRITE(*,*) 'Failed to create variable ', qname,
     &        ' in restart HDF file'
         WRITE(*,*) '(call to sfcreate in check_hdf.f)'
         stop
      end if
c
c     # HDF: Set up dimensions for integer array.
c
      istart(1) = 0
      istart(2) = 0
      iedges(1) = idims(1)
      iedges(2) = idims(2)
      istride(1) = 1
      istride(2) = 1
c
c     # HDF: set compression mode and write data to hdf file.
c
      istat=sfscompress(sds_id,comp_code_deflate,deflate_level)
      istat = sfwdata(sds_id,istart,istride,iedges,iout)  
      if (istat.eq.fail) THEN
         WRITE(*,*) 'Failed to write variable ', qname,
     &        ' in restart HDF file'
         WRITE(*,*) '(call to sfwdata in check_hdf.f)'
         stop
      end if
c
c     # HDF: End access to integer array in HDF file.
c
      istat = sfendacc(sds_id)  
      if (istat.eq.fail) THEN
         WRITE(*,*) 'Failed to end access to variable ', qname,
     &        ' in restart HDF file'
         WRITE(*,*) '(call to sfendacc in check_hdf.f)'
         stop
      end if

      return
      end