35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56#include "implicit_f.inc"
57
58
59
60#include "param_c.inc"
61#include "vect01_c.inc"
62#include "com04_c.inc"
63#include "tabsiz_c.inc"
64
65
66
67 INTEGER MAT(NEL), IFLAG, NEL
68 my_real pm(npropm,nummat), bufmat(sbufmat),
69 . off(nel) , eint(nel), rho(nel) , rho0(nel),
70 . espe(nel), dvol(nel), pnew(nel),
71 . dpdm(nel), dpde(nel), theta(nel)
72
73
74
75 INTEGER I, MX, NR, NT, IDR, IDT, IDP, IDE
76 my_real espem, pres, dtde, dpdr, dpdt
78
79
80
81 IF(iflag == 0) THEN
82 DO i=1,nel
83 mx = mat(i)
84 pc(i) = pm(37,mx)
85 nr = nint(pm(33,mx))
86 nt = nint(pm(34,mx))
87 idr = nint(pm(35,mx))
88 idt = idr + nr
89 idp = idt + nt
90 ide = idp + nr * nt
91 espem = espe(i)/rho0(i)
92 dtde = zero
93 CALL mintp_re(bufmat(idr),nr,bufmat(idt),nt,bufmat(ide),rho(i),theta(i),espem,dtde)
94 CALL mintp1_rt(bufmat(idr),nr,bufmat(idt),nt,bufmat(idp),rho(i),theta(i),pres,dpdr,dpdt)
95 dpdm(i) = rho0(i)*dpdr
96 dpde(i) = dpdt*dtde/rho0(i)
97 pnew(i) =
max(pres,pc(i))*off(i)
98 ENDDO
99
100 ELSEIF(iflag == 1) THEN
101 DO i=1,nel
102 mx = mat(i)
103 pc(i) = pm(37,mx)
104 nr = nint(pm(33,mx))
105 nt = nint(pm(34,mx))
106 idr = nint(pm(35,mx))
107 idt = idr + nr
108 idp = idt + nt
109 ide = idp + nr * nt
110 espem=espe(i)/rho0(i)
111 CALL mintp_re(bufmat(idr),nr,bufmat(idt),nt,bufmat(ide),rho(i),theta(i),espem,dtde)
112 CALL mintp_rt(bufmat(idr),nr,bufmat(idt),nt,bufmat(idp),rho(i),theta(i),pnew(i),dpdr)
113 pnew(i)=
max(pnew(i),pc(i))*off(i)
114 eint(i)= eint(i)-half*dvol(i)*pnew(i)
115 ENDDO
116
117 ELSEIF(iflag == 2) THEN
118 DO i=1, nel
119 mx = mat(i)
120 nr = nint(pm(33,mx))
121 nt = nint(pm(34,mx))
122 pc(i) = pm(37,mx)
123 idr = nint(pm(35,mx))
124 idt = idr + nr
125 idp = idt + nt
126 ide = idp + nr * nt
127 espem = espe(i)/rho0(i)
128 CALL mintp_re(bufmat(idr),nr,bufmat(idt),nt,bufmat(ide),rho(i),theta(i),espem,dtde)
129 CALL mintp1_rt(bufmat(idr),nr,bufmat(idt),nt,bufmat(idp),rho(i),theta(i),pres,dpdr,dpdt)
130 dpdm(i) = rho0(i)*dpdr
131 dpde(i) = dpdt*dtde/rho0(i)
132 pnew(i) =
max(pres,pc(i))*off(i)
133 ENDDO
134 ENDIF
135
136 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)