/usr/share/doc/libsundials-serial-dev/examples/kinsol/fcmix_serial/fkinDiagon_kry.f is in libsundials-serial-dev 2.5.0-3+b3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 | program fkinDiagon_kry
c ----------------------------------------------------------------
c $Revision: 1.2 $
c $Date: 2009/09/30 23:41:32 $
c ----------------------------------------------------------------
c Programmer(s): Allan Taylor, Alan Hindmarsh and
c Radu Serban @ LLNL
c ----------------------------------------------------------------
c Simple diagonal test with Fortran interface, using user-supplied
c preconditioner setup and solve routines (supplied in Fortran).
c
c This example does a basic test of the solver by solving the
c system:
c f(u) = 0 for
c f(u) = u(i)^2 - i^2
c
c No scaling is done.
c An approximate diagonal preconditioner is used.
c
c ----------------------------------------------------------------
c
implicit none
integer ier, globalstrat, maxl, maxlrst
integer*4 PROBSIZE
parameter(PROBSIZE=128)
integer*4 neq, i, msbpre
integer*4 iout(15)
double precision pp, fnormtol, scsteptol
double precision rout(2), uu(PROBSIZE), scale(PROBSIZE)
double precision constr(PROBSIZE)
common /pcom/ pp(PROBSIZE)
common /psize/ neq
neq = PROBSIZE
globalstrat = 0
fnormtol = 1.0d-5
scsteptol = 1.0d-4
maxl = 10
maxlrst = 2
msbpre = 5
c * * * * * * * * * * * * * * * * * * * * * *
call fnvinits(3, neq, ier)
if (ier .ne. 0) then
write(6,1220) ier
1220 format('SUNDIALS_ERROR: FNVINITS returned IER = ', i2)
stop
endif
do 20 i = 1, neq
uu(i) = 2.0d0 * i
scale(i) = 1.0d0
constr(i) = 0.0d0
20 continue
call fkinmalloc(iout, rout, ier)
if (ier .ne. 0) then
write(6,1230) ier
1230 format('SUNDIALS_ERROR: FKINMALLOC returned IER = ', i2)
stop
endif
call fkinsetiin('MAX_SETUPS', msbpre, ier)
call fkinsetrin('FNORM_TOL', fnormtol, ier)
call fkinsetrin('SSTEP_TOL', scsteptol, ier)
call fkinsetvin('CONSTR_VEC', constr, ier)
call fkinspgmr(maxl, maxlrst, ier)
if (ier .ne. 0) then
write(6,1235) ier
1235 format('SUNDIALS_ERROR: FKINSPGMR returned IER = ', i2)
call fkinfree
stop
endif
call fkinspilssetprec(1, ier)
write(6,1240)
1240 format('Example program fkinDiagon_kry:'//' This FKINSOL example',
1 ' solves a 128 eqn diagonal algebraic system.'/
2 ' Its purpose is to demonstrate the use of the Fortran',
3 ' interface'/' in a serial environment.'///
4 ' globalstrategy = KIN_NONE')
call fkinsol(uu, globalstrat, scale, scale, ier)
if (ier .lt. 0) then
write(6,1242) ier, iout(9)
1242 format('SUNDIALS_ERROR: FKINSOL returned IER = ', i2, /,
1 ' Linear Solver returned IER = ', i2)
call fkinfree
stop
endif
write(6,1245) ier
1245 format(/' FKINSOL return code is ', i3)
write(6,1246)
1246 format(//' The resultant values of uu are:'/)
do 30 i = 1, neq, 4
write(6,1256) i, uu(i), uu(i+1), uu(i+2), uu(i+3)
1256 format(i4, 4(1x, f10.6))
30 continue
write(6,1267) iout(3), iout(14), iout(4), iout(12), iout(13),
1 iout(15)
1267 format(//'Final statistics:'//
1 ' nni = ', i3, ', nli = ', i3, /,
2 ' nfe = ', i3, ', npe = ', i3, /,
3 ' nps = ', i3, ', ncfl = ', i3)
call fkinfree
stop
end
c * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
c The function defining the system f(u) = 0 must be defined by a Fortran
c function of the following form.
subroutine fkfun(uu, fval, ier)
implicit none
integer ier
integer*4 neq, i
double precision fval(*), uu(*)
common /psize/ neq
do 10 i = 1, neq
fval(i) = uu(i) * uu(i) - i * i
10 continue
ier = 0
return
end
c * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
c The routine kpreco is the preconditioner setup routine. It must have
c that specific name be used in order that the c code can find and link
c to it. The argument list must also be as illustrated below:
subroutine fkpset(udata, uscale, fdata, fscale,
1 vtemp1, vtemp2, ier)
implicit none
integer ier
integer*4 neq, i
double precision pp
double precision udata(*), uscale(*), fdata(*), fscale(*)
double precision vtemp1(*), vtemp2(*)
common /pcom/ pp(128)
common /psize/ neq
do 10 i = 1, neq
pp(i) = 0.5d0 / (udata(i) + 5.0d0)
10 continue
ier = 0
return
end
c * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
c The routine kpsol is the preconditioner solve routine. It must have
c that specific name be used in order that the c code can find and link
c to it. The argument list must also be as illustrated below:
subroutine fkpsol(udata, uscale, fdata, fscale,
1 vv, ftem, ier)
implicit none
integer ier
integer*4 neq, i
double precision pp
double precision udata(*), uscale(*), fdata(*), fscale(*)
double precision vv(*), ftem(*)
common /pcom/ pp(128)
common /psize/ neq
do 10 i = 1, neq
vv(i) = vv(i) * pp(i)
10 continue
ier = 0
return
end
|