1 files changed, 102 insertions, 0 deletions
diff --git a/src/nuc_eos/dumpASCIItable.F90 b/src/nuc_eos/dumpASCIItable.F90
new file mode 100644
index 0000000..ee89acf
--- /dev/null
+++ b/src/nuc_eos/dumpASCIItable.F90
@@ -0,0 +1,102 @@
+#include "cctk.h"
+#include "cctk_Parameters.h"
+#include "cctk_Arguments.h"
+#include "cctk_Functions.h"
+
+subroutine EOS_OMNI_dumptable(CCTK_ARGUMENTS)
+
+  use eosmodule
+  implicit none
+
+  DECLARE_CCTK_PARAMETERS
+  DECLARE_CCTK_ARGUMENTS
+  DECLARE_CCTK_FUNCTIONS
+
+  integer :: irho,itemp,iye,n
+  integer :: strlength1,strlength2
+  integer, parameter :: maxstrlength=200
+  character(len=200) :: fname, dirname, fullpath
+
+  if (CCTK_MyProc(cctkGH) .ne. 0) then
+     return
+  end if
+
+  call CCTK_FortranString(strlength1,out_dir,dirname)
+  if (strlength1 .gt. maxstrlength) then
+     call CCTK_WARN(0,"The output directory string is too long")
+  end if
+
+  call CCTK_FortranString(strlength2,dump_nuceos_table_name,fname)
+  if (strlength2 .gt. maxstrlength) then
+     call CCTK_WARN(0,"The output filename string is too long")
+  end if
+
+  if (strlength1+strlength2+1 .gt. maxstrlength) then
+     call CCTK_WARN(0,"The full output path string is too long")
+  end if
+
+  fullpath = trim(dirname)//'/'//trim(fname)
+
+  call CCTK_Info(CCTK_THORNSTRING,"*******************************");
+  call CCTK_Info(CCTK_THORNSTRING,"Dumping nuc_eos table file in ASCII:");
+  call CCTK_Info(CCTK_THORNSTRING,trim(fullpath));
+  call CCTK_Info(CCTK_THORNSTRING,"*******************************");
+
+  open(unit=473,file=trim(fullpath),status='unknown',form='formatted',position='rewind')
+
+  write(473,"('# ',a20,/,i4)") "nrho:",nrho
+  write(473,"('# ',a20,/,i4)") "ntemp:",ntemp
+  write(473,"('# ',a20,/,i4)") "nye:",nye
+
+  write(473,"('# ',a20,/,1P1E18.9)") "energy shift:",energy_shift
+
+  write(473,"('# ',a20,/,1P2E18.9)") "rho min and max:",eos_rhomin,eos_rhomax
+  write(473,"('# ',a20,/,1P2E18.9)") "ye min and max:",eos_yemin,eos_yemax
+  write(473,"('# ',a20,/,1P2E18.9)") "temp min and max:",eos_tempmin,eos_tempmax
+
+  write(473,"('# ',a20,/)") "log rho points:"
+  do irho=1,nrho
+     write(473,"(E18.9)") logrho(irho)
+  enddo
+  write(473,"('# ',a20)") "log temp points:"
+  do itemp=1,ntemp
+     write(473,"(E18.9)") logtemp(itemp)
+  enddo
+  write(473,"('#',a20)") "ye points:"
+  do iye=1,nye
+     write(473,"(E18.9)") ye(iye)
+  enddo
+
+  write(473,"('# ',a20,/,i4)") "nvars:",nvars
+  write(473,"('# ',a20)") "table mappings:"
+  write(473,"('# ',a20)") " 1 -> logpress"
+  write(473,"('# ',a20)") " 2 -> logenergy"
+  write(473,"('# ',a20)") " 3 -> entropy"
+  write(473,"('# ',a20)") " 4 -> munu"
+  write(473,"('# ',a20)") " 5 -> cs2"
+  write(473,"('# ',a20)") " 6 -> dedT"
+  write(473,"('# ',a20)") " 7 -> dpdrhoe"
+  write(473,"('# ',a20)") " 8 -> dpderho"
+  write(473,"('# ',a20)") " 9 -> muhat"
+  write(473,"('# ',a20)") "10 -> mu_e"
+  write(473,"('# ',a20)") "11 -> mu_p"
+  write(473,"('# ',a20)") "12 -> mu_n"
+  write(473,"('# ',a20)") "13 -> xa"
+  write(473,"('# ',a20)") "14 -> xh"
+  write(473,"('# ',a20)") "15 -> xn"
+  write(473,"('# ',a20)") "16 -> xp"
+  write(473,"('# ',a20)") "17 -> abar"
+  write(473,"('# ',a20)") "18 -> zbar"
+  write(473,"('# ',a20)") "19 -> gamma"
+  
+  do irho=1,nrho
+     do itemp=1,ntemp
+        do iye=1,nye
+           do n=1,nvars
+              write(473,"(i4,i4,i4,i4,E18.9)") irho,itemp,iye,n,alltables(irho,itemp,iye,n)
+           enddo
+        enddo
+     enddo
+  enddo
+  
+end subroutine EOS_OMNI_dumptable