*DECK DQAWFE
      SUBROUTINE DQAWFE (F, A, OMEGA, INTEGR, EPSABS, LIMLST, LIMIT,
     +   MAXP1, RESULT, ABSERR, NEVAL, IER, RSLST, ERLST, IERLST, LST,
     +   ALIST, BLIST, RLIST, ELIST, IORD, NNLOG, CHEBMO)
C***BEGIN PROLOGUE  DQAWFE
C***PURPOSE  The routine calculates an approximation result to a
C            given Fourier integral
C            I = Integral of F(X)*W(X) over (A,INFINITY)
C            where W(X)=COS(OMEGA*X) or W(X)=SIN(OMEGA*X),
C            hopefully satisfying following claim for accuracy
C            ABS(I-RESULT).LE.EPSABS.
C***LIBRARY   SLATEC (QUADPACK)
C***CATEGORY  H2A3A1
C***TYPE      DOUBLE PRECISION (QAWFE-S, DQAWFE-D)
C***KEYWORDS  AUTOMATIC INTEGRATOR, CONVERGENCE ACCELERATION,
C             FOURIER INTEGRALS, INTEGRATION BETWEEN ZEROS, QUADPACK,
C             QUADRATURE, SPECIAL-PURPOSE INTEGRAL
C***AUTHOR  Piessens, Robert
C             Applied Mathematics and Programming Division
C             K. U. Leuven
C           de Doncker, Elise
C             Applied Mathematics and Programming Division
C             K. U. Leuven
C***DESCRIPTION
C
C        Computation of Fourier integrals
C        Standard fortran subroutine
C        Double precision version
C
C        PARAMETERS
C         ON ENTRY
C            F      - Double precision
C                     Function subprogram defining the integrand
C                     Function F(X). The actual name for F needs to
C                     be declared E X T E R N A L in the driver program.
C
C            A      - Double precision
C                     Lower limit of integration
C
C            OMEGA  - Double precision
C                     Parameter in the WEIGHT function
C
C            INTEGR - Integer
C                     Indicates which WEIGHT function is used
C                     INTEGR = 1      W(X) = COS(OMEGA*X)
C                     INTEGR = 2      W(X) = SIN(OMEGA*X)
C                     If INTEGR.NE.1.AND.INTEGR.NE.2, the routine will
C                     end with IER = 6.
C
C            EPSABS - Double precision
C                     absolute accuracy requested, EPSABS.GT.0
C                     If EPSABS.LE.0, the routine will end with IER = 6.
C
C            LIMLST - Integer
C                     LIMLST gives an upper bound on the number of
C                     cycles, LIMLST.GE.1.
C                     If LIMLST.LT.3, the routine will end with IER = 6.
C
C            LIMIT  - Integer
C                     Gives an upper bound on the number of subintervals
C                     allowed in the partition of each cycle, LIMIT.GE.1
C                     each cycle, LIMIT.GE.1.
C
C            MAXP1  - Integer
C                     Gives an upper bound on the number of
C                     Chebyshev moments which can be stored, I.E.
C                     for the intervals of lengths ABS(B-A)*2**(-L),
C                     L=0,1, ..., MAXP1-2, MAXP1.GE.1
C
C         ON RETURN
C            RESULT - Double precision
C                     Approximation to the integral X
C
C            ABSERR - Double precision
C                     Estimate of the modulus of the absolute error,
C                     which should equal or exceed ABS(I-RESULT)
C
C            NEVAL  - Integer
C                     Number of integrand evaluations
C
C            IER    - IER = 0 Normal and reliable termination of
C                             the routine. It is assumed that the
C                             requested accuracy has been achieved.
C                     IER.GT.0 Abnormal termination of the routine. The
C                             estimates for integral and error are less
C                             reliable. It is assumed that the requested
C                             accuracy has not been achieved.
C            ERROR MESSAGES
C                    If OMEGA.NE.0
C                     IER = 1 Maximum number of  cycles  allowed
C                             Has been achieved., i.e. of subintervals
C                             (A+(K-1)C,A+KC) where
C                             C = (2*INT(ABS(OMEGA))+1)*PI/ABS(OMEGA),
C                             for K = 1, 2, ..., LST.
C                             One can allow more cycles by increasing
C                             the value of LIMLST (and taking the
C                             according dimension adjustments into
C                             account).
C                             Examine the array IWORK which contains
C                             the error flags on the cycles, in order to
C                             look for eventual local integration
C                             difficulties. If the position of a local
C                             difficulty can be determined (e.g.
C                             SINGULARITY, DISCONTINUITY within the
C                             interval) one will probably gain from
C                             splitting up the interval at this point
C                             and calling appropriate integrators on
C                             the subranges.
C                         = 4 The extrapolation table constructed for
C                             convergence acceleration of the series
C                             formed by the integral contributions over
C                             the cycles, does not converge to within
C                             the requested accuracy. As in the case of
C                             IER = 1, it is advised to examine the
C                             array IWORK which contains the error
C                             flags on the cycles.
C                         = 6 The input is invalid because
C                             (INTEGR.NE.1 AND INTEGR.NE.2) or
C                              EPSABS.LE.0 or LIMLST.LT.3.
C                              RESULT, ABSERR, NEVAL, LST are set
C                              to zero.
C                         = 7 Bad integrand behaviour occurs within one
C                             or more of the cycles. Location and type
C                             of the difficulty involved can be
C                             determined from the vector IERLST. Here
C                             LST is the number of cycles actually
C                             needed (see below).
C                             IERLST(K) = 1 The maximum number of
C                                           subdivisions (= LIMIT) has
C                                           been achieved on the K th
C                                           cycle.
C                                       = 2 Occurrence of roundoff error
C                                           is detected and prevents the
C                                           tolerance imposed on the
C                                           K th cycle, from being
C                                           achieved.
C                                       = 3 Extremely bad integrand
C                                           behaviour occurs at some
C                                           points of the K th cycle.
C                                       = 4 The integration procedure
C                                           over the K th cycle does
C                                           not converge (to within the
C                                           required accuracy) due to
C                                           roundoff in the
C                                           extrapolation procedure
C                                           invoked on this cycle. It
C                                           is assumed that the result
C                                           on this interval is the
C                                           best which can be obtained.
C                                       = 5 The integral over the K th
C                                           cycle is probably divergent
C                                           or slowly convergent. It
C                                           must be noted that
C                                           divergence can occur with
C                                           any other value of
C                                           IERLST(K).
C                    If OMEGA = 0 and INTEGR = 1,
C                    The integral is calculated by means of DQAGIE
C                    and IER = IERLST(1) (with meaning as described
C                    for IERLST(K), K = 1).
C
C            RSLST  - Double precision
C                     Vector of dimension at least LIMLST
C                     RSLST(K) contains the integral contribution
C                     over the interval (A+(K-1)C,A+KC) where
C                     C = (2*INT(ABS(OMEGA))+1)*PI/ABS(OMEGA),
C                     K = 1, 2, ..., LST.
C                     Note that, if OMEGA = 0, RSLST(1) contains
C                     the value of the integral over (A,INFINITY).
C
C            ERLST  - Double precision
C                     Vector of dimension at least LIMLST
C                     ERLST(K) contains the error estimate corresponding
C                     with RSLST(K).
C
C            IERLST - Integer
C                     Vector of dimension at least LIMLST
C                     IERLST(K) contains the error flag corresponding
C                     with RSLST(K). For the meaning of the local error
C                     flags see description of output parameter IER.
C
C            LST    - Integer
C                     Number of subintervals needed for the integration
C                     If OMEGA = 0 then LST is set to 1.
C
C            ALIST, BLIST, RLIST, ELIST - Double precision
C                     vector of dimension at least LIMIT,
C
C            IORD, NNLOG - Integer
C                     Vector of dimension at least LIMIT, providing
C                     space for the quantities needed in the subdivision
C                     process of each cycle
C
C            CHEBMO - Double precision
C                     Array of dimension at least (MAXP1,25), providing
C                     space for the Chebyshev moments needed within the
C                     cycles
C
C***REFERENCES  (NONE)
C***ROUTINES CALLED  D1MACH, DQAGIE, DQAWOE, DQELG
C***REVISION HISTORY  (YYMMDD)
C   800101  DATE WRITTEN
C   890531  Changed all specific intrinsics to generic.  (WRB)
C   890831  Modified array declarations.  (WRB)
C   891009  Removed unreferenced variable.  (WRB)
C   891009  REVISION DATE from Version 3.2
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C***END PROLOGUE  DQAWFE
C
      DOUBLE PRECISION A,ABSEPS,ABSERR,ALIST,BLIST,CHEBMO,CORREC,CYCLE,
     1  C1,C2,DL,DRL,D1MACH,ELIST,ERLST,EP,EPS,EPSA,
     2  EPSABS,ERRSUM,F,FACT,OMEGA,P,PI,P1,PSUM,RESEPS,RESULT,RES3LA,
     3  RLIST,RSLST,UFLOW
      INTEGER IER,IERLST,INTEGR,IORD,KTMIN,L,LAST,LST,LIMIT,LIMLST,LL,
     1    MAXP1,MOMCOM,NEV,NEVAL,NNLOG,NRES,NUMRL2
C
      DIMENSION ALIST(*),BLIST(*),CHEBMO(MAXP1,25),ELIST(*),
     1  ERLST(*),IERLST(*),IORD(*),NNLOG(*),PSUM(52),
     2  RES3LA(3),RLIST(*),RSLST(*)
C
      EXTERNAL F
C
C
C            THE DIMENSION OF  PSUM  IS DETERMINED BY THE VALUE OF
C            LIMEXP IN SUBROUTINE DQELG (PSUM MUST BE OF DIMENSION
C            (LIMEXP+2) AT LEAST).
C
C           LIST OF MAJOR VARIABLES
C           -----------------------
C
C           C1, C2    - END POINTS OF SUBINTERVAL (OF LENGTH CYCLE)
C           CYCLE     - (2*INT(ABS(OMEGA))+1)*PI/ABS(OMEGA)
C           PSUM      - VECTOR OF DIMENSION AT LEAST (LIMEXP+2)
C                       (SEE ROUTINE DQELG)
C                       PSUM CONTAINS THE PART OF THE EPSILON TABLE
C                       WHICH IS STILL NEEDED FOR FURTHER COMPUTATIONS.
C                       EACH ELEMENT OF PSUM IS A PARTIAL SUM OF THE
C                       SERIES WHICH SHOULD SUM TO THE VALUE OF THE
C                       INTEGRAL.
C           ERRSUM    - SUM OF ERROR ESTIMATES OVER THE SUBINTERVALS,
C                       CALCULATED CUMULATIVELY
C           EPSA      - ABSOLUTE TOLERANCE REQUESTED OVER CURRENT
C                       SUBINTERVAL
C           CHEBMO    - ARRAY CONTAINING THE MODIFIED CHEBYSHEV
C                       MOMENTS (SEE ALSO ROUTINE DQC25F)
C
      SAVE P, PI
      DATA P/0.9D+00/
      DATA PI / 3.1415926535 8979323846 2643383279 50 D0 /
C
C           TEST ON VALIDITY OF PARAMETERS
C           ------------------------------
C
C***FIRST EXECUTABLE STATEMENT  DQAWFE
      RESULT = 0.0D+00
      ABSERR = 0.0D+00
      NEVAL = 0
      LST = 0
      IER = 0
      IF((INTEGR.NE.1.AND.INTEGR.NE.2).OR.EPSABS.LE.0.0D+00.OR.
     1  LIMLST.LT.3) IER = 6
      IF(IER.EQ.6) GO TO 999
      IF(OMEGA.NE.0.0D+00) GO TO 10
C
C           INTEGRATION BY DQAGIE IF OMEGA IS ZERO
C           --------------------------------------
C
      IF(INTEGR.EQ.1) CALL DQAGIE(F,A,1,EPSABS,0.0D+00,LIMIT,
     1  RESULT,ABSERR,NEVAL,IER,ALIST,BLIST,RLIST,ELIST,IORD,LAST)
      RSLST(1) = RESULT
      ERLST(1) = ABSERR
      IERLST(1) = IER
      LST = 1
      GO TO 999
C
C           INITIALIZATIONS
C           ---------------
C
   10 L = ABS(OMEGA)
      DL = 2*L+1
      CYCLE = DL*PI/ABS(OMEGA)
      IER = 0
      KTMIN = 0
      NEVAL = 0
      NUMRL2 = 0
      NRES = 0
      C1 = A
      C2 = CYCLE+A
      P1 = 0.1D+01-P
      UFLOW = D1MACH(1)
      EPS = EPSABS
      IF(EPSABS.GT.UFLOW/P1) EPS = EPSABS*P1
      EP = EPS
      FACT = 0.1D+01
      CORREC = 0.0D+00
      ABSERR = 0.0D+00
      ERRSUM = 0.0D+00
C
C           MAIN DO-LOOP
C           ------------
C
      DO 50 LST = 1,LIMLST
C
C           INTEGRATE OVER CURRENT SUBINTERVAL.
C
        EPSA = EPS*FACT
        CALL DQAWOE(F,C1,C2,OMEGA,INTEGR,EPSA,0.0D+00,LIMIT,LST,MAXP1,
     1  RSLST(LST),ERLST(LST),NEV,IERLST(LST),LAST,ALIST,BLIST,RLIST,
     2  ELIST,IORD,NNLOG,MOMCOM,CHEBMO)
        NEVAL = NEVAL+NEV
        FACT = FACT*P
        ERRSUM = ERRSUM+ERLST(LST)
        DRL = 0.5D+02*ABS(RSLST(LST))
C
C           TEST ON ACCURACY WITH PARTIAL SUM
C
        IF((ERRSUM+DRL).LE.EPSABS.AND.LST.GE.6) GO TO 80
        CORREC = MAX(CORREC,ERLST(LST))
        IF(IERLST(LST).NE.0) EPS = MAX(EP,CORREC*P1)
        IF(IERLST(LST).NE.0) IER = 7
        IF(IER.EQ.7.AND.(ERRSUM+DRL).LE.CORREC*0.1D+02.AND.
     1  LST.GT.5) GO TO 80
        NUMRL2 = NUMRL2+1
        IF(LST.GT.1) GO TO 20
        PSUM(1) = RSLST(1)
        GO TO 40
   20   PSUM(NUMRL2) = PSUM(LL)+RSLST(LST)
        IF(LST.EQ.2) GO TO 40
C
C           TEST ON MAXIMUM NUMBER OF SUBINTERVALS
C
        IF(LST.EQ.LIMLST) IER = 1
C
C           PERFORM NEW EXTRAPOLATION
C
        CALL DQELG(NUMRL2,PSUM,RESEPS,ABSEPS,RES3LA,NRES)
C
C           TEST WHETHER EXTRAPOLATED RESULT IS INFLUENCED BY ROUNDOFF
C
        KTMIN = KTMIN+1
        IF(KTMIN.GE.15.AND.ABSERR.LE.0.1D-02*(ERRSUM+DRL)) IER = 4
        IF(ABSEPS.GT.ABSERR.AND.LST.NE.3) GO TO 30
        ABSERR = ABSEPS
        RESULT = RESEPS
        KTMIN = 0
C
C           IF IER IS NOT 0, CHECK WHETHER DIRECT RESULT (PARTIAL SUM)
C           OR EXTRAPOLATED RESULT YIELDS THE BEST INTEGRAL
C           APPROXIMATION
C
        IF((ABSERR+0.1D+02*CORREC).LE.EPSABS.OR.
     1  (ABSERR.LE.EPSABS.AND.0.1D+02*CORREC.GE.EPSABS)) GO TO 60
   30   IF(IER.NE.0.AND.IER.NE.7) GO TO 60
   40   LL = NUMRL2
        C1 = C2
        C2 = C2+CYCLE
   50 CONTINUE
C
C         SET FINAL RESULT AND ERROR ESTIMATE
C         -----------------------------------
C
   60 ABSERR = ABSERR+0.1D+02*CORREC
      IF(IER.EQ.0) GO TO 999
      IF(RESULT.NE.0.0D+00.AND.PSUM(NUMRL2).NE.0.0D+00) GO TO 70
      IF(ABSERR.GT.ERRSUM) GO TO 80
      IF(PSUM(NUMRL2).EQ.0.0D+00) GO TO 999
   70 IF(ABSERR/ABS(RESULT).GT.(ERRSUM+DRL)/ABS(PSUM(NUMRL2)))
     1  GO TO 80
      IF(IER.GE.1.AND.IER.NE.7) ABSERR = ABSERR+DRL
      GO TO 999
   80 RESULT = PSUM(NUMRL2)
      ABSERR = ERRSUM+DRL
  999 RETURN
      END


c Pseudo-random number generator
c Numerical Recipes, p. 274

	subroutine ran(jlo, jhi, j)

	implicit none

c	Parameters:
	real	jlo, jhi	! Limit values (changed)
	real	j

c	Local variables:
	integer	im, ia, ic
	real	jran

	parameter (im= 714025, ia= 4096, ic= 150889)

      jhi=jhi-1.0
      jran= mod(jran*ia+ic,real(im))         ! generator
      j= jlo+((jhi-jlo+1)*jran)/im
      return
      end


      MODULE GREEK MATHEMATICIANS	!Two millenia back and more.
       CONTAINS
        INTEGER FUNCTION GCD(I,J)	!Greatest common divisor.
         INTEGER I,J	!Of these two integers.
         INTEGER N,M,R	!Workers.
          N = MAX(I,J)	!Since I don't want to damage I or J,
          M = MIN(I,J)	!These copies might as well be the right way around.
    1     R = MOD(N,M)		!Divide N by M to get the remainder R.
c          write (6,*) "M,N,R",M,N,R
          IF (R.GT.0) THEN	!Remainder zero?
            N = M			!No. Descend a level.
            M = R			!M-multiplicity has been removed from N.
            IF (R .GT. 1) GO TO 1	!No point dividing by one.
          END IF			!If R = 0, M divides N.
          GCD = M			!There we are.
        END FUNCTION GCD	!Euclid lives on!
        FUNCTION GCD3(I,J,K)	!Double do.
         INTEGER I,J,K	!Three numbers.
         INTEGER R	!One remainder.
          R = GCD(I,J)		!Greatest common divisor.
          IF (R .GT. 1) R = GCD(R,K)	!The first two might be co-prime.
          GCD3 = R		!The result.
        END FUNCTION GCD3

        REAL*8 FUNCTION HERO(SIDE)	!Hero's calculation for the area of a triangle.
Calculations could proceed with non-integer sides.
         INTEGER SIDE(3)	!The lengths of each of the sides.
         REAL*8 S		!A scratchpad.
          S = SUM(SIDE)		!Definitely integer arithmetic.
          S = S/2		!Full precision without muttering /2D0.
          S = S*PRODUCT(S - SIDE)	!Negative for non-joining triangles.
          HERO = SIGN(SQRT(ABS(S)),S)	!Protect the SQRT against such.
        END FUNCTION HERO		!As when one side is longer than the other two combined.
      END MODULE GREEK MATHEMATICIANS	!Only a selection here.

      PROGRAM TEST		!Find triangles with integral sides and areas.
      USE GREEK MATHEMATICIANS	!For guidance.
      INTEGER LIMIT,LOTS	!And then descend to Furrytran.
      PARAMETER (LIMIT = 200, LOTS = 666)	!This should do.
      INTEGER I,J,K,SIDE(3)	!The lengths of the sides of the triangles.
      EQUIVALENCE (SIDE(1),I),(SIDE(2),J),(SIDE(3),K)	!I want two access styles.
      REAL*8 A			!The area of the triangle.
      TYPE ABLOB		!Define a stash for the desired results.
       INTEGER SIDE(3)		!The three sides,
       INTEGER PERIMETER	!Their summation, somewhat redundant.
       INTEGER AREA		!This is rather more difficult to calculate.
      END TYPE ABLOB		!That will do.
      TYPE(ABLOB) STASH(LOTS)	!I'll have some.
      INTEGER N,XNDX(LOTS)	!A counter and an index..
      INTEGER H,T		!Stuff for the in-line combsort.
      LOGICAL CURSE		!Rather than mess with subroutines and parameters.
      INTEGER TASTE,CHOICE	!Output selection stuff.
      PARAMETER (TASTE = 10, CHOICE = 210)	!As specified.

Collect some triangles.
      N = 0	!So, here we go.
      DO K = 1,LIMIT	!Just slog away,
        DO J = 1,K		!With brute force and ignorance.
          DO I = 1,J			!This way, a 3,4,5 triangle is in that order.
            IF (GCD3(I,J,K).GT.1) CYCLE	!A mere multiple. Seen it before.
            A = HERO(SIDE)		!Assess the area.
            IF (A.LE.0) CYCLE		!Not a valid triangle!
            IF (A .NE. INT(A)) CYCLE	!Not an integral area. Precision is adequate...
            N = N + 1			!Another candidate survives.
            IF (N.GT.LOTS) STOP "Too many!"	!Perhaps not for long!
            XNDX(N) = N			!So, keep a finger.
            STASH(N).SIDE = SIDE		!Stash its details.
            STASH(N).PERIMETER = SUM(SIDE)	!Calculate once, here.
            STASH(N).AREA = A			!And save this as an integer.
c            WRITE (6,10) N,STASH(N)
   10       FORMAT (I4,":",3I4,I7,I8)	!A reasonable layout.
          END DO
        END DO
      END DO
      WRITE (6,11) N,LIMIT	!The first result.
   11 FORMAT (I0," triangles of integral area. Sides up to ",I0)

Comb sort involves coding only one test, and the comparison is to be compound...
      H = N - 1	!Last - First, and not +1.
   20 H = MAX(1,H*10/13)	!The special feature.
      IF (H.EQ.9 .OR. H.EQ.10) H = 11	!A twiddle.
      CURSE = .FALSE.		!So far, so good.
      DO 24 I = N - H,1,-1	!If H = 1, this is a BubbleSort.
        IF (STASH(XNDX(I)).AREA - STASH(XNDX(I + H)).AREA) 24,21,23 	!One compare. But, a compound key.
   21   IF (STASH(XNDX(I)).PERIMETER-STASH(XNDX(I+H)).PERIMETER)24,22,23 	!Equal area, so, perimeter?
   22   IF (MAXVAL(STASH(XNDX(I)).SIDE)			!Equal perimeter, so, longest side?
     1    - MAXVAL(STASH(XNDX(I+H)).SIDE)) 24,24,23	!At last, equality here can be passed over.
   23     T=XNDX(I); XNDX(I)=XNDX(I+H); XNDX(I+H)=T	!One swap.
          CURSE = .TRUE.			!One curse.
   24 CONTINUE				!One loop.
      IF (CURSE .OR. H.GT.1) GO TO 20	!Work remains?

Cast forth the results, as per the specification.
      WRITE (6,30) TASTE
   30 FORMAT ("First ",I0,", ordered by area, perimeter, longest side.",
     1 /,"Index ---Sides--- Perimeter Area")
      DO I = 1,TASTE
        WRITE (6,10) XNDX(I),STASH(XNDX(I))
      END DO

      WRITE (6,31) CHOICE
   31 FORMAT ("Those triangles with area",I7)
      DO I = 1,N	!I could go looking through the ordered list for CHOICE entries,
        IF (STASH(XNDX(I)).AREA.NE.CHOICE) CYCLE!But I can't be bothered.
        WRITE (6,10) XNDX(I),STASH(XNDX(I))	!Here is one such.
      END DO		!Just thump through the lot.
      END


      subroutine r8herm3ev(xget,yget,zget,x,nx,y,ny,z,nz,
     >                   ilinx,iliny,ilinz,
     >                   f,inf2,inf3,ict,fval,ier)
C
C  evaluate a 3d cubic Hermite interpolant on a rectilinear
C  grid -- this is C1 in all directions.
C
C  this subroutine calls two subroutines:
C     herm3xyz  -- find cell containing (xget,yget,zget)
C     herm3fcn -- evaluate interpolant function and (optionally) derivatives
C
C  input arguments:
C  ================
C
!============
! idecl:  explicitize implicit INTEGER declarations:
      IMPLICIT NONE
      INTEGER, PARAMETER :: R8=SELECTED_REAL_KIND(12,100)
      INTEGER ny,nz,inf2,inf3,nx
!============
      REAL*8 xget,yget,zget               ! target of this interpolation
      REAL*8 x(nx)                        ! ordered x grid
      REAL*8 y(ny)                        ! ordered y grid
      REAL*8 z(nz)                        ! ordered z grid
      integer ilinx                     ! ilinx=1 => assume x evenly spaced
      integer iliny                     ! iliny=1 => assume y evenly spaced
      integer ilinz                     ! ilinz=1 => assume z evenly spaced
C
      REAL*8 f(0:7,inf2,inf3,nz)          ! function data
C
C       f 2nd dimension inf2 must be .ge. nx; 3rd dim inf3 .ge. ny
C       contents of f:
C
C  f(0,i,j,k) = f @ x(i),y(j),z(k)
C  f(1,i,j,k) = df/dx @ x(i),y(j),z(k)
C  f(2,i,j,k) = df/dy @ x(i),y(j),z(k)
C  f(3,i,j,k) = df/dz @ x(i),y(j),z(k)
C  f(4,i,j,k) = d2f/dxdy @ x(i),y(j),z(k)
C  f(5,i,j,k) = d2f/dxdz @ x(i),y(j),z(k)
C  f(6,i,j,k) = d2f/dydz @ x(i),y(j),z(k)
C  f(7,i,j,k) = d3f/dxdydz @ x(i),y(j),z(k)
C
      integer ict(8)                    ! code specifying output desired
C
C  ict(1)=1 -- return f  (0, don't)
C  ict(2)=1 -- return df/dx  (0, don't)
C  ict(3)=1 -- return df/dy  (0, don't)
C  ict(4)=1 -- return df/dz  (0, don't)
C  ict(5)=1 -- return d2f/dxdy  (0, don't)
C  ict(6)=1 -- return d2f/dxdz  (0, don't)
C  ict(7)=1 -- return d2f/dydz  (0, don't)
C  ict(8)=1 -- return d3f/dxdydz  (0, don't)
C
C output arguments:
C =================
C
      REAL*8 fval(*)                      ! output data
      integer ier                       ! error code =0 ==> no error
C
C  fval(1) receives the first output (depends on ict(...) spec)
C  fval(2) receives the second output (depends on ict(...) spec)
C  fval(3) receives the third output (depends on ict(...) spec)
C  fval(4) receives the 4th output (depends on ict(...) spec)
C  fval(5-8) receive 5th thru 8th outputs (if required by ict(...) spec)
C
C  examples:
C    on input ict = [1,1,1,1,0,0,0,0]
C   on output fval= [f,df/dx,df/dy,df/dz]
C
C    on input ict = [1,0,0,0,0,0,0,0]
C   on output fval= [f] ... elements 2-8 never referenced
C
C    on input ict = [0,1,1,0,0,0,0,0]
C   on output fval= [df/dx,df/dy] ... elements 3-8 never referenced
C
C    on input ict = [0,0,0,0,1,0,0,0]
C   on output fval= [d2f/dxdy] ... elements 2-8 never referenced.
C
C  ier -- completion code:  0 means OK
C-------------------
C  local:
C
      integer, dimension(1) :: i,j,k                     ! cell indices
C
C  normalized displacement from (x(i),y(j)) corner of cell.
C    xparam=0 @x(i)  xparam=1 @x(i+1)
C    yparam=0 @y(j)  yparam=1 @y(j+1)
C    zparam=0 @z(k)  zparam=1 @z(k+1)
C
      REAL*8, dimension(1) :: xparam,yparam,zparam
C
C  cell dimensions and
C  inverse cell dimensions hxi = 1/(x(i+1)-x(i)), hyi = 1/(y(j+1)-y(j))
C
      REAL*8, dimension(1) :: hx,hy,hz
      REAL*8, dimension(1) :: hxi,hyi,hzi
C
C  0 .le. xparam .le. 1
C  0 .le. yparam .le. 1
C  0 .le. zparam .le. 1
C
C---------------------------------------------------------------------
C
      call r8herm3xyz(xget,yget,zget,x,nx,y,ny,z,nz,ilinx,iliny,ilinz,
     >   i(1),j(1),k(1),xparam(1),yparam(1),zparam(1),hx(1),hxi(1),
     >   hy(1),hyi(1),hz(1),hzi(1),ier)
      if(ier.ne.0) return
c
      call r8herm3fcn(ict,1,1,
     >   fval,i,j,k,xparam,yparam,zparam,
     >   hx,hxi,hy,hyi,hz,hzi,
     >   f,inf2,inf3,nz)
C
      return
      end
C---------------------------------------------------------------------
c  herm3xyz -- look up x-y-z zone
c
c  this is the "first part" of herm3ev, see comments, above.
c
      subroutine r8herm3xyz(xget,yget,zget,x,nx,y,ny,z,nz,
     >   ilinx,iliny,ilinz,
     >   i,j,k,xparam,yparam,zparam,
     >   hx,hxi,hy,hyi,hz,hzi,ier)
c
c  input of herm3xyz
c  ================
c
!============
! idecl:  explicitize implicit INTEGER declarations:
      IMPLICIT NONE
      INTEGER, PARAMETER :: R8=SELECTED_REAL_KIND(12,100)
      INTEGER nxm,nym,nzm,ii,jj,kk
!============
! idecl:  explicitize implicit REAL declarations:
      REAL*8 zxget,zyget,zzget,zxtol,zytol,zztol
!============
      integer nx,ny,nz                  ! coord. grid dimensions
c
      REAL*8 xget,yget,zget               ! target point
      REAL*8 x(nx),y(ny),z(nz)            ! indep. coords. (ascending order)
c
      integer ilinx                     ! =1:  x evenly spaced
      integer iliny                     ! =1:  y evenly spaced
      integer ilinz                     ! =1:  z evenly spaced
c
c  output of herm3xyz
c  =================
      integer i,j,k                     ! index to cell containing target pt
c          on exit:  1.le.i.le.nx-1   1.le.j.le.ny-1  1.le.k.le.nz-1
c
c  normalized position w/in (i,j) cell (btw 0 and 1):
c
      REAL*8 xparam                       ! (xget-x(i))/(x(i+1)-x(i))
      REAL*8 yparam                       ! (yget-y(j))/(y(j+1)-y(j))
      REAL*8 zparam                       ! (zget-z(k))/(z(k+1)-z(k))
c
c  grid spacing
c
      REAL*8 hx                           ! hx = x(i+1)-x(i)
      REAL*8 hy                           ! hy = y(j+1)-y(j)
      REAL*8 hz                           ! hz = z(k+1)-z(k)
c
c  inverse grid spacing:
c
      REAL*8 hxi                          ! 1/hx = 1/(x(i+1)-x(i))
      REAL*8 hyi                          ! 1/hy = 1/(y(j+1)-y(j))
      REAL*8 hzi                          ! 1/hz = 1/(z(k+1)-z(k))
c
      integer ier                       ! return ier.ne.0 on error
c
c------------------------------------
c
      ier=0
c
c  range check
c
      zxget=xget
      zyget=yget
      zzget=zget
      if((xget.lt.x(1)).or.(xget.gt.x(nx))) then
         zxtol=4.0E-7_r8*max(abs(x(1)),abs(x(nx)))
         if((xget.lt.x(1)-zxtol).or.(xget.gt.x(nx)+zxtol)) then
            ier=1
            write(6,1001) xget,x(1),x(nx)
 1001       format(' ?herm3ev:  xget=',1pe11.4,' out of range ',
     >         1pe11.4,' to ',1pe11.4)
         else
            if((xget.lt.x(1)-0.5_r8*zxtol).or.
     >         (xget.gt.x(nx)+0.5_r8*zxtol))
     >      write(6,1011) xget,x(1),x(nx)
 1011       format(' %herm3ev:  xget=',1pe15.8,' beyond range ',
     >         1pe15.8,' to ',1pe15.8,' (fixup applied)')
            if(xget.lt.x(1)) then
               zxget=x(1)
            else
               zxget=x(nx)
            endif
         endif
      endif
      if((yget.lt.y(1)).or.(yget.gt.y(ny))) then
         zytol=4.0E-7_r8*max(abs(y(1)),abs(y(ny)))
         if((yget.lt.y(1)-zytol).or.(yget.gt.y(ny)+zytol)) then
            ier=1
            write(6,1002) yget,y(1),y(ny)
 1002       format(' ?herm3ev:  yget=',1pe11.4,' out of range ',
     >         1pe11.4,' to ',1pe11.4)
         else
            if((yget.lt.y(1)-0.5_r8*zytol).or.
     >         (yget.gt.y(ny)+0.5_r8*zytol))
     >      write(6,1012) yget,y(1),y(ny)
 1012       format(' %herm3ev:  yget=',1pe15.8,' beyond range ',
     >         1pe15.8,' to ',1pe15.8,' (fixup applied)')
            if(yget.lt.y(1)) then
               zyget=y(1)
            else
               zyget=y(ny)
            endif
         endif
      endif
      if((zget.lt.z(1)).or.(zget.gt.z(nz))) then
         zztol=4.0E-7_r8*max(abs(z(1)),abs(z(nz)))
         if((zget.lt.z(1)-zztol).or.(zget.gt.z(nz)+zztol)) then
            ier=1
            write(6,1003) zget,z(1),z(nz)
 1003       format(' ?herm3ev:  zget=',1pe11.4,' out of range ',
     >         1pe11.4,' to ',1pe11.4)
         else
            if((zget.lt.z(1)-0.5_r8*zztol).or.
     >         (zget.gt.z(nz)+0.5_r8*zztol))
     >      write(6,1013) zget,z(1),z(nz)
 1013       format(' %herm3ev:  zget=',1pe15.8,' beyond range ',
     >         1pe15.8,' to ',1pe15.8,' (fixup applied)')
            if(zget.lt.z(1)) then
               zzget=z(1)
            else
               zzget=z(nz)
            endif
         endif
      endif
      if(ier.ne.0) return
c
c  now find interval in which target point lies..
c
      nxm=nx-1
      nym=ny-1
      nzm=nz-1
c
      if(ilinx.eq.1) then
         ii=1+nxm*(zxget-x(1))/(x(nx)-x(1))
         i=min(nxm, ii)
         if(zxget.lt.x(i)) then
            i=i-1
         else if(zxget.gt.x(i+1)) then
            i=i+1
         endif
      else
         if((1.le.i).and.(i.lt.nxm)) then
            if((x(i).le.zxget).and.(zxget.le.x(i+1))) then
               continue  ! already have the zone
            else
               call r8zonfind(x,nx,zxget,i)
            endif
         else
            i=nx/2
            call r8zonfind(x,nx,zxget,i)
         endif
      endif
c
      if(iliny.eq.1) then
         jj=1+nym*(zyget-y(1))/(y(ny)-y(1))
         j=min(nym, jj)
         if(zyget.lt.y(j)) then
            j=j-1
         else if(zyget.gt.y(j+1)) then
            j=j+1
         endif
      else
         if((1.le.j).and.(j.lt.nym)) then
            if((y(j).le.zyget).and.(zyget.le.y(j+1))) then
               continue  ! already have the zone
            else
               call r8zonfind(y,ny,zyget,j)
            endif
         else
            j=ny/2
            call r8zonfind(y,ny,zyget,j)
         endif
      endif
c
      if(ilinz.eq.1) then
         kk=1+nzm*(zzget-z(1))/(z(nz)-z(1))
         k=min(nzm, kk)
         if(zzget.lt.z(k)) then
            k=k-1
         else if(zzget.gt.z(k+1)) then
            k=k+1
         endif
      else
         if((1.le.k).and.(k.lt.nzm)) then
            if((z(k).le.zzget).and.(zzget.le.z(k+1))) then
               continue  ! already have the zone
            else
               call r8zonfind(z,nz,zzget,k)
            endif
         else
            k=nz/2
            call r8zonfind(z,nz,zzget,k)
         endif
      endif
c
      hx=(x(i+1)-x(i))
      hy=(y(j+1)-y(j))
      hz=(z(k+1)-z(k))
c
      hxi=1.0_r8/hx
      hyi=1.0_r8/hy
      hzi=1.0_r8/hz
c
      xparam=(zxget-x(i))*hxi
      yparam=(zyget-y(j))*hyi
      zparam=(zzget-z(k))*hzi
c
      return
      end
C---------------------------------------------------------------------
C  evaluate C1 cubic Hermite function interpolation -- 3d fcn
C   --vectorized-- dmc 10 Feb 1999
C
      subroutine r8herm3fcn(ict,ivec,ivecd,
     >   fval,ii,jj,kk,xparam,yparam,zparam,
     >   hx,hxi,hy,hyi,hz,hzi,
     >   fin,inf2,inf3,nz)
C
!============
! idecl:  explicitize implicit INTEGER declarations:
      IMPLICIT NONE
      INTEGER, PARAMETER :: R8=SELECTED_REAL_KIND(12,100)
      INTEGER inf3,nz,inf2,i,j,k,iadr
!============
! idecl:  explicitize implicit REAL declarations:
      REAL*8 xp,xpi,xp2,xpi2,ax,axbar,bx,bxbar,yp,ypi,yp2,ypi2,ay
      REAL*8 aybar,by,bybar,zp,zpi,zp2,zpi2,az,azbar,bz,bzbar,axp
      REAL*8 axbarp,bxp,bxbarp,ayp,aybarp,byp,bybarp,azp,azbarp,bzp
      REAL*8 bzbarp
!============
      integer ict(8)                    ! requested output control
      integer ivec                      ! vector length
      integer ivecd                     ! vector dimension (1st dim of fval)
C
      integer ii(ivec),jj(ivec),kk(ivec) ! target cells (i,j,k)
      REAL*8 xparam(ivec),yparam(ivec),zparam(ivec)
                          ! normalized displacements from (i,j,k) corners
C
      REAL*8 hx(ivec),hy(ivec),hz(ivec)   ! grid spacing, and
      REAL*8 hxi(ivec),hyi(ivec),hzi(ivec) ! inverse grid spacing
           ! 1/(x(i+1)-x(i)) & 1/(y(j+1)-y(j)) & 1/(z(k+1)-z(i))
C
      REAL*8 fin(0:7,inf2,inf3,nz)        ! interpolant data (cf "herm3ev")
C
      REAL*8 fval(ivecd,*)                ! output returned
C
C  for detailed description of fin, ict and fval see subroutine herm3ev
C  comments.  Note ict is not vectorized; the same output
C  is expected to be returned for all input vector data points.
C
C  note that the index inputs ii,jj,kk and parameter inputs
C     xparam,yparam,zparam,hx,hxi,hy,hyi,hz,hzi are vectorized, and the
C     output array fval has a vector ** 1st dimension ** whose
C     size must be given as a separate argument
C
C  to use this routine in scalar mode, pass in ivec=ivecd=1
C
C---------------
C  Hermite cubic basis functions
C  -->for function value matching
C     a(0)=0 a(1)=1        a'(0)=0 a'(1)=0
C   abar(0)=1 abar(1)=0  abar'(0)=0 abar'(1)=0
C
C   a(x)=-2*x**3 + 3*x**2    = x*x*(-2.0*x+3.0)
C   abar(x)=1-a(x)
C   a'(x)=-abar'(x)          = 6.0*x*(1.0-x)
C
C  -->for derivative matching
C     b(0)=0 b(1)=0          b'(0)=0 b'(1)=1
C   bbar(0)=0 bbar(1)=0  bbar'(0)=1 bbar'(1)=0
C
C     b(x)=x**3-x**2         b'(x)=3*x**2-2*x
C     bbar(x)=x**3-2*x**2+x  bbar'(x)=3*x**2-4*x+1
C
      REAL*8 sum
      integer v
C
      do v=1,ivec
         i=ii(v)
         j=jj(v)
         k=kk(v)
C
C   ...in x direction
C
         xp=xparam(v)
         xpi=1.0_r8-xp
         xp2=xp*xp
         xpi2=xpi*xpi
         ax=xp2*(3.0_r8-2.0_r8*xp)
         axbar=1.0_r8-ax
         bx=-xp2*xpi
         bxbar=xpi2*xp
C
C   ...in y direction
C
         yp=yparam(v)
         ypi=1.0_r8-yp
         yp2=yp*yp
         ypi2=ypi*ypi
         ay=yp2*(3.0_r8-2.0_r8*yp)
         aybar=1.0_r8-ay
         by=-yp2*ypi
         bybar=ypi2*yp
C
C   ...in z direction
C
         zp=zparam(v)
         zpi=1.0_r8-zp
         zp2=zp*zp
         zpi2=zpi*zpi
         az=zp2*(3.0_r8-2.0_r8*zp)
         azbar=1.0_r8-az
         bz=-zp2*zpi
         bzbar=zpi2*zp
C
         iadr=0
C
C  derivatives:
C
         axp=6.0_r8*xp*xpi
         axbarp=-axp
         bxp=xp*(3.0_r8*xp-2.0_r8)
         bxbarp=xpi*(3.0_r8*xpi-2.0_r8)
C
         ayp=6.0_r8*yp*ypi
         aybarp=-ayp
         byp=yp*(3.0_r8*yp-2.0_r8)
         bybarp=ypi*(3.0_r8*ypi-2.0_r8)
C
         azp=6.0_r8*zp*zpi
         azbarp=-azp
         bzp=zp*(3.0_r8*zp-2.0_r8)
         bzbarp=zpi*(3.0_r8*zpi-2.0_r8)
C
C  get desired values:
C
         if(ict(1).eq.1) then
C
C  function value:
C
            iadr=iadr+1
            sum=azbar*(
     >         axbar*(aybar*fin(0,i,j,k)  +ay*fin(0,i,j+1,k))+
     >            ax*(aybar*fin(0,i+1,j,k)+ay*fin(0,i+1,j+1,k)))
     >          +  az*(
     >         axbar*(aybar*fin(0,i,j,k+1)  +ay*fin(0,i,j+1,k+1))+
     >            ax*(aybar*fin(0,i+1,j,k+1)+ay*fin(0,i+1,j+1,k+1)))
C
            sum=sum+hx(v)*(
     >         azbar*(
     >         bxbar*(aybar*fin(1,i,j,k)  +ay*fin(1,i,j+1,k))+
     >            bx*(aybar*fin(1,i+1,j,k)+ay*fin(1,i+1,j+1,k)))
     >          + az*(
     >         bxbar*(aybar*fin(1,i,j,k+1)  +ay*fin(1,i,j+1,k+1))+
     >            bx*(aybar*fin(1,i+1,j,k+1)+ay*fin(1,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hy(v)*(
     >         azbar*(
     >         axbar*(bybar*fin(2,i,j,k)  +by*fin(2,i,j+1,k))+
     >            ax*(bybar*fin(2,i+1,j,k)+by*fin(2,i+1,j+1,k)))
     >          + az*(
     >         axbar*(bybar*fin(2,i,j,k+1)  +by*fin(2,i,j+1,k+1))+
     >            ax*(bybar*fin(2,i+1,j,k+1)+by*fin(2,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hz(v)*(
     >         bzbar*(
     >         axbar*(aybar*fin(3,i,j,k)  +ay*fin(3,i,j+1,k))+
     >            ax*(aybar*fin(3,i+1,j,k)+ay*fin(3,i+1,j+1,k)))
     >          + bz*(
     >         axbar*(aybar*fin(3,i,j,k+1)  +ay*fin(3,i,j+1,k+1))+
     >            ax*(aybar*fin(3,i+1,j,k+1)+ay*fin(3,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*hy(v)*(
     >         azbar*(
     >         bxbar*(bybar*fin(4,i,j,k)  +by*fin(4,i,j+1,k))+
     >            bx*(bybar*fin(4,i+1,j,k)+by*fin(4,i+1,j+1,k)))
     >          + az*(
     >         bxbar*(bybar*fin(4,i,j,k+1)  +by*fin(4,i,j+1,k+1))+
     >            bx*(bybar*fin(4,i+1,j,k+1)+by*fin(4,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*hz(v)*(
     >         bzbar*(
     >         bxbar*(aybar*fin(5,i,j,k)  +ay*fin(5,i,j+1,k))+
     >            bx*(aybar*fin(5,i+1,j,k)+ay*fin(5,i+1,j+1,k)))
     >          + bz*(
     >         bxbar*(aybar*fin(5,i,j,k+1)  +ay*fin(5,i,j+1,k+1))+
     >            bx*(aybar*fin(5,i+1,j,k+1)+ay*fin(5,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hy(v)*hz(v)*(
     >         bzbar*(
     >         axbar*(bybar*fin(6,i,j,k)  +by*fin(6,i,j+1,k))+
     >            ax*(bybar*fin(6,i+1,j,k)+by*fin(6,i+1,j+1,k)))
     >          + bz*(
     >         axbar*(bybar*fin(6,i,j,k+1)  +by*fin(6,i,j+1,k+1))+
     >            ax*(bybar*fin(6,i+1,j,k+1)+by*fin(6,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*hy(v)*hz(v)*(
     >         bzbar*(
     >         bxbar*(bybar*fin(7,i,j,k)  +by*fin(7,i,j+1,k))+
     >            bx*(bybar*fin(7,i+1,j,k)+by*fin(7,i+1,j+1,k)))
     >          + bz*(
     >         bxbar*(bybar*fin(7,i,j,k+1)  +by*fin(7,i,j+1,k+1))+
     >            bx*(bybar*fin(7,i+1,j,k+1)+by*fin(7,i+1,j+1,k+1)))
     >         )
C
            fval(v,iadr)=sum
         endif
C
         if(ict(2).eq.1) then
C
C     df/dx:
C
            iadr=iadr+1
C
            sum=hxi(v)*(
     >          azbar*(
     >         axbarp*(aybar*fin(0,i,j,k)  +ay*fin(0,i,j+1,k))+
     >            axp*(aybar*fin(0,i+1,j,k)+ay*fin(0,i+1,j+1,k)))
     >          +  az*(
     >         axbarp*(aybar*fin(0,i,j,k+1)  +ay*fin(0,i,j+1,k+1))+
     >            axp*(aybar*fin(0,i+1,j,k+1)+ay*fin(0,i+1,j+1,k+1)))
     >         )
C
            sum=sum+(
     >         azbar*(
     >         bxbarp*(aybar*fin(1,i,j,k)  +ay*fin(1,i,j+1,k))+
     >            bxp*(aybar*fin(1,i+1,j,k)+ay*fin(1,i+1,j+1,k)))
     >          + az*(
     >         bxbarp*(aybar*fin(1,i,j,k+1)  +ay*fin(1,i,j+1,k+1))+
     >            bxp*(aybar*fin(1,i+1,j,k+1)+ay*fin(1,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*hy(v)*(
     >         azbar*(
     >         axbarp*(bybar*fin(2,i,j,k)  +by*fin(2,i,j+1,k))+
     >            axp*(bybar*fin(2,i+1,j,k)+by*fin(2,i+1,j+1,k)))
     >          + az*(
     >         axbarp*(bybar*fin(2,i,j,k+1)  +by*fin(2,i,j+1,k+1))+
     >            axp*(bybar*fin(2,i+1,j,k+1)+by*fin(2,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*hz(v)*(
     >         bzbar*(
     >         axbarp*(aybar*fin(3,i,j,k)  +ay*fin(3,i,j+1,k))+
     >            axp*(aybar*fin(3,i+1,j,k)+ay*fin(3,i+1,j+1,k)))
     >          + bz*(
     >         axbarp*(aybar*fin(3,i,j,k+1)  +ay*fin(3,i,j+1,k+1))+
     >            axp*(aybar*fin(3,i+1,j,k+1)+ay*fin(3,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hy(v)*(
     >         azbar*(
     >         bxbarp*(bybar*fin(4,i,j,k)  +by*fin(4,i,j+1,k))+
     >            bxp*(bybar*fin(4,i+1,j,k)+by*fin(4,i+1,j+1,k)))
     >          + az*(
     >         bxbarp*(bybar*fin(4,i,j,k+1)  +by*fin(4,i,j+1,k+1))+
     >            bxp*(bybar*fin(4,i+1,j,k+1)+by*fin(4,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hz(v)*(
     >         bzbar*(
     >         bxbarp*(aybar*fin(5,i,j,k)  +ay*fin(5,i,j+1,k))+
     >            bxp*(aybar*fin(5,i+1,j,k)+ay*fin(5,i+1,j+1,k)))
     >          + bz*(
     >         bxbarp*(aybar*fin(5,i,j,k+1)  +ay*fin(5,i,j+1,k+1))+
     >            bxp*(aybar*fin(5,i+1,j,k+1)+ay*fin(5,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*hy(v)*hz(v)*(
     >         bzbar*(
     >         axbarp*(bybar*fin(6,i,j,k)  +by*fin(6,i,j+1,k))+
     >            axp*(bybar*fin(6,i+1,j,k)+by*fin(6,i+1,j+1,k)))
     >          + bz*(
     >         axbarp*(bybar*fin(6,i,j,k+1)  +by*fin(6,i,j+1,k+1))+
     >            axp*(bybar*fin(6,i+1,j,k+1)+by*fin(6,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hy(v)*hz(v)*(
     >         bzbar*(
     >         bxbarp*(bybar*fin(7,i,j,k)  +by*fin(7,i,j+1,k))+
     >            bxp*(bybar*fin(7,i+1,j,k)+by*fin(7,i+1,j+1,k)))
     >          + bz*(
     >         bxbarp*(bybar*fin(7,i,j,k+1)  +by*fin(7,i,j+1,k+1))+
     >            bxp*(bybar*fin(7,i+1,j,k+1)+by*fin(7,i+1,j+1,k+1)))
     >         )
C
            fval(v,iadr)=sum
         endif
C
         if(ict(3).eq.1) then
C
C  df/dy:
C
            iadr=iadr+1
C
            sum=hyi(v)*(
     >          azbar*(
     >         axbar*(aybarp*fin(0,i,j,k)  +ayp*fin(0,i,j+1,k))+
     >            ax*(aybarp*fin(0,i+1,j,k)+ayp*fin(0,i+1,j+1,k)))
     >          +  az*(
     >         axbar*(aybarp*fin(0,i,j,k+1)  +ayp*fin(0,i,j+1,k+1))+
     >            ax*(aybarp*fin(0,i+1,j,k+1)+ayp*fin(0,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hyi(v)*hx(v)*(
     >         azbar*(
     >         bxbar*(aybarp*fin(1,i,j,k)  +ayp*fin(1,i,j+1,k))+
     >            bx*(aybarp*fin(1,i+1,j,k)+ayp*fin(1,i+1,j+1,k)))
     >          + az*(
     >         bxbar*(aybarp*fin(1,i,j,k+1)  +ayp*fin(1,i,j+1,k+1))+
     >            bx*(aybarp*fin(1,i+1,j,k+1)+ayp*fin(1,i+1,j+1,k+1)))
     >         )
C
            sum=sum+(
     >         azbar*(
     >         axbar*(bybarp*fin(2,i,j,k)  +byp*fin(2,i,j+1,k))+
     >            ax*(bybarp*fin(2,i+1,j,k)+byp*fin(2,i+1,j+1,k)))
     >          + az*(
     >         axbar*(bybarp*fin(2,i,j,k+1)  +byp*fin(2,i,j+1,k+1))+
     >            ax*(bybarp*fin(2,i+1,j,k+1)+byp*fin(2,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hyi(v)*hz(v)*(
     >         bzbar*(
     >         axbar*(aybarp*fin(3,i,j,k)  +ayp*fin(3,i,j+1,k))+
     >            ax*(aybarp*fin(3,i+1,j,k)+ayp*fin(3,i+1,j+1,k)))
     >          + bz*(
     >         axbar*(aybarp*fin(3,i,j,k+1)  +ayp*fin(3,i,j+1,k+1))+
     >            ax*(aybarp*fin(3,i+1,j,k+1)+ayp*fin(3,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*(
     >         azbar*(
     >         bxbar*(bybarp*fin(4,i,j,k)  +byp*fin(4,i,j+1,k))+
     >            bx*(bybarp*fin(4,i+1,j,k)+byp*fin(4,i+1,j+1,k)))
     >          + az*(
     >         bxbar*(bybarp*fin(4,i,j,k+1)  +byp*fin(4,i,j+1,k+1))+
     >            bx*(bybarp*fin(4,i+1,j,k+1)+byp*fin(4,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*hyi(v)*hz(v)*(
     >         bzbar*(
     >         bxbar*(aybarp*fin(5,i,j,k)  +ayp*fin(5,i,j+1,k))+
     >            bx*(aybarp*fin(5,i+1,j,k)+ayp*fin(5,i+1,j+1,k)))
     >          + bz*(
     >         bxbar*(aybarp*fin(5,i,j,k+1)  +ayp*fin(5,i,j+1,k+1))+
     >            bx*(aybarp*fin(5,i+1,j,k+1)+ayp*fin(5,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hz(v)*(
     >         bzbar*(
     >         axbar*(bybarp*fin(6,i,j,k)  +byp*fin(6,i,j+1,k))+
     >            ax*(bybarp*fin(6,i+1,j,k)+byp*fin(6,i+1,j+1,k)))
     >          + bz*(
     >         axbar*(bybarp*fin(6,i,j,k+1)  +byp*fin(6,i,j+1,k+1))+
     >            ax*(bybarp*fin(6,i+1,j,k+1)+byp*fin(6,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*hz(v)*(
     >         bzbar*(
     >         bxbar*(bybarp*fin(7,i,j,k)  +byp*fin(7,i,j+1,k))+
     >            bx*(bybarp*fin(7,i+1,j,k)+byp*fin(7,i+1,j+1,k)))
     >          + bz*(
     >         bxbar*(bybarp*fin(7,i,j,k+1)  +byp*fin(7,i,j+1,k+1))+
     >            bx*(bybarp*fin(7,i+1,j,k+1)+byp*fin(7,i+1,j+1,k+1)))
     >         )
C
            fval(v,iadr)=sum
         endif
C
         if(ict(4).eq.1) then
C
C  df/dz:
C
            iadr=iadr+1
C
            sum=hzi(v)*(
     >          azbarp*(
     >         axbar*(aybar*fin(0,i,j,k)  +ay*fin(0,i,j+1,k))+
     >            ax*(aybar*fin(0,i+1,j,k)+ay*fin(0,i+1,j+1,k)))
     >          +  azp*(
     >         axbar*(aybar*fin(0,i,j,k+1)  +ay*fin(0,i,j+1,k+1))+
     >            ax*(aybar*fin(0,i+1,j,k+1)+ay*fin(0,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hzi(v)*hx(v)*(
     >         azbarp*(
     >         bxbar*(aybar*fin(1,i,j,k)  +ay*fin(1,i,j+1,k))+
     >            bx*(aybar*fin(1,i+1,j,k)+ay*fin(1,i+1,j+1,k)))
     >          + azp*(
     >         bxbar*(aybar*fin(1,i,j,k+1)  +ay*fin(1,i,j+1,k+1))+
     >            bx*(aybar*fin(1,i+1,j,k+1)+ay*fin(1,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hzi(v)*hy(v)*(
     >         azbarp*(
     >         axbar*(bybar*fin(2,i,j,k)  +by*fin(2,i,j+1,k))+
     >            ax*(bybar*fin(2,i+1,j,k)+by*fin(2,i+1,j+1,k)))
     >          + azp*(
     >         axbar*(bybar*fin(2,i,j,k+1)  +by*fin(2,i,j+1,k+1))+
     >            ax*(bybar*fin(2,i+1,j,k+1)+by*fin(2,i+1,j+1,k+1)))
     >         )
C
            sum=sum+(
     >         bzbarp*(
     >         axbar*(aybar*fin(3,i,j,k)  +ay*fin(3,i,j+1,k))+
     >            ax*(aybar*fin(3,i+1,j,k)+ay*fin(3,i+1,j+1,k)))
     >          + bzp*(
     >         axbar*(aybar*fin(3,i,j,k+1)  +ay*fin(3,i,j+1,k+1))+
     >            ax*(aybar*fin(3,i+1,j,k+1)+ay*fin(3,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hzi(v)*hx(v)*hy(v)*(
     >         azbarp*(
     >         bxbar*(bybar*fin(4,i,j,k)  +by*fin(4,i,j+1,k))+
     >            bx*(bybar*fin(4,i+1,j,k)+by*fin(4,i+1,j+1,k)))
     >          + azp*(
     >         bxbar*(bybar*fin(4,i,j,k+1)  +by*fin(4,i,j+1,k+1))+
     >            bx*(bybar*fin(4,i+1,j,k+1)+by*fin(4,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*(
     >         bzbarp*(
     >         bxbar*(aybar*fin(5,i,j,k)  +ay*fin(5,i,j+1,k))+
     >            bx*(aybar*fin(5,i+1,j,k)+ay*fin(5,i+1,j+1,k)))
     >          + bzp*(
     >         bxbar*(aybar*fin(5,i,j,k+1)  +ay*fin(5,i,j+1,k+1))+
     >            bx*(aybar*fin(5,i+1,j,k+1)+ay*fin(5,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hy(v)*(
     >         bzbarp*(
     >         axbar*(bybar*fin(6,i,j,k)  +by*fin(6,i,j+1,k))+
     >            ax*(bybar*fin(6,i+1,j,k)+by*fin(6,i+1,j+1,k)))
     >          + bzp*(
     >         axbar*(bybar*fin(6,i,j,k+1)  +by*fin(6,i,j+1,k+1))+
     >            ax*(bybar*fin(6,i+1,j,k+1)+by*fin(6,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*hy(v)*(
     >         bzbarp*(
     >         bxbar*(bybar*fin(7,i,j,k)  +by*fin(7,i,j+1,k))+
     >            bx*(bybar*fin(7,i+1,j,k)+by*fin(7,i+1,j+1,k)))
     >          + bzp*(
     >         bxbar*(bybar*fin(7,i,j,k+1)  +by*fin(7,i,j+1,k+1))+
     >            bx*(bybar*fin(7,i+1,j,k+1)+by*fin(7,i+1,j+1,k+1)))
     >         )
C
            fval(v,iadr)=sum
         endif
C
         if(ict(5).eq.1) then
C
C  d2f/dxdy:
C
            iadr=iadr+1
C
            sum=hxi(v)*hyi(v)*(
     >          azbar*(
     >         axbarp*(aybarp*fin(0,i,j,k)  +ayp*fin(0,i,j+1,k))+
     >            axp*(aybarp*fin(0,i+1,j,k)+ayp*fin(0,i+1,j+1,k)))
     >          +  az*(
     >         axbarp*(aybarp*fin(0,i,j,k+1)  +ayp*fin(0,i,j+1,k+1))+
     >            axp*(aybarp*fin(0,i+1,j,k+1)+ayp*fin(0,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hyi(v)*(
     >         azbar*(
     >         bxbarp*(aybarp*fin(1,i,j,k)  +ayp*fin(1,i,j+1,k))+
     >            bxp*(aybarp*fin(1,i+1,j,k)+ayp*fin(1,i+1,j+1,k)))
     >          + az*(
     >         bxbarp*(aybarp*fin(1,i,j,k+1)  +ayp*fin(1,i,j+1,k+1))+
     >            bxp*(aybarp*fin(1,i+1,j,k+1)+ayp*fin(1,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*(
     >         azbar*(
     >         axbarp*(bybarp*fin(2,i,j,k)  +byp*fin(2,i,j+1,k))+
     >            axp*(bybarp*fin(2,i+1,j,k)+byp*fin(2,i+1,j+1,k)))
     >          + az*(
     >         axbarp*(bybarp*fin(2,i,j,k+1)  +byp*fin(2,i,j+1,k+1))+
     >            axp*(bybarp*fin(2,i+1,j,k+1)+byp*fin(2,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*hyi(v)*hz(v)*(
     >         bzbar*(
     >         axbarp*(aybarp*fin(3,i,j,k)  +ayp*fin(3,i,j+1,k))+
     >            axp*(aybarp*fin(3,i+1,j,k)+ayp*fin(3,i+1,j+1,k)))
     >          + bz*(
     >         axbarp*(aybarp*fin(3,i,j,k+1)  +ayp*fin(3,i,j+1,k+1))+
     >            axp*(aybarp*fin(3,i+1,j,k+1)+ayp*fin(3,i+1,j+1,k+1)))
     >         )
C
            sum=sum+(
     >         azbar*(
     >         bxbarp*(bybarp*fin(4,i,j,k)  +byp*fin(4,i,j+1,k))+
     >            bxp*(bybarp*fin(4,i+1,j,k)+byp*fin(4,i+1,j+1,k)))
     >          + az*(
     >         bxbarp*(bybarp*fin(4,i,j,k+1)  +byp*fin(4,i,j+1,k+1))+
     >            bxp*(bybarp*fin(4,i+1,j,k+1)+byp*fin(4,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hyi(v)*hz(v)*(
     >         bzbar*(
     >         bxbarp*(aybarp*fin(5,i,j,k)  +ayp*fin(5,i,j+1,k))+
     >            bxp*(aybarp*fin(5,i+1,j,k)+ayp*fin(5,i+1,j+1,k)))
     >          + bz*(
     >         bxbarp*(aybarp*fin(5,i,j,k+1)  +ayp*fin(5,i,j+1,k+1))+
     >            bxp*(aybarp*fin(5,i+1,j,k+1)+ayp*fin(5,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*hz(v)*(
     >         bzbar*(
     >         axbarp*(bybarp*fin(6,i,j,k)  +byp*fin(6,i,j+1,k))+
     >            axp*(bybarp*fin(6,i+1,j,k)+byp*fin(6,i+1,j+1,k)))
     >          + bz*(
     >         axbarp*(bybarp*fin(6,i,j,k+1)  +byp*fin(6,i,j+1,k+1))+
     >            axp*(bybarp*fin(6,i+1,j,k+1)+byp*fin(6,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hz(v)*(
     >         bzbar*(
     >         bxbarp*(bybarp*fin(7,i,j,k)  +byp*fin(7,i,j+1,k))+
     >            bxp*(bybarp*fin(7,i+1,j,k)+byp*fin(7,i+1,j+1,k)))
     >          + bz*(
     >         bxbarp*(bybarp*fin(7,i,j,k+1)  +byp*fin(7,i,j+1,k+1))+
     >            bxp*(bybarp*fin(7,i+1,j,k+1)+byp*fin(7,i+1,j+1,k+1)))
     >         )
C
            fval(v,iadr)=sum
         endif
C
         if(ict(6).eq.1) then
C
C  d2f/dxdz:
C
            iadr=iadr+1
C
            sum=hxi(v)*hzi(v)*(
     >          azbarp*(
     >         axbarp*(aybar*fin(0,i,j,k)  +ay*fin(0,i,j+1,k))+
     >            axp*(aybar*fin(0,i+1,j,k)+ay*fin(0,i+1,j+1,k)))
     >          +  azp*(
     >         axbarp*(aybar*fin(0,i,j,k+1)  +ay*fin(0,i,j+1,k+1))+
     >            axp*(aybar*fin(0,i+1,j,k+1)+ay*fin(0,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hzi(v)*(
     >         azbarp*(
     >         bxbarp*(aybar*fin(1,i,j,k)  +ay*fin(1,i,j+1,k))+
     >            bxp*(aybar*fin(1,i+1,j,k)+ay*fin(1,i+1,j+1,k)))
     >          + azp*(
     >         bxbarp*(aybar*fin(1,i,j,k+1)  +ay*fin(1,i,j+1,k+1))+
     >            bxp*(aybar*fin(1,i+1,j,k+1)+ay*fin(1,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*hy(v)*hzi(v)*(
     >         azbarp*(
     >         axbarp*(bybar*fin(2,i,j,k)  +by*fin(2,i,j+1,k))+
     >            axp*(bybar*fin(2,i+1,j,k)+by*fin(2,i+1,j+1,k)))
     >          + azp*(
     >         axbarp*(bybar*fin(2,i,j,k+1)  +by*fin(2,i,j+1,k+1))+
     >            axp*(bybar*fin(2,i+1,j,k+1)+by*fin(2,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*(
     >         bzbarp*(
     >         axbarp*(aybar*fin(3,i,j,k)  +ay*fin(3,i,j+1,k))+
     >            axp*(aybar*fin(3,i+1,j,k)+ay*fin(3,i+1,j+1,k)))
     >          + bzp*(
     >         axbarp*(aybar*fin(3,i,j,k+1)  +ay*fin(3,i,j+1,k+1))+
     >            axp*(aybar*fin(3,i+1,j,k+1)+ay*fin(3,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hy(v)*hzi(v)*(
     >         azbarp*(
     >         bxbarp*(bybar*fin(4,i,j,k)  +by*fin(4,i,j+1,k))+
     >            bxp*(bybar*fin(4,i+1,j,k)+by*fin(4,i+1,j+1,k)))
     >          + azp*(
     >         bxbarp*(bybar*fin(4,i,j,k+1)  +by*fin(4,i,j+1,k+1))+
     >            bxp*(bybar*fin(4,i+1,j,k+1)+by*fin(4,i+1,j+1,k+1)))
     >         )
C
            sum=sum+(
     >         bzbarp*(
     >         bxbarp*(aybar*fin(5,i,j,k)  +ay*fin(5,i,j+1,k))+
     >            bxp*(aybar*fin(5,i+1,j,k)+ay*fin(5,i+1,j+1,k)))
     >          + bzp*(
     >         bxbarp*(aybar*fin(5,i,j,k+1)  +ay*fin(5,i,j+1,k+1))+
     >            bxp*(aybar*fin(5,i+1,j,k+1)+ay*fin(5,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*hy(v)*(
     >         bzbarp*(
     >         axbarp*(bybar*fin(6,i,j,k)  +by*fin(6,i,j+1,k))+
     >            axp*(bybar*fin(6,i+1,j,k)+by*fin(6,i+1,j+1,k)))
     >          + bzp*(
     >         axbarp*(bybar*fin(6,i,j,k+1)  +by*fin(6,i,j+1,k+1))+
     >            axp*(bybar*fin(6,i+1,j,k+1)+by*fin(6,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hy(v)*(
     >         bzbarp*(
     >         bxbarp*(bybar*fin(7,i,j,k)  +by*fin(7,i,j+1,k))+
     >            bxp*(bybar*fin(7,i+1,j,k)+by*fin(7,i+1,j+1,k)))
     >          + bzp*(
     >         bxbarp*(bybar*fin(7,i,j,k+1)  +by*fin(7,i,j+1,k+1))+
     >            bxp*(bybar*fin(7,i+1,j,k+1)+by*fin(7,i+1,j+1,k+1)))
     >         )
C
            fval(v,iadr)=sum
         endif
C
         if(ict(7).eq.1) then
C
C  d2f/dydz:
C
            iadr=iadr+1
C
            sum=hyi(v)*hzi(v)*(
     >          azbarp*(
     >         axbar*(aybarp*fin(0,i,j,k)  +ayp*fin(0,i,j+1,k))+
     >            ax*(aybarp*fin(0,i+1,j,k)+ayp*fin(0,i+1,j+1,k)))
     >          +  azp*(
     >         axbar*(aybarp*fin(0,i,j,k+1)  +ayp*fin(0,i,j+1,k+1))+
     >            ax*(aybarp*fin(0,i+1,j,k+1)+ayp*fin(0,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hyi(v)*hzi(v)*hx(v)*(
     >         azbarp*(
     >         bxbar*(aybarp*fin(1,i,j,k)  +ayp*fin(1,i,j+1,k))+
     >            bx*(aybarp*fin(1,i+1,j,k)+ayp*fin(1,i+1,j+1,k)))
     >          + azp*(
     >         bxbar*(aybarp*fin(1,i,j,k+1)  +ayp*fin(1,i,j+1,k+1))+
     >            bx*(aybarp*fin(1,i+1,j,k+1)+ayp*fin(1,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hzi(v)*(
     >         azbarp*(
     >         axbar*(bybarp*fin(2,i,j,k)  +byp*fin(2,i,j+1,k))+
     >            ax*(bybarp*fin(2,i+1,j,k)+byp*fin(2,i+1,j+1,k)))
     >          + azp*(
     >         axbar*(bybarp*fin(2,i,j,k+1)  +byp*fin(2,i,j+1,k+1))+
     >            ax*(bybarp*fin(2,i+1,j,k+1)+byp*fin(2,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hyi(v)*(
     >         bzbarp*(
     >         axbar*(aybarp*fin(3,i,j,k)  +ayp*fin(3,i,j+1,k))+
     >            ax*(aybarp*fin(3,i+1,j,k)+ayp*fin(3,i+1,j+1,k)))
     >          + bzp*(
     >         axbar*(aybarp*fin(3,i,j,k+1)  +ayp*fin(3,i,j+1,k+1))+
     >            ax*(aybarp*fin(3,i+1,j,k+1)+ayp*fin(3,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*hzi(v)*(
     >         azbarp*(
     >         bxbar*(bybarp*fin(4,i,j,k)  +byp*fin(4,i,j+1,k))+
     >            bx*(bybarp*fin(4,i+1,j,k)+byp*fin(4,i+1,j+1,k)))
     >          + azp*(
     >         bxbar*(bybarp*fin(4,i,j,k+1)  +byp*fin(4,i,j+1,k+1))+
     >            bx*(bybarp*fin(4,i+1,j,k+1)+byp*fin(4,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*hyi(v)*(
     >         bzbarp*(
     >         bxbar*(aybarp*fin(5,i,j,k)  +ayp*fin(5,i,j+1,k))+
     >            bx*(aybarp*fin(5,i+1,j,k)+ayp*fin(5,i+1,j+1,k)))
     >          + bzp*(
     >         bxbar*(aybarp*fin(5,i,j,k+1)  +ayp*fin(5,i,j+1,k+1))+
     >            bx*(aybarp*fin(5,i+1,j,k+1)+ayp*fin(5,i+1,j+1,k+1)))
     >         )
C
            sum=sum+(
     >         bzbarp*(
     >         axbar*(bybarp*fin(6,i,j,k)  +byp*fin(6,i,j+1,k))+
     >            ax*(bybarp*fin(6,i+1,j,k)+byp*fin(6,i+1,j+1,k)))
     >          + bzp*(
     >         axbar*(bybarp*fin(6,i,j,k+1)  +byp*fin(6,i,j+1,k+1))+
     >            ax*(bybarp*fin(6,i+1,j,k+1)+byp*fin(6,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*(
     >         bzbarp*(
     >         bxbar*(bybarp*fin(7,i,j,k)  +byp*fin(7,i,j+1,k))+
     >            bx*(bybarp*fin(7,i+1,j,k)+byp*fin(7,i+1,j+1,k)))
     >          + bzp*(
     >         bxbar*(bybarp*fin(7,i,j,k+1)  +byp*fin(7,i,j+1,k+1))+
     >            bx*(bybarp*fin(7,i+1,j,k+1)+byp*fin(7,i+1,j+1,k+1)))
     >         )
C
            fval(v,iadr)=sum
         endif
C
         if(ict(8).eq.1) then
C
C  d3f/dxdydz:
C
            iadr=iadr+1
C
            sum=hxi(v)*hyi(v)*hzi(v)*(
     >          azbarp*(
     >         axbarp*(aybarp*fin(0,i,j,k)  +ayp*fin(0,i,j+1,k))+
     >            axp*(aybarp*fin(0,i+1,j,k)+ayp*fin(0,i+1,j+1,k)))
     >          +  azp*(
     >         axbarp*(aybarp*fin(0,i,j,k+1)  +ayp*fin(0,i,j+1,k+1))+
     >            axp*(aybarp*fin(0,i+1,j,k+1)+ayp*fin(0,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hyi(v)*hzi(v)*(
     >         azbarp*(
     >         bxbarp*(aybarp*fin(1,i,j,k)  +ayp*fin(1,i,j+1,k))+
     >            bxp*(aybarp*fin(1,i+1,j,k)+ayp*fin(1,i+1,j+1,k)))
     >          + azp*(
     >         bxbarp*(aybarp*fin(1,i,j,k+1)  +ayp*fin(1,i,j+1,k+1))+
     >            bxp*(aybarp*fin(1,i+1,j,k+1)+ayp*fin(1,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*hzi(v)*(
     >         azbarp*(
     >         axbarp*(bybarp*fin(2,i,j,k)  +byp*fin(2,i,j+1,k))+
     >            axp*(bybarp*fin(2,i+1,j,k)+byp*fin(2,i+1,j+1,k)))
     >          + azp*(
     >         axbarp*(bybarp*fin(2,i,j,k+1)  +byp*fin(2,i,j+1,k+1))+
     >            axp*(bybarp*fin(2,i+1,j,k+1)+byp*fin(2,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*hyi(v)*(
     >         bzbarp*(
     >         axbarp*(aybarp*fin(3,i,j,k)  +ayp*fin(3,i,j+1,k))+
     >            axp*(aybarp*fin(3,i+1,j,k)+ayp*fin(3,i+1,j+1,k)))
     >          + bzp*(
     >         axbarp*(aybarp*fin(3,i,j,k+1)  +ayp*fin(3,i,j+1,k+1))+
     >            axp*(aybarp*fin(3,i+1,j,k+1)+ayp*fin(3,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hzi(v)*(
     >         azbarp*(
     >         bxbarp*(bybarp*fin(4,i,j,k)  +byp*fin(4,i,j+1,k))+
     >            bxp*(bybarp*fin(4,i+1,j,k)+byp*fin(4,i+1,j+1,k)))
     >          + azp*(
     >         bxbarp*(bybarp*fin(4,i,j,k+1)  +byp*fin(4,i,j+1,k+1))+
     >            bxp*(bybarp*fin(4,i+1,j,k+1)+byp*fin(4,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hyi(v)*(
     >         bzbarp*(
     >         bxbarp*(aybarp*fin(5,i,j,k)  +ayp*fin(5,i,j+1,k))+
     >            bxp*(aybarp*fin(5,i+1,j,k)+ayp*fin(5,i+1,j+1,k)))
     >          + bzp*(
     >         bxbarp*(aybarp*fin(5,i,j,k+1)  +ayp*fin(5,i,j+1,k+1))+
     >            bxp*(aybarp*fin(5,i+1,j,k+1)+ayp*fin(5,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*(
     >         bzbarp*(
     >         axbarp*(bybarp*fin(6,i,j,k)  +byp*fin(6,i,j+1,k))+
     >            axp*(bybarp*fin(6,i+1,j,k)+byp*fin(6,i+1,j+1,k)))
     >          + bzp*(
     >         axbarp*(bybarp*fin(6,i,j,k+1)  +byp*fin(6,i,j+1,k+1))+
     >            axp*(bybarp*fin(6,i+1,j,k+1)+byp*fin(6,i+1,j+1,k+1)))
     >         )
C
            sum=sum+(
     >         bzbarp*(
     >         bxbarp*(bybarp*fin(7,i,j,k)  +byp*fin(7,i,j+1,k))+
     >            bxp*(bybarp*fin(7,i+1,j,k)+byp*fin(7,i+1,j+1,k)))
     >          + bzp*(
     >         bxbarp*(bybarp*fin(7,i,j,k+1)  +byp*fin(7,i,j+1,k+1))+
     >            bxp*(bybarp*fin(7,i+1,j,k+1)+byp*fin(7,i+1,j+1,k+1)))
     >         )
C
            fval(v,iadr)=sum
         endif
C
      enddo                             ! vector loop
C
      return
      end
C---------------------------------------------------------------------
C  evaluate C1 cubic Hermite function interpolation -- 3d fcn
C   --vectorized-- dmc 10 Feb 1999
C    --optimized for VARIATION along x axis ONLY--
C
      subroutine r8herm3fcnx(ict,ivec,ivecd,
     >   fval,ii,jj,kk,xparam,yparam,zparam,
     >   hx,hxi,hy,hyi,hz,hzi,
     >   fin,inf2,inf3,nz)
C
!============
! idecl:  explicitize implicit INTEGER declarations:
      IMPLICIT NONE
      INTEGER, PARAMETER :: R8=SELECTED_REAL_KIND(12,100)
      INTEGER inf3,nz,inf2,j,k,i,iadr
!============
! idecl:  explicitize implicit REAL declarations:
      REAL*8 yp,ypi,yp2,ypi2,ay,aybar,by,bybar,zp,zpi,zp2,zpi2,az
      REAL*8 azbar,bz,bzbar,ayp,aybarp,byp,bybarp,azp,azbarp,bzp
      REAL*8 bzbarp,xp,xpi,xp2,xpi2,ax,axbar,bx,bxbar,axp,axbarp
      REAL*8 bxp,bxbarp
!============
      integer ict(8)                    ! requested output control
      integer ivec                      ! vector length
      integer ivecd                     ! vector dimension (1st dim of fval)
C
      integer ii(ivec),jj,kk            ! target cells (i,j,k)
      REAL*8 xparam(ivec),yparam,zparam
                          ! normalized displacements from (i,j,k) corners
C
      REAL*8 hx(ivec),hy,hz               ! grid spacing, and
      REAL*8 hxi(ivec),hyi,hzi            ! inverse grid spacing
           ! 1/(x(i+1)-x(i)) & 1/(y(j+1)-y(j)) & 1/(z(k+1)-z(i))
C
      REAL*8 fin(0:7,inf2,inf3,nz)        ! interpolant data (cf "herm3ev")
C
      REAL*8 fval(ivecd,*)                ! output returned
C
C  for detailed description of fin, ict and fval see subroutine herm3ev
C  comments.  Note ict is not vectorized; the same output
C  is expected to be returned for all input vector data points.
C
C  note that the index inputs ii,jj,kk and parameter inputs
C     xparam,yparam,zparam,hx,hxi,hy,hyi,hz,hzi are vectorized, and the
C     output array fval has a vector ** 1st dimension ** whose
C     size must be given as a separate argument
C
C  to use this routine in scalar mode, pass in ivec=ivecd=1
C
C---------------
C  Hermite cubic basis functions
C  -->for function value matching
C     a(0)=0 a(1)=1        a'(0)=0 a'(1)=0
C   abar(0)=1 abar(1)=0  abar'(0)=0 abar'(1)=0
C
C   a(x)=-2*x**3 + 3*x**2    = x*x*(-2.0*x+3.0)
C   abar(x)=1-a(x)
C   a'(x)=-abar'(x)          = 6.0*x*(1.0-x)
C
C  -->for derivative matching
C     b(0)=0 b(1)=0          b'(0)=0 b'(1)=1
C   bbar(0)=0 bbar(1)=0  bbar'(0)=1 bbar'(1)=0
C
C     b(x)=x**3-x**2         b'(x)=3*x**2-2*x
C     bbar(x)=x**3-2*x**2+x  bbar'(x)=3*x**2-4*x+1
C
      REAL*8 sum
      integer v
C
      j=jj
      k=kk
C
C   ...in y direction
C
      yp=yparam
      ypi=1.0_r8-yp
      yp2=yp*yp
      ypi2=ypi*ypi
      ay=yp2*(3.0_r8-2.0_r8*yp)
      aybar=1.0_r8-ay
      by=-yp2*ypi
      bybar=ypi2*yp
C
C   ...in z direction
C
      zp=zparam
      zpi=1.0_r8-zp
      zp2=zp*zp
      zpi2=zpi*zpi
      az=zp2*(3.0_r8-2.0_r8*zp)
      azbar=1.0_r8-az
      bz=-zp2*zpi
      bzbar=zpi2*zp
C
C  derivatives
C
      ayp=6.0_r8*yp*ypi
      aybarp=-ayp
      byp=yp*(3.0_r8*yp-2.0_r8)
      bybarp=ypi*(3.0_r8*ypi-2.0_r8)
C
      azp=6.0_r8*zp*zpi
      azbarp=-azp
      bzp=zp*(3.0_r8*zp-2.0_r8)
      bzbarp=zpi*(3.0_r8*zpi-2.0_r8)

      do v=1,ivec
         i=ii(v)
C
C   ...in x direction
C
         xp=xparam(v)
         xpi=1.0_r8-xp
         xp2=xp*xp
         xpi2=xpi*xpi
         ax=xp2*(3.0_r8-2.0_r8*xp)
         axbar=1.0_r8-ax
         bx=-xp2*xpi
         bxbar=xpi2*xp
C
         iadr=0
C
C  derivatives:
C
         axp=6.0_r8*xp*xpi
         axbarp=-axp
         bxp=xp*(3.0_r8*xp-2.0_r8)
         bxbarp=xpi*(3.0_r8*xpi-2.0_r8)
C
C  get desired values:
C
         if(ict(1).eq.1) then
C
C  function value:
C
            iadr=iadr+1
            sum=azbar*(
     >         axbar*(aybar*fin(0,i,j,k)  +ay*fin(0,i,j+1,k))+
     >            ax*(aybar*fin(0,i+1,j,k)+ay*fin(0,i+1,j+1,k)))
     >          +  az*(
     >         axbar*(aybar*fin(0,i,j,k+1)  +ay*fin(0,i,j+1,k+1))+
     >            ax*(aybar*fin(0,i+1,j,k+1)+ay*fin(0,i+1,j+1,k+1)))
C
            sum=sum+hx(v)*(
     >         azbar*(
     >         bxbar*(aybar*fin(1,i,j,k)  +ay*fin(1,i,j+1,k))+
     >            bx*(aybar*fin(1,i+1,j,k)+ay*fin(1,i+1,j+1,k)))
     >          + az*(
     >         bxbar*(aybar*fin(1,i,j,k+1)  +ay*fin(1,i,j+1,k+1))+
     >            bx*(aybar*fin(1,i+1,j,k+1)+ay*fin(1,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hy*(
     >         azbar*(
     >         axbar*(bybar*fin(2,i,j,k)  +by*fin(2,i,j+1,k))+
     >            ax*(bybar*fin(2,i+1,j,k)+by*fin(2,i+1,j+1,k)))
     >          + az*(
     >         axbar*(bybar*fin(2,i,j,k+1)  +by*fin(2,i,j+1,k+1))+
     >            ax*(bybar*fin(2,i+1,j,k+1)+by*fin(2,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hz*(
     >         bzbar*(
     >         axbar*(aybar*fin(3,i,j,k)  +ay*fin(3,i,j+1,k))+
     >            ax*(aybar*fin(3,i+1,j,k)+ay*fin(3,i+1,j+1,k)))
     >          + bz*(
     >         axbar*(aybar*fin(3,i,j,k+1)  +ay*fin(3,i,j+1,k+1))+
     >            ax*(aybar*fin(3,i+1,j,k+1)+ay*fin(3,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*hy*(
     >         azbar*(
     >         bxbar*(bybar*fin(4,i,j,k)  +by*fin(4,i,j+1,k))+
     >            bx*(bybar*fin(4,i+1,j,k)+by*fin(4,i+1,j+1,k)))
     >          + az*(
     >         bxbar*(bybar*fin(4,i,j,k+1)  +by*fin(4,i,j+1,k+1))+
     >            bx*(bybar*fin(4,i+1,j,k+1)+by*fin(4,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*hz*(
     >         bzbar*(
     >         bxbar*(aybar*fin(5,i,j,k)  +ay*fin(5,i,j+1,k))+
     >            bx*(aybar*fin(5,i+1,j,k)+ay*fin(5,i+1,j+1,k)))
     >          + bz*(
     >         bxbar*(aybar*fin(5,i,j,k+1)  +ay*fin(5,i,j+1,k+1))+
     >            bx*(aybar*fin(5,i+1,j,k+1)+ay*fin(5,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hy*hz*(
     >         bzbar*(
     >         axbar*(bybar*fin(6,i,j,k)  +by*fin(6,i,j+1,k))+
     >            ax*(bybar*fin(6,i+1,j,k)+by*fin(6,i+1,j+1,k)))
     >          + bz*(
     >         axbar*(bybar*fin(6,i,j,k+1)  +by*fin(6,i,j+1,k+1))+
     >            ax*(bybar*fin(6,i+1,j,k+1)+by*fin(6,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*hy*hz*(
     >         bzbar*(
     >         bxbar*(bybar*fin(7,i,j,k)  +by*fin(7,i,j+1,k))+
     >            bx*(bybar*fin(7,i+1,j,k)+by*fin(7,i+1,j+1,k)))
     >          + bz*(
     >         bxbar*(bybar*fin(7,i,j,k+1)  +by*fin(7,i,j+1,k+1))+
     >            bx*(bybar*fin(7,i+1,j,k+1)+by*fin(7,i+1,j+1,k+1)))
     >         )
C
            fval(v,iadr)=sum
         endif
C
         if(ict(2).eq.1) then
C
C     df/dx:
C
            iadr=iadr+1
C
            sum=hxi(v)*(
     >          azbar*(
     >         axbarp*(aybar*fin(0,i,j,k)  +ay*fin(0,i,j+1,k))+
     >            axp*(aybar*fin(0,i+1,j,k)+ay*fin(0,i+1,j+1,k)))
     >          +  az*(
     >         axbarp*(aybar*fin(0,i,j,k+1)  +ay*fin(0,i,j+1,k+1))+
     >            axp*(aybar*fin(0,i+1,j,k+1)+ay*fin(0,i+1,j+1,k+1)))
     >         )
C
            sum=sum+(
     >         azbar*(
     >         bxbarp*(aybar*fin(1,i,j,k)  +ay*fin(1,i,j+1,k))+
     >            bxp*(aybar*fin(1,i+1,j,k)+ay*fin(1,i+1,j+1,k)))
     >          + az*(
     >         bxbarp*(aybar*fin(1,i,j,k+1)  +ay*fin(1,i,j+1,k+1))+
     >            bxp*(aybar*fin(1,i+1,j,k+1)+ay*fin(1,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*hy*(
     >         azbar*(
     >         axbarp*(bybar*fin(2,i,j,k)  +by*fin(2,i,j+1,k))+
     >            axp*(bybar*fin(2,i+1,j,k)+by*fin(2,i+1,j+1,k)))
     >          + az*(
     >         axbarp*(bybar*fin(2,i,j,k+1)  +by*fin(2,i,j+1,k+1))+
     >            axp*(bybar*fin(2,i+1,j,k+1)+by*fin(2,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*hz*(
     >         bzbar*(
     >         axbarp*(aybar*fin(3,i,j,k)  +ay*fin(3,i,j+1,k))+
     >            axp*(aybar*fin(3,i+1,j,k)+ay*fin(3,i+1,j+1,k)))
     >          + bz*(
     >         axbarp*(aybar*fin(3,i,j,k+1)  +ay*fin(3,i,j+1,k+1))+
     >            axp*(aybar*fin(3,i+1,j,k+1)+ay*fin(3,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hy*(
     >         azbar*(
     >         bxbarp*(bybar*fin(4,i,j,k)  +by*fin(4,i,j+1,k))+
     >            bxp*(bybar*fin(4,i+1,j,k)+by*fin(4,i+1,j+1,k)))
     >          + az*(
     >         bxbarp*(bybar*fin(4,i,j,k+1)  +by*fin(4,i,j+1,k+1))+
     >            bxp*(bybar*fin(4,i+1,j,k+1)+by*fin(4,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hz*(
     >         bzbar*(
     >         bxbarp*(aybar*fin(5,i,j,k)  +ay*fin(5,i,j+1,k))+
     >            bxp*(aybar*fin(5,i+1,j,k)+ay*fin(5,i+1,j+1,k)))
     >          + bz*(
     >         bxbarp*(aybar*fin(5,i,j,k+1)  +ay*fin(5,i,j+1,k+1))+
     >            bxp*(aybar*fin(5,i+1,j,k+1)+ay*fin(5,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*hy*hz*(
     >         bzbar*(
     >         axbarp*(bybar*fin(6,i,j,k)  +by*fin(6,i,j+1,k))+
     >            axp*(bybar*fin(6,i+1,j,k)+by*fin(6,i+1,j+1,k)))
     >          + bz*(
     >         axbarp*(bybar*fin(6,i,j,k+1)  +by*fin(6,i,j+1,k+1))+
     >            axp*(bybar*fin(6,i+1,j,k+1)+by*fin(6,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hy*hz*(
     >         bzbar*(
     >         bxbarp*(bybar*fin(7,i,j,k)  +by*fin(7,i,j+1,k))+
     >            bxp*(bybar*fin(7,i+1,j,k)+by*fin(7,i+1,j+1,k)))
     >          + bz*(
     >         bxbarp*(bybar*fin(7,i,j,k+1)  +by*fin(7,i,j+1,k+1))+
     >            bxp*(bybar*fin(7,i+1,j,k+1)+by*fin(7,i+1,j+1,k+1)))
     >         )
C
            fval(v,iadr)=sum
         endif
C
         if(ict(3).eq.1) then
C
C  df/dy:
C
            iadr=iadr+1
C
            sum=hyi*(
     >          azbar*(
     >         axbar*(aybarp*fin(0,i,j,k)  +ayp*fin(0,i,j+1,k))+
     >            ax*(aybarp*fin(0,i+1,j,k)+ayp*fin(0,i+1,j+1,k)))
     >          +  az*(
     >         axbar*(aybarp*fin(0,i,j,k+1)  +ayp*fin(0,i,j+1,k+1))+
     >            ax*(aybarp*fin(0,i+1,j,k+1)+ayp*fin(0,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hyi*hx(v)*(
     >         azbar*(
     >         bxbar*(aybarp*fin(1,i,j,k)  +ayp*fin(1,i,j+1,k))+
     >            bx*(aybarp*fin(1,i+1,j,k)+ayp*fin(1,i+1,j+1,k)))
     >          + az*(
     >         bxbar*(aybarp*fin(1,i,j,k+1)  +ayp*fin(1,i,j+1,k+1))+
     >            bx*(aybarp*fin(1,i+1,j,k+1)+ayp*fin(1,i+1,j+1,k+1)))
     >         )
C
            sum=sum+(
     >         azbar*(
     >         axbar*(bybarp*fin(2,i,j,k)  +byp*fin(2,i,j+1,k))+
     >            ax*(bybarp*fin(2,i+1,j,k)+byp*fin(2,i+1,j+1,k)))
     >          + az*(
     >         axbar*(bybarp*fin(2,i,j,k+1)  +byp*fin(2,i,j+1,k+1))+
     >            ax*(bybarp*fin(2,i+1,j,k+1)+byp*fin(2,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hyi*hz*(
     >         bzbar*(
     >         axbar*(aybarp*fin(3,i,j,k)  +ayp*fin(3,i,j+1,k))+
     >            ax*(aybarp*fin(3,i+1,j,k)+ayp*fin(3,i+1,j+1,k)))
     >          + bz*(
     >         axbar*(aybarp*fin(3,i,j,k+1)  +ayp*fin(3,i,j+1,k+1))+
     >            ax*(aybarp*fin(3,i+1,j,k+1)+ayp*fin(3,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*(
     >         azbar*(
     >         bxbar*(bybarp*fin(4,i,j,k)  +byp*fin(4,i,j+1,k))+
     >            bx*(bybarp*fin(4,i+1,j,k)+byp*fin(4,i+1,j+1,k)))
     >          + az*(
     >         bxbar*(bybarp*fin(4,i,j,k+1)  +byp*fin(4,i,j+1,k+1))+
     >            bx*(bybarp*fin(4,i+1,j,k+1)+byp*fin(4,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*hyi*hz*(
     >         bzbar*(
     >         bxbar*(aybarp*fin(5,i,j,k)  +ayp*fin(5,i,j+1,k))+
     >            bx*(aybarp*fin(5,i+1,j,k)+ayp*fin(5,i+1,j+1,k)))
     >          + bz*(
     >         bxbar*(aybarp*fin(5,i,j,k+1)  +ayp*fin(5,i,j+1,k+1))+
     >            bx*(aybarp*fin(5,i+1,j,k+1)+ayp*fin(5,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hz*(
     >         bzbar*(
     >         axbar*(bybarp*fin(6,i,j,k)  +byp*fin(6,i,j+1,k))+
     >            ax*(bybarp*fin(6,i+1,j,k)+byp*fin(6,i+1,j+1,k)))
     >          + bz*(
     >         axbar*(bybarp*fin(6,i,j,k+1)  +byp*fin(6,i,j+1,k+1))+
     >            ax*(bybarp*fin(6,i+1,j,k+1)+byp*fin(6,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*hz*(
     >         bzbar*(
     >         bxbar*(bybarp*fin(7,i,j,k)  +byp*fin(7,i,j+1,k))+
     >            bx*(bybarp*fin(7,i+1,j,k)+byp*fin(7,i+1,j+1,k)))
     >          + bz*(
     >         bxbar*(bybarp*fin(7,i,j,k+1)  +byp*fin(7,i,j+1,k+1))+
     >            bx*(bybarp*fin(7,i+1,j,k+1)+byp*fin(7,i+1,j+1,k+1)))
     >         )
C
            fval(v,iadr)=sum
         endif
C
         if(ict(4).eq.1) then
C
C  df/dz:
C
            iadr=iadr+1
C
            sum=hzi*(
     >          azbarp*(
     >         axbar*(aybar*fin(0,i,j,k)  +ay*fin(0,i,j+1,k))+
     >            ax*(aybar*fin(0,i+1,j,k)+ay*fin(0,i+1,j+1,k)))
     >          +  azp*(
     >         axbar*(aybar*fin(0,i,j,k+1)  +ay*fin(0,i,j+1,k+1))+
     >            ax*(aybar*fin(0,i+1,j,k+1)+ay*fin(0,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hzi*hx(v)*(
     >         azbarp*(
     >         bxbar*(aybar*fin(1,i,j,k)  +ay*fin(1,i,j+1,k))+
     >            bx*(aybar*fin(1,i+1,j,k)+ay*fin(1,i+1,j+1,k)))
     >          + azp*(
     >         bxbar*(aybar*fin(1,i,j,k+1)  +ay*fin(1,i,j+1,k+1))+
     >            bx*(aybar*fin(1,i+1,j,k+1)+ay*fin(1,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hzi*hy*(
     >         azbarp*(
     >         axbar*(bybar*fin(2,i,j,k)  +by*fin(2,i,j+1,k))+
     >            ax*(bybar*fin(2,i+1,j,k)+by*fin(2,i+1,j+1,k)))
     >          + azp*(
     >         axbar*(bybar*fin(2,i,j,k+1)  +by*fin(2,i,j+1,k+1))+
     >            ax*(bybar*fin(2,i+1,j,k+1)+by*fin(2,i+1,j+1,k+1)))
     >         )
C
            sum=sum+(
     >         bzbarp*(
     >         axbar*(aybar*fin(3,i,j,k)  +ay*fin(3,i,j+1,k))+
     >            ax*(aybar*fin(3,i+1,j,k)+ay*fin(3,i+1,j+1,k)))
     >          + bzp*(
     >         axbar*(aybar*fin(3,i,j,k+1)  +ay*fin(3,i,j+1,k+1))+
     >            ax*(aybar*fin(3,i+1,j,k+1)+ay*fin(3,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hzi*hx(v)*hy*(
     >         azbarp*(
     >         bxbar*(bybar*fin(4,i,j,k)  +by*fin(4,i,j+1,k))+
     >            bx*(bybar*fin(4,i+1,j,k)+by*fin(4,i+1,j+1,k)))
     >          + azp*(
     >         bxbar*(bybar*fin(4,i,j,k+1)  +by*fin(4,i,j+1,k+1))+
     >            bx*(bybar*fin(4,i+1,j,k+1)+by*fin(4,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*(
     >         bzbarp*(
     >         bxbar*(aybar*fin(5,i,j,k)  +ay*fin(5,i,j+1,k))+
     >            bx*(aybar*fin(5,i+1,j,k)+ay*fin(5,i+1,j+1,k)))
     >          + bzp*(
     >         bxbar*(aybar*fin(5,i,j,k+1)  +ay*fin(5,i,j+1,k+1))+
     >            bx*(aybar*fin(5,i+1,j,k+1)+ay*fin(5,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hy*(
     >         bzbarp*(
     >         axbar*(bybar*fin(6,i,j,k)  +by*fin(6,i,j+1,k))+
     >            ax*(bybar*fin(6,i+1,j,k)+by*fin(6,i+1,j+1,k)))
     >          + bzp*(
     >         axbar*(bybar*fin(6,i,j,k+1)  +by*fin(6,i,j+1,k+1))+
     >            ax*(bybar*fin(6,i+1,j,k+1)+by*fin(6,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*hy*(
     >         bzbarp*(
     >         bxbar*(bybar*fin(7,i,j,k)  +by*fin(7,i,j+1,k))+
     >            bx*(bybar*fin(7,i+1,j,k)+by*fin(7,i+1,j+1,k)))
     >          + bzp*(
     >         bxbar*(bybar*fin(7,i,j,k+1)  +by*fin(7,i,j+1,k+1))+
     >            bx*(bybar*fin(7,i+1,j,k+1)+by*fin(7,i+1,j+1,k+1)))
     >         )
C
            fval(v,iadr)=sum
         endif
C
         if(ict(5).eq.1) then
C
C  d2f/dxdy:
C
            iadr=iadr+1
C
            sum=hxi(v)*hyi*(
     >          azbar*(
     >         axbarp*(aybarp*fin(0,i,j,k)  +ayp*fin(0,i,j+1,k))+
     >            axp*(aybarp*fin(0,i+1,j,k)+ayp*fin(0,i+1,j+1,k)))
     >          +  az*(
     >         axbarp*(aybarp*fin(0,i,j,k+1)  +ayp*fin(0,i,j+1,k+1))+
     >            axp*(aybarp*fin(0,i+1,j,k+1)+ayp*fin(0,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hyi*(
     >         azbar*(
     >         bxbarp*(aybarp*fin(1,i,j,k)  +ayp*fin(1,i,j+1,k))+
     >            bxp*(aybarp*fin(1,i+1,j,k)+ayp*fin(1,i+1,j+1,k)))
     >          + az*(
     >         bxbarp*(aybarp*fin(1,i,j,k+1)  +ayp*fin(1,i,j+1,k+1))+
     >            bxp*(aybarp*fin(1,i+1,j,k+1)+ayp*fin(1,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*(
     >         azbar*(
     >         axbarp*(bybarp*fin(2,i,j,k)  +byp*fin(2,i,j+1,k))+
     >            axp*(bybarp*fin(2,i+1,j,k)+byp*fin(2,i+1,j+1,k)))
     >          + az*(
     >         axbarp*(bybarp*fin(2,i,j,k+1)  +byp*fin(2,i,j+1,k+1))+
     >            axp*(bybarp*fin(2,i+1,j,k+1)+byp*fin(2,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*hyi*hz*(
     >         bzbar*(
     >         axbarp*(aybarp*fin(3,i,j,k)  +ayp*fin(3,i,j+1,k))+
     >            axp*(aybarp*fin(3,i+1,j,k)+ayp*fin(3,i+1,j+1,k)))
     >          + bz*(
     >         axbarp*(aybarp*fin(3,i,j,k+1)  +ayp*fin(3,i,j+1,k+1))+
     >            axp*(aybarp*fin(3,i+1,j,k+1)+ayp*fin(3,i+1,j+1,k+1)))
     >         )
C
            sum=sum+(
     >         azbar*(
     >         bxbarp*(bybarp*fin(4,i,j,k)  +byp*fin(4,i,j+1,k))+
     >            bxp*(bybarp*fin(4,i+1,j,k)+byp*fin(4,i+1,j+1,k)))
     >          + az*(
     >         bxbarp*(bybarp*fin(4,i,j,k+1)  +byp*fin(4,i,j+1,k+1))+
     >            bxp*(bybarp*fin(4,i+1,j,k+1)+byp*fin(4,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hyi*hz*(
     >         bzbar*(
     >         bxbarp*(aybarp*fin(5,i,j,k)  +ayp*fin(5,i,j+1,k))+
     >            bxp*(aybarp*fin(5,i+1,j,k)+ayp*fin(5,i+1,j+1,k)))
     >          + bz*(
     >         bxbarp*(aybarp*fin(5,i,j,k+1)  +ayp*fin(5,i,j+1,k+1))+
     >            bxp*(aybarp*fin(5,i+1,j,k+1)+ayp*fin(5,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*hz*(
     >         bzbar*(
     >         axbarp*(bybarp*fin(6,i,j,k)  +byp*fin(6,i,j+1,k))+
     >            axp*(bybarp*fin(6,i+1,j,k)+byp*fin(6,i+1,j+1,k)))
     >          + bz*(
     >         axbarp*(bybarp*fin(6,i,j,k+1)  +byp*fin(6,i,j+1,k+1))+
     >            axp*(bybarp*fin(6,i+1,j,k+1)+byp*fin(6,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hz*(
     >         bzbar*(
     >         bxbarp*(bybarp*fin(7,i,j,k)  +byp*fin(7,i,j+1,k))+
     >            bxp*(bybarp*fin(7,i+1,j,k)+byp*fin(7,i+1,j+1,k)))
     >          + bz*(
     >         bxbarp*(bybarp*fin(7,i,j,k+1)  +byp*fin(7,i,j+1,k+1))+
     >            bxp*(bybarp*fin(7,i+1,j,k+1)+byp*fin(7,i+1,j+1,k+1)))
     >         )
C
            fval(v,iadr)=sum
         endif
C
         if(ict(6).eq.1) then
C
C  d2f/dxdz:
C
            iadr=iadr+1
C
            sum=hxi(v)*hzi*(
     >          azbarp*(
     >         axbarp*(aybar*fin(0,i,j,k)  +ay*fin(0,i,j+1,k))+
     >            axp*(aybar*fin(0,i+1,j,k)+ay*fin(0,i+1,j+1,k)))
     >          +  azp*(
     >         axbarp*(aybar*fin(0,i,j,k+1)  +ay*fin(0,i,j+1,k+1))+
     >            axp*(aybar*fin(0,i+1,j,k+1)+ay*fin(0,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hzi*(
     >         azbarp*(
     >         bxbarp*(aybar*fin(1,i,j,k)  +ay*fin(1,i,j+1,k))+
     >            bxp*(aybar*fin(1,i+1,j,k)+ay*fin(1,i+1,j+1,k)))
     >          + azp*(
     >         bxbarp*(aybar*fin(1,i,j,k+1)  +ay*fin(1,i,j+1,k+1))+
     >            bxp*(aybar*fin(1,i+1,j,k+1)+ay*fin(1,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*hy*hzi*(
     >         azbarp*(
     >         axbarp*(bybar*fin(2,i,j,k)  +by*fin(2,i,j+1,k))+
     >            axp*(bybar*fin(2,i+1,j,k)+by*fin(2,i+1,j+1,k)))
     >          + azp*(
     >         axbarp*(bybar*fin(2,i,j,k+1)  +by*fin(2,i,j+1,k+1))+
     >            axp*(bybar*fin(2,i+1,j,k+1)+by*fin(2,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*(
     >         bzbarp*(
     >         axbarp*(aybar*fin(3,i,j,k)  +ay*fin(3,i,j+1,k))+
     >            axp*(aybar*fin(3,i+1,j,k)+ay*fin(3,i+1,j+1,k)))
     >          + bzp*(
     >         axbarp*(aybar*fin(3,i,j,k+1)  +ay*fin(3,i,j+1,k+1))+
     >            axp*(aybar*fin(3,i+1,j,k+1)+ay*fin(3,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hy*hzi*(
     >         azbarp*(
     >         bxbarp*(bybar*fin(4,i,j,k)  +by*fin(4,i,j+1,k))+
     >            bxp*(bybar*fin(4,i+1,j,k)+by*fin(4,i+1,j+1,k)))
     >          + azp*(
     >         bxbarp*(bybar*fin(4,i,j,k+1)  +by*fin(4,i,j+1,k+1))+
     >            bxp*(bybar*fin(4,i+1,j,k+1)+by*fin(4,i+1,j+1,k+1)))
     >         )
C
            sum=sum+(
     >         bzbarp*(
     >         bxbarp*(aybar*fin(5,i,j,k)  +ay*fin(5,i,j+1,k))+
     >            bxp*(aybar*fin(5,i+1,j,k)+ay*fin(5,i+1,j+1,k)))
     >          + bzp*(
     >         bxbarp*(aybar*fin(5,i,j,k+1)  +ay*fin(5,i,j+1,k+1))+
     >            bxp*(aybar*fin(5,i+1,j,k+1)+ay*fin(5,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*hy*(
     >         bzbarp*(
     >         axbarp*(bybar*fin(6,i,j,k)  +by*fin(6,i,j+1,k))+
     >            axp*(bybar*fin(6,i+1,j,k)+by*fin(6,i+1,j+1,k)))
     >          + bzp*(
     >         axbarp*(bybar*fin(6,i,j,k+1)  +by*fin(6,i,j+1,k+1))+
     >            axp*(bybar*fin(6,i+1,j,k+1)+by*fin(6,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hy*(
     >         bzbarp*(
     >         bxbarp*(bybar*fin(7,i,j,k)  +by*fin(7,i,j+1,k))+
     >            bxp*(bybar*fin(7,i+1,j,k)+by*fin(7,i+1,j+1,k)))
     >          + bzp*(
     >         bxbarp*(bybar*fin(7,i,j,k+1)  +by*fin(7,i,j+1,k+1))+
     >            bxp*(bybar*fin(7,i+1,j,k+1)+by*fin(7,i+1,j+1,k+1)))
     >         )
C
            fval(v,iadr)=sum
         endif
C
         if(ict(7).eq.1) then
C
C  d2f/dydz:
C
            iadr=iadr+1
C
            sum=hyi*hzi*(
     >          azbarp*(
     >         axbar*(aybarp*fin(0,i,j,k)  +ayp*fin(0,i,j+1,k))+
     >            ax*(aybarp*fin(0,i+1,j,k)+ayp*fin(0,i+1,j+1,k)))
     >          +  azp*(
     >         axbar*(aybarp*fin(0,i,j,k+1)  +ayp*fin(0,i,j+1,k+1))+
     >            ax*(aybarp*fin(0,i+1,j,k+1)+ayp*fin(0,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hyi*hzi*hx(v)*(
     >         azbarp*(
     >         bxbar*(aybarp*fin(1,i,j,k)  +ayp*fin(1,i,j+1,k))+
     >            bx*(aybarp*fin(1,i+1,j,k)+ayp*fin(1,i+1,j+1,k)))
     >          + azp*(
     >         bxbar*(aybarp*fin(1,i,j,k+1)  +ayp*fin(1,i,j+1,k+1))+
     >            bx*(aybarp*fin(1,i+1,j,k+1)+ayp*fin(1,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hzi*(
     >         azbarp*(
     >         axbar*(bybarp*fin(2,i,j,k)  +byp*fin(2,i,j+1,k))+
     >            ax*(bybarp*fin(2,i+1,j,k)+byp*fin(2,i+1,j+1,k)))
     >          + azp*(
     >         axbar*(bybarp*fin(2,i,j,k+1)  +byp*fin(2,i,j+1,k+1))+
     >            ax*(bybarp*fin(2,i+1,j,k+1)+byp*fin(2,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hyi*(
     >         bzbarp*(
     >         axbar*(aybarp*fin(3,i,j,k)  +ayp*fin(3,i,j+1,k))+
     >            ax*(aybarp*fin(3,i+1,j,k)+ayp*fin(3,i+1,j+1,k)))
     >          + bzp*(
     >         axbar*(aybarp*fin(3,i,j,k+1)  +ayp*fin(3,i,j+1,k+1))+
     >            ax*(aybarp*fin(3,i+1,j,k+1)+ayp*fin(3,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*hzi*(
     >         azbarp*(
     >         bxbar*(bybarp*fin(4,i,j,k)  +byp*fin(4,i,j+1,k))+
     >            bx*(bybarp*fin(4,i+1,j,k)+byp*fin(4,i+1,j+1,k)))
     >          + azp*(
     >         bxbar*(bybarp*fin(4,i,j,k+1)  +byp*fin(4,i,j+1,k+1))+
     >            bx*(bybarp*fin(4,i+1,j,k+1)+byp*fin(4,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*hyi*(
     >         bzbarp*(
     >         bxbar*(aybarp*fin(5,i,j,k)  +ayp*fin(5,i,j+1,k))+
     >            bx*(aybarp*fin(5,i+1,j,k)+ayp*fin(5,i+1,j+1,k)))
     >          + bzp*(
     >         bxbar*(aybarp*fin(5,i,j,k+1)  +ayp*fin(5,i,j+1,k+1))+
     >            bx*(aybarp*fin(5,i+1,j,k+1)+ayp*fin(5,i+1,j+1,k+1)))
     >         )
C
            sum=sum+(
     >         bzbarp*(
     >         axbar*(bybarp*fin(6,i,j,k)  +byp*fin(6,i,j+1,k))+
     >            ax*(bybarp*fin(6,i+1,j,k)+byp*fin(6,i+1,j+1,k)))
     >          + bzp*(
     >         axbar*(bybarp*fin(6,i,j,k+1)  +byp*fin(6,i,j+1,k+1))+
     >            ax*(bybarp*fin(6,i+1,j,k+1)+byp*fin(6,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hx(v)*(
     >         bzbarp*(
     >         bxbar*(bybarp*fin(7,i,j,k)  +byp*fin(7,i,j+1,k))+
     >            bx*(bybarp*fin(7,i+1,j,k)+byp*fin(7,i+1,j+1,k)))
     >          + bzp*(
     >         bxbar*(bybarp*fin(7,i,j,k+1)  +byp*fin(7,i,j+1,k+1))+
     >            bx*(bybarp*fin(7,i+1,j,k+1)+byp*fin(7,i+1,j+1,k+1)))
     >         )
C
            fval(v,iadr)=sum
         endif
C
         if(ict(8).eq.1) then
C
C  d3f/dxdydz:
C
            iadr=iadr+1
C
            sum=hxi(v)*hyi*hzi*(
     >          azbarp*(
     >         axbarp*(aybarp*fin(0,i,j,k)  +ayp*fin(0,i,j+1,k))+
     >            axp*(aybarp*fin(0,i+1,j,k)+ayp*fin(0,i+1,j+1,k)))
     >          +  azp*(
     >         axbarp*(aybarp*fin(0,i,j,k+1)  +ayp*fin(0,i,j+1,k+1))+
     >            axp*(aybarp*fin(0,i+1,j,k+1)+ayp*fin(0,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hyi*hzi*(
     >         azbarp*(
     >         bxbarp*(aybarp*fin(1,i,j,k)  +ayp*fin(1,i,j+1,k))+
     >            bxp*(aybarp*fin(1,i+1,j,k)+ayp*fin(1,i+1,j+1,k)))
     >          + azp*(
     >         bxbarp*(aybarp*fin(1,i,j,k+1)  +ayp*fin(1,i,j+1,k+1))+
     >            bxp*(aybarp*fin(1,i+1,j,k+1)+ayp*fin(1,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*hzi*(
     >         azbarp*(
     >         axbarp*(bybarp*fin(2,i,j,k)  +byp*fin(2,i,j+1,k))+
     >            axp*(bybarp*fin(2,i+1,j,k)+byp*fin(2,i+1,j+1,k)))
     >          + azp*(
     >         axbarp*(bybarp*fin(2,i,j,k+1)  +byp*fin(2,i,j+1,k+1))+
     >            axp*(bybarp*fin(2,i+1,j,k+1)+byp*fin(2,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*hyi*(
     >         bzbarp*(
     >         axbarp*(aybarp*fin(3,i,j,k)  +ayp*fin(3,i,j+1,k))+
     >            axp*(aybarp*fin(3,i+1,j,k)+ayp*fin(3,i+1,j+1,k)))
     >          + bzp*(
     >         axbarp*(aybarp*fin(3,i,j,k+1)  +ayp*fin(3,i,j+1,k+1))+
     >            axp*(aybarp*fin(3,i+1,j,k+1)+ayp*fin(3,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hzi*(
     >         azbarp*(
     >         bxbarp*(bybarp*fin(4,i,j,k)  +byp*fin(4,i,j+1,k))+
     >            bxp*(bybarp*fin(4,i+1,j,k)+byp*fin(4,i+1,j+1,k)))
     >          + azp*(
     >         bxbarp*(bybarp*fin(4,i,j,k+1)  +byp*fin(4,i,j+1,k+1))+
     >            bxp*(bybarp*fin(4,i+1,j,k+1)+byp*fin(4,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hyi*(
     >         bzbarp*(
     >         bxbarp*(aybarp*fin(5,i,j,k)  +ayp*fin(5,i,j+1,k))+
     >            bxp*(aybarp*fin(5,i+1,j,k)+ayp*fin(5,i+1,j+1,k)))
     >          + bzp*(
     >         bxbarp*(aybarp*fin(5,i,j,k+1)  +ayp*fin(5,i,j+1,k+1))+
     >            bxp*(aybarp*fin(5,i+1,j,k+1)+ayp*fin(5,i+1,j+1,k+1)))
     >         )
C
            sum=sum+hxi(v)*(
     >         bzbarp*(
     >         axbarp*(bybarp*fin(6,i,j,k)  +byp*fin(6,i,j+1,k))+
     >            axp*(bybarp*fin(6,i+1,j,k)+byp*fin(6,i+1,j+1,k)))
     >          + bzp*(
     >         axbarp*(bybarp*fin(6,i,j,k+1)  +byp*fin(6,i,j+1,k+1))+
     >            axp*(bybarp*fin(6,i+1,j,k+1)+byp*fin(6,i+1,j+1,k+1)))
     >         )
C
            sum=sum+(
     >         bzbarp*(
     >         bxbarp*(bybarp*fin(7,i,j,k)  +byp*fin(7,i,j+1,k))+
     >            bxp*(bybarp*fin(7,i+1,j,k)+byp*fin(7,i+1,j+1,k)))
     >          + bzp*(
     >         bxbarp*(bybarp*fin(7,i,j,k+1)  +byp*fin(7,i,j+1,k+1))+
     >            bxp*(bybarp*fin(7,i+1,j,k+1)+byp*fin(7,i+1,j+1,k+1)))
     >         )
C
            fval(v,iadr)=sum
         endif
C
      enddo                             ! vector loop
C
      return
      end