!******************************************************************************
!*                       Code generated with sympy 1.0                        *
!*                                                                            *
!*              See http://www.sympy.org/ for more information.               *
!*                                                                            *
!*                 This file is part of 'elmer-mgs-galfenol'                  *
!******************************************************************************

REAL(KIND=dp) function dexx_depsxx()
use types
implicit none

dexx_depsxx = 2.0e0_dp/3.0e0_dp

end function

REAL(KIND=dp) function dexx_depsyy()
use types
implicit none

dexx_depsyy = -1.0e0_dp/3.0e0_dp

end function

REAL(KIND=dp) function dexx_depszz()
use types
implicit none

dexx_depszz = -1.0e0_dp/3.0e0_dp

end function

REAL(KIND=dp) function dexy_depsxy()
use types
implicit none

dexy_depsxy = 1

end function

REAL(KIND=dp) function deyy_depsxx()
use types
implicit none

deyy_depsxx = -1.0e0_dp/3.0e0_dp

end function

REAL(KIND=dp) function deyy_depsyy()
use types
implicit none

deyy_depsyy = 2.0e0_dp/3.0e0_dp

end function

REAL(KIND=dp) function deyy_depszz()
use types
implicit none

deyy_depszz = -1.0e0_dp/3.0e0_dp

end function

REAL(KIND=dp) function deyz_depsyz()
use types
implicit none

deyz_depsyz = 1

end function

REAL(KIND=dp) function dezx_depszx()
use types
implicit none

dezx_depszx = 1

end function

REAL(KIND=dp) function dezz_depsxx()
use types
implicit none

dezz_depsxx = -1.0e0_dp/3.0e0_dp

end function

REAL(KIND=dp) function dezz_depsyy()
use types
implicit none

dezz_depsyy = -1.0e0_dp/3.0e0_dp

end function

REAL(KIND=dp) function dezz_depszz()
use types
implicit none

dezz_depszz = 2.0e0_dp/3.0e0_dp

end function

REAL(KIND=dp) function dI1_depsxx()
use types
implicit none

dI1_depsxx = 1

end function

REAL(KIND=dp) function dI1_depsyy()
use types
implicit none

dI1_depsyy = 1

end function

REAL(KIND=dp) function dI1_depszz()
use types
implicit none

dI1_depszz = 1

end function

REAL(KIND=dp) function dI2_depsxx(epsxx)
use types
implicit none
REAL(KIND=dp), intent(in) :: epsxx

dI2_depsxx = 2*epsxx

end function

REAL(KIND=dp) function d2I2_depsxx2()
use types
implicit none

d2I2_depsxx2 = 2

end function

REAL(KIND=dp) function dI2_depsxy(epsxy)
use types
implicit none
REAL(KIND=dp), intent(in) :: epsxy

dI2_depsxy = 4*epsxy

end function

REAL(KIND=dp) function d2I2_depsxy2()
use types
implicit none

d2I2_depsxy2 = 4

end function

REAL(KIND=dp) function dI2_depsyy(epsyy)
use types
implicit none
REAL(KIND=dp), intent(in) :: epsyy

dI2_depsyy = 2*epsyy

end function

REAL(KIND=dp) function d2I2_depsyy2()
use types
implicit none

d2I2_depsyy2 = 2

end function

REAL(KIND=dp) function dI2_depsyz(epsyz)
use types
implicit none
REAL(KIND=dp), intent(in) :: epsyz

dI2_depsyz = 4*epsyz

end function

REAL(KIND=dp) function d2I2_depsyz2()
use types
implicit none

d2I2_depsyz2 = 4

end function

REAL(KIND=dp) function dI2_depszx(epszx)
use types
implicit none
REAL(KIND=dp), intent(in) :: epszx

dI2_depszx = 4*epszx

end function

REAL(KIND=dp) function d2I2_depszx2()
use types
implicit none

d2I2_depszx2 = 4

end function

REAL(KIND=dp) function dI2_depszz(epszz)
use types
implicit none
REAL(KIND=dp), intent(in) :: epszz

dI2_depszz = 2*epszz

end function

REAL(KIND=dp) function d2I2_depszz2()
use types
implicit none

d2I2_depszz2 = 2

end function

REAL(KIND=dp) function dI4_dBx(Bx)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx

dI4_dBx = 2*Bx

end function

REAL(KIND=dp) function d2I4_dBx2()
use types
implicit none

d2I4_dBx2 = 2

end function

REAL(KIND=dp) function dI4_dBy(By)
use types
implicit none
REAL(KIND=dp), intent(in) :: By

dI4_dBy = 2*By

end function

REAL(KIND=dp) function d2I4_dBy2()
use types
implicit none

d2I4_dBy2 = 2

end function

REAL(KIND=dp) function dI4_dBz(Bz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bz

dI4_dBz = 2*Bz

end function

REAL(KIND=dp) function d2I4_dBz2()
use types
implicit none

d2I4_dBz2 = 2

end function

REAL(KIND=dp) function dI5_dBx(Bx, By, Bz, exx, exy, ezx)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exx
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: ezx

dI5_dBx = 2*Bx*exx + 2*By*exy + 2*Bz*ezx

end function

REAL(KIND=dp) function d2I5_dBx2(exx)
use types
implicit none
REAL(KIND=dp), intent(in) :: exx

d2I5_dBx2 = 2*exx

end function

REAL(KIND=dp) function d2I5_dBxdBy(exy)
use types
implicit none
REAL(KIND=dp), intent(in) :: exy

d2I5_dBxdBy = 2*exy

end function

REAL(KIND=dp) function d2I5_dBxdBz(ezx)
use types
implicit none
REAL(KIND=dp), intent(in) :: ezx

d2I5_dBxdBz = 2*ezx

end function

REAL(KIND=dp) function d2I5_dBxdexx(Bx)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx

d2I5_dBxdexx = 2*Bx

end function

REAL(KIND=dp) function d2I5_dBxdexy(By)
use types
implicit none
REAL(KIND=dp), intent(in) :: By

d2I5_dBxdexy = 2*By

end function

REAL(KIND=dp) function d2I5_dBxdezx(Bz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bz

d2I5_dBxdezx = 2*Bz

end function

REAL(KIND=dp) function dI5_dBy(Bx, By, Bz, exy, eyy, eyz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyy
REAL(KIND=dp), intent(in) :: eyz

dI5_dBy = 2*Bx*exy + 2*By*eyy + 2*Bz*eyz

end function

REAL(KIND=dp) function d2I5_dBy2(eyy)
use types
implicit none
REAL(KIND=dp), intent(in) :: eyy

d2I5_dBy2 = 2*eyy

end function

REAL(KIND=dp) function d2I5_dBydBz(eyz)
use types
implicit none
REAL(KIND=dp), intent(in) :: eyz

d2I5_dBydBz = 2*eyz

end function

REAL(KIND=dp) function d2I5_dBydexy(Bx)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx

d2I5_dBydexy = 2*Bx

end function

REAL(KIND=dp) function d2I5_dBydeyy(By)
use types
implicit none
REAL(KIND=dp), intent(in) :: By

d2I5_dBydeyy = 2*By

end function

REAL(KIND=dp) function d2I5_dBydeyz(Bz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bz

d2I5_dBydeyz = 2*Bz

end function

REAL(KIND=dp) function dI5_dBz(Bx, By, Bz, eyz, ezx, ezz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezx
REAL(KIND=dp), intent(in) :: ezz

dI5_dBz = 2*Bx*ezx + 2*By*eyz + 2*Bz*ezz

end function

REAL(KIND=dp) function d2I5_dBz2(ezz)
use types
implicit none
REAL(KIND=dp), intent(in) :: ezz

d2I5_dBz2 = 2*ezz

end function

REAL(KIND=dp) function d2I5_dBzdeyz(By)
use types
implicit none
REAL(KIND=dp), intent(in) :: By

d2I5_dBzdeyz = 2*By

end function

REAL(KIND=dp) function d2I5_dBzdezx(Bx)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx

d2I5_dBzdezx = 2*Bx

end function

REAL(KIND=dp) function d2I5_dBzdezz(Bz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bz

d2I5_dBzdezz = 2*Bz

end function

REAL(KIND=dp) function dI5_dexx(Bx)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx

dI5_dexx = Bx**2

end function

REAL(KIND=dp) function dI5_dexy(Bx, By)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By

dI5_dexy = 2*Bx*By

end function

REAL(KIND=dp) function dI5_deyy(By)
use types
implicit none
REAL(KIND=dp), intent(in) :: By

dI5_deyy = By**2

end function

REAL(KIND=dp) function dI5_deyz(By, Bz)
use types
implicit none
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz

dI5_deyz = 2*By*Bz

end function

REAL(KIND=dp) function dI5_dezx(Bx, Bz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: Bz

dI5_dezx = 2*Bx*Bz

end function

REAL(KIND=dp) function dI5_dezz(Bz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bz

dI5_dezz = Bz**2

end function

REAL(KIND=dp) function dI6_dBx(Bx, By, Bz, exx, exy, eyy, eyz, ezx, ezz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exx
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyy
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezx
REAL(KIND=dp), intent(in) :: ezz

dI6_dBx = 2*Bx*(exx**2 + exy**2 + ezx**2) + 2*By*(exx*exy + exy*eyy + &
      eyz*ezx) + 2*Bz*(exx*ezx + exy*eyz + ezx*ezz)

end function

REAL(KIND=dp) function d2I6_dBx2(exx, exy, ezx)
use types
implicit none
REAL(KIND=dp), intent(in) :: exx
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: ezx

d2I6_dBx2 = 2*exx**2 + 2*exy**2 + 2*ezx**2

end function

REAL(KIND=dp) function d2I6_dBxdBy(exx, exy, eyy, eyz, ezx)
use types
implicit none
REAL(KIND=dp), intent(in) :: exx
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyy
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezx

d2I6_dBxdBy = 2*exx*exy + 2*exy*eyy + 2*eyz*ezx

end function

REAL(KIND=dp) function d2I6_dBxdBz(exx, exy, eyz, ezx, ezz)
use types
implicit none
REAL(KIND=dp), intent(in) :: exx
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezx
REAL(KIND=dp), intent(in) :: ezz

d2I6_dBxdBz = 2*exx*ezx + 2*exy*eyz + 2*ezx*ezz

end function

REAL(KIND=dp) function d2I6_dBxdexx(Bx, By, Bz, exx, exy, ezx)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exx
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: ezx

d2I6_dBxdexx = 4*Bx*exx + 2*By*exy + 2*Bz*ezx

end function

REAL(KIND=dp) function d2I6_dBxdexy(Bx, By, Bz, exx, exy, eyy, eyz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exx
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyy
REAL(KIND=dp), intent(in) :: eyz

d2I6_dBxdexy = 4*Bx*exy + 2*By*(exx + eyy) + 2*Bz*eyz

end function

REAL(KIND=dp) function d2I6_dBxdeyy(By, exy)
use types
implicit none
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: exy

d2I6_dBxdeyy = 2*By*exy

end function

REAL(KIND=dp) function d2I6_dBxdeyz(By, Bz, exy, ezx)
use types
implicit none
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: ezx

d2I6_dBxdeyz = 2*By*ezx + 2*Bz*exy

end function

REAL(KIND=dp) function d2I6_dBxdezx(Bx, By, Bz, exx, eyz, ezx, ezz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exx
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezx
REAL(KIND=dp), intent(in) :: ezz

d2I6_dBxdezx = 4*Bx*ezx + 2*By*eyz + 2*Bz*(exx + ezz)

end function

REAL(KIND=dp) function d2I6_dBxdezz(Bz, ezx)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: ezx

d2I6_dBxdezz = 2*Bz*ezx

end function

REAL(KIND=dp) function dI6_dBy(Bx, By, Bz, exx, exy, eyy, eyz, ezx, ezz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exx
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyy
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezx
REAL(KIND=dp), intent(in) :: ezz

dI6_dBy = 2*Bx*(exx*exy + exy*eyy + eyz*ezx) + 2*By*(exy**2 + eyy**2 + &
      eyz**2) + 2*Bz*(exy*ezx + eyy*eyz + eyz*ezz)

end function

REAL(KIND=dp) function d2I6_dBy2(exy, eyy, eyz)
use types
implicit none
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyy
REAL(KIND=dp), intent(in) :: eyz

d2I6_dBy2 = 2*exy**2 + 2*eyy**2 + 2*eyz**2

end function

REAL(KIND=dp) function d2I6_dBydBz(exy, eyy, eyz, ezx, ezz)
use types
implicit none
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyy
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezx
REAL(KIND=dp), intent(in) :: ezz

d2I6_dBydBz = 2*exy*ezx + 2*eyy*eyz + 2*eyz*ezz

end function

REAL(KIND=dp) function d2I6_dBydexx(Bx, exy)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: exy

d2I6_dBydexx = 2*Bx*exy

end function

REAL(KIND=dp) function d2I6_dBydexy(Bx, By, Bz, exx, exy, eyy, ezx)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exx
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyy
REAL(KIND=dp), intent(in) :: ezx

d2I6_dBydexy = 2*Bx*(exx + eyy) + 4*By*exy + 2*Bz*ezx

end function

REAL(KIND=dp) function d2I6_dBydeyy(Bx, By, Bz, exy, eyy, eyz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyy
REAL(KIND=dp), intent(in) :: eyz

d2I6_dBydeyy = 2*Bx*exy + 4*By*eyy + 2*Bz*eyz

end function

REAL(KIND=dp) function d2I6_dBydeyz(Bx, By, Bz, eyy, eyz, ezx, ezz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: eyy
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezx
REAL(KIND=dp), intent(in) :: ezz

d2I6_dBydeyz = 2*Bx*ezx + 4*By*eyz + 2*Bz*(eyy + ezz)

end function

REAL(KIND=dp) function d2I6_dBydezx(Bx, Bz, exy, eyz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyz

d2I6_dBydezx = 2*Bx*eyz + 2*Bz*exy

end function

REAL(KIND=dp) function d2I6_dBydezz(Bz, eyz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: eyz

d2I6_dBydezz = 2*Bz*eyz

end function

REAL(KIND=dp) function dI6_dBz(Bx, By, Bz, exx, exy, eyy, eyz, ezx, ezz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exx
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyy
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezx
REAL(KIND=dp), intent(in) :: ezz

dI6_dBz = 2*Bx*(exx*ezx + exy*eyz + ezx*ezz) + 2*By*(exy*ezx + eyy*eyz + &
      eyz*ezz) + 2*Bz*(eyz**2 + ezx**2 + ezz**2)

end function

REAL(KIND=dp) function d2I6_dBz2(eyz, ezx, ezz)
use types
implicit none
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezx
REAL(KIND=dp), intent(in) :: ezz

d2I6_dBz2 = 2*eyz**2 + 2*ezx**2 + 2*ezz**2

end function

REAL(KIND=dp) function d2I6_dBzdexx(Bx, ezx)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: ezx

d2I6_dBzdexx = 2*Bx*ezx

end function

REAL(KIND=dp) function d2I6_dBzdexy(Bx, By, eyz, ezx)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezx

d2I6_dBzdexy = 2*Bx*eyz + 2*By*ezx

end function

REAL(KIND=dp) function d2I6_dBzdeyy(By, eyz)
use types
implicit none
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: eyz

d2I6_dBzdeyy = 2*By*eyz

end function

REAL(KIND=dp) function d2I6_dBzdeyz(Bx, By, Bz, exy, eyy, eyz, ezz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyy
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezz

d2I6_dBzdeyz = 2*Bx*exy + 2*By*(eyy + ezz) + 4*Bz*eyz

end function

REAL(KIND=dp) function d2I6_dBzdezx(Bx, By, Bz, exx, exy, ezx, ezz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exx
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: ezx
REAL(KIND=dp), intent(in) :: ezz

d2I6_dBzdezx = 2*Bx*(exx + ezz) + 2*By*exy + 4*Bz*ezx

end function

REAL(KIND=dp) function d2I6_dBzdezz(Bx, By, Bz, eyz, ezx, ezz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezx
REAL(KIND=dp), intent(in) :: ezz

d2I6_dBzdezz = 2*Bx*ezx + 2*By*eyz + 4*Bz*ezz

end function

REAL(KIND=dp) function dI6_dexx(Bx, By, Bz, exx, exy, ezx)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exx
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: ezx

dI6_dexx = 2*Bx*(Bx*exx + By*exy + Bz*ezx)

end function

REAL(KIND=dp) function d2I6_dexx2(Bx)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx

d2I6_dexx2 = 2*Bx**2

end function

REAL(KIND=dp) function d2I6_dexxdexy(Bx, By)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By

d2I6_dexxdexy = 2*Bx*By

end function

REAL(KIND=dp) function d2I6_dexxdezx(Bx, Bz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: Bz

d2I6_dexxdezx = 2*Bx*Bz

end function

REAL(KIND=dp) function dI6_dexy(Bx, By, Bz, exx, exy, eyy, eyz, ezx)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exx
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyy
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezx

dI6_dexy = 2*Bx**2*exy + 2*Bx*(By*(exx + eyy) + Bz*eyz) + 2*By**2*exy + &
      2*By*Bz*ezx

end function

REAL(KIND=dp) function d2I6_dexy2(Bx, By)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By

d2I6_dexy2 = 2*Bx**2 + 2*By**2

end function

REAL(KIND=dp) function d2I6_dexydeyy(Bx, By)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By

d2I6_dexydeyy = 2*Bx*By

end function

REAL(KIND=dp) function d2I6_dexydeyz(Bx, Bz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: Bz

d2I6_dexydeyz = 2*Bx*Bz

end function

REAL(KIND=dp) function d2I6_dexydezx(By, Bz)
use types
implicit none
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz

d2I6_dexydezx = 2*By*Bz

end function

REAL(KIND=dp) function dI6_deyy(Bx, By, Bz, exy, eyy, eyz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyy
REAL(KIND=dp), intent(in) :: eyz

dI6_deyy = 2*By*(Bx*exy + By*eyy + Bz*eyz)

end function

REAL(KIND=dp) function d2I6_deyy2(By)
use types
implicit none
REAL(KIND=dp), intent(in) :: By

d2I6_deyy2 = 2*By**2

end function

REAL(KIND=dp) function d2I6_deyydeyz(By, Bz)
use types
implicit none
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz

d2I6_deyydeyz = 2*By*Bz

end function

REAL(KIND=dp) function dI6_deyz(Bx, By, Bz, exy, eyy, eyz, ezx, ezz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyy
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezx
REAL(KIND=dp), intent(in) :: ezz

dI6_deyz = 2*Bx*By*ezx + 2*By**2*eyz + 2*Bz**2*eyz + 2*Bz*(Bx*exy + By*( &
      eyy + ezz))

end function

REAL(KIND=dp) function d2I6_deyz2(By, Bz)
use types
implicit none
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz

d2I6_deyz2 = 2*By**2 + 2*Bz**2

end function

REAL(KIND=dp) function d2I6_deyzdezx(Bx, By)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By

d2I6_deyzdezx = 2*Bx*By

end function

REAL(KIND=dp) function d2I6_deyzdezz(By, Bz)
use types
implicit none
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz

d2I6_deyzdezz = 2*By*Bz

end function

REAL(KIND=dp) function dI6_dezx(Bx, By, Bz, exx, exy, eyz, ezx, ezz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exx
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezx
REAL(KIND=dp), intent(in) :: ezz

dI6_dezx = 2*Bx**2*ezx + 2*Bx*(By*eyz + Bz*(exx + ezz)) + 2*By*Bz*exy + &
      2*Bz**2*ezx

end function

REAL(KIND=dp) function d2I6_dezx2(Bx, Bz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: Bz

d2I6_dezx2 = 2*Bx**2 + 2*Bz**2

end function

REAL(KIND=dp) function d2I6_dezxdezz(Bx, Bz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: Bz

d2I6_dezxdezz = 2*Bx*Bz

end function

REAL(KIND=dp) function dI6_dezz(Bx, By, Bz, eyz, ezx, ezz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezx
REAL(KIND=dp), intent(in) :: ezz

dI6_dezz = 2*Bz*(Bx*ezx + By*eyz + Bz*ezz)

end function

REAL(KIND=dp) function d2I6_dezz2(Bz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bz

d2I6_dezz2 = 2*Bz**2

end function

REAL(KIND=dp) function dphi_dBx(dI4_dBx, dI5_dBx, dI6_dBx, dphi_dI4, dphi_dI5, &
      dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: dI4_dBx
REAL(KIND=dp), intent(in) :: dI5_dBx
REAL(KIND=dp), intent(in) :: dI6_dBx
REAL(KIND=dp), intent(in) :: dphi_dI4
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

dphi_dBx = dI4_dBx*dphi_dI4 + dI5_dBx*dphi_dI5 + dI6_dBx*dphi_dI6

end function

REAL(KIND=dp) function d2phi_dBx2(d2I4_dBx2, d2I5_dBx2, d2I6_dBx2, d2phi_dI42, &
      dI4_dBx, dphi_dI4, dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I4_dBx2
REAL(KIND=dp), intent(in) :: d2I5_dBx2
REAL(KIND=dp), intent(in) :: d2I6_dBx2
REAL(KIND=dp), intent(in) :: d2phi_dI42
REAL(KIND=dp), intent(in) :: dI4_dBx
REAL(KIND=dp), intent(in) :: dphi_dI4
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBx2 = d2I4_dBx2*dphi_dI4 + d2I5_dBx2*dphi_dI5 + d2I6_dBx2* &
      dphi_dI6 + d2phi_dI42*dI4_dBx**2

end function

REAL(KIND=dp) function d2phi_dBxdBy(d2I5_dBxdBy, d2I6_dBxdBy, d2phi_dI42, dI4_dBx, &
      dI4_dBy, dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I5_dBxdBy
REAL(KIND=dp), intent(in) :: d2I6_dBxdBy
REAL(KIND=dp), intent(in) :: d2phi_dI42
REAL(KIND=dp), intent(in) :: dI4_dBx
REAL(KIND=dp), intent(in) :: dI4_dBy
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBxdBy = d2I5_dBxdBy*dphi_dI5 + d2I6_dBxdBy*dphi_dI6 + d2phi_dI42* &
      dI4_dBx*dI4_dBy

end function

REAL(KIND=dp) function d2phi_dBxdBz(d2I5_dBxdBz, d2I6_dBxdBz, d2phi_dI42, dI4_dBx, &
      dI4_dBz, dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I5_dBxdBz
REAL(KIND=dp), intent(in) :: d2I6_dBxdBz
REAL(KIND=dp), intent(in) :: d2phi_dI42
REAL(KIND=dp), intent(in) :: dI4_dBx
REAL(KIND=dp), intent(in) :: dI4_dBz
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBxdBz = d2I5_dBxdBz*dphi_dI5 + d2I6_dBxdBz*dphi_dI6 + d2phi_dI42* &
      dI4_dBx*dI4_dBz

end function

REAL(KIND=dp) function d2phi_dBxdepsxx(d2I5_dBxdexx, d2I6_dBxdexx, d2I6_dBxdeyy, &
      d2I6_dBxdezz, dexx_depsxx, deyy_depsxx, dezz_depsxx, &
      dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I5_dBxdexx
REAL(KIND=dp), intent(in) :: d2I6_dBxdexx
REAL(KIND=dp), intent(in) :: d2I6_dBxdeyy
REAL(KIND=dp), intent(in) :: d2I6_dBxdezz
REAL(KIND=dp), intent(in) :: dexx_depsxx
REAL(KIND=dp), intent(in) :: deyy_depsxx
REAL(KIND=dp), intent(in) :: dezz_depsxx
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBxdepsxx = d2I5_dBxdexx*dexx_depsxx*dphi_dI5 + dphi_dI6*( &
      d2I6_dBxdexx*dexx_depsxx + d2I6_dBxdeyy*deyy_depsxx + &
      d2I6_dBxdezz*dezz_depsxx)

end function

REAL(KIND=dp) function d2phi_dBxdepsxy(d2I5_dBxdexy, d2I6_dBxdexy, dexy_depsxy, &
      dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I5_dBxdexy
REAL(KIND=dp), intent(in) :: d2I6_dBxdexy
REAL(KIND=dp), intent(in) :: dexy_depsxy
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBxdepsxy = d2I5_dBxdexy*dexy_depsxy*dphi_dI5 + d2I6_dBxdexy* &
      dexy_depsxy*dphi_dI6

end function

REAL(KIND=dp) function d2phi_dBxdepsyy(d2I5_dBxdexx, d2I6_dBxdexx, d2I6_dBxdeyy, &
      d2I6_dBxdezz, dexx_depsyy, deyy_depsyy, dezz_depsyy, &
      dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I5_dBxdexx
REAL(KIND=dp), intent(in) :: d2I6_dBxdexx
REAL(KIND=dp), intent(in) :: d2I6_dBxdeyy
REAL(KIND=dp), intent(in) :: d2I6_dBxdezz
REAL(KIND=dp), intent(in) :: dexx_depsyy
REAL(KIND=dp), intent(in) :: deyy_depsyy
REAL(KIND=dp), intent(in) :: dezz_depsyy
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBxdepsyy = d2I5_dBxdexx*dexx_depsyy*dphi_dI5 + dphi_dI6*( &
      d2I6_dBxdexx*dexx_depsyy + d2I6_dBxdeyy*deyy_depsyy + &
      d2I6_dBxdezz*dezz_depsyy)

end function

REAL(KIND=dp) function d2phi_dBxdepsyz(d2I6_dBxdeyz, deyz_depsyz, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I6_dBxdeyz
REAL(KIND=dp), intent(in) :: deyz_depsyz
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBxdepsyz = d2I6_dBxdeyz*deyz_depsyz*dphi_dI6

end function

REAL(KIND=dp) function d2phi_dBxdepszx(d2I5_dBxdezx, d2I6_dBxdezx, dezx_depszx, &
      dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I5_dBxdezx
REAL(KIND=dp), intent(in) :: d2I6_dBxdezx
REAL(KIND=dp), intent(in) :: dezx_depszx
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBxdepszx = d2I5_dBxdezx*dezx_depszx*dphi_dI5 + d2I6_dBxdezx* &
      dezx_depszx*dphi_dI6

end function

REAL(KIND=dp) function d2phi_dBxdepszz(d2I5_dBxdexx, d2I6_dBxdexx, d2I6_dBxdeyy, &
      d2I6_dBxdezz, dexx_depszz, deyy_depszz, dezz_depszz, &
      dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I5_dBxdexx
REAL(KIND=dp), intent(in) :: d2I6_dBxdexx
REAL(KIND=dp), intent(in) :: d2I6_dBxdeyy
REAL(KIND=dp), intent(in) :: d2I6_dBxdezz
REAL(KIND=dp), intent(in) :: dexx_depszz
REAL(KIND=dp), intent(in) :: deyy_depszz
REAL(KIND=dp), intent(in) :: dezz_depszz
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBxdepszz = d2I5_dBxdexx*dexx_depszz*dphi_dI5 + dphi_dI6*( &
      d2I6_dBxdexx*dexx_depszz + d2I6_dBxdeyy*deyy_depszz + &
      d2I6_dBxdezz*dezz_depszz)

end function

REAL(KIND=dp) function dphi_dBy(dI4_dBy, dI5_dBy, dI6_dBy, dphi_dI4, dphi_dI5, &
      dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: dI4_dBy
REAL(KIND=dp), intent(in) :: dI5_dBy
REAL(KIND=dp), intent(in) :: dI6_dBy
REAL(KIND=dp), intent(in) :: dphi_dI4
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

dphi_dBy = dI4_dBy*dphi_dI4 + dI5_dBy*dphi_dI5 + dI6_dBy*dphi_dI6

end function

REAL(KIND=dp) function d2phi_dBy2(d2I4_dBy2, d2I5_dBy2, d2I6_dBy2, d2phi_dI42, &
      dI4_dBy, dphi_dI4, dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I4_dBy2
REAL(KIND=dp), intent(in) :: d2I5_dBy2
REAL(KIND=dp), intent(in) :: d2I6_dBy2
REAL(KIND=dp), intent(in) :: d2phi_dI42
REAL(KIND=dp), intent(in) :: dI4_dBy
REAL(KIND=dp), intent(in) :: dphi_dI4
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBy2 = d2I4_dBy2*dphi_dI4 + d2I5_dBy2*dphi_dI5 + d2I6_dBy2* &
      dphi_dI6 + d2phi_dI42*dI4_dBy**2

end function

REAL(KIND=dp) function d2phi_dBydBz(d2I5_dBydBz, d2I6_dBydBz, d2phi_dI42, dI4_dBy, &
      dI4_dBz, dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I5_dBydBz
REAL(KIND=dp), intent(in) :: d2I6_dBydBz
REAL(KIND=dp), intent(in) :: d2phi_dI42
REAL(KIND=dp), intent(in) :: dI4_dBy
REAL(KIND=dp), intent(in) :: dI4_dBz
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBydBz = d2I5_dBydBz*dphi_dI5 + d2I6_dBydBz*dphi_dI6 + d2phi_dI42* &
      dI4_dBy*dI4_dBz

end function

REAL(KIND=dp) function d2phi_dBydepsxx(d2I5_dBydeyy, d2I6_dBydexx, d2I6_dBydeyy, &
      d2I6_dBydezz, dexx_depsxx, deyy_depsxx, dezz_depsxx, &
      dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I5_dBydeyy
REAL(KIND=dp), intent(in) :: d2I6_dBydexx
REAL(KIND=dp), intent(in) :: d2I6_dBydeyy
REAL(KIND=dp), intent(in) :: d2I6_dBydezz
REAL(KIND=dp), intent(in) :: dexx_depsxx
REAL(KIND=dp), intent(in) :: deyy_depsxx
REAL(KIND=dp), intent(in) :: dezz_depsxx
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBydepsxx = d2I5_dBydeyy*deyy_depsxx*dphi_dI5 + dphi_dI6*( &
      d2I6_dBydexx*dexx_depsxx + d2I6_dBydeyy*deyy_depsxx + &
      d2I6_dBydezz*dezz_depsxx)

end function

REAL(KIND=dp) function d2phi_dBydepsxy(d2I5_dBydexy, d2I6_dBydexy, dexy_depsxy, &
      dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I5_dBydexy
REAL(KIND=dp), intent(in) :: d2I6_dBydexy
REAL(KIND=dp), intent(in) :: dexy_depsxy
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBydepsxy = d2I5_dBydexy*dexy_depsxy*dphi_dI5 + d2I6_dBydexy* &
      dexy_depsxy*dphi_dI6

end function

REAL(KIND=dp) function d2phi_dBydepsyy(d2I5_dBydeyy, d2I6_dBydexx, d2I6_dBydeyy, &
      d2I6_dBydezz, dexx_depsyy, deyy_depsyy, dezz_depsyy, &
      dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I5_dBydeyy
REAL(KIND=dp), intent(in) :: d2I6_dBydexx
REAL(KIND=dp), intent(in) :: d2I6_dBydeyy
REAL(KIND=dp), intent(in) :: d2I6_dBydezz
REAL(KIND=dp), intent(in) :: dexx_depsyy
REAL(KIND=dp), intent(in) :: deyy_depsyy
REAL(KIND=dp), intent(in) :: dezz_depsyy
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBydepsyy = d2I5_dBydeyy*deyy_depsyy*dphi_dI5 + dphi_dI6*( &
      d2I6_dBydexx*dexx_depsyy + d2I6_dBydeyy*deyy_depsyy + &
      d2I6_dBydezz*dezz_depsyy)

end function

REAL(KIND=dp) function d2phi_dBydepsyz(d2I5_dBydeyz, d2I6_dBydeyz, deyz_depsyz, &
      dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I5_dBydeyz
REAL(KIND=dp), intent(in) :: d2I6_dBydeyz
REAL(KIND=dp), intent(in) :: deyz_depsyz
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBydepsyz = d2I5_dBydeyz*deyz_depsyz*dphi_dI5 + d2I6_dBydeyz* &
      deyz_depsyz*dphi_dI6

end function

REAL(KIND=dp) function d2phi_dBydepszx(d2I6_dBydezx, dezx_depszx, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I6_dBydezx
REAL(KIND=dp), intent(in) :: dezx_depszx
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBydepszx = d2I6_dBydezx*dezx_depszx*dphi_dI6

end function

REAL(KIND=dp) function d2phi_dBydepszz(d2I5_dBydeyy, d2I6_dBydexx, d2I6_dBydeyy, &
      d2I6_dBydezz, dexx_depszz, deyy_depszz, dezz_depszz, &
      dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I5_dBydeyy
REAL(KIND=dp), intent(in) :: d2I6_dBydexx
REAL(KIND=dp), intent(in) :: d2I6_dBydeyy
REAL(KIND=dp), intent(in) :: d2I6_dBydezz
REAL(KIND=dp), intent(in) :: dexx_depszz
REAL(KIND=dp), intent(in) :: deyy_depszz
REAL(KIND=dp), intent(in) :: dezz_depszz
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBydepszz = d2I5_dBydeyy*deyy_depszz*dphi_dI5 + dphi_dI6*( &
      d2I6_dBydexx*dexx_depszz + d2I6_dBydeyy*deyy_depszz + &
      d2I6_dBydezz*dezz_depszz)

end function

REAL(KIND=dp) function dphi_dBz(dI4_dBz, dI5_dBz, dI6_dBz, dphi_dI4, dphi_dI5, &
      dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: dI4_dBz
REAL(KIND=dp), intent(in) :: dI5_dBz
REAL(KIND=dp), intent(in) :: dI6_dBz
REAL(KIND=dp), intent(in) :: dphi_dI4
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

dphi_dBz = dI4_dBz*dphi_dI4 + dI5_dBz*dphi_dI5 + dI6_dBz*dphi_dI6

end function

REAL(KIND=dp) function d2phi_dBz2(d2I4_dBz2, d2I5_dBz2, d2I6_dBz2, d2phi_dI42, &
      dI4_dBz, dphi_dI4, dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I4_dBz2
REAL(KIND=dp), intent(in) :: d2I5_dBz2
REAL(KIND=dp), intent(in) :: d2I6_dBz2
REAL(KIND=dp), intent(in) :: d2phi_dI42
REAL(KIND=dp), intent(in) :: dI4_dBz
REAL(KIND=dp), intent(in) :: dphi_dI4
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBz2 = d2I4_dBz2*dphi_dI4 + d2I5_dBz2*dphi_dI5 + d2I6_dBz2* &
      dphi_dI6 + d2phi_dI42*dI4_dBz**2

end function

REAL(KIND=dp) function d2phi_dBzdepsxx(d2I5_dBzdezz, d2I6_dBzdexx, d2I6_dBzdeyy, &
      d2I6_dBzdezz, dexx_depsxx, deyy_depsxx, dezz_depsxx, &
      dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I5_dBzdezz
REAL(KIND=dp), intent(in) :: d2I6_dBzdexx
REAL(KIND=dp), intent(in) :: d2I6_dBzdeyy
REAL(KIND=dp), intent(in) :: d2I6_dBzdezz
REAL(KIND=dp), intent(in) :: dexx_depsxx
REAL(KIND=dp), intent(in) :: deyy_depsxx
REAL(KIND=dp), intent(in) :: dezz_depsxx
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBzdepsxx = d2I5_dBzdezz*dezz_depsxx*dphi_dI5 + dphi_dI6*( &
      d2I6_dBzdexx*dexx_depsxx + d2I6_dBzdeyy*deyy_depsxx + &
      d2I6_dBzdezz*dezz_depsxx)

end function

REAL(KIND=dp) function d2phi_dBzdepsxy(d2I6_dBzdexy, dexy_depsxy, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I6_dBzdexy
REAL(KIND=dp), intent(in) :: dexy_depsxy
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBzdepsxy = d2I6_dBzdexy*dexy_depsxy*dphi_dI6

end function

REAL(KIND=dp) function d2phi_dBzdepsyy(d2I5_dBzdezz, d2I6_dBzdexx, d2I6_dBzdeyy, &
      d2I6_dBzdezz, dexx_depsyy, deyy_depsyy, dezz_depsyy, &
      dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I5_dBzdezz
REAL(KIND=dp), intent(in) :: d2I6_dBzdexx
REAL(KIND=dp), intent(in) :: d2I6_dBzdeyy
REAL(KIND=dp), intent(in) :: d2I6_dBzdezz
REAL(KIND=dp), intent(in) :: dexx_depsyy
REAL(KIND=dp), intent(in) :: deyy_depsyy
REAL(KIND=dp), intent(in) :: dezz_depsyy
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBzdepsyy = d2I5_dBzdezz*dezz_depsyy*dphi_dI5 + dphi_dI6*( &
      d2I6_dBzdexx*dexx_depsyy + d2I6_dBzdeyy*deyy_depsyy + &
      d2I6_dBzdezz*dezz_depsyy)

end function

REAL(KIND=dp) function d2phi_dBzdepsyz(d2I5_dBzdeyz, d2I6_dBzdeyz, deyz_depsyz, &
      dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I5_dBzdeyz
REAL(KIND=dp), intent(in) :: d2I6_dBzdeyz
REAL(KIND=dp), intent(in) :: deyz_depsyz
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBzdepsyz = d2I5_dBzdeyz*deyz_depsyz*dphi_dI5 + d2I6_dBzdeyz* &
      deyz_depsyz*dphi_dI6

end function

REAL(KIND=dp) function d2phi_dBzdepszx(d2I5_dBzdezx, d2I6_dBzdezx, dezx_depszx, &
      dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I5_dBzdezx
REAL(KIND=dp), intent(in) :: d2I6_dBzdezx
REAL(KIND=dp), intent(in) :: dezx_depszx
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBzdepszx = d2I5_dBzdezx*dezx_depszx*dphi_dI5 + d2I6_dBzdezx* &
      dezx_depszx*dphi_dI6

end function

REAL(KIND=dp) function d2phi_dBzdepszz(d2I5_dBzdezz, d2I6_dBzdexx, d2I6_dBzdeyy, &
      d2I6_dBzdezz, dexx_depszz, deyy_depszz, dezz_depszz, &
      dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I5_dBzdezz
REAL(KIND=dp), intent(in) :: d2I6_dBzdexx
REAL(KIND=dp), intent(in) :: d2I6_dBzdeyy
REAL(KIND=dp), intent(in) :: d2I6_dBzdezz
REAL(KIND=dp), intent(in) :: dexx_depszz
REAL(KIND=dp), intent(in) :: deyy_depszz
REAL(KIND=dp), intent(in) :: dezz_depszz
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_dBzdepszz = d2I5_dBzdezz*dezz_depszz*dphi_dI5 + dphi_dI6*( &
      d2I6_dBzdexx*dexx_depszz + d2I6_dBzdeyy*deyy_depszz + &
      d2I6_dBzdezz*dezz_depszz)

end function

REAL(KIND=dp) function dphi_dI1(I1, lam)
use types
implicit none
REAL(KIND=dp), intent(in) :: I1
REAL(KIND=dp), intent(in) :: lam

dphi_dI1 = I1*lam

end function

REAL(KIND=dp) function d2phi_dI12(lam)
use types
implicit none
REAL(KIND=dp), intent(in) :: lam

d2phi_dI12 = lam

end function

REAL(KIND=dp) function dphi_dI2(mu)
use types
implicit none
REAL(KIND=dp), intent(in) :: mu

dphi_dI2 = mu

end function

REAL(KIND=dp) function dphi_dI4(I4, alp1, alp10, alp11, alp2, alp3, alp4, alp5, &
      alp6, alp7, alp8, alp9)
use types
implicit none
REAL(KIND=dp), intent(in) :: I4
REAL(KIND=dp), intent(in) :: alp1
REAL(KIND=dp), intent(in) :: alp10
REAL(KIND=dp), intent(in) :: alp11
REAL(KIND=dp), intent(in) :: alp2
REAL(KIND=dp), intent(in) :: alp3
REAL(KIND=dp), intent(in) :: alp4
REAL(KIND=dp), intent(in) :: alp5
REAL(KIND=dp), intent(in) :: alp6
REAL(KIND=dp), intent(in) :: alp7
REAL(KIND=dp), intent(in) :: alp8
REAL(KIND=dp), intent(in) :: alp9

dphi_dI4 = 11*I4**10*alp11 + 10*I4**9*alp10 + 9*I4**8*alp9 + 8*I4**7* &
      alp8 + 7*I4**6*alp7 + 6*I4**5*alp6 + 5*I4**4*alp5 + 4*I4**3*alp4 &
      + 3*I4**2*alp3 + 2*I4*alp2 + alp1

end function

REAL(KIND=dp) function d2phi_dI42(I4, alp10, alp11, alp2, alp3, alp4, alp5, alp6, &
      alp7, alp8, alp9)
use types
implicit none
REAL(KIND=dp), intent(in) :: I4
REAL(KIND=dp), intent(in) :: alp10
REAL(KIND=dp), intent(in) :: alp11
REAL(KIND=dp), intent(in) :: alp2
REAL(KIND=dp), intent(in) :: alp3
REAL(KIND=dp), intent(in) :: alp4
REAL(KIND=dp), intent(in) :: alp5
REAL(KIND=dp), intent(in) :: alp6
REAL(KIND=dp), intent(in) :: alp7
REAL(KIND=dp), intent(in) :: alp8
REAL(KIND=dp), intent(in) :: alp9

d2phi_dI42 = 110*I4**9*alp11 + 90*I4**8*alp10 + 72*I4**7*alp9 + 56*I4**6 &
      *alp8 + 42*I4**5*alp7 + 30*I4**4*alp6 + 20*I4**3*alp5 + 12*I4**2* &
      alp4 + 6*I4*alp3 + 2*alp2

end function

REAL(KIND=dp) function dphi_dI5(bet1)
use types
implicit none
REAL(KIND=dp), intent(in) :: bet1

dphi_dI5 = bet1

end function

REAL(KIND=dp) function dphi_dI6(gam1)
use types
implicit none
REAL(KIND=dp), intent(in) :: gam1

dphi_dI6 = gam1

end function

REAL(KIND=dp) function dphi_depsxx(dI1_depsxx, dI2_depsxx, dI5_dexx, dI5_deyy, &
      dI5_dezz, dI6_dexx, dI6_deyy, dI6_dezz, dexx_depsxx, &
      deyy_depsxx, dezz_depsxx, dphi_dI1, dphi_dI2, dphi_dI5, &
      dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: dI1_depsxx
REAL(KIND=dp), intent(in) :: dI2_depsxx
REAL(KIND=dp), intent(in) :: dI5_dexx
REAL(KIND=dp), intent(in) :: dI5_deyy
REAL(KIND=dp), intent(in) :: dI5_dezz
REAL(KIND=dp), intent(in) :: dI6_dexx
REAL(KIND=dp), intent(in) :: dI6_deyy
REAL(KIND=dp), intent(in) :: dI6_dezz
REAL(KIND=dp), intent(in) :: dexx_depsxx
REAL(KIND=dp), intent(in) :: deyy_depsxx
REAL(KIND=dp), intent(in) :: dezz_depsxx
REAL(KIND=dp), intent(in) :: dphi_dI1
REAL(KIND=dp), intent(in) :: dphi_dI2
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

dphi_depsxx = dI1_depsxx*dphi_dI1 + dI2_depsxx*dphi_dI2 + dphi_dI5*( &
      dI5_dexx*dexx_depsxx + dI5_deyy*deyy_depsxx + dI5_dezz* &
      dezz_depsxx) + dphi_dI6*(dI6_dexx*dexx_depsxx + dI6_deyy* &
      deyy_depsxx + dI6_dezz*dezz_depsxx)

end function

REAL(KIND=dp) function d2phi_depsxx2(d2I2_depsxx2, d2I6_dexx2, d2I6_deyy2, &
      d2I6_dezz2, d2phi_dI12, dI1_depsxx, dexx_depsxx, &
      deyy_depsxx, dezz_depsxx, dphi_dI2, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I2_depsxx2
REAL(KIND=dp), intent(in) :: d2I6_dexx2
REAL(KIND=dp), intent(in) :: d2I6_deyy2
REAL(KIND=dp), intent(in) :: d2I6_dezz2
REAL(KIND=dp), intent(in) :: d2phi_dI12
REAL(KIND=dp), intent(in) :: dI1_depsxx
REAL(KIND=dp), intent(in) :: dexx_depsxx
REAL(KIND=dp), intent(in) :: deyy_depsxx
REAL(KIND=dp), intent(in) :: dezz_depsxx
REAL(KIND=dp), intent(in) :: dphi_dI2
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depsxx2 = d2I2_depsxx2*dphi_dI2 + d2phi_dI12*dI1_depsxx**2 + &
      dphi_dI6*(d2I6_dexx2*dexx_depsxx**2 + d2I6_deyy2*deyy_depsxx**2 + &
      d2I6_dezz2*dezz_depsxx**2)

end function

REAL(KIND=dp) function d2phi_depsxxdepsxy(d2I6_dexxdexy, d2I6_dexydeyy, &
      dexx_depsxx, dexy_depsxy, deyy_depsxx, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I6_dexxdexy
REAL(KIND=dp), intent(in) :: d2I6_dexydeyy
REAL(KIND=dp), intent(in) :: dexx_depsxx
REAL(KIND=dp), intent(in) :: dexy_depsxy
REAL(KIND=dp), intent(in) :: deyy_depsxx
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depsxxdepsxy = dphi_dI6*(d2I6_dexxdexy*dexx_depsxx*dexy_depsxy + &
      d2I6_dexydeyy*dexy_depsxy*deyy_depsxx)

end function

REAL(KIND=dp) function d2phi_depsxxdepsyy(d2I6_dexx2, d2I6_deyy2, d2I6_dezz2, &
      d2phi_dI12, dI1_depsxx, dI1_depsyy, dexx_depsxx, &
      dexx_depsyy, deyy_depsxx, deyy_depsyy, dezz_depsxx, &
      dezz_depsyy, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I6_dexx2
REAL(KIND=dp), intent(in) :: d2I6_deyy2
REAL(KIND=dp), intent(in) :: d2I6_dezz2
REAL(KIND=dp), intent(in) :: d2phi_dI12
REAL(KIND=dp), intent(in) :: dI1_depsxx
REAL(KIND=dp), intent(in) :: dI1_depsyy
REAL(KIND=dp), intent(in) :: dexx_depsxx
REAL(KIND=dp), intent(in) :: dexx_depsyy
REAL(KIND=dp), intent(in) :: deyy_depsxx
REAL(KIND=dp), intent(in) :: deyy_depsyy
REAL(KIND=dp), intent(in) :: dezz_depsxx
REAL(KIND=dp), intent(in) :: dezz_depsyy
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depsxxdepsyy = d2phi_dI12*dI1_depsxx*dI1_depsyy + dphi_dI6*( &
      d2I6_dexx2*dexx_depsxx*dexx_depsyy + d2I6_deyy2*deyy_depsxx* &
      deyy_depsyy + d2I6_dezz2*dezz_depsxx*dezz_depsyy)

end function

REAL(KIND=dp) function d2phi_depsxxdepsyz(d2I6_deyydeyz, d2I6_deyzdezz, &
      deyy_depsxx, deyz_depsyz, dezz_depsxx, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I6_deyydeyz
REAL(KIND=dp), intent(in) :: d2I6_deyzdezz
REAL(KIND=dp), intent(in) :: deyy_depsxx
REAL(KIND=dp), intent(in) :: deyz_depsyz
REAL(KIND=dp), intent(in) :: dezz_depsxx
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depsxxdepsyz = dphi_dI6*(d2I6_deyydeyz*deyy_depsxx*deyz_depsyz + &
      d2I6_deyzdezz*deyz_depsyz*dezz_depsxx)

end function

REAL(KIND=dp) function d2phi_depsxxdepszx(d2I6_dexxdezx, d2I6_dezxdezz, &
      dexx_depsxx, dezx_depszx, dezz_depsxx, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I6_dexxdezx
REAL(KIND=dp), intent(in) :: d2I6_dezxdezz
REAL(KIND=dp), intent(in) :: dexx_depsxx
REAL(KIND=dp), intent(in) :: dezx_depszx
REAL(KIND=dp), intent(in) :: dezz_depsxx
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depsxxdepszx = dphi_dI6*(d2I6_dexxdezx*dexx_depsxx*dezx_depszx + &
      d2I6_dezxdezz*dezx_depszx*dezz_depsxx)

end function

REAL(KIND=dp) function d2phi_depsxxdepszz(d2I6_dexx2, d2I6_deyy2, d2I6_dezz2, &
      d2phi_dI12, dI1_depsxx, dI1_depszz, dexx_depsxx, &
      dexx_depszz, deyy_depsxx, deyy_depszz, dezz_depsxx, &
      dezz_depszz, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I6_dexx2
REAL(KIND=dp), intent(in) :: d2I6_deyy2
REAL(KIND=dp), intent(in) :: d2I6_dezz2
REAL(KIND=dp), intent(in) :: d2phi_dI12
REAL(KIND=dp), intent(in) :: dI1_depsxx
REAL(KIND=dp), intent(in) :: dI1_depszz
REAL(KIND=dp), intent(in) :: dexx_depsxx
REAL(KIND=dp), intent(in) :: dexx_depszz
REAL(KIND=dp), intent(in) :: deyy_depsxx
REAL(KIND=dp), intent(in) :: deyy_depszz
REAL(KIND=dp), intent(in) :: dezz_depsxx
REAL(KIND=dp), intent(in) :: dezz_depszz
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depsxxdepszz = d2phi_dI12*dI1_depsxx*dI1_depszz + dphi_dI6*( &
      d2I6_dexx2*dexx_depsxx*dexx_depszz + d2I6_deyy2*deyy_depsxx* &
      deyy_depszz + d2I6_dezz2*dezz_depsxx*dezz_depszz)

end function

REAL(KIND=dp) function dphi_depsxy(dI2_depsxy, dI5_dexy, dI6_dexy, dexy_depsxy, &
      dphi_dI2, dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: dI2_depsxy
REAL(KIND=dp), intent(in) :: dI5_dexy
REAL(KIND=dp), intent(in) :: dI6_dexy
REAL(KIND=dp), intent(in) :: dexy_depsxy
REAL(KIND=dp), intent(in) :: dphi_dI2
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

dphi_depsxy = dI2_depsxy*dphi_dI2 + dI5_dexy*dexy_depsxy*dphi_dI5 + &
      dI6_dexy*dexy_depsxy*dphi_dI6

end function

REAL(KIND=dp) function d2phi_depsxy2(d2I2_depsxy2, d2I6_dexy2, dexy_depsxy, &
      dphi_dI2, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I2_depsxy2
REAL(KIND=dp), intent(in) :: d2I6_dexy2
REAL(KIND=dp), intent(in) :: dexy_depsxy
REAL(KIND=dp), intent(in) :: dphi_dI2
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depsxy2 = d2I2_depsxy2*dphi_dI2 + d2I6_dexy2*dexy_depsxy**2* &
      dphi_dI6

end function

REAL(KIND=dp) function d2phi_depsxydepsyy(d2I6_dexxdexy, d2I6_dexydeyy, &
      dexx_depsyy, dexy_depsxy, deyy_depsyy, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I6_dexxdexy
REAL(KIND=dp), intent(in) :: d2I6_dexydeyy
REAL(KIND=dp), intent(in) :: dexx_depsyy
REAL(KIND=dp), intent(in) :: dexy_depsxy
REAL(KIND=dp), intent(in) :: deyy_depsyy
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depsxydepsyy = dexy_depsxy*dphi_dI6*(d2I6_dexxdexy*dexx_depsyy + &
      d2I6_dexydeyy*deyy_depsyy)

end function

REAL(KIND=dp) function d2phi_depsxydepsyz(d2I6_dexydeyz, dexy_depsxy, deyz_depsyz, &
      dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I6_dexydeyz
REAL(KIND=dp), intent(in) :: dexy_depsxy
REAL(KIND=dp), intent(in) :: deyz_depsyz
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depsxydepsyz = d2I6_dexydeyz*dexy_depsxy*deyz_depsyz*dphi_dI6

end function

REAL(KIND=dp) function d2phi_depsxydepszx(d2I6_dexydezx, dexy_depsxy, dezx_depszx, &
      dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I6_dexydezx
REAL(KIND=dp), intent(in) :: dexy_depsxy
REAL(KIND=dp), intent(in) :: dezx_depszx
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depsxydepszx = d2I6_dexydezx*dexy_depsxy*dezx_depszx*dphi_dI6

end function

REAL(KIND=dp) function d2phi_depsxydepszz(d2I6_dexxdexy, d2I6_dexydeyy, &
      dexx_depszz, dexy_depsxy, deyy_depszz, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I6_dexxdexy
REAL(KIND=dp), intent(in) :: d2I6_dexydeyy
REAL(KIND=dp), intent(in) :: dexx_depszz
REAL(KIND=dp), intent(in) :: dexy_depsxy
REAL(KIND=dp), intent(in) :: deyy_depszz
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depsxydepszz = dexy_depsxy*dphi_dI6*(d2I6_dexxdexy*dexx_depszz + &
      d2I6_dexydeyy*deyy_depszz)

end function

REAL(KIND=dp) function dphi_depsyy(dI1_depsyy, dI2_depsyy, dI5_dexx, dI5_deyy, &
      dI5_dezz, dI6_dexx, dI6_deyy, dI6_dezz, dexx_depsyy, &
      deyy_depsyy, dezz_depsyy, dphi_dI1, dphi_dI2, dphi_dI5, &
      dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: dI1_depsyy
REAL(KIND=dp), intent(in) :: dI2_depsyy
REAL(KIND=dp), intent(in) :: dI5_dexx
REAL(KIND=dp), intent(in) :: dI5_deyy
REAL(KIND=dp), intent(in) :: dI5_dezz
REAL(KIND=dp), intent(in) :: dI6_dexx
REAL(KIND=dp), intent(in) :: dI6_deyy
REAL(KIND=dp), intent(in) :: dI6_dezz
REAL(KIND=dp), intent(in) :: dexx_depsyy
REAL(KIND=dp), intent(in) :: deyy_depsyy
REAL(KIND=dp), intent(in) :: dezz_depsyy
REAL(KIND=dp), intent(in) :: dphi_dI1
REAL(KIND=dp), intent(in) :: dphi_dI2
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

dphi_depsyy = dI1_depsyy*dphi_dI1 + dI2_depsyy*dphi_dI2 + dphi_dI5*( &
      dI5_dexx*dexx_depsyy + dI5_deyy*deyy_depsyy + dI5_dezz* &
      dezz_depsyy) + dphi_dI6*(dI6_dexx*dexx_depsyy + dI6_deyy* &
      deyy_depsyy + dI6_dezz*dezz_depsyy)

end function

REAL(KIND=dp) function d2phi_depsyy2(d2I2_depsyy2, d2I6_dexx2, d2I6_deyy2, &
      d2I6_dezz2, d2phi_dI12, dI1_depsyy, dexx_depsyy, &
      deyy_depsyy, dezz_depsyy, dphi_dI2, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I2_depsyy2
REAL(KIND=dp), intent(in) :: d2I6_dexx2
REAL(KIND=dp), intent(in) :: d2I6_deyy2
REAL(KIND=dp), intent(in) :: d2I6_dezz2
REAL(KIND=dp), intent(in) :: d2phi_dI12
REAL(KIND=dp), intent(in) :: dI1_depsyy
REAL(KIND=dp), intent(in) :: dexx_depsyy
REAL(KIND=dp), intent(in) :: deyy_depsyy
REAL(KIND=dp), intent(in) :: dezz_depsyy
REAL(KIND=dp), intent(in) :: dphi_dI2
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depsyy2 = d2I2_depsyy2*dphi_dI2 + d2phi_dI12*dI1_depsyy**2 + &
      dphi_dI6*(d2I6_dexx2*dexx_depsyy**2 + d2I6_deyy2*deyy_depsyy**2 + &
      d2I6_dezz2*dezz_depsyy**2)

end function

REAL(KIND=dp) function d2phi_depsyydepsyz(d2I6_deyydeyz, d2I6_deyzdezz, &
      deyy_depsyy, deyz_depsyz, dezz_depsyy, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I6_deyydeyz
REAL(KIND=dp), intent(in) :: d2I6_deyzdezz
REAL(KIND=dp), intent(in) :: deyy_depsyy
REAL(KIND=dp), intent(in) :: deyz_depsyz
REAL(KIND=dp), intent(in) :: dezz_depsyy
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depsyydepsyz = dphi_dI6*(d2I6_deyydeyz*deyy_depsyy*deyz_depsyz + &
      d2I6_deyzdezz*deyz_depsyz*dezz_depsyy)

end function

REAL(KIND=dp) function d2phi_depsyydepszx(d2I6_dexxdezx, d2I6_dezxdezz, &
      dexx_depsyy, dezx_depszx, dezz_depsyy, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I6_dexxdezx
REAL(KIND=dp), intent(in) :: d2I6_dezxdezz
REAL(KIND=dp), intent(in) :: dexx_depsyy
REAL(KIND=dp), intent(in) :: dezx_depszx
REAL(KIND=dp), intent(in) :: dezz_depsyy
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depsyydepszx = dphi_dI6*(d2I6_dexxdezx*dexx_depsyy*dezx_depszx + &
      d2I6_dezxdezz*dezx_depszx*dezz_depsyy)

end function

REAL(KIND=dp) function d2phi_depsyydepszz(d2I6_dexx2, d2I6_deyy2, d2I6_dezz2, &
      d2phi_dI12, dI1_depsyy, dI1_depszz, dexx_depsyy, &
      dexx_depszz, deyy_depsyy, deyy_depszz, dezz_depsyy, &
      dezz_depszz, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I6_dexx2
REAL(KIND=dp), intent(in) :: d2I6_deyy2
REAL(KIND=dp), intent(in) :: d2I6_dezz2
REAL(KIND=dp), intent(in) :: d2phi_dI12
REAL(KIND=dp), intent(in) :: dI1_depsyy
REAL(KIND=dp), intent(in) :: dI1_depszz
REAL(KIND=dp), intent(in) :: dexx_depsyy
REAL(KIND=dp), intent(in) :: dexx_depszz
REAL(KIND=dp), intent(in) :: deyy_depsyy
REAL(KIND=dp), intent(in) :: deyy_depszz
REAL(KIND=dp), intent(in) :: dezz_depsyy
REAL(KIND=dp), intent(in) :: dezz_depszz
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depsyydepszz = d2phi_dI12*dI1_depsyy*dI1_depszz + dphi_dI6*( &
      d2I6_dexx2*dexx_depsyy*dexx_depszz + d2I6_deyy2*deyy_depsyy* &
      deyy_depszz + d2I6_dezz2*dezz_depsyy*dezz_depszz)

end function

REAL(KIND=dp) function dphi_depsyz(dI2_depsyz, dI5_deyz, dI6_deyz, deyz_depsyz, &
      dphi_dI2, dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: dI2_depsyz
REAL(KIND=dp), intent(in) :: dI5_deyz
REAL(KIND=dp), intent(in) :: dI6_deyz
REAL(KIND=dp), intent(in) :: deyz_depsyz
REAL(KIND=dp), intent(in) :: dphi_dI2
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

dphi_depsyz = dI2_depsyz*dphi_dI2 + dI5_deyz*deyz_depsyz*dphi_dI5 + &
      dI6_deyz*deyz_depsyz*dphi_dI6

end function

REAL(KIND=dp) function d2phi_depsyz2(d2I2_depsyz2, d2I6_deyz2, deyz_depsyz, &
      dphi_dI2, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I2_depsyz2
REAL(KIND=dp), intent(in) :: d2I6_deyz2
REAL(KIND=dp), intent(in) :: deyz_depsyz
REAL(KIND=dp), intent(in) :: dphi_dI2
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depsyz2 = d2I2_depsyz2*dphi_dI2 + d2I6_deyz2*deyz_depsyz**2* &
      dphi_dI6

end function

REAL(KIND=dp) function d2phi_depsyzdepszx(d2I6_deyzdezx, deyz_depsyz, dezx_depszx, &
      dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I6_deyzdezx
REAL(KIND=dp), intent(in) :: deyz_depsyz
REAL(KIND=dp), intent(in) :: dezx_depszx
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depsyzdepszx = d2I6_deyzdezx*deyz_depsyz*dezx_depszx*dphi_dI6

end function

REAL(KIND=dp) function d2phi_depsyzdepszz(d2I6_deyydeyz, d2I6_deyzdezz, &
      deyy_depszz, deyz_depsyz, dezz_depszz, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I6_deyydeyz
REAL(KIND=dp), intent(in) :: d2I6_deyzdezz
REAL(KIND=dp), intent(in) :: deyy_depszz
REAL(KIND=dp), intent(in) :: deyz_depsyz
REAL(KIND=dp), intent(in) :: dezz_depszz
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depsyzdepszz = deyz_depsyz*dphi_dI6*(d2I6_deyydeyz*deyy_depszz + &
      d2I6_deyzdezz*dezz_depszz)

end function

REAL(KIND=dp) function dphi_depszx(dI2_depszx, dI5_dezx, dI6_dezx, dezx_depszx, &
      dphi_dI2, dphi_dI5, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: dI2_depszx
REAL(KIND=dp), intent(in) :: dI5_dezx
REAL(KIND=dp), intent(in) :: dI6_dezx
REAL(KIND=dp), intent(in) :: dezx_depszx
REAL(KIND=dp), intent(in) :: dphi_dI2
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

dphi_depszx = dI2_depszx*dphi_dI2 + dI5_dezx*dezx_depszx*dphi_dI5 + &
      dI6_dezx*dezx_depszx*dphi_dI6

end function

REAL(KIND=dp) function d2phi_depszx2(d2I2_depszx2, d2I6_dezx2, dezx_depszx, &
      dphi_dI2, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I2_depszx2
REAL(KIND=dp), intent(in) :: d2I6_dezx2
REAL(KIND=dp), intent(in) :: dezx_depszx
REAL(KIND=dp), intent(in) :: dphi_dI2
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depszx2 = d2I2_depszx2*dphi_dI2 + d2I6_dezx2*dezx_depszx**2* &
      dphi_dI6

end function

REAL(KIND=dp) function d2phi_depszxdepszz(d2I6_dexxdezx, d2I6_dezxdezz, &
      dexx_depszz, dezx_depszx, dezz_depszz, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I6_dexxdezx
REAL(KIND=dp), intent(in) :: d2I6_dezxdezz
REAL(KIND=dp), intent(in) :: dexx_depszz
REAL(KIND=dp), intent(in) :: dezx_depszx
REAL(KIND=dp), intent(in) :: dezz_depszz
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depszxdepszz = dezx_depszx*dphi_dI6*(d2I6_dexxdezx*dexx_depszz + &
      d2I6_dezxdezz*dezz_depszz)

end function

REAL(KIND=dp) function dphi_depszz(dI1_depszz, dI2_depszz, dI5_dexx, dI5_deyy, &
      dI5_dezz, dI6_dexx, dI6_deyy, dI6_dezz, dexx_depszz, &
      deyy_depszz, dezz_depszz, dphi_dI1, dphi_dI2, dphi_dI5, &
      dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: dI1_depszz
REAL(KIND=dp), intent(in) :: dI2_depszz
REAL(KIND=dp), intent(in) :: dI5_dexx
REAL(KIND=dp), intent(in) :: dI5_deyy
REAL(KIND=dp), intent(in) :: dI5_dezz
REAL(KIND=dp), intent(in) :: dI6_dexx
REAL(KIND=dp), intent(in) :: dI6_deyy
REAL(KIND=dp), intent(in) :: dI6_dezz
REAL(KIND=dp), intent(in) :: dexx_depszz
REAL(KIND=dp), intent(in) :: deyy_depszz
REAL(KIND=dp), intent(in) :: dezz_depszz
REAL(KIND=dp), intent(in) :: dphi_dI1
REAL(KIND=dp), intent(in) :: dphi_dI2
REAL(KIND=dp), intent(in) :: dphi_dI5
REAL(KIND=dp), intent(in) :: dphi_dI6

dphi_depszz = dI1_depszz*dphi_dI1 + dI2_depszz*dphi_dI2 + dphi_dI5*( &
      dI5_dexx*dexx_depszz + dI5_deyy*deyy_depszz + dI5_dezz* &
      dezz_depszz) + dphi_dI6*(dI6_dexx*dexx_depszz + dI6_deyy* &
      deyy_depszz + dI6_dezz*dezz_depszz)

end function

REAL(KIND=dp) function d2phi_depszz2(d2I2_depszz2, d2I6_dexx2, d2I6_deyy2, &
      d2I6_dezz2, d2phi_dI12, dI1_depszz, dexx_depszz, &
      deyy_depszz, dezz_depszz, dphi_dI2, dphi_dI6)
use types
implicit none
REAL(KIND=dp), intent(in) :: d2I2_depszz2
REAL(KIND=dp), intent(in) :: d2I6_dexx2
REAL(KIND=dp), intent(in) :: d2I6_deyy2
REAL(KIND=dp), intent(in) :: d2I6_dezz2
REAL(KIND=dp), intent(in) :: d2phi_dI12
REAL(KIND=dp), intent(in) :: dI1_depszz
REAL(KIND=dp), intent(in) :: dexx_depszz
REAL(KIND=dp), intent(in) :: deyy_depszz
REAL(KIND=dp), intent(in) :: dezz_depszz
REAL(KIND=dp), intent(in) :: dphi_dI2
REAL(KIND=dp), intent(in) :: dphi_dI6

d2phi_depszz2 = d2I2_depszz2*dphi_dI2 + d2phi_dI12*dI1_depszz**2 + &
      dphi_dI6*(d2I6_dexx2*dexx_depszz**2 + d2I6_deyy2*deyy_depszz**2 + &
      d2I6_dezz2*dezz_depszz**2)

end function

REAL(KIND=dp) function exx(epsxx, epsyy, epszz)
use types
implicit none
REAL(KIND=dp), intent(in) :: epsxx
REAL(KIND=dp), intent(in) :: epsyy
REAL(KIND=dp), intent(in) :: epszz

exx = (2.0e0_dp/3.0e0_dp)*epsxx - 1.0e0_dp/3.0e0_dp*epsyy - 1.0e0_dp/3.0e0_dp*epszz

end function

REAL(KIND=dp) function exy(epsxy)
use types
implicit none
REAL(KIND=dp), intent(in) :: epsxy

exy = epsxy

end function

REAL(KIND=dp) function eyy(epsxx, epsyy, epszz)
use types
implicit none
REAL(KIND=dp), intent(in) :: epsxx
REAL(KIND=dp), intent(in) :: epsyy
REAL(KIND=dp), intent(in) :: epszz

eyy = -1.0e0_dp/3.0e0_dp*epsxx + (2.0e0_dp/3.0e0_dp)*epsyy - 1.0e0_dp/3.0e0_dp*epszz

end function

REAL(KIND=dp) function eyz(epsyz)
use types
implicit none
REAL(KIND=dp), intent(in) :: epsyz

eyz = epsyz

end function

REAL(KIND=dp) function ezx(epszx)
use types
implicit none
REAL(KIND=dp), intent(in) :: epszx

ezx = epszx

end function

REAL(KIND=dp) function ezz(epsxx, epsyy, epszz)
use types
implicit none
REAL(KIND=dp), intent(in) :: epsxx
REAL(KIND=dp), intent(in) :: epsyy
REAL(KIND=dp), intent(in) :: epszz

ezz = -1.0e0_dp/3.0e0_dp*epsxx - 1.0e0_dp/3.0e0_dp*epsyy + (2.0e0_dp/3.0e0_dp)*epszz

end function

REAL(KIND=dp) function I1(epsxx, epsyy, epszz)
use types
implicit none
REAL(KIND=dp), intent(in) :: epsxx
REAL(KIND=dp), intent(in) :: epsyy
REAL(KIND=dp), intent(in) :: epszz

I1 = epsxx + epsyy + epszz

end function

REAL(KIND=dp) function I2(epsxx, epsxy, epsyy, epsyz, epszx, epszz)
use types
implicit none
REAL(KIND=dp), intent(in) :: epsxx
REAL(KIND=dp), intent(in) :: epsxy
REAL(KIND=dp), intent(in) :: epsyy
REAL(KIND=dp), intent(in) :: epsyz
REAL(KIND=dp), intent(in) :: epszx
REAL(KIND=dp), intent(in) :: epszz

I2 = epsxx**2 + 2*epsxy**2 + epsyy**2 + 2*epsyz**2 + 2*epszx**2 + epszz &
      **2

end function

REAL(KIND=dp) function I4(Bx, By, Bz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz

I4 = Bx**2 + By**2 + Bz**2

end function

REAL(KIND=dp) function I5(Bx, By, Bz, exx, exy, eyy, eyz, ezx, ezz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exx
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyy
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezx
REAL(KIND=dp), intent(in) :: ezz

I5 = Bx**2*exx + 2*Bx*(By*exy + Bz*ezx) + By**2*eyy + 2*By*Bz*eyz + Bz** &
      2*ezz

end function

REAL(KIND=dp) function I6(Bx, By, Bz, exx, exy, eyy, eyz, ezx, ezz)
use types
implicit none
REAL(KIND=dp), intent(in) :: Bx
REAL(KIND=dp), intent(in) :: By
REAL(KIND=dp), intent(in) :: Bz
REAL(KIND=dp), intent(in) :: exx
REAL(KIND=dp), intent(in) :: exy
REAL(KIND=dp), intent(in) :: eyy
REAL(KIND=dp), intent(in) :: eyz
REAL(KIND=dp), intent(in) :: ezx
REAL(KIND=dp), intent(in) :: ezz

I6 = Bx**2*(exx**2 + exy**2 + ezx**2) + 2*Bx*(By*(exx*exy + exy*eyy + &
      eyz*ezx) + Bz*(exx*ezx + exy*eyz + ezx*ezz)) + By**2*(exy**2 + &
      eyy**2 + eyz**2) + 2*By*Bz*(exy*ezx + eyy*eyz + eyz*ezz) + Bz**2* &
      (eyz**2 + ezx**2 + ezz**2)

end function

REAL(KIND=dp) function mu()
use types
implicit none

mu = 26785714285.7143e0_dp

end function

REAL(KIND=dp) function alp1()
use types
implicit none

alp1 = 9246.91810913343e0_dp

end function

REAL(KIND=dp) function alp10()
use types
implicit none

alp10 = -401.109688285048e0_dp

end function

REAL(KIND=dp) function alp11()
use types
implicit none

alp11 = 25.0566742147221e0_dp

end function

REAL(KIND=dp) function alp2()
use types
implicit none

alp2 = -10340.7223921532e0_dp

end function

REAL(KIND=dp) function alp3()
use types
implicit none

alp3 = 18840.6348392641e0_dp

end function

REAL(KIND=dp) function alp4()
use types
implicit none

alp4 = -32235.9981598122e0_dp

end function

REAL(KIND=dp) function alp5()
use types
implicit none

alp5 = 43656.3918760386e0_dp

end function

REAL(KIND=dp) function alp6()
use types
implicit none

alp6 = -41419.4903715411e0_dp

end function

REAL(KIND=dp) function alp7()
use types
implicit none

alp7 = 26241.069129634e0_dp

end function

REAL(KIND=dp) function alp8()
use types
implicit none

alp8 = -10805.5861288096e0_dp

end function

REAL(KIND=dp) function alp9()
use types
implicit none

alp9 = 2769.92820860071e0_dp

end function

REAL(KIND=dp) function bet1()
use types
implicit none

bet1 = 485724572.934798e0_dp

end function

REAL(KIND=dp) function gam1()
use types
implicit none

gam1 = 1.1528881683185e+15_dp

end function

REAL(KIND=dp) function epsM(epsxx, epsyy, epszz)
use types
implicit none
REAL(KIND=dp), intent(in) :: epsxx
REAL(KIND=dp), intent(in) :: epsyy
REAL(KIND=dp), intent(in) :: epszz

epsM = (1.0e0_dp/3.0e0_dp)*epsxx + (1.0e0_dp/3.0e0_dp)*epsyy + (1.0e0_dp/3.0e0_dp)*epszz

end function

REAL(KIND=dp) function lam()
use types
implicit none

lam = 107142857142.857e0_dp

end function

REAL(KIND=dp) function phi(I1, I2, I4, I5, I6, alp1, alp10, alp11, alp2, alp3, &
      alp4, alp5, alp6, alp7, alp8, alp9, bet1, gam1, lam, mu)
use types
implicit none
REAL(KIND=dp), intent(in) :: I1
REAL(KIND=dp), intent(in) :: I2
REAL(KIND=dp), intent(in) :: I4
REAL(KIND=dp), intent(in) :: I5
REAL(KIND=dp), intent(in) :: I6
REAL(KIND=dp), intent(in) :: alp1
REAL(KIND=dp), intent(in) :: alp10
REAL(KIND=dp), intent(in) :: alp11
REAL(KIND=dp), intent(in) :: alp2
REAL(KIND=dp), intent(in) :: alp3
REAL(KIND=dp), intent(in) :: alp4
REAL(KIND=dp), intent(in) :: alp5
REAL(KIND=dp), intent(in) :: alp6
REAL(KIND=dp), intent(in) :: alp7
REAL(KIND=dp), intent(in) :: alp8
REAL(KIND=dp), intent(in) :: alp9
REAL(KIND=dp), intent(in) :: bet1
REAL(KIND=dp), intent(in) :: gam1
REAL(KIND=dp), intent(in) :: lam
REAL(KIND=dp), intent(in) :: mu

phi = (1.0e0_dp/2.0e0_dp)*I1**2*lam + I2*mu + I4**11*alp11 + I4**10*alp10 + I4 &
      **9*alp9 + I4**8*alp8 + I4**7*alp7 + I4**6*alp6 + I4**5*alp5 + I4 &
      **4*alp4 + I4**3*alp3 + I4**2*alp2 + I4*alp1 + I5*bet1 + I6*gam1

end function


! inprod_analytic.f90
!
!>  Inner products between the truncated set of basis functions for the
!>  ocean and atmosphere streamfunction fields.
!>  These are partly calculated using the analytical expressions from
!>  Cehelsky, P., & Tung, K. K. : Theories of multiple equilibria and
!>  weather regimes-A critical reexamination. Part II: Baroclinic two-layer
!>  models. Journal of the atmospheric sciences, 44(21), 3282-3303, 1987.
!
!> @copyright
!> 2015 Lesley De Cruz & Jonathan Demaeyer.
!> See LICENSE.txt for license information.
!
!---------------------------------------------------------------------------!
!
!> @remark
!> Generated Fortran90/95 code
!> from inprod_analytic.lua
!
!---------------------------------------------------------------------------!

MODULE inprod_analytic

  !-----------------------------------------------------!
  !                                                     !
  ! Preamble and variables declaration                  !
  !                                                     !
  !-----------------------------------------------------!

  USE params, only: nbatm, nboc, natm, noc, n, oms, ams, pi
  IMPLICIT NONE

  PRIVATE

  PUBLIC :: init_inprod, deallocate_inprod

  !> Atmospheric bloc specification type
  TYPE :: atm_wavenum
     CHARACTER :: typ
     INTEGER :: M=0,P=0,H=0
     REAL(KIND=8) :: Nx=0.,Ny=0.
  END TYPE atm_wavenum

  !> Oceanic bloc specification type
  TYPE :: ocean_wavenum
     INTEGER :: P,H
     REAL(KIND=8) :: Nx,Ny
  END TYPE ocean_wavenum

  !> Type holding the atmospheric inner products tensors
  TYPE :: atm_tensors
     REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: a,c,d,s
     REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: b,g
  END TYPE atm_tensors

  !> Type holding the oceanic inner products tensors
  TYPE :: ocean_tensors
     REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: K,M,N,W
     REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: O,C
  END TYPE ocean_tensors

  !> Atmospheric blocs specification
  TYPE(atm_wavenum), DIMENSION(:), ALLOCATABLE, PUBLIC :: awavenum
  !> Oceanic blocs specification
  TYPE(ocean_wavenum), DIMENSION(:), ALLOCATABLE, PUBLIC :: owavenum

  !> Atmospheric tensors
  TYPE(atm_tensors), PUBLIC :: atmos
  !> Oceanic tensors
  TYPE(ocean_tensors), PUBLIC :: ocean

  !-----------------------------------------------------!
  !                                                     !
  ! End of preamble                                     !
  !                                                     !
  !-----------------------------------------------------!

CONTAINS

  !-----------------------------------------------------!
  !                                                     !
  ! Definition of the Helper functions from Cehelsky    !
  ! & Tung                                              !
  !                                                     !
  !-----------------------------------------------------!

  !>  Cehelsky & Tung Helper functions
  REAL(KIND=8) FUNCTION B1(Pi, Pj, Pk)
    INTEGER :: Pi,Pj,Pk
    B1 = (Pk + Pj) / REAL(Pi)
  END FUNCTION B1

  !>  Cehelsky & Tung Helper functions
  REAL(KIND=8) FUNCTION B2(Pi, Pj, Pk)
    INTEGER :: Pi,Pj,Pk
    B2 = (Pk - Pj) / REAL(Pi)
  END FUNCTION B2

  !>  Integer Dirac delta function
  REAL(KIND=8) FUNCTION delta(r)
    INTEGER :: r
    IF (r==0) THEN
       delta = 1.D0
    ELSE
       delta = 0.D0
    ENDIF
  END FUNCTION delta

  !>  "Odd or even" function
  REAL(KIND=8) FUNCTION flambda(r)
    INTEGER :: r
    IF (mod(r,2)==0) THEN
       flambda = 0.D0
    ELSE
       flambda = 1.D0
    ENDIF
  END FUNCTION flambda

  !>  Cehelsky & Tung Helper functions
  REAL(KIND=8) FUNCTION S1(Pj, Pk, Mj, Hk)
    INTEGER :: Pk,Pj,Mj,Hk
    S1 = -((Pk * Mj + Pj * Hk)) / 2.D0
  END FUNCTION S1

  !>  Cehelsky & Tung Helper functions
  REAL(KIND=8) FUNCTION S2(Pj, Pk, Mj, Hk)
    INTEGER :: Pk,Pj,Mj,Hk
    S2 = (Pk * Mj - Pj * Hk) / 2.D0
  END FUNCTION S2

  !>  Cehelsky & Tung Helper functions
  REAL(KIND=8) FUNCTION S3(Pj, Pk, Hj, Hk)
    INTEGER :: Pj,Pk,Hj,Hk
    S3 = (Pk * Hj + Pj * Hk) / 2.D0
  END FUNCTION S3

  !>  Cehelsky & Tung Helper functions
  REAL(KIND=8) FUNCTION S4(Pj, Pk, Hj, Hk)
    INTEGER :: Pj,Pk,Hj,Hk
    S4 = (Pk * Hj - Pj * Hk) / 2.D0
  END FUNCTION S4

  !-----------------------------------------------------!
  ! Inner products definition routines                  !
  !--------------------------------------------------------!
  ! 1. Inner products in the equations for the atmosphere  !
  !--------------------------------------------------------!

  !> Eigenvalues of the Laplacian (atmospheric)
  !>
  !> \f$ a_{i,j} = (F_i, \nabla^2 F_j)\f$ .
  SUBROUTINE calculate_a
    INTEGER :: i
    TYPE(atm_wavenum) :: Ti
    INTEGER :: AllocStat
    IF (natm == 0 ) THEN
       STOP "*** Problem with calculate_a : natm==0 ! ***"
    ELSE
       IF (.NOT. ALLOCATED(atmos%a)) THEN
          ALLOCATE(atmos%a(natm,natm), STAT=AllocStat)
          IF (AllocStat /= 0) STOP "*** Not enough memory ! ***"
       END IF
    END IF
    atmos%a=0.D0

    DO i=1,natm
       Ti = awavenum(i)
       atmos%a(i,i) = -(n**2) * Ti%Nx**2 - Ti%Ny**2
    ENDDO
  END SUBROUTINE calculate_a

  !> Streamfunction advection terms (atmospheric)
  !>
  !> \f$ b_{i,j,k} = (F_i, J(F_j, \nabla^2 F_k))\f$ .
  !
  !> @remark
  !> Atmospheric g and a tensors must be computed before calling
  !> this routine
  SUBROUTINE calculate_b
    INTEGER :: i,j,k
    INTEGER :: AllocStat

    IF ((.NOT. ALLOCATED(atmos%a)) .OR. (.NOT. ALLOCATED(atmos%g))) THEN
       STOP "*** atmos%a and atmos%g must be defined before calling calculate_b ! ***"
    END IF

    IF (natm == 0 ) THEN
       STOP "*** Problem with calculate_b : natm==0 ! ***"
    ELSE
       IF (.NOT. ALLOCATED(atmos%b)) THEN
          ALLOCATE(atmos%b(natm,natm,natm), STAT=AllocStat)
          IF (AllocStat /= 0) STOP "*** Not enough memory ! ***"
       END IF
    END IF
    atmos%b=0.D0

    DO i=1,natm
       DO j=1,natm
          DO k=1,natm
             atmos%b(i,j,k)= atmos%a(k,k) * atmos%g(i,j,k)
          END DO
       END DO
    END DO
  END SUBROUTINE calculate_b

  !> Beta term for the atmosphere
  !>
  !> \f$ c_{i,j} = (F_i, \partial_x F_j)\f$ .
  !
  !> @remark
  !> Strict function !! Only accepts KL type.
  !> For any other combination, it will not calculate anything
  SUBROUTINE calculate_c_atm
    INTEGER :: i,j
    TYPE(atm_wavenum) :: Ti, Tj
    REAL(KIND=8) :: val
    INTEGER :: AllocStat

    IF (natm == 0 ) THEN
       STOP "*** Problem with calculate_c_atm : natm==0 ! ***"
    ELSE
       IF (.NOT. ALLOCATED(atmos%c)) THEN
          ALLOCATE(atmos%c(natm,natm), STAT=AllocStat)
          IF (AllocStat /= 0) STOP "*** Not enough memory ! ***"
       END IF
    END IF
    atmos%c=0.D0

    DO i=1,natm
       DO j=1,natm
          Ti = awavenum(i)
          Tj = awavenum(j)
          val = 0.D0
          IF ((Ti%typ == "K") .AND. (Tj%typ == "L")) THEN
             val = n * Ti%M * delta(Ti%M - Tj%H) * delta(Ti%P - Tj%P)
          END IF
          IF (val /= 0.D0) THEN
             atmos%c(i,j)=val
             atmos%c(j,i)= - val
          ENDIF
       END DO
    END DO
  END SUBROUTINE calculate_c_atm

  !> Forcing of the ocean on the atmosphere.
  !>
  !> \f$ d_{i,j} = (F_i, \nabla^2 \eta_j)\f$ .
  !
  !> @remark
  !> Atmospheric s tensor and oceanic M tensor must be computed before
  !> calling this routine !
  SUBROUTINE calculate_d
    INTEGER :: i,j
    INTEGER :: AllocStat

    IF ((.NOT. ALLOCATED(atmos%s)) .OR. (.NOT. ALLOCATED(ocean%M))) THEN
       STOP "*** atmos%s and ocean%M must be defined before calling calculate_d ! ***"
    END IF

    IF (natm == 0 ) THEN
       STOP "*** Problem with calculate_d : natm==0 ! ***"
    ELSE
       IF (.NOT. ALLOCATED(atmos%d)) THEN
          ALLOCATE(atmos%d(natm,noc), STAT=AllocStat)
          IF (AllocStat /= 0) STOP "*** Not enough memory ! ***"
       END IF
    END IF
    atmos%d=0.D0

    DO i=1,natm
       DO j=1,noc
          atmos%d(i,j)=atmos%s(i,j) * ocean%M(j,j)
       END DO
    END DO
  END SUBROUTINE calculate_d

  !> Temperature advection terms (atmospheric)
  !>
  !> \f$ g_{i,j,k} = (F_i, J(F_j, F_k))\f$ .
  !
  ! @remark
  ! This is a strict function: it only accepts AKL KKL and LLL types.
  ! For any other combination, it will not calculate anything.
  SUBROUTINE calculate_g
    INTEGER :: i,j,k
    TYPE(atm_wavenum) :: Ti, Tj, Tk
    REAL(KIND=8) :: val,vb1, vb2, vs1, vs2, vs3, vs4
    INTEGER :: AllocStat

    IF (natm == 0 ) THEN
       STOP "*** Problem with calculate_g : natm==0 ! ***"
    ELSE
       IF (.NOT. ALLOCATED(atmos%g)) THEN
          ALLOCATE(atmos%g(natm,natm,natm), STAT=AllocStat)
          IF (AllocStat /= 0) STOP "*** Not enough memory ! ***"
       END IF
    END IF
    atmos%g=0.D0

    DO i=1,natm
       DO j=1,natm
          DO k=1,natm
             Ti = awavenum(i)
             Tj = awavenum(j)
             Tk = awavenum(k)
             val=0.D0
             IF ((Ti%typ == "A") .AND. (Tj%typ == "K") .AND. (Tk%typ == "L")) THEN
                vb1 = B1(Ti%P,Tj%P,Tk%P)
                vb2 = B2(Ti%P,Tj%P,Tk%P)
                val = -2 * sqrt(2.) / pi * Tj%M * delta(Tj%M - Tk%H) * flambda(Ti%P + Tj%P + Tk%P)
                IF (val /= 0.D0) val = val * (vb1**2 / (vb1**2 - 1) - vb2**2 / (vb2**2 - 1))
             ELSEIF ((Ti%typ == "K") .AND. (Tj%typ == "K") .AND. (Tk%typ == "L")) THEN
                vs1 = S1(Tj%P,Tk%P,Tj%M,Tk%H)
                vs2 = S2(Tj%P,Tk%P,Tj%M,Tk%H)
                val = vs1 * (delta(Ti%M - Tk%H - Tj%M) * delta(Ti%P -&
                     & Tk%P + Tj%P) - delta(Ti%M- Tk%H - Tj%M) *&
                     & delta(Ti%P + Tk%P - Tj%P) + (delta(Tk%H - Tj%M&
                     & + Ti%M) + delta(Tk%H - Tj%M - Ti%M)) *&
                     & delta(Tk%P + Tj%P - Ti%P)) + vs2 * (delta(Ti%M&
                     & - Tk%H - Tj%M) * delta(Ti%P - Tk%P - Tj%P) +&
                     & (delta(Tk%H - Tj%M - Ti%M) + delta(Ti%M + Tk%H&
                     & - Tj%M)) * (delta(Ti%P - Tk%P + Tj%P) -&
                     & delta(Tk%P - Tj%P + Ti%P)))
             END IF
             val=val*n
             IF (val /= 0.D0) THEN
                atmos%g(i,j,k) = val
                atmos%g(j,k,i) = val
                atmos%g(k,i,j) = val
                atmos%g(i,k,j) = -val
                atmos%g(j,i,k) = -val
                atmos%g(k,j,i) = -val
             ENDIF
          END DO
       END DO
    END DO

    DO i=1,natm
       DO j=i,natm
          DO k=j,natm
             Ti = awavenum(i)
             Tj = awavenum(j)
             Tk = awavenum(k)
             val=0.D0

             IF ((Ti%typ == "L") .AND. (Tj%typ == "L") .AND. (Tk%typ == "L")) THEN
                vs3 = S3(Tj%P,Tk%P,Tj%H,Tk%H)
                vs4 = S4(Tj%P,Tk%P,Tj%H,Tk%H)
                val = vs3 * ((delta(Tk%H - Tj%H - Ti%H) - delta(Tk%H &
                     &- Tj%H + Ti%H)) * delta(Tk%P + Tj%P - Ti%P) +&
                     & delta(Tk%H + Tj%H - Ti%H) * (delta(Tk%P - Tj%P&
                     & + Ti%P) - delta(Tk%P - Tj%P - Ti%P))) + vs4 *&
                     & ((delta(Tk%H + Tj%H - Ti%H) * delta(Tk%P - Tj&
                     &%P - Ti%P)) + (delta(Tk%H - Tj%H + Ti%H) -&
                     & delta(Tk%H - Tj%H - Ti%H)) * (delta(Tk%P - Tj&
                     &%P - Ti%P) - delta(Tk%P - Tj%P + Ti%P)))
             ENDIF
             val=val*n
             IF (val /= 0.D0) THEN
                atmos%g(i,j,k) = val
                atmos%g(j,k,i) = val
                atmos%g(k,i,j) = val
                atmos%g(i,k,j) = -val
                atmos%g(j,i,k) = -val
                atmos%g(k,j,i) = -val
             ENDIF
          ENDDO
       ENDDO
    ENDDO

  END SUBROUTINE calculate_g

  !> Forcing (thermal) of the ocean on the atmosphere.
  !>
  !> \f$ s_{i,j} = (F_i, \eta_j)\f$ .
  SUBROUTINE calculate_s
    INTEGER :: i,j
    TYPE(atm_wavenum) :: Ti
    TYPE(ocean_wavenum) :: Dj
    REAL(KIND=8) :: val
    INTEGER :: AllocStat
    IF (natm == 0 ) THEN
       STOP "*** Problem with calculate_s : natm==0 ! ***"
    ELSEIF (noc == 0) then
       STOP "*** Problem with calculate_s : noc==0 ! ***"
    ELSE
       IF (.NOT. ALLOCATED(atmos%s)) THEN
          ALLOCATE(atmos%s(natm,noc), STAT=AllocStat)
          IF (AllocStat /= 0) STOP "*** Not enough memory ! ***"
       END IF
    END IF
    atmos%s=0.D0

    DO i=1,natm
       DO j=1,noc
          Ti = awavenum(i)
          Dj = owavenum(j)
          val=0.D0
          IF (Ti%typ == "A") THEN
             val = flambda(Dj%H) * flambda(Dj%P + Ti%P)
             IF (val /= 0.D0) THEN
                val = val*8*sqrt(2.)*Dj%P/(pi**2 * (Dj%P**2 - Ti%P**2) * Dj%H)
             END IF
          ELSEIF (Ti%typ == "K") THEN
             val = flambda(2 * Ti%M + Dj%H) * delta(Dj%P - Ti%P)
             IF (val /= 0.D0) THEN
                val = val*4*Dj%H/(pi * (-4 * Ti%M**2 + Dj%H**2))
             END IF
          ELSEIF (Ti%typ == "L") THEN
             val = delta(Dj%P - Ti%P) * delta(2 * Ti%H - Dj%H)
          END IF
          IF (val /= 0.D0) THEN
             atmos%s(i,j)=val
          ENDIF
       END DO
    END DO
  END SUBROUTINE calculate_s

  !--------------------------------------------------------!
  ! 2. Inner products in the equations for the ocean       !
  !--------------------------------------------------------!

  !> Forcing of the atmosphere on the ocean.
  !>
  !> \f$ K_{i,j} = (\eta_i, \nabla^2 F_j)\f$ .
  !
  !> @remark
  !> atmospheric a and s tensors must be computed before calling
  !> this function !
  SUBROUTINE calculate_K
    INTEGER :: i,j
    INTEGER :: AllocStat

    IF ((.NOT. ALLOCATED(atmos%a)) .OR. (.NOT. ALLOCATED(atmos%s))) THEN
       STOP "*** atmos%a and atmos%s must be defined before calling calculate_K ! ***"
    END IF

    IF (noc == 0 ) THEN
       STOP "*** Problem with calculate_K : noc==0 ! ***"
    ELSEIF (natm == 0 ) THEN
       STOP "*** Problem with calculate_K : natm==0 ! ***"
    ELSE
       IF (.NOT. ALLOCATED(ocean%K)) THEN
          ALLOCATE(ocean%K(noc,natm), STAT=AllocStat)
          IF (AllocStat /= 0) STOP "*** Not enough memory ! ***"
       END IF
    END IF
    ocean%K=0.D0

    DO i=1,noc
       DO j=1,natm
          ocean%K(i,j) = atmos%s(j,i) * atmos%a(j,j)
       END DO
    END DO
  END SUBROUTINE calculate_K

  !> Forcing of the ocean fields on the ocean.
  !>
  !> \f$ M_{i,j} = (eta_i, \nabla^2 \eta_j)\f$ .
  SUBROUTINE calculate_M
    INTEGER :: i
    TYPE(ocean_wavenum) :: Di
    INTEGER :: AllocStat
    IF (noc == 0 ) THEN
       STOP "*** Problem with calculate_M : noc==0 ! ***"
    ELSE
       IF (.NOT. ALLOCATED(ocean%M)) THEN
          ALLOCATE(ocean%M(noc,noc), STAT=AllocStat)
          IF (AllocStat /= 0) STOP "*** Not enough memory ! ***"
       END IF
    END IF
    ocean%M=0.D0

    DO i=1,noc
       Di = owavenum(i)
       ocean%M(i,i) = -(n**2) * Di%Nx**2 - Di%Ny**2
    END DO
  END SUBROUTINE calculate_M

  !> Beta term for the ocean
  !>
  !> \f$ N_{i,j} = (\eta_i, \partial_x \eta_j) \f$.
  SUBROUTINE calculate_N
    INTEGER :: i,j
    TYPE(ocean_wavenum) :: Di,Dj
    REAL(KIND=8) :: val
    INTEGER :: AllocStat
    IF (noc == 0 ) THEN
       STOP "*** Problem with calculate_N : noc==0 ! ***"
    ELSE
       IF (.NOT. ALLOCATED(ocean%N)) THEN
          ALLOCATE(ocean%N(noc,noc), STAT=AllocStat)
          IF (AllocStat /= 0) STOP "*** Not enough memory ! ***"
       END IF
    END IF
    ocean%N=0.D0
    val=0.D0

    DO i=1,noc
       DO j=1,noc
          Di = owavenum(i)
          Dj = owavenum(j)
          val = delta(Di%P - Dj%P) * flambda(Di%H + Dj%H)
          IF (val /= 0.D0) ocean%N(i,j) = val * (-2) * Dj%H * Di%H * n / ((Dj%H**2 - Di%H**2) * pi)
       END DO
    END DO
  END SUBROUTINE calculate_N

  !> Temperature advection term (passive scalar)
  !>
  !> \f$ O_{i,j,k} = (\eta_i, J(\eta_j, \eta_k))\f$ .
  SUBROUTINE calculate_O
    INTEGER :: i,j,k
    REAL(KIND=8) :: vs3,vs4,val
    TYPE(ocean_wavenum) :: Di,Dj,Dk
    INTEGER :: AllocStat
    IF (noc == 0 ) THEN
       STOP "*** Problem with calculate_O : noc==0 ! ***"
    ELSE
       IF (.NOT. ALLOCATED(ocean%O)) THEN
          ALLOCATE(ocean%O(noc,noc,noc), STAT=AllocStat)
          IF (AllocStat /= 0) STOP "*** Not enough memory ! ***"
       END IF
    END IF
    ocean%O=0.D0
    val=0.D0

    DO i=1,noc
       DO j=i,noc
          DO k=j,noc
             Di = owavenum(i)
             Dj = owavenum(j)
             Dk = owavenum(k)
             vs3 = S3(Dj%P,Dk%P,Dj%H,Dk%H)
             vs4 = S4(Dj%P,Dk%P,Dj%H,Dk%H)
             val = vs3*((delta(Dk%H - Dj%H - Di%H) - delta(Dk%H - Dj&
                  &%H + Di%H)) * delta(Dk%P + Dj%P - Di%P) + delta(Dk&
                  &%H + Dj%H - Di%H) * (delta(Dk%P - Dj%P + Di%P) -&
                  & delta(Dk%P - Dj%P - Di%P))) + vs4 * ((delta(Dk%H &
                  &+ Dj%H - Di%H) * delta(Dk%P - Dj%P - Di%P)) +&
                  & (delta(Dk%H - Dj%H + Di%H) - delta(Dk%H - Dj%H -&
                  & Di%H)) * (delta(Dk%P - Dj%P - Di%P) - delta(Dk%P &
                  &- Dj%P + Di%P)))
             val = val * n / 2
             IF (val /= 0.D0) THEN
                ocean%O(i,j,k) = val
                ocean%O(j,k,i) = val
                ocean%O(k,i,j) = val
                ocean%O(i,k,j) = -val
                ocean%O(j,i,k) = -val
                ocean%O(k,j,i) = -val
             END IF
          END DO
       END DO
    END DO
  END SUBROUTINE calculate_O

  !> Streamfunction advection terms (oceanic)
  !>
  !> \f$ C_{i,j,k} = (\eta_i, J(\eta_j,\nabla^2 \eta_k))\f$ .
  !
  !> @remark
  !> Requires O_{i,j,k} and M_{i,j} to be calculated beforehand.
  SUBROUTINE calculate_C_oc
    INTEGER :: i,j,k
    REAL(KIND=8) :: val
    INTEGER :: AllocStat

    IF ((.NOT. ALLOCATED(ocean%O)) .OR. (.NOT. ALLOCATED(ocean%M))) THEN
       STOP "*** ocean%O and ocean%M must be defined before calling calculate_C ! ***"
    END IF

    IF (noc == 0 ) THEN
       STOP "*** Problem with calculate_C : noc==0 ! ***"
    ELSE
       IF (.NOT. ALLOCATED(ocean%C)) THEN
          ALLOCATE(ocean%C(noc,noc,noc), STAT=AllocStat)
          IF (AllocStat /= 0) STOP "*** Not enough memory ! ***"
       END IF
    END IF
    ocean%C=0.D0
    val=0.D0

    DO i=1,noc
       DO j=1,noc
          DO k=1,noc
             val = ocean%M(k,k) * ocean%O(i,j,k)
             IF (val /= 0.D0) ocean%C(i,j,k) = val
          END DO
       END DO
    END DO
  END SUBROUTINE calculate_C_oc

  !> Short-wave radiative forcing of the ocean
  !>
  !> \f$ W_{i,j} = (\eta_i, F_j)\f$ .
  !
  !> @remark
  !> atmospheric s tensor must be computed before calling
  !> this function !
  SUBROUTINE calculate_W
    INTEGER :: i,j
    INTEGER :: AllocStat

    IF (.NOT. ALLOCATED(atmos%s)) THEN
       STOP "*** atmos%s must be defined before calling calculate_W ! ***"
    END IF

    IF (noc == 0 ) THEN
       STOP "*** Problem with calculate_W : noc==0 ! ***"
    ELSEIF (natm == 0 ) THEN
       STOP "*** Problem with calculate_W : natm==0 ! ***"
    ELSE
       IF (.NOT. ALLOCATED(ocean%W)) THEN
          ALLOCATE(ocean%W(noc,natm), STAT=AllocStat)
          IF (AllocStat /= 0) STOP "*** Not enough memory ! ***"
       END IF
    END IF
    ocean%W=0.D0

    DO i=1,noc
       DO j=1,natm
          ocean%W(i,j) = atmos%s(j,i)
       END DO
    END DO
  END SUBROUTINE calculate_W

  !-----------------------------------------------------!
  !                                                     !
  ! Initialisation routine                              !
  !                                                     !
  !-----------------------------------------------------!

  !> Initialisation of the inner product
  SUBROUTINE init_inprod
    INTEGER :: i,j
    INTEGER :: AllocStat

    ! Definition of the types and wave numbers tables

    ALLOCATE(owavenum(noc),awavenum(natm), STAT=AllocStat)
    IF (AllocStat /= 0) STOP "*** Not enough memory ! ***"

    j=0
    DO i=1,nbatm
       IF (ams(i,1)==1) THEN
          awavenum(j+1)%typ='A'
          awavenum(j+2)%typ='K'
          awavenum(j+3)%typ='L'

          awavenum(j+1)%P=ams(i,2)
          awavenum(j+2)%M=ams(i,1)
          awavenum(j+2)%P=ams(i,2)
          awavenum(j+3)%H=ams(i,1)
          awavenum(j+3)%P=ams(i,2)

          awavenum(j+1)%Ny=REAL(ams(i,2))
          awavenum(j+2)%Nx=REAL(ams(i,1))
          awavenum(j+2)%Ny=REAL(ams(i,2))
          awavenum(j+3)%Nx=REAL(ams(i,1))
          awavenum(j+3)%Ny=REAL(ams(i,2))

          j=j+3
       ELSE
          awavenum(j+1)%typ='K'
          awavenum(j+2)%typ='L'

          awavenum(j+1)%M=ams(i,1)
          awavenum(j+1)%P=ams(i,2)
          awavenum(j+2)%H=ams(i,1)
          awavenum(j+2)%P=ams(i,2)

          awavenum(j+1)%Nx=REAL(ams(i,1))
          awavenum(j+1)%Ny=REAL(ams(i,2))
          awavenum(j+2)%Nx=REAL(ams(i,1))
          awavenum(j+2)%Ny=REAL(ams(i,2))

          j=j+2

       ENDIF
    ENDDO

    DO i=1,noc
       owavenum(i)%H=oms(i,1)
       owavenum(i)%P=oms(i,2)

       owavenum(i)%Nx=oms(i,1)/2.D0
       owavenum(i)%Ny=oms(i,2)

    ENDDO

    ! Computation of the atmospheric inner products tensors

    CALL calculate_a
    CALL calculate_g
    CALL calculate_s
    CALL calculate_b
    CALL calculate_c_atm

    ! Computation of the oceanic inner products tensors

    CALL calculate_M
    CALL calculate_N
    CALL calculate_O
    CALL calculate_C_oc
    CALL calculate_W
    CALL calculate_K

    ! A last atmospheric one that needs ocean%M

    CALL calculate_d

  END SUBROUTINE init_inprod

  !> Deallocation of the inner products
  SUBROUTINE deallocate_inprod
    INTEGER :: AllocStat

    ! Deallocation of atmospheric inprod
    AllocStat=0
    IF (ALLOCATED(atmos%a)) DEALLOCATE(atmos%a, STAT=AllocStat)
    IF (AllocStat /= 0)  STOP "*** Problem to deallocate ! ***"

    AllocStat=0
    IF (ALLOCATED(atmos%c)) DEALLOCATE(atmos%c, STAT=AllocStat)
    IF (AllocStat /= 0)  STOP "*** Problem to deallocate ! ***"

    AllocStat=0
    IF (ALLOCATED(atmos%d)) DEALLOCATE(atmos%d, STAT=AllocStat)
    IF (AllocStat /= 0)  STOP "*** Problem to deallocate ! ***"

    AllocStat=0
    IF (ALLOCATED(atmos%s)) DEALLOCATE(atmos%s, STAT=AllocStat)
    IF (AllocStat /= 0)  STOP "*** Problem to deallocate ! ***"

    AllocStat=0
    IF (ALLOCATED(atmos%g)) DEALLOCATE(atmos%g, STAT=AllocStat)
    IF (AllocStat /= 0)  STOP "*** Problem to deallocate ! ***"

    AllocStat=0
    IF (ALLOCATED(atmos%b)) DEALLOCATE(atmos%b, STAT=AllocStat)
    IF (AllocStat /= 0)  STOP "*** Problem to deallocate ! ***"

    ! Deallocation of oceanic inprod
    AllocStat=0
    IF (ALLOCATED(ocean%K)) DEALLOCATE(ocean%K, STAT=AllocStat)
    IF (AllocStat /= 0)  STOP "*** Problem to deallocate ! ***"

    AllocStat=0
    IF (ALLOCATED(ocean%M)) DEALLOCATE(ocean%M, STAT=AllocStat)
    IF (AllocStat /= 0)  STOP "*** Problem to deallocate ! ***"

    AllocStat=0
    IF (ALLOCATED(ocean%N)) DEALLOCATE(ocean%N, STAT=AllocStat)
    IF (AllocStat /= 0)  STOP "*** Problem to deallocate ! ***"

    AllocStat=0
    IF (ALLOCATED(ocean%W)) DEALLOCATE(ocean%W, STAT=AllocStat)
    IF (AllocStat /= 0)  STOP "*** Problem to deallocate ! ***"

    AllocStat=0
    IF (ALLOCATED(ocean%O)) DEALLOCATE(ocean%O, STAT=AllocStat)
    IF (AllocStat /= 0)  STOP "*** Problem to deallocate ! ***"

    AllocStat=0
    IF (ALLOCATED(ocean%C)) DEALLOCATE(ocean%C, STAT=AllocStat)
    IF (AllocStat /= 0)  STOP "*** Problem to deallocate ! ***"
  END SUBROUTINE deallocate_inprod

END MODULE inprod_analytic


      subroutine crotgf(ca,cb,c,s)
      complex ca,cb,s
      real c
      real norm,scale
      complex alpha
      if (cabs(ca) .ne. 0.) go to 10
         c = 0.
         s = (1.,0.)
         ca = cb
         go to 20
   10 continue
         scale = cabs(ca) + cabs(cb)
         norm = scale * sqrt((cabs(ca/scale))**2 + (cabs(cb/scale))**2)
         alpha = ca /cabs(ca)
         c = cabs(ca) / norm
         s = alpha * conjg(cb) / norm
         ca = alpha * norm
   20 continue
      return
      end


      subroutine edge_cross(ndnum, crflag)

	  parameter (nume2=20000)
	  common /pcracktip/ connect(4,nume2),node(2,nume2),penta(nume2),
     >	                 ndflag(2,nume2), numnpt, numeltu, ndc

	  integer ndnum(4), crflag
	  real ncord(2,4), node
	  real k1, b1, k2, b2, yc, zc, tol

	  tol=1.0e-6
	  yc=0.0
	  zc=0.0

	  do i=1,4
	      ncord(1,i)=node(1,ndnum(i))
	      ncord(2,i)=node(2,ndnum(i))
	  end do

	  if(sqrt((ncord(1,1)-ncord(1,3))**2+
     >    (ncord(2,1)-ncord(2,3))**2)<1.0e-8) then
	      go to 20
	  else if(sqrt((ncord(1,1)-ncord(1,4))**2+
     >    (ncord(2,1)-ncord(2,4))**2)<1.0e-8) then
	      go to 20
      else if(sqrt((ncord(1,2)-ncord(1,3))**2+
     >    (ncord(2,2)-ncord(2,3))**2)<1.0e-8) then
	      go to 20
	  else if(sqrt((ncord(1,2)-ncord(1,4))**2+
     >    (ncord(2,2)-ncord(2,4))**2)<1.0e-8) then
	      go to 20
	  end if

c     calculate intersection points
      if(ncord(1,1)==ncord(1,2) .and. ncord(1,3)/=ncord(1,4)) then
	      k2=(ncord(2,4)-ncord(2,3))/(ncord(1,4)-ncord(1,3))
		  b2=ncord(2,3)-k2*ncord(1,3)
		  yc=ncord(1,1)
		  zc=k2*yc+b2

	  elseif(ncord(1,3)==ncord(1,4) .and. ncord(1,1)/=ncord(1,2)) then
	      k1=(ncord(2,2)-ncord(2,1))/(ncord(1,2)-ncord(1,1))
		  b1=ncord(2,1)-k1*ncord(1,1)
		  yc=ncord(1,3)
		  zc=k1*yc+b1

	  elseif(ncord(1,3)==ncord(1,4) .and. ncord(1,1)==ncord(1,2)) then
	      go to 20

	  else
	      k1=(ncord(2,2)-ncord(2,1))/(ncord(1,2)-ncord(1,1))
		  b1=ncord(2,1)-k1*ncord(1,1)
		  k2=(ncord(2,4)-ncord(2,3))/(ncord(1,4)-ncord(1,3))
		  b2=ncord(2,3)-k2*ncord(1,3)
		  if(k1 .ne. k2) then
	          yc=(b2-b1)/(k1-k2)
		      zc=k1*yc+b1
	      end if

	  end if

	  if (yc-min(ncord(1,1),ncord(1,2))>tol .and.
     >    max(ncord(1,1),ncord(1,2))-yc>tol .and.
     >    zc-min(ncord(2,1),ncord(2,2))>tol .and.
     >    max(ncord(2,1),ncord(2,2))-zc>tol .and.
     >    yc-min(ncord(1,3),ncord(1,4))>tol .and.
     >    max(ncord(1,3),ncord(1,4))-yc>tol .and.
     >    zc-min(ncord(2,3),ncord(2,4))>tol .and.
     >    max(ncord(2,3),ncord(2,4))-zc>tol) then
	      crflag=1
		  write(*,*) 'crack surface overlapped'
		  write(*,*) 'crack line intersection position:'
		  write(*,*) 'yc:', yc, 'zc:', zc
      end if

   20 end


      DOUBLE PRECISION FUNCTION PHO_RNDBET(Gam,Eta)
C********************************************************************
C
C     RANDOM NUMBER GENERATION FROM BETA
C     DISTRIBUTION IN REGION  0 < X < 1.
C     F(X) = X**(GAM-1.)*(1.-X)**(ETA-1)*GAMM(ETA+GAM) / (GAMM(GAM
C                                                        *GAMM(ETA))
C
C********************************************************************
      IMPLICIT NONE
      DOUBLE PRECISION Eta , Gam , PHO_RNDGAM , y , z
      SAVE

      y = PHO_RNDGAM(1.D0,Gam)
      z = PHO_RNDGAM(1.D0,Eta)

      PHO_RNDBET = y/(y+z)

      END FUNCTION


      SUBROUTINE JDATE(FLAG,  JAHR,MONTH,DAY,CNAME,  DJD)
C  SUBROUTINE DATE COMPUTES JULIAN DATE FROM CIVIL DATE,OR VICE VERSA.
C     JAHR IS YEAR AD OR BC(INTEGER),DJD IS DOUBLE PRECISION JULIAN DATE.
C     JAHR AND MONTH ARE INTEGERS, DAY A SINGLE PRECISION VARIABLE.
C     IF DJD IS TO BE COMPUTED, IT MUST BE ENTERED AS ZERO.
C     CIVIL DATE MAY BE EITHER JULIAN OR GREGORIAN CALENDAR,DEPENDING ON FLAG.

C     FLAG IS 'G' FOR GREGORIAN CIVIL DATE, 'J' FOR JULIAN CIVIL DATE.
C      CNAME IS THE NAME OF THE MONTH,SUITABLE FOR WRITING OUT (A6).
      DIMENSION NO(12),DEPOCH(2)
      CHARACTER*6 VNAME(12), CNAME
      CHARACTER*1  FLAG
      INTEGER Y, JAHRJ, JAHRG
      DOUBLE PRECISION DJD,DEPOCH,DMJD
      DATA VNAME/ '  JAN ','  FEB ','  MAR ','  APR ','  MAY ','  JUNE',
     1 '  JULY','  AUG ','  SEPT','  OCT ','  NOV ','  DEC '/
C     JD 2159716.5 IS 1 JAN 1201AD (GREGORIAN CALENDAR).
      DATA DEPOCH / 260423.5D0, 2159716.5D0/
      DATA NO/31,28,31,30,31,30,31,31,30,31,30,31/
C
      IF ( DJD.GT.1.D-13 ) GO TO 50
      Y = JAHR
      M = MONTH
      IF ( FLAG.EQ.'G' ) GO TO 10
C     THE MULLER-WIMBERLY STATEMENT FOR JULIAN CALENDAR FOLLOWS.
      J=367*Y-7*(Y+5001+(M-9)/7)/4+275*M/9+1729777
C  DBLE(FLOAT(J)) MAY NOT GIVE FULL PRECISION ON SOME MACHINES.
      DJD = DBLE(DAY+FLOAT(J) ) -.5D0
C
      CNAME = VNAME(MONTH)
      RETURN
   10 CONTINUE
C     THE MULLER-WIMBERLY STATEMENT FOR GREGORIAN CALENDAR FOLLOWS.
      J=367*Y-7*(Y+(M+9)/12)/4-3*((Y+(M-9)/7)/100+1)/4+275*M/9+1721029
      DJD = DAY + DBLE(J) - .5D0
C
      CNAME = VNAME(MONTH)
      RETURN
   50 CONTINUE
      JUMP = 0
      MODE = 2
      IF ( FLAG.EQ.'J' ) MODE = 1
      DMJD=DJD-DEPOCH(MODE)
      L=DMJD
      FL=FLOAT(L)
      REMAIN=DMJD-DBLE(FL)
      LEAP = 0
      GO TO (51,52) ,  MODE
   51 JAHR = JAHRJ(L)
      IF ( MOD(JAHR,4).EQ.0)  JUMP = 1
      GO TO 60
   52 N400 = L/146097
      IF ( L.EQ.146097 )  LEAP = 1
      M400 = MOD(L,146097) - LEAP
      N100 = M400/36524
      L = MOD( M400,36524 )
      JAHR = JAHRG( L,N100,N400 )
      IF (MOD(JAHR,4).NE.0) GO TO 60
      IF ( MOD(JAHR,100).NE.0)  JUMP = 1
      IF ( MOD(JAHR,400).EQ.0 ) JUMP = 1
   60 CONTINUE
      L = L + LEAP
      L = MOD (L,1461)
      L = (L/1460)*365 + MOD(L,365) + 1
      DO 55 MONTH = 1,12
      N = NO(MONTH)
      IF (MONTH.EQ.2) N = 28+JUMP
      L = L-N
      IF (L.LE.0) GO TO 56
   55 CONTINUE
   56 CONTINUE
      CNAME = VNAME(MONTH)
      DAY = FLOAT(L+N) + REMAIN
      RETURN
      END
      INTEGER FUNCTION JAHRJ(IL)
      INTEGER IL
C
      JAHRJ = (IL -IL/1460)/365 - 3999
C
      RETURN
      END
      INTEGER FUNCTION JAHRG(IL,I100,I400)
      INTEGER IL,I100,I400
C
      JAHRG = (IL-IL/1460)/365+100*I100+400*I400+1201
C
      RETURN
      END


! { dg-do compile }
! { dg-options "-floop-nest-optimize -O2" }

SUBROUTINE integrate_core_1(grid,coef_xyz,pol_x,pol_y,&
             pol_z,map,sphere_bounds,cmax,gridbounds)
    INTEGER, PARAMETER :: dp=8
    INTEGER, INTENT(IN)    :: sphere_bounds(*), cmax, &
                              map(-cmax:cmax,1:3), &
                              gridbounds(2,3)
    REAL(dp), INTENT(IN) :: grid(gridbounds(1,1):gridbounds(2,1), &
             gridbounds(1,2):gridbounds(2,2),&
             gridbounds(1,3):gridbounds(2,3))
    INTEGER, PARAMETER     :: lp = 1
    REAL(dp), INTENT(IN)   :: pol_x(0:lp,-cmax:cmax), &
                              pol_y(1:2,0:lp,-cmax:0), &
                              pol_z(1:2,0:lp,-cmax:0)
    REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6)
    INTEGER   :: i, ig, igmax, igmin, j, j2, &
                 jg, jg2, jgmin, k, k2, kg, &
                 kg2, kgmin, lxp, sci
    REAL(dp)  :: coef_x(4,0:lp), &
                 coef_xy(2,((lp+1)*(lp+2))/2), &
                 s(4)
    DO kg=kgmin,0
       DO jg=jgmin,0
          coef_x=0.0_dp
          DO ig=igmin,igmax
             DO lxp=0,lp
                coef_x(:,lxp)=coef_x(:,lxp)+s(:)*pol_x(lxp,ig)
             ENDDO
          END DO
             coef_xy(:,3)=coef_xy(:,3)+coef_x(3:4,0)*pol_y(2,1,jg)
       END DO
                coef_xyz(3)=coef_xyz(3)+coef_xy(1,3)*pol_z(1,0,kg)
    END DO
  END SUBROUTINE integrate_core_1


! { dg-do run }
! PR Fortran/83900
! Contributed by Gerhard Steinmetz  <gscfq t t-online dot de>
program p
   integer, parameter :: a(3,2) = 1
   real, parameter :: b(2,3) = 2
   real, parameter :: c(3,3) = matmul(a, b)
   if (any(c /= 4.)) STOP 1
end


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Originally created by James McDonagh at the University of Manchester 2015, in the Popelier group      !
! Components of the module are acknowledged to Dr Tanja van Mourik University of St Andrews             !
! Licensed under MIT License                                      !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Originally created by James.
! Version 1.1
! CHANGE LOG
! Version 1  : Paramters for calculating structural parameters
! Version 1.1: Modular format and incorporation in the Hermes program.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

module module_constants

  implicit none

  real, parameter :: pi = 3.1415926536
  real, parameter :: e = 2.7182818285
  real, parameter :: degrees_to_radians = 0.0174532925
  Real, parameter :: radians_to_degrees = 57.2957795

  contains
    subroutine show_contants()
      Print*, "Constants used are "
      Write(*,'(A,f12.10)') "pi = ",pi
      Write(*,'(A,f12.10)') "e = ",e
      Write(*,'(A,f12.10)') "Degrees to radians = ",degrees_to_radians
      Write(*,'(A,f12.10)') "Radians to degrees = ",radians_to_degrees
    end subroutine show_contants
  end module module_constants