1 subroutine r8akherm1(x,nx,fherm,ilinx,ier)
13 INTEGER,
PARAMETER :: R8=selected_real_kind(12,100)
31 call r8akherm1p(x,nx,fherm,ilinx,0,ier)
36 subroutine r8akherm1p(x,nx,fherm,ilinx,ipx,ier)
56 INTEGER,
PARAMETER :: R8=selected_real_kind(12,100)
57 INTEGER ier,ilinx,ierbc,ix,ixm2,ixm1,ixmm2,ixmm1,ixp2,ixp1
61 real*8 ztol,cxp,cxm,cxpp,cxmm,cxtrap0,cxtrap1
77 call r8splinck(x,nx,ilinx,ztol,ier)
79 write(6,*)
'?akherm1: x axis not strict ascending.'
84 call ibc_ck(ipx,
'akherm1',
'Bdy Cond',0,2,ierbc)
93 cxp=(fherm(0,2)-fherm(0,1))/(x(2)-x(1))
94 cxm=(fherm(0,nx)-fherm(0,nx-1))/(x(nx)-x(nx-1))
103 cxpp=(fherm(0,3)-fherm(0,2))/(x(3)-x(2))
104 cxmm=(fherm(0,nx-1)-fherm(0,nx-2))/(x(nx-1)-x(nx-2))
106 call r8akherm0(cxmm,cxm,cxp,cxpp,wx,fherm(1,1))
107 fherm(1,nx)=fherm(1,1)
117 else if(ipx.eq.0)
then
122 cxpp=(fherm(0,3)-fherm(0,2))/(x(3)-x(2))
123 fherm(1,1)=1.5_r8*cxp-0.5_r8*cxpp
125 cxmm=(fherm(0,nx-1)-fherm(0,nx-2))/(x(nx-1)-x(nx-2))
126 fherm(1,nx)=1.5_r8*cxm-0.5_r8*cxmm
136 cxtrap0=2.0_r8*fherm(1,1)-cxp
137 cxtrap1=2.0_r8*fherm(1,nx)-cxm
144 cxtrap0=2.0_r8*fherm(1,1)-cxp
145 cxtrap1=2.0_r8*fherm(1,nx)-cxm
168 cxmm=(fherm(0,ixmm2)-fherm(0,ixmm1))/(x(ixmm2)-x(ixmm1))
174 cxpp=(fherm(0,ixpp2)-fherm(0,ixpp1))/(x(ixpp2)-x(ixpp1))
177 cxm=(fherm(0,ixm2)-fherm(0,ixm1))/(x(ixm2)-x(ixm1))
178 cxp=(fherm(0,ixp2)-fherm(0,ixp1))/(x(ixp2)-x(ixp1))
180 call r8akherm0(cxmm,cxm,cxp,cxpp,wx,fherm(1,ix))
187 subroutine r8akherm0(cxmm,cxm,cxp,cxpp,wx,result)
199 INTEGER,
PARAMETER :: R8=selected_real_kind(12,100)
200 real*8 cxmm,cxm,cxp,cxpp
206 if(wx(1)+wx(2).eq.0.0_r8)
then
213 result=(wx(1)*cxm+wx(2)*cxp)/(wx(1)+wx(2))