1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
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
|
