47
48
49
50 USE eos_param_mod , ONLY : eos_param_
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72#include "implicit_f.inc"
73
74
75
76
77#include "vect01_c.inc"
78#include "com04_c.inc"
79#include "tabsiz_c.inc"
80
81
82
83 INTEGER :: IFLAG, NEL
85 . off(nel) , eint(nel), rho(nel) , rho0(nel),
86 . espe(nel), dvol(nel), pnew(nel),
87 . dpdm(nel), dpde(nel), theta(nel)
88 TYPE(EOS_PARAM_),INTENT(IN) :: EOS_STRUCT
89
90
91
92 INTEGER :: I, NR, NT, IDR, IDT, IDP, IDE
93 my_real :: espem, pres, dtde, dpdr, dpdt
95
96
97
98 nr = eos_struct%IPARAM(1)
99 nt = eos_struct%IPARAM(2)
100 idr = eos_struct%IPARAM(3)
101
102 IF(iflag == 0) THEN
103 DO i=1,nel
104 idt = idr + nr
105 idp = idt + nt
106 ide = idp + nr * nt
107 espem = espe(i)/rho0(i)
108 dtde = zero
109 CALL mintp_re(bufmat(idr),nr,bufmat(idt),nt,bufmat(ide),rho(i),theta(i),espem,dtde)
110 CALL mintp1_rt(bufmat(idr),nr,bufmat(idt),nt,bufmat(idp),rho(i),theta(i),pres,dpdr,dpdt)
111 dpdm(i) = rho0(i)*dpdr
112 dpde(i) = dpdt*dtde/rho0(i)
113 pnew(i) =
max(pres,pmin)*off(i)
114 ENDDO
115
116 ELSEIF(iflag == 1) THEN
117 DO i=1,nel
118 idt = idr + nr
119 idp = idt + nt
120 ide = idp + nr * nt
121 espem=espe(i)/rho0(i)
122 CALL mintp_re(bufmat(idr),nr,bufmat(idt),nt,bufmat(ide),rho(i),theta(i),espem,dtde)
123 CALL mintp_rt(bufmat(idr),nr,bufmat(idt),nt,bufmat(idp),rho(i),theta(i),pnew(i),dpdr)
124 pnew(i)=
max(pnew(i),pmin)*off(i)
125 eint(i)= eint(i)-half*dvol(i)*pnew(i)
126 ENDDO
127
128 ELSEIF(iflag == 2) THEN
129 DO i=1, nel
130 idt = idr + nr
131 idp = idt + nt
132 ide = idp + nr * nt
133 espem = espe(i)/rho0(i)
134 CALL mintp_re(bufmat(idr),nr,bufmat(idt),nt,bufmat(ide),rho(i),theta(i),espem,dtde)
135 CALL mintp1_rt(bufmat(idr),nr,bufmat(idt),nt,bufmat(idp),rho(i),theta(i),pres,dpdr,dpdt)
136 dpdm(i) = rho0(i)*dpdr
137 dpde(i) = dpdt*dtde/rho0(i)
138 pnew(i) =
max(pres,pmin)*off(i)
139 ENDDO
140 ENDIF
141
142 RETURN
subroutine mintp1_rt(xx, nx, yy, ny, zz, x, y, z, dzdx, dzdy)
subroutine mintp_re(xx, nx, yy, ny, zz, x, y, z, dydz)
subroutine mintp_rt(xx, nx, yy, ny, zz, x, y, z, dzdx)