mkl_rci.fi 15 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455
  1. !===============================================================================
  2. ! Copyright 2005-2022 Intel Corporation.
  3. !
  4. ! This software and the related documents are Intel copyrighted materials, and
  5. ! your use of them is governed by the express license under which they were
  6. ! provided to you (License). Unless the License provides otherwise, you may not
  7. ! use, modify, copy, publish, distribute, disclose or transmit this software or
  8. ! the related documents without Intel's prior written permission.
  9. !
  10. ! This software and the related documents are provided as is, with no express
  11. ! or implied warranties, other than those that are expressly stated in the
  12. ! License.
  13. !===============================================================================
  14. ! Content:
  15. ! Intel(R) oneAPI Math Kernel Library (Intel(R) oneMKL) interface for
  16. ! preconditioners, RCI ISS and TR solvers routines
  17. !******************************************************************************
  18. ! PARAMETERS
  19. INTEGER(KIND=4) TR_SUCCESS
  20. INTEGER(KIND=4) TR_INVALID_OPTION
  21. INTEGER(KIND=4) TR_OUT_OF_MEMORY
  22. PARAMETER (TR_SUCCESS = 1501)
  23. PARAMETER (TR_INVALID_OPTION = 1502)
  24. PARAMETER (TR_OUT_OF_MEMORY = 1503)
  25. ! SUBROUTINES
  26. INTERFACE
  27. SUBROUTINE DCG(n,x,b,rci_request,ipar,dpar,tmp)
  28. INTEGER n, rci_request
  29. DOUBLE PRECISION x( * ), b( * ), dpar( * )
  30. DOUBLE PRECISION tmp( n, * )
  31. INTEGER ipar( * )
  32. END SUBROUTINE
  33. END INTERFACE
  34. INTERFACE
  35. SUBROUTINE DCG_INIT(n,x,b,rci_request,ipar,dpar,tmp)
  36. INTEGER n, rci_request
  37. DOUBLE PRECISION x( * ), b( * ), dpar( * )
  38. DOUBLE PRECISION tmp( n, * )
  39. INTEGER ipar( * )
  40. END SUBROUTINE
  41. END INTERFACE
  42. INTERFACE
  43. SUBROUTINE DCG_CHECK(n,x,b,rci_request,ipar,dpar,tmp)
  44. INTEGER n, rci_request
  45. DOUBLE PRECISION x( * ), b( * ), dpar( * )
  46. DOUBLE PRECISION tmp( n, * )
  47. INTEGER ipar( * )
  48. END SUBROUTINE
  49. END INTERFACE
  50. INTERFACE
  51. SUBROUTINE DCG_GET(n,x,b,rci_request,ipar,dpar,tmp,itercount)
  52. INTEGER n, rci_request, itercount
  53. DOUBLE PRECISION x( * ), b( * ), dpar( * )
  54. DOUBLE PRECISION tmp( n, * )
  55. INTEGER ipar( * )
  56. END SUBROUTINE
  57. END INTERFACE
  58. INTERFACE
  59. SUBROUTINE DCSRILU0(n,a,ia,ja,alu,ipar,dpar,ierr)
  60. INTEGER n, ierr
  61. DOUBLE PRECISION a( * ), dpar( * ), alu( * )
  62. INTEGER ia( * ), ja( * ), ipar( * )
  63. END SUBROUTINE
  64. END INTERFACE
  65. INTERFACE
  66. SUBROUTINE DCSRILUT(n,a,ia,ja,alut,ialut,jalut,tol,maxfil, &
  67. & ipar,dpar,ierr)
  68. INTEGER n, maxfil, ierr
  69. DOUBLE PRECISION tol
  70. DOUBLE PRECISION a( * ), dpar( * ), alut( * )
  71. INTEGER ia( * ), ja( * ), ipar( * ), ialut( * )
  72. INTEGER jalut( * )
  73. END SUBROUTINE
  74. END INTERFACE
  75. INTERFACE
  76. SUBROUTINE DFGMRES(n,x,b,rci_request,ipar,dpar,tmp)
  77. INTEGER n, rci_request
  78. DOUBLE PRECISION x( * ), b( * ), tmp( * ), dpar( * )
  79. INTEGER ipar( * )
  80. END SUBROUTINE
  81. END INTERFACE
  82. INTERFACE
  83. SUBROUTINE DFGMRES_INIT(n,x,b,rci_request,ipar,dpar,tmp)
  84. INTEGER n, rci_request
  85. DOUBLE PRECISION x( * ), b( * ), tmp( * ), dpar( * )
  86. INTEGER ipar( * )
  87. END SUBROUTINE
  88. END INTERFACE
  89. INTERFACE
  90. SUBROUTINE DFGMRES_CHECK(n,x,b,rci_request,ipar,dpar,tmp)
  91. INTEGER n, rci_request
  92. DOUBLE PRECISION x( * ), b( * ), tmp( * ), dpar( * )
  93. INTEGER ipar( * )
  94. END SUBROUTINE
  95. END INTERFACE
  96. INTERFACE
  97. SUBROUTINE DFGMRES_GET(n,x,b,rci_request,ipar,dpar, &
  98. & tmp,itercount)
  99. INTEGER n, rci_request, itercount
  100. DOUBLE PRECISION x( * ), b( * ), tmp( * ), dpar( * )
  101. INTEGER ipar( * )
  102. END SUBROUTINE
  103. END INTERFACE
  104. INTERFACE
  105. SUBROUTINE DCGMRHS(n,x,nRhs,b,rci_request,ipar,dpar,tmp)
  106. INTEGER n, rci_request, nRhs
  107. DOUBLE PRECISION x( * ), b( * ), dpar( * )
  108. DOUBLE PRECISION tmp( n, * )
  109. INTEGER ipar( * )
  110. END SUBROUTINE
  111. END INTERFACE
  112. INTERFACE
  113. SUBROUTINE DCGMRHS_INIT(n,x,nRhs,b,method,rci_request, &
  114. & ipar,dpar,tmp)
  115. INTEGER n, rci_request, nRhs, method
  116. DOUBLE PRECISION x( * ), b( * ), dpar( * )
  117. DOUBLE PRECISION tmp( n, * )
  118. INTEGER ipar( * )
  119. END SUBROUTINE
  120. END INTERFACE
  121. INTERFACE
  122. SUBROUTINE DCGMRHS_CHECK(n,x,nRhs,b,rci_request,ipar,dpar,tmp)
  123. INTEGER n, rci_request, nRhs
  124. DOUBLE PRECISION x( * ), dpar( * )
  125. DOUBLE PRECISION tmp( n, * ), b( nRhs, * )
  126. INTEGER ipar( * )
  127. END SUBROUTINE
  128. END INTERFACE
  129. INTERFACE
  130. SUBROUTINE DCGMRHS_GET(n,x,nRhs,b,rci_request,ipar,dpar, &
  131. & tmp,itercount)
  132. INTEGER n, rci_request, nRhs
  133. DOUBLE PRECISION x( * ), dpar( * )
  134. DOUBLE PRECISION tmp( n, * ), b( nRhs, * )
  135. INTEGER ipar( * ), itercount( * )
  136. END SUBROUTINE
  137. END INTERFACE
  138. ! FUNCTIONS
  139. INTERFACE
  140. INTEGER FUNCTION DTRNLSP_INIT(handle, n, m, x, eps, &
  141. & iter1, iter2, rs)
  142. INTEGER n, m, iter1, iter2
  143. DOUBLE PRECISION x( * ), eps( * )
  144. DOUBLE PRECISION rs
  145. INTEGER(KIND=8) handle
  146. END FUNCTION
  147. END INTERFACE
  148. INTERFACE
  149. INTEGER FUNCTION DTRNLSP_CHECK(handle, n, m, fjac, fvec, &
  150. & eps, info)
  151. INTEGER n, m
  152. INTEGER info( * )
  153. DOUBLE PRECISION fvec( * ), eps( * )
  154. DOUBLE PRECISION fjac( m, * )
  155. INTEGER(KIND=8) handle
  156. END FUNCTION
  157. END INTERFACE
  158. INTERFACE
  159. INTEGER FUNCTION DTRNLSP_SOLVE(handle, fvec, fjac, rci_request)
  160. INTEGER rci_request
  161. DOUBLE PRECISION fvec( * )
  162. DOUBLE PRECISION fjac( 1 , * ) ! ignore 1
  163. INTEGER(KIND=8) handle
  164. END FUNCTION
  165. END INTERFACE
  166. INTERFACE
  167. INTEGER FUNCTION DTRNLSP_GET(handle, iter, st_cr, r1, r2)
  168. INTEGER iter, st_cr
  169. DOUBLE PRECISION r1, r2
  170. INTEGER(KIND=8) handle
  171. END FUNCTION
  172. END INTERFACE
  173. INTERFACE
  174. INTEGER FUNCTION DTRNLSP_DELETE(handle)
  175. INTEGER(KIND=8) handle
  176. END FUNCTION
  177. END INTERFACE
  178. INTERFACE
  179. INTEGER FUNCTION DTRNLSPBC_INIT(handle, n, m, x, low, up, e, &
  180. & iter1, iter2, rs)
  181. INTEGER n, m, iter1, iter2
  182. DOUBLE PRECISION x( * ), low( * ), up( * ), e( * )
  183. DOUBLE PRECISION rs
  184. INTEGER(KIND=8) handle
  185. END FUNCTION
  186. END INTERFACE
  187. INTERFACE
  188. INTEGER FUNCTION DTRNLSPBC_CHECK(handle, n, m, fjac, fvec, &
  189. & low, up, eps, info)
  190. INTEGER n, m
  191. DOUBLE PRECISION fvec( * ), low( * ), up( * )
  192. DOUBLE PRECISION fjac( m, * )
  193. DOUBLE PRECISION eps( * )
  194. INTEGER info( * )
  195. INTEGER(KIND=8) handle
  196. END FUNCTION
  197. END INTERFACE
  198. INTERFACE
  199. INTEGER FUNCTION DTRNLSPBC_SOLVE(handle, fjac, fvec, &
  200. & rci_request)
  201. INTEGER rci_request
  202. DOUBLE PRECISION fvec( * )
  203. DOUBLE PRECISION fjac( 1, * ) ! ignore 1
  204. INTEGER(KIND=8) handle
  205. END FUNCTION
  206. END INTERFACE
  207. INTERFACE
  208. INTEGER FUNCTION DTRNLSPBC_GET(handle, iter, st_cr, r1, r2)
  209. INTEGER iter, st_cr
  210. DOUBLE PRECISION r1, r2
  211. INTEGER(KIND=8) handle
  212. END FUNCTION
  213. END INTERFACE
  214. INTERFACE
  215. INTEGER FUNCTION DTRNLSPBC_DELETE(handle)
  216. INTEGER(KIND=8) handle
  217. END FUNCTION
  218. END INTERFACE
  219. INTERFACE
  220. INTEGER FUNCTION DJACOBI_INIT(handle, n, m, x, fjac, eps)
  221. INTEGER n, m
  222. DOUBLE PRECISION x( * )
  223. DOUBLE PRECISION fjac( m , * )
  224. DOUBLE PRECISION eps
  225. INTEGER(KIND=8) handle
  226. END FUNCTION
  227. END INTERFACE
  228. INTERFACE
  229. INTEGER FUNCTION DJACOBI_SOLVE(handle, f1, f2, rci_request)
  230. INTEGER rci_request
  231. DOUBLE PRECISION f1( * ), f2( * )
  232. INTEGER(KIND=8) handle
  233. END FUNCTION
  234. END INTERFACE
  235. INTERFACE
  236. INTEGER FUNCTION DJACOBI_DELETE(handle)
  237. INTEGER(KIND=8) handle
  238. END FUNCTION
  239. END INTERFACE
  240. INTERFACE
  241. INTEGER FUNCTION DJACOBI(fcn, n, m, fjac, x, eps)
  242. INTEGER n, m
  243. DOUBLE PRECISION eps
  244. DOUBLE PRECISION x( * )
  245. DOUBLE PRECISION fjac( m , * )
  246. INTERFACE
  247. SUBROUTINE fcn(m,n,x,f)
  248. INTEGER n, m
  249. DOUBLE PRECISION x( * ), f( * )
  250. END SUBROUTINE
  251. END INTERFACE
  252. END FUNCTION
  253. END INTERFACE
  254. INTERFACE
  255. INTEGER FUNCTION DJACOBIX(fcn, n, m, fjac, x, eps, user_data)
  256. USE, INTRINSIC :: ISO_C_BINDING
  257. INTEGER n, m
  258. DOUBLE PRECISION eps
  259. DOUBLE PRECISION x( * )
  260. DOUBLE PRECISION fjac( m , * )
  261. INTEGER(C_INTPTR_T) user_data
  262. INTERFACE
  263. SUBROUTINE fcn(m,n,x,f,user_data)
  264. USE, INTRINSIC :: ISO_C_BINDING
  265. INTEGER n, m
  266. DOUBLE PRECISION x( * ), f( * )
  267. INTEGER(C_INTPTR_T) user_data
  268. END SUBROUTINE
  269. END INTERFACE
  270. END FUNCTION
  271. END INTERFACE
  272. INTERFACE
  273. INTEGER FUNCTION STRNLSP_INIT(handle, n, m, x, eps, &
  274. & iter1, iter2, rs)
  275. INTEGER n, m, iter1, iter2
  276. REAL x( * ), eps( * )
  277. REAL rs
  278. INTEGER(KIND=8) handle
  279. END FUNCTION
  280. END INTERFACE
  281. INTERFACE
  282. INTEGER FUNCTION STRNLSP_CHECK(handle, n, m, fjac, fvec, &
  283. & eps, info)
  284. INTEGER n, m
  285. INTEGER info( * )
  286. REAL fvec( * ), eps( * )
  287. REAL fjac( m, * )
  288. INTEGER(KIND=8) handle
  289. END FUNCTION
  290. END INTERFACE
  291. INTERFACE
  292. INTEGER FUNCTION STRNLSP_SOLVE(handle, fvec, fjac, rci_request)
  293. INTEGER rci_request
  294. REAL fvec( * )
  295. REAL fjac( 1, * ) ! ignore 1
  296. INTEGER(KIND=8) handle
  297. END FUNCTION
  298. END INTERFACE
  299. INTERFACE
  300. INTEGER FUNCTION STRNLSP_GET(handle, iter, st_cr, r1, r2)
  301. INTEGER iter, st_cr
  302. REAL r1, r2
  303. INTEGER(KIND=8) handle
  304. END FUNCTION
  305. END INTERFACE
  306. INTERFACE
  307. INTEGER FUNCTION STRNLSP_DELETE(handle)
  308. INTEGER(KIND=8) handle
  309. END FUNCTION
  310. END INTERFACE
  311. INTERFACE
  312. INTEGER FUNCTION STRNLSPBC_INIT(handle, n, m, x, low, up, e, &
  313. & iter1, iter2, rs)
  314. INTEGER n, m, iter1, iter2
  315. REAL x( * ), low( * ), up( * ), e( * )
  316. REAL rs
  317. INTEGER(KIND=8) handle
  318. END FUNCTION
  319. END INTERFACE
  320. INTERFACE
  321. INTEGER FUNCTION STRNLSPBC_CHECK(handle, n, m, fjac, fvec, &
  322. & low, up, eps, info)
  323. INTEGER n, m
  324. REAL fvec( * ), low( * ), up( * )
  325. REAL fjac( m, * )
  326. REAL eps( * )
  327. INTEGER info( * )
  328. INTEGER(KIND=8) handle
  329. END FUNCTION
  330. END INTERFACE
  331. INTERFACE
  332. INTEGER FUNCTION STRNLSPBC_SOLVE(handle, fjac, fvec, &
  333. & rci_request)
  334. INTEGER rci_request
  335. REAL fvec( * )
  336. REAL fjac( 1, * ) ! ignore 1
  337. INTEGER(KIND=8) handle
  338. END FUNCTION
  339. END INTERFACE
  340. INTERFACE
  341. INTEGER FUNCTION STRNLSPBC_GET(handle, iter, st_cr, r1, r2)
  342. INTEGER iter, st_cr
  343. REAL r1, r2
  344. INTEGER(KIND=8) handle
  345. END FUNCTION
  346. END INTERFACE
  347. INTERFACE
  348. INTEGER FUNCTION STRNLSPBC_DELETE(handle)
  349. INTEGER(KIND=8) handle
  350. END FUNCTION
  351. END INTERFACE
  352. INTERFACE
  353. INTEGER FUNCTION SJACOBI_INIT(handle, n, m, x, fjac, eps)
  354. INTEGER n, m
  355. REAL x( * )
  356. REAL fjac( m , * )
  357. REAL eps
  358. INTEGER(KIND=8) handle
  359. END FUNCTION
  360. END INTERFACE
  361. INTERFACE
  362. INTEGER FUNCTION SJACOBI_SOLVE(handle, f1, f2, rci_request)
  363. INTEGER rci_request
  364. REAL f1( * ), f2( * )
  365. INTEGER(KIND=8) handle
  366. END FUNCTION
  367. END INTERFACE
  368. INTERFACE
  369. INTEGER FUNCTION SJACOBI_DELETE(handle)
  370. INTEGER(KIND=8) handle
  371. END FUNCTION
  372. END INTERFACE
  373. INTERFACE
  374. INTEGER FUNCTION SJACOBI(fcn, n, m, fjac, x, eps)
  375. INTEGER n, m
  376. REAL eps
  377. REAL x( * )
  378. REAL fjac( m , * )
  379. INTERFACE
  380. SUBROUTINE fcn(m,n,x,f)
  381. INTEGER n, m
  382. REAL x( * ), f( * )
  383. END SUBROUTINE
  384. END INTERFACE
  385. END FUNCTION
  386. END INTERFACE
  387. INTERFACE
  388. INTEGER FUNCTION SJACOBIX(fcn, n, m, fjac, x, eps, user_data)
  389. USE, INTRINSIC :: ISO_C_BINDING
  390. INTEGER n, m
  391. REAL eps
  392. REAL x( * )
  393. REAL fjac( m , * )
  394. INTEGER(C_INTPTR_T) user_data
  395. INTERFACE
  396. SUBROUTINE fcn(m,n,x,f,user_data)
  397. USE, INTRINSIC :: ISO_C_BINDING
  398. INTEGER n, m
  399. REAL x( * ), f( * )
  400. INTEGER(C_INTPTR_T) user_data
  401. END SUBROUTINE
  402. END INTERFACE
  403. END FUNCTION
  404. END INTERFACE