1! icbp : iso_c_binding for parpack
2
3subroutine psnaupd_c(comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,&
4                     iparam, ipntr, workd, workl, lworkl, info)              &
5                     bind(c, name="psnaupd_c")
6  use :: iso_c_binding
7  implicit none
8#include "arpackicb.h"
9  integer(kind=i_int),    value,               intent(in)    :: comm
10  integer(kind=i_int),                         intent(inout) :: ido
11  character(kind=c_char),                      intent(in)    :: bmat
12  integer(kind=i_int),    value,               intent(in)    :: n
13  character(kind=c_char), dimension(2),        intent(in)    :: which
14  integer(kind=i_int),    value,               intent(in)    :: nev
15  real(kind=c_float),     value,               intent(in)    :: tol
16  real(kind=c_float),     dimension(n),        intent(inout) :: resid
17  integer(kind=i_int),    value,               intent(in)    :: ncv
18  real(kind=c_float),     dimension(ldv, ncv), intent(out)   :: v
19  integer(kind=i_int),    value,               intent(in)    :: ldv
20  integer(kind=i_int),    dimension(11),       intent(inout) :: iparam
21  integer(kind=i_int),    dimension(14),       intent(out)   :: ipntr
22  real(kind=c_float),     dimension(3*n),      intent(out)   :: workd
23  real(kind=c_float),     dimension(lworkl),   intent(out)   :: workl
24  integer(kind=i_int),    value,               intent(in)    :: lworkl
25  integer(kind=i_int),                         intent(inout) :: info
26
27  character(len=2):: w
28  integer         :: i
29
30  do i =1,2
31      w(i:i) = which(i)
32  end do
33
34  call psnaupd(comm, ido, bmat, n, w, nev, tol, resid, ncv, v, ldv,&
35               iparam, ipntr, workd, workl, lworkl, info)
36end subroutine psnaupd_c
37
38subroutine psneupd_c(comm, rvec, howmny, select,                  &
39                     dr, di, z, ldz, sigmar, sigmai, workev,      &
40                     bmat, n, which, nev, tol, resid, ncv, v, ldv,&
41                     iparam, ipntr, workd, workl, lworkl, info)   &
42                     bind(c, name="psneupd_c")
43  use :: iso_c_binding
44  implicit none
45#include "arpackicb.h"
46  integer(kind=i_int),    value,               intent(in)    :: comm
47  integer(kind=i_int),    value,               intent(in)    :: rvec
48  character(kind=c_char),                      intent(in)    :: howmny
49  integer(kind=i_int),    dimension(ncv),      intent(in)    :: select
50  real(kind=c_float),     dimension(nev+1),    intent(out)   :: dr
51  real(kind=c_float),     dimension(nev+1),    intent(out)   :: di
52  real(kind=c_float),     dimension(n, nev+1), intent(out)   :: z
53  integer(kind=i_int),    value,               intent(in)    :: ldz
54  real(kind=c_float),     value,               intent(in)    :: sigmar
55  real(kind=c_float),     value,               intent(in)    :: sigmai
56  real(kind=c_float),     dimension(3*ncv),    intent(out)   :: workev
57  character(kind=c_char),                      intent(in)    :: bmat
58  integer(kind=i_int),    value,               intent(in)    :: n
59  character(kind=c_char), dimension(2),        intent(in)    :: which
60  integer(kind=i_int),    value,               intent(in)    :: nev
61  real(kind=c_float),     value,               intent(in)    :: tol
62  real(kind=c_float),     dimension(n),        intent(inout) :: resid
63  integer(kind=i_int),    value,               intent(in)    :: ncv
64  real(kind=c_float),     dimension(ldv, ncv), intent(out)   :: v
65  integer(kind=i_int),    value,               intent(in)    :: ldv
66  integer(kind=i_int),    dimension(11),       intent(inout) :: iparam
67  integer(kind=i_int),    dimension(14),       intent(out)   :: ipntr
68  real(kind=c_float),     dimension(3*n),      intent(out)   :: workd
69  real(kind=c_float),     dimension(lworkl),   intent(out)   :: workl
70  integer(kind=i_int),    value,               intent(in)    :: lworkl
71  integer(kind=i_int),                         intent(inout) :: info
72
73  ! convert parameters if needed.
74
75  logical :: rv
76  logical, dimension(ncv) :: slt
77  integer :: idx
78  character(len=2):: w
79  integer         :: i
80
81  rv = .false.
82  if (rvec .ne. 0) rv = .true.
83
84  slt = .false.
85  do idx=1, ncv
86    if (select(idx) .ne. 0) slt(idx) = .true.
87  enddo
88
89  do i =1,2
90      w(i:i) = which(i)
91  end do
92
93  ! call arpack.
94
95  call psneupd(comm, rv, howmny, slt,                       &
96               dr, di, z, ldz, sigmar, sigmai, workev,      &
97               bmat, n, w, nev, tol, resid, ncv, v, ldv,&
98               iparam, ipntr, workd, workl, lworkl, info)
99end subroutine psneupd_c
100