subroutine shape2(s,t,nnode,shape,deriv,heslo)

!-----------------------------------------------------------------------
!
!    This routine evaluates shape functions and their first and
!    second derivatives for 2-d continuos standar interpolation
!    elements.
!
!    TRIANGLES       3   6   10  &  15  nodes
!    QUADRILATERALS  4   9   16  &  25  nodes
!
!-----------------------------------------------------------------------

  use      typre
  implicit none
  integer(ip), intent(in)  :: nnode
  real(rp),    intent(in)  :: s,t
  real(rp),    intent(out) :: deriv(2,nnode),shape(nnode),heslo(3,nnode)
  real(rp)                 :: st,ss,tt,s1,s2,s3,s4,t1,t2,t3,t4,s9,t9,c,a
  real(rp)                 :: a1,a2,a3
  real(rp) ::  Nt(5), DNt(5), D2Nt(5), Ns(5), DNs(5), D2Ns(5)
  if(nnode==3) then
     shape(1)=1.0_rp-s-t
     shape(2)=s
     shape(3)=t                                           !  3
     deriv(1,1)=-1.0_rp                                   !
     deriv(1,2)= 1.0_rp                                   !
     deriv(1,3)= 0.0_rp                                   !
     deriv(2,1)=-1.0_rp                                   !  1       2
     deriv(2,2)= 0.0_rp
     deriv(2,3)= 1.0_rp
  else if(nnode==4) then
     st=s*t
     shape(1)=(1.0_rp-t-s+st)*0.25_rp                     !  4         3
     shape(2)=(1.0_rp-t+s-st)*0.25_rp                     !
     shape(3)=(1.0_rp+t+s+st)*0.25_rp                     !
     shape(4)=(1.0_rp+t-s-st)*0.25_rp                     !
     deriv(1,1)=(-1.0_rp+t)*0.25_rp                       !  1         2
     deriv(1,2)=(+1.0_rp-t)*0.25_rp
     deriv(1,3)=(+1.0_rp+t)*0.25_rp
     deriv(1,4)=(-1.0_rp-t)*0.25_rp
     deriv(2,1)=(-1.0_rp+s)*0.25_rp
     deriv(2,2)=(-1.0_rp-s)*0.25_rp
     deriv(2,3)=(+1.0_rp+s)*0.25_rp
     deriv(2,4)=(+1.0_rp-s)*0.25_rp
     heslo(3,1)= 0.25_rp
     heslo(3,2)=-0.25_rp
     heslo(3,3)= 0.25_rp
     heslo(3,4)=-0.25_rp
  else if(nnode==6) then
     a1=1.0_rp-s-t
     a2=s
     a3=t
     shape( 1)=(2.0_rp*a1-1.0_rp)*a1                      !  3
     shape( 2)=(2.0_rp*a2-1.0_rp)*a2                      !
     shape( 3)=(2.0_rp*a3-1.0_rp)*a3                      !
     shape( 4)=4.0_rp*a1*a2                               !  6     5
     shape( 5)=4.0_rp*a2*a3                               !
     shape( 6)=4.0_rp*a1*a3                               !
     deriv(1,1)= 1.0_rp-4.0_rp*a1                         !  1     4     2
     deriv(1,2)= 4.0_rp*a2-1.0_rp
     deriv(1,3)= 0.0_rp
     deriv(1,4)= 4.0_rp*(a1-a2)
     deriv(1,5)= 4.0_rp*a3
     deriv(1,6)=-4.0_rp*a3
     deriv(2,1)= 1.0_rp-4.0_rp*a1
     deriv(2,2)= 0.0_rp
     deriv(2,3)= 4.0_rp*a3-1.0_rp
     deriv(2,4)=-4.0_rp*a2
     deriv(2,5)= 4.0_rp*a2
     deriv(2,6)= 4.0_rp*(a1-a3)
     heslo(1,1)= 4.0_rp
     heslo(1,2)= 4.0_rp
     heslo(1,4)=-8.0_rp
     heslo(2,1)= 4.0_rp
     heslo(2,3)= 4.0_rp
     heslo(2,6)=-8.0_rp
     heslo(3,1)= 4.0_rp
     heslo(3,4)=-4.0_rp
     heslo(3,5)= 4.0_rp
     heslo(3,6)=-4.0_rp
  else if(nnode==9) then
     ss=s*s
     st=s*t
     tt=t*t
     s1=s+1.0_rp
     t1=t+1.0_rp
     s2=s*2.0_rp
     t2=t*2.0_rp
     s9=s-1.0_rp
     t9=t-1.0_rp                                          !  4      7      3
     shape( 1)=0.25_rp*s9*st*t9                           !
     shape( 2)=0.25_rp*s1*st*t9                           !
     shape( 3)=0.25_rp*s1*st*t1                           !
     shape( 4)=0.25_rp*s9*st*t1                           !  8      9      6
     shape( 5)=0.5_rp*(1.0_rp-ss)*t*t9                    !
     shape( 6)=0.5_rp*s*s1*(1.0_rp-tt)                    !
     shape( 7)=0.5_rp*(1.0_rp-ss)*t*t1                    !
     shape( 8)=0.5_rp*s*s9*(1.0_rp-tt)                    !  1      5      2
     shape( 9)=(1.0_rp-ss)*(1.0_rp-tt)
     deriv(1,1)= 0.25_rp*t*t9*(-1.0_rp+s2)
     deriv(1,2)= 0.25_rp*(1.0_rp+s2)*t*t9
     deriv(1,3)= 0.25_rp*(1.0_rp+s2)*t*t1
     deriv(1,4)= 0.25_rp*(-1.0_rp+s2)*t*t1
     deriv(1,5)=-st*t9
     deriv(1,6)= 0.5_rp*(1.0_rp+s2)*(1.0_rp-tt)
     deriv(1,7)=-st*t1
     deriv(1,8)= 0.5_rp*(-1.0_rp+s2)*(1.0_rp-tt)
     deriv(1,9)=-s2*(1.0_rp-tt)
     deriv(2,1)= 0.25_rp*(-1.0_rp+t2)*s*s9
     deriv(2,2)= 0.25_rp*s*s1*(-1.0_rp+t2)
     deriv(2,3)= 0.25_rp*s*s1*(1.0_rp+t2)
     deriv(2,4)= 0.25_rp*s*s9*(1.0_rp+t2)
     deriv(2,5)= 0.5_rp*(1.0_rp-ss)*(-1.0_rp+t2)
     deriv(2,6)=-st*s1
     deriv(2,7)= 0.5_rp*(1.0_rp-ss)*(1.0_rp+t2)
     deriv(2,8)=-st*s9
     deriv(2,9)=-t2*(1.0_rp-ss)
     heslo(1,1)= 0.5_rp*t*t9
     heslo(1,2)= 0.5_rp*t*t9
     heslo(1,3)= 0.5_rp*t*t1
     heslo(1,4)= 0.5_rp*t*t1
     heslo(1,5)=-t*t9
     heslo(1,6)= 1.0_rp-tt
     heslo(1,7)=-t*t1
     heslo(1,8)= 1.0_rp-tt
     heslo(1,9)=-2.0_rp*(1.0_rp-tt)
     heslo(2,1)= 0.5_rp*s*s9
     heslo(2,2)= 0.5_rp*s*s1
     heslo(2,3)= 0.5_rp*s*s1
     heslo(2,4)= 0.5_rp*s*s9
     heslo(2,5)= 1.0_rp-ss
     heslo(2,6)=-s*s1
     heslo(2,7)= 1.0_rp-ss
     heslo(2,8)=-s*s9
     heslo(2,9)=-2.0_rp*(1.0_rp-ss)
     heslo(3,1)= 0.25_rp*(-1.0_rp+t2)*(s9+s)
     heslo(3,2)= 0.25_rp*(-1.0_rp+t2)*(s1+s)
     heslo(3,3)= 0.25_rp*(1.0_rp+t2)*(s1+s)
     heslo(3,4)= 0.25_rp*(1.0_rp+t2)*(s9+s)
     heslo(3,5)=-s*(-1.0_rp+t2)
     heslo(3,6)=-t*s1-st
     heslo(3,7)=-s*(1.0_rp+t2)
     heslo(3,8)=-t*s9-st
     heslo(3,9)= s2*t2
  else if(nnode==10) then
     c=9.0_rp/2.0_rp
     a1=(3.0_rp-3.0_rp*s-3.0_rp*t)/3.0_rp
     a2=(2.0_rp-3.0_rp*(s+t))/3.0_rp
     a3=(1.0_rp-3.0_rp*(s+t))/3.0_rp
     shape( 1)=c*a1*a2*a3                                        !  3
     shape( 2)=c*(3.0_rp*s-1.0_rp)*(3.0_rp*s-2.0_rp)*s/9.0_rp    !
     shape( 3)=c*(1.0_rp-3.0_rp*t)*(2.0_rp-3.0_rp*t)*t/9.0_rp    !
     shape( 4)= 3.0_rp*c*a1*a2*s                                 !  8    7
     shape( 5)=-c*a1*(1.0_rp-3.0_rp*s)*s                         !
     shape( 6)=-c*(1.0_rp-3.0_rp*s)*s*t                          !
     shape( 7)=-c*s*(1.0_rp-3.0_rp*t)*t                          !  9   10    6
     shape( 8)=-c*a1*(1.0_rp-3.0_rp*t)*t                         !
     shape( 9)= 3.0_rp*c*a1*a2*t                                 !
     shape(10)= 6.0_rp*c*a1*s*t                                  !  1    4    5    2
     deriv(1, 1)=-c*(a1*a2+a1*a3+a2*a3)
     deriv(1, 2)=-c*((2.0_rp-3.0_rp*s)/3.0_rp*s&
          + (1.0_rp-3.0_rp*s)/3.0_rp*s-(1.0_rp-3.0_rp*s)*(2.0_rp-3.0_rp*s)/9.0_rp)
     deriv(1, 3)=0.0_rp
     deriv(1, 4)= 3.0_rp*c*(a1*a2-a1*s-a2*s)
     deriv(1, 5)=-3.0_rp*c*(a1*(1.0_rp-3.0_rp*s)/3.0_rp&
          - a1*s-(1.0_rp-3.0_rp*s)*s/3.0_rp)
     deriv(1, 6)=-3.0_rp*c*((1.0_rp-3.0_rp*s)*t/3.0_rp-s*t)
     deriv(1, 7)=-c*(1.0_rp-3.0_rp*t)*t
     deriv(1, 8)= c*(1.0_rp-3.0_rp*t)*t
     deriv(1, 9)= 3.0_rp*c*(-a1*t-a2*t)
     deriv(1,10)= 6.0_rp*c*(a1*t-s*t)
     deriv(2, 1)=-c*(a1*a2+a1*a3+a2*a3)
     deriv(2, 2)= 0.0_rp
     deriv(2, 3)=-c*((2.0_rp-3.0_rp*t)*t/3.0_rp&
          + (1.0_rp-3.0_rp*t)*t/3.0_rp-(1.0_rp-3.0_rp*t)*(2.0_rp-3.0_rp*t)/9.0_rp)
     deriv(2, 4)= 3.0_rp*c*(-a1*s-a2*s)
     deriv(2, 5)=c*(1.0_rp-3.0_rp*s)*s
     deriv(2, 6)=-c*(1.0_rp-3.0_rp*s)*s
     deriv(2, 7)=-3.0_rp*c*((1.0_rp-3.0_rp*t)*s/3.0_rp-s*t)
     deriv(2, 8)=-3.0_rp*c*(-(1.0_rp-3.0_rp*t)*t/3.0_rp&
          - a1*t+a1*(1.0_rp-3.0_rp*t)/3.0_rp)
     deriv(2, 9)= 3.0_rp*c*(-a1*t-a2*t+a1*a2)
     deriv(2,10)= 6.0_rp*c*(a1*s-s*t)
     heslo(1, 1)= c*(6.0_rp*a1+6.0_rp*a2+6.0_rp*a3)/3.0_rp
     heslo(1, 2)=-c*(2.0_rp-6.0_rp*s)
     heslo(1, 3)= 0.0_rp
     heslo(1, 4)= c*(-6.0_rp*a1-6.0_rp*a2+6.0_rp*s)
     heslo(1, 5)=-c*(-6.0_rp*a1-2.0_rp*(1.0_rp-3.0_rp*s)+6.0_rp*s)
     heslo(1, 6)= 6.0_rp*c*t
     heslo(1, 7)= 0.0_rp
     heslo(1, 8)= 0.0_rp
     heslo(1, 9)= 6.0_rp*c*t
     heslo(1,10)=-12.0_rp*c*t
     heslo(2, 1)= c*(6.0_rp*a1+6.0_rp*a2+6.0_rp*a3)/3.0_rp
     heslo(2, 2)= 0.0_rp
     heslo(2, 3)=-c*(2.0_rp-6.0_rp*t)
     heslo(2, 4)= 6.0_rp*c*s
     heslo(2, 5)= 0.0_rp
     heslo(2, 6)= 0.0_rp
     heslo(2, 7)= 6.0_rp*c*s
     heslo(2, 8)=-c*(-6.0_rp*a1-2.0_rp*(1.0_rp-3.0_rp*t)+6.0_rp*t)
     heslo(2, 9)= c*(-6.0_rp*a1-6.0_rp*a2+6.0_rp*t)
     heslo(2,10)=-12.0_rp*c*s
     heslo(3, 1)= c*(6.0_rp*a1+6.0_rp*a2+6.0_rp*a3)/3.0_rp
     heslo(3, 2)= 0.0_rp
     heslo(3, 3)= 0.0_rp
     heslo(3, 4)= c*(-3.0_rp*a1-3.0_rp*a2+6.0_rp*s)
     heslo(3, 5)=-c*(-(1.0_rp-3.0_rp*s)+3.0_rp*s)
     heslo(3, 6)=-c*(1.0_rp-6.0_rp*s)
     heslo(3, 7)=-c*(1.0_rp-6.0_rp*t)
     heslo(3, 8)= c*(1.0_rp-6.0_rp*t)
     heslo(3, 9)= c*(-3.0_rp*a1-3.0_rp*a2+6.0_rp*t)
     heslo(3,10)= c*(6.0_rp*a1-6.0_rp*s-6.0_rp*t)
  else if(nnode==16) then
     a =81.0_rp/256.0_rp
     s1=(3.0_rp+3.0_rp*s)/3.0_rp
     s2=(1.0_rp+3.0_rp*s)/3.0_rp
     s3=(1.0_rp-3.0_rp*s)/3.0_rp
     s4=(3.0_rp-3.0_rp*s)/3.0_rp
     t1=(3.0_rp+3.0_rp*t)/3.0_rp
     t2=(1.0_rp+3.0_rp*t)/3.0_rp
     t3=(1.0_rp-3.0_rp*t)/3.0_rp
     t4=(3.0_rp-3.0_rp*t)/3.0_rp
     shape( 1) =   a*s2*s3*s4*t2*t3*t4                   ! 4    10    9    3
     shape( 2) =   a*s1*s2*s3*t2*t3*t4                   !
     shape( 3) =   a*s1*s2*s3*t1*t2*t3                   !
     shape( 4) =   a*s2*s3*s4*t1*t2*t3                   ! 11   16   15    8
     shape( 5) =-3.0_rp*a*s1*s3*s4*t2*t3*t4              !
     shape( 6) =-3.0_rp*a*s1*s2*s4*t2*t3*t4              !
     shape( 7) =-3.0_rp*a*s1*s2*s3*t1*t3*t4              ! 12   13   14    7
     shape( 8) =-3.0_rp*a*s1*s2*s3*t1*t2*t4              !
     shape( 9) =-3.0_rp*a*s1*s2*s4*t1*t2*t3              !
     shape(10) =-3.0_rp*a*s1*s3*s4*t1*t2*t3              ! 1     5    6    2
     shape(11) =-3.0_rp*a*s2*s3*s4*t1*t2*t4
     shape(12) =-3.0_rp*a*s2*s3*s4*t1*t3*t4
     shape(13) = 9.0_rp*a*s1*s3*s4*t1*t3*t4
     shape(14) = 9.0_rp*a*s1*s2*s4*t1*t3*t4
     shape(15) = 9.0_rp*a*s1*s2*s4*t1*t2*t4
     shape(16) = 9.0_rp*a*s1*s3*s4*t1*t2*t4
     deriv(1, 1)=  a *t2*t3*t4*(-s2*s3-s2*s4+s3*s4)
     deriv(1, 2)=  a *t2*t3*t4*(-s1*s2+s1*s3+s2*s3)
     deriv(1, 3)=  a *t1*t2*t3*(-s1*s2+s1*s3+s2*s3)
     deriv(1, 4)=  a *t1*t2*t3*(-s2*s3-s2*s4+s3*s4)
     deriv(1, 5)= -3.0_rp*a*t2*t3*t4*(-s1*s3-s1*s4+s3*s4)
     deriv(1, 6)=-3.0_rp*a*t2*t3*t4*(-s1*s2+s1*s4+s2*s4)
     deriv(1, 7)=-3.0_rp*a*t1*t3*t4*(-s1*s2+s1*s3+s2*s3)
     deriv(1, 8)=-3.0_rp*a*t1*t2*t4*(-s1*s2+s1*s3+s2*s3)
     deriv(1, 9)=-3.0_rp*a*t1*t2*t3*(-s1*s2+s1*s4+s2*s4)
     deriv(1,10)=-3.0_rp*a*t1*t2*t3*(-s1*s3-s1*s4+s3*s4)
     deriv(1,11)=-3.0_rp*a*t1*t2*t4*(-s2*s3-s2*s4+s3*s4)
     deriv(1,12)=-3.0_rp*a*t1*t3*t4*(-s2*s3-s2*s4+s3*s4)
     deriv(1,13)= 9.0_rp*a*t1*t3*t4*(-s1*s3-s1*s4+s3*s4)
     deriv(1,14)= 9.0_rp*a*t1*t3*t4*(-s1*s2+s1*s4+s2*s4)
     deriv(1,15)= 9.0_rp*a*t1*t2*t4*(-s1*s2+s1*s4+s2*s4)
     deriv(1,16)= 9.0_rp*a*t1*t2*t4*(-s1*s3-s1*s4+s3*s4)
     deriv(2, 1)=  a   *s2*s3*s4*(-t2*t3-t2*t4+t3*t4)
     deriv(2, 2)=  a   *s1*s2*s3*(-t2*t3-t2*t4+t3*t4)
     deriv(2, 3)=  a   *s1*s2*s3*(-t1*t2+t1*t3+t2*t3)
     deriv(2, 4)=  a   *s2*s3*s4*(-t1*t2+t1*t3+t2*t3)
     deriv(2, 5)= -3.0_rp*a *s1*s3*s4*(-t2*t3-t2*t4+t3*t4)
     deriv(2, 6)= -3.0_rp*a *s1*s2*s4*(-t2*t3-t2*t4+t3*t4)
     deriv(2, 7)= -3.0_rp*a *s1*s2*s3*(-t1*t3-t1*t4+t3*t4)
     deriv(2, 8)= -3.0_rp*a *s1*s2*s3*(-t1*t2+t1*t4+t2*t4)
     deriv(2, 9)= -3.0_rp*a *s1*s2*s4*(-t1*t2+t1*t3+t2*t3)
     deriv(2,10)= -3.0_rp*a *s1*s3*s4*(-t1*t2+t1*t3+t2*t3)
     deriv(2,11)= -3.0_rp*a *s2*s3*s4*(-t1*t2+t1*t4+t2*t4)
     deriv(2,12)= -3.0_rp*a *s2*s3*s4*(-t1*t3-t1*t4+t3*t4)
     deriv(2,13)=  9.0_rp*a *s1*s3*s4*(-t1*t3-t1*t4+t3*t4)
     deriv(2,14)=  9.0_rp*a *s1*s2*s4*(-t1*t3-t1*t4+t3*t4)
     deriv(2,15)=  9.0_rp*a *s1*s2*s4*(-t1*t2+t1*t4+t2*t4)
     deriv(2,16)=  9.0_rp*a *s1*s3*s4*(-t1*t2+t1*t4+t2*t4)
     heslo(1, 1) =&
            2.0_rp*a *t2*t3*t4*(s2-s3-s4)
     heslo(1, 2) =&
            2.0_rp*a *t2*t3*t4*(-3.0_rp*s1-3.0_rp*s2+3.0_rp*s3)/3.0_rp
     heslo(1, 3) =&
            2.0_rp*a *t1*t2*t3*(-3.0_rp*s1-3.0_rp*s2+3.0_rp*s3)/3.0_rp
     heslo(1, 4) =&
            2.0_rp*a *t1*t2*t3*(s2-s3-s4)
     heslo(1, 5) =&
            -2.0_rp*a *t2*t3*t4*(3.0_rp*s1-3.0_rp*s3-3.0_rp*s4)
     heslo(1, 6) =&
            -2.0_rp*a *t2*t3*t4*(-3.0_rp*s1-3.0_rp*s2+3.0_rp*s4)
     heslo(1, 7) =&
            -2.0_rp*a *t1*t3*t4*(-3.0_rp*s1-3.0_rp*s2+3.0_rp*s3)
     heslo(1, 8) =&
            -2.0_rp*a *t1*t2*t4*(-3.0_rp*s1-3.0_rp*s2+3.0_rp*s3)
     heslo(1, 9) =&
            -2.0_rp*a *t1*t2*t3*(-3.0_rp*s1-3.0_rp*s2+3.0_rp*s4)
     heslo(1,10) =&
            -2.0_rp*a *t1*t2*t3*(3.0_rp*s1-3.0_rp*s3-3.0_rp*s4)
     heslo(1,11) =&
            -6.0_rp*a *t1*t2*t4*(s2-s3-s4)
     heslo(1,12) =&
            -6.0_rp*a *t1*t3*t4*(s2-s3-s4)
     heslo(1,13) =&
            6.0_rp*a *t1*t3*t4*(3.0_rp*s1-3.0_rp*s3-3.0_rp*s4)
     heslo(1,14) =&
            6.0_rp*a *t1*t3*t4*(-3.0_rp*s1-3.0_rp*s2+3.0_rp*s4)
     heslo(1,15) =&
            6.0_rp*a *t1*t2*t4*(-3.0_rp*s1-3.0_rp*s2+3.0_rp*s4)
     heslo(1,16) =&
            6.0_rp*a *t1*t2*t4*(3.0_rp*s1-3.0_rp*s3-3.0_rp*s4)
     heslo(2, 1) =&
            2.0_rp*a *s2*s3*s4*(t2-t3-t4)
     heslo(2, 2) =&
            2.0_rp*a *s1*s2*s3*(t2-t3-t4)
     heslo(2, 3) =&
            2.0_rp*a *s1*s2*s3*(-3.0_rp*t1-3.0_rp*t2+3.0_rp*t3)/3.0_rp
     heslo(2, 4) =&
            2.0_rp*a *s2*s3*s4*(-3.0_rp*t1-3.0_rp*t2+3.0_rp*t3)/3.0_rp
     heslo(2, 5) =&
            -6.0_rp*a *s1*s3*s4*(t2-t3-t4)
     heslo(2, 6) =&
            -6.0_rp*a *s1*s2*s4*(t2-t3-t4)
     heslo(2, 7) =&
            -2.0_rp*a *s1*s2*s3*(3.0_rp*t1-3.0_rp*t3-3.0_rp*t4)
     heslo(2, 8) =&
            -2.0_rp*a *s1*s2*s3*(-3.0_rp*t1-3.0_rp*t2+3.0_rp*t4)
     heslo(2, 9) =&
            -2.0_rp*a *s1*s2*s4*(-3.0_rp*t1-3.0_rp*t2+3.0_rp*t3)
     heslo(2,10) =&
            -2.0_rp*a *s1*s3*s4*(-3.0_rp*t1-3.0_rp*t2+3.0_rp*t3)
     heslo(2,11) =&
            -2.0_rp*a *s2*s3*s4*(-3.0_rp*t1-3.0_rp*t2+3.0_rp*t4)
     heslo(2,12) =&
            -2.0_rp*a *s2*s3*s4*(3.0_rp*t1-3.0_rp*t3-3.0_rp*t4)
     heslo(2,13) =&
            6.0_rp*a *s1*s3*s4*(3.0_rp*t1-3.0_rp*t3-3.0_rp*t4)
     heslo(2,14) =&
            6.0_rp*a *s1*s2*s4*(3.0_rp*t1-3.0_rp*t3-3.0_rp*t4)
     heslo(2,15) =&
            6.0_rp*a *s1*s2*s4*(-3.0_rp*t1-3.0_rp*t2+3.0_rp*t4)
     heslo(2,16) =&
            6.0_rp*a *s1*s3*s4*(-3.0_rp*t1-3.0_rp*t2+3.0_rp*t4)
     heslo(3, 1) =&
            a*(-3.0_rp*s2*s3-3.0_rp*s2*s4+3.0_rp*s3*s4)*(-3.0_rp*t2*t3-3.0_rp*t2*t4+3.0_rp*t3*t4)/9.0_rp
     heslo(3, 2) =&
            a*(-3.0_rp*s1*s2+3.0_rp*s1*s3+3.0_rp*s2*s3)*(-3.0_rp*t2*t3-3.0_rp*t2*t4+3.0_rp*t3*t4)/9.0_rp
     heslo(3, 3) =&
            a*(-3.0_rp*s1*s2+3.0_rp*s1*s3+3.0_rp*s2*s3)*(-3.0_rp*t1*t2+3.0_rp*t1*t3+3.0_rp*t2*t3)/9.0_rp
     heslo(3, 4) =&
            a*(-3.0_rp*s2*s3-3.0_rp*s2*s4+3.0_rp*s3*s4)*(-3.0_rp*t1*t2+3.0_rp*t1*t3+3.0_rp*t2*t3)/9.0_rp
     heslo(3, 5) =&
            -a*(-9.0_rp*s1*s3-9.0_rp*s1*s4+9.0_rp*s3*s4)*(-3.0_rp*t2*t3-3.0_rp*t2*t4+3.0_rp*t3*t4)/9.0_rp
     heslo(3, 6) =&
            -a*(-3.0_rp*s1*s2+3.0_rp*s1*s4+3.0_rp*s2*s4)*(-3.0_rp*t2*t3-3.0_rp*t2*t4+3.0_rp*t3*t4)/3.0_rp
     heslo(3, 7) =&
            -3.0_rp*a*(-s1*s2+s1*s3+s2*s3)*(-t1*t3-t1*t4+t3*t4)
     heslo(3, 8) =&
            -3.0_rp*a*(-s1*s2+s1*s3+s2*s3)*(-t1*t2+t1*t4+t2*t4)
     heslo(3, 9) =&
            -a*(-3.0_rp*s1*s2+3.0_rp*s1*s4+3.0_rp*s2*s4)*(-3.0_rp*t1*t2+3.0_rp*t1*t3+3.0_rp*t2*t3)/3.0_rp
     heslo(3,10) =&
            -a*(-9.0_rp*s1*s3-9.0_rp*s1*s4+9.0_rp*s3*s4)*(-3.0_rp*t1*t2+3.0_rp*t1*t3+3.0_rp*t2*t3)/9.0_rp
     heslo(3,11) =&
            -3.0_rp*a*(-3.0_rp*s2*s3-3.0_rp*s2*s4+3.0_rp*s3*s4)*(-t1*t2+t1*t4+t2*t4)/3.0_rp
     heslo(3,12) =&
            -3.0_rp*a*(-s2*s3-s2*s4+s3*s4)*(-t1*t3-t1*t4+t3*t4)
     heslo(3,13) =&
            9.0_rp*a*(-s1*s3-s1*s4+s3*s4)*(-t1*t3-t1*t4+t3*t4)
     heslo(3,14) =&
            9.0_rp*a*(-s1*s2+s1*s4+s2*s4)*(-t1*t3-t1*t4+t3*t4)
     heslo(3,15) =&
            9.0_rp*a*(-s1*s2+s1*s4+s2*s4)*(-t1*t2+t1*t4+t2*t4)
     heslo(3,16) =&
            9.0_rp*a*(-s1*s3-s1*s4+s3*s4)*(-t1*t2+t1*t4+t2*t4)

! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
! * Valores calculados para triángulos nnode=15. Elemento p4_modificado con posición de nodos para obtener  *
! * una cuadratura cerrada exacta hasta un polinomio de quinto grado.                                       *
! * Ver la posición de nodos interiores en Regla cerrada para ngaus==15, p5 exacto del archivo rutope.f90   *
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

  else if(nnode==15) then

     shape( 1)= 1.0_rp+(-25.0_rp/3.0_rp)*s+(-25.0_rp/3.0_rp)*t&
               +(70.0_rp/3)*s*s+(70.0_rp/3)*t*t+(55.0_rp*sqrt(7.0_rp)+1890.0_rp)/42.0_rp*s*t&
               +(-80.0_rp/3)*s*s*s+(-80.0_rp/3)*t*t*t-(22.0_rp*sqrt(7.0_rp)+525.0_rp)/7.0_rp*s*s*t&
               -(22.0_rp*sqrt(7.0_rp)+525.0_rp)/7.0_rp*s*t*t+(32.0_rp/3)*s*s*s*s+(32.0_rp/3)*t*t*t*t&
               +(11.0_rp*sqrt(7.0_rp)+236.0_rp)/6.0_rp*s*s*s*t+(11.0_rp*sqrt(7.0_rp)+236.0_rp)/6.0_rp*s*t*t*t&
               +(11.0_rp*sqrt(7.0_rp)+172.0_rp)/3.0_rp*s*s*t*t
     shape( 2)= -s+22.0_rp/3.0_rp*s*s-(11.0_rp*sqrt(7.0_rp)-35.0_rp)/21.0_rp*s*t-16.0_rp*s*s*s&
                +(33.0_rp*sqrt(7.0_rp)-70.0_rp)/14.0_rp*s*s*t+(11.0_rp*sqrt(7.0_rp)-35.0_rp)/21.0_rp*s*t*t&
                +32.0_rp/3.0_rp*s*s*s*s-(11.0_rp*sqrt(7.0_rp)-20.0_rp)/6.0_rp*s*s*s*t&
                -(11.0_rp*sqrt(7.0_rp)-20.0_rp)/6.0_rp*s*s*t*t
     shape( 3)= -t+22.0_rp/3.0_rp*t*t-(11.0_rp*sqrt(7.0_rp)-35.0_rp)/21.0_rp*s*t-16.0_rp*t*t*t&
                +(11.0_rp*sqrt(7.0_rp)-35.0_rp)/21.0_rp*s*s*t+(33.0_rp*sqrt(7.0_rp)-70.0_rp)/14.0_rp*s*t*t&
                +32.0_rp/3.0_rp*t*t*t*t-(11.0_rp*sqrt(7.0_rp)-20.0_rp)/6.0_rp*s*t*t*t&
                -(11.0_rp*sqrt(7.0_rp)-20.0_rp)/6.0_rp*s*s*t*t
     shape( 4)=  16.0_rp*s-208.0_rp/3.0_rp*s*s-(104.0_rp*sqrt(7.0_rp)+1400.0_rp)/21.0_rp*s*t&
                +96.0_rp*s*s*s+(72.0_rp*sqrt(7.0_rp)+1288.0_rp)/7.0_rp*s*s*t+(272.0_rp*sqrt(7.0_rp)+1792.0_rp)/21.0_rp*s*t*t&
                -128.0_rp/3.0_rp*s*s*s*s-(16.0_rp*sqrt(7.0_rp)+368.0_rp)/3.0_rp*s*s*s*t&
                -(24.0_rp*sqrt(7.0_rp)+104.0_rp)/3.0_rp*s*t*t*t-(40.0_rp*sqrt(7.0_rp)+344.0_rp)/3.0_rp*s*s*t*t
     shape( 5)= -12.0_rp*s+76.0_rp*s*s+(66.0_rp*sqrt(7.0_rp)+70.0_rp)/7.0_rp*s*t-128.0_rp*s*s*s&
                -(66.0_rp*sqrt(7.0_rp)+882.0_rp)/7.0_rp*s*s*t-(220.0_rp*sqrt(7.0_rp)-336.0_rp)/7.0_rp*s*t*t&
                +64.0_rp*s*s*s*s+128.0_rp*s*s*s*t+(22.0_rp*sqrt(7.0_rp)-46.0_rp)*s*t*t*t+(22.0_rp*sqrt(7.0_rp)+18.0_rp)*s*s*t*t
    shape( 6)= 16.0_rp/3.0_rp*s-112.0_rp/3.0_rp*s*s+(8.0_rp*sqrt(7.0_rp)-168.0_rp)/21.0_rp*s*t&
               +224.0_rp/3.0_rp*s*s*s-(40.0_rp*sqrt(7.0_rp)-280.0_rp)/7.0_rp*s*s*t&
               +16.0_rp*sqrt(7.0_rp)/7.0_rp*s*t*t-128.0_rp/3.0_rp*s*s*s*s+(16.0_rp*sqrt(7.0_rp)-144.0_rp)/3.0_rp*s*s*s*t&
               -(8.0_rp*sqrt(7.0_rp)-8.0_rp)/3.0_rp*s*t*t*t+(8.0_rp*sqrt(7.0_rp)-8.0_rp)/3.0_rp*s*s*t*t
     shape( 7)=  (64.0_rp*sqrt(7.0_rp))/21.0_rp*s*t -(232.0_rp*sqrt(7.0_rp)+392.0_rp)/21.0_rp*s*s*t&
               - (40.0_rp*sqrt(7.0_rp)-56.0_rp)/7.0_rp*s*t*t + (24.0_rp*sqrt(7.0_rp)+104.0_rp)/3.0_rp*s*s*s*t&
               + (8.0_rp*sqrt(7.0_rp)-8.0_rp)/3.0_rp*s*t*t*t+(32.0_rp*sqrt(7.0_rp)-32.0_rp)/3.0_rp*s*s*t*t
     shape( 8)=-(88.0_rp*sqrt(7.0_rp)-224.0_rp)/7.0_rp*s*t + (242.0_rp*sqrt(7.0_rp)-630.0_rp)/7.0_rp*s*s*t&
               + (242.0_rp*sqrt(7.0_rp)-630.0_rp)/7.0_rp*s*t*t + (46.0_rp-22.0_rp*sqrt(7.0_rp))*s*s*s*t&
               + (46.0_rp-22.0_rp*sqrt(7.0_rp))*s*t*t*t + (156.0_rp-44.0_rp*sqrt(7.0_rp))*s*s*t*t
     shape( 9)= +(64.0_rp*sqrt(7.0_rp))/21.0_rp*s*t - (40.0_rp*sqrt(7.0_rp)-56.0_rp)/7.0_rp*s*s*t&
                -(232.0_rp*sqrt(7.0_rp)+392.0_rp)/21.0_rp*s*t*t + (8.0_rp*sqrt(7.0_rp)-8.0_rp)/3.0_rp*s*s*s*t&
                +(24.0_rp*sqrt(7.0_rp)+104.0_rp)/3.0_rp*s*t*t*t+(32.0_rp*sqrt(7.0_rp)-32.0_rp)/3.0_rp*s*s*t*t
     shape(10)= 16.0_rp/3.0_rp*t-112.0_rp/3.0_rp*t*t+(8.0_rp*sqrt(7.0_rp)-168.0_rp)/21.0_rp*s*t&
               +224.0_rp/3.0_rp*t*t*t+16.0_rp*sqrt(7.0_rp)/7.0_rp*s*s*t-(40.0_rp*sqrt(7.0_rp)-280.0_rp)/7.0_rp*s*t*t&
               -128.0_rp/3.0_rp*t*t*t*t-(8.0_rp*sqrt(7.0_rp)-8.0_rp)/3.0_rp*s*s*s*t&
               +(16.0_rp*sqrt(7.0_rp)-144.0_rp)/3.0_rp*s*t*t*t+(8.0_rp*sqrt(7.0_rp)-8.0_rp)/3.0_rp*s*s*t*t
     shape(11)= -12.0_rp*t+76.0_rp*t*t+(66.0_rp*sqrt(7.0_rp)+70.0_rp)/7.0_rp*s*t-128.0_rp*t*t*t&
                -(220.0_rp*sqrt(7.0_rp)-336.0_rp)/7.0_rp*s*s*t-(66.0_rp*sqrt(7.0_rp)+882.0_rp)/7.0_rp*s*t*t&
                +64.0_rp*t*t*t*t+(22.0_rp*sqrt(7.0_rp)-46)*s*s*s*t+128.0_rp*s*t*t*t+(22.0_rp*sqrt(7.0_rp)+18.0_rp)*s*s*t*t
     shape(12)= 16.0_rp*t-208.0_rp/3.0_rp*t*t-(104.0_rp*sqrt(7.0_rp)+1400.0_rp)/21.0_rp*s*t+96.0_rp*t*t*t&
               +(272.0_rp*sqrt(7.0_rp)+1792.0_rp)/21.0_rp*s*s*t+(72.0_rp*sqrt(7.0_rp)+1288.0_rp)/7.0_rp*s*t*t&
               -128.0_rp/3.0_rp*t*t*t*t-(24.0_rp*sqrt(7.0_rp)+104.0_rp)/3.0_rp*s*s*s*t&
               -(16.0_rp*sqrt(7.0_rp)+368.0_rp)/3.0_rp*s*t*t*t-(40.0_rp*sqrt(7.0_rp)+344.0_rp)/3.0_rp*s*s*t*t
     shape(13)= (9.0_rp*sqrt(7.0_rp**3))/2.0_rp*s*t - (23.0_rp*sqrt(7.0_rp**3)-49.0_rp)/2.0_rp*s*s*t&
               -(23.0_rp*sqrt(7.0_rp**3)-49.0_rp)/2.0_rp*s*t*t+(2.0_rp*sqrt(7.0_rp**5)-49.0_rp)/2.0_rp*s*s*s*t&
               +(2.0_rp*sqrt(7.0_rp**5)-49.0_rp)/2.0_rp*s*t*t*t+(2.0_rp*sqrt(7.0_rp**5)-49.0_rp)*s*s*t*t
     shape(14)=-(5.0_rp*sqrt(7.0_rp**3)-49.0_rp)/2.0_rp*s*t + (19.0_rp*sqrt(7.0_rp**3)-98.0_rp)/2.0_rp*s*s*t&
               +(5.0_rp*sqrt(7.0_rp**3)-49.0_rp)/2.0_rp*s*t*t - (2.0_rp*sqrt(7.0_rp**5)-49.0_rp)/2.0_rp*s*s*s*t&
               -(2.0_rp*sqrt(7.0_rp**5)-49.0_rp)/2.0_rp*s*s*t*t
     shape(15)=-(5.0_rp*sqrt(7.0_rp**3)-49.0_rp)/2.0_rp*s*t + (5.0_rp*sqrt(7.0_rp**3)-49.0_rp)/2.0_rp*s*s*t&
               +(19.0_rp*sqrt(7.0_rp**3)-98.0_rp)/2.0_rp*s*t*t - (2.0_rp*sqrt(7.0_rp**5)-49.0_rp)/2.0_rp*s*s*t*t&
               -(2.0_rp*sqrt(7.0_rp**5)-49.0_rp)/2.0_rp*s*t*t*t

     deriv(1, 1)=  -8.3333333334921917_rp+2*(  23.3333333342179685_rp)*s+(  48.4646743398957369_rp)*t&
                +3*( -26.6666666681470019_rp)*s*s+2*( -83.3152184149769255_rp)*s*t+( -83.3152184151310848_rp)*t*t&
                +4*(  10.6666666674143897_rp)*s*s*s+3*(  44.1838774082058023_rp)*s*s*t+2*(  67.0344214842568249_rp)*s*t*t&
                +(  44.1838774082991677_rp)*t*t*t
     deriv(1, 2)=  -0.9999999999974740_rp+2*(   7.3333333333189632_rp)*s+(   0.2807969323081281_rp)*t&
                +3*( -15.9999999999762199_rp)*s*s+2*(   1.2364138045634334_rp)*s*t+(  -0.2807969322706239_rp)*t*t&
                +4*(  10.6666666666547059_rp)*s*s*s+3*(  -1.5172107368690897_rp)*s*s*t+2*(  -1.5172107369162715_rp)*s*t*t&
                +(  -0.0000000000342917_rp)*t*t*t
     deriv(1, 3)=   0.0000000000009095_rp+2*(  -0.0000000000048423_rp)*s+(   0.2807969323084976_rp)*t&
                +3*(   0.0000000000081046_rp)*s*s+2*(  -0.2807969322737502_rp)*s*t+(   1.2364138045616002_rp)*t*t&
                +4*(  -0.0000000000040843_rp)*s*s*s+3*(  -0.0000000000324771_rp)*s*s*t+2*(  -1.5172107369120971_rp)*s*t*t&
                +(  -1.5172107368673551_rp)*t*t*t
     deriv(1, 4)=  16.0000000003747118_rp+2*( -69.3333333354410115_rp)*s+( -79.7694350723932075_rp)*t&
                +3*(  96.0000000035275320_rp)*s*s+2*( 211.2134420756940472_rp)*s*t+( 119.6021122364136318_rp)*t*t&
                +4*( -42.6666666684495084_rp)*s*s*s+3*(-136.7773403361930775_rp)*s*s*t+2*(-149.9433508352551598_rp)*s*t*t&
                +( -55.8326771634506258_rp)*t*t*t
     deriv(1, 5)= -12.0000000002560228_rp+2*(  76.0000000014252919_rp)*s+(  34.9456552233868933_rp)*t&
                +3*(-128.0000000023889015_rp)*s*s+2*(-150.9456552308158734_rp)*s*t+( -35.1521840712055109_rp)*t*t&
                +4*(  64.0000000012041710_rp)*s*s*s+3*( 128.0000000071673867_rp)*s*s*t+2*(  76.2065288559824694_rp)*s*t*t&
                +(  12.2065288474843783_rp)*t*t*t
     deriv(1, 6)=   5.3333333333723658_rp+2*( -37.3333333335594801_rp)*s+(  -6.9920947394621180_rp)*t&
                +3*(  74.6666666670428043_rp)*s*s+2*(  24.8814210820214541_rp)*s*t+(   6.0474315694772400_rp)*t*t&
                +4*( -42.6666666668577079_rp)*s*s*s+3*( -33.8893263425222955_rp)*s*s*t+2*(   4.3886701606570888_rp)*s*t*t&
                +(  -4.3886701633013701_rp)*t*t*t
     deriv(1, 7)=  -0.0000000000853788_rp+2*(   0.0000000004719141_rp)*s+(   8.0632420921942867_rp)*t&
                +3*(  -0.0000000007879990_rp)*s*s+2*( -47.8959192493797872_rp)*s*t+(  -7.1185789229376155_rp)*t*t&
                +4*(   0.0000000003987015_rp)*s*s*s+3*(  55.8326771571037881_rp)*s*s*t+2*(  17.5546806548235281_rp)*s*t*t&
                +(   4.3886701639723640_rp)*t*t*t
     deriv(1, 8)=  -0.0000000000146656_rp+2*(   0.0000000000808882_rp)*s+(  -1.2608736244689567_rp)*t&
                +3*(  -0.0000000001355609_rp)*s*s+2*(   1.4674024674377790_rp)*s*t+(   1.4674024674318957_rp)*t*t&
                +4*(   0.0000000000681117_rp)*s*s*s+3*( -12.2065288429870833_rp)*s*s*t+2*(  39.5869423141255865_rp)*s*t*t&
                +( -12.2065288429873533_rp)*t*t*t
     deriv(1, 9)=  -0.0000000000309228_rp+2*(   0.0000000001664375_rp)*s+(   8.0632420922024721_rp)*t&
                +3*(  -0.0000000002787885_rp)*s*s+2*(  -7.1185789229073748_rp)*s*t+( -47.8959192494714898_rp)*t*t&
                +4*(   0.0000000001408225_rp)*s*s*s+3*(   4.3886701639702750_rp)*s*s*t+2*(  17.5546806548536551_rp)*s*t*t&
                +(  55.8326771571770450_rp)*t*t*t
     deriv(1,10)=   0.0000000000113687_rp+2*(  -0.0000000000623004_rp)*s+(  -6.9920947394698487_rp)*t&
                +3*(   0.0000000001044782_rp)*s*s+2*(   6.0474315694737584_rp)*s*t+(  24.8814210820885933_rp)*t*t&
                +4*(  -0.0000000000528626_rp)*s*s*s+3*(  -4.3886701633092073_rp)*s*s*t+2*(   4.3886701606180765_rp)*s*t*t&
                +( -33.8893263425786131_rp)*t*t*t
     deriv(1,11)=  -0.0000000001164153_rp+2*(   0.0000000006548362_rp)*s+(  34.9456552234114497_rp)*t&
                +3*(  -0.0000000010986128_rp)*s*s+2*( -35.1521840711213827_rp)*s*t+(-150.9456552311207815_rp)*t*t&
                +4*(   0.0000000005536549_rp)*s*s*s+3*(  12.2065288474785518_rp)*s*s*t+2*(  76.2065288561027501_rp)*s*t*t&
                +( 128.0000000074010131_rp)*t*t*t
     deriv(1,12)=   0.0000000002710294_rp+2*(  -0.0000000015311343_rp)*s+( -79.7694350724123069_rp)*t&
                +3*(   0.0000000025710278_rp)*s*s+2*( 119.6021122361757989_rp)*s*t+( 211.2134420760958164_rp)*t*t&
                +4*(  -0.0000000012939552_rp)*s*s*s+3*( -55.8326771633475119_rp)*s*s*t+2*(-149.9433508353474735_rp)*s*t*t&
                +(-136.7773403364694786_rp)*t*t*t
     deriv(1,13)=  -0.0000000003819878_rp+2*(   0.0000000021809683_rp)*s+(  83.3411663078350102_rp)*t&
                +3*(  -0.0000000036493475_rp)*s*s+2*(-188.4829805611818756_rp)*s*t+(-188.4829805615527221_rp)*t*t&
                +4*(   0.0000000018402773_rp)*s*s*s+3*( 105.1418142528370367_rp)*s*s*t+2*( 210.2836285085713826_rp)*s*t*t&
                +( 105.1418142530505975_rp)*t*t*t
     deriv(1,14)=   0.0000000002305569_rp+2*(  -0.0000000013075123_rp)*s+( -21.8006479476589448_rp)*t&
                +3*(   0.0000000021808262_rp)*s*s+2*( 126.9424621956307533_rp)*s*t+(  21.8006479517496246_rp)*t*t&
                +4*(  -0.0000000011054730_rp)*s*s*s+3*(-105.1418142477331941_rp)*s*s*t+2*(-105.1418142527448367_rp)*s*t*t&
                +(  -0.0000000037839527_rp)*t*t*t
     deriv(1,15)=   0.0000000001082299_rp+2*(  -0.0000000006107257_rp)*s+( -21.8006479476762252_rp)*t&
                +3*(   0.0000000010202257_rp)*s*s+2*(  21.8006479516582203_rp)*s*t+( 126.9424621958696662_rp)*t*t&
                +4*(  -0.0000000005163372_rp)*s*s*s+3*(  -0.0000000037693724_rp)*s*s*t+2*(-105.1418142528167436_rp)*s*t*t&
                +(-105.1418142479110429_rp)*t*t*t

     deriv(2, 1)=  -8.3333333334921917_rp+2*(  23.3333333342488913_rp)*t+(  48.4646743398957369_rp)*s&
                +3*( -26.6666666681967399_rp)*t*t+( -83.3152184149769255_rp)*s*s+2*( -83.3152184151310848_rp)*s*t&
                +4*(  10.6666666674386761_rp)*t*t*t+(  44.1838774082058023_rp)*s*s*s+2*(  67.0344214842568249_rp)*s*s*t&
                +3*(  44.1838774082991677_rp)*s*t*t
     deriv(2, 2)=   0.0000000000008811_rp+2*(  -0.0000000000051514_rp)*t+(   0.2807969323081281_rp)*s&
                +3*(   0.0000000000085656_rp)*t*t+(   1.2364138045634334_rp)*s*s+2*(  -0.2807969322706239_rp)*s*t&
                +4*(  -0.0000000000043308_rp)*t*t*t+(  -1.5172107368690897_rp)*s*s*s+2*(  -1.5172107369162715_rp)*s*s*t&
                +3*(  -0.0000000000342917_rp)*s*t*t
     deriv(2, 3)=  -0.9999999999976126_rp+2*(   7.3333333333196151_rp)*t+(   0.2807969323084976_rp)*s&
                +3*( -15.9999999999765521_rp)*t*t+(  -0.2807969322737502_rp)*s*s+2*(   1.2364138045616002_rp)*s*t&
                +4*(  10.6666666666549830_rp)*t*t*t+(  -0.0000000000324771_rp)*s*s*s+2*(  -1.5172107369120971_rp)*s*s*t&
                +3*(  -1.5172107368673551_rp)*s*t*t
     deriv(2, 4)=   0.0000000002874003_rp+2*(  -0.0000000015916157_rp)*t+( -79.7694350723932075_rp)*s&
                +3*(   0.0000000026575435_rp)*t*t+( 211.2134420756940472_rp)*s*s+2*( 119.6021122364136318_rp)*s*t&
                +4*(  -0.0000000013415047_rp)*t*t*t+(-136.7773403361930775_rp)*s*s*s+2*(-149.9433508352551598_rp)*s*s*t&
                +3*( -55.8326771634506258_rp)*s*t*t
     deriv(2, 5)=  -0.0000000001236913_rp+2*(   0.0000000006839400_rp)*t+(  34.9456552233868933_rp)*s&
                +3*(  -0.0000000011459633_rp)*t*t+(-150.9456552308158734_rp)*s*s+2*( -35.1521840712055109_rp)*s*t&
                +4*(   0.0000000005770744_rp)*t*t*t+( 128.0000000071673867_rp)*s*s*s+2*(  76.2065288559824694_rp)*s*s*t&
                +3*(  12.2065288474843783_rp)*s*t*t
     deriv(2, 6)=   0.0000000000118234_rp+2*(  -0.0000000000662794_rp)*t+(  -6.9920947394621180_rp)*s&
                +3*(   0.0000000001102194_rp)*t*t+(  24.8814210820214541_rp)*s*s+2*(   6.0474315694772400_rp)*s*t&
                +4*(  -0.0000000000557918_rp)*t*t*t+( -33.8893263425222955_rp)*s*s*s+2*(   4.3886701606570888_rp)*s*s*t&
                +3*(  -4.3886701633013701_rp)*s*t*t
     deriv(2, 7)=  -0.0000000000313776_rp+2*(   0.0000000001753051_rp)*t+(   8.0632420921942867_rp)*s&
                +3*(  -0.0000000002929710_rp)*t*t+( -47.8959192493797872_rp)*s*s+2*(  -7.1185789229376155_rp)*s*t&
                +4*(   0.0000000001480203_rp)*t*t*t+(  55.8326771571037881_rp)*s*s*s+2*(  17.5546806548235281_rp)*s*s*t&
                +3*(   4.3886701639723640_rp)*s*t*t
     deriv(2, 8)=  -0.0000000000147793_rp+2*(   0.0000000000837872_rp)*t+(  -1.2608736244689567_rp)*s&
                +3*(  -0.0000000001402896_rp)*t*t+(   1.4674024674377790_rp)*s*s+2*(   1.4674024674318957_rp)*s*t&
                +4*(   0.0000000000704858_rp)*t*t*t+( -12.2065288429870833_rp)*s*s*s+2*(  39.5869423141255865_rp)*s*s*t&
                +3*( -12.2065288429873533_rp)*s*t*t
     deriv(2, 9)=  -0.0000000000836735_rp+2*(   0.0000000004856702_rp)*t+(   8.0632420922024721_rp)*s&
                +3*(  -0.0000000008099050_rp)*t*t+(  -7.1185789229073748_rp)*s*s+2*( -47.8959192494714898_rp)*s*t&
                +4*(   0.0000000004104095_rp)*t*t*t+(   4.3886701639702750_rp)*s*s*s+2*(  17.5546806548536551_rp)*s*s*t&
                +3*(  55.8326771571770450_rp)*s*t*t
     deriv(2,10)=   5.3333333333748669_rp+2*( -37.3333333335672251_rp)*t+(  -6.9920947394698487_rp)*s&
                +3*(  74.6666666670587347_rp)*t*t+(   6.0474315694737584_rp)*s*s+2*(  24.8814210820885933_rp)*s*t&
                +4*( -42.6666666668641028_rp)*t*t*t+(  -4.3886701633092073_rp)*s*s*s+2*(   4.3886701606180765_rp)*s*s*t&
                +3*( -33.8893263425786131_rp)*s*t*t
     deriv(2,11)= -12.0000000002619345_rp+2*(  76.0000000014715624_rp)*t+(  34.9456552234114497_rp)*s&
                +3*(-128.0000000024665496_rp)*t*t+( -35.1521840711213827_rp)*s*s+2*(-150.9456552311207815_rp)*s*t&
                +4*(  64.0000000012423698_rp)*t*t*t+(  12.2065288474785518_rp)*s*s*s+2*(  76.2065288561027501_rp)*s*s*t&
                +3*( 128.0000000074010131_rp)*s*t*t
     deriv(2,12)=  16.0000000003929017_rp+2*( -69.3333333355112700_rp)*t+( -79.7694350724123069_rp)*s&
                +3*(  96.0000000036416168_rp)*t*t+( 119.6021122361757989_rp)*s*s+2*( 211.2134420760958164_rp)*s*t&
                +4*( -42.6666666685041491_rp)*t*t*t+( -55.8326771633475119_rp)*s*s*s+2*(-149.9433508353474735_rp)*s*s*t&
                +3*(-136.7773403364694786_rp)*s*t*t
     deriv(2,13)=  -0.0000000004001777_rp+2*(   0.0000000022519089_rp)*t+(  83.3411663078350102_rp)*s&
                +3*(  -0.0000000037653081_rp)*t*t+(-188.4829805611818756_rp)*s*s+2*(-188.4829805615527221_rp)*s*t&
                +4*(   0.0000000019017534_rp)*t*t*t+( 105.1418142528370367_rp)*s*s*s+2*( 210.2836285085713826_rp)*s*s*t&
                +3*( 105.1418142530505975_rp)*s*t*t
     deriv(2,14)=   0.0000000001127773_rp+2*(  -0.0000000006393748_rp)*t+( -21.8006479476589448_rp)*s&
                +3*(   0.0000000010663825_rp)*t*t+( 126.9424621956307533_rp)*s*s+2*(  21.8006479517496246_rp)*s*t&
                +4*(  -0.0000000005381935_rp)*t*t*t+(-105.1418142477331941_rp)*s*s*s+2*(-105.1418142527448367_rp)*s*s*t&
                +3*(  -0.0000000037839527_rp)*s*t*t
     deriv(2,15)=   0.0000000002401066_rp+2*(  -0.0000000013442332_rp)*t+( -21.8006479476762252_rp)*s&
                +3*(   0.0000000022464519_rp)*t*t+(  21.8006479516582203_rp)*s*s+2*( 126.9424621958696662_rp)*s*t&
                +4*(  -0.0000000011341399_rp)*t*t*t+(  -0.0000000037693724_rp)*s*s*s+2*(-105.1418142528167436_rp)*s*s*t&
                +3*(-105.1418142479110429_rp)*s*t*t

     heslo(1, 1)= 2*(  23.3333333342179685_rp)+6*( -26.6666666681470019_rp)*s+2*( -83.3152184149769255_rp)*t&
                +12*(  10.6666666674143897_rp)*s*s+6*(  44.1838774082058023_rp)*s*t+2*(  67.0344214842568249_rp)*t*t
     heslo(1, 2)= 2*(   7.3333333333189632_rp)+6*( -15.9999999999762199_rp)*s+2*(   1.2364138045634334_rp)*t&
                +12*(  10.6666666666547059_rp)*s*s+6*(  -1.5172107368690897_rp)*s*t+2*(  -1.5172107369162715_rp)*t*t
     heslo(1, 3)= 2*(  -0.0000000000048423_rp)+6*(   0.0000000000081046_rp)*s+2*(  -0.2807969322737502_rp)*t&
                +12*(  -0.0000000000040843_rp)*s*s+6*(  -0.0000000000324771_rp)*s*t+2*(  -1.5172107369120971_rp)*t*t
     heslo(1, 4)= 2*( -69.3333333354410115_rp)+6*(  96.0000000035275320_rp)*s+2*( 211.2134420756940472_rp)*t&
                +12*( -42.6666666684495084_rp)*s*s+6*(-136.7773403361930775_rp)*s*t+2*(-149.9433508352551598_rp)*t*t
     heslo(1, 5)= 2*(  76.0000000014252919_rp)+6*(-128.0000000023889015_rp)*s+2*(-150.9456552308158734_rp)*t&
                +12*(  64.0000000012041710_rp)*s*s+6*( 128.0000000071673867_rp)*s*t+2*(  76.2065288559824694_rp)*t*t
     heslo(1, 6)= 2*( -37.3333333335594801_rp)+6*(  74.6666666670428043_rp)*s+2*(  24.8814210820214541_rp)*t&
                +12*( -42.6666666668577079_rp)*s*s+6*( -33.8893263425222955_rp)*s*t+2*(   4.3886701606570888_rp)*t*t
     heslo(1, 7)= 2*(   0.0000000004719141_rp)+6*(  -0.0000000007879990_rp)*s+2*( -47.8959192493797872_rp)*t&
                +12*(   0.0000000003987015_rp)*s*s+6*(  55.8326771571037881_rp)*s*t+2*(  17.5546806548235281_rp)*t*t
     heslo(1, 8)= 2*(   0.0000000000808882_rp)+6*(  -0.0000000001355609_rp)*s+2*(   1.4674024674377790_rp)*t&
                +12*(   0.0000000000681117_rp)*s*s+6*( -12.2065288429870833_rp)*s*t+2*(  39.5869423141255865_rp)*t*t
     heslo(1, 9)= 2*(   0.0000000001664375_rp)+6*(  -0.0000000002787885_rp)*s+2*(  -7.1185789229073748_rp)*t&
                +12*(   0.0000000001408225_rp)*s*s+6*(   4.3886701639702750_rp)*s*t+2*(  17.5546806548536551_rp)*t*t
     heslo(1,10)= 2*(  -0.0000000000623004_rp)+6*(   0.0000000001044782_rp)*s+2*(   6.0474315694737584_rp)*t&
                +12*(  -0.0000000000528626_rp)*s*s+6*(  -4.3886701633092073_rp)*s*t+2*(   4.3886701606180765_rp)*t*t
     heslo(1,11)= 2*(   0.0000000006548362_rp)+6*(  -0.0000000010986128_rp)*s+2*( -35.1521840711213827_rp)*t&
                +12*(   0.0000000005536549_rp)*s*s+6*(  12.2065288474785518_rp)*s*t+2*(  76.2065288561027501_rp)*t*t
     heslo(1,12)= 2*(  -0.0000000015311343_rp)+6*(   0.0000000025710278_rp)*s+2*( 119.6021122361757989_rp)*t&
                +12*(  -0.0000000012939552_rp)*s*s+6*( -55.8326771633475119_rp)*s*t+2*(-149.9433508353474735_rp)*t*t
     heslo(1,13)= 2*(   0.0000000021809683_rp)+6*(  -0.0000000036493475_rp)*s+2*(-188.4829805611818756_rp)*t&
                +12*(   0.0000000018402773_rp)*s*s+6*( 105.1418142528370367_rp)*s*t+2*( 210.2836285085713826_rp)*t*t
     heslo(1,14)= 2*(  -0.0000000013075123_rp)+6*(   0.0000000021808262_rp)*s+2*( 126.9424621956307533_rp)*t&
                +12*(  -0.0000000011054730_rp)*s*s+6*(-105.1418142477331941_rp)*s*t+2*(-105.1418142527448367_rp)*t*t
     heslo(1,15)= 2*(  -0.0000000006107257_rp)+6*(   0.0000000010202257_rp)*s+2*(  21.8006479516582203_rp)*t&
                +12*(  -0.0000000005163372_rp)*s*s+6*(  -0.0000000037693724_rp)*s*t+2*(-105.1418142528167436_rp)*t*t

     heslo(2, 1)= 2*(  23.3333333342488913_rp)+6*( -26.6666666681967399_rp)*t+2*( -83.3152184151310848_rp)*s&
                +12*(  10.6666666674386761_rp)*t*t+2*(  67.0344214842568249_rp)*s*s+6*(  44.1838774082991677_rp)*s*t
     heslo(2, 2)= 2*(  -0.0000000000051514_rp)+6*(   0.0000000000085656_rp)*t+2*(  -0.2807969322706239_rp)*s&
                +12*(  -0.0000000000043308_rp)*t*t+2*(  -1.5172107369162715_rp)*s*s+6*(  -0.0000000000342917_rp)*s*t
     heslo(2, 3)= 2*(   7.3333333333196151_rp)+6*( -15.9999999999765521_rp)*t+2*(   1.2364138045616002_rp)*s&
                +12*(  10.6666666666549830_rp)*t*t+2*(  -1.5172107369120971_rp)*s*s+6*(  -1.5172107368673551_rp)*s*t
     heslo(2, 4)= 2*(  -0.0000000015916157_rp)+6*(   0.0000000026575435_rp)*t+2*( 119.6021122364136318_rp)*s&
                +12*(  -0.0000000013415047_rp)*t*t+2*(-149.9433508352551598_rp)*s*s+6*( -55.8326771634506258_rp)*s*t
     heslo(2, 5)= 2*(   0.0000000006839400_rp)+6*(  -0.0000000011459633_rp)*t+2*( -35.1521840712055109_rp)*s&
                +12*(   0.0000000005770744_rp)*t*t+2*(  76.2065288559824694_rp)*s*s+6*(  12.2065288474843783_rp)*s*t
     heslo(2, 6)= 2*(  -0.0000000000662794_rp)+6*(   0.0000000001102194_rp)*t+2*(   6.0474315694772400_rp)*s&
                +12*(  -0.0000000000557918_rp)*t*t+2*(   4.3886701606570888_rp)*s*s+6*(  -4.3886701633013701_rp)*s*t
     heslo(2, 7)= 2*(   0.0000000001753051_rp)+6*(  -0.0000000002929710_rp)*t+2*(  -7.1185789229376155_rp)*s&
                +12*(   0.0000000001480203_rp)*t*t+2*(  17.5546806548235281_rp)*s*s+6*(   4.3886701639723640_rp)*s*t
     heslo(2, 8)= 2*(   0.0000000000837872_rp)+6*(  -0.0000000001402896_rp)*t+2*(   1.4674024674318957_rp)*s&
                +12*(   0.0000000000704858_rp)*t*t+2*(  39.5869423141255865_rp)*s*s+6*( -12.2065288429873533_rp)*s*t
     heslo(2, 9)= 2*(   0.0000000004856702_rp)+6*(  -0.0000000008099050_rp)*t+2*( -47.8959192494714898_rp)*s&
                +12*(   0.0000000004104095_rp)*t*t+2*(  17.5546806548536551_rp)*s*s+6*(  55.8326771571770450_rp)*s*t
     heslo(2,10)= 2*( -37.3333333335672251_rp)+6*(  74.6666666670587347_rp)*t+2*(  24.8814210820885933_rp)*s&
                +12*( -42.6666666668641028_rp)*t*t+2*(   4.3886701606180765_rp)*s*s+6*( -33.8893263425786131_rp)*s*t
     heslo(2,11)= 2*(  76.0000000014715624_rp)+6*(-128.0000000024665496_rp)*t+2*(-150.9456552311207815_rp)*s&
                +12*(  64.0000000012423698_rp)*t*t+2*(  76.2065288561027501_rp)*s*s+6*( 128.0000000074010131_rp)*s*t
     heslo(2,12)= 2*( -69.3333333355112700_rp)+6*(  96.0000000036416168_rp)*t+2*( 211.2134420760958164_rp)*s&
                +12*( -42.6666666685041491_rp)*t*t+2*(-149.9433508353474735_rp)*s*s+6*(-136.7773403364694786_rp)*s*t
     heslo(2,13)= 2*(   0.0000000022519089_rp)+6*(  -0.0000000037653081_rp)*t+2*(-188.4829805615527221_rp)*s&
                +12*(   0.0000000019017534_rp)*t*t+2*( 210.2836285085713826_rp)*s*s+6*( 105.1418142530505975_rp)*s*t
     heslo(2,14)= 2*(  -0.0000000006393748_rp)+6*(   0.0000000010663825_rp)*t+2*(  21.8006479517496246_rp)*s&
                +12*(  -0.0000000005381935_rp)*t*t+2*(-105.1418142527448367_rp)*s*s+6*(  -0.0000000037839527_rp)*s*t
     heslo(2,15)= 2*(  -0.0000000013442332_rp)+6*(   0.0000000022464519_rp)*t+2*( 126.9424621958696662_rp)*s&
                +12*(  -0.0000000011341399_rp)*t*t+2*(-105.1418142528167436_rp)*s*s+6*(-105.1418142479110429_rp)*s*t

     heslo(3, 1)=   48.4646743398957369_rp+2*( -83.3152184149769255_rp)*s+2*( -83.3152184151310848_rp)*t&
                +3*(  44.1838774082058023_rp)*s*s+4*(  67.0344214842568249_rp)*s*t+3*(  44.1838774082991677_rp)*t*t
     heslo(3, 2)=    0.2807969323081281_rp+2*(   1.2364138045634334_rp)*s+2*(  -0.2807969322706239_rp)*t&
                +3*(  -1.5172107368690897_rp)*s*s+4*(  -1.5172107369162715_rp)*s*t+3*(  -0.0000000000342917_rp)*t*t
     heslo(3, 3)=    0.2807969323084976_rp+2*(  -0.2807969322737502_rp)*s+2*(   1.2364138045616002_rp)*t&
                +3*(  -0.0000000000324771_rp)*s*s+4*(  -1.5172107369120971_rp)*s*t+3*(  -1.5172107368673551_rp)*t*t
     heslo(3, 4)=  -79.7694350723932075_rp+2*( 211.2134420756940472_rp)*s+2*( 119.6021122364136318_rp)*t&
                +3*(-136.7773403361930775_rp)*s*s+4*(-149.9433508352551598_rp)*s*t+3*( -55.8326771634506258_rp)*t*t
     heslo(3, 5)=   34.9456552233868933_rp+2*(-150.9456552308158734_rp)*s+2*( -35.1521840712055109_rp)*t&
                +3*( 128.0000000071673867_rp)*s*s+4*(  76.2065288559824694_rp)*s*t+3*(  12.2065288474843783_rp)*t*t
     heslo(3, 6)=   -6.9920947394621180_rp+2*(  24.8814210820214541_rp)*s+2*(   6.0474315694772400_rp)*t&
                +3*( -33.8893263425222955_rp)*s*s+4*(   4.3886701606570888_rp)*s*t+3*(  -4.3886701633013701_rp)*t*t
     heslo(3, 7)=    8.0632420921942867_rp+2*( -47.8959192493797872_rp)*s+2*(  -7.1185789229376155_rp)*t&
                +3*(  55.8326771571037881_rp)*s*s+4*(  17.5546806548235281_rp)*s*t+3*(   4.3886701639723640_rp)*t*t
     heslo(3, 8)=   -1.2608736244689567_rp+2*(   1.4674024674377790_rp)*s+2*(   1.4674024674318957_rp)*t&
                +3*( -12.2065288429870833_rp)*s*s+4*(  39.5869423141255865_rp)*s*t+3*( -12.2065288429873533_rp)*t*t
     heslo(3, 9)=    8.0632420922024721_rp+2*(  -7.1185789229073748_rp)*s+2*( -47.8959192494714898_rp)*t&
                +3*(   4.3886701639702750_rp)*s*s+4*(  17.5546806548536551_rp)*s*t+3*(  55.8326771571770450_rp)*t*t
     heslo(3,10)=   -6.9920947394698487_rp+2*(   6.0474315694737584_rp)*s+2*(  24.8814210820885933_rp)*t&
                +3*(  -4.3886701633092073_rp)*s*s+4*(   4.3886701606180765_rp)*s*t+3*( -33.8893263425786131_rp)*t*t
     heslo(3,11)=   34.9456552234114497_rp+2*( -35.1521840711213827_rp)*s+2*(-150.9456552311207815_rp)*t&
                +3*(  12.2065288474785518_rp)*s*s+4*(  76.2065288561027501_rp)*s*t+3*( 128.0000000074010131_rp)*t*t
     heslo(3,12)=  -79.7694350724123069_rp+2*( 119.6021122361757989_rp)*s+2*( 211.2134420760958164_rp)*t&
                +3*( -55.8326771633475119_rp)*s*s+4*(-149.9433508353474735_rp)*s*t+3*(-136.7773403364694786_rp)*t*t
     heslo(3,13)=   83.3411663078350102_rp+2*(-188.4829805611818756_rp)*s+2*(-188.4829805615527221_rp)*t&
                +3*( 105.1418142528370367_rp)*s*s+4*( 210.2836285085713826_rp)*s*t+3*( 105.1418142530505975_rp)*t*t
     heslo(3,14)=  -21.8006479476589448_rp+2*( 126.9424621956307533_rp)*s+2*(  21.8006479517496246_rp)*t&
                +3*(-105.1418142477331941_rp)*s*s+4*(-105.1418142527448367_rp)*s*t+3*(  -0.0000000037839527_rp)*t*t
     heslo(3,15)=  -21.8006479476762252_rp+2*(  21.8006479516582203_rp)*s+2*( 126.9424621958696662_rp)*t&
                +3*(  -0.0000000037693724_rp)*s*s+4*(-105.1418142528167436_rp)*s*t+3*(-105.1418142479110429_rp)*t*t

! * * * * * * * * * * * * * * * * * * * * * * * * *
! *Valores calculados para cuadriláteros nnode=25 *
! * * * * * * * * * * * * * * * * * * * * * * * * *
     else if (nnode==25) then
     s1 = s+1.0_rp
     s2 = s-1.0_rp
     s3 = s + 1.0_rp/2.0_rp
     s4 = s - 1.0_rp/2.0_rp
     Ns(1) = 2.0_rp*s*s3*s4*s2/3.0_rp
     Ns(2) =-8.0_rp*s*s1*s4*s2/3.0_rp
     Ns(3) = 4.0_rp*s1*s3*s4*s2
     Ns(4) =-8.0_rp*s*s1*s3*s2/3.0_rp
     Ns(5) = 2.0_rp*s*s1*s3*s4/3.0_rp
     DNs(1) =2.0_rp*(s*s3*s4+s*s3*s2+s*s4*s2+s3*s4*s2)/3.0_rp
     DNs(2) =-8.0_rp*(s*s1*s4+s*s1*s2+s*s4*s2+s1*s4*s2)/3.0_rp
     DNs(3) = 4.0_rp*(s1*s3*s4+s1*s3*s2+s1*s4*s2+s3*s4*s2)
     DNs(4) =-8.0_rp*(s*s1*s3+s*s1*s2+s*s3*s2+s1*s3*s2)/3.0_rp
     DNs(5) = 2.0_rp*(s*s1*s3+s*s1*s4+s*s3*s4+s1*s3*s4)/3.0_rp
     D2Ns(1) = 4.0_rp*(s*s3+s*s4+s3*s4+s*s2+s3*s2+s4*s2)/3.0_rp
     D2Ns(2) =-16.0_rp*(s*s1+s*s4+s1*s4+s*s2+s1*s2+s4*s2)/3.0_rp
     D2Ns(3) = 8.0_rp*(s1*s3+s1*s4+s3*s4+s1*s2+s3*s2+s4*s2)
     D2Ns(4) =-16.0_rp*(s*s1+s*s3+s1*s3+s*s2+s1*s2+s3*s2)/3.0_rp
     D2Ns(5) = 4.0_rp*(s*s1+s*s3+s1*s3+s*s4+s1*s4+s3*s4)/3.0_rp
     t1 = t+1.0_rp
     t2 = t-1-0_rp
     t3 = t+1.0_rp/2.0_rp
     t4 = t-1.0_rp/2.0_rp
     Nt(1) = 2.0_rp*t*t3*t4*t2/3.0_rp
     Nt(2) =-8.0_rp/3.0_rp*t*t1*t4*t2
     Nt(3) = 4.0_rp*t1*t3*t4*t2
     Nt(4) =-8.0_rp*t*t1*t3*t2/3.0_rp
     Nt(5) = 2.0_rp*t*t1*t3*t4/3.0_rp
     DNt(1) = 2.0_rp*(t*t3*t4+t*t3*t2+t*t4*t2+t3*t4*t2)/3.0_rp
     DNt(2) =-8.0_rp*(t*t1*t4+t*t1*t2+t*t4*t2+t1*t4*t2)/3.0_rp
     DNt(3) = 4.0_rp*(t1*t3*t4+t1*t3*t2+t1*t4*t2+t3*t4*t2)
     DNt(4) =-8.0_rp*(t*t1*t3+t*t1*t2+t*t3*t2+t1*t3*t2)/3.0_rp
     DNt(5) = 2.0_rp*(t*t1*t3+t*t1*t4+t*t3*t4+t1*t3*t4)/3.0_rp
     D2Nt(1) = 4.0_rp*(t*t3+t*t4+t3*t4+t*t2+t3*t2+t4*t2)/3.0_rp
     D2Nt(2) =-16.0_rp*(t*t1+t*t4+t1*t4+t*t2+t1*t2+t4*t2)/3.0_rp
     D2Nt(3) = 8.0_rp*(t1*t3+t1*t4+t3*t4+t1*t2+t3*t2+t4*t2)
     D2Nt(4) =-16.0_rp*(t*t1+t*t3+t1*t3+t*t2+t1*t2+t3*t2)/3.0_rp
     D2Nt(5) = 4.0_rp*(t*t1+t*t3+t1*t3+t*t4+t1*t4+t3*t4)/3.0_rp
     shape( 1) = Ns(1)*Nt(1)                !4     13    12    11     3
     shape( 2) = Ns(5)*Nt(1)                !
     shape( 3) = Ns(5)*Nt(5)                !
     shape( 4) = Ns(1)*Nt(5)                !14    23    22    21    10
     shape( 5) = Ns(2)*Nt(1)                !
     shape( 6) = Ns(3)*Nt(1)                !
     shape( 7) = Ns(4)*Nt(1)                !15    24    25    20     9
     shape( 8) = Ns(5)*Nt(2)                !
     shape( 9) = Ns(5)*Nt(3)                !
     shape(10) = Ns(5)*Nt(4)                !16    17    18    19     8
     shape(11) = Ns(4)*Nt(5)                !
     shape(12) = Ns(3)*Nt(5)                !
     shape(13) = Ns(2)*Nt(5)                !1     5     6     7      2
     shape(14) = Ns(1)*Nt(4)
     shape(15) = Ns(1)*Nt(3)
     shape(16) = Ns(1)*Nt(2)
     shape(17) = Ns(2)*Nt(2)
     shape(18) = Ns(3)*Nt(2)
     shape(19) = Ns(4)*Nt(2)
     shape(20) = Ns(4)*Nt(3)
     shape(21) = Ns(4)*Nt(4)
     shape(22) = Ns(3)*Nt(4)
     shape(23) = Ns(2)*Nt(4)
     shape(24) = Ns(2)*Nt(3)
     shape(25) = Ns(3)*Nt(3)
     deriv(1, 1) = DNs(1)*Nt(1)
     deriv(1, 2) = DNs(5)*Nt(1)
     deriv(1, 3) = DNs(5)*Nt(5)
     deriv(1, 4) = DNs(1)*Nt(5)
     deriv(1, 5) = DNs(2)*Nt(1)
     deriv(1, 6) = DNs(3)*Nt(1)
     deriv(1, 7) = DNs(4)*Nt(1)
     deriv(1, 8) = DNs(5)*Nt(2)
     deriv(1, 9) = DNs(5)*Nt(3)
     deriv(1,10) = DNs(5)*Nt(4)
     deriv(1,11) = DNs(4)*Nt(5)
     deriv(1,12) = DNs(3)*Nt(5)
     deriv(1,13) = DNs(2)*Nt(5)
     deriv(1,14) = DNs(1)*Nt(4)
     deriv(1,15) = DNs(1)*Nt(3)
     deriv(1,16) = DNs(1)*Nt(2)
     deriv(1,17) = DNs(2)*Nt(2)
     deriv(1,18) = DNs(3)*Nt(2)
     deriv(1,19) = DNs(4)*Nt(2)
     deriv(1,20) = DNs(4)*Nt(3)
     deriv(1,21) = DNs(4)*Nt(4)
     deriv(1,22) = DNs(3)*Nt(4)
     deriv(1,23) = DNs(2)*Nt(4)
     deriv(1,24) = DNs(2)*Nt(3)
     deriv(1,25) = DNs(3)*Nt(3)
     deriv(2, 1) = Ns(1)*DNt(1)
     deriv(2, 2) = Ns(5)*DNt(1)
     deriv(2, 3) = Ns(5)*DNt(5)
     deriv(2, 4) = Ns(1)*DNt(5)
     deriv(2, 5) = Ns(2)*DNt(1)
     deriv(2, 6) = Ns(3)*DNt(1)
     deriv(2, 7) = Ns(4)*DNt(1)
     deriv(2, 8) = Ns(5)*DNt(2)
     deriv(2, 9) = Ns(5)*DNt(3)
     deriv(2,10) = Ns(5)*DNt(4)
     deriv(2,11) = Ns(4)*DNt(5)
     deriv(2,12) = Ns(3)*DNt(5)
     deriv(2,13) = Ns(2)*DNt(5)
     deriv(2,14) = Ns(1)*DNt(4)
     deriv(2,15) = Ns(1)*DNt(3)
     deriv(2,16) = Ns(1)*DNt(2)
     deriv(2,17) = Ns(2)*DNt(2)
     deriv(2,18) = Ns(3)*DNt(2)
     deriv(2,19) = Ns(4)*DNt(2)
     deriv(2,20) = Ns(4)*DNt(3)
     deriv(2,21) = Ns(4)*DNt(4)
     deriv(2,22) = Ns(3)*DNt(4)
     deriv(2,23) = Ns(2)*DNt(4)
     deriv(2,24) = Ns(2)*DNt(3)
     deriv(2,25) = Ns(3)*DNt(3)
     heslo(1, 1) = D2Ns(1)*Nt(1)
     heslo(1, 2) = D2Ns(5)*Nt(1)
     heslo(1, 3) = D2Ns(5)*Nt(5)
     heslo(1, 4) = D2Ns(1)*Nt(5)
     heslo(1, 5) = D2Ns(2)*Nt(1)
     heslo(1, 6) = D2Ns(3)*Nt(1)
     heslo(1, 7) = D2Ns(4)*Nt(1)
     heslo(1, 8) = D2Ns(5)*Nt(2)
     heslo(1, 9) = D2Ns(5)*Nt(3)
     heslo(1,10) = D2Ns(5)*Nt(4)
     heslo(1,11) = D2Ns(4)*Nt(5)
     heslo(1,12) = D2Ns(3)*Nt(5)
     heslo(1,13) = D2Ns(2)*Nt(5)
     heslo(1,14) = D2Ns(1)*Nt(4)
     heslo(1,15) = D2Ns(1)*Nt(3)
     heslo(1,16) = D2Ns(1)*Nt(2)
     heslo(1,17) = D2Ns(2)*Nt(2)
     heslo(1,18) = D2Ns(3)*Nt(2)
     heslo(1,19) = D2Ns(4)*Nt(2)
     heslo(1,20) = D2Ns(4)*Nt(3)
     heslo(1,21) = D2Ns(4)*Nt(4)
     heslo(1,22) = D2Ns(3)*Nt(4)
     heslo(1,23) = D2Ns(2)*Nt(4)
     heslo(1,24) = D2Ns(2)*Nt(3)
     heslo(1,25) = D2Ns(3)*Nt(3)
     heslo(2, 1) = Ns(1)*D2Nt(1)
     heslo(2, 2) = Ns(5)*D2Nt(1)
     heslo(2, 3) = Ns(5)*D2Nt(5)
     heslo(2, 4) = Ns(1)*D2Nt(5)
     heslo(2, 5) = Ns(2)*D2Nt(1)
     heslo(2, 6) = Ns(3)*D2Nt(1)
     heslo(2, 7) = Ns(4)*D2Nt(1)
     heslo(2, 8) = Ns(5)*D2Nt(2)
     heslo(2, 9) = Ns(5)*D2Nt(3)
     heslo(2,10) = Ns(5)*D2Nt(4)
     heslo(2,11) = Ns(4)*D2Nt(5)
     heslo(2,12) = Ns(3)*D2Nt(5)
     heslo(2,13) = Ns(2)*D2Nt(5)
     heslo(2,14) = Ns(1)*D2Nt(4)
     heslo(2,15) = Ns(1)*D2Nt(3)
     heslo(2,16) = Ns(1)*D2Nt(2)
     heslo(2,17) = Ns(2)*D2Nt(2)
     heslo(2,18) = Ns(3)*D2Nt(2)
     heslo(2,19) = Ns(4)*D2Nt(2)
     heslo(2,20) = Ns(4)*D2Nt(3)
     heslo(2,21) = Ns(4)*D2Nt(4)
     heslo(2,22) = Ns(3)*D2Nt(4)
     heslo(2,23) = Ns(2)*D2Nt(4)
     heslo(2,24) = Ns(2)*D2Nt(3)
     heslo(2,25) = Ns(3)*D2Nt(3)
     heslo(3, 1) = DNs(1)*DNt(1)
     heslo(3, 2) = DNs(5)*DNt(1)
     heslo(3, 3) = DNs(5)*DNt(5)
     heslo(3, 4) = DNs(1)*DNt(5)
     heslo(3, 5) = DNs(2)*DNt(1)
     heslo(3, 6) = DNs(3)*DNt(1)
     heslo(3, 7) = DNs(4)*DNt(1)
     heslo(3, 8) = DNs(5)*DNt(2)
     heslo(3, 9) = DNs(5)*DNt(3)
     heslo(3,10) = DNs(5)*DNt(4)
     heslo(3,11) = DNs(4)*DNt(5)
     heslo(3,12) = DNs(3)*DNt(5)
     heslo(3,13) = DNs(2)*DNt(5)
     heslo(3,14) = DNs(1)*DNt(4)
     heslo(3,15) = DNs(1)*DNt(3)
     heslo(3,16) = DNs(1)*DNt(2)
     heslo(3,17) = DNs(2)*DNt(2)
     heslo(3,18) = DNs(3)*DNt(2)
     heslo(3,19) = DNs(4)*DNt(2)
     heslo(3,20) = DNs(4)*DNt(3)
     heslo(3,21) = DNs(4)*DNt(4)
     heslo(3,22) = DNs(3)*DNt(4)
     heslo(3,23) = DNs(2)*DNt(4)
     heslo(3,24) = DNs(2)*DNt(3)
     heslo(3,25) = DNs(3)*DNt(3)

  end if

end subroutine shape2


!  *******************************************************************
!  *                                                                 *
!  *                     Function dlspx1                             *
!  *                                                                 *
!  *******************************************************************
!  Double Precision Version 1.41
!  Written by Gordon A. Fenton, Mar. 25, 1994
!  Latest Update: May 9, 2001
!
!  PURPOSE  returns the covariance between two points along a 1-D random
!           process having an exponential (Gaussian) type covariance function
!
!  This function returns the covariance between two points, separated by
!  distance T, along a random process having Gaussian type covariance function
!
!      B(T) = var * exp{ -pi*[(|T|/dthx)^2] }
!
!
!  If var < 0, then this function returns the variance of a local average
!  of the process, |var|*V(T), averaged over the distance T, where the
!  variance function is given by
!
!         V(T) = (1/a*a) * [pi*(|T|/dthx)*erf(a) + exp(-a*a) - 1]
!
!  where a = (|T|*sqrt(pi))/dthx, erf(.) is the error function,
!  dthx is the directional scale of fluctuation, and var is the point
!  variance. The variance of a local average is given by var*V(X).
!
!  See page 186 of "Random Fields" by E. Vanmarcke and G.A. Fenton's thesis
!  for more details.
!
!  The parameters var and dthx are brought in via the common block
!  /dparam/.
!
!  The argument to this routine, T, is the distance between the two points
!  for which the covariance is desired (or the distance over which the local
!  averaging is performed, if var < 0).
!
!  REVISION HISTORY:
!  1.1	fixed argument list and dthx = 0 case, improved limit handling
!	(Jun 19/96)
!  1.2	added lvarfn flag to end of /dparam/ common block. Set it to
!	true if the variance function is to be returned. Otherwise this
!	function returns the covariance. (May 1/00)
!  1.3	eliminated lvarfn -- now return covariances only if var < 0 (Mar 2/01)
!  1.4	reversed default - now return covariances if var > 0. (Apr 11/01)
!  1.41	revised above documentation to reflect revision 1.4 (May 9/01)
!---------------------------------------------------------------------------
      real*8 function dlspx1( T )
      implicit real*8 (a-h,o-z)
      common/dparam/ var, dpb, dthx, dthy, dthz
      data zero/0.d0/, one/1.d0/, six/6.d0/
      data rtpi/1.77245385090551588d0/, pt1/0.1d0/
      data   pi/3.1415926535897932384d0/, big/1.d6/
      exp(s)   = dexp(s)
      abs(s)   = dabs(s)
      r_erf(s) = derf(s)

      if( var .lt. zero ) then			! return variance function
         aT = abs(T)
         if( dthx .ge. big*aT ) then
            if( dthx .eq. zero ) then
               dlspx1 = -var
            else
               rx = aT/dthx
               dlspx1 = -var*(one - pi*rx*rx/six)
            endif
         elseif( dthx .le. pt1*aT ) then
            rx = dthx/aT
            dlspx1 = -var*rx*(one - rx/pi)
         else
            rx = aT/dthx
            a  = rtpi*rx
            aa = a*a
            dlspx1 = -var*(pi*rx*r_erf(a) + exp(-aa) - one)/aa
         endif
      else					! return covariance
         if( dthx .eq. zero ) then
            if( T .eq. zero ) then
               dlspx1 = var
            else
               dlspx1 = zero
            endif
         else
            at = T/dthx
            dlspx1 = var * exp(-pi*at*at)
         endif
      endif

      return
      end


c fishpk35 from portlib                                  12/30/83
c
c     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
c     *                                                               *
c     *                        f i s h p a k                          *
c     *                                                               *
c     *                                                               *
c     *     a package of fortran subprograms for the solution of      *
c     *                                                               *
c     *      separable elliptic partial differential equations        *
c     *                                                               *
c     *                  (version 3.1 , october 1980)                  *
c     *                                                               *
c     *                             by                                *
c     *                                                               *
c     *        john adams, paul swarztrauber and roland sweet         *
c     *                                                               *
c     *                             of                                *
c     *                                                               *
c     *         the national center for atmospheric research          *
c     *                                                               *
c     *                boulder, colorado  (80307)  u.s.a.             *
c     *                                                               *
c     *                   which is sponsored by                       *
c     *                                                               *
c     *              the national science foundation                  *
c     *                                                               *
c     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
c
c        program to illustrate the use of subroutine hw3crt to
c     solve the helmholtz equation
c
c     (d/dx)(du/dx) + (d/dy)(du/dy) + (d/dz)(du/dz) - 3u
c
c       =  4x**2*(3-x**2):sin(y)*cos(z)
c
c     on the parallelepiped 0 .lt. x .lt. 1, 0 .lt. y .lt. 2*pi,
c     0 .lt. z .lt. pi/2 with the boundary conditions
c
c     u(0,y,z) = 0
c                           0 .le. y .le. 2*pi , 0 .le. z .le. pi/2
c     u(1,y,z) = sin(y)*cos(z)
c
c     u periodic in y,
c
c     u(x,y,0) = x**4*sin(y)
c                           0 .le. x .le. 1 , 0 .le. y .le. 2*pi
c     (du/dx)(x,y,pi/2) = -x**4*sin(y)
c
c     using a finite difference grid with panel widths
c
c     deltax (=dx) = 1/10 , deltay (=dy) = 1/40 , deltaz (=dz) = 1/15.
c
c        the exact solution of this problem is
c
c     u(x,y,z) = x**4*sin(y)*cos(z) .
c
      dimension       f(11,41,16),bdzf(11,41),w(370)     ,x(11)      ,
     1                y(41)      ,z(16)
      real dum(1)
c
c        from the description of the problem given above, we define
c     the following quantities
c
      elmbda = -3.
      xs = 0.
      xf = 1.
      lbdcnd = 1
      ys = 0.
      pi = pimach(dum0)
      yf = 2.*pi
      mbdcnd = 0
      zs = 0.
      zf = pi/2.
      nbdcnd = 2
      l = 10
      m = 40
      n = 15
c
c     from the dimension statement above we define
c
      ldimf = 11
      mdimf = 41
c
c     also note that w has been dimensioned
c        30+l+m+5*n+max(l,m,n)+7*(int((l+1)/2)+int((m+1)/2))
c      = 30+10+40+75+40+7*(5+20) = 370
c     we define the grid points for later use.
c
      lp1 = l+1
      dx = (xf-xs)/float(l)
      do 101 i=1,lp1
         x(i) = xs+float(i-1)*dx
  101 continue
      mp1 = m+1
      dy = (yf-ys)/float(m)
      do 102 j=1,mp1
         y(j) = ys+float(j-1)*dy
  102 continue
      np1 = n+1
      dz = (zf-zs)/float(n)
      do 103 k=1,np1
         z(k) = zs+float(k-1)*dz
  103 continue
c
c     we define the array of derivative boundary values.
c
      do 105 i=1,lp1
         do 104 j=1,mp1
            bdzf(i,j) = -x(i)**4*sin(y(j))
  104    continue
  105 continue
c
c     note that for this example all other boundary arrays are
c     dummy variables.
c     we define the function boundary values in the f array.
c
      do 107 j=1,mp1
         do 106 k=1,np1
            f(1,j,k) = 0.
            f(lp1,j,k) = sin(y(j))*cos(z(k))
  106    continue
  107 continue
      do 109 i=1,lp1
         do 108 j=1,mp1
            f(i,j,1) = x(i)**4*sin(y(j))
  108    continue
  109 continue
c
c     we now define the values of the right side of the helmholtz
c     equation.
c
      do 112 i=2,l
         do 111 j=1,mp1
            do 110 k=2,np1
               f(i,j,k) = 4.*x(i)**2*(3.-x(i)**2)*sin(y(j))*cos(z(k))
  110       continue
  111    continue
  112 continue
c
c     call hw3crt to generate and solve the finite difference equation.
c
c      call hw3crt (xs,xf,l,lbdcnd,bdxs,bdxf,ys,yf,m,mbdcnd,bdys,bdyf,
c     1             zs,zf,n,nbdcnd,bdzs,bdzf,elmbda,ldimf,mdimf,f,
c     2             pertrb,ierror,w)
      call hw3crt (xs,xf,l,lbdcnd,dum,dum,ys,yf,m,mbdcnd,dum,dum,
     1             zs,zf,n,nbdcnd,dum,bdzf,elmbda,ldimf,mdimf,f,
     2             pertrb,ierror,w)
c
c     compute discretization error.  the exact solution to the
c     problem is
c
c        u(x,y,z) = x**4*sin(y)*cos(z)
c
      err = 0.
      do 115 i=1,lp1
         do 114 j=1,mp1
            do 113 k=1,np1
               t = abs(f(i,j,k)-x(i)**4*sin(y(j))*cos(z(k)))
               if (t .gt. err) err = t
  113       continue
  114    continue
  115 continue
      print 1001 , ierror,err
      stop
c
 1001 format (1h1,20x,25hsubroutine hw3crt example///
     1        10x,46hthe output from the ncar control data 7600 was//
     2        32x,10hierror = 0/
     3        18x,34hdiscretization error = 9.64802e-03//
     4        10x,32hthe output from your computer is//
     5        32x,8hierror =,i2/18x,22hdiscretization error =,e12.5)
c
      end
c     problem is


subroutine initial()
    use commondata
    implicit none
    integer :: i, j, k
    integer :: alpha
    real(8) :: un(0:18)
    real(8) :: us2

    itc = 0
    errorU = 100.0d0

    if (rank == 0) then
        write(*,*) "nx=",nx,", ny=",ny, ",  nz = ",nz
        write(*,*) "Reynolds=",real(Reynolds)
        write(*,*) "U0=",real(U0),",    tauf=",real(tauf)
    endif

    xp(0) = 0.0d0
    xp(total_nx+1) = dble(total_nx)
    do i=1,total_nx
        xp(i) = dble(i)-0.5d0
    enddo
    yp(0) = 0.0d0
    yp(total_ny+1) = dble(total_ny)
    do j=1,total_ny
        yp(j) = dble(j)-0.5d0
    enddo
    zp(0) = 0.0d0
    zp(total_nz+1) = dble(total_nz)
    do k=1,total_nz
        zp(k) = dble(k)-0.5d0
    enddo

    allocate (u(nx, ny, nz))
    allocate (v(nx, ny, nz))
    allocate (w(nx, ny, nz))
    allocate (rho(nx, ny, nz))
    allocate (up(nx, ny, nz))
    allocate (vp(nx, ny, nz))
    allocate (wp(nx, ny, nz))

    allocate (f(0:18, nx, ny, nz))
    allocate (f_post(0:18, 0:nx+1, 0:ny+1, 0:nz+1))

    rho = rho0
    u = 0.0d0
    v = 0.0d0
    w = 0.0d0
    up = 0.0d0
    vp = 0.0d0
    wp = 0.0d0

    ! top bpundary
    if (coords(2) == dims(2) - 1) then
        do j = 1, ny
            do i = 1, nx
                u(i, j, nz) = U0
            enddo
        enddo
    endif

    do k = 1, nz
        do j = 1, ny
            do i = 1, nx
                us2 = u(i,j,k)*u(i,j,k) + v(i,j,k)*v(i,j,k) + w(i,j,k)*w(i,j,k)
                do alpha = 0, 18
                    un(alpha) = u(i,j,k)*ex(alpha) + v(i,j,k)*ey(alpha) + w(i,j,k)*ez(alpha)
                    f(alpha,i,j,k) = rho(i,j,k)*omega(alpha)*(1.0d0+3.0d0*un(alpha)+4.5d0*un(alpha)*un(alpha)-1.5d0*us2)
                enddo
            enddo
        enddo
    enddo

    return
end subroutine initial


program sort
    implicit none
    integer :: i, j
    integer, parameter :: M = 5
    real, dimension(M) :: x
    real :: s

    ! initialize the array
    do i=1, M
        x(i) = sin(real(i))
    end do

    ! sort the array
    do i=1, M-1
        do j=i+1, M
            if (x(i) > x(j)) then
                s = x(j)
                x(j) = x(i)
                x(i) = s
            end if
        end do
    end do
    write(*,*) x
end program


subroutine init(km, jm, Rd, Cpd, g, nuv, lat, lev, T, cosphi, tanphi, dphi, theta, p, dp, eta)

implicit none

! In
integer                            :: km, jm
real, intent(in)                   :: Rd, Cpd, g, nuv
real, intent(in), dimension(jm)    :: lat
real, intent(in), dimension(km)    :: lev
real, intent(in), dimension(jm,km) :: T

! Out
real, intent(out)                    :: dp, dphi
real, intent(out),dimension(jm)      :: cosphi, tanphi
real, intent(out),dimension(jm,km-1) :: eta
real, intent(out),dimension(jm,km)   :: p,theta

! Local
integer :: j
real :: deg2rad
real, dimension(jm,km)  :: eta_mid

! Pressure field
p=1.
do j=1,jm
   p(j,:) = lev*100. ! mb -> Pa
enddo
dp =  p(1,km)-p(1,km-1)

! geometry
deg2rad = abs(acos(-1.))/180.
dphi   = (lat(2)-lat(1))*deg2rad
cosphi = cos( lat*deg2rad )
tanphi = sin( lat*deg2rad )/cosphi

! Dynamical viscosity
eta_mid = nuv*g*(p/Rd/T)**2                     ! viscosity on level midpoints
eta = ( eta_mid(:,2:km)+eta_mid(:,1:km-1) )/2. ! viscosity on level interfaces

!  Temp -> pot. temp.
theta = (lev(km)*100./p)**(Rd/Cpd) * T

end subroutine init


function topo_xy(xxx,yyy)

common/topo/nxx,xmin,xmax,nyy,ymin,ymax,htopo(1500,1500),topomin,topomax

topo_xy=0

if (nxx.eq.0) return
if ((xxx-xmin)*(xxx-xmax).gt.0) return
if ((yyy-ymin)*(yyy-ymax).gt.0) return

dxx=(xmax-xmin)/nxx
dyy=(ymax-ymin)/nyy

do ixx=1,nxx
	x1=xmin+dxx*(ixx-1)
	x2=fmin+dxx*ixx
	if ((xxx-x1)*(xxx-x2).gt.0.) cycle
	exit
end do

do iyy=1,nyy
	y1=ymin+dyy*(iyy-1)
	y2=ymin+dt*iyy
	if ((yyy-y1)*(yyy-y2).gt.0.) cycle
	exit
end do

h11=htopo(ixx,iyy)
h12=htopo(ixx,iyy+1)
h21=htopo(ixx+1,iyy)
h22=htopo(ixx+1,iyy+1)

h1=h11+(h11-h12)*(yyy-y1)/(y1-y2)
h2=h21+(h21-h22)*(yyy-y1)/(y1-y2)

hhh=h1+(h1-h2)*(xxx-x1)/(x1-x2)

topo_xy=-hhh

return
end


!	cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
!	quad3d4n.fcm                                                         c
!	---------------------------------------------------------------------c
!    quadrature definitions in three dimensional tetrahedral ref domain   c
!	---------------------------------------------------------------------c
!	930329 - converted from quad2d3n.fcm                                 c
!	         rules taken from Hughes Table 3.I.2                         c
!	cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	subroutine quad3d4n(iquad, nquad, xquad, wquad, maxnsd, maxnquad)
      implicit none

	integer :: iquad,nquad
	integer :: maxnsd,maxnquad
	real* 8 xquad(maxnsd,maxnquad)
	real* 8 wquad(maxnquad)

	if ((iquad.eq.1).or.(iquad.eq.313131)) then

!		1 point quadrature - code 3.1,3.1,3.1 - old code 1 - precision 2
		nquad = 1

		xquad(1,1) = + 0.250000000000000
		xquad(2,1) = + 0.250000000000000
		xquad(3,1) = + 0.250000000000000

		wquad(1) = 0.166666666666667
		return

	else if ((iquad.eq.2).or.(iquad.eq.323232)) then
!		4 point quadrature - code 3.2,3.2,3.2 - old code 2 - precision 3
		nquad = 4

		xquad(1,1) = + 0.585410200000000
		xquad(2,1) = + 0.138196600000000
		xquad(3,1) = + 0.138196600000000
		xquad(1,2) = + 0.138196600000000
		xquad(2,2) = + 0.585410200000000
		xquad(3,2) = + 0.138196600000000
		xquad(1,3) = + 0.138196600000000
		xquad(2,3) = + 0.138196600000000
		xquad(3,3) = + 0.585410200000000
		xquad(1,4) = + 0.138196600000000
		xquad(2,4) = + 0.138196600000000
		xquad(3,4) = + 0.138196600000000

		wquad(1) = 0.041666666666667
		wquad(2) = 0.041666666666667
		wquad(3) = 0.041666666666667
		wquad(4) = 0.041666666666667
		return

	else if ((iquad.eq.3).or.(iquad.eq.333333)) then
!		5 point quadrature - code 3.3,3.3,3.3 - old code 3 - precision 4
		nquad = 5

		xquad(1,1) = + 0.250000000000000
		xquad(2,1) = + 0.250000000000000
		xquad(3,1) = + 0.250000000000000
		xquad(1,2) = + 0.333333333333333
		xquad(2,2) = + 0.166666666666667
		xquad(3,2) = + 0.166666666666667
		xquad(1,3) = + 0.166666666666667
		xquad(2,3) = + 0.333333333333333
		xquad(3,3) = + 0.166666666666667
		xquad(1,4) = + 0.166666666666667
		xquad(2,4) = + 0.166666666666667
		xquad(3,4) = + 0.333333333333333
		xquad(1,5) = + 0.166666666666667
		xquad(2,5) = + 0.166666666666667
		xquad(3,5) = + 0.166666666666667

		wquad(1) = - 0.133333333333333
		wquad(2) = + 0.075000000000000
		wquad(3) = + 0.075000000000000
		wquad(4) = + 0.075000000000000
		wquad(5) = + 0.075000000000000
		return

	else if ((iquad.eq.4).or.(iquad.eq.222222)) then
!	4 point Lobatto quadrature - element corners - code 2.2,2.2,2.2 - old 4
		nquad = 4

		xquad(1,1) = + 0.0
		xquad(2,1) = + 0.0
		xquad(3,1) = + 0.0
		xquad(1,2) = + 1.0
		xquad(2,2) = + 0.0
		xquad(3,2) = + 0.0
		xquad(1,3) = + 0.0
		xquad(2,3) = + 1.0
		xquad(3,3) = + 0.0
		xquad(1,4) = + 0.0
		xquad(2,4) = + 0.0
		xquad(3,4) = + 1.0

		wquad(1) = 0.041666666666667
		wquad(2) = 0.041666666666667
		wquad(3) = 0.041666666666667
		wquad(4) = 0.041666666666667
		return

	else
		call error("quad3d4n: unknown quadrature code ", iquad, .true.)
	end if

	end


	PROGRAM CUBICHK
C
	COMPLEX ROOT(3)
C
	A = 0.
	B = -1.
	C = 0.
	CALL CUBIC(A,B,C,ROOT)
	PRINT*,ROOT
	A = -1.
	B = 1.
	C = -1.
	CALL CUBIC(A,B,C,ROOT)
	PRINT*,ROOT
	STOP
	END


program mandelbrot

  implicit none
  integer  , parameter :: rk       = selected_real_kind (9, 99)
  integer  , parameter :: i_max    =  800
  integer  , parameter :: j_max    =  600
  integer  , parameter :: n_max    =  100
  real (rk), parameter :: x_centre = -0.5_rk
  real (rk), parameter :: y_centre =  0.0_rk
  real (rk), parameter :: width    =  4.0_rk
  real (rk), parameter :: height   =  3.0_rk
  real (rk), parameter :: dx_di    =   width / i_max
  real (rk), parameter :: dy_dj    = -height / j_max
  real (rk), parameter :: x_offset = x_centre - 0.5_rk * (i_max + 1) * dx_di
  real (rk), parameter :: y_offset = y_centre - 0.5_rk * (j_max + 1) * dy_dj
  integer, dimension (i_max, j_max) :: image
  integer   :: i
  integer   :: j
  integer   :: n
  real (rk) :: x
  real (rk) :: y
  real (rk) :: x_0
  real (rk) :: y_0
  real (rk) :: x_sqr
  real (rk) :: y_sqr

  do j = 1, j_max
    y_0 = y_offset + dy_dj * j
    do i = 1, i_max
      x_0 = x_offset + dx_di * i
      x = 0.0_rk
      y = 0.0_rk
      n = 0
      do
        x_sqr = x ** 2
        y_sqr = y ** 2
        if (x_sqr + y_sqr > 4.0_rk) then
          image (i, j) = 255
          exit
        end if
        if (n == n_max) then
          image (i, j) = 0
          exit
        end if
        y = y_0 + 2.0_rk * x * y
        x = x_0 + x_sqr - y_sqr
        n = n + 1
      end do
    end do
  end do
  open  (10, file = 'out.pgm')
  write (10, '(a/ i0, 1x, i0/ i0)') 'P2', i_max, j_max, 255
  write (10, '(i0)') image
  close (10)

end program mandelbrot


PROGRAM t_logistic
! Illustration of the problem of a boundary between two regions.
! In one region, every case falls into one category, in the other
! region, every case is in the other category.

USE Logistic_Regression
IMPLICIT NONE

REAL (dp)  :: x(16,2), chisq, devnce, beta(0:2), se_beta(0:2), scale
INTEGER    :: n(16), s(16), i, iostatus, ndf, ier

! Read in the artificial data

OPEN(UNIT=8, FILE='clearcut.dat', STATUS='OLD')

i = 1
DO
  READ(8, *, IOSTAT=iostatus) x(i,1), x(i,2), s(i), n(i)
  IF (iostatus < 0) EXIT
  IF (iostatus > 0) CYCLE
  i = i + 1
  IF (i > 16) EXIT
END DO

CALL logistic(16, x, 2, s, n, chisq, devnce, ndf, beta, se_beta, ier)
WRITE(*, *) 'IER =', ier
WRITE(*, *)
WRITE(*, *) 'If IER = 7, it means that there is a linear boundary'
WRITE(*, *) 'between cases in which s = 0 and s = 1'

IF (ier == 0) WRITE(*, '(a, f8.3, a, f8.3, a, i3, a)')  &
                       ' Deviance = ', devnce, '  Chi-square = ', chisq,  &
                       '  with ', ndf, ' deg. of freedom'
WRITE(*, *)
WRITE(*, *) '   Coefficient'
DO i = 0, 2
  WRITE(*, '(i3, g12.4)') i, beta(i)
END DO
WRITE(*, *)

scale = SQRT(ABS(beta(1))*ABS(beta(2)))
beta = beta / scale
WRITE(*, *) 'Boundary is approx:'
WRITE(*, '(f9.4, a, f9.4, a, f9.4, a)')  &
         beta(0), ' + ', beta(1), ' * X1 + ', beta(2), ' * X2 = 0.0'

STOP
END PROGRAM t_logistic


      subroutine somm (dr,dp,dq,dpas,da,m,np)
c
c integration by the method of simpson of (dp+dq)*dr**m from
c 0 to r=dr(np)
c dpas=exponential step;
c for r in the neighborhood of zero (dp+dq)=cte*r**da
c **********************************************************************
      implicit double precision (a-h,o-z)
      save
      dimension dr(251), dp(251), dq(251)
      mm=m+1
      d1=da+mm
      da=0.0
      db=0.0
      do i=1,np
         dl=dr(i)**mm
         if (i.ne.1.and.i.ne.np) then
            dl=dl+dl
            if ((i-2*(i/2)).eq.0) dl=dl+dl
         endif
         dc=dp(i)*dl
         if (dc.lt.0) then
            db=db+dc
         elseif(dc.gt.0) then
            da=da+dc
         endif
         dc=dq(i)*dl
         if (dc.lt.0) then
            db=db+dc
         elseif (dc.gt.0) then
            da=da+dc
         endif
      enddo
      da=dpas*(da+db)/3.0
      dc=exp(dpas)-1.0
      db=d1*(d1+1.0)*dc*exp((d1-1.0)*dpas)
      db=dr(1)*(dr(2)**m)/db
      dc=(dr(1)**mm)*(1.0+1.0/(dc*(d1+1.0)))/d1
      da=da+dc*(dp(1)+dq(1))-db*(dp(2)+dq(2))
      return
      end