1 subroutine r8dnherm3(x,nx,y,ny,z,nz,fherm,nf2,nf3,
2 > ilinx,iliny,ilinz,ier)
17 INTEGER,
PARAMETER :: R8=selected_real_kind(12,100)
18 INTEGER iliny,ilinz,ier,ilinx,ierx,iery,ierz,iz,izp,izm,iy
19 INTEGER iyp,iym,ix,ixp,ixm
24 integer nx,ny,nz,nf2,nf3
28 real*8 fherm(0:7,nf2,nf3,nz)
58 call r8splinck(x,nx,ilinx,1.0e-3_r8,ierx)
62 write(6,
'('' ?dnherm3: x axis not strict ascending'')')
65 call r8splinck(y,ny,iliny,1.0e-3_r8,iery)
69 write(6,
'('' ?dnherm3: y axis not strict ascending'')')
72 call r8splinck(z,nz,ilinz,1.0e-3_r8,ierz)
76 write(6,
'('' ?dnherm3: z axis not strict ascending'')')
81 write(6,*)
'?dnherm3: fherm (x) array dimension too small.'
86 write(6,*)
'?dnherm3: fherm (y) array dimension too small.'
110 zd=(fherm(0,ixp,iy,iz)-fherm(0,ixm,iy,iz))/
117 zd=(fherm(0,ix,iyp,iz)-fherm(0,ix,iym,iz))/
124 zd=(fherm(0,ix,iy,izp)-fherm(0,ix,iy,izm))/
132 > (fherm(0,ixp,iyp,iz)-fherm(0,ixm,iyp,iz)
133 > -fherm(0,ixp,iym,iz)+fherm(0,ixm,iym,iz))/
134 > ((x(ixp)-x(ixm))*(y(iyp)-y(iym)))
139 > (fherm(0,ixp,iy,izp)-fherm(0,ixm,iy,izp)
140 > -fherm(0,ixp,iy,izm)+fherm(0,ixm,iy,izm))/
141 > ((x(ixp)-x(ixm))*(z(izp)-z(izm)))
146 > (fherm(0,ix,iyp,izp)-fherm(0,ix,iym,izp)
147 > -fherm(0,ix,iyp,izm)+fherm(0,ix,iym,izm))/
148 > ((y(iyp)-y(iym))*(z(izp)-z(izm)))
153 > ((fherm(0,ixp,iyp,izp)-fherm(0,ixp,iym,izp)
154 > -fherm(0,ixp,iyp,izm)+fherm(0,ixp,iym,izm))-
155 > (fherm(0,ixm,iyp,izp)-fherm(0,ixm,iym,izp)
156 > -fherm(0,ixm,iyp,izm)+fherm(0,ixm,iym,izm)))/
157 > ((x(ixp)-x(ixm))*(y(iyp)-y(iym))*(z(izp)-z(izm)))