! { dg-do run }
! { dg-options "-fno-range-check" }
!
! PR fortran/34342
!
! Test for Fortran 2003 BOZ.
!
program f2003
implicit none

real,parameter             :: r2c = real(int(z'3333'))
real,parameter             :: rc  = real(z'50CB9F09')
double precision,parameter :: dc  = dble(Z'3FD34413509F79FF')
complex,parameter          :: z1c = cmplx(b'11000001010001101101110110000011', 3.049426e-10)
complex,parameter          :: z2c = cmplx(4.160326e16, o'6503667306')

real             :: r2 = real(int(z'3333'))
real             :: r  = real(z'50CB9F09')
double precision :: d  = dble(Z'3FD34413509F79FF')
complex          :: z1 = cmplx(b'11000001010001101101110110000011', 3.049426e-10)
complex          :: z2 = cmplx(4.160326e16, o'6503667306')

if (r2c /= 13107.0) STOP 1
if (rc  /= 2.732958e10) STOP 2
if (dc /= 0.30102999566398120d0) STOP 3
if (real(z1c) /= -1.242908e1 .or. aimag(z1c) /= 3.049426e-10) STOP 4
if (real(z2c) /= 4.160326e16 .or. aimag(z2c) /= 5.343285e-7) STOP 5

if (r2 /= 13107.0) STOP 6
if (r  /= 2.732958e10) STOP 7
if (d /= 0.30102999566398120d0) STOP 8
if (real(z1) /= -1.242908e1 .or. aimag(z1) /= 3.049426e-10) STOP 9
if (real(z2) /= 4.160326e16 .or. aimag(z2) /= 5.343285e-7) STOP 10

r2 = dble(int(z'3333'))
r = real(z'50CB9F09')
d = dble(Z'3FD34413509F79FF')
z1 = cmplx(b'11000001010001101101110110000011', 3.049426e-10)
z2 = cmplx(4.160326e16, o'6503667306')

if (r2 /= 13107d0) STOP 11
if (r  /= 2.732958e10) STOP 12
if (d /= 0.30102999566398120d0) STOP 13
if (real(z1) /= -1.242908e1 .or. aimag(z1) /= 3.049426e-10) STOP 14
if (real(z2) /= 4.160326e16 .or. aimag(z2) /= 5.343285e-7) STOP 15

call test4()
call test8()

contains

subroutine test4
real,parameter             :: r2c = real(int(z'3333', kind=4), kind=4)
real,parameter             :: rc  = real(z'50CB9F09', kind=4)
complex,parameter          :: z1c = cmplx(b'11000001010001101101110110000011', 3.049426e-10, kind=4)
complex,parameter          :: z2c = cmplx(4.160326e16, o'6503667306', kind=4)

real             :: r2 = real(int(z'3333', kind=4), kind=4)
real             :: r  = real(z'50CB9F09', kind=4)
complex          :: z1 = cmplx(b'11000001010001101101110110000011', 3.049426e-10, kind=4)
complex          :: z2 = cmplx(4.160326e16, o'6503667306', kind=4)

if (r2c /= 13107.0) STOP 16
if (rc  /= 2.732958e10) STOP 17
if (real(z1) /= -1.242908e1 .or. aimag(z1) /= 3.049426e-10) STOP 18
if (real(z2) /= 4.160326e16 .or. aimag(z2) /= 5.343285e-7) STOP 19

if (r2 /= 13107.0) STOP 20
if (r  /= 2.732958e10) STOP 21
if (real(z1) /= -1.242908e1 .or. aimag(z1) /= 3.049426e-10) STOP 22
if (real(z2) /= 4.160326e16 .or. aimag(z2) /= 5.343285e-7) STOP 23

r2 = real(int(z'3333'), kind=4)
r = real(z'50CB9F09', kind=4)
z1 = cmplx(b'11000001010001101101110110000011', 3.049426e-10, kind=4)
z2 = cmplx(4.160326e16, o'6503667306', kind=4)

if (r2 /= 13107.0) STOP 24
if (r  /= 2.732958e10) STOP 25
if (real(z1) /= -1.242908e1 .or. aimag(z1) /= 3.049426e-10) STOP 26
if (real(z2) /= 4.160326e16 .or. aimag(z2) /= 5.343285e-7) STOP 27
end subroutine test4

subroutine test8
real(8),parameter     :: r2c = real(int(z'FFFFFF3333', kind=8), kind=8)
real(8),parameter     :: rc  = real(z'AAAAAFFFFFFF3333', kind=8)
complex(8),parameter  :: z1c = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
complex(8),parameter  :: z2c = cmplx(5.0, o'442222222222233301245', kind=8)

real(8)             :: r2 = real(int(z'FFFFFF3333',kind=8),kind=8)
real(8)             :: r  = real(z'AAAAAFFFFFFF3333', kind=8)
complex(8)          :: z1 = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
complex(8)          :: z2 = cmplx(5.0, o'442222222222233301245', kind=8)

if (r2c /= 1099511575347.0d0) STOP 28
if (rc  /= -3.72356884822177915d-103) STOP 29
if (real(z1c) /= 3.05175781249999627d-5 .or. aimag(z1c) /= -4.0) STOP 30
if (real(z2c) /= 5.0 .or. aimag(z2c) /= 3.98227593015308981d41) STOP 31

if (r2 /= 1099511575347.0d0) STOP 32
if (r  /= -3.72356884822177915d-103) STOP 33
if (real(z1) /= 3.05175781249999627d-5 .or. aimag(z1) /= -4.0) STOP 34
if (real(z2) /= 5.0 .or. aimag(z2) /= 3.98227593015308981d41) STOP 35

r2 = real(int(z'FFFFFF3333',kind=8),kind=8)
r  = real(z'AAAAAFFFFFFF3333', kind=8)
z1 = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
z2 = cmplx(5.0, o'442222222222233301245', kind=8)

if (r2 /= 1099511575347.0d0) STOP 36
if (r  /= -3.72356884822177915d-103) STOP 37
if (real(z1) /= 3.05175781249999627d-5 .or. aimag(z1) /= -4.0) STOP 38
if (real(z2) /= 5.0 .or. aimag(z2) /= 3.98227593015308981d41) STOP 39

end subroutine test8

end program f2003


program demo_math_is_close

    use mini_test, only: check, is_close
    real :: x(2) = [1, 2]

    print *, is_close(x,[real :: 1, 2.1])     !! [T, F]
    print *, is_close(2.0, 2.1, atol=0.1)     !! T

    call check(all(is_close(x, [2.0, 2.0])), msg="all(is_close(x, [2.0, 2.0])) failed.", warn=.true.)
        !! all(is_close(x, [2.0, 2.0])) failed.

end program demo_math_is_close


program main

    use random_util2, only: init_random_seed

    implicit none
    integer :: seed
    real (kind=8) :: x(3)

    print *, "input seed"
    read *, seed

    call init_random_seed(seed)

    call random_number(x)
    print *, "Three random numbers: ",x
    call random_number(x)
    print *, "Three more random numbers: ",x

end program main


! { dg-do run }
! { dg-options "-std=f2003 " }

! PR fortran/38936
! Association to derived-type, where the target type is not know
! during parsing (only resolution).

! Contributed by Daniel Kraft, d@domob.eu.

MODULE m
  IMPLICIT NONE

  TYPE :: mynum
    INTEGER :: comp
  END TYPE mynum

  INTERFACE OPERATOR(+)
    MODULE PROCEDURE add
  END INTERFACE OPERATOR(+)

CONTAINS

  PURE FUNCTION add (a, b)
    TYPE(mynum), INTENT(IN) :: a, b
    TYPE(mynum) :: add

    add%comp = a%comp + b%comp
  END FUNCTION add

END MODULE m

PROGRAM main
  USE :: m
  IMPLICIT NONE

  TYPE(mynum) :: a
  a = mynum (5)

  ASSOCIATE (x => add (a, a))
    IF (x%comp /= 10) STOP 1
  END ASSOCIATE

  ASSOCIATE (x => a + a)
    IF (x%comp /= 10) STOP 2
  END ASSOCIATE
END PROGRAM main


cc Copyright (C) 2010-2011: Leslie Greengard, Zydrunas Gimbustas
cc and Manas Rachh
cc Contact: greengard@cims.nyu.edu
cc
cc This program is free software; you can redistribute it and/or modify
cc it under the terms of the GNU General Public License as published by
cc the Free Software Foundation; either version 2 of the License, or
cc (at your option) any later version.  This program is distributed in
cc the hope that it will be useful, but WITHOUT ANY WARRANTY; without
cc even the implied warranty of MERCHANTABILITY or FITNESS FOR A
cc PARTICULAR PURPOSE.  See the GNU General Public License for more
cc details. You should have received a copy of the GNU General Public
cc License along with this program;
cc if not, see <http://www.gnu.org/licenses/>.

c
c   Helmholtz FMM in R^2: evaluate all pairwise particle
c   interactions (ignoring self-interaction)
c   and interactions with targets.
c
c   We use H_0(kr)*(i/4) for the Green's function.
c   Self-interactions are not included
c
c   h2d: charge and dipstr are complex valued, x in \R^2
c
c   \phi(x_i) = (i/4)\sum_{j\ne i} charge_j H^{(1)}_0(k |x_i - x_j|)
c   + dipstr_j (dipvec_j \dot (x_i - x_j)) H^{(1)}_1(k |x_i - x_j|*
c                                          k/|x_i-x_j|
c
c

c
c
c
c
c
c

      subroutine hfmm2d_s_c_p(eps,zk,ns,sources,
     1            charge,pot,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge
cf2py  intent(out) pot,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(ns)    : charge strengths
c
c   OUTPUT PARAMETERS
c   pot(ns)       : potential at the source locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,ier
      real *8 sources(2,ns)
      complex *16 charge(ns)

      complex *16 pot(ns)

c
cc     temporary variables
c
      complex *16 dipstr
      real *8 dipvec(2)
      integer nt
      real *8 targ(2)
      complex *16 pottarg(1)
      complex *16 grad(2),gradtarg(2)
      complex *16 hess(3),hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      integer nd

      ifcharge = 1
      ifdipole = 0

      ifpgh = 1
      ifpghtarg = 0

      nt = 0

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------

      subroutine hfmm2d_s_c_g(eps,zk,ns,sources,
     1            charge,pot,grad,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge
cf2py  intent(out) pot,grad,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(ns)    : charge strengths
c
c   OUTPUT PARAMETERS
c   pot(ns)       : potential at the source locations
c   grad(2,ns)    : gradients at the source locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,ier
      real *8 sources(2,ns)
      complex *16 charge(ns)

      complex *16 pot(ns),grad(2,ns)

c
cc     temporary variables
c
      complex *16 dipstr
      real *8 dipvec(2)
      integer nt
      real *8 targ(2)
      complex *16 pottarg(1)
      complex *16 gradtarg(2)
      complex *16 hess(3),hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg
      integer nd

      ifcharge = 1
      ifdipole = 0

      nt = 0

      ifpgh = 2
      ifpghtarg = 0

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c
c
      subroutine hfmm2d_s_c_h(eps,zk,ns,sources,
     1            charge,pot,grad,hess,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge
cf2py  intent(out) pot,grad,hess,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(ns)    : charge strengths
c
c   OUTPUT PARAMETERS
c   pot(ns)       : potential at the source locations
c   grad(2,ns)    : gradients at the source locations
c   hess(3,ns)    : hessian at the source locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,ier
      real *8 sources(2,ns)
      complex *16 charge(ns)

      complex *16 pot(ns),grad(2,ns),hess(3,ns)

c
cc     temporary variables
c
      complex *16 dipstr
      real *8 dipvec(2)
      integer nt
      real *8 targ(2)
      complex *16 pottarg(1)
      complex *16 gradtarg(2)
      complex *16 hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg
      integer nd

      ifcharge = 1
      ifdipole = 0

      ifpgh = 3
      ifpghtarg = 0

      nd = 1

      nt = 0

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end

c-------------------------------

      subroutine hfmm2d_s_d_p(eps,zk,ns,sources,
     1            dipstr,dipvec,pot,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec
cf2py  intent(out) pot,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   dipstr(ns)    : dipole strengths
c   dipvec(2,ns)  : dipole orientation vectors
c
c   OUTPUT PARAMETERS
c   pot(ns)       : potential at the source locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,ier
      real *8 sources(2,ns)
      real *8 dipvec(2,ns)
      complex *16 dipstr(ns)

      complex *16 pot(ns)

c
cc     temporary variables
c
      complex *16 charge
      integer nt
      real *8 targ(2)
      complex *16 pottarg(1)
      complex *16 grad(2),gradtarg(2)
      complex *16 hess(3),hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      integer nd

      ifcharge = 0
      ifdipole = 1

      ifpgh = 1
      ifpghtarg = 0

      nt = 0

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------

      subroutine hfmm2d_s_d_g(eps,zk,ns,sources,
     1            dipstr,dipvec,pot,grad,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec
cf2py  intent(out) pot,grad,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   dipstr(ns)    : dipole strengths
c   dipvec(2,ns)  : dipole orientation vectors
c
c   OUTPUT PARAMETERS
c   pot(ns)       : potential at the source locations
c   grad(2,ns)    : gradients at the source locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,ier
      real *8 sources(2,ns)
      real *8 dipvec(2,ns)
      complex *16 dipstr(ns)

      complex *16 pot(ns),grad(2,ns)

c
cc     temporary variables
c
      complex *16 charge
      integer nt
      real *8 targ(2)
      complex *16 pottarg(1)
      complex *16 gradtarg(2)
      complex *16 hess(3),hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg
      integer nd

      ifcharge = 0
      ifdipole = 1

      ifpgh = 2
      ifpghtarg = 0

      nt = 0

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c
c
      subroutine hfmm2d_s_d_h(eps,zk,ns,sources,
     1            dipstr,dipvec,pot,grad,hess,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec
cf2py  intent(out) pot,grad,hess,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   dipstr(ns)    : dipole strengths
c   dipvec(2,ns)  : dipole orientation vectors
c
c   OUTPUT PARAMETERS
c   pot(ns)       : potential at the source locations
c   grad(2,ns)    : gradients at the source locations
c   hess(3,ns)    : hessian at the source locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,ier
      real *8 sources(2,ns)
      real *8 dipvec(2,ns)
      complex *16 dipstr(ns)

      complex *16 pot(ns),grad(2,ns),hess(3,ns)

c
cc     temporary variables
c
      complex *16 charge
      integer nt
      real *8 targ(2)
      complex *16 pottarg(1)
      complex *16 gradtarg(2)
      complex *16 hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg
      integer nd

      ifcharge = 0
      ifdipole = 1

      ifpgh = 3
      ifpghtarg = 0

      nt = 0

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end

c-------------------------------

      subroutine hfmm2d_s_cd_p(eps,zk,ns,sources,charge,
     1            dipstr,dipvec,pot,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec,charge
cf2py  intent(out) pot,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(ns)    : charge strengths
c   dipstr(ns)    : dipole strengths
c   dipvec(2,ns)  : dipole orientation vectors
c
c   OUTPUT PARAMETERS
c   pot(ns)       : potential at the source locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,ier
      real *8 sources(2,ns)
      real *8 dipvec(2,ns)
      complex *16 charge(ns),dipstr(ns)

      complex *16 pot(ns)

c
cc     temporary variables
c
      integer nt
      real *8 targ(2)
      complex *16 pottarg(1)
      complex *16 grad(2),gradtarg(2)
      complex *16 hess(3),hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      integer nd

      ifcharge = 1
      ifdipole = 1

      ifpgh = 1
      ifpghtarg = 0

      nt = 0

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c

      subroutine hfmm2d_s_cd_g(eps,zk,ns,sources,charge,
     1            dipstr,dipvec,pot,grad,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec,charge
cf2py  intent(out) pot,grad,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(ns)    : charge strengths
c   dipstr(ns)    : dipole strengths
c   dipvec(2,ns)  : dipole orientation vectors
c
c   OUTPUT PARAMETERS
c   pot(ns)       : potential at the source locations
c   grad(2,ns)    : gradients at the source locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,ier
      real *8 sources(2,ns)
      real *8 dipvec(2,ns)
      complex *16 charge(ns),dipstr(ns)

      complex *16 pot(ns),grad(2,ns)

c
cc     temporary variables
c
      integer nt
      real *8 targ(2)
      complex *16 pottarg(1)
      complex *16 gradtarg(2)
      complex *16 hess(3),hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg
      integer nd

      ifcharge = 1
      ifdipole = 1

      ifpgh = 2
      ifpghtarg = 0

      nt = 0

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c
c
      subroutine hfmm2d_s_cd_h(eps,zk,ns,sources,charge,
     1            dipstr,dipvec,pot,grad,hess,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec,charge
cf2py  intent(out) pot,grad,hess,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(ns)    : charge strengths
c   dipstr(ns)    : dipole strengths
c   dipvec(2,ns)  : dipole orientation vectors
c
c   OUTPUT PARAMETERS
c   pot(ns)       : potential at the source locations
c   grad(2,ns)    : gradients at the source locations
c   hess(3,ns)    : hessian at the source locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,ier
      real *8 sources(2,ns)
      real *8 dipvec(2,ns)
      complex *16 charge(ns),dipstr(ns)

      complex *16 pot(ns),grad(2,ns),hess(3,ns)

c
cc     temporary variables
c
      integer nt
      real *8 targ(2)
      complex *16 pottarg(1)
      complex *16 gradtarg(2)
      complex *16 hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg
      integer nd

      ifcharge = 1
      ifdipole = 1

      ifpgh = 3
      ifpghtarg = 0

      nt = 0

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end

      subroutine hfmm2d_t_c_p(eps,zk,ns,sources,
     1            charge,nt,targ,pottarg,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,nt,targ
cf2py  intent(out) pottarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(ns)    : charge strengths
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pottarg(nt)   : potential at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      complex *16 charge(ns)

      complex *16 pottarg(nt)

c
cc     temporary variables
c
      complex *16 dipstr
      real *8 dipvec(2)
      complex *16 pot(1)
      complex *16 grad(2),gradtarg(2)
      complex *16 hess(3),hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      integer nd

      ifcharge = 1
      ifdipole = 0

      ifpgh = 0
      ifpghtarg = 1

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------

      subroutine hfmm2d_t_c_g(eps,zk,ns,sources,
     1            charge,nt,targ,pottarg,gradtarg,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,nt,targ
cf2py  intent(out) pottarg,gradtarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(ns)    : charge strengths
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pottarg(nt)   : potential at the target locations
c   gradtarg(2,nt): gradient at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      complex *16 charge(ns)

      complex *16 pottarg(nt),gradtarg(2,nt)

c
cc     temporary variables
c
      complex *16 dipstr
      real *8 dipvec(2)
      complex *16 pot(1)
      complex *16 grad(2)
      complex *16 hess(3),hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg
      integer nd

      ifcharge = 1
      ifdipole = 0

      ifpgh = 0
      ifpghtarg = 2

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c
c
      subroutine hfmm2d_t_c_h(eps,zk,ns,sources,
     1            charge,nt,targ,pottarg,
     2            gradtarg,hesstarg,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,nt,targ
cf2py  intent(out) pottarg,gradtarg,hesstarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(ns)    : charge strengths
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pottarg(nt)   : potential at the target locations
c   gradtarg(2,nt): gradient at the target locations
c   hesstarg(3,nt): hessian at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      complex *16 charge(ns)

      complex *16 pottarg(nt),gradtarg(2,nt),hesstarg(3,nt)

c
cc     temporary variables
c
      complex *16 dipstr
      real *8 dipvec(2)
      complex *16 pot(1)
      complex *16 grad(2)
      complex *16 hess(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg
      integer nd

      ifcharge = 1
      ifdipole = 0

      ifpgh = 0
      ifpghtarg = 3

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end

c-------------------------------

      subroutine hfmm2d_t_d_p(eps,zk,ns,sources,
     1            dipstr,dipvec,nt,targ,pottarg,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec,nt,targ
cf2py  intent(out) pottarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   dipstr(ns)    : dipole strengths
c   dipvec(2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pottarg(nt)   : potential at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(2,ns)
      complex *16 dipstr(ns)

      complex *16 pottarg(nt)

c
cc     temporary variables
c
      complex *16 charge
      complex *16 pot(1)
      complex *16 grad(2),gradtarg(2)
      complex *16 hess(3),hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      integer nd

      ifcharge = 0
      ifdipole = 1

      ifpgh = 0
      ifpghtarg = 1

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------

      subroutine hfmm2d_t_d_g(eps,zk,ns,sources,
     1            dipstr,dipvec,nt,targ,pottarg,gradtarg,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec,nt,targ
cf2py  intent(out) pottarg,gradtarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   dipstr(ns)    : dipole strengths
c   dipvec(2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pottarg(nt)   : potential at the target locations
c   gradtarg(2,nt): gradient at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(2,ns)
      complex *16 dipstr(ns)

      complex *16 pottarg(nt),gradtarg(2,nt)

c
cc     temporary variables
c
      complex *16 charge
      complex *16 pot(1)
      complex *16 grad(2)
      complex *16 hess(3),hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg
      integer nd

      ifcharge = 0
      ifdipole = 1

      ifpgh = 0
      ifpghtarg = 2

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c
c
      subroutine hfmm2d_t_d_h(eps,zk,ns,sources,
     1            dipstr,dipvec,nt,targ,pottarg,
     2            gradtarg,hesstarg,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec,nt,targ
cf2py  intent(out) pottarg,gradtarg,hesstarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   dipstr(ns)    : dipole strengths
c   dipvec(2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pottarg(nt)   : potential at the target locations
c   gradtarg(2,nt): gradient at the target locations
c   hesstarg(3,nt): hessian at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(2,ns)
      complex *16 dipstr(ns)

      complex *16 pottarg(nt),gradtarg(2,nt),hesstarg(3,nt)

c
cc     temporary variables
c
      complex *16 charge
      complex *16 pot(1)
      complex *16 grad(2)
      complex *16 hess(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg
      integer nd

      ifcharge = 0
      ifdipole = 1

      ifpgh = 0
      ifpghtarg = 3

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end

c-------------------------------

      subroutine hfmm2d_t_cd_p(eps,zk,ns,sources,charge,
     1            dipstr,dipvec,nt,targ,pottarg,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,dipstr,dipvec,nt,targ
cf2py  intent(out) pottarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(ns)    : charge strengths
c   dipstr(ns)    : dipole strengths
c   dipvec(2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pottarg(nt)   : potential at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(2,ns)
      complex *16 charge(ns),dipstr(ns)

      complex *16 pottarg(nt)

c
cc     temporary variables
c
      complex *16 pot(1)
      complex *16 grad(2),gradtarg(2)
      complex *16 hess(3),hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      integer nd

      ifcharge = 1
      ifdipole = 1

      ifpgh = 0
      ifpghtarg = 1

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c

      subroutine hfmm2d_t_cd_g(eps,zk,ns,sources,charge,
     1            dipstr,dipvec,nt,targ,pottarg,gradtarg,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,dipstr,dipvec,nt,targ
cf2py  intent(out) pottarg,gradtarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(ns)    : charge strengths
c   dipstr(ns)    : dipole strengths
c   dipvec(2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pottarg(nt)   : potential at the target locations
c   gradtarg(2,nt): gradient at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(2,ns)
      complex *16 charge(ns),dipstr(ns)

      complex *16 pottarg(nt),gradtarg(2,nt)

c
cc     temporary variables
c
      complex *16 pot(1)
      complex *16 grad(2)
      complex *16 hess(3),hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg
      integer nd

      ifcharge = 1
      ifdipole = 1

      ifpgh = 0
      ifpghtarg = 2

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c
c
      subroutine hfmm2d_t_cd_h(eps,zk,ns,sources,charge,
     1            dipstr,dipvec,nt,targ,pottarg,
     2            gradtarg,hesstarg,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,dipstr,dipvec,nt,targ
cf2py  intent(out) pottarg,gradtarg,hesstarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(ns)    : charge strengths
c   dipstr(ns)    : dipole strengths
c   dipvec(2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pottarg(nt)   : potential at the target locations
c   gradtarg(2,nt): gradient at the target locations
c   hesstarg(3,nt): hessian at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(2,ns)
      complex *16 charge(ns),dipstr(ns)

      complex *16 pottarg(nt),gradtarg(2,nt),hesstarg(3,nt)

c
cc     temporary variables
c
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg
      integer nd
      complex *16 pot(1)
      complex *16 grad(2)
      complex *16 hess(3)

      ifcharge = 1
      ifdipole = 1

      ifpgh = 0
      ifpghtarg = 3

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end

c
c
c
c
c
c

      subroutine hfmm2d_st_c_p(eps,zk,ns,sources,
     1            charge,pot,nt,targ,pottarg,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,nt,targ
cf2py  intent(out) pot,pottarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(ns)    : charge strengths
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pot(ns)       : potential at the source locations
c   pottarg(nt)   : potential at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      complex *16 charge(ns)

      complex *16 pot(ns)
      complex *16 pottarg(nt)

c
cc     temporary variables
c
      complex *16 dipstr
      real *8 dipvec(2)
      complex *16 grad(2),gradtarg(2)
      complex *16 hess(3),hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      integer nd

      ifcharge = 1
      ifdipole = 0

      ifpgh = 1
      ifpghtarg = 1

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------

      subroutine hfmm2d_st_c_g(eps,zk,ns,sources,
     1            charge,pot,grad,nt,targ,pottarg,gradtarg,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,nt,targ
cf2py  intent(out) pot,pottarg,grad,gradtarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(ns)    : charge strengths
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pot(ns)       : potential at the source locations
c   grad(2,ns)    : gradients at the source locations
c   pottarg(nt)   : potential at the target locations
c   gradtarg(2,nt): gradient at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      complex *16 charge(ns)

      complex *16 pot(ns),grad(2,ns)
      complex *16 pottarg(nt),gradtarg(2,nt)

c
cc     temporary variables
c
      complex *16 dipstr
      real *8 dipvec(2)
      complex *16 hess(3),hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg
      integer nd

      ifcharge = 1
      ifdipole = 0

      ifpgh = 2
      ifpghtarg = 2

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c
c
      subroutine hfmm2d_st_c_h(eps,zk,ns,sources,
     1            charge,pot,grad,hess,nt,targ,pottarg,
     2            gradtarg,hesstarg,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,nt,targ
cf2py  intent(out) pot,pottarg,grad,gradtarg,hess,hesstarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(ns)    : charge strengths
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pot(ns)       : potential at the source locations
c   grad(2,ns)    : gradients at the source locations
c   hess(3,ns)    : hessian at the source locations
c   pottarg(nt)   : potential at the target locations
c   gradtarg(2,nt): gradient at the target locations
c   hesstarg(3,nt): hessian at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      complex *16 charge(ns)

      complex *16 pot(ns),grad(2,ns),hess(3,ns)
      complex *16 pottarg(nt),gradtarg(2,nt),hesstarg(3,nt)

c
cc     temporary variables
c
      complex *16 dipstr
      real *8 dipvec(2)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg
      integer nd

      ifcharge = 1
      ifdipole = 0

      ifpgh = 3
      ifpghtarg = 3

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end

c-------------------------------

      subroutine hfmm2d_st_d_p(eps,zk,ns,sources,
     1            dipstr,dipvec,pot,nt,targ,pottarg,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec,nt,targ
cf2py  intent(out) pot,pottarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   dipstr(ns)    : dipole strengths
c   dipvec(2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pot(ns)       : potential at the source locations
c   pottarg(nt)   : potential at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(2,ns)
      complex *16 dipstr(ns)

      complex *16 pot(ns)
      complex *16 pottarg(nt)

c
cc     temporary variables
c
      complex *16 charge
      complex *16 grad(2),gradtarg(2)
      complex *16 hess(3),hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      integer nd

      ifcharge = 0
      ifdipole = 1

      ifpgh = 1
      ifpghtarg = 1

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------

      subroutine hfmm2d_st_d_g(eps,zk,ns,sources,
     1            dipstr,dipvec,pot,grad,nt,targ,pottarg,gradtarg,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec,nt,targ
cf2py  intent(out) pot,pottarg,grad,gradtarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   dipstr(ns)    : dipole strengths
c   dipvec(2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pot(ns)       : potential at the source locations
c   grad(2,ns)    : gradients at the source locations
c   pottarg(nt)   : potential at the target locations
c   gradtarg(2,nt): gradient at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(2,ns)
      complex *16 dipstr(ns)

      complex *16 pot(ns),grad(2,ns)
      complex *16 pottarg(nt),gradtarg(2,nt)

c
cc     temporary variables
c
      complex *16 charge
      complex *16 hess(3),hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg
      integer nd

      ifcharge = 0
      ifdipole = 1

      ifpgh = 2
      ifpghtarg = 2

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c
c
      subroutine hfmm2d_st_d_h(eps,zk,ns,sources,
     1            dipstr,dipvec,pot,grad,hess,nt,targ,pottarg,
     2            gradtarg,hesstarg,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,dipstr,dipvec,nt,targ
cf2py  intent(out) pot,pottarg,grad,gradtarg,hess,hesstarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   dipstr(ns)    : dipole strengths
c   dipvec(2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pot(ns)       : potential at the source locations
c   grad(2,ns)    : gradients at the source locations
c   hess(3,ns)    : hessian at the source locations
c   pottarg(nt)   : potential at the target locations
c   gradtarg(2,nt): gradient at the target locations
c   hesstarg(3,nt): hessian at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(2,ns)
      complex *16 dipstr(ns)

      complex *16 pot(ns),grad(2,ns),hess(3,ns)
      complex *16 pottarg(nt),gradtarg(2,nt),hesstarg(3,nt)

c
cc     temporary variables
c
      complex *16 charge
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg
      integer nd

      ifcharge = 0
      ifdipole = 1

      ifpgh = 3
      ifpghtarg = 3

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end

c-------------------------------

      subroutine hfmm2d_st_cd_p(eps,zk,ns,sources,charge,
     1            dipstr,dipvec,pot,nt,targ,pottarg,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,dipstr,dipvec,nt,targ
cf2py  intent(out) pot,pottarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(ns)    : charge strengths
c   dipstr(ns)    : dipole strengths
c   dipvec(2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pot(ns)       : potential at the source locations
c   pottarg(nt)   : potential at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(2,ns)
      complex *16 charge(ns),dipstr(ns)

      complex *16 pot(ns)
      complex *16 pottarg(nt)

c
cc     temporary variables
c
      complex *16 grad(2),gradtarg(2)
      complex *16 hess(3),hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg

      integer nd

      ifcharge = 1
      ifdipole = 1

      ifpgh = 1
      ifpghtarg = 1

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c

      subroutine hfmm2d_st_cd_g(eps,zk,ns,sources,charge,
     1            dipstr,dipvec,pot,grad,nt,targ,pottarg,gradtarg,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,dipstr,dipvec,nt,targ
cf2py  intent(out) pot,pottarg,grad,gradtarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(ns)    : charge strengths
c   dipstr(ns)    : dipole strengths
c   dipvec(2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pot(ns)       : potential at the source locations
c   grad(2,ns)    : gradients at the source locations
c   pottarg(nt)   : potential at the target locations
c   gradtarg(2,nt): gradient at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(2,ns)
      complex *16 charge(ns),dipstr(ns)

      complex *16 pot(ns),grad(2,ns)
      complex *16 pottarg(nt),gradtarg(2,nt)

c
cc     temporary variables
c
      complex *16 hess(3),hesstarg(3)
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg
      integer nd

      ifcharge = 1
      ifdipole = 1

      ifpgh = 2
      ifpghtarg = 2

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end
c------------------------------
c
c
c
c
c
      subroutine hfmm2d_st_cd_h(eps,zk,ns,sources,charge,
     1            dipstr,dipvec,pot,grad,hess,nt,targ,pottarg,
     2            gradtarg,hesstarg,ier)
cf2py  intent(in) eps
cf2py  intent(in) zk
cf2py  intent(in) ns,sources,charge,dipstr,dipvec,nt,targ
cf2py  intent(out) pot,pottarg,grad,gradtarg,hess,hesstarg,ier

c----------------------------------------------
c   INPUT PARAMETERS:
c   eps           : FMM precision requested
c   zk            : Helmholtz parameter
c   ns            : number of sources
c   sources(2,ns) : source locations
c   charge(ns)    : charge strengths
c   dipstr(ns)    : dipole strengths
c   dipvec(2,ns)  : dipole orientation vectors
c   nt            : number of targets
c   targ(2,nt)    : target locations
c
c   OUTPUT PARAMETERS
c   pot(ns)       : potential at the source locations
c   grad(2,ns)    : gradients at the source locations
c   hess(3,ns)    : hessian at the source locations
c   pottarg(nt)   : potential at the target locations
c   gradtarg(2,nt): gradient at the target locations
c   hesstarg(3,nt): hessian at the target locations
c

      implicit none
c
cc      calling sequence variables
c
      real *8 eps
      complex *16 zk
      integer ns,nt,ier
      real *8 sources(2,ns),targ(2,nt)
      real *8 dipvec(2,ns)
      complex *16 charge(ns),dipstr(ns)

      complex *16 pot(ns),grad(2,ns),hess(3,ns)
      complex *16 pottarg(nt),gradtarg(2,nt),hesstarg(3,nt)

c
cc     temporary variables
c
      integer ifcharge,ifdipole,iper
      integer ifpgh,ifpghtarg
      integer nd

      ifcharge = 1
      ifdipole = 1

      ifpgh = 3
      ifpghtarg = 3

      nd = 1

      call hfmm2d(nd,eps,zk,ns,sources,ifcharge,charge,
     1            ifdipole,dipstr,dipvec,iper,ifpgh,pot,grad,hess,
     2            nt,targ,ifpghtarg,pottarg,gradtarg,
     3            hesstarg,ier)
      return
      end


program demo_stats_randu

    use forlab_stats, only: randu

    print *, "running `demo_stats_randu`.."

    print *, randu(start=1, end=2)
    print *, randu(start=1.0, end=2.0, ndim=3)
    print *, reshape(randu(1.0, 2.0, 2*2), [2,2])

    !> Possible output:

    !! 2
    !! 1.65676987       1.11625218       1.03502560
    !! 1.74973476       1.82997108       1.77998054       1.14384007

end program demo_stats_randu


module gamblers

    implicit none
    integer :: kwalks, max_steps
    save

contains

    subroutine walk(n1in, n2in, p, verbose, nsteps, winner)

    implicit none
    integer, intent(in) :: n1in,n2in
    real(kind=8), intent(in) :: p
    logical, intent(in) :: verbose
    integer, intent(out) :: nsteps, winner

    ! local variables
    real(kind=8) :: r
    integer :: nstep, n1, n2

    ! initialize n1 and n2 with input values
    ! need to change n1 and n2 internally during this walk but do not
    ! want to affect n1 and n2 in main program.
    n1 = n1in
    n2 = n2in

    ! CONTINUE WRITING THIS SUBROUTINE....

    end subroutine walk

end module gamblers


      LOGICAL FUNCTION DTLEAP (YEAR)
      IMPLICIT NONE

*     FORMAL_PARAMETERS:
      INTEGER YEAR

**    no local variables
      SAVE

      DTLEAP = MOD (YEAR,4).EQ.0
      IF (MOD (YEAR,100).EQ.0) DTLEAP = .FALSE.
      IF (MOD (YEAR,400).EQ.0) DTLEAP = .TRUE.

      RETURN
      END


! Calculate velocity magnitude from momenta and density. NOTE the resulting units are km/s, NOT cm/s.

subroutine calc_abs_v(xmom, ymom, zmom, mom_ng, density, density_ng, lo, hi, abs_v)
  use, intrinsic :: iso_c_binding
  implicit none

  integer(c_int), intent(in) :: lo(3), hi(3), mom_ng, density_ng
  real(c_double), intent(in) :: xmom (lo(1)-mom_ng:hi(1)+mom_ng, &
                                      lo(2)-mom_ng:hi(2)+mom_ng, &
                                      lo(3)-mom_ng:hi(3)+mom_ng, 1)
  real(c_double), intent(in) :: ymom (lo(1)-mom_ng:hi(1)+mom_ng, &
                                      lo(2)-mom_ng:hi(2)+mom_ng, &
                                      lo(3)-mom_ng:hi(3)+mom_ng, 1)
  real(c_double), intent(in) :: zmom (lo(1)-mom_ng:hi(1)+mom_ng, &
                                      lo(2)-mom_ng:hi(2)+mom_ng, &
                                      lo(3)-mom_ng:hi(3)+mom_ng, 1)
  real(c_double), intent(in) :: density (lo(1)-density_ng:hi(1)+density_ng, &
                                         lo(2)-density_ng:hi(2)+density_ng, &
                                         lo(3)-density_ng:hi(3)+density_ng, 1)

  real(c_double), intent(out) :: abs_v(lo(1)-mom_ng:hi(1)+mom_ng, &
                                       lo(2)-mom_ng:hi(2)+mom_ng, &
                                       lo(3)-mom_ng:hi(3)+mom_ng, 1)

  integer :: i, j, k
  real(c_double) :: xvel, yvel, zvel

  do k = lo(3), hi(3)
    do j = lo(2), hi(2)
      do i = lo(1), hi(1)
        xvel = xmom(i, j, k, 1) / density(i, j, k, 1)
        yvel = ymom(i, j, k, 1) / density(i, j, k, 1)
        zvel = zmom(i, j, k, 1) / density(i, j, k, 1)

        ! NOTE: THE UNITS ARE KM/S, NOT CM/S
        abs_v(i, j, k, 1) = sqrt(xvel*xvel + yvel*yvel + zvel*zvel)
      end do
    end do
  end do
end subroutine calc_abs_v


      FUNCTION FHYDCN(VOID,BMECH4,BMECH5,BMECH6,IBMECHK)
      INTEGER::IBMECHK
      REAL::FHYDCN,BMECH4,TMP,VOID,BMECH5,BMECH6,FHYDCNLOG
C CHANGE RECORD
C  ADDED STANDARD EXPONENTIAL FORM CONSTITUTIVE RELATIONSHIP
C
C
C **  FHYDCN IS HYDRAULIC CONDUCTIVITY DIVIDED BY 1+VOID RATIO
C
      IF(BMECH4.GT.0.0)THEN
        TMP=(VOID-BMECH5)/BMECH6
        IF(IBMECHK.EQ.0) THEN
          FHYDCN=BMECH4*EXP(TMP)/(1.+VOID)
        ELSE
          FHYDCN=BMECH4*EXP(TMP)
        END IF
      ELSE
        FHYDCNLOG=0.00816448*(VOID**3)-0.232453*(VOID**2)+2.5759*VOID
     &      -28.581
        FHYDCN=EXP(FHYDCNLOG)
      END IF
      RETURN
      END


program Montecarlo
    implicit none

    integer :: total_points
    real :: calculate_pi
    real :: pi

    print*, "Enter the total amount of points for the calculation..."
    read*, total_points

    pi = calculate_pi(total_points)

    write(*,*) 'PI = ', pi
end

real function calculate_pi(p)
        integer :: p
        real in_area, x, y

        in_area = 0
        x = 0
        y = 0

        do i=1,p
            x = rand(0)
            y = rand(0)
            z = calculate_z(x,y)
            if (z .le. 1.) then
                in_area = in_area + 1
                write(*,*) 'In Area = ', in_area, 'X = ', x, ' Y = ', y, ' Z = ', z
            else
                write(*,*) 'NOT In Area = X = ', x, ' Y = ', y, ' Z = ', z
            end if
        enddo

        calculate_pi = 4 * (p / in_area)

    return
end

real function calculate_z(x,y)
    real :: x, y
    real :: square_x, square_y
    square_x = x**2
    square_y = y**2
    calculate_z = sqrt(square_x + square_y)
end


PROGRAM temp_avgs
IMPLICIT NONE
CHARACTER(LEN=80) :: msg
INTEGER :: status, i, j
REAL, DIMENSION(6, 6) :: t

OPEN(UNIT=1, FILE="temps.txt", STATUS='OLD', ACTION='READ', &
     IOSTAT=status, IOMSG=msg)
READ(1, *) t
WRITE(*, *) "Temperature Readings:"
WRITE(*, '(6F6.1)') ((t(i, j), j=1, 6), i=1, 6)
WRITE(*, *) "Latitute Averages:"
WRITE(*, '(6F6.1)') (SUM(t(i,1:6)) / 6., i = 1, 6)
WRITE(*, *) "Longitute Averages:"
WRITE(*, '(6F6.1)') (SUM(t(1:6,i)) / 6., i = 1, 6)
CLOSE(1)
END PROGRAM temp_avgs


      SUBROUTINE QTRAP(FUNC,A,B,S)
      PARAMETER (EPS=1.E-6, JMAX=20)
      OLDS=-1.E30
      DO 11 J=1,JMAX
        CALL TRAPZD(FUNC,A,B,S,J)
        IF (ABS(S-OLDS).LT.EPS*ABS(OLDS)) RETURN
        OLDS=S
11    CONTINUE
      PAUSE 'Too many steps.'
      END


	SUBROUTINE VC_NBTS  ( adat, nxy, mxsgdg, nmbts, iret )
C************************************************************************
C* VC_NBTS								*
C*									*
C* This subroutine computes the number of packing bits given the	*
C* maximum number of significant digits to preserve.			*
C*									*
C* VC_NBTS ( ADAT, NXY, MXSGDG, NMBTS, IRET )				*
C*									*
C* Input parameters:							*
C*	ADAT (NXY)	REAL		Array of data values		*
C*	NXY		INTEGER		Number of data values		*
C*	MXSGDG		INTEGER		Maximum # of significant digits	*
C*									*
C* Output parameters:							*
C*	NMBTS		INTEGER		Number of bits for packing	*
C*	IRET		INTEGER		Return code			*
C*					  0 = normal return		*
C*					 +1 = all missing		*
C**									*
C* Log:									*
C* K. Brill/NMC		06/92						*
C* K. Brill/NMC		08/92	Add all missing check			*
C* J. Wu/GSC            07/00   Moved INCLUDE 'ERMISS.FNC' before the   *
C*                              DATA statement                          *
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
	REAL		adat (*)
C*
	INCLUDE		'ERMISS.FNC'
	DATA		rln2/0.69314718/
C-----------------------------------------------------------------------
	iret = 0
	icnt = 0
C
C*	Find the maximum and minimum.
C
	amax = -1.e33
	amin =  1.e33
	DO i = 1, nxy
	    IF ( .not. ERMISS ( adat (i) ) ) THEN
		IF ( adat (i) .gt. amax ) amax = adat (i)
		IF ( adat (i) .lt. amin ) amin = adat (i)
	    ELSE
		icnt = icnt + 1
	    END IF
	END DO
	IF ( icnt .eq. nxy ) THEN
	   nmbts = 8
	   iret = +1
	   RETURN
	END IF
	range = amax - amin
	IF ( range .le. 0.00 ) THEN
	    nmbts = 8
	    RETURN
	END IF
	ipo = INT ( ALOG10 ( range ) )
	IF ( range .lt. 1.00 ) ipo = ipo - 1
	ipo = ipo - mxsgdg + 1
	rr = range * 10. ** ( -ipo )
	nmbts = INT ( ALOG ( rr ) / rln2 ) + 1
C*
	RETURN
	END


      function inverf(x)
!***********************************************************************
! $Id: inverf.f,v 1.1 2006/05/17 15:23:22 zvd Exp $
!***********************************************************************
!  Copyright, 2004,  The  Regents  of the  University of California.
!  This program was prepared by the Regents of the University of
!  California at Los Alamos National Laboratory (the University) under
!  contract No. W-7405-ENG-36 with the U.S. Department of Energy (DOE).
!  All rights in the program are reserved by the DOE and the University.
!  Permission is granted to the public to copy and use this software
!  without charge, provided that this Notice and any statement of
!  authorship are reproduced on all copies. Neither the U.S. Government
!  nor the University makes any warranty, express or implied, or
!  assumes any liability or responsibility for the use of this software.
!***********************************************************************
!
!  PURPOSE
!
!  This subroutine calculates the inverse of the error function
!  for a value of x between 0 and 1.  It does so using linear
!  interpolation between chosen values of the erf(x) curve.
!
!***********************************************************************
!
! Initial implementation: 03/16/95, Programmer: B. Robinson
!     for FEHM V1.0
!
!***********************************************************************

      implicit none

      integer i
      real inverf,ef(8),a(8),b(8), x
      data ef/.2227,.42839,.60386,.79691,.91031,.97635,.99532,1./
      data a/.8980691,.972337,-1.255877,-1.033911,-0.8452046,
     +     -0.6909501,-0.5685161,-0.4299497/
      data b/0.,-1.653945e-2,9.494722e-2,0.1842109,0.3148551,0.476399,
     +     0.6754972,0.9983227/

      if(x.lt.0.) x=-x
      if(x.gt.1.) then
         write(6,110)
 110     format(1x,'value of x greater than 1')
         return
      end if
      do i=1,2
         if(x.lt.ef(i)) then
            inverf=a(i)*x+b(i)
            return
         end if
      enddo
      do i=3,7
         if(x.lt.ef(i)) goto 11
      enddo
      i=8
 11   inverf=a(i)*alog10(1.-x)+b(i)

      return
      end


    Program dgbcon_example

!     DGBCON Example Program Text

!     Copyright (c) 2018, Numerical Algorithms Group (NAG Ltd.)
!     For licence see
!       https://github.com/numericalalgorithmsgroup/LAPACK_Examples/blob/master/LICENCE.md

!     .. Use Statements ..
      Use lapack_interfaces, Only: dgbcon, dgbtrf, dlangb
      Use lapack_precision, Only: dp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter :: nin = 5, nout = 6
      Character (1), Parameter :: norm = '1'
!     .. Local Scalars ..
      Real (Kind=dp) :: anorm, rcond
      Integer :: i, info, j, k, kl, ku, ldab, n
!     .. Local Arrays ..
      Real (Kind=dp), Allocatable :: ab(:, :), work(:)
      Integer, Allocatable :: ipiv(:), iwork(:)
!     .. Intrinsic Procedures ..
      Intrinsic :: epsilon, max, min
!     .. Executable Statements ..
      Write (nout, *) 'DGBCON Example Program Results'
!     Skip heading in data file
      Read (nin, *)
      Read (nin, *) n, kl, ku
      ldab = 2*kl + ku + 1
      Allocate (ab(ldab,n), work(3*n), ipiv(n), iwork(n))

!     Read A from data file

      k = kl + ku + 1
      Read (nin, *)((ab(k+i-j,j),j=max(i-kl,1),min(i+ku,n)), i=1, n)

!     Compute norm of A
      anorm = dlangb(norm, n, kl, ku, ab(kl+1,1), ldab, work)

!     Factorize A

      Call dgbtrf(n, n, kl, ku, ab, ldab, ipiv, info)

      Write (nout, *)
      If (info==0) Then

!       Estimate condition number

        Call dgbcon(norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond, work, &
          iwork, info)

        If (rcond>=epsilon(1.0E0_dp)) Then
          Write (nout, 100) 'Estimate of condition number =', 1.0_dp/rcond
        Else
          Write (nout, *) 'A is singular to working precision'
        End If
      Else
        Write (nout, *) 'The factor U is singular'
      End If

100   Format (1X, A, 1P, E10.2)
    End Program


************************************************************************
*
*     Subroutine PCTL
*
*     Called by: INPUTE,OUTHEAD,OUTSUMM2,OUTSUMM3,OUTSUMMC
*
*     calculate the minimum and maximum values, and 10th, 25th, 50th,
*     75th, 90th, 95th, and 99th percentiles
*
*     Local variable
*     --------------
*     X2       copy of X sorted in ascending order
*
************************************************************************
      SUBROUTINE PCTL(X,NUM,XMIN,P10,P25,P50,P75,P90,P95,P99,XMAX)
*
*     subroutine arguments
*
      INTEGER*4 NUM
      DOUBLE PRECISION XMIN,P10,P25,P50,P75,P90,P95,P99,XMAX
      DOUBLE PRECISION X(*)
*
*     local vars
*
      INTEGER*4 I
      DOUBLE PRECISION X2(NUM)
*
*     function declaration
*
      DOUBLE PRECISION PTILE
*
*     create copy of X and sort [all operations are done on the copy
*     (X2) so that X is passed back to the calling program unaltered]
*
      DO 10 I = 1,NUM
         X2(I) = X(I)
 10   CONTINUE
      CALL SORT(X2,NUM)
*
*     the minimum and maximum values correspond to the first and last
*     elements of X2
*
      XMIN = X2(1)
      XMAX = X2(NUM)
*
*     set percentiles
*
*
      P10 = PTILE(X2,NUM,0.10D0)
      P25 = PTILE(X2,NUM,0.25D0)
      P50 = PTILE(X2,NUM,0.50D0)
      P75 = PTILE(X2,NUM,0.75D0)
      P90 = PTILE(X2,NUM,0.90D0)
      P95 = PTILE(X2,NUM,0.95D0)
      P99 = PTILE(X2,NUM,0.99D0)

      RETURN
      END


      SUBROUTINE fixrts(d,m)
      INTEGER m,MMAX
      REAL d(m)
      PARAMETER (MMAX=100)
CU    USES zroots
      INTEGER i,j
      LOGICAL polish
      COMPLEX a(MMAX),roots(MMAX)
      a(m+1)=cmplx(1.,0.)
      do 11 j=m,1,-1
        a(j)=cmplx(-d(m+1-j),0.)
11    continue
      polish=.true.
      call zroots(a,m,roots,polish)
      do 12 j=1,m
        if(abs(roots(j)).gt.1.)then
          roots(j)=1./conjg(roots(j))
        endif
12    continue
      a(1)=-roots(1)
      a(2)=cmplx(1.,0.)
      do 14 j=2,m
        a(j+1)=cmplx(1.,0.)
        do 13 i=j,2,-1
          a(i)=a(i-1)-roots(j)*a(i)
13      continue
        a(1)=-roots(j)*a(1)
14    continue
      do 15 j=1,m
        d(m+1-j)=-real(a(j))
15    continue
      return
      END

NR-Functions/Numerical Recipes- Example & Functions/Functions/fixrts.for