!
!     CalculiX - A 3-dimensional finite element program
!     Copyright (C) 1998-2019 Guido Dhondt
!
!     This program is free software; you can redistribute it and/or
!     modify it under the terms of the GNU General Public License as
!     published by the Free Software Foundation(version 2);
!
!
!     This program is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with this program; if not, write to the Free Software
!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
      subroutine gaspipe_rot(node1,node2,nodem,nelem,lakon,kon,
     &        ipkon,nactdog,identity,ielprop,prop,iflag,v,xflow,f,
     &        nodef,idirf,df,cp,r,physcon,dvi,numf,set,
     &        shcon,nshcon,rhcon,nrhcon,ntmat_,co,vold,mi,ttime,time,
     &        iaxial,iplausi)
!
!     rotating pipe with friction and variable cross section
!
      implicit none
!
      logical identity,crit
      character*8 lakon(*)
      character*81 set(*)
!
      integer nelem,nactdog(0:3,*),node1,node2,nodem,numf,ielprop(*),
     &     idirf(*),index,iflag,nodef(*),inv,ipkon(*),kon(*),icase,ith,
     &     nshcon(*),nrhcon(*),ntmat_,mi(*),iaxial,iplausi
!
      real*8 prop(*),v(0:mi(2),*),xflow,f,df(*),kappa,r,A,d,xl,
     &     T1,T2,Tt1,Tt2,pt1,pt2,cp,physcon(*),km1,dvi,kp1,kdkm1,
     &     reynolds,pi,lambda,kdkp1,rho,km1d2,ttime,time,pt2zpt1,ks,
     &     form_fact,pt2zpt1_c,Qred1_crit,Qred,phi,M1,M2,Qred1,co(3,*),
     &     shcon(0:3,ntmat_,*),rhcon(0:1,ntmat_,*),vold(0:mi(2),*),
     &     bb,cc,ee1,ee2,dfdM1,dfdM2,M1_c,Qred2,za,zb,zc,Z1,Z2,r1,r2,
     &     term,omega,om2,d1,d2,A1,A2,alpha,beta,coef,M2_c,Qred2_crit
!
      ith=0
!
      if(iflag.eq.0) then
         identity=.true.
!
         if(nactdog(2,node1).ne.0)then
            identity=.false.
         elseif(nactdog(2,node2).ne.0)then
            identity=.false.
         elseif(nactdog(1,nodem).ne.0)then
            identity=.false.
         endif
!
      elseif(iflag.eq.1)then
         if(v(1,nodem).ne.0.d0) then
            xflow=v(1,nodem)
            return
         endif
!
         pi=4.d0*datan(1.d0)
!
         index=ielprop(nelem)
         kappa=(cp/(cp-r))
!
         A1=prop(index+1)
         A2=prop(index+2)
         xl=prop(index+3)
         ks=prop(index+4)
         form_fact=prop(index+5)
         d1=prop(index+6)
         if(form_fact.eq.1.d0) then
            d1=2.d0*dsqrt(A1/pi)
         endif
         d2=prop(index+7)
         if(form_fact.eq.1.d0) then
            d2=2.d0*dsqrt(A2/pi)
         endif
         r1=prop(index+8)
         r2=prop(index+9)
         omega=prop(index+10)
!
         pt1=v(2,node1)
         pt2=v(2,node2)
!
         Tt1=v(0,node1)-physcon(1)
         Tt2=v(0,node2)-physcon(1)
!
         A=(A1+A2)/2.d0
         d=(d1+d2)/2.d0
         if(r2.ge.r1) then
            om2=omega**2
         else
            om2=-omega**2
         endif
!
!        calculation of the dynamic viscosity
!
         if(dabs(dvi).lt.1d-30) then
            write(*,*) '*ERROR in gaspipe_fanno: '
            write(*,*) '       no dynamic viscosity defined'
            write(*,*) '       dvi= ',dvi
            call exit(201)
         endif
!
!        assumed value for the reynolds number
!
         reynolds=3.e3
!
         call friction_coefficient(xl,d,ks,reynolds,form_fact,
     &        lambda)
!
!        estimate of the flow using the incompressible relationships
!        for a gas pipe
!
!        mean density
!
         rho=(pt1/(r*Tt1)+pt2/(r*Tt2))/2.d0
         term=(rho*(pt1-pt2)+rho**2*om2*(r2**2-r1**2)/2.d0)*
     &           2.d0*d/(lambda*xl)
!
         if(term.ge.0.d0) then
            inv=1.d0
            if(v(1,nodem).le.0.d0) then
               xflow=A*dsqrt(term)
            else
               xflow=v(1,nodem)*iaxial
            endif
         else
!
!           if the term underneath the square root is negative,
!           lambda must have a negative sign, which means that the flow
!           direction has to be reversed
!
            inv=-1.d0
            lambda=-lambda
            if(v(1,nodem).ge.0.d0) then
               xflow=-A*dsqrt(-term)
            else
               xflow=v(1,nodem)*iaxial
            endif
         endif
!
         kp1=kappa+1.d0
         km1=kappa-1.d0
         km1d2=km1/2.d0
!
!        check whether the flow does not exceed the critical one
!
         alpha=-4.d0*(d2-d1)/(xl*d)-(r1+r2)*om2*kp1/
     &        (cp*(Tt1+Tt2)*km1)
         if(alpha.eq.0.d0) then
            write(*,*) '*ERROR in gaspipe_rot: looks like the'
            write(*,*) '       cross section is constant and'
            write(*,*) '       the rotational speed is zero;'
            write(*,*) '       please use the gaspipe_fanno'
            write(*,*) '       element instead'
            call exit(201)
         endif
         beta=lambda*kappa/d
!
!        for subsonic flow:
!        coef>0.d0 means that the Mach number increases from 1 to 2
!           (i.e. sonic conditions can only occur at 2)
!        coef<0.d0 means that the Mach number decreases from 1 to 2
!           (i.e. sonic conditions can only occur at 1)
!
         call ts_calc(xflow,Tt1,pt1,kappa,r,A1,T1,ith)
         M1=dsqrt(((Tt1/T1)-1.d0)/km1d2)
         call ts_calc(xflow,Tt2,pt2,kappa,r,A2,T2,ith)
         M2=dsqrt(((Tt2/T2)-1.d0)/km1d2)
         coef=alpha+beta*((M1+M2)/2.d0)**2
!
!        icase tells where sonic conditions can occur, if any.
!
         if(coef.ge.0.d0) then
            icase=2
         else
            icase=1
         endif
!
         za=1.d0/alpha
         zb=(alpha+beta)*beta/(alpha*(alpha*km1d2-beta))
         zc=kp1*km1d2/(2.d0*beta-alpha*km1)
!
         if(omega.eq.0.d0) then
            call pt2zpt1_rot(pt2,pt1,kappa,r,xl,pt2zpt1_c,crit,icase,
     &        M1_c,M2_c,za,zb,zc,alpha,beta,Qred1_crit,Qred2_crit,A1,A2)
         else
            crit=.false.
         endif
!
!        check for critical flow only in the absence of rotational
!        speed
!
         if((icase.eq.1).and.(omega.eq.0.d0)) then
c         if(icase.eq.1) then
!
!           decreasing Mach number from 1 to 2
!
            Qred2=dabs(xflow)*dsqrt(Tt2)/(A2*pt2)
!
!           check whether flow is critical
!           assigning the physcical correct sign to xflow
!
            if(crit) then
!
!              the flow is set to half the critical value or
!              one of the pressures is adapted (depending on
!              which variable is unknown)
!
c               if(nactdog(1,nodem).ne.0) then
                  xflow=0.5d0*inv*Qred2_crit*pt2*A2/dsqrt(Tt2)
c               elseif(nactdog(2,node1).ne.0) then
c                  if(beta.ge.0.d0) then
c                     v(2,node1)=pt2/pt2zpt1_c*0.99d0
c                  else
c                     v(2,node1)=pt2/pt2zpt1_c*1.01d0
c                  endif
c               elseif(nactdog(2,node2).ne.0) then
c                  if(beta.ge.0.d0) then
c                     v(2,node2)=pt2zpt1_c*pt1*1.01d0
c                  else
c                     v(2,node2)=pt2zpt1_c*pt1*0.99d0
c                  endif
c               endif
            elseif(Qred.gt.Qred2_crit) then
!
!              the flow is set to half the critical value
!
               xflow=0.5d0*inv*Qred2_crit*pt2*A2/dsqrt(Tt2)
            endif
         else
!
!           increasing Mach number from 1 to 2
!
            Qred=dabs(xflow)*dsqrt(Tt1)/(A1*pt1)
            if(crit) then
!
!              the flow is set to half the critical value or
!              one of the pressures is adapted (depending on
!              which variable is unknown)
!
c               if(nactdog(1,nodem).ne.0) then
                  xflow=0.5d0*inv*Qred1_crit*pt1*A1/dsqrt(Tt1)
c               elseif(nactdog(2,node1).ne.0) then
c                  if(beta.ge.0.d0) then
c                     v(2,node1)=pt2/pt2zpt1_c*0.99d0
c                  else
c                     v(2,node1)=pt2/pt2zpt1_c*1.01d0
c                  endif
c               elseif(nactdog(2,node2).ne.0) then
c                  if(beta.ge.0.d0) then
c                     v(2,node2)=pt2zpt1_c*pt1*1.01d0
c                  else
c                     v(2,node2)=pt2zpt1_c*pt1*0.99d0
c                  endif
c               endif
             elseif(Qred.gt.Qred1_crit) then
!
!              the flow is set to half the critical value
!
               xflow=0.5d0*inv*Qred1_crit*pt1*A1/dsqrt(Tt1)
            endif
         endif
!
      elseif(iflag.eq.2)then
!
         numf=5
!
         pi=4.d0*datan(1.d0)
!
         index=ielprop(nelem)
         kappa=(cp/(cp-r))
!
         A1=prop(index+1)
         A2=prop(index+2)
         xl=prop(index+3)
         ks=prop(index+4)
         form_fact=prop(index+5)
         d1=prop(index+6)
         if(form_fact.eq.1.d0) then
            d1=2.d0*dsqrt(A1/pi)
         endif
         d2=prop(index+7)
         if(form_fact.eq.1.d0) then
            d2=2.d0*dsqrt(A2/pi)
         endif
         r1=prop(index+8)
         r2=prop(index+9)
         omega=prop(index+10)
!
         pt1=v(2,node1)
         pt2=v(2,node2)
!
         Tt1=v(0,node1)-physcon(1)
         Tt2=v(0,node2)-physcon(1)
!
         xflow=v(1,nodem)*iaxial
!
         write(*,*) 'gaspipe_rot: ',pt1,pt2,xflow,Tt1,Tt2
!
         idirf(1)=2
         idirf(2)=0
         idirf(3)=1
         idirf(4)=2
         idirf(5)=0
!
         nodef(1)=node1
         nodef(2)=node1
         nodef(3)=nodem
         nodef(4)=node2
         nodef(5)=node2
!
         pt2zpt1=pt2/pt1
!
         A=(A1+A2)/2.d0
         d=(d1+d2)/2.d0
         if(r2.ge.r1) then
            om2=omega**2
         else
            om2=-omega**2
         endif
!
!     calculation of the dynamic viscosity
!
         if(dabs(dvi).lt.1d-30) then
            write(*,*) '*ERROR in gaspipe_fanno: '
            write(*,*) '       no dynamic viscosity defined'
            write(*,*) '       dvi= ',dvi
            call exit(201)
         endif
!
         reynolds=dabs(xflow)*d/(dvi*A)
!
!        calculation of the friction coefficient
!
         call friction_coefficient(xl,d,ks,reynolds,form_fact,
     &        lambda)
!
         if(xflow.lt.0.d0) then
            lambda=-lambda
            inv=-1
         else
            inv=1
         endif
!
         kp1=kappa+1.d0
         km1=kappa-1.d0
         km1d2=km1/2.d0
!
         alpha=-4.d0*(d2-d1)/(xl*d)-(r1+r2)*om2*kp1/
     &        (cp*(Tt1+Tt2)*km1)
         if(alpha.eq.0.d0) then
            write(*,*) '*ERROR in gaspipe_rot: looks like the'
            write(*,*) '       cross section is constant and'
            write(*,*) '       the rotational speed is zero;'
            write(*,*) '       please use the gaspipe_fanno'
            write(*,*) '       element instead'
            call exit(201)
         endif
         beta=lambda*kappa/d
!
!        for subsonic flow:
!        coef>0.d0 means that the Mach number increases from 1 to 2
!           (i.e. sonic conditions can only occur at 2)
!        coef<0.d0 means that the Mach number decreases from 1 to 2
!           (i.e. sonic conditions can only occur at 1)
!
         call ts_calc(xflow,Tt1,pt1,kappa,r,A1,T1,ith)
         M1=dsqrt(((Tt1/T1)-1.d0)/km1d2)
         call ts_calc(xflow,Tt2,pt2,kappa,r,A2,T2,ith)
         M2=dsqrt(((Tt2/T2)-1.d0)/km1d2)
         coef=alpha+beta*((M1+M2)/2.d0)**2
         write(*,*) 'gaspipe_rot M1,M2',M1,M2
!
!        icase tells where sonic conditions can occur, if any.
!
         if(coef.ge.0.d0) then
            icase=2
         else
            icase=1
         endif
!
         za=1.d0/alpha
         zb=(alpha+beta)*beta/(alpha*(alpha*km1d2-beta))
         zc=kp1*km1d2/(2.d0*beta-alpha*km1)
         write(*,*) 'gaspipe_rot alpha beta',alpha,beta
         write(*,*) 'za zb zc',za,zb,zc
!
         if(omega.eq.0.d0) then
            call pt2zpt1_rot(pt2,pt1,kappa,r,xl,pt2zpt1_c,crit,icase,
     &        M1_c,M2_c,za,zb,zc,alpha,beta,Qred1_crit,Qred2_crit,A1,A2)
         else
            crit=.false.
         endif
         write(*,*) 'gaspipe_rot crit ',crit
!
!        check for critical flow only in the absence of rotational
!        speed
!
         if((icase.eq.1).and.(omega.eq.0.d0)) then
!
!           decreasing Mach number from 1 to 2
!
            Qred2=dabs(xflow)*dsqrt(Tt2)/(A2*pt2)
!
!           check whether flow is critical
!           assigning the physcical correct sign to xflow
!
            if(crit) then
               write(*,*) '*WARNING in gaspipe_rot'
               write(*,*) '         critical conditions detected'
               write(*,*) '         in element ',nelem
               xflow=inv*Qred2_crit*A2*pt2/dsqrt(Tt2)
!
!              check whether flow has changed; if so, update v
!              for consistency
!
               if(dabs((xflow-iaxial*v(1,nodem))/xflow).gt.1.d-5) then
                  iplausi=0
                  if(nactdog(1,nodem).ne.0) v(1,nodem)=xflow/iaxial
               endif
               M2=dsqrt(((Tt2/T2)-1.d0)/km1d2)
               M2=min(M2,0.999d0)
               if((alpha+beta*M2*M2)/(alpha+beta).lt.0.d0) then
                  M2=M2_c
               endif
!
!                 recalculate M1
!
               call ts_calc(xflow,Tt1,pt1,kappa,r,A1,T1,ith)
               M1=dsqrt(((Tt1/T1)-1.d0)/km1d2)
            else
               if(Qred2.gt.Qred2_crit) then
                  xflow=inv*Qred2_crit*A2*pt2/dsqrt(Tt2)
!
!                 check whether flow has changed; if so, update v
!                 for consistency
!
                  if(dabs((xflow-iaxial*v(1,nodem))/xflow).gt.1.d-5)
     &               then
                     iplausi=0
                     if(nactdog(1,nodem).ne.0) v(1,nodem)=xflow/iaxial
                  endif
!
                  M2=M2_c
!
!                 recalculate M1
!
                  call ts_calc(xflow,Tt1,pt1,kappa,r,A1,T1,ith)
                  M1=dsqrt(((Tt1/T1)-1.d0)/km1d2)
c               else
c                  call ts_calc(xflow,Tt2,pt2,kappa,r,A2,T2,ith)
c                  M2=dsqrt(((Tt2/T2)-1.d0)/km1d2)
               endif
!
c               Tt1=Tt2
c               call ts_calc(xflow,Tt1,pt1,kappa,r,A1,T1,ith)
c               M1=dsqrt(((Tt1/T1)-1.d0)/km1d2)
            endif
         elseif((icase.eq.2).and.(omega.eq.0.d0)) then
!
!           increasing Mach number from 1 to 2
!
            Qred1=dabs(xflow)*dsqrt(Tt1)/(A1*pt1)
!
!           check whether flow is critical
!           assigning the physcical correct sign to xflow
!
            if(crit) then
               write(*,*) '*WARNING in gaspipe_rot'
               write(*,*) '         critical conditions detected'
               write(*,*) '         in element ',nelem
               xflow=inv*Qred1_crit*A1*pt1/dsqrt(Tt1)
!
!              check whether flow has changed; if so, update v
!              for consistency
!
               if(dabs((xflow-iaxial*v(1,nodem))/xflow).gt.1.d-5) then
                  iplausi=0
                  if(nactdog(1,nodem).ne.0) v(1,nodem)=xflow/iaxial
               endif
!
               M1=dsqrt(((Tt1/T1)-1.d0)/km1d2)
               M1=min(M1,0.999d0)
               if((alpha+beta)/(alpha+beta*M1*M1).lt.0.d0) then
                  M1=M1_c
               endif
!
!                 recalculate M2
!
               call ts_calc(xflow,Tt2,pt2,kappa,r,A2,T2,ith)
               M2=dsqrt(((Tt2/T2)-1.d0)/km1d2)
            else
               if(Qred1.gt.Qred1_crit) then
                  xflow=inv*Qred1_crit*A1*pt1/dsqrt(Tt1)
!
!                 check whether flow has changed; if so, update v
!                 for consistency
!
                  if(dabs((xflow-iaxial*v(1,nodem))/xflow).gt.1.d-5)
     &               then
                     iplausi=0
                     if(nactdog(1,nodem).ne.0) v(1,nodem)=xflow/iaxial
                  endif
!
                  M1=M1_c
!
!                 recalculate M2
!
                  call ts_calc(xflow,Tt2,pt2,kappa,r,A2,T2,ith)
                  M2=dsqrt(((Tt2/T2)-1.d0)/km1d2)
c               else
c                  call ts_calc(xflow,Tt1,pt1,kappa,r,A1,T1,ith)
c                  M1=dsqrt(((Tt1/T1)-1.d0)/km1d2)
               endif
!
c               Tt2=Tt1
               call ts_calc(xflow,Tt2,pt2,kappa,r,A2,T2,ith)
               M2=dsqrt(((Tt2/T2)-1.d0)/km1d2)
            endif
c         elseif(icase.eq.1) then
c         else
         endif
!
         bb=km1d2
         cc=-kp1/(2.d0*km1)
!
!     definition of the coefficients
!
         if(icase.eq.1) then
!
!           decreasing Mach number from 1 to 2
!
            Z2=M2**2
            ee2=M2*(1.d0+bb*Z2)/(1.d0+bb*Z2*(1.d0+2.d0*cc))
            dfdM2=2.d0*M2*(za/Z2+zb/(alpha+beta*Z2)
     &                          +zc/(1.d0+km1d2*Z2))
!
            if(.not.crit) then
!
!              residual
!
               Z1=M1**2
               ee1=M1*(1.d0+bb*Z1)/(1.d0+bb*Z1*(1.d0+2.d0*cc))
               dfdM1=-2.d0*M1*(za/Z1+zb/(alpha+beta*Z1)
     &                              +zc/(1.d0+km1d2*Z1))
!
               f=dlog((Z2/Z1)**za
     &              *((alpha+beta*Z2)/(alpha+beta*Z1))**(zb/beta)
     &              *((1.d0+km1d2*Z2)/(1.d0+km1d2*Z1))**(zc/km1d2))
     &              -xl
!
!              pressure node1
!
               df(1)=-dfdM1*ee1/pt1
!
!              temperature node1
!
               df(2)=dfdM1*ee1/(2.d0*Tt1)
!
!              mass flow
!
               df(3)=(dfdM1*ee1+dfdM2*ee2)/xflow
!
!              pressure node2
!
               df(4)=-dfdM2*ee2/pt2
!
!              temperature node2
!
               df(5)=dfdM2*ee2/(2.d0*Tt2)
!
            else
!
               f=dlog(Z2**za
     &              *((alpha+beta*Z2)/(alpha+beta))**(zb/beta)
     &              *((1.d0+km1d2*Z2)/(1.d0+km1d2))**(zc/km1d2))
     &              -xl
!
!              pressure node1
!
               df(1)=0.d0
!
!              temperature node1
!
               df(2)=0.d0
!
!              mass flow
!
               df(3)=(dfdM2*ee2)/xflow
!
!              pressure node2
!
               df(4)=-dfdM2*ee2/pt2
!
!              temperature node2
!
               df(5)=dfdM2*ee2/(2.d0*Tt2)
!
            endif
         elseif(icase.eq.2) then
!
!           increasing Mach number from 1 to 2
!
            Z1=M1**2
            ee1=M1*(1.d0+bb*Z1)/(1.d0+bb*Z1*(1.d0+2.d0*cc))
            dfdM1=-2.d0*M1*(za/Z1+zb/(alpha+beta*Z1)
     &                           +zc/(1.d0+km1d2*Z1))
!
            if(.not.crit) then
!
!              residual
!
               Z2=M2**2
               ee2=M2*(1.d0+bb*Z2)/(1.d0+bb*Z2*(1.d0+2.d0*cc))
               dfdM2=2.d0*M2*(za/Z2+zb/(alpha+beta*Z2)
     &                             +zc/(1.d0+km1d2*Z2))
!
               f=dlog((Z2/Z1)**za
     &              *((alpha+beta*Z2)/(alpha+beta*Z1))**(zb/beta)
     &              *((1.d0+km1d2*Z2)/(1.d0+km1d2*Z1))**(zc/km1d2))
     &              -xl
!
!              pressure node1
!
               df(1)=-dfdM1*ee1/pt1
!
!              temperature node1
!
               df(2)=dfdM1*ee1/(2.d0*Tt1)
!
!              mass flow
!
               df(3)=(dfdM1*ee1+dfdM2*ee2)/xflow
!
!              pressure node2
!
               df(4)=-dfdM2*ee2/pt2
!
!              temperature node2
!
               df(5)=dfdM2*ee2/(2.d0*Tt2)
!
            else
!
               f=dlog((1.d0/Z1)**za
     &              *((alpha+beta)/(alpha+beta*Z1))**(zb/beta)
     &              *((1.d0+km1d2)/(1.d0+km1d2*Z1))**(zc/km1d2))
     &              -xl
!
!              pressure node1
!
               df(1)=-dfdM1*ee1/pt1
!
!              temperature node1
!
               df(2)=dfdM1*ee1/(2.d0*Tt1)
!
!              mass flow
!
               df(3)=dfdM1*ee1/xflow
!
!              pressure node2
!
               df(4)=0.d0
!
!              temperature node2
!
               df(5)=0.d0
!
            endif
         endif
!
!     output
!
      elseif(iflag.eq.3) then
!
         pi=4.d0*datan(1.d0)
!
         kappa=(cp/(cp-r))
         km1=kappa-1.d0
         km1d2=km1/2.d0
         kp1=kappa+1.d0
         kdkm1=kappa/km1
         kdkp1=kappa/kp1
!
         index=ielprop(nelem)
         A1=prop(index+1)
         A2=prop(index+2)
         xl=prop(index+3)
!
         lambda=0.5d0
!
         ks=prop(index+4)
         form_fact=prop(index+5)
         d1=prop(index+6)
         if(form_fact.eq.1.d0) then
            d1=2.d0*dsqrt(A1/pi)
         endif
         d2=prop(index+7)
         if(form_fact.eq.1.d0) then
            d2=2.d0*dsqrt(A2/pi)
         endif
         r1=prop(index+8)
         r2=prop(index+9)
         omega=prop(index+10)
!
         pt1=v(2,node1)
         pt2=v(2,node2)
!
         if(xflow.ge.0.d0) then
            inv=1
            xflow=v(1,nodem)*iaxial
            Tt1=v(0,node1)-physcon(1)
            Tt2=v(0,node2)-physcon(1)
         else
            inv=-1
            pt1=v(2,node2)
            pt2=v(2,node1)
            xflow=v(1,nodem)*iaxial
            Tt1=v(0,node2)-physcon(1)
            Tt2=v(0,node1)-physcon(1)
         endif
         call ts_calc(xflow,Tt1,pt1,kappa,r,A1,T1,ith)
c         Tt2=Tt1
         call ts_calc(xflow,Tt2,pt2,kappa,r,A2,T2,ith)
!
         pt2zpt1=pt2/pt1
!
         A=(A1+A2)/2.d0
         d=(d1+d2)/2.d0
!
!     calculation of the dynamic viscosity
!
         if(dabs(dvi).lt.1d-30) then
            write(*,*) '*ERROR in gaspipe_fanno: '
            write(*,*) '       no dynamic viscosity defined'
            write(*,*) '       dvi= ',dvi
            call exit(201)
         endif
!
         reynolds=dabs(xflow)*d/(dvi*A)
!
        if(reynolds.lt.1.d0) then
            reynolds= 1.d0
         endif
!
!     definition of the friction coefficient for pure air
!
         phi=1.d0
         call friction_coefficient(xl,d,ks,reynolds,form_fact,
     &        lambda)
!
!     definition of the coefficients
!
         M1=dsqrt(((Tt1/T1)-1)/km1d2)
         M2=dsqrt(((Tt2/T2)-1)/km1d2)
!
         write(1,*) ''
         write(1,55) ' from node ',node1,
     &        ' to node ', node2,':   air massflow rate = ',xflow
!
         if(inv.eq.1) then
            write(1,53)'       Inlet node ',node1,' :    Tt1 = ',Tt1,
     &           ' , Ts1 = ',T1,'  , Pt1 = ',pt1,
     &           ' , M1 = ',M1
            write(1,*)'             Element ',nelem,lakon(nelem)
            write(1,57)'             dvi = ',dvi,' , Re = '
     &           ,reynolds
            write(1,58)'             PHI = ',phi,' , LAMBDA = ',
     &           lambda,
     &           ', LAMBDA*l/d = ',lambda*xl/d,' , ZETA_PHI = ',
     &           phi*lambda*xl/d
            write(1,53)'      Outlet node ',node2,' :    Tt2 = ',
     &           Tt2,
     &           ' , Ts2 = ',T2,'  , Pt2 = ',pt2,
     &           ' , M2 = ',M2
!
         else if(inv.eq.-1) then
            write(1,53)'       Inlet node ',node2,':    Tt1= ',Tt1,
     &           ' , Ts1= ',T1,' , Pt1= ',pt1,
     &           ' , M1= ',M1
            write(1,*)'             Element ',nelem,lakon(nelem)
            write(1,57)'             dvi = ',dvi,' , Re = '
     &           ,reynolds
            write(1,58)'             PHI = ',phi,' , LAMBDA = ',
     &           lambda,
     &           ', LAMBDA*l/d = ',lambda*xl/d,' , ZETA_PHI = ',
     &           phi*lambda*xl/d
            write(1,53)'      Outlet node ',node1,' :    Tt2 = ',
     &           Tt2,
     &           ' , Ts2 = ',T2,'  , Pt2 =',pt2,
     &           ' , M2 = ',M2
         endif
      endif
!
 55   format(1X,a,i6,a,i6,a,e11.4,a,e11.4)
 53   format(1X,a,i6,a,e11.4,a,e11.4,a,e11.4,a,e11.4)
 57   format(1X,a,e11.4,a,e11.4)
 58   format(1X,a,e11.4,a,e11.4,a,e11.4,a,e11.4)
!
      xflow=xflow/iaxial
      df(3)=df(3)*iaxial
!
      return
      end


!>  ChiDG Interpolation Utilities
!!
!!  Purpose:
!!  ---------------------------------------
!!  Facilitate interpolation from modal representations
!!  to node discrete representations of variables.
!!
!!
!!  Public routines:
!!  ---------------------------------------
!!      interpolate_element_autodiff
!!      interpolate_face_autodiff
!!      !interpolate_edge_autodiff
!!      interpolate_general_autodiff
!!
!!      interpolate_element_standard
!!      interpolate_face_standard
!!
!!
!!  Module utility routines:
!!  ---------------------------------------
!!      get_elem_interpolation_info
!!      get_elem_interpolation_interpolator
!!      get_elem_interpolation_mask
!!      get_elem_interpolation_ndonors
!!      get_elem_interpolation_style
!!      get_interpolation_nderiv
!!
!!
!---------------------------------------------------------------------------------------------
module mod_interpolate
#include <messenger.h>
    use mod_kinds,              only: rk,ik
    use mod_constants,          only: CHIMERA, INTERIOR, BOUNDARY, &
                                      ME, NEIGHBOR, ONE, ZERO, NO_ID, NO_DATA, &
                                      dQ_DIFF, dBC_DIFF, NO_DIFF, dD_DIFF, dX_DIFF

    use mod_chidg_mpi,          only: IRANK
    use mod_DNAD_tools,         only: compute_neighbor_face
    use mod_chimera,            only: find_gq_donor, find_gq_donor_parallel
    use mod_polynomial,         only: polynomial_val
    use mod_differentiate,      only: differentiate_modal_coefficients, differentiate_element_interpolator, &
                                      differentiate_face_interior_interpolator, differentiate_face_parallel_interpolator, &
                                      differentiate_face_local_interpolator, differentiate_face_chimera_interpolator
    use DNAD_D

    use type_mesh,              only: mesh_t
    use type_element_info,      only: element_info_t, element_info
    use type_face_info,         only: face_info_constructor
    use type_edge_info,         only: edge_info_t
    use type_seed,              only: seed_t
    use type_function_info,     only: function_info_t
    use type_recv,              only: recv_t
    use type_chidg_vector,      only: chidg_vector_t
    implicit none

contains

    !>  Interpolate polynomial expansion to volume quadrature node set, initializing the
    !!  automatic differentiation process if needed.
    !!
    !!  This returns an array of automatic differentiation(AD) values at the quadrature nodes,
    !!  that also have their derivatives initialized.
    !!
    !!  Some interpolation parameters to note that are used inside here:
    !!      - interpolation_type:   'value', 'grad1', 'grad2', 'grad3'
    !!
    !!  Partial mode expansions can be used to perform interpolations. To do this, pass the
    !!  Pmin and Pmax optional arguments. Pmin is the minimum 1D polynomial order to be used
    !!  in the interpolation. Pmax is the maximum 1D polynomial order to be used in the
    !!  interpolation. One might pass Pmin=0, Pmax=1. This would return an interpolation that
    !!  used only the first 8 modes in the polynomial expansion. The constant mode and all
    !!  the linear modes, but no modes of higher order.
    !!
    !!
    !!  @author Nathan A. Wukie
    !!  @date   2/1/2016
    !!
    !!  @author Mayank Sharma + Matteo Ugolotti
    !!  @date   11/5/2016
    !!
    !!  @author Matteo Ugolotti
    !!  @date   9/3/2018
    !!
    !!  Added capability to compute dX derivatives. The differentiation comes from the geometric
    !!  side, that is from grad1, grad2 and grad3.
    !!  For dQ differentiation, the derivatives coms from the qdiff whereas for dX differentiation
    !!  the derivatives come fom the interpolator.
    !!  In order to speed up the matmul computation, qdiff (AD) and standard interpolator (rk)
    !!  are multiplied. Instead, q (rk) and differentiated interpolator (AD) are used for
    !!  dX case.
    !!  This is meant to avoid a matmul operation that involves two AD terms.
    !!
    !!  @author Matteo Ugolotti
    !!  @date   11/26/2018
    !!
    !!  Added BC linearization
    !!
    !!  @author Matteo Ugolotti
    !!  @date   5/10/2019
    !!
    !!  Added distance field linearization
    !!
    !-----------------------------------------------------------------------------------------
    function interpolate_element_autodiff(mesh,vector,elem_info,fcn_info,ifield,itime,interpolation_type,interpolator,mode_min,mode_max) result(var_gq)
        type(mesh_t),           intent(in)              :: mesh
        type(chidg_vector_t),   intent(inout)           :: vector
        type(element_info_t),   intent(in)              :: elem_info
        type(function_info_t),  intent(in)              :: fcn_info
        integer(ik),            intent(in)              :: ifield
        integer(ik),            intent(in)              :: itime
        character(*),           intent(in)              :: interpolation_type
        real(rk),               intent(in), optional    :: interpolator(:,:)
        integer(ik),            intent(in), optional    :: mode_min
        integer(ik),            intent(in), optional    :: mode_max

        character(:),   allocatable :: user_msg

        type(AD_D), allocatable :: qdiff(:), var_gq(:), interpolator_ad(:,:)
        real(rk),   allocatable :: qtmp(:), q(:)

        integer(ik) :: nderiv, set_deriv, iterm, nterms, ierr
        logical     :: differentiate_me

        associate( idom => elem_info%idomain_l, ielem => elem_info%ielement_l )

        user_msg = "interpolate_element_autodiff: currently only supports overriding the &
                    default interpolator for 'value' interpolations."
        if (present(interpolator) .and. (interpolation_type /= 'value')) call chidg_signal(FATAL,user_msg)

!        ! Get number of derivatives to initialize for automatic differentiation
!        nderiv = get_interpolation_nderiv(mesh,fcn_info%seed)

        ! Determine nterms from interpolator matrix
        nterms = mesh%domain(idom)%elems(ielem)%basis_s%nterms_i()

!        ! Allocate qdiff buffer and initialize derivative allocations + zero
!        allocate(qdiff(nterms), stat=ierr)
!        if (ierr /= 0) call AllocationError
!        do iterm = 1,nterms
!            qdiff(iterm) = AD_D(nderiv)
!        end do
!        qdiff = ZERO

        ! Retrieve modal coefficients representing ifield in vector to 'qtmp'
        qtmp = vector%get_field(elem_info,ifield,itime)

!        ! 1: If mode_min,mode_max are present, use a subset of the expansion modes.
!        ! 2: If not present, use the entire expansion.
!        if (present(mode_min) .and. present(mode_max)) then
!            qdiff(mode_min:mode_max) = qtmp(mode_min:mode_max)
!        else
!            qdiff(1:nterms) = qtmp(1:nterms)
!        end if
!
!        ! If the current element is being differentiated (ielem == ielem_seed)
!        ! then copy the solution modes to local AD variable and seed derivatives
!        !
!        ! If the current element is being differentiated (ielem == ielem_seed)
!        ! then copy the solution modes to local AD variable and seed derivatives
!        differentiate_me = ( (elem_info%idomain_g  == fcn_info%seed%idomain_g ) .and. &
!                             (elem_info%ielement_g == fcn_info%seed%ielement_g) .and. &
!                             (itime                == fcn_info%seed%itime) )
!
!        if (differentiate_me) then
!            ! Differentiating element, initialize appropriate derivatives to ONE
!            do iterm = 1,size(qdiff)
!                set_deriv = (ifield - 1)*mesh%domain(idom)%elems(ielem)%nterms_s + iterm
!                qdiff(iterm)%xp_ad_(set_deriv) = ONE
!            end do
!        else
!            ! Not differentiating element, set all derivatives to ZERO
!            do iterm = 1,size(qdiff)
!                qdiff(iterm)%xp_ad_ = ZERO
!            end do
!        end if

        ! Standard dQ differentiation, or no differentiation at all
        if (fcn_info%dtype == dQ_DIFF  .or. &
            fcn_info%dtype == dBC_DIFF .or. &
            fcn_info%dtype == NO_DIFF  .or. &
            fcn_info%dtype == dD_DIFF) then

            ! 1: If mode_min,mode_max are present, use a subset of the expansion modes.
            ! 2: If not present, use the entire expansion.
            if (present(mode_min) .and. present(mode_max)) then
                qdiff = differentiate_modal_coefficients(qtmp(mode_min:mode_max),fcn_info,elem_info,ifield,itime,nterms,mode_min,mode_max)
            else
                qdiff = differentiate_modal_coefficients(qtmp(1:nterms),fcn_info,elem_info,ifield,itime,nterms)
            end if

            ! Select interpolation type
            select case (interpolation_type)
                case('value')
                    if (present(interpolator)) then
                        var_gq = matmul(interpolator,qdiff)
                    else
                        var_gq = matmul(mesh%domain(idom)%elems(ielem)%basis_s%interpolator_element('Value'),qdiff)
                    end if

                case('grad1')
                    var_gq = matmul(mesh%domain(idom)%elems(ielem)%grad1,qdiff)

                case('grad2')
                    var_gq = matmul(mesh%domain(idom)%elems(ielem)%grad2,qdiff)

                case('grad3')
                    var_gq = matmul(mesh%domain(idom)%elems(ielem)%grad3,qdiff)

                case default
                    user_msg = "interpolate_element_autodiff: The 'interpolation_type' incoming&
                                parameter was not a valid string. Valid strings for &
                                'interpolation_type' include 'value', 'grad1', 'grad2', 'grad3'."
                    call chidg_signal_one(FATAL,user_msg,interpolation_type)
            end select

        ! dX differentiation
        else if (fcn_info%dtype == dX_DIFF) then

            ! Allocate q buffer in case of dX differentiation
            allocate(q(nterms), stat=ierr)
            if (ierr /= 0) call AllocationError

            ! 1: If mode_min,mode_max are present, use a subset of the expansion modes.
            ! 2: If not present, use the entire expansion.
            if (present(mode_min) .and. present(mode_max)) then
                q(mode_min:mode_max) = qtmp(mode_min:mode_max)
            else
                q(1:nterms) = qtmp(1:nterms)
            end if
            interpolator_ad = differentiate_element_interpolator(interpolation_type,mesh,elem_info,fcn_info,itime)
            var_gq = matmul(interpolator_ad,q)

        else
            user_msg = "interpolate_element_autodiff: The 'fcn_info%dtype' incoming&
                        parameter was not a valid string. Valid strings for &
                        'differentiation_type' include 'dQ', 'dX', 'dBC, 'NO'."
            call chidg_signal_one(FATAL,user_msg,fcn_info%dtype)

        end if

        end associate

    end function interpolate_element_autodiff
    !*****************************************************************************************

    !>  Interpolate variable from polynomial expansion to explicit values at quadrature
    !!  nodes. The automatic differentiation process really starts here, when the polynomial
    !!  expansion is evaluated.
    !!
    !!  The interpolation process occurs through a matrix-vector multiplication. That is an
    !!  interpolation matrix multiplied by a vector of modes from the polynomial expansion.
    !!  To start the automatic differentiation, the derivative arrays of the values for the
    !!  polynomial modes must be initialized before any computation. So, before the
    !!  matrix-vector multiplication.
    !!
    !!  Some interpolation parameters to note that a user might select:
    !!      - interpolation_type:   'value', 'grad1', 'grad2', 'grad3'
    !!      - interpolation_source: ME, NEIGHBOR
    !!
    !!  @author Nathan A. Wukie
    !!  @date   2/1/2016
    !!
    !!  @param[in]      mesh                    Array of mesh instances.
    !!  @param[in]      face                    Face indices for locating the face in mesh.
    !!  @param[in]      vector                  A chidg_vector containing a modal representation of fields on mesh
    !!  @param[in]      ifield                  Index of field being interpolated
    !!  @param[inout]   var_gq                  Autodiff values of field evaluated at gq points
    !!  @param[in]      interpolation_type      Interpolate 'value', 'grad1', 'grad2', 'grad3'
    !!  @param[in]      interpolation_source    ME/NEIGHBOR indicating element to interpolate from
    !!
    !!  @author Mayank Sharma + Matteo Ugolotti
    !!  @date   11/5/2016
    !!
    !!  @param[in]      itime                   Index for time step in solution
    !!
    !------------------------------------------------------------------------------------------
    function interpolate_face_autodiff(mesh,vector,elem_info,fcn_info, iface, ifield, itime, interpolation_type, interpolation_source) result(var_gq)
        type(mesh_t),           intent(in)              :: mesh
        type(chidg_vector_t),   intent(inout)           :: vector
        type(element_info_t),   intent(in)              :: elem_info
        type(function_info_t),  intent(in)              :: fcn_info
        integer(ik),            intent(in)              :: iface
        integer(ik),            intent(in)              :: ifield
        integer(ik),            intent(in)              :: itime
        character(*),           intent(in)              :: interpolation_type
        integer(ik),            intent(in)              :: interpolation_source

        type(element_info_t) :: donor_info

        type(AD_D),         allocatable :: qdiff(:), var_gq(:)
        real(rk),           allocatable :: qtmp(:), q(:)
        real(rk),           allocatable :: interpolator(:,:)
        type(AD_D),         allocatable :: interpolator_ad(:,:)
        character(:),       allocatable :: interpolation_style

        integer(ik) :: nderiv, set_deriv, iterm, igq, nterms_s, ierr, nnodes, donor_iface
        logical     :: differentiate_me, conforming_interpolation, chimera_interpolation

        ! Chimera data
        integer(ik)                 :: ndonors, idonor
        logical,    allocatable     :: mask(:)          ! node mask for distributing Chimera quadrature points
        type(AD_D), allocatable     :: var_gq_chimera(:)

        ! Allocate output array
        nnodes   = mesh%domain(elem_info%idomain_l)%elems(elem_info%ielement_l)%basis_s%nnodes_face()
        nterms_s = mesh%domain(elem_info%idomain_l)%elems(elem_info%ielement_l)%basis_s%nterms_i()
        allocate(var_gq(nnodes), stat=ierr)
        if (ierr /= 0) call AllocationError

        ! Get number of donors for the interpolation
        ndonors = get_elem_interpolation_ndonors(mesh,elem_info,iface,interpolation_source)

        ! Get interpolation style. Conforming or Chimera
        interpolation_style = get_elem_interpolation_style(mesh,elem_info,iface,interpolation_source)
        conforming_interpolation = (interpolation_style == 'conforming')
        chimera_interpolation    = (interpolation_style == 'chimera')

        ! For each donor element to the interpolation.
        ! (ndonors could be > 1 for Chimera interpolations)
        do idonor = 1,ndonors

            ! Get face info for face being interpolated to(ME, NEIGHBOR),
            ! interpolation matrix, and recv data for parallel access
            donor_iface  = compute_neighbor_face(mesh,elem_info%idomain_l,elem_info%ielement_l,iface,idonor)         ! THIS PROBABLY NEEDS IMPROVED
            donor_info   = get_elem_interpolation_info(        mesh,elem_info,iface,interpolation_source,idonor)
            mask         = get_elem_interpolation_mask(        mesh,elem_info,iface,interpolation_source,idonor)
            interpolator = get_elem_interpolation_interpolator(mesh,elem_info,iface,interpolation_source,idonor,interpolation_type,donor_info,donor_iface)

            ! Deduce nterms from interpolator matrix
            nterms_s = size(interpolator,2)

            ! Retrieve modal coefficients for ifield from vector
            qtmp = vector%get_field(donor_info,ifield,itime)

            select case(fcn_info%dtype)

                case(dX_DIFF)

                    ! Allocate solution vector q for dX differentiation
                    if ( allocated(q) ) deallocate(q)
                    allocate(q(nterms_s), stat=ierr)
                    if (ierr /= 0) call AllocationError

                    ! Copy the right modes to q
                    q = qtmp(1:nterms_s)

                    ! Initialize interpolator with grid-node derivatives
                    interpolator_ad = get_elem_interpolation_interpolator_ad(mesh,                 &
                                                                             elem_info,            &
                                                                             iface,                &
                                                                             interpolation_source, &
                                                                             idonor,               &
                                                                             donor_info,           &
                                                                             donor_iface,          &
                                                                             interpolation_type,   &
                                                                             fcn_info,             &
                                                                             itime)

                    if ( conforming_interpolation ) then
                        var_gq = matmul(interpolator_ad,q)

                    elseif ( chimera_interpolation ) then
                        ! Perform interpolation
                        var_gq_chimera = matmul(interpolator_ad,q)

                        ! Scatter chimera nodes to appropriate location in var_gq
                        var_gq = unpack(var_gq_chimera,mask,var_gq)

                    else
                        call chidg_signal(FATAL,"interpolate_face: face interpolation type error")
                    end if

                case default

                    !qdiff = differentiate_modal_coefficients(qtmp(1:nterms_s),fcn_info,elem_info,ifield,itime,nterms_s)
                    qdiff = differentiate_modal_coefficients(qtmp(1:nterms_s),fcn_info,donor_info,ifield,itime,nterms_s)

                    ! Interpolate solution to GQ nodes via matrix-vector multiplication
                    if ( conforming_interpolation ) then
                        var_gq = matmul(interpolator,  qdiff)

                    elseif ( chimera_interpolation ) then
                        ! Perform interpolation
                        var_gq_chimera = matmul(interpolator,  qdiff)

                        ! Scatter chimera nodes to appropriate location in var_gq
                        var_gq = unpack(var_gq_chimera,mask,var_gq)

                    else
                        call chidg_signal(FATAL,"interpolate_face: face interpolation type error")
                    end if

            end select

        end do ! idonor

    end function interpolate_face_autodiff
    !*****************************************************************************************

    !> Compute variable at quadrature nodes.
    !!
    !!  @author Nathan A. Wukie
    !!  @date   2/1/2016
    !!
    !!  @author Mayank Sharma + Matteo Ugolotti
    !!  @date   11/5/2016
    !!
    !----------------------------------------------------------------------------------------
    function interpolate_element_standard(mesh,q,idomain_l,ielement_l,ifield,itime,interpolation_type) result(var_gq)
        type(mesh_t),           intent(in)      :: mesh
        type(chidg_vector_t),   intent(inout)   :: q
        integer(ik),            intent(in)      :: idomain_l
        integer(ik),            intent(in)      :: ielement_l
        integer(ik),            intent(in)      :: ifield
        integer(ik),            intent(in)      :: itime
        character(*),           intent(in)      :: interpolation_type

        real(rk),   allocatable :: var_gq(:)
        type(element_info_t)    :: elem_info

        elem_info = mesh%get_element_info(idomain_l,ielement_l)

        ! Use quadrature instance to compute variable at quadrature nodes.
        ! This takes the form of a matrix multiplication of the quadrature matrix
        ! with the array of modes for the given variable.
        select case (interpolation_type)
            case('value')
                var_gq = matmul(mesh%domain(idomain_l)%elems(ielement_l)%basis_s%interpolator_element('Value'), q%get_field(elem_info,ifield,itime))
            case('grad1')
                var_gq = matmul(mesh%domain(idomain_l)%elems(ielement_l)%grad1, q%get_field(elem_info,ifield,itime))
            case('grad2')
                var_gq = matmul(mesh%domain(idomain_l)%elems(ielement_l)%grad2, q%get_field(elem_info,ifield,itime))
            case('grad3')
                var_gq = matmul(mesh%domain(idomain_l)%elems(ielement_l)%grad3, q%get_field(elem_info,ifield,itime))
            case default
                call chidg_signal(FATAL,"interpolate_element_standard: invalid interpolation_type. Options are 'value', 'grad1', 'grad2', 'grad3'.")
        end select

    end function interpolate_element_standard
    !*****************************************************************************************

    !> Compute variable at quadrature nodes.
    !!
    !!  @author Nathan A. Wukie
    !!  @date   2/1/2016
    !!
    !!  @author Mayank Sharma + Matteo Ugolotti
    !!  @date   11/5/2016
    !!
    !-----------------------------------------------------------------------------------------
    function interpolate_face_standard(mesh,q,idomain_l,ielement_l,iface,ifield,itime) result(var_gq)
        type(mesh_t),           intent(in)      :: mesh
        type(chidg_vector_t),   intent(inout)   :: q
        integer(ik),            intent(in)      :: idomain_l
        integer(ik),            intent(in)      :: ielement_l
        integer(ik),            intent(in)      :: iface
        integer(ik),            intent(in)      :: ifield
        integer(ik),            intent(in)      :: itime

        real(rk),   allocatable :: var_gq(:)
        type(element_info_t)    :: elem_info

        elem_info = mesh%get_element_info(idomain_l,ielement_l)

        !
        ! Use quadrature instance to compute variable at quadrature nodes.
        ! This takes the form of a matrix multiplication of the face quadrature matrix
        ! with the array of modes for the given variable
        !
        !var_gq = matmul(mesh%domain(idomain_l)%faces(ielement_l,iface)%basis_s%interpolator_face('Value',iface), q%dom(idomain_l)%vecs(ielement_l)%getvar(ifield,itime))
        var_gq = matmul(mesh%domain(idomain_l)%faces(ielement_l,iface)%basis_s%interpolator_face('Value',iface), q%get_field(elem_info,ifield,itime))

    end function interpolate_face_standard
    !*****************************************************************************************

    !> Interpolate variable from polynomial expansion to explicit values at quadrature nodes. The automatic
    !! differentiation process really starts here, when the polynomial expansion is evaluated.
    !!
    !! The interpolation process occurs through a matrix-vector multiplication. That is an interpolation matrix
    !! multiplied by a vector of modes from the polynomial expansion. To start the automatic differentiation,
    !! the derivative arrays of the values for the polynomial modes must be initialized before any computation.
    !! So, before the matrix-vector multiplication.
    !!
    !!  @author Nathan A. Wukie
    !!  @date   2/1/2016
    !!
    !-----------------------------------------------------------------------------------------------------------
    function interpolate_general_autodiff(mesh,vector,fcn_info,ifield,itime,interpolation_type,nodes,try_offset,donors,donor_nodes) result(var)
        type(mesh_t),           intent(in)              :: mesh
        type(chidg_vector_t),   intent(inout)           :: vector
        type(function_info_t),  intent(in)              :: fcn_info
        integer(ik),            intent(in)              :: ifield
        integer(ik),            intent(in)              :: itime
        character(*),           intent(in)              :: interpolation_type
        real(rk),               intent(in), optional    :: nodes(:,:)
        real(rk),               intent(in), optional    :: try_offset(3)
        type(element_info_t),   intent(in), optional    :: donors(:)
        real(rk),               intent(in), optional    :: donor_nodes(:,:)

        type(element_info_t)    :: donor
        type(recv_t)            :: recv_info

        type(AD_D), allocatable  :: qdiff(:), var(:), tmp(:)
        real(rk),   allocatable  :: interpolator(:,:)

        real(rk)        :: donor_node(3), donor_volume
        integer(ik)     :: nderiv, set_deriv, iterm, ierr, nterms_s, inode, nnodes
        logical         :: differentiate_me = .false.
        logical         :: donor_found      = .false.
        logical         :: parallel_donor   = .false.

        ! 1: Check incoming node array makes sense
        ! 2: Check interpolation_type
        if (present(nodes)) then
            if (size(nodes,2) /= 3) call chidg_signal(FATAL,'interpolate_general_autodiff: size(nodes,2) /= 3.')
        else if (present(donor_nodes)) then
            if (size(donor_nodes,2) /= 3) call chidg_signal(FATAL,'interpolate_general_autodiff: size(donor_nodes,2) /= 3.')
        end if
        if (interpolation_type /= 'value') call chidg_signal(FATAL,"interpolation_general_autodiff: currently only supports interpolation_type == 'value'.")

        ! Get number of derivatives to initialize for automatic differentiation
        nderiv = get_interpolation_nderiv(mesh,fcn_info%seed)

        ! Get nnodes
        if (present(nodes)) nnodes = size(nodes,1)
        if (present(donor_nodes)) nnodes = size(donor_nodes,1)

        ! Allocate result and derivatives
        allocate(var(nnodes), stat=ierr)
        if (ierr /= 0) call AllocationError

        do inode = 1,size(var)
            allocate(var(inode)%xp_ad_(nderiv))
        end do

        ! Find donor elements for incoming nodes
        do inode = 1,nnodes

            if (present(donors) .and. present(donor_nodes)) then
                donor       = donors(inode)
                donor_node = donor_nodes(inode,:)

            else
                !
                ! Try processor-LOCAL elements
                !
                call find_gq_donor(mesh,                                &
                                   nodes(inode,1:3),                    &
                                   [ZERO,ZERO,ZERO],                    &
                                   face_info_constructor(0,0,0,0,0,0),    &   ! we don't really have a receiver face
                                   donor,                               &
                                   donor_node,                          &
                                   donor_found,                         &
                                   donor_volume=donor_volume)

                !
                ! Try LOCAL elements with try_offset if still not found and try_offset
                ! is present
                !
                if ( (.not. donor_found) .and. (present(try_offset)) ) then
                    call find_gq_donor(mesh,                                &
                                       nodes(inode,1:3),                    &
                                       try_offset,                          &
                                       face_info_constructor(0,0,0,0,0,0),    &   ! we don't really have a receiver face
                                       donor,                               &
                                       donor_node,                          &
                                       donor_found,                         &
                                       donor_volume=donor_volume)

                end if

                !
                ! Try PARALLEL_ELEMENTS if donor not found amongst local elements
                !
                if (.not. donor_found) then
                    call find_gq_donor_parallel(mesh,                               &
                                                nodes(inode,1:3),                   &
                                                [ZERO,ZERO,ZERO],                   &
                                                face_info_constructor(0,0,0,0,0,0),   &   ! we don't really have a receiver face
                                                donor,                              &
                                                donor_node,                         &
                                                donor_found,                        &
                                                donor_volume=donor_volume)
                end if

                !
                ! Try PARALLEL_ELEMENTS with try_offset if still not found and
                ! try_offset is present
                !
                if ( (.not. donor_found) .and. (present(try_offset)) ) then
                    call find_gq_donor_parallel(mesh,                               &
                                                nodes(inode,1:3),                   &
                                                try_offset,                         &
                                                face_info_constructor(0,0,0,0,0,0),   &   ! we don't really have a receiver face
                                                donor,                              &
                                                donor_node,                         &
                                                donor_found,                        &
                                                donor_volume=donor_volume)
                end if

                ! Abort if we didn't find a donor
                if (.not. donor_found) call chidg_signal(FATAL,"interpolate_general_autodiff: no donor element found for interpolation node.")

            end if ! Find Donor

            ! Check parallel or local donor
            parallel_donor = (donor%iproc /= IRANK)

            ! Get nterms
            if (parallel_donor) then
                nterms_s = mesh%parallel_element(donor%pelem_ID)%nterms_s
            else
                nterms_s = mesh%domain(donor%idomain_l)%elems(donor%ielement_l)%nterms_s
            end if

            ! Construct interpolator
            if (allocated(interpolator)) deallocate(interpolator)
            allocate(interpolator(1,nterms_s), stat=ierr)
            if (ierr /= 0) call AllocationError

            do iterm = 1,nterms_s
                interpolator(1,iterm) = polynomial_val(3,nterms_s,iterm,donor_node)
            end do ! iterm

            ! Allocate solution and derivative arrays for temporary solution variable
            if ( allocated(qdiff) ) deallocate(qdiff)
            allocate(qdiff(nterms_s), stat=ierr)
            if (ierr /= 0) call AllocationError

            do iterm = 1,nterms_s
                qdiff(iterm) = AD_D(nderiv)
            end do

            ! Retrieve modal coefficients for ifield from vector
            !! OLD
            !if (parallel_donor) then
            !    recv_info%comm    = mesh%parallel_element(donor%pelem_ID)%recv_comm
            !    recv_info%domain  = mesh%parallel_element(donor%pelem_ID)%recv_domain
            !    recv_info%element = mesh%parallel_element(donor%pelem_ID)%recv_element
            !    qdiff = vector%recv%comm(recv_info%comm)%dom(recv_info%domain)%vecs(recv_info%element)%getvar(ifield,itime)
            !else
            !    qdiff = vector%dom(donor%idomain_l)%vecs(donor%ielement_l)%getvar(ifield,itime)
            !end if
            ! NEW
            qdiff = vector%get_field(donor,ifield,itime)

            ! If the current element is being differentiated (ielem == ielem_seed)
            ! then copy the solution modes to local AD variable and seed derivatives
            differentiate_me = ( (donor%idomain_g  == fcn_info%seed%idomain_g ) .and. &
                                 (donor%ielement_g == fcn_info%seed%ielement_g) .and. &
                                 (itime            == fcn_info%seed%itime) )

            if ( differentiate_me ) then
                ! Loop through the terms in qdiff, seed appropriate derivatives to ONE
                do iterm = 1,size(qdiff)
                    ! For the given term, seed its appropriate derivative
                    set_deriv = (ifield - 1)*nterms_s + iterm
                    qdiff(iterm)%xp_ad_(set_deriv) = ONE
                end do

            else
                ! Loop through the terms in qdiff. Set all derivatives to ZERO
                do iterm = 1,size(qdiff)
                    qdiff(iterm)%xp_ad_ = ZERO
                end do

            end if

            ! Interpolate solution to GQ nodes via matrix-vector multiplication
            tmp = matmul(interpolator,  qdiff)
            var(inode) = tmp(1)

        end do ! inode

    end function interpolate_general_autodiff
    !*************************************************************************************************************

!    !> Interpolate variable from polynomial expansion to explicit values at quadrature nodes. The automatic
!    !! differentiation process really starts here, when the polynomial expansion is evaluated.
!    !!
!    !! The interpolation process occurs through a matrix-vector multiplication. That is an interpolation matrix
!    !! multiplied by a vector of modes from the polynomial expansion. To start the automatic differentiation,
!    !! the derivative arrays of the values for the polynomial modes must be initialized before any computation.
!    !! So, before the matrix-vector multiplication.
!    !!
!    !!  @author Nathan A. Wukie
!    !!  @date   2/1/2016
!    !!
!    !!  @param[in]      mesh        Array of mesh instances.
!    !!  @param[in]      face        Face info, such as indices for locating the face in the mesh.
!    !!  @param[in]      q           Solution vector
!    !!  @param[in]      ieqn        Index of the equation variable being interpolated
!    !!  @param[inout]   var_gq      Array of auto-diff values of the equation evaluated at gq points that is passed back
!    !!  @param[in]      source      ME/NEIGHBOR indicating which element to interpolate from
!    !!
!    !-----------------------------------------------------------------------------------------------------------
!    subroutine interpolate_boundary_autodiff(mesh,face,q,ieqn,points,var)
!        type(mesh_t),           intent(in)              :: mesh(:)
!        type(face_info_t),      intent(in)              :: face
!        type(chidg_vector_t),    intent(in)              :: q
!        integer(ik),            intent(in)              :: ieqn
!        type(point_t),          intent(in)              :: points(:)
!        type(AD_D),             intent(inout)           :: var(:)
!
!        integer(ik)     :: idomain_l, ielement_l, iface
!        type(seed_t)    :: seed
!
!        type(AD_D), allocatable  :: qdiff(:)
!        type(AD_D), allocatable  :: tmp(:)
!        real(rk),   allocatable  :: interpolator(:,:)
!
!        real(rk)        :: xi, eta, zeta
!        integer(ik)     :: nderiv, set_deriv, iterm, nterms_s, ierr, neqns_seed, nterms_s_seed, ipnt, nterms
!        integer(ik)     :: idomain_l_seed, ielement_l_seed, idonor, idomain_l_interp, ielement_l_interp, igq
!        integer(ik)     :: idom_d, ielem_d
!        type(point_t)   :: point_comp, node
!        type(ivector_t) :: donor_domains, donor_elements
!        type(rvector_t) :: donor_xi, donor_eta, donor_zeta
!        logical         :: linearize_me             = .false.
!
!
!
!
!
!        idomain_l  = face%idomain_l
!        ielement_l = face%ielement_l
!        iface      = face%iface
!        seed       = face%seed
!
!
!        !
!        ! Get domain/element index that is being differentiated
!        !
!        idomain_l_seed  = seed%idomain_l
!        ielement_l_seed = seed%ielement_l
!
!
!
!        !
!        ! Get the number of degrees of freedom for the seed element
!        ! and set this as the number of partial derivatives to track
!        !
!        if (ielement_l_seed == 0) then
!            !
!            ! If ielem_seed == 0 then we aren't interested in tracking derivatives
!            !
!            nderiv = 1
!
!        else
!            !
!            ! Get number of equations and terms in solution expansions
!            !
!            neqns_seed    = mesh(idomain_l_seed)%elems(ielement_l_seed)%neqns
!            nterms_s_seed = mesh(idomain_l_seed)%elems(ielement_l_seed)%nterms_s
!
!            !
!            ! Compute number of unknowns in the seed element, which is the number of partial derivatives we are tracking
!            !
!            nderiv = neqns_seed  *  nterms_s_seed
!        end if
!
!
!
!        !
!        ! Allocate the derivative array for each autodiff variable
!        ! MIGHT NOT NEED THIS IF IT GETS AUTOMATICALLY ALLOCATED ON ASSIGNMENT -- TEST
!        !
!        do igq = 1,size(var)
!            allocate(var(igq)%xp_ad_(nderiv))
!        end do
!
!
!
!
!        !
!        ! Find elements associated with boundary nodes
!        !
!        do ipnt = 1,size(points)
!
!
!            call compute_element_donor(mesh, points(ipnt), idom_d, ielem_d, point_comp)
!
!
!            call donor_domains%push_back(  idom_d  )
!            call donor_elements%push_back( ielem_d )
!            call donor_xi%push_back(   point_comp%c1_ )
!            call donor_eta%push_back(  point_comp%c2_ )
!            call donor_zeta%push_back( point_comp%c3_ )
!
!        end do ! ipnt
!
!
!
!
!        !
!        ! For each donor element to the interpolation.
!        !
!        do idonor = 1,donor_elements%size()
!
!
!            !
!            ! Get donor element and coordinate
!            !
!            idom_interp  = donor_domains%at(idonor)
!            ielem_interp = donor_elements%at(idonor)
!
!            xi   = donor_xi%at(  idonor)
!            eta  = donor_eta%at( idonor)
!            zeta = donor_zeta%at(idonor)
!
!            call node%set(xi,eta,zeta)
!
!
!            !
!            ! Get interpolation matrix from quadrature instance
!            !
!            nterms = mesh(idom_interp)%elems(ielem_interp)%nterms_s
!            if (allocated(interpolator)) deallocate(interpolator)
!            allocate(interpolator(1,nterms), stat=ierr)
!            if (ierr /= 0) call AllocationError
!
!            do iterm = 1,nterms
!                interpolator(1,iterm) = polynomial_val(3,nterms,iterm,node)
!            end do ! imode
!
!
!
!
!
!            !
!            ! If the current element is being differentiated (ielem == ielem_seed)
!            ! then copy the solution modes to local AD variable and seed derivatives
!            !
!
!            linearize_me = ( (idom_interp == idom_seed) .and. (ielem_interp == ielem_seed) )
!
!            if ( linearize_me ) then
!
!
!                !
!                ! Allocate AD array to store a copy of the solution which starts the differentiation
!                !
!                nterms_s = mesh(idom_interp)%elems(ielem_interp)%nterms_s
!                if ( allocated(qdiff) ) deallocate(qdiff)
!                allocate(qdiff(nterms_s), stat=ierr)
!                if (ierr /= 0) call AllocationError
!
!
!                !
!                ! Allocate derivative arrays for temporary solution variable
!                !
!                do iterm = 1,nterms_s
!                    allocate(qdiff(iterm)%xp_ad_(nderiv))
!                end do
!
!
!                !
!                ! Copy the solution variables from 'q' to 'qdiff'
!                !
!                qdiff = q%dom(idom_interp)%vecs(ielem_interp)%getvar(ieqn)
!
!
!                !
!                ! Loop through the terms in qdiff and seed derivatives
!                !
!                do iterm = 1,size(qdiff)
!                    ! For the given term, seed its appropriate derivative
!                    set_deriv = (ieqn - 1)*nterms_s + iterm
!                    qdiff(iterm)%xp_ad_(set_deriv) = 1.0_rk
!                end do
!
!
!
!
!                !
!                ! Interpolate solution to GQ nodes via matrix-vector multiplication
!                !
!                !var(idonor) = matmul(interpolator(1,:),  qdiff)
!                tmp = matmul(interpolator,  qdiff)
!                var(idonor) = tmp(1)
!
!            else
!
!                !
!                ! If the solution variable derivatives dont need initialized
!                ! then just use the q(ielem) values and derivatives get
!                ! initialized to zero
!                !
!
!                if ( allocated(tmp) ) deallocate(tmp)
!                allocate(tmp(1))
!                allocate(tmp(1)%xp_ad_(nderiv))
!
!
!                !var(idonor) = matmul(interpolator(1,:),  q%dom(idom_interp)%vecs(ielem_interp)%getvar(ieqn))
!                tmp = matmul(interpolator,  q%dom(idom_interp)%vecs(ielem_interp)%getvar(ieqn))
!                var(idonor) = tmp(1)
!
!            end if
!
!
!
!
!        end do ! idonor
!
!
!    end subroutine interpolate_boundary_autodiff
!    !*************************************************************************************************************

    !>  This routine returns face_info data for the face being interpolated to.
    !!
    !!  Given a face, interpolation type, and interpolation source, this routine returns
    !!      - a face_info_t of the face to be interpolated to
    !!      - an interpolation matrix
    !!      - receiver info to be used if the interpolation is remote
    !!
    !!  @author Nathan A. Wukie (AFRL)
    !!  @date   8/16/2016
    !!
    !!
    !-----------------------------------------------------------------------------------------
    function get_elem_interpolation_info(mesh,source_info,source_iface,interpolation_source,idonor) result(donor_info)
        type(mesh_t),           intent(in)  :: mesh
        type(element_info_t),   intent(in)  :: source_info
        integer(ik),            intent(in)  :: source_iface
        integer(ik),            intent(in)  :: interpolation_source
        integer(ik),            intent(in)  :: idonor

        type(element_info_t)    :: donor_info
        integer(ik)             :: ChiID, recv_dof
        logical                 :: conforming_interpolation, chimera_interpolation

        associate( idom => source_info%idomain_l, ielem => source_info%ielement_l, iface => source_iface)

        !
        ! Compute neighbor access indices
        !
        if ( interpolation_source == ME ) then
            ! Interpolate from ME element
            donor_info = source_info

        elseif ( interpolation_source == NEIGHBOR ) then

            chimera_interpolation    = ( mesh%domain(idom)%faces(ielem,iface)%ftype == CHIMERA )
            conforming_interpolation = ( mesh%domain(idom)%faces(ielem,iface)%ftype == INTERIOR )

            ! Interpolate from conforming NEIGHBOR element
            if ( conforming_interpolation ) then

                donor_info = element_info(idomain_g         = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%ineighbor_domain_g,         &
                                          idomain_l         = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%ineighbor_domain_l,         &
                                          ielement_g        = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%ineighbor_element_g,        &
                                          ielement_l        = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%ineighbor_element_l,        &
                                          iproc             = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%ineighbor_proc,             &
                                          pelem_ID          = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%ineighbor_pelem_ID,         &
                                          coordinate_system = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%coordinate_system,          &
                                          eqn_ID            = NO_ID,                                                                                &
                                          nfields           = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%ineighbor_nfields,          &
                                          ntime             = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%ineighbor_ntime,            &
                                          nterms_s          = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%ineighbor_nterms_s,         &
                                          nterms_c          = NO_DATA,                                                                                &
                                          dof_start         = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%ineighbor_dof_start,        &
                                          dof_local_start   = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%ineighbor_dof_local_start,  &
                                          xdof_start        = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%ineighbor_xdof_start,       &
                                          xdof_local_start  = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%ineighbor_xdof_local_start, &
                                          recv_comm         = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%recv_comm,                  &
                                          recv_domain       = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%recv_domain,                &
                                          recv_element      = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%recv_element,               &
                                          recv_dof          = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%recv_dof,                   &
                                          recv_xdof         = mesh%domain(source_info%idomain_l)%faces(source_info%ielement_l,source_iface)%recv_xdof)

            ! Interpolate from CHIMERA donor element
            elseif ( chimera_interpolation ) then
                ChiID = mesh%domain(idom)%faces(ielem,iface)%ChiID
                donor_info = mesh%domain(source_info%idomain_l)%chimera%recv(ChiID)%donor(idonor)%elem_info

            else
                call chidg_signal(FATAL,"get_elem_interpolation_info: neighbor conforming_interpolation nor chimera_interpolation were detected")
            end if

        else
            call chidg_signal(FATAL,"get_elem_interpolation_info: invalid source. ME or NEIGHBOR.")
        end if

        end associate

    end function get_elem_interpolation_info
    !*****************************************************************************************

    !>  This returns an interpolation matrix that is used to actually perform the interpolation
    !!  from a modal expansion to a set of quadrature nodes.
    !!
    !!  The interpolation from a modal expansion to a set of quadrature nodes takes the form
    !!  of a matrix-vector multiplication, where the vector entries are modal coefficients of
    !!  the polynomial expansion, and the matrix contains entries that evaluate the modes of
    !!  the polynomial expansion at the quadrature nodes. This routine returns the
    !!  interpolation matrix. Additionally, an interpolation could be computing the actual
    !!  value of the expansion at the nodes('value'), or it could be computing derivatives
    !!  ('grad1', 'grad2', 'grad3'). The interpolation_type specifies what kind of interpolation
    !!  to perform.
    !!
    !!  Given a face, interpolation type, and interpolation source, this routine returns
    !!      - a face_info_t of the face to be interpolated to
    !!      - an interpolation matrix
    !!      - receiver info to be used if the interpolation is remote
    !!
    !!  @author Nathan A. Wukie (AFRL)
    !!  @date   8/16/2016
    !!
    !!
    !----------------------------------------------------------------------------------------
    function get_elem_interpolation_interpolator(mesh,source_elem,source_iface,interpolation_source,idonor,interpolation_type,donor_elem,donor_iface) result(interpolator)
        type(mesh_t),           intent(in)  :: mesh
        type(element_info_t),   intent(in)  :: source_elem
        integer(ik),            intent(in)  :: source_iface
        integer(ik),            intent(in)  :: interpolation_source
        integer(ik),            intent(in)  :: idonor
        type(element_info_t),   intent(in)  :: donor_elem
        integer(ik),            intent(in)  :: donor_iface
        character(*),           intent(in)  :: interpolation_type

        real(rk),       allocatable :: interpolator(:,:)
        integer(ik),    allocatable :: gq_node_indices(:)
        integer(ik)                 :: inode, ChiID, donor_proc
        logical                     :: conforming_interpolation, chimera_interpolation, parallel_interpolation

        associate( idom => source_elem%idomain_l, ielem => source_elem%ielement_l, iface => source_iface )

        !
        ! Compute neighbor access indices
        !
        if ( interpolation_source == ME ) then
            select case(interpolation_type)
                case('value')
                    interpolator = mesh%domain(idom)%faces(ielem,iface)%basis_s%interpolator_face('Value',iface)
                case('grad1')
                    interpolator = mesh%domain(idom)%faces(ielem,iface)%grad1
                case('grad2')
                    interpolator = mesh%domain(idom)%faces(ielem,iface)%grad2
                case('grad3')
                    interpolator = mesh%domain(idom)%faces(ielem,iface)%grad3
                case default
                    call chidg_signal(FATAL,"get_elem_interpolation_interpolator: Invalid interpolation_type. Options are 'value', 'grad1', 'grad2', 'grad3'.")
            end select

        elseif ( interpolation_source == NEIGHBOR ) then

            chimera_interpolation    = ( mesh%domain(idom)%faces(ielem,iface)%ftype == CHIMERA )
            conforming_interpolation = ( mesh%domain(idom)%faces(ielem,iface)%ftype == INTERIOR )

            ! Interpolate from conforming NEIGHBOR element
            if ( conforming_interpolation ) then

                parallel_interpolation   = ( IRANK /= mesh%domain(idom)%faces(ielem,iface)%ineighbor_proc )

                ! If parallel use iface_interp to get an interpolation for an opposite face. Assumes same order and eqns.
                if (parallel_interpolation) then
                    select case(interpolation_type)
                        case('value')
                            interpolator = mesh%domain(idom)%faces(ielem,iface)%basis_s%interpolator_face('Value',donor_iface)    ! THIS PROBABLY NEEDS IMPROVED
                        case('grad1')
                            interpolator = mesh%domain(idom)%faces(ielem,iface)%neighbor_grad1
                        case('grad2')
                            interpolator = mesh%domain(idom)%faces(ielem,iface)%neighbor_grad2
                        case('grad3')
                            interpolator = mesh%domain(idom)%faces(ielem,iface)%neighbor_grad3
                        case default
                            call chidg_signal(FATAL,"get_elem_interpolation_interpolator: Invalid interpolation_type. Options are 'value', 'grad1', 'grad2', 'grad3'.")
                    end select
                else
                    select case(interpolation_type)
                        case('value')
                            interpolator = mesh%domain(donor_elem%idomain_l)%faces(donor_elem%ielement_l,donor_iface)%basis_s%interpolator_face('Value',donor_iface)
                        case('grad1')
                            interpolator = mesh%domain(donor_elem%idomain_l)%faces(donor_elem%ielement_l,donor_iface)%grad1
                        case('grad2')
                            interpolator = mesh%domain(donor_elem%idomain_l)%faces(donor_elem%ielement_l,donor_iface)%grad2
                        case('grad3')
                            interpolator = mesh%domain(donor_elem%idomain_l)%faces(donor_elem%ielement_l,donor_iface)%grad3
                        case default
                            call chidg_signal(FATAL,"get_elem_interpolation_interpolator: Invalid interpolation_type. Options are 'value', 'grad1', 'grad2', 'grad3'.")
                    end select
                end if

            ! Interpolate from CHIMERA donor element
            elseif ( chimera_interpolation ) then
                ChiID = mesh%domain(idom)%faces(ielem,iface)%ChiID
                    select case(interpolation_type)
                        case('value')
                            interpolator = mesh%domain(idom)%chimera%recv(ChiID)%donor(idonor)%value
                        case('grad1')
                            interpolator = mesh%domain(idom)%chimera%recv(ChiID)%donor(idonor)%grad1
                        case('grad2')
                            interpolator = mesh%domain(idom)%chimera%recv(ChiID)%donor(idonor)%grad2
                        case('grad3')
                            interpolator = mesh%domain(idom)%chimera%recv(ChiID)%donor(idonor)%grad3
                        case default
                            call chidg_signal(FATAL,"get_elem_interpolation_interpolator: Invalid interpolation_type. Options are 'value', 'grad1', 'grad2', 'grad3'.")
                    end select

            else
                call chidg_signal(FATAL,"get_elem_interpolation_interpolator: neighbor conforming_interpolation nor chimera_interpolation were detected")
            end if

        else
            call chidg_signal(FATAL,"get_elem_interpolation_interpolator: invalid source. ME or NEIGHBOR.")
        end if

        end associate

    end function get_elem_interpolation_interpolator
    !*****************************************************************************************

    !>  This returns an interpolation matrix that is used to actually perform the interpolation
    !!  from a modal expansion to a set of quadrature nodes.
    !!
    !!  Compared to get_elem_interpolation_interpolator, this routine returns also the derivatives
    !!  wrt the grid-nodes for each interpolator.
    !!
    !!  The interpolation from a modal expansion to a set of quadrature nodes takes the form
    !!  of a matrix-vector multiplication, where the vector entries are modal coefficients of
    !!  the polynomial expansion, and the matrix contains entries that evaluate the modes of
    !!  the polynomial expansion at the quadrature nodes. This routine returns the
    !!  interpolation matrix. Additionally, an interpolation could be computing the actual
    !!  value of the expansion at the nodes('value'), or it could be computing derivatives
    !!  ('grad1', 'grad2', 'grad3'). The interpolation_type specifies what kind of interpolation
    !!  to perform.
    !!
    !!  Given a face, interpolation type, and interpolation source, this routine returns
    !!      - a face_info_t of the face to be interpolated to
    !!      - an interpolation matrix
    !!      - receiver info to be used if the interpolation is remote
    !!
    !!  @author Matteo Ugolotti
    !!  @date   9/3/2018
    !!
    !!
    !----------------------------------------------------------------------------------------
    function get_elem_interpolation_interpolator_ad(mesh,source_elem,source_iface,interpolation_source,idonor,donor_elem,donor_iface,interpolation_type,fcn_info,itime) result(interpolator)
        type(mesh_t),           intent(in)  :: mesh
        type(element_info_t),   intent(in)  :: source_elem
        integer(ik),            intent(in)  :: source_iface
        integer(ik),            intent(in)  :: interpolation_source
        integer(ik),            intent(in)  :: idonor
        type(element_info_t),   intent(in)  :: donor_elem
        integer(ik),            intent(in)  :: donor_iface
        character(*),           intent(in)  :: interpolation_type
        type(function_info_t), intent(in)   :: fcn_info
        integer(ik),            intent(in)  :: itime

        type(AD_D),     allocatable :: interpolator(:,:)
        integer(ik),    allocatable :: gq_node_indices(:)
        integer(ik)                 :: inode, ChiID, donor_proc
        logical                     :: conforming_interpolation, chimera_interpolation, parallel_interpolation

        associate( idom => source_elem%idomain_l, ielem => source_elem%ielement_l, iface => source_iface )

        ! Compute neighbor access indices
        if ( interpolation_source == ME ) then
            interpolator = differentiate_face_interior_interpolator(interpolation_type,mesh,source_elem,source_iface,donor_elem,donor_iface,fcn_info,itime)

        elseif ( interpolation_source == NEIGHBOR ) then

            chimera_interpolation    = ( mesh%domain(idom)%faces(ielem,iface)%ftype == CHIMERA )
            conforming_interpolation = ( mesh%domain(idom)%faces(ielem,iface)%ftype == INTERIOR )

            ! Interpolate from conforming NEIGHBOR element
            if ( conforming_interpolation ) then
                parallel_interpolation   = ( IRANK /= mesh%domain(idom)%faces(ielem,iface)%ineighbor_proc )
                ! If parallel use iface_interp to get an interpolation for an opposite face. Assumes same order and eqns.
                if (parallel_interpolation) then
                    interpolator = differentiate_face_parallel_interpolator(interpolation_type,mesh,source_elem,source_iface,donor_elem,donor_iface,fcn_info,itime)
                else
                    interpolator = differentiate_face_local_interpolator(interpolation_type,mesh,source_elem,source_iface,donor_elem,donor_iface,fcn_info,itime)
                end if

            ! Interpolate from CHIMERA donor element
            elseif ( chimera_interpolation ) then
                ChiID = mesh%domain(idom)%faces(ielem,iface)%ChiID
                interpolator = differentiate_face_chimera_interpolator(interpolation_type,mesh,source_elem,source_iface,donor_elem,ChiID,idonor,fcn_info,itime)

            else
                call chidg_signal(FATAL,"get_elem_interpolation_interpolator_ad: neighbor conforming_interpolation nor chimera_interpolation were detected")
            end if

        else
            call chidg_signal(FATAL,"get_elem_interpolation_interpolator_ad: invalid source. ME or NEIGHBOR.")
        end if

        end associate

    end function get_elem_interpolation_interpolator_ad
    !*****************************************************************************************

    !>  This routine returns a logical mask that indicates which nodes in the full
    !!  quadrature node set are to be filled by a chimera donor. This defines the scatter
    !!  pattern for the nodes returned by a chimera donor to the nodes in the full node set.
    !!
    !!  If the interpolation is not a CHIMERA interpolation, then the mask is simply allocated
    !!  to length one and has no meaning.
    !!
    !!  @author Nathan A. Wukie (AFRL)
    !!  @date   8/16/2016
    !!
    !!
    !-----------------------------------------------------------------------------------------
    function get_elem_interpolation_mask(mesh,source_info,source_iface,interpolation_source,idonor) result(mask)
        type(mesh_t),           intent(in)  :: mesh
        type(element_info_t),   intent(in)  :: source_info
        integer(ik),            intent(in)  :: source_iface
        integer(ik),            intent(in)  :: interpolation_source
        integer(ik),            intent(in)  :: idonor

        logical, allocatable :: mask(:) !< This gets returned if CHIMERA interpolation

        integer(ik), allocatable    :: gq_node_indices(:)
        integer(ik)                 :: inode, ChiID, nnodes, ierr
        logical                     :: chimera_interpolation

        associate( idom => source_info%idomain_l, ielem => source_info%ielement_l, iface => source_iface )

        if ( interpolation_source == NEIGHBOR ) then

            nnodes = mesh%domain(idom)%faces(ielem,iface)%basis_s%nnodes_face()
            allocate(mask(nnodes), stat=ierr)
            mask = .false.
            if (ierr /= 0) call AllocationError

            chimera_interpolation = ( mesh%domain(idom)%faces(ielem,iface)%ftype == CHIMERA )

            !
            ! Interpolate from CHIMERA donor element
            !
            if ( chimera_interpolation ) then
                ChiID = mesh%domain(idom)%faces(ielem,iface)%ChiID
                gq_node_indices = mesh%domain(idom)%chimera%recv(ChiID)%donor(idonor)%node_index(:)

                ! Create mask over full GQ vector of only those nodes that are filled by the current element
                do inode = 1,size(gq_node_indices)
                    mask(gq_node_indices(inode)) = .true.
                end do

            end if

        else
            ! Otherwise, just allocate something so it doens't segfault when it tries to return.
            allocate(mask(1))

        end if

        end associate

    end function get_elem_interpolation_mask
    !*****************************************************************************************

!    !>  This routine returns a recv_t communication structure indicating whether the
!    !!  interpolation donor is LOCAL or REMOTE.
!    !!
!    !!  The recv_t contains recv_comm, recv_domain, and recv_element components. If these are
!    !!  set, then the interpolation is remote and these indices specify where in the 'recv'
!    !!  container to find the solution modes for the interpolation. If these indices are not
!    !!  set, then the interpolation is LOCAL and the main interpolation routine can use the
!    !!  local element indices to locate the solution modes.
!    !!
!    !!
!    !!  @author Nathan A. Wukie (AFRL)
!    !!  @date   8/16/2016
!    !!
!    !!
!    !-----------------------------------------------------------------------------------------
!    function get_elem_interpolation_comm(mesh,source_info,source_iface,interpolation_source,idonor) result(recv_info)
!        type(mesh_t),           intent(in)  :: mesh
!        type(element_info_t),   intent(in)  :: source_info
!        integer(ik),            intent(in)  :: source_iface
!        integer(ik),            intent(in)  :: interpolation_source
!        integer(ik),            intent(in)  :: idonor
!
!
!        type(recv_t)    :: recv_info                !< This gets set if REMOTE interpolation
!        integer(ik)     :: ChiID, donor_proc
!        logical         :: conforming_interpolation, chimera_interpolation, parallel_interpolation
!
!
!        associate( idom => source_info%idomain_l, ielem => source_info%ielement_l, iface => source_iface)
!
!        !
!        ! Initialize recv_info container to null, indicating LOCAL interpolation.
!        ! Always the case, if interpolation_source=ME.
!        !
!        recv_info = recv_t(0,0,0)
!
!
!
!        if ( interpolation_source == NEIGHBOR ) then
!
!            chimera_interpolation    = ( mesh%domain(idom)%faces(ielem,iface)%ftype == CHIMERA )
!            conforming_interpolation = ( mesh%domain(idom)%faces(ielem,iface)%ftype == INTERIOR )
!
!
!            ! Interpolate from conforming NEIGHBOR element
!            if ( conforming_interpolation ) then
!
!                parallel_interpolation   = ( IRANK /= mesh%domain(idom)%faces(ielem,iface)%ineighbor_proc )
!
!                if (parallel_interpolation) then
!                    recv_info%comm    = mesh%domain(idom)%faces(ielem,iface)%recv_comm
!                    recv_info%domain  = mesh%domain(idom)%faces(ielem,iface)%recv_domain
!                    recv_info%element = mesh%domain(idom)%faces(ielem,iface)%recv_element
!                end if
!
!
!
!            ! Interpolate from CHIMERA donor element
!            elseif ( chimera_interpolation ) then
!                ChiID = mesh%domain(idom)%faces(ielem,iface)%ChiID
!                donor_proc = mesh%domain(idom)%chimera%recv(ChiID)%donor(idonor)%iproc
!
!                parallel_interpolation = (IRANK /= donor_proc)
!                if (parallel_interpolation) then
!                     recv_info%comm    = mesh%domain(idom)%chimera%recv(ChiID)%donor(idonor)%recv_comm
!                     recv_info%domain  = mesh%domain(idom)%chimera%recv(ChiID)%donor(idonor)%recv_domain
!                     recv_info%element = mesh%domain(idom)%chimera%recv(ChiID)%donor(idonor)%recv_element
!                end if
!
!            else
!                call chidg_signal(FATAL,"get_elem_interpolation_comm: neighbor conforming_interpolation nor chimera_interpolation were detected")
!            end if
!
!
!        end if
!
!        end associate
!
!    end function get_elem_interpolation_comm
!    !*****************************************************************************************

    !>  Return the number of elements contributing to the interpolation.
    !!
    !!  For standard conforming interpolations this will be ==1.
    !!  For Chimera interpolations, this could be >=1.
    !!
    !!  @author Nathan A. Wukie(AFRL)
    !!  @date   8/17/2016
    !!
    !!
    !-----------------------------------------------------------------------------------------
    function get_elem_interpolation_ndonors(mesh,source_info,source_iface,interpolation_source) result(ndonors)
        type(mesh_t),           intent(in)  :: mesh
        type(element_info_t),   intent(in)  :: source_info
        integer(ik),            intent(in)  :: source_iface
        integer(ik),            intent(in)  :: interpolation_source

        integer(ik) :: ndonors, ChiID
        logical     :: chimera_interpolation, conforming_interpolation

        associate( idom => source_info%idomain_l, ielem => source_info%ielement_l, iface => source_iface)

        !
        ! Test if interpolating from local element
        !
        if ( interpolation_source == ME ) then

            ndonors = 1

        !
        ! Test if interpolating from neighbor element(s)
        !
        elseif (interpolation_source == NEIGHBOR ) then

            chimera_interpolation    = ( mesh%domain(idom)%faces(ielem,iface)%ftype == CHIMERA )
            conforming_interpolation = ( mesh%domain(idom)%faces(ielem,iface)%ftype == INTERIOR )

            ! Test for standard conforming interpolation from neighbor
            if ( conforming_interpolation ) then
                ndonors = 1

            ! Test for chimera interpolation from neighbor
            elseif ( chimera_interpolation ) then
                ChiID   = mesh%domain(idom)%faces(ielem,iface)%ChiID
                ndonors = mesh%domain(idom)%chimera%recv(ChiID)%ndonors()

            else
                call chidg_signal(FATAL,"get_elem_interpolation_ndonors: invalid value for 'face%ftype'")
            end if

        else
            call chidg_signal(FATAL,"get_elem_interpolation_ndonors: invalid value for incoming parameter 'source'")
        end if

        end associate

    end function get_elem_interpolation_ndonors
    !*****************************************************************************************

    !>  Return the style of the interpolation.
    !!
    !!  Interpolation styles include:
    !!      - 'conforming'    conforming interpolation
    !!      - 'chimera'       chimera interpolation
    !!
    !!  @author Nathan A. Wukie(AFRL)
    !!  @date   8/17/2016
    !!
    !!
    !----------------------------------------------------------------------------------------
    function get_elem_interpolation_style(mesh,source_info,source_iface,interpolation_source) result(interpolation_style)
        type(mesh_t),           intent(in)  :: mesh
        type(element_info_t),   intent(in)  :: source_info
        integer(ik),            intent(in)  :: source_iface
        integer(ik),            intent(in)  :: interpolation_source

        character(:),   allocatable :: interpolation_style
        logical                     :: conforming_interpolation, chimera_interpolation

        associate( idom => source_info%idomain_l, ielem => source_info%ielement_l, iface => source_iface)

        if ( interpolation_source == ME ) then
            conforming_interpolation = ( (mesh%domain(idom)%faces(ielem,iface)%ftype == INTERIOR) .or. &
                                         (mesh%domain(idom)%faces(ielem,iface)%ftype == BOUNDARY) .or. &
                                         (mesh%domain(idom)%faces(ielem,iface)%ftype == CHIMERA) )         ! including chimera here because in the ME case, it doesn't matter
        elseif (interpolation_source == NEIGHBOR ) then
            chimera_interpolation    = ( mesh%domain(idom)%faces(ielem,iface)%ftype == CHIMERA  )
            conforming_interpolation = ( mesh%domain(idom)%faces(ielem,iface)%ftype == INTERIOR )
        else
            call chidg_signal(FATAL,"get_elem_interpolation_style: Invalid interpolation_source. ME or NEIGHBOR")
        end if

        if (conforming_interpolation) then
            interpolation_style = "conforming"
        else if (chimera_interpolation) then
            interpolation_style = "chimera"
        else
            call chidg_signal(FATAL,"get_elem_interpolation_style: Error in selecting interpolation style")
        end if

        end associate

    end function get_elem_interpolation_style
    !******************************************************************************************

!    !>  This returns an interpolation matrix that is used to actually perform the interpolation
!    !!  from a modal expansion to a set of interpolation nodes.
!    !!
!    !!  The interpolation from a modal expansion to a set of quadrature nodes takes the form
!    !!  of a matrix-vector multiplication, where the vector entries are modal coefficients of
!    !!  the polynomial expansion, and the matrix contains entries that evaluate the modes of
!    !!  the polynomial expansion at the interpolation nodes. This routine returns the
!    !!  interpolation matrix. Additionally, an interpolation could be computing the actual
!    !!  value of the expansion at the nodes('value'), or it could be computing derivatives
!    !!  ('grad1', 'grad2', 'grad3'). The interpolation_type specifies what kind of interpolation
!    !!  to perform.
!    !!
!    !!
!    !!  @author Nathan A. Wukie
!    !!  @date   12/6/2017
!    !!
!    !!
!    !----------------------------------------------------------------------------------------
!    function get_edge_interpolation_interpolator(mesh,edge_info,interpolation_type) result(interpolator)
!        type(mesh_t),       intent(in)  :: mesh
!        type(edge_info_t),  intent(in)  :: edge_info
!        character(*),       intent(in)  :: interpolation_type
!
!        real(rk), allocatable :: interpolator(:,:)
!
!        associate( idom  => edge_info%idomain_l,  &
!                   ielem => edge_info%ielement_l, &
!                   iedge => edge_info%iedge )
!
!        !
!        ! Compute neighbor access indices
!        !
!        select case(interpolation_type)
!            case('value')
!                interpolator = mesh%domain(idom)%elems(ielem)%basis_s%interpolator_edge('Value',iedge)
!            case('grad1')
!                interpolator = mesh%domain(idom)%elems(ielem)%edge_grad1(:,:,iedge)
!            case('grad2')
!                interpolator = mesh%domain(idom)%elems(ielem)%edge_grad2(:,:,iedge)
!            case('grad3')
!                interpolator = mesh%domain(idom)%elems(ielem)%edge_grad3(:,:,iedge)
!            case default
!                call chidg_signal(FATAL,"get_edge_interpolation_interpolator: Invalid interpolation_type. Options are 'value', 'grad1', 'grad2', 'grad3'.")
!        end select
!
!
!        end associate
!
!
!    end function get_edge_interpolation_interpolator
!    !*****************************************************************************************

    !>  Determine the number of derivatives being computed for the automatic differentiation
    !!  process.
    !!
    !!  This is the number of degrees of freedom in the element being differentiated with
    !!  respect to.
    !!
    !!  @author Nathan A. Wukie (AFRL)
    !!  @date   8/17/2016
    !!
    !-----------------------------------------------------------------------------------------
    function get_interpolation_nderiv(mesh,seed) result(nderiv)
        type(mesh_t),           intent(in)  :: mesh
        type(seed_t),           intent(in)  :: seed

        integer(ik) :: nderiv

        !
        ! If ielem_seed == 0 then we aren't interested in tracking derivatives.
        !   !So set it to lowest number possible while still having something
        !   !allocated in the AD type so the operations are valid.
        !
        !   Actually, allocating with size 0 is okay in fortran. Just need to be
        !   careful not to try and access anything as var%xp_ad_(1)
        !
        if (seed%ielement_l == 0) then
            !nderiv = 1
            nderiv = 0

        else

            ! Compute number of unknowns in the seed element, which is the number of
            ! partial derivatives we are tracking.
            nderiv = seed%nfields * seed%nterms_s

        end if

    end function get_interpolation_nderiv
    !*****************************************************************************************

    !>
    !!
    !!
    !! @author  Eric M. Wolf
    !! @date    07/27/2018
    !!
    !--------------------------------------------------------------------------------
    function interpolate_from_vertices(vert_vals,node) result(val)
        real(rk) :: vert_vals(8), node(3)
        real(rk) :: val

        !if (abs(node(1)>1.0_rk)) print *, 'node(1) out of bounds'
        !if (abs(node(2)>1.0_rk)) print *, 'node(2) out of bounds'
        !if (abs(node(3)>1.0_rk)) print *, 'node(3) out of bounds'

        ! Corresponding (xi, eta, zeta) for each vertex:
        ! 1: (-1,-1,-1), 2: (-1,-1,1), 3: (-1,1,-1), 4: (-1,1,1), 5: (1,-1,-1), 6: (1, -1, 1), 7: (1,1,-1), 8: (1,1,1)
        val =   vert_vals(1)*(1.0_rk-node(1))*(1.0_rk-node(2))*(1.0_rk-node(3))/8.0_rk + &
                vert_vals(2)*(1.0_rk-node(1))*(1.0_rk-node(2))*(node(3)+1.0_rk)/8.0_rk + &
                vert_vals(3)*(1.0_rk-node(1))*(node(2)+1.0_rk)*(node(3)+1.0_rk)/8.0_rk + &
                vert_vals(4)*(1.0_rk-node(1))*(node(2)+1.0_rk)*(1.0_rk-node(3))/8.0_rk + &
                vert_vals(5)*(node(1)+1.0_rk)*(1.0_rk-node(2))*(1.0_rk-node(3))/8.0_rk + &
                vert_vals(6)*(node(1)+1.0_rk)*(1.0_rk-node(2))*(node(3)+1.0_rk)/8.0_rk + &
                vert_vals(7)*(node(1)+1.0_rk)*(node(2)+1.0_rk)*(node(3)+1.0_rk)/8.0_rk + &
                vert_vals(8)*(node(1)+1.0_rk)*(node(2)+1.0_rk)*(1.0_rk-node(3))/8.0_rk

    end function interpolate_from_vertices
    !*****************************************************************************************

end module mod_interpolate