restrt_hdf.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	restrt (nsteps, time, nvar)
subroutine	read_integer_vector (sd_id, idims, index, qname, iout)
subroutine	read_integer_array (sd_id, idim1, idim2, index, qname, iout)
subroutine	dump_integer_vector (sd_id, idims, qname, iout)
subroutine	dump_integer_array (sd_id, idim1, idim2, qname, iout)

Function/Subroutine Documentation

dump_integer_array()

subroutine dump_integer_array	(	integer	sd_id,
			idim1,
			idim2,
		character*6	qname,
		dimension(idim1,idim2)	iout
	)

Definition at line 433 of file restrt_hdf.f.

Referenced by check().

      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

Here is the caller graph for this function:

dump_integer_vector()

subroutine dump_integer_vector	(	integer	sd_id,
			idims,
		character*6	qname,
		dimension(idims)	iout
	)

Definition at line 362 of file restrt_hdf.f.

Referenced by check().

      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

Here is the caller graph for this function:

read_integer_array()

subroutine read_integer_array	(	integer	sd_id,
			idim1,
			idim2,
			index,
		character*6	qname,
		dimension(idim1,idim2)	iout
	)

Definition at line 299 of file restrt_hdf.f.

Referenced by restrt().

      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

Here is the caller graph for this function:

read_integer_vector()

subroutine read_integer_vector	(	integer	sd_id,
			idims,
			index,
		character*6	qname,
		dimension(idims)	iout
	)

Definition at line 240 of file restrt_hdf.f.

Referenced by restrt().

      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

Here is the caller graph for this function:

restrt()

subroutine restrt	(		nsteps,
			time,
			nvar
	)

Definition at line 5 of file restrt_hdf.f.

References amr_module::alloc, amr_module::evol, amr_module::hxposs, amr_module::hyposs, amr_module::icheck, igetsp(), amr_module::intratx, amr_module::intraty, amr_module::iorder, amr_module::iregsz, amr_module::jregsz, amr_module::kcheck, amr_module::kratio, amr_module::lendim, amr_module::lenf, amr_module::lenmax, amr_module::lentot, amr_module::levelptr, amr_module::lfdim, amr_module::lfine, amr_module::lfree, amr_module::listsp, amr_module::lstart, amr_module::matlabu, amr_module::maxgr, amr_module::maxlv, amr_module::memsize, amr_module::mstart, amr_module::mxnest, amr_module::ndfree, amr_module::ndfree_bnd, amr_module::ndihi, amr_module::ndilo, amr_module::ndjhi, amr_module::ndjlo, amr_module::newstl, amr_module::nghost, amr_module::node, amr_module::outunit, amr_module::possk, read_double_array(), read_double_vector(), read_integer_array(), read_integer_vector(), reclam(), amr_module::rnode, amr_module::rsize, amr_module::rvol, amr_module::rvoll, and amr_module::store2.

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

Here is the call graph for this function: