check_hdf.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	check (nsteps, time, nvar, naux)
subroutine	dump_double_vector (sd_id, idims, qname, out)
subroutine	dump_double_array (sd_id, idim1, idim2, qname, out)
subroutine	read_double_vector (sd_id, idims, index, qname, out)
subroutine	read_double_array (sd_id, idim1, idim2, index, qname, out)

Function/Subroutine Documentation

check()

subroutine check	(		nsteps,
			time,
			nvar,
			naux
	)

check point routine - can only call at end of coarse grid cycle

Definition at line 5 of file check_hdf.f.

References amr_module::alloc, dump_double_array(), dump_double_vector(), dump_integer_array(), dump_integer_vector(), amr_module::evol, amr_module::hxposs, amr_module::hyposs, amr_module::ibuff, amr_module::icheck, 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::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::newstl, amr_module::node, amr_module::possk, amr_module::rnode, amr_module::rsize, amr_module::rvol, amr_module::rvoll, and amr_module::tol.

c
c :::::::::::::::::::::: CHECK ::::::::::::::::::::::::::::::::;
c :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::;

      use amr_module
      implicit double precision (a-h,o-z)

      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.
      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_create
      parameter(dfacc_create = 4)

      integer   succeed, fail
      parameter(succeed = 0, fail = -1)
c
c     ###  make the file name showing the time step
c
      chkname = 'fort.chk'
     &     // char(ichar('0') + mod(nsteps/1000,10)) 
     &     // char(ichar('0') + mod(nsteps/100,10)) 
     &     // char(ichar('0') + mod(nsteps/10,10)) 
     &     // char(ichar('0') + mod(nsteps,10))
     &     // '.hdf'
c     
c     # HDF: create hdf file.
c     
      sd_id = sfstart(chkname, dfacc_create)
      if (sd_id.eq.fail) THEN
         WRITE(*,*) 'Failed to create HDF file (call to sfstart)'
         stop
      end if
c     
c     # HDF: create array of integers for storage.
c     
c     # HDF: DFNT_INT32
      iqout(1) = lenmax
      iqout(2) = lendim
      iqout(3) = memsize
      iqout(4) = lenf
      iqout(5) = ibuff
      iqout(6) = mstart
      iqout(7) = ndfree
      iqout(8) = lfine
      iqout(9) = iorder
      iqout(10) = mxnest
      iqout(11) = kcheck
      iqout(12) = nsteps
      iqout(13) = matlabu
      iqout(14) = lentot
      iqout(15) = ndfree_bnd
      call dump_integer_vector(sd_id,15,'iqout ',iqout)
      call dump_integer_vector(sd_id,maxlv,'icheck',icheck)
      call dump_integer_vector(sd_id,maxlv,'lstart',lstart)
      call dump_integer_vector(sd_id,maxlv,'newstl',newstl)
      call dump_integer_vector(sd_id,maxlv,'listsp',listsp)
      call dump_integer_vector(sd_id,maxlv,'intratx',intratx)
      call dump_integer_vector(sd_id,maxlv,'intraty',intraty)
      call dump_integer_vector(sd_id,maxlv,'kratio',kratio)
      call dump_integer_vector(sd_id,maxlv,'iregsz',iregsz)
      call dump_integer_vector(sd_id,maxlv,'jregsz',jregsz)

      call dump_integer_array(sd_id,lfdim,2,'lfree ',lfree)
      call dump_integer_array(sd_id,rsize,maxgr,'node  ',node)

c     # HDF: DFNT_FLOAT64

      qout(1) = tol
      qout(2) = time
      qout(3) = evol
      qout(4) = rvol
      call dump_double_vector(sd_id,4,'qout  ',qout)
      call dump_double_vector(sd_id,maxlv,'hxposs',hxposs)
      call dump_double_vector(sd_id,maxlv,'hyposs',hyposs)
      call dump_double_vector(sd_id,maxlv,'possk ',possk)
      call dump_double_vector(sd_id,10,'rvoll ',rvoll)
      call dump_double_vector(sd_id,lendim,'alloc ',alloc)
      
      call dump_double_array(sd_id,rsize,maxgr,'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)'
         stop
      end if

      return

Here is the call graph for this function:

dump_double_array()

subroutine dump_double_array	(	integer	sd_id,
			idim1,
			idim2,
		character*6	qname,
		dimension(idim1,idim2)	out
	)

Definition at line 190 of file check_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  out(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 double 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_float64,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 double 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,out)  
      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 double 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_double_vector()

subroutine dump_double_vector	(	integer	sd_id,
			idims,
		character*6	qname,
		dimension(idims)	out
	)

Definition at line 119 of file check_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  out(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 double 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_float64,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 double 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,out)  
      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 double 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_double_array()

subroutine read_double_array	(	integer	sd_id,
			idim1,
			idim2,
			index,
		character*6	qname,
		dimension(idim1,idim2)	out
	)

Definition at line 326 of file check_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  out(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 double array.
c
      istart(1) = 0
      istart(2) = 0
      iedges(1) = idim1
      iedges(2) = idim2
      istride(1) = 1
      istride(2) = 1
c
c     # HDF: read double array from hdf file.
c
      istat = sfrdata(sds_id,istart,istride,iedges,out)  
      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 double 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_double_vector()

subroutine read_double_vector	(	integer	sd_id,
			idims,
			index,
		character*6	qname,
		dimension(idims)	out
	)

Definition at line 267 of file check_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  out(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 double vector.
c
      istart(1) = 0
      iedges(1) = idims
      istride(1) = 1
c
c     # HDF: read double vector from hdf file.
c
      istat = sfrdata(sds_id,istart,istride,iedges,out)  
      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 double 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: